CP/M/CPM_CDROM.iso/simtel/cpmug/cpmug045.ark/P_R291.BAS

BASIC Source File | 1984-04-29 | 9.2 KB | 278 lines

    REMARK    *************************************\
        *  P/R291.BAS   JOB POSTING UPDATE  *\
        *  5/17/79                 3:46 PM  *\
        *************************************

%INCLUDE CURSOR

    DIM S(96),R1(2),R2(5),G3(5),G2$(5),J(4),D(4),T2(8)
    DIM W(2),W1(2),W2$(2),W2(14),R$(5)

    DEF FNR(X9)=INT(X9*100+.5)/100                    REMARK  ROUNDING FUNCTION

    DEF FNEXACT(M1,M2)=M1*1000+M2                    REMARK  KEY LOCATOR FUNCTION

    YES=1
    GOTO 6000

680.5    X0$=STR$(X0)                            REMARK  USE ONE ROUTINE FROM SUBS1.BAS
681    IF LEN(X0$)<6 THEN X0$="0"+X0$:GOTO 681
    PRINT LEFT$(X0$,2);"/";MID$(X0$,3,2);"/";RIGHT$(X0$,2);:RETURN

%INCLUDE GENINFO
%INCLUDE MSTRIN

825    A1=115                                REMARK    ****    LINE PRINTER ROUTINE    ****
    IF LINE.COUNT% < 58 THEN RETURN                    REMARK  IF SPACE REMAINS ON REPORT PAGE, RETURN
    P=P+1
    PRINT CHR$(12);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
    PRINT
    LINE.COUNT%=4                            REMARK  RESET LINE COUNTER FOR NEW REPORT 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


2210    LPRINTER                            REMARK  SELECT PRINTER TO PRINT NONZERO EMPLOYEE POSTING TOTALS
    IF F1=0 THEN 2245
    IF T2(6)<>J(1) THEN 2221                    REMARK  PRINT TOTALS IF JOB OR EMPLOYEE NUMBER HAVE CHANGED
    IF T2(1)=D(1) THEN 2270
2221    IF EMPLOYEE.DETAILS% <= 1 THEN 2230                REMARK  DON'T PRINT TOTALS FOR ONLY ONE EMPLOYEE POSTING

    IF D(2)+D(3)+D(4)>0\                        REMARK  PRINT EMPLOYEE POSTING TOTALS IF GREATER THAN ZERO
    THEN\
    LINE.COUNT%=LINE.COUNT%+1:\
    GOSUB 825:\                            REMARK  CHECK FOR END OF PAGE BEFORE PRINTING TOTALS
    PRINT USING"     ......  EMPLOYEE TOTALS........"+\
    "  ... #####.## ######.## ######.##";D(2),D(3),D(4)

2230    FOR I%=2 TO 4                            REMARK  ACCUMULATE EMPLOYEE TOTALS TO JOB POSTING TOTALS
    J(I%)=J(I%)+D(I%)
    D(I%)=0
    NEXT I%
    EMPLOYEE.DETAILS%=0

2245    D(1)=T2(1)                            REMARK  PRINT JOB POSTING TOTALS
    IF F1=0 THEN 2267
    IF T2(6)=J(1) THEN 2270                        REMARK  PRINT JOB TOTALS IF JOB NUMBER HAS CHANGED

    IF J(2)+J(3)+J(4)>0\
    THEN\
    LINE.COUNT%=LINE.COUNT%+1:\
    GOSUB 825:\                            REMARK  CHECK FOR END OF PAGE BEFORE PRINTING TOTALS
    PRINT "     ------  JOB TOTALS--------------";
    PRINT USING " -->######.## ######.## ######.##";J(2),J(3),J(4)
2265    PRINT
    J(2)=0:J(3)=0:J(4)=0                        REMARK  RESET JOB POSTING TOTALS
    LINE.COUNT%=LINE.COUNT%+1

2267    J(1)=T2(6)                            REMARK  SET CURRENT JOB NUMBER TO NEW JOB NUMBER
2269    IF FLAG%=99  THEN RETURN                    REMARK  IF END-OF-FILE REACHED ON POSTINGS, RETURN
    IF F1 <> 0 THEN GOSUB 836


2270    GOSUB 825                            REMARK  PRINT POSTING DETAILS
    F1=1
    D(2)=D(2)+T2(7)                            REMARK  ADD HOURS, COST-1 AND COST-2 TO JOB POSTING TOTALS
    D(3)=D(3)+Z1
    D(4)=D(4)+Z2
    PRINT USING MASKA$;T2(1);R$(1);T2(3);T2(7);Z1;Z2;        REMARK  PRINT EMPLOYEE NUMBER, NAME, PAY TYPE, HOURS, ETC.
    PRINT "  ";ERROR.MESSAGE$
    LINE.COUNT%=LINE.COUNT%+1
    EMPLOYEE.DETAILS%=EMPLOYEE.DETAILS%+1
    CONSOLE
    ERROR.MESSAGE$=" "
    RETURN


5300    Z1=FNR(T2(7)*S(8))                        REMARK  CALCULATE COST-1
    IF S(73)+S(80)>0 THEN Z2=FNR(S(74)*T2(7)/(S(73)+S(80)))        REMARK  CALCULATE COST-2 IF HOURS EXIST ON EMPLOYEE RECORD

5305    W2(3)=W2(3)+Z2                            REMARK  ACCUMULATE COST-2
    W2(10)=W2(10)+Z2

    IF T2(3)=6 THEN Z1=0                        REMARK  ZERO OUT COST-1 FOR COMP TIME TRANSACTIONS
    W2(2)=W2(2)+Z1
    W2(9)=W2(9)+Z1

    W2(1)=W2(1)+T2(7)                        REMARK  ACCUMULATE HOURS FROM JOB POSTING TO JOB RECORD
    W2(8)=W2(8)+T2(7)
    RETURN

5310    IF R2(1)<>1 THEN 5300

5315    Z1=T2(8):Z2=T2(8)                        REMARK CALCULATE COST-1 AND COST-2 FOR HOURLY EMPLOYEES
    GOTO 5305

5320    Z1=FNR(T2(7)*S(8)*G3.0)                        REMARK  CALCULATE COST-1 AND COST-2 FOR OVERTIME POSTINGS
    Z2=Z1
    GOTO  5305


6000    MASKA$="     ######  /2345678901234567890123/"            REMARK  SET UP PRINT MASKS
    MASKA$=MASKA$+" ### #####.## ######.## ######.##"
    X4$="JOB POSTINGS"
    W1$="NO HEADER RECORD"
    LINE.COUNT%=60
    Y6=2
    Y9=4
    PRINT CLEAR.SCREEN$;"JOB POSTING UPDATE"
    OPEN "P/R0F110.DAT" RECL 1150 AS 1
    OPEN "JOB0F100.DAT" RECL 160 AS Y6
    OPEN "JOB0F110.DAT" RECL 42 AS 3
    OPEN "G/I0F010.DAT" RECL 200 AS Y9
    CREATE "WORKFILE.DAT" RECL 160 AS 5
    GOSUB 700                            REMARK  READ SYSTEM GENERAL INFORMATION
    Y2=Y6
    RECORD.COUNT=JOB.RECORDS

    IF END #3 THEN 6060                        REMARK SET EOF TRAP
    GOTO 6070
6060    FLAG%=99                            REMARK  END-OF-FILE PROCESSING FOR JOB POSTING FILE
    OUTPUT.COUNT%=OUTPUT.COUNT%+1
    X0=OUTPUT.COUNT%                        REMARK  WRITE LAST JOB POSTING RECORD

    Y6=5:GOSUB 1110
    Y6=2
    GOTO 6200
6070    READ #3;T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8)        REMARK  READ JOB POSTING RECORD

    IF T2(6)=0\                            REMARK  IF A ZERO JOB NUMBER WAS READ, PRINT ERROR ON PRINTER
    THEN\
    Z1=0:Z2=0:ERROR.MESSAGE$="ILLEGAL JOB":\
    GOSUB 2210:GOTO 6070

    IF T2(7)+T2(8)=0 THEN GOTO 6070                    REMARK  IF NO HOURS OR COSTS FOR THIS POSTING, GET NEXT RECORD


    IF END #2 THEN 6087                        REMARK  SET EOF TRAP FOR JOB FILE PROCESSING

    IF FNEXACT(W(1),W(2)) <> FNEXACT(T2(6),T2(1))\            REMARK  WRITE OUT THE POSTED JOB RECORD
    AND POST.RECORD%=YES\                        REMARK  IF JOB POSTING RECORD KEY IS GREATER
    THEN\
    OUTPUT.COUNT%=OUTPUT.COUNT%+1:\
    X0=OUTPUT.COUNT%:\
    Y6=5:GOSUB 1110:\
    POST.RECORD%=0:\
    Y6=2


    WHILE FNEXACT(W(1),W(2)) < FNEXACT(T2(6),T2(1))

        INPUT.COUNT%=INPUT.COUNT%+1                REMARK  READ THROUGH JOB FILE FOR A MATCH ON POSTING FILE
        X0=INPUT.COUNT%
        Y6=2
        GOSUB 1100
        IF FNEXACT(W(1),W(2)) >= FNEXACT(T2(6),T2(1))\        REMARK  GET OUT OF LOOP IF A MATCH WAS FOUND...
        OR\
        W2$(1)="D" OR W2(3)=-1 THEN GOTO 6085            REMARK  DISCARD ANY LOGICALLY DELETED JOB RECORDS

        OUTPUT.COUNT%=OUTPUT.COUNT%+1                REMARK  WRITE OUT JOB RECORDS OCCURRING BEFORE POSTINGS
        X0=OUTPUT.COUNT%
        Y6=5
        GOSUB 1110

6085    WEND

    JOB.NUMBER=W(1):EMPLOYEE=W(2)

6087    IF W(1)=T2(6) THEN 6090                        REMARK  SEARCH JOB FILE FOR HEADER RECORD IF IT IS NEW
    W1$="NO HEADER RECORD"
    K=FNEXACT(T2(6),0):GOSUB 1060
    IF H=-1 THEN 6090                        REMARK  IF HEADER NOT FOUND, SET DESCRIPTION TO ERROR MESSAGE
    X0=L:GOSUB 1100                            REMARK  READ HEADER RECORD FROM JOB FILE

    IF W2$(1)="D" THEN W1$="NO HEADER RECORD"            REMARK  IF RECORD WAS DELETED, SET HEADER ERROR

6090    IF FNEXACT(JOB.NUMBER,EMPLOYEE) > FNEXACT(T2(6),T2(1))\        REMARK  IF NO MATCH WAS FOUND, CREATE NEW DETAIL
    THEN\
    INPUT.COUNT%=INPUT.COUNT%-1:\
    W(1)=T2(6):W(2)=T2(1):\
    FOR I%=1 TO 14:W2(I%)=0:NEXT I%


6120    IF T2(1)=S(1) THEN 6130                        REMARK  SKIP MASTER FILE READ IF EMPLOYEE HAS NOT CHANGED
    S(1)=0
    IF T2(1)>0 AND T2(1)<=MSTR.RECORDS THEN X0=T2(1):GOSUB 745    REMARK  GET EMPLOYEE RECORD IF IT IS WITHIN EXTENTS

    IF S(1)>0 THEN GOTO 6125
    R$(1)=""                            REMARK  IF INVALID EMPLOYEE WAS POSTED, PRINT ERROR
    ERROR.MESSAGE$="NO EMPLOYEE RECORD - AMOUNT NOT POSTED"        REMARK  WITHOUT UPDDATING THE FILE
    GOSUB 2210
    IF FNEXACT(W(1),W(2))=FNEXACT(T2(6),T2(1)) THEN\
    POST.RECORD%=YES
    GOTO 6070

6125    IF R2(1) <> 1 THEN S(8)=S(8)/80                    REMARK  SIMULATE HOURLY RATE FOR SALARIED EMPLOYEES
6130    Z1=0:Z2=0
    ON T2(3) GOSUB 5300,5310,5320,5315,5320,5300            REMARK  CALCULATE POSTING COSTS BASED ON WORK TYPE

6140    ERROR.MESSAGE$=" ":GOSUB 2210                    REMARK  PRINT NORMAL POSTING DETAIL
    POST.RECORD%=YES
    GOTO  6070                            REMARK  BRANCH BACK TO READ NEXT JOB POSTING RECORD

6200    INPUT.COUNT%=INPUT.COUNT%+1
    WHILE INPUT.COUNT% <= JOB.RECORDS                REMARK  COPY THE REMAINDER OF THE JOB FILE IF RECORDS
                                    REMARK  STILL NEED TO BE COPIED INTO THE WORKFILE
    READ #2,INPUT.COUNT%;LINE DATA$                    REMARK  READ IN JOB RECORD
    A%=MATCH(",-1,",DATA$,1)
    IF A%>0 THEN GOTO 6200.1                    REMARK  IF A DELETED DETAIL RECORD WAS READ, SKIP IT
    A%=0
    FOR I%=1 TO 5                            REMARK  TEST FOR DELETED HEADER; SKIP IF TRUE
    A%=MATCH(",",DATA$,A%+1)
    NEXT I%
    IF MID$(DATA$,A%+1,3)=CHR$(22H)+"D"+CHR$(22H) THEN GOTO 6200.1

    OUTPUT.COUNT%=OUTPUT.COUNT%+1                    REMARK  COPY THE REMAINDER OF DATA FILE
    PRINT USING "&";#5,OUTPUT.COUNT%;DATA$
6200.1    INPUT.COUNT%=INPUT.COUNT%+1
    WEND

6200.5    J(1)=-1
    ERROR.MESSAGE$=" ":GOSUB 2210                    REMARK  PRINT TOTALS FOR LAST JOB
    CLOSE 1,2,3,4,5                            REMARK  CLOSE ALL FILES
    OPEN "JOB0F100.DAT" AS 1
    DELETE 1                            REMARK  DELETE JOB FILE
    A%=RENAME("JOB0F100.DAT","WORKFILE.DAT")            REMARK  RENAME WORK FILE AS JOB FILE
    CREATE "JOB0F110.DAT" AS 1                    REMARK  SET UP A BLANK JOB POSTING FILE
    OPEN "G/I0F010.DAT" RECL 200 AS Y9
    JOB.RECORDS=OUTPUT.COUNT%
    GOSUB 720                            REMARK  WRITE OUT NEW JOB FILE EXTENTS

    CONSOLE
    PRINT CLEAR.SCREEN$;"JOB POSTING UPDATE ENDED"
    CHAIN "P/R000"                            REMARK  LOAD MENU