home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug045.ark / P_R070.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  3.2 KB  |  73 lines
  1.     REMARK    ***********************************************\
  2.         *   P/R070.BAS  TRANS. ACCUMULATE TO SUMMARY  *\
  3.         *    5/14/79                   9:48 AM        *\
  4.         ***********************************************
  5. %INCLUDE CURSOR
  6.     DIM T2(8),B1(5)
  7.     DEF FNEXACT(X0,X1,X2)=X0*1000+X1*10+X2
  8.     GOTO 6000
  9. 5120    IF END #Y4 THEN 5122
  10.     READ  #Y4;T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8)    REMARK  READ RECORD FROM TRANSACTION FILE
  11.     RETURN
  12. 5122    R1=99
  13.     IF R2=99 THEN RETURN                        REMARK  IF END OF FILE WAS REACHED ON TRANSACTION FILE,\
  14.                                             READ RECORDS FROM THE PAYROLL SUMMARY FILE.
  15.     READ #Y5;T2(1),T2(2),T2(3),T2(7),T2(8)
  16.     R1=0
  17.     RETURN
  18. 5130    IF END #Y5 THEN 5132
  19.     READ #Y5;B1(1),B1(2),B1(3),B1(4),B1(5)                REMARK  READ JOB POSTING VARIABLES FROM JOB POSTING FILE
  20.     IF B1(1)=9000000000 THEN B1(1)=0:GOTO 5132            REMARK  IF END OF FILE, SET FLAG
  21.     RETURN
  22. 5132    R2=99
  23.     IF R1=99 THEN RETURN
  24.                                     REMARK  IF END OF FILE REACHED ON P/R SUMMARY FILE,\
  25.                                             GET NEXT RECORD FROM THE TRANSACTION FILE.
  26.     READ #Y4;B1(1),B1(2),B1(3),X0,X0,X0,B1(4),B1(5)
  27.     R2=0
  28.     RETURN
  29. 5140    IF B1(1)=0 THEN RETURN
  30.     PRINT #Y6;B1(1),B1(2),B1(3),B1(4),B1(5)                REMARK  WRITE TRANSACTION SUMMARY RECORD
  31.     FOR I%=1 TO 5:B1(I%)=0:NEXT I%                    REMARK  RE-INITIALIZE TRANSACTION SUMMARY RECORD
  32.     RETURN
  33.  
  34.  
  35. 6000    PRINT CLEAR.SCREEN$;"P/R TRANSACTION SUMMARY":PRINT
  36.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
  37. 6000.1    IF CONSTAT%=0 THEN 6000.1
  38.     A%=CONCHAR%
  39.     IF A% = 03H THEN\
  40.     PRINT CLEAR.SCREEN$;"P/R TRANS. SUMMARY LOADING MENU":\        REMARK  IF CTRL-C WAS PRESSED, LOAD MENU
  41.     CHAIN "P/R000"
  42.     IF A% <> 0DH THEN GOTO 6000.1                    REMARK  IF <RETURN> WAS NOT HIT, WAIT FOR KEYSTROKE
  43.     PRINT:PRINT "WORKING...DO NOT INTERRUPT "
  44.     Y4=1
  45.     Y5=2
  46.     Y6=3
  47.     OPEN "P/R0F040.DAT" RECL 42 AS Y4                REMARK  OPEN PAYROLL TRANSACTION FILE
  48.     OPEN "P/R0F050.DAT" RECL 30 AS Y5                REMARK  OPEN P/R TRANSACTION SUMMARY FILE
  49.     CREATE "WORKFILE.DAT" RECL 30 AS Y6                REMARK  CREATE OUTPUT WORK FILE
  50.     GOSUB 5120                            REMARK  READ FIRST TRANSACTION RECORD
  51.     GOSUB 5130                            REMARK   ""   ""   SUMMARY RECORD
  52. 6100    IF R1=99 AND R2=99 THEN 9999                    REMARK  IF END OF BOTH FILES, END PROGRAM
  53. 6135    IF FNEXACT(B1(1),B1(2),B1(3))=FNEXACT(T2(1),T2(2),T2(3)) THEN\
  54.     B1(4)=B1(4)+T2(7):B1(5)=B1(5)+T2(8):GOSUB 5120:GOTO 6100    REMARK  IF DUPLICATE RECORD, ACCUMULATE HOURS & AMOUNTS
  55.     IF FNEXACT(B1(1),B1(2),B1(3)) < FNEXACT(T2(1),T2(2),T2(3))\
  56.     OR R1=99 THEN GOSUB 5140:GOSUB 5130                REMARK  IF SUMMARY RECORD IS LOWER,\
  57.                                             WRITE IT TO WORKFILE
  58. 6150    IF FNEXACT(B1(1),B1(2),B1(3)) > FNEXACT(T2(1),T2(2),T2(3)) \
  59.     OR R2=99 THEN\
  60.     PRINT #Y6;T2(1),T2(2),T2(3),T2(7),T2(8):GOSUB 5120        REMARK  IF TRANSACTION RECORD IS LOWER,\
  61.                                             WRITE IT OUT TO WORKFILE
  62.     GOTO 6100
  63. 9999    IF B1(1)=9000000000 OR T2(1)=9000000000 THEN 9999.5
  64.     GOSUB 5140                            REMARK  WRITE LAST TRANSACTION SUMMARY RECORD
  65.     B1(1)=9000000000
  66.     GOSUB 5140                            REMARK  WRITE TRAILER RECORD TO SUMMARY FILE
  67. 9999.5    CLOSE 1,2,3
  68.     OPEN "P/R0F050.DAT" AS 1
  69.     DELETE 1
  70.     A%=RENAME("P/R0F050.DAT","WORKFILE.DAT")                REMARK  SCRATCH SUMMARY FILE; REPLACE IT WITH WORK FILE
  71. 9999.9    PRINT "P/R TRANSACTIONS TRANSFER TO JOB POSTING"
  72.     CHAIN "P/R080"                            REMARK  LOAD MENU
  73.