home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug009.ark / GL4.ASC < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.4 KB  |  122 lines
  1. 10 ' PROGRAM NAME "GL4"
  2. 20 ' PROGRAMMED BY:    BUD SHAMBURGER        NOVEMBER 1976
  3. 30 '                   #27 RED OAK DR
  4. 40 '                   CONWAY ARK  72032
  5. 50 '                   501-327-3641
  6. 60 '
  7. 70 ' THIS PROGRAM TAKES THE DATA ENTERED FROM THE TERMINAL,
  8. 80 ' (CHECK NUMBER AND MONEY AMOUNT FROM ENCODED MICR BANK FIELD)
  9. 90 ' (TAKEN FROM THIS MONTHS CANCELLED CHECKS)
  10. 100 ' (CHANGES THE RECORD TYPE CODE TO A '3' ON THE DISK RECORD)
  11. 110 ' SORTS IT ON CK# AND TAGS THE -BANKCURR- FILE FOR CHECKS CASHED,
  12. 120 ' COMPARING ON CHECK NUMBER AND MONEY AMOUNT.
  13. 130 ' -BANKCURR- FILE IS ON DR1. 500 ENTRIES MAX FROM TERMINAL
  14. 140 '
  15. 150 '*******************************************************************
  16. 160 '
  17. 170 CLEAR 1000
  18. 180 PRINT "TAG CHECKS CASHED - 500 ENTRIES MAX"
  19. 190 DIM B(500)
  20. 200 DIM BB$(500)
  21. 210 JS=4
  22. 220 REC=200
  23. 230 INPUT "ENTER -Y- TO MOUNT THE FILE";WY$
  24. 240 IF WY$<>"Y" THEN 280
  25. 260 PRINT "** ENTER ** -T- TO TERMINATE INPUT"
  26. 270 PRINT
  27. 280 INPUT "ENTER REPORT DATE AS MOYR";DT$
  28. 290 H1$="  CHEK   AMOUNT"
  29. 300 H2$="  NMBR $$$.$$$.$$"
  30. 310 PRINT H1$:PRINT H2$
  31. 320 FOR J=1 TO 2
  32. 330 INPUT A$
  33. 340 IF MID$(A$,1,1)="T" THEN 520'    LAST ENTRY MADE - GO SORT ON CHECK#
  34. 350 B=LEN(A$)
  35. 360 IF B<>15 THEN 490
  36. 370 IF MID$(A$,5,1)<>" " THEN 490        'EDIT
  37. 380 IF MID$(A$,9,1)<>"." AND MID$(A$,9,1)<>" " THEN 490' EDIT
  38. 390 IF MID$(A$,13,1)<>"." THEN 490
  39. 400 I=I+1
  40. 410 C$=MID$(A$,1,4):
  41. 420 C=VAL(C$)
  42. 430 B(I)=C
  43. 440 D$="-"+MID$(A$,6,3)+MID$(A$,10,6)
  44. 450 BB$(I)=D$
  45. 460 NEXT J
  46. 470 IF I>500 THEN PRINT "TOO MANY ENTRIES":STOP
  47. 480 GOTO 290
  48. 490 PRINT CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7)
  49. 500 PRINT H1$:PRINT H2$'   EDIT ERROR REPEAT LINE
  50. 510 GOTO 330
  51. 520 N=I
  52. 530 GOSUB 1020'             GO SORT ON CHECK#
  53. 540 OPEN "R",1,"BANKCURR"
  54. 550 GOSUB 770'             GO GET 1ST DISK RECORD
  55. 560 FOR I=1 TO N
  56. 570 DCK=VAL(DCK$)
  57. 580 IF B(I)=DCK THEN 620'  GO CHECK AMOUNT & TAG
  58. 590 IF B(I)<DCK THEN 740'  NOT IN DISK FILE ERROR
  59. 600 GOSUB 770'             O GET NEXT DISK RECORD
  60. 610 GOTO 570
  61. 620 IF BB$(I)=DOL$ THEN 650
  62. 630 PRINT "AMOUNT UNEQUAL ";B(I),BB$(I),DOL$
  63. 640 PRINT "TAGGED ANYWAY"
  64. 650 DSK$=DREC$(J)
  65. 660 MID$(DSK$,27,4)=DT$
  66. 670 MID$(DSK$,42,1)="3" 
  67. 680 LSET DREC$(J)=DSK$
  68. 690 PUT #1,REC
  69. 700 NEXT I
  70. 710 CLOSE
  71. 720 PRINT "EOJ"
  72. 730 LOAD "GLMENU",R
  73. 740 PRINT "NOT IN DISK FILE";B(I)
  74. 750 GOTO 700
  75. 760 '
  76. 770 ' THIS ROUTINE GETS THE DISK RECORD
  77. 780 '
  78. 790 IF JS=4 THEN 900
  79. 800 FOR J=JS TO 3
  80. 810 FIELD #1, (J-1)*42 AS D$,42 AS DREC$(J)
  81. 820 IF MID$(DREC$(J),1,3)="EOF" THEN 950'   END OF DISK FILE
  82. 830 IF MID$(DREC$(J),42,1)<>"2" THEN 890'   BYPASS BAL FWD & BAD RECORDS
  83. 840 IF MID$(DREC$(J),11,1)<>"C" THEN 890'  BYPASS VOUCHERS
  84. 850 DCK$=MID$(DREC$(J),12,4)
  85. 860 DOL$=MID$(DREC$(J),31,1)+MID$(DREC$(J),33,9)
  86. 870 JS=J+1
  87. 880 RETURN
  88. 890 NEXT J
  89. 900 REC=REC+1
  90. 910 IF REC>400 THEN 950
  91. 920 GET #1,REC
  92. 930 JS=1
  93. 940 GOTO 790
  94. 950 IF I>N THEN 710
  95. 960 P=I
  96. 970 FOR I=P TO N
  97. 980 PRINT "NO DISK RECORD FOR ";B(I)
  98. 990 NEXT I
  99. 1000 GOTO 710
  100. 1010 '
  101. 1020 ' THIS ROUTINE SORTS THE TERMINAL ENTRIES ON CHECK#
  102. 1030 '
  103. 1040 M=N
  104. 1050 M=INT(M/2)
  105. 1060 EXH=0
  106. 1070 IF M=0 THEN 1210  ' END OF SORT - GOTO NEXT ROUTINE
  107. 1080 K=N-M
  108. 1090 Q=1
  109. 1100 I=Q
  110. 1110 L=I+M
  111. 1120 IF B(I)<=B(L) THEN 1180
  112. 1130 SWAP B(I),B(L)
  113. 1140 SWAP BB$(I),BB$(L)
  114. 1150 EXH=EXH+1
  115. 1160 I=I-M
  116. 1170 IF I>=1 THEN 1110
  117. 1180 Q=Q+1
  118. 1190 IF Q>K THEN PRINT "M = ";M;" SWAPS MADE = ";EXH:GOTO 1050
  119. 1200 GOTO 1100
  120. 1210 RETURN'       END OF SORT
  121. 1220 END
  122.