home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug045.ark / P_R190.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  3.2 KB  |  102 lines
  1.     REMARK    *******************************************\
  2.         *   P/R190.BAS   PAYROLL HISTORY UPDATE   *\
  3.         *    4/6/79                     6:25 PM   *\
  4.         *******************************************
  5.  
  6. %INCLUDE CURSOR
  7.  
  8.     DIM S(96),R$(5),R1(2),R2(5),H1(3),H2(9),I1(3),I2(9)
  9.     DIM G2$(5),G3(5)
  10.  
  11.     DEF FNR(Z1)=INT(Z1*100+.5)/100                    REMARK  ROUNDING FUNCTION
  12.  
  13.     DEF FNEXACT(X0,X1)=X0*1000000+X1                REMARK  FUNCTION FOR KEY COMPARISON
  14.  
  15.     WRITTEN=999999                            REMARK  SET 'RECORD WRITTEN' FLAG
  16.  
  17.     GOTO 6000
  18.  
  19. %INCLUDE GENINFO
  20. %INCLUDE MSTRIN
  21.  
  22. 1900    PRINT #Y4;H1(1),H1(2),H1(3),H2(1),H2(2),H2(3),H2(4),\        REMARK  WRITE HISTORY RECORD ON WORKFILE
  23.     H2(5),H2(6),H2(7),H2(8),H2(9)
  24.     OUTPUT.COUNT%=OUTPUT.COUNT%+1
  25.     RETURN
  26.  
  27.  
  28. 2000    IF END #Y2 THEN 2010
  29.     READ #Y2;H1(1),H1(2),H1(3),H2(1),H2(2),H2(3),H2(4),\        REMARK  READ PAYROLL HISTORY RECORD
  30.     H2(5),H2(6),H2(7),H2(8),H2(9)
  31.     RETURN
  32.  
  33. 2010    H1(1)=WRITTEN
  34.     RETURN
  35.  
  36. 5000    IF J1% > MSTR.RECORDS THEN I1(1)=WRITTEN:RETURN            REMARK  READ SEQUENTIALLY FROM EMPLOYEE MASTER FILE
  37.     X0=J1%
  38.     GOSUB 745                            REMARK  GET EMPLOYEE RECORD
  39.     J1%=J1%+1
  40.     IF S(5)=0 OR S(1)=0 OR R2(1)=99 THEN GOTO 5000            REMARK  IF NO CHECK WAS WRITTEN FOR THIS EMPLOYEE, SKIP IT
  41.  
  42.     IF S(4)=0 THEN S(4)=G3(1)
  43.     I1(1)=S(1)
  44.  
  45.     I1(2)=INT(S(4)/100)                        REMARK  CONVERT LAST CHECK DATE TO YYMMDD FORMAT
  46.     I1(2)=(S(4)-I1(2)*100)*10000+I1(2)
  47.  
  48.     I1(3)=S(5)                            REMARK  SET REMAINING PAYROLL HISTORY FIELDS
  49.     I2(1)=S(73)+S(77)
  50.     I2(2)=S(75)
  51.     I2(3)=S(80)
  52.     I2(4)=S(83)
  53.     FOR I%=5 TO 8
  54.     I2(I%)=S(80+I%)
  55.     NEXT I%
  56.     I2(9)=S(90)
  57.     RETURN
  58.  
  59.  
  60. 6000    PRINT CLEAR.SCREEN$;"PAYROLL HISTORY UPDATE"            REMARK  DISPLAY PROGRAM I.D.
  61.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
  62. 6030    IF CONSTAT%=0 THEN GOTO 6030                    REMARK  WAIT FOR KEYBOARD DEPRESSION
  63.     A%=CONCHAR%
  64.     IF A%= 03H THEN GOTO 9010                    REMARK  IF CTRL-C WAS HIT, EXIT FFROM PROGRAM
  65.     IF A% <> 0DH THEN GOTO 6030
  66.     Y9=3
  67.     Y2=2
  68.     Y4=4
  69.     OPEN "P/R0F110.DAT" RECL 1150 AS 1
  70.     OPEN "P/R0F120.DAT" RECL 102 AS 2
  71.     OPEN "G/I0F010.DAT" RECL 200 AS Y9
  72.     CREATE "WORKFILE.DAT" RECL 102 AS 4 BUFF 40 RECS 128
  73.     GOSUB 700                            REMARK  LOAD SYSTEM GENERAL INFORMATION
  74.     J1%=1
  75.     GOSUB 5000                            REMARK  GET FIRST EMPLOYEE RECORD FOR UPDATE
  76.     GOSUB 2000                            REMARK  GET FIRST PAYROLL HISTORY RECORD
  77.  
  78.  
  79. 6035    IF H1(1)=WRITTEN AND I1(1)=WRITTEN THEN GOTO 9000        REMARK  END PROGRAM IF EOF ON BOTH FILES
  80.  
  81.     IF I1(1) = WRITTEN THEN GOTO 6050                REMARK  WRITE REMAINING HISTORY RECORDS IF EOF MASTER
  82.  
  83.     IF FNEXACT(H1(1),H1(2)) >= FNEXACT(I1(1),I1(2)) THEN\        REMARK  WRITE THE NEW HISTORY RECORD IF IT IS LOWER
  84.     OUTPUT.COUNT%=OUTPUT.COUNT%+1:\
  85.     PRINT #Y4;I1(1),I1(2),I1(3),I2(1),I2(2),I2(3),I2(4),\
  86.     I2(5),I2(6),I2(7),I2(8),I2(9):I1(1)=WRITTEN:GOSUB 5000
  87.  
  88.     IF H1(1)=WRITTEN THEN GOTO 6035
  89.  
  90. 6050    IF FNEXACT(I1(1),I1(2)) >= FNEXACT(H1(1),H1(2)) THEN\        REMARK  WRITE PAYROLL HISTORY RECORD IF IT IS LOWER
  91.     GOSUB 1900:H1(1)=WRITTEN:GOSUB 2000
  92.     GOTO 6035
  93.  
  94. 9000    DELETE 2                            REMARK  REPLACE HISTORY FILE WITH WORKFILE
  95.     CLOSE 4
  96.     A%=RENAME("P/R0F120.DAT","WORKFILE.DAT")
  97.     HISTORY.RECORDS=OUTPUT.COUNT%
  98.     GOSUB 720                            REMARK  WRITE OUT NEW FILE LENGTH
  99.  
  100. 9010    PRINT CLEAR.SCREEN$;"P/R HISTORY UPDATE LOADING MENU"        REMARK  DISPLAY EXIT MESSAGE
  101.     CHAIN "P/R000"
  102.