home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug045.ark / P_R240.BAS < prev    next >
BASIC Source File  |  1983-08-29  |  9KB  |  290 lines
  1.     REMARK    ******************************************\
  2.         *  P/R240.BAS  SUMMARY FILE MAINTENANCE  *\
  3.         *   5/17/79                     1:21 PM  *\
  4.         ******************************************
  5.  
  6.  
  7. %INCLUDE CURSOR
  8.     RESTORE
  9.     DATA"HRS","AMT"
  10.     DIM B1(5),S(1),G3(5),R1(2),R2(5)
  11.     DIM G2$(5),A(14,12),A1.0(6)
  12.     DIM R$(5)
  13.     DEF FNA(Z1)=Z1-INT(Z1/10)*10                    REMARK  FUNCTION TO STRIP OFF TENS DIGIT
  14.     GOTO 6000
  15.  
  16. %INCLUDE GENINFO
  17. %INCLUDE SUBS1
  18.  
  19.  
  20.     
  21. 745    READ #1,X0;R$(1),R$(2),R$(3),R$(4),R1(1),R1(2),R2(1),R2(2),\    REMARK  READ PORTION OF MASTER RECORD
  22.     R2(3),R2(4),R2(5),R3$,S(1)
  23.     RETURN
  24.  
  25.  
  26. 825    Z1=110                                REMARK  LINE PRINTER ROUTINE
  27.     IF LINE.COUNT% < 55 THEN RETURN                    REMARK  IF SPACE REMAINS ON REPORT PAGE, RETURN
  28.  
  29.     PRINT CHR$(12);TAB((Z1-LEN(G2$(1)))/2);G2$(1);TAB(Z1);"DATE ";    REMARK  PRINT COMPANY NAME AND REPORT DATE
  30.     P=P+1
  31.     X0=G3(1):GOSUB 680.5
  32.     PRINT 
  33.  
  34.     PRINT TAB((Z1-LEN(X4$))/2);X4$;TAB(Z1);"PAGE";P            REMARK  PRINT REPORT HEADINGS
  35.     PRINT
  36.     PRINT "EMP #  PT";TAB(14);"  MON     TUE     WED     THU     FRI";
  37.     PRINT "     SAT     SUN     MON     TUE     WED     THU     FRI";
  38.     PRINT "     SAT     SUN"
  39.     PRINT
  40.     LINE.COUNT%=5                            REMARK  RESET LINE COUNTER FOR NEW REPORT PAGE
  41.     RETURN
  42.  
  43.  
  44. 873    READ #Y5,X0;B1(1),B1(2),B1(3),B1(4),B1(5)            REMARK  READ TRANSACTION SUMMARY RECORD
  45.     RETURN
  46.  
  47.  
  48. 875    PRINT #Y5,X0;B1(1),B1(2),B1(3),B1(4),B1(5)            REMARK  WRITE TRANSACTION SUMMARY RECORD
  49.     RETURN
  50.  
  51.  
  52. 1060    L=0                                REMARK  SEARCH FILE FOR SUMMARY RECORD
  53. 1070    L=L+1
  54.     IF L > RECORD.COUNT THEN H=-1:RETURN
  55.     X0=L:GOSUB 873                            REMARK  IF RECORD ID GREATER THAN EMPLOYEE NUMBER, RETURN
  56.     IF B1(1) > E1 THEN H=-1:RETURN
  57.     IF B1(1)=E1 AND B1(2) >= DAY.NO THEN H=0:RETURN
  58.     GOTO 1070
  59.  
  60.  
  61. 5300    X1=404:X2=2:X3=0:X4=16:GOSUB 345                REMARK  ENTER PAY TYPE
  62.     IF FNA(X0)>6 THEN X2$="OUT OF RANGE":GOSUB 615:GOTO 5300    REMARK  REJECT OUT-OF-RANGE ENTRIES
  63.     IF R2(1)=1 AND FNA(X0)=0\
  64.     THEN\
  65.     X2$="INCONSISTENT PAY TYPE":GOSUB 615:\                REMARK  FLAG PAY TYPES INCONSISTENT WITH EMPLOYEE TYPE
  66.     GOTO 5300\
  67.     ELSE\
  68.     B1(3)=X0:RETURN
  69.  
  70.  
  71. 5350    IF FNA(B1(3))>0 AND R2(1)<>1 THEN GOTO 5370
  72.     IF R2(1)=1 AND FNA(B1(3))<>2 THEN 5370
  73. 5360    X2$="OUT OF RANGE":GOSUB 615                    REMARK  REJECT ENTRY OF HOURS IF NOT APPLICABLE
  74.     RETURN 
  75.  
  76. 5370    X1=465:X2=5:X3=0:X4=99.99:GOSUB 345                REMARK  ENTER HOURS
  77.     B1(4)=X0
  78.     RETURN 
  79.  
  80.  
  81. 5400    IF R2(1) = 0 AND FNA(B1(3))=2 THEN GOTO 5405            REMARK  ENTER AMOUNT IF PAY TYPES PERMIT IT
  82.     IF FNA(B1(3)) = 2 OR FNA(B1(3)) = 4\
  83.     THEN\
  84.     X1=527:X2=7:X3=0:X4=9999.99:GOSUB 345:\
  85.     B1(5)=X0:\
  86.     RETURN 
  87.  
  88. 5405    X2$="OUT OF RANGE"
  89.     GOSUB 615
  90.     RETURN
  91.  
  92.  
  93. 5450    IF P=0 THEN LINE.COUNT%=60
  94.     X4$="PAYROLL BIWEEKLY SUMMARY":GOSUB 825            REMARK  PRINT BIWEEKLY PAYROLL SUMMARY
  95.     FOR K%=1 TO 6
  96.     IF A1.0(K%)=0 THEN  5475
  97.     PRINT USING B$;E1;                        REMARK  PRINT EMPLOYEE NUMBER
  98. 5463    RESTORE 
  99.     Z%=K%*2-1
  100.     FOR A1=Z% TO Z%+A.0
  101.     READ X4$
  102.     PRINT TAB(5);X4$;K%;                        REMARK  PRINT "HRS" OR "AMT"
  103. 5465    FOR J%=1 TO 14
  104.     IF A(J%,A1)=0 THEN  5470
  105.     PRINT TAB(J%*8+4);
  106.     PRINT USING D$;A(J%,A1);                    REMARK  PRINT HOURS/AMOUNT FOR DAY 'J'
  107. 5470    NEXT J%
  108.     PRINT 
  109.     NEXT A1
  110.     LINE.COUNT%=LINE.COUNT%+1+A.0
  111. 5475    NEXT K%
  112.  
  113.     A1.0(1)=0:A1.0(2)=0:A1.0(3)=0:A1.0(4)=0:A1.0(5)=0:A1.0(6)=0    REMARK  INITIALIZE TOTALS
  114.  
  115.     DIM A(14,12)                            REMARK  RE-INITIALIZE TOTALS ARRAY BY RE-DIMENSIONING IT
  116.     RETURN 
  117.  
  118.  
  119. 6000    A$=" ###.##"                            REMARK  SET UP PRINT MASKS FOR REPORT
  120.     B$="###"
  121.     C$="##"
  122.     D$="####.##"
  123.     Y5=2
  124.     Y9=3
  125.     OPEN "P/R0F110.DAT" RECL 1150 AS 1                REMARK  OPEN EMPLOYEE MASTER FILE
  126.     OPEN "P/R0F050.DAT" RECL 30 AS Y5                REMARK  OPEN PAYROLL TRANSACTION SUMMARY FILE
  127.     OPEN "G/I0F010.DAT" RECL 200 AS Y9:GOSUB 700            REMARK  OPEN AND LOAD GENERAL INFORMATION FILE
  128.     OPEN "CRT" RECL 1100 AS 19
  129.  
  130.  
  131.     WHILE B1(1) <> 9000000000                    REMARK  FIND END OF SUMMARY FILE
  132.     READ #Y5;B1(1)
  133.     RECORD.COUNT=RECORD.COUNT+1
  134.     WEND
  135.  
  136.  
  137. 6020    B=10
  138.     X0=10:GOSUB 260                            REMARK  LOAD AND DISPLAY CRT MASK NUMBER 10
  139.  
  140.     X2=1:X3=0:X4=2:X2$="ENTER OPERATION (0=END;1=CHANGE OR DELETE;2=PRINT)"
  141.     GOSUB 665
  142.  
  143.  
  144.     IF X0=0 THEN\                            REMARK  END PROGRAM AND LOAD MENU IF ZERO CODE ENTERED
  145.     PRINT CLEAR.SCREEN$;"P/R SUMMARY F/M LOADING MENU":\
  146.     CHAIN "P/R000"
  147.  
  148.  
  149.     IF X0=2 THEN  6200                        REMARK  IF CODE = 2, BRANCH TO PRINT ROUTINE
  150.  
  151.  
  152. 6030    X1=270:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER EMPLOYEE NUMBER
  153.     E1=X0
  154.     IF X0=0 THEN  6020                        REMARK  REQUEST OPERATION CODE IF EMPLOYEE = 0
  155.     R$(1)="NOT ON MASTER"
  156.     IF X0<=MSTR.RECORDS THEN GOSUB 745                REMARK  READ EMPLOYEE MASTER FILE RECORD
  157.  
  158. 6031    IF R2(1)=99 OR S(1)=0 OR X0>MSTR.RECORDS\
  159.     THEN R$(1)="NOT ON MASTER" 
  160.  
  161. 6053    X1=284:GOSUB 210
  162.     PRINT R$(1);TAB(30)                        REMARK  PRINT EMPLOYEE NAME OR ERROR MESSAGE IF NOT FOUND
  163.  
  164.     X1=326:X2=2:X3=0:X4=14:GOSUB 345                REMARK  ENTER DAY NUMBER
  165.     DAY.NO=X0
  166.  
  167.     GOSUB 1060                            REMARK  SEARCH SUMMARY FILE FOR EMPLOYEE ENTERED
  168.  
  169.     R5=L
  170.     IF H=-1 AND DAY.NO=0 AND B1(1)=E1 THEN H=0
  171.     IF B1(1)=E1 AND DAY.NO <> 0 AND B1(2) <> DAY.NO THEN H=-1
  172.     IF H=-1 THEN X2$="NOT ON FILE":GOSUB 615:GOTO 6030        REMARK  DISPLAY ERROR MESSAGE IF EMPLOYEE NOT FOUND
  173.  
  174.  
  175. 6070    X1=256:GOSUB 210
  176.     GOSUB 7025                            REMARK  DISPLAY TRANSACTION SUMMARY DATA
  177.  
  178. 6075    X2=2:X3=0:X4=99
  179.     X2$="ENTER FIELD TO CHANGE (0=NONE;98=NEW EMPL;99=DELETE)"    REMARK  PROMPT OPERATOR FOR FIELD TO CHANGE
  180.     GOSUB 665
  181.     X1=64:GOSUB 210:PRINT TAB(64):PRINT TAB(64);
  182.     IF X0=0 THEN  6095
  183.     IF X0=98 THEN  6030                        REMARK  REQUEST NEW EMPLOYEE
  184.  
  185.     IF X0=99 THEN  6100                        REMARK  BRANCH TO DELETE ROUTINE IF INDICATED
  186.  
  187.     IF X0 > 3 THEN 6075
  188.     ON X0    GOSUB 5300,5350,5400
  189.     GOTO 6075
  190. 6095    X0=L:GOSUB 875                            REMARK  SAVE RECORD ON FILE
  191.     L=L+1
  192.     IF L > RECORD.COUNT THEN 6030
  193.     X0=L
  194.     GOSUB 873                            REMARK  GET NEXT PAYROLL SUMMARY RECORD
  195.     IF B1(1)=E1 THEN  6070
  196.     GOTO 6030
  197. 6100    X2=3:X3=0:X4=0:X2$="ENTER DELETE CODE":GOSUB 665        REMARK  PROMPT OPERATOR FOR DELETE CODE
  198.     IF X0$ <> "DEL" THEN  6075
  199.     A.0=1
  200.     IF RECORD.COUNT=1\                        REMARK  SKIP RE-WRITING IF ONLY ONE RECORD ON FILE
  201.     THEN RECORD.COUNT=RECORD.COUNT+1:GOTO 6105
  202.  
  203.     FOR I=L TO RECORD.COUNT-1                    REMARK  PHYSICALLY RE-WRITE OVER DELETED RECORD
  204.     X0=I+1:GOSUB 873
  205.     X0=I:GOSUB 875
  206.     NEXT I
  207.  
  208. 6105    RECORD.COUNT=RECORD.COUNT-1
  209.     B1(1)=9000000000:B1(2)=0:B1(3)=0:\
  210.     B1(4)=0:B1(5)=0:X0=RECORD.COUNT:GOSUB 875
  211.     X2$="RECORD DELETED":GOSUB 615                    REMARK  FLASH DELETED RECORD BULLETIN
  212.     GOTO 6030
  213.  
  214.  
  215. 6200    X0=11:GOSUB 260                            REMARK  LOAD SUMMARY FILE PRINT CRT MASK
  216. 6205    X1=282:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER START EMPLOYEE NUMBER
  217.     E1=X0
  218.     X1=346:X2=3:X3=E1:X4=999:GOSUB 345                REMARK  ENTER END EMPLOYEE NUMBER
  219.     E2=X0
  220.     X1=411:X2=2:X3=0:X4=14:GOSUB 345                REMARK  ENTER START DAY NUMBER
  221.     D1=X0
  222.     X1=475:X2=2:X3=D1:X4=14:GOSUB 345                REMARK  ENTER END DAY NUMBER
  223.     D2=X0
  224.     X1=540:X2=1:X3=0:X4=1:GOSUB 345                    REMARK  PROMPT TO PRINT AMOUNT FIELDS OPTIONALLY
  225.     A.0=X0
  226.     X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK  VERIFY ENTRIES:'1'=O.K; '0'=RETRY
  227.     IF X0 <> 1 THEN  6205
  228. 6295    LPRINTER                            REMARK  SELECT PRINTER AS OUTPUT DEVICE
  229.     P=0
  230.     I=1
  231.     IF E2 > MSTR.RECORDS THEN E2=MSTR.RECORDS
  232.     DAY.NO=0
  233.     GOSUB 1060                            REMARK  GET FIRST EMPLOYEE NUMBER IN RANGE
  234.     R5=L
  235.  
  236. 6305    FOR I1%=L TO RECORD.COUNT
  237.     X0=I1%
  238.     GOSUB 873                            REMARK  READ THE NEXT PAYROLL SUMMARY RECORD
  239.     IF B1(1) > E2 THEN I1%=RECORD.COUNT+1:GOTO 6360
  240.     IF B1(2) < D1 OR B1(2) > D2\
  241.     OR FNA(B1(3))=0 THEN GOTO 6360                    REMARK  IF SUMMARY RECORD IS INVALID, SKIP IT
  242.  
  243.     IF B1(1) > E1 THEN GOSUB 5450:E1=B1(1)                REMARK  PRINT A DETAIL LINE ON REPORT
  244.     
  245. 6340    J%=FNA(B1(3))*2
  246. 6350    A(B1(2),J%-1)=B1(4)
  247.     A(B1(2),J%)=B1(5)
  248.     A1.0(J%/2)=1
  249. 6360    NEXT I1%
  250. 6370    GOSUB 5450                            REMARK  PRINT TOTALS FOR REPORT
  251.     CONSOLE
  252.     GOTO 6020                            REMARK  REQUEST A NEW OPERATION
  253.  
  254.  
  255. 7000    REMARK DISPLAY CRT MASK 10 OR 11
  256.     CONSOLE
  257.     X0=B:GOSUB 260
  258.     PRINT
  259.     PRINT 
  260.     PRINT 
  261.     PRINT 
  262.     IF B=11 THEN  7060
  263. 7025    X1=13:GOSUB 215
  264.     PRINT USING B$;B1(1);                        REMARK  DISPLAY EMPLOYEE NUMBER
  265.     X1=12:GOSUB 215
  266.     PRINT R$(1);TAB(63)                        REMARK  DISPLAY EMPLOYEE NAME
  267.     X1=7:GOSUB 215
  268.  
  269.     PRINT USING C$;B1(2)                        REMARK  DISPLAY DAY NUMBER FOR SUMMARY RECORD
  270.     X1=21:GOSUB 215
  271.     PRINT USING C$;B1(3)                        REMARK  DISPLAY PAY TYPE
  272.     X1=16:GOSUB 215
  273.     PRINT USING A$;B1(4)                        REMARK  DISPLAY HOURS
  274.     X1=16:GOSUB 215
  275.     PRINT USING D$;B1(5)
  276.     RETURN 
  277.  
  278.  
  279. 7060    X1=24:GOSUB 215
  280.     PRINT USING B$;E1                        REMARK  DISPLAY START EMPLOYEE NUMBER
  281.     X1=24:GOSUB 215
  282.     PRINT USING B$;E2                        REMARK  DISPLAY END EMPLOYEE NUMBER
  283.     X1=24:GOSUB 215
  284.     PRINT USING B$;D1                        REMARK  DISPLAY START DAY
  285.     X1=24:GOSUB 215
  286.     PRINT USING B$;D2                        REMARK  DISPLAY END DAY
  287.     X1=24:GOSUB 215
  288.     PRINT USING B$;A.0                        REMARK  DISPLAY AMOUNT PRINT OPTION
  289.     RETURN 
  290.