home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug009.ark / GL3.ASC < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.4 KB  |  106 lines
  1. 10 ' PROGRAM NAME "GL3"
  2. 190 CLEAR 1500
  3. 200 JS=4
  4. 210 KS=4
  5. 220 A3=200
  6. 230 INPUT "ENTER -Y- TO MOUNT THE FILES";WY$
  7. 240 IF WY$<>"Y" THEN 270
  8. 250 UNLOAD 0,1
  9. 260 MOUNT 0,1
  10. 270 OPEN "R",1,"LEDGER",0
  11. 280 OPEN "R",2,"BANKBKUP",1
  12. 290 OPEN "R",3,"BANKCURR",1
  13. 300 PRINT "* BEFORE RUNNING THIS PROGRAM - COPY BANKCURR TO BANKBKUP * "
  14. 310 PRINT "MERGE -LEDGER-DR0 AND -BANKBKUP-DR1 AND CUT NEW -BANKCURR-DR1"
  15. 320 INPUT "ENTER REPORT DATE AS MOYR";DT$
  16. 330 GOSUB 530
  17. 340 GOSUB 680
  18. 350 GOSUB 880'               GO GET 1ST BANKBKUP RECORD FROM FILE
  19. 360 IF C1$<C2$ THEN 450
  20. 370 IF C1$=C2$ THEN PRINT "DUPLICATE CTL#";C1$,C2$:STOP
  21. 380 IF KEF=1 AND JEF=1 THEN 1220'  GO WRITE LAST BANKCURR & EOF
  22. 390 DUM$=K2$(K)'             MOVE BANKBKUP TO OUTPUT AREA
  23. 400 GOSUB 1080'               GO CHECK FOR PUT TO BANKCURR
  24. 410 IF KEF=1 THEN 450'            ALL OF BANKBKUP MERGED IN
  25. 420 GOSUB 880'                GO GET NEXT BANKBKUP RECORD FROMFILE
  26. 430 IF JEF=1 THEN 380'            ALL OF LEDGER MERGED IN
  27. 440 GOTO 360
  28. 450 IF KEF=1 AND JEF=1 THEN 1220'  GO WRITE LAST BANKCURR & EOF
  29. 460 DUM$=J1$(J)'              MOVE LEDGER TO OUTPUT AREA
  30. 470 GOSUB 1080'                GO CHECK FOR PUT TO BANKCURR
  31. 480 IF JEF=1 THEN 380'            ALL OF LEDGER MERGED IN
  32. 490 GOSUB 680'                GO GET NEXT LEDGER RECORD FROM FILE
  33. 500 IF KEF=1 THEN 450'            ALL OF BANKBKUP MERGED IN
  34. 510 GOTO 360
  35. 560 GET #1,2037
  36. 570 FOR I=1 TO 16
  37. 580 FIELD #1, (I-1)*8 AS D$,8 AS DD$(I)
  38. 590 IF DT$=MID$(DD$(I),1,4) THEN 620
  39. 600 NEXT I
  40. 610 PRINT "FILE START NOT IN TABLE":STOP
  41. 620 A1$=MID$(DD$(I),5,4)
  42. 630 A1=VAL(A1$)
  43. 640 RETURN
  44. 650 '
  45. 660 ' THIS ROUTINE GETS THE PROPER LEDGER RECORD
  46. 670 '
  47. 680 IF JS=4 THEN 830
  48. 690 FOR J=JS TO 3
  49. 700 FIELD #1, (J-1)*42 AS J$,42 AS J1$(J)
  50. 710 IF MID$(J1$(J),1,3)="EOF" AND JW=1 THEN JEF=1:GOTO 380' EOF LEDGER
  51. 720 JDT$=MID$(J1$(J),1,2)+MID$(J1$(J),5,2)
  52. 730 IF DT$<>JDT$ THEN 810'      NOT CURRENT FILE YET
  53. 740 JW=1                 '      START OF CURRENT FILE
  54. 750 IF MID$(J1$(J),7,4)<>"1110" THEN 810'   NOT BANK RECORD
  55. 760 IF MID$(J1$(J),41,1)="*" THEN 810'    BYPASS BAD RECORD
  56. 770 IF MID$(J1$(J),42,1)="1" THEN JS=J+1:DUM$=J1$(J):GOTO 350
  57. 780 C1$=MID$(J1$(J),11,5)
  58. 790 JS=J+1               '      THIS IS THE PROPER RECORD
  59. 800 RETURN
  60. 810 NEXT J
  61. 820 IF A1=2037 THEN PRINT "FILEND ERROR-LEDGER":STOP
  62. 830 GET #1,A1
  63. 840 JS=1
  64. 850 A1=A1+1
  65. 860 GOTO 680
  66. 910 IF KS=4 THEN 1020
  67. 920 FOR K=KS TO 3
  68. 930 FIELD #2, (K-1)*42 AS K$,42 AS K2$(K)
  69. 940 IF MID$(K2$(K),1,3)="EOF" THEN KEF=1:GOTO 450' END OF BANKBKUP
  70. 950 IF MID$(K2$(K),42,1)<>"2" THEN 1010' DELETE THESE RECORDS FROM FILE
  71. 960 IF MID$(K2$(K),11,1)="V" THEN 1010' DELETE VOUCHERS FROM FILE
  72. 970 IF MID$(K2$(K),16,4)="VOID" THEN 1010' DELETE VOID CKS FROM FILE
  73. 980 C2$=MID$(K2$(K),11,5)
  74. 990 KS=K+1                            
  75. 1000 RETURN
  76. 1010 NEXT K
  77. 1020 A2=A2+1
  78. 1030 IF A2=201 THEN PRINT "FILEND ERROR-BANKUP":STOP
  79. 1040 GET #2,A2
  80. 1050 KS=1
  81. 1060 GOTO 910
  82. 1070 '
  83. 1080 ' THIS ROUTINE WRITES OUT THE BANKCURR FILE IN 201-400#R1
  84. 1090 '
  85. 1100 FIELD #3,128 AS L4$
  86. 1110 L3$=L3$+DUM$
  87. 1120 L=L+1
  88. 1130 IF L=3 THEN 1150
  89. 1140 RETURN
  90. 1150 A3=A3+1
  91. 1160 IF A3>400 THEN PRINT "FILEND ERR BANKCURR":STOP
  92. 1170 LSET L4$=L3$
  93. 1180 PUT #3,A3
  94. 1190 L3$=BLK$
  95. 1200 L=0
  96. 1210 GOTO 1140
  97. 1220 L3$=L3$+"EOF"    
  98. 1230 LSET L4$=L3$
  99. 1240 A3=A3+1
  100. 1250 IF A3>400 THEN 1160
  101. 1260 PUT #3,A3        
  102. 1270 CLOSE
  103. 1280 PRINT "EOJ"
  104. 1290 LOAD "GLMENU",0,R
  105. 1300 END
  106.