home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug045.ark / P_R210.BAS < prev    next >
Encoding:
BASIC Source File  |  1983-08-29  |  8.8 KB  |  295 lines
  1.     REMARK    *******************************************\
  2.         *  P/R210.BAS   HISTORY FILE MAINTENANCE  *\
  3.         *    5/17/79                  11:26 PM    *\
  4.         *******************************************
  5.  
  6. %INCLUDE CURSOR
  7.  
  8.  
  9.      DIM H1(3),H2(9),I1(3),I2(9),G2$(5),G3(5)
  10.  
  11.  
  12.     DEF FNEXACT(X0,X1)=X0*1000000+X1                REMARK  FUNCTION TO FORM SEARCH KEY
  13.  
  14.     WRITTEN=999999
  15.     YES=1
  16.     
  17.     GOTO 6000
  18.  
  19. %INCLUDE GENINFO
  20. %INCLUDE SUBS1
  21. %INCLUDE HISTORY
  22.  
  23.  
  24.  
  25. 1000    H=0:Y2=1:RECORD.COUNT=HISTORY.RECORDS:GOSUB 1060        REMARK  ROUTINE TO SEARCH HISTORY FILE AND HISTORY INPUT FILE
  26.     IF H <>-1 OR FINDNEXT=YES THEN RETURN
  27.  
  28. 1010    H=0:Y2=2:RECORD.COUNT=NEW.RECORDS%
  29.     SEARCH.FAILURE%=0
  30.     GOSUB 1060
  31.     IF VAR1 <> INT(K/1000000) THEN SEARCH.FAILURE%=YES
  32.     RETURN
  33.  
  34. %INCLUDE PR-SEARCH
  35.  
  36.  
  37. 5300    X1=341:X2=6:X3=1:X4=999999:GOSUB 345                REMARK  ENTER CHECK NUMBER
  38.     H1(3)=X0
  39.     RETURN 
  40.  
  41.  
  42. 5310    X1=274+F*64:X2=9:X3=0:X4=999999.99:GOSUB 345            REMARK  ENTER HOURS AND PAY SUMMARY FIELDS
  43.     H2(F-1)=X0
  44.     RETURN 
  45.  
  46.  
  47. 5320    X1=274+F*64:X2=9:X3=0:X4=999999.99:GOSUB 345            REMARK  ENTER DEDUCTION AMOUNT
  48.  
  49. 5325    H2(9)=H2(9)-H2(F-1)+X0                        REMARK  ACCUMULATE TO TOTAL DEDUCTIONS
  50.  
  51. 5330    H2(F-1)=X0
  52.  
  53. 5335    X1=914:GOSUB 210                        REMARK  RE-DISPLAY TOTAL DEDUCTIONS AFTER FIELD ENTRY
  54.     PRINT USING A1$; H2(9)
  55. 5340    RETURN 
  56.  
  57. 6000    A1$="######.##"
  58.     B$="######"
  59.     Y2=1
  60.     Y9=4
  61.     OPEN "P/R0F120.DAT" RECL 102 AS 1                REMARK  OPEN PAYROLL HISTORY AND HISTORY INPUT FILES
  62.     CREATE "HISTORY.DAT" RECL 102 AS 2
  63.  
  64.     OPEN "CRT" RECL 1100 AS 19                    REMARK  OPEN CRT MASK FILE
  65.  
  66.     OPEN "G/I0F010.DAT" RECL 200 AS Y9:GOSUB 700            REMARK  OPEN AND LOAD GENERAL INFORMATION FILE
  67.  
  68.     X0=9:GOSUB 260                            REMARK  LOAD HISTORY FILE MAINTENANCE CRT MASK
  69.  
  70. 6015    X2=1:X3=0:X4=2                            REMARK  ENTER OPERATION CODE
  71.     X2$="ENTER OPERATION(0=EXIT;1=ADD;2=INQUIRE,CHANGE OR DELETE)"
  72.     GOSUB 665
  73.  
  74.     IF X0 = 0 THEN\                            REMARK  IF ZERO ENTERED, BRANCH TO WRAPUP ROUTINES
  75.     X1=64:GOSUB 210:PRINT "WORKING... DO NOT INTERRUPT!";TAB(70):\
  76.     GOTO 9000
  77.  
  78.     IF X0=1 THEN 6200                        REMARK  BRANCH TO ADD ROUTINE IF CODE =1
  79.  
  80.                                     REMARK  CHANGE HISTORY RECORD ROUTINE
  81.  
  82. 6025    X1=265:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER EMPLOYEE NUMBER
  83.  
  84.     IF X0>0 THEN EMPL.NO=X0 ELSE GOTO 6015
  85.  
  86.     FINDNEXT=YES
  87.     
  88.     K=FNEXACT(EMPL.NO,0):GOSUB 1000                    REMARK  SEARCH HISTORY FILE FOR FIRST RECORD WHICH\
  89.                                             CORRESPONDS TO EMPLOYEE ENTERED
  90.  
  91.  
  92. 6055    IF VAR1 <> EMPL.NO AND SEARCH.FAILURE% <> YES\
  93.     THEN GOSUB 1010
  94.     IF VAR1 > EMPL.NO OR L>RECORD.COUNT THEN X2$="NOT ON FILE":\    REMARK  IF RECORD NOT FOUND, FLASH BULLETIN TO OPERATOR
  95.     GOSUB 615:GOTO 6025
  96.  
  97.     READ #Y2,L;VAR1,VAR2,VAR3
  98.     IF VAR3=9999999 THEN\                        REMARK  IF RECORD HAS BEEN LOGICALLY DELETED, SKIP IT
  99.     L=L+1:GOTO 6055
  100.     
  101.  
  102.     IF VAR1 > EMPL.NO THEN\
  103.     X2$="NOT ON FILE":GOSUB 615:GOTO 6025
  104.  
  105. 6060    Y6=Y2:EMPL.RECORD%=L
  106.     X0=EMPL.RECORD%
  107.     GOSUB 905
  108.  
  109. 6065    X1=265:GOSUB 210                        REMARK  DISPLAY RECORD ON CRT
  110.     GOSUB 7015
  111.  
  112. 6070    X2=2                                REMARK  ENTER FIELD TO CHANGE ON RECORD
  113.     X3=0
  114.     X4=99
  115.     X2$="ENTER FIELD TO CHANGE (0=NONE; 99=DELETE)"
  116.     GOSUB 665
  117.  
  118.     IF X0 > 10 AND X0<99 THEN GOTO 6070                REMARK  REJECT INVALID FIELD NUMBER
  119.  
  120.     IF X0=0 THEN 6090                        REMARK  SAVE RECORD IF CODE=0
  121.  
  122.     IF X0=99 THEN 6150                        REMARK  BRANCH TO DELETE ROUTINE IF CODE=99
  123.  
  124.     F=X0
  125.     ON F GOSUB 5300,5310,5310,5310,5310,5320,5320,5320,5320,5320    REMARK  CHANGE FIELD INDICATED BY FIELD NUMBER ENTERED
  126.     GOTO 6070
  127.  
  128. 6090    X0=EMPL.RECORD%:GOSUB 910
  129.     FINDNEXT=YES
  130. 6095    H1(2)=H1(2)+1
  131.     K=FNEXACT(H1(1),H1(2))
  132.     GOSUB 1000                            REMARK  FIND NEXT EMPLOYEE HISTORY RECORD
  133.  
  134.  
  135. 6100    IF VAR1 <> H1(1) OR L > RECORD.COUNT\
  136.     AND SEARCH.FAILURE=0 THEN GOSUB 1010                 REMARK  SEARCH FOR NEXT RECORD ON HISTORY FILE
  137.  
  138.     IF VAR1 <> H1(1) OR L > RECORD.COUNT THEN GOTO 6025        REMARK  IF NO MORE RECORDS FOR THIS EMPLOYEE, GET NEW NUMBER
  139.     READ #Y2,L;VAR1,VAR2,VAR3
  140.     IF VAR3=9999999 THEN GOTO 6095 ELSE GOTO 6060            REMARK  IGNORE LOGICALLY DELETED HISTORY RECORDS
  141.  
  142. 6150    X2=3:X3=0:X4=0                            REMARK  IF VERIFY THE DELETE OPERATION BY ENTERING CODE
  143.     X2$="ENTER DELETE CODE"
  144.     GOSUB 665
  145.     IF X0$ = "DEL" THEN H1(3)=9999999:\
  146.     X0=EMPL.RECORD%:GOSUB 910:\
  147.     X2$="RECORD DELETED":GOSUB 615:\
  148.     GOTO 6095\
  149.     ELSE GOTO 6070                            REMARK  REJECT IMPROPER CODE AND RE-PROMPT FOR EMPLOYEE NUMBER
  150.  
  151.  
  152. 6200    GOSUB 265
  153.     X1=265:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER EMPLOYEE NUMBER TO ADD TO HISTORY FILE
  154.     FINDNEXT=0
  155.  
  156. 6210    IF X0=0 THEN GOTO 6015                        REMARK  REQUEST OPERATION CODE IF ZERO EMPLOYEE NUMBER
  157.  
  158.     DIM H1(3),H2(9)                            REMARK  RE-INITIALIZE HISTORY RECORD ARRAY
  159.     H1(1)=X0
  160.  
  161.     X1=290
  162.     GOSUB 673                            REMARK  INPUT CHECK DATE
  163.     H1(2)=X0
  164.     H1(2)=INT(X0/100)*100                        REMARK  CONVERT DATE TO YYMMDD FROM MMDDYY
  165.     H1(2)=(X0-H1(2))*10000+H1(2)/100
  166.  
  167.     K=FNEXACT(H1(1),H1(2))
  168.     GOSUB 1000                            REMARK  CHECK FOR DUPLICATE RECORD ON FILE
  169.     IF H=-1 THEN GOTO 6230
  170.     READ #Y2,L;VAR1,VAR2,VAR3
  171.  
  172.     IF VAR3 <> 9999999 THEN\                    REMARK  IF 'NEW' RECORD WAS FOUND ON THE FILE AND IT
  173.     X2$="ALREADY ON FILE":GOSUB 615:GOTO 6200\            REMARK  HASN'T BEEN DELETED, FLASH ERROR AND RE-PROMPT;
  174.     ELSE\                                REMARK  OTHERWISE, REUSE THE LOGICALLY DELETED RECORD
  175.     RE.USE.DELETED.RECORD=YES:Y6=Y2:EMPL.RECORD%=L:GOTO 6240    REMARK  TO MAINTAIN PERFECT ORDER IN THE FILE
  176.  
  177. 6230    EMPL.RECORD%=L:Y6=2
  178.  
  179. 6240    GOSUB 5300                            REMARK  INPUT CHECK NUMBER
  180.  
  181. 6245    FOR F=2 TO 5                            REMARK  ENTER HOURS AND PAY
  182.     GOSUB 5310
  183.     NEXT F
  184.  
  185. 6250    FOR F=6 TO 9                            REMARK  ENTER DEDUCTION AMOUNTS
  186.     GOSUB 5320
  187.     NEXT F
  188.  
  189. 6255    X2=2:X3=0:X4=99
  190.     X2$="ENTER FIELD TO CHANGE (0=NONE, 99=CANCEL)":GOSUB 665    REMARK  ALLOW CHANGES TO ENTERED FIELDS
  191.  
  192.     IF X0=0 THEN 6275                        REMARK  BRANCH IF NO CHANGES
  193.  
  194.     IF X0=99 THEN X2$="CANCEL":GOSUB 615:GOTO 6200            REMARK  RESTART DATA ENTRY IF CANCEL CODE WAS ENTERED
  195.  
  196.     IF X0 > 10 AND X0 < 99 THEN GOTO 6255                 REMARK  REJECT INVALID FIELD NUMBERS
  197.     F=X0
  198.     ON F GOSUB 5300,5310,5310,5310,5310,5320,5320,5320,5320,5320    REMARK  CHANGE FIELDS SPECIFIED BY OPERATOR
  199.     GOTO 6255
  200.  
  201. 6275    IF RE.USE.DELETED.RECORD=YES THEN GOTO 6285
  202.     IF EMPL.RECORD% > NEW.RECORDS% THEN GOTO 6280            REMARK  INSERT OR APPEND NEW RECORD INTO HISTORY INPUT FILE
  203.     FOR I%=NEW.RECORDS% TO EMPL.RECORD% STEP -1
  204.     READ #2,I%;LINE X0$
  205.     PRINT USING "&";#2,I%+1;X0$
  206.     NEXT I%
  207. 6280    NEW.RECORDS%=NEW.RECORDS%+1
  208.  
  209. 6285    X0=EMPL.RECORD%:GOSUB 910                    REMARK  WRITE THE NEW RECORD
  210.  
  211.     CLOSE 2:OPEN "HISTORY.DAT" RECL 102 AS 2            REMARK  CLOSE AND RE-OPEN FILE TO SAVE FCB CONTENTS
  212.     RE.USE.DELETED.RECORD=0
  213.  
  214.     GOTO 6200
  215.  
  216. 7015    X1=265:GOSUB 210                        REMARK  DISPLAY PAYROLL HISTORY RECORD ON CRT
  217.  
  218.     PRINT USING "###"; H1(1);                    REMARK  DISPLAY EMPLOYEE NUMBER
  219.  
  220.     X1=23:GOSUB 215                            REMARK  DISLPAY DATE IN MMDDYY FORMAT
  221.     X0=H1(2)*100-INT(H1(2)/10000)*(1000000-1)
  222.     GOSUB 680.5
  223.     PRINT 
  224.  
  225.     X1=22:GOSUB 215                            REMARK  DISPLAY CHECK NUMBER
  226.     PRINT USING B$; H1(3)
  227.  
  228.     FOR I%=1 TO 9                            REMARK  DISPLAY REMAINING PAYROLL HISTORY FIELDS
  229.     X1=19:GOSUB 215
  230.     PRINT USING A1$; H2(I%)
  231.     NEXT I%
  232.     RETURN 
  233.  
  234.  
  235. 9000    CLOSE 1,19                            REMARK CLOSE ALL OPENED FILES...
  236.     IF NEW.RECORDS% = 0 THEN DELETE 2:GOTO 9910
  237.     CLOSE 2
  238.  
  239. 9005    OPEN "P/R0F120.DAT" RECL 102 AS 1,"HISTORY.DAT" RECL 102 AS 2    REMARK  REOPEN  FILES NEEDED FOR MERGE
  240.     CREATE "WORKFILE.DAT" RECL 102 AS 3 BUFF 40 RECS 128
  241.  
  242.     GOSUB 9010                            REMARK  READ FIRST HISTORY RECORD
  243.     GOSUB 9020                            REMARK  READ FIRST HISTORY INPUT RECORD
  244.  
  245. 9007    IF H1(1)=WRITTEN AND I1(1)=WRITTEN THEN GOTO 9900
  246.     IF I1(1) = WRITTEN THEN GOTO 9008                REMARK  WRITE REMAINING HISTORY RECORDS IF EOF MASTER
  247.  
  248.     IF FNEXACT(H1(1),H1(2)) >= FNEXACT(I1(1),I1(2)) THEN\        REMARK  WRITE THE NEW HISTORY RECORD IF IT IS LOWER
  249.     OUTPUT.COUNT%=OUTPUT.COUNT%+1:\
  250.     PRINT #3;I1(1),I1(2),I1(3),I2(1),I2(2),I2(3),I2(4),\
  251.     I2(5),I2(6),I2(7),I2(8),I2(9):I1(1)=WRITTEN:GOSUB 9020
  252.  
  253.     IF H1(1)=WRITTEN THEN GOTO 9007
  254.  
  255. 9008    IF FNEXACT(I1(1),I1(2)) >= FNEXACT(H1(1),H1(2)) THEN\        REMARK  WRITE PAYROLL HISTORY RECORD IF IT IS LOWER
  256.     GOSUB 9030:H1(1)=WRITTEN:GOSUB 9010
  257.     GOTO 9007
  258.  
  259. 9010    IF END #1 THEN 9011                        REMARK  READ SEQUENTIALLY FROM PAYROLL HISTORY FILE
  260.     READ #1;H1(1),H1(2),H1(3),H2(1),H2(2),H2(3),H2(4),\
  261.     H2(5),H2(6),H2(7),H2(8),H2(9)
  262.     IF H1(3)=9999999 THEN GOTO 9010
  263.     RETURN
  264.  
  265. 9011    H1(1)=WRITTEN
  266.     RETURN
  267.  
  268. 9020    IF END #2 THEN 9021                        REMARK  READ FROM PAYROLL HISTORY INPUT FILE
  269.     READ #2;I1(1),I1(2),I1(3),I2(1),I2(2),I2(3),I2(4),\
  270.     I2(5),I2(6),I2(7),I2(8),I2(9)
  271.     IF I1(3)=9999999 THEN GOTO 9020
  272.     RETURN
  273.  
  274. 9021    I1(1)=WRITTEN
  275.     RETURN
  276.  
  277. 9030    PRINT #3;H1(1),H1(2),H1(3),H2(1),H2(2),H2(3),H2(4),\        REMARK  WRITE PAYROLL HISTORY RECORD TO WORKFILE
  278.     H2(5),H2(6),H2(7),H2(8),H2(9)
  279.     OUTPUT.COUNT%=OUTPUT.COUNT%+1
  280.     RETURN
  281.  
  282.  
  283.     
  284.  
  285.  
  286. 9900    DELETE 1,2                            REMARK  REPLACE HISTORY FILE WITH WORKFILE
  287.     CLOSE 3
  288.     A%=RENAME("P/R0F120.DAT","WORKFILE.DAT")
  289.     HISTORY.RECORDS=OUTPUT.COUNT%
  290.     GOSUB 720                            REMARK  WRITE OUT NEW FILE LENGTH
  291.  
  292. 9910    PRINT CLEAR.SCREEN$;\
  293.     "P/R HISTORY FILE MAINTENANCE LOADING MENU"            REMARK  DISPLAY EXIT MESSAGE
  294.     CHAIN "P/R000"
  295.