home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG045.ARK
/
P_R300.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
11KB
|
328 lines
REMARK **************************************\
* P/R300.BAS JOB COSTING REPORT *\
* 5/18/79 10:20 AM *\
**************************************\
%INCLUDE CURSOR
DIM S(1),R1(2),R2(5),G3(5),G2$(5),J(4,14),REPORT.SPEC(6),T2(8)
DIM W(2),W1(2),W2$(2),W2(14),R$(5),L$(80)
DIM L$(80)
DEF FNR(X9)=INT(X9*100+.5)/100 REMARK ROUNDING FUNCTION
DEF FNEXACT(M1,M2)=M1*1000+M2 REMARK KEY LOCATOR FUNCTION
GOTO 6000
%INCLUDE SUBS1
%INCLUDE GENINFO
745 Q$=" " REMARK READ ONLY A PORTION OF THE EMPLOYEE MASTER RECORD
R$(1)="NOT ON FILE"
IF X0 = 0 OR X0 > MSTR.RECORDS THEN Q$="N":RETURN
READ #1,X0;R$(1),R$(2),R$(3),R$(4),R$(5),R1(1),R1(2),\
R2(1),R2(2),R2(3),R2(4),R2(5),S(1)
IF S(1)=0 THEN R$(1)="NOT ON FILE":Q$="N":RETURN
RETURN
825 A1=115 REMARK **** LINE PRINTER ROUTINE ****
IF LINE.COUNT% < 56 THEN RETURN REMARK IF SPACE REMAINS ON REPORT PAGE, RETURN
P=P+1
PRINT CHR$(12);TAB((A1-LEN(G2$(1)))/2);G2$(1);TAB(A1);"DATE "; REMARK SKIP TO TOP OF FORM AND PRINT DATE
X0=G3(1):GOSUB 680.5
PRINT
PRINT TAB((A1-LEN(X4$))/2);X4$;TAB(A1);"PAGE";P REMARK PRINT REPORT TITLE AND PAGE NUMBER
PRINT
LINE.COUNT%=4 REMARK RESET LINE COUNTER FOR NEW REPORT PAGE
IF P=1 THEN RETURN REMARK PRINT CURRENT JOB HEADER DATA FROM PREVIOUS PAGE
836 PRINT "JOB "; REMARK PRINT JOB HEADER DATA ON PRINTER
PRINT USING "######";W(1);
PRINT " ";W1$;TAB(70);"STARTED ";
X0=W1(1):GOSUB 680.5
IF W2$(1)<>"0" THEN PRINT " COMPLETED "; \
ELSE PRINT " DUE DATE ";
X0=W1(2):GOSUB 680.5 REMARK PRINT JOB COMPLETION OR DUE DATE
PRINT " TYPE ";W2$(2);
IF W2$(1)<>"0" THEN GOTO 840
X0=INT(W1(2)/100)*100 REMARK COMPARE REPORT DATE AND DUE DATE; PRINT 'OVERDUE'\
IF DUE DATE <= REPORT DATE
X0=(W1(2)-X0)*10000+(X0/100)
X1=INT(G3(1)/100)*100
X1=(G3(1)-X1)*10000+(X1/100)
IF X0 <= X1 THEN PRINT TAB(120);"**OVERDUE**";
840 PRINT
PRINT
PRINT " EMPLOYEE NAME";TAB(46);"HOURS COST-1 COST-2";
PRINT " P/R OHD GEN OHD PRS OHD OTH OHD TOT OHD COST"
LINE.COUNT%=LINE.COUNT%+3
RETURN
%INCLUDE JOBFILE
%INCLUDE PR-SEARC
4100 REMARK ****************************************\
* PRINT A LINE OF THE COSTING REPORT *\
* BASED ON REPORT.SPEC AND LEVEL% *\
****************************************
PRINT TAB(13);X0$; REMARK PRINT EMPLOYEE NAME OR TOTAL TYPE
IF REPORT.SPEC(4)=1\ REMARK PRINT MONTH-TO-DATE TOTALS IF REQUESTED
THEN\
Z=J(LEVEL%,4)+J(LEVEL%,5)+J(LEVEL%,6)+J(LEVEL%,7):\
PRINT TAB(38);"MTD";:\
PRINT USING MASKA$;J(LEVEL%,1),J(LEVEL%,2),J(LEVEL%,3),\
J(LEVEL%,4),J(LEVEL%,5),J(LEVEL%,6),J(LEVEL%,7),Z,Z+J(LEVEL%,3):\
LINE.COUNT%=LINE.COUNT%+1
IF REPORT.SPEC(5)=1\ REMARK PRINT JOB-TO-DATE TOTALS IF REQUESTED
THEN\
Z=J(LEVEL%,11)+J(LEVEL%,12)+J(LEVEL%,13)+J(LEVEL%,14):\
PRINT TAB(38);"JTD";:\
PRINT USING MASKA$;J(LEVEL%,8),J(LEVEL%,9),J(LEVEL%,10),\
J(LEVEL%,11),J(LEVEL%,12),J(LEVEL%,13),J(LEVEL%,14),\
Z,Z+J(LEVEL%,10):\
LINE.COUNT%=LINE.COUNT%+1
PRINT
LINE.COUNT%=LINE.COUNT%+1
IF LEVEL%=4 THEN RETURN REMARK AVOID ACCUMULATION IF GRAND TOTALS WERE PRINTED
FOR I1%=1TO 14 REMARK ACCUMULATE THIS LINE TO NEXT TOTAL LEVEL
J(LEVEL%+1,I1%)=J(LEVEL%+1,I1%)+J(LEVEL%,I1%)
J(LEVEL%,I1%)=0 REMARK INITIALIZE CURRENT TOTAL LEVEL
NEXT I1%
RETURN
5300 C=W(1)
IF W(2)>0 THEN W1$="NO HEADER RECORD"
IF W2$(1)="D" THEN DELETE.FLAG%=1:GOTO 5390 REMARK IGNORE LOGICALLY DELETED JOB RECORDS
GOSUB 825 REMARK CHECK FOR END OF PAGE
IF LINE.COUNT%<>7 THEN GOSUB 836 REMARK PRINT JOB HEADER DATA IF NOT ALREADY PRINTED
5310 IF REPORT.SPEC(6)=0 THEN GOTO 5313 REMARK DELETE CANCELLED JOBS IF REQUESTED
IF W2$(1)<>"9" THEN GOTO 5313
IF W(2)>0 THEN W2(3)=-1:X0=INPUT%:GOSUB 1110:W2(3)=0 REMARK SAVE DELETED DETAIL RECORD
IF W(2)=0 THEN W2$(1)="D":X0=INPUT%:GOSUB 1110:W2$(1)="9" REMARK SAVE DELETED HEADER RECORD
IF F <= 0 THEN PRINT " ***** DELETED ***** "
LINE.COUNT%=LINE.COUNT%+1
5313 F=1
INPUT%=INPUT%+1
IF INPUT% > JOB.RECORDS THEN W(1)=10000000:GOTO 5380
X0=INPUT%
GOSUB 1100 REMARK READ JOB RECORD
IF W2(3)=-1 THEN GOTO 5313
IF C=W(1)\
THEN\
X0=W(2):GOSUB 745:\ REMARK GET EMPLOYEE RECORD
GOSUB 825:\
PRINT TAB(6);:\
PRINT USING MASKB$;W(2);:\ REMARK PRINT EMPLOYEE NUMBER ON REPORT PAGE
FOR I1%=1 TO 14:\ REMARK PLACE DETAIL RECORD FIELDS INTO LEVEL-1 TOTALS
J(1,I1%)=W2(I1%):\
NEXT I1%:\
LEVEL%=1:X0$=R$(1):GOSUB 4100:\ REMARK PRINT REMAINDER OF JOB DETAIL AND ACCUMULATE
GOTO 5310
5380 F=0
IF INT(C/10)<>INT(W(1)/10) THEN 5405 REMARK IF THE NEW JOB NUMBER'S ROOT HAS CHANGED,\
PRINT TASK TOTALS, THEN PRINT JOB TOTALS
5385 IF W2$(1)="0"\ REMARK FORCE PRINTING OF ACTIVE JOBS, OR ALL JOBS
OR REPORT.SPEC(6)=1 THEN GOTO 5395
IF REPORT.SPEC(3)=0 AND W2$(1) <> "D" THEN GOTO 5395
5390 INPUT%=INPUT%+1 REMARK SEARCH FOR A JOB THAT IS PRINTABLE
IF INPUT%>JOB.RECORDS THEN W(1)=10000000:GOTO 5405
X0=INPUT%
GOSUB 1100 REMARK GET NEXT DETAIL RECORD
IF C<>W(1) THEN GOTO 5380 ELSE GOTO 5390
5395 IF DELETE.FLAG%=1 THEN DELETE.FLAG%=0:GOTO 5300 REMARK DO NOT PRINT TASK TOTALS FOR DELETED JOBS
TASK.TOTALS%=1
LEVEL%=2:X0$="TASK TOTALS":GOSUB 4100 REMARK PRINT TASK TOTALS AND START PRINTING A NEW TASK
IF W(2) > 0 THEN INPUT%=INPUT%-1
GOTO 5300
5405 IF W(2) > 0 THEN INPUT%=INPUT%-1 REMARK IF NEW JOB RECORD HAS NO HEADER, SUBTRACT POINTER
IF DELETE.FLAG%=1 THEN GOTO 5415
IF TASK.TOTALS%=0\ REMARK IF TASK TOTALS FLAG NOT SET, ACCUMULATE TO JOB TOTALS
THEN\
FOR I1%=1 TO 14:\
J(3,I1%)=J(2,I1%):\
J(2,I1%)=0:\
NEXT I1%\
ELSE\
LEVEL%=2:X0$="TASK TOTALS":GOSUB 4100
5415 IF DELETE.FLAG%=1 AND TASK.TOTALS%=1\ REMARK IF LAST TASK WAS DELETED, GO ON TO PRINT JOB TOTALS
THEN\
DELETE.FLAG%=0
IF DELETE.FLAG%=1 THEN DELETE.FLAG%=0:RETURN REMARK IF DELETE FLAG WAS SET, RETURN WITHOUT JOB TOTALS
TASK.TOTALS%=0 REMARK PRINT JOB TOTALS
LEVEL%=3:X0$="JOB TOTALS":GOSUB 4100
X0$="----"
FOR X%=1 TO 4:X0$=X0$+X0$:NEXT X%
PRINT X0$;X0$ REMARK PRINT A FULL LINE OF DASHES TO SEPARATE JOBS
LINE.COUNT%=LINE.COUNT%+1
RETURN
6000 FOR I%=1 TO 9:MASKA$=MASKA$+" ######.##":NEXT I% REMARK SET UP PRINT MASKS
MASKB$="######"
Y6=2
Y9=3
CTRL.C%=1 REMARK ENABLE A CTRL-C PROGRAM EXIT
OPEN "P/R0F110.DAT" RECL 1150 AS 1 REMARK OPEN FILES
OPEN "JOB0F100.DAT" RECL 160 AS Y6
OPEN "G/I0F010.DAT" RECL 200 AS Y9
OPEN "CRT" RECL 1100 AS 19
GOSUB 700 REMARK LOAD SYSTEM GENERAL INFORMATION
RECORD.COUNT=JOB.RECORDS
Y2=Y6
6015 LINE.COUNT%=60
X0=14:GOSUB 260 REMARK LOAD COSTING REPORT CRT MASK
DIM REPORT.SPEC(6),J(4,14)
6020 X1=266:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER FIRST JOB TO PRINT
IF X%=3 THEN GOTO 6400
IF X0=0 THEN 6060
REPORT.SPEC(1)=X0
X1=281:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER LAST JOB TO PRINT
IF X0=0 THEN 6020
REPORT.SPEC(2)=X0
6030 X1=302:X2=1:X3=0:X4=1:GOSUB 345 REMARK INPUT WHETHER TO PRINT ACTIVE JOBS ONLY
REPORT.SPEC(3)=X0
X1=309:X2=1:X3=0:X4=1:GOSUB 345 REMARK INPUT WHETHER TO PRINT M-T-D FIELDS
REPORT.SPEC(4)=X0
X1=316:X2=1:X3=0:X4=1:GOSUB 345 REMARK INPUT WHETHER TO PRINT J-T-D FIELDS
REPORT.SPEC(5)=X0
6043 X0$="A" REMARK INPUT JOB TYPE TO PRINT--"A"=ALL
X1=334:X2=1:X3=0:X4=0:GOSUB 345
IF X0$ = "A" THEN GOTO 6045
IF X0$<"0" OR X0$ > "9" THEN GOTO 6043
6045 JOB.TYPE$=X0$
X1=352:X2=1:X3=0:X4=1:GOSUB 345 REMARK INPUT WHETHER TO DELETE CANCELLED JOBS
REPORT.SPEC(6)=X0
6050 X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665 REMARK VERIFY ENTRY:'1'=O.K.; '0'=RETRY
IF X0<>1 THEN 6015
GOTO 6100 REMARK BRANCH TO PRINT REPORT
6060 FOR I1%=1 TO 9
FOR I%=1 TO 8
6065 X1=64*I1%+7*I%+384:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER JOB NUMBERS INTO GRID (80 MAXIMUM)
IF X0=0 THEN I1%=9:I%=8:GOTO 6070 REMARK GRID ENTRY IS TERMINATED BY JOB NUMBER=0
L$(I%+8*(I1%-1))=X0$
6070 NEXT I%
NEXT I1%
6075 X2=2:X3=0:X4=10:X2$="ENTER ROW TO CHANGE (0=NONE)" REMARK PROMPT OPERATOR FOR CHANGES TO GRID
GOSUB 665
IF X0=0 THEN 6030 REMARK IF ROW TO CHANGE=0, NO MORE CHANGES ARE NEEDED
I1%=X0
X2=1:X3=1:X4=8:X2$="ENTER COLUMN TO CHANGE":GOSUB 665
I%=X0
X1=64*I1%+7*I%+384:X2=6:X3=0:X4=999999:GOSUB 345 REMARK ENTER AMENDED JOB NUMBER
L$(I%+8*(I1%-1))=X0$
GOTO 6075
6100 LPRINTER REMARK SELECT PRINTER AS OUTPUT DEVICE
X4$="JOB COSTING"
GOSUB 825 REMARK PRINT HEADINGS FOR FIRST PAGE
REPORT.SPEC(4)=REPORT.SPEC(4) OR REPORT.SPEC(6) REMARK ENABLE MTD AND JTD PRINT IF DELETE OPTION SELECTED
REPORT.SPEC(5)=REPORT.SPEC(5) OR REPORT.SPEC(6)
6105 IF REPORT.SPEC(1)=0 THEN 6130 REMARK IF START JOB=0, PROCESS JOB FILE VIA GRID ENTRIES
K1=FNEXACT(REPORT.SPEC(1),0) REMARK LOCATE START JOB ON FILE
GOSUB 1060
INPUT%=L
X0=INPUT%
GOSUB 1100
6120 IF W(1)>REPORT.SPEC(2) THEN 6200 REMARK IF JOB NUMBER IS BEYOND RANGE SPECIFIED, EXIT
IF W(1)=10000000 THEN 6200 REMARK IF END OF FILE ENCOUNTERED, EXIT
IF W2$(1)="D" THEN GOTO 6125
IF JOB.TYPE$<> "A" AND W2$(2)<>JOB.TYPE$ THEN GOTO 6125
6123 IF REPORT.SPEC(3)=0\ REMARK DETERMINE WHETHER TO PRINT THIS JOB
OR W2$(1)<"1"\
OR REPORT.SPEC(6)=1\
THEN\
GOSUB 5300:GOTO 6120
6125 VAR1=W(1) REMARK LOOK FOR NEXT JOB IF THIS THIS IS NOT TO BE PRINTED
INPUT%=INPUT%+1
X0=INPUT%
GOSUB 1100
IF VAR1=W(1) THEN GOTO 6125\
ELSE\
GOTO 6120
6130 FOR I%=1TO 80 REMARK PRINT REPORT USING JOB ENTRY GRID
6135 JOB.NO=VAL(L$(I%))
IF JOB.NO=0 THEN 6155
K=FNEXACT(JOB.NO,0)
GOSUB 1060 REMARK SEARCH FILE FOR A MATCH FROM JOB GRID
IF H=-1 THEN 6155 REMARK IF NOT FOUND, GET THE NEXT JOB ON THE GRID
INPUT%=L REMARK READ HEADER RECORD
X0=INPUT%
GOSUB 1100
IF W2$(1)="D" THEN 6155
W(2)=0 REMARK SET EMPLOYEE NUMBER IN ORDER TO PRINT HEADER
GOSUB 5300
6155 NEXT I%
6200 LEVEL%=4:X0$="GRAND TOTALS":GOSUB 4100 REMARK PRINT REPORT GRAND TOTALS
GOTO 6015
6400 CONSOLE REMARK DISPLAY EXIT MESSAGE AND LOAD THE MENU
PRINT CLEAR.SCREEN$;"JOB COSTING REPORT LOADING MENU"
CHAIN "P/R000"