10 ' PROGRAM NAME "GL4"
20 ' PROGRAMMED BY:    BUD SHAMBURGER        NOVEMBER 1976
30 '                   #27 RED OAK DR
40 '                   CONWAY ARK  72032
50 '                   501-327-3641
60 '
70 ' THIS PROGRAM TAKES THE DATA ENTERED FROM THE TERMINAL,
80 ' (CHECK NUMBER AND MONEY AMOUNT FROM ENCODED MICR BANK FIELD)
90 ' (TAKEN FROM THIS MONTHS CANCELLED CHECKS)
100 ' (CHANGES THE RECORD TYPE CODE TO A '3' ON THE DISK RECORD)
110 ' SORTS IT ON CK# AND TAGS THE -BANKCURR- FILE FOR CHECKS CASHED,
120 ' COMPARING ON CHECK NUMBER AND MONEY AMOUNT.
130 ' -BANKCURR- FILE IS ON DR1. 500 ENTRIES MAX FROM TERMINAL
140 '
150 '*******************************************************************
160 '
170 CLEAR 1000
180 PRINT "TAG CHECKS CASHED - 500 ENTRIES MAX"
190 DIM B(500)
200 DIM BB$(500)
210 JS=4
220 REC=200
230 INPUT "ENTER -Y- TO MOUNT THE FILE";WY$
240 IF WY$<>"Y" THEN 280
260 PRINT "** ENTER ** -T- TO TERMINATE INPUT"
270 PRINT
280 INPUT "ENTER REPORT DATE AS MOYR";DT$
290 H1$="  CHEK   AMOUNT"
300 H2$="  NMBR $$$.$$$.$$"
310 PRINT H1$:PRINT H2$
320 FOR J=1 TO 2
330 INPUT A$
340 IF MID$(A$,1,1)="T" THEN 520'    LAST ENTRY MADE - GO SORT ON CHECK#
350 B=LEN(A$)
360 IF B<>15 THEN 490
370 IF MID$(A$,5,1)<>" " THEN 490        'EDIT
380 IF MID$(A$,9,1)<>"." AND MID$(A$,9,1)<>" " THEN 490' EDIT
390 IF MID$(A$,13,1)<>"." THEN 490
400 I=I+1
410 C$=MID$(A$,1,4):
420 C=VAL(C$)
430 B(I)=C
440 D$="-"+MID$(A$,6,3)+MID$(A$,10,6)
450 BB$(I)=D$
460 NEXT J
470 IF I>500 THEN PRINT "TOO MANY ENTRIES":STOP
480 GOTO 290
490 PRINT CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7)
500 PRINT H1$:PRINT H2$'   EDIT ERROR REPEAT LINE
510 GOTO 330
520 N=I
530 GOSUB 1020'             GO SORT ON CHECK#
540 OPEN "R",1,"BANKCURR"
550 GOSUB 770'             GO GET 1ST DISK RECORD
560 FOR I=1 TO N
570 DCK=VAL(DCK$)
580 IF B(I)=DCK THEN 620'  GO CHECK AMOUNT & TAG
590 IF B(I)<DCK THEN 740'  NOT IN DISK FILE ERROR
600 GOSUB 770'             O GET NEXT DISK RECORD
610 GOTO 570
620 IF BB$(I)=DOL$ THEN 650
630 PRINT "AMOUNT UNEQUAL ";B(I),BB$(I),DOL$
640 PRINT "TAGGED ANYWAY"
650 DSK$=DREC$(J)
660 MID$(DSK$,27,4)=DT$
670 MID$(DSK$,42,1)="3" 
680 LSET DREC$(J)=DSK$
690 PUT #1,REC
700 NEXT I
710 CLOSE
720 PRINT "EOJ"
730 LOAD "GLMENU",R
740 PRINT "NOT IN DISK FILE";B(I)
750 GOTO 700
760 '
770 ' THIS ROUTINE GETS THE DISK RECORD
780 '
790 IF JS=4 THEN 900
800 FOR J=JS TO 3
810 FIELD #1, (J-1)*42 AS D$,42 AS DREC$(J)
820 IF MID$(DREC$(J),1,3)="EOF" THEN 950'   END OF DISK FILE
830 IF MID$(DREC$(J),42,1)<>"2" THEN 890'   BYPASS BAL FWD & BAD RECORDS
840 IF MID$(DREC$(J),11,1)<>"C" THEN 890'  BYPASS VOUCHERS
850 DCK$=MID$(DREC$(J),12,4)
860 DOL$=MID$(DREC$(J),31,1)+MID$(DREC$(J),33,9)
870 JS=J+1
880 RETURN
890 NEXT J
900 REC=REC+1
910 IF REC>400 THEN 950
920 GET #1,REC
930 JS=1
940 GOTO 790
950 IF I>N THEN 710
960 P=I
970 FOR I=P TO N
980 PRINT "NO DISK RECORD FOR ";B(I)
990 NEXT I
1000 GOTO 710
1010 '
1020 ' THIS ROUTINE SORTS THE TERMINAL ENTRIES ON CHECK#
1030 '
1040 M=N
1050 M=INT(M/2)
1060 EXH=0
1070 IF M=0 THEN 1210  ' END OF SORT - GOTO NEXT ROUTINE
1080 K=N-M
1090 Q=1
1100 I=Q
1110 L=I+M
1120 IF B(I)<=B(L) THEN 1180
1130 SWAP B(I),B(L)
1140 SWAP BB$(I),BB$(L)
1150 EXH=EXH+1
1160 I=I-M
1170 IF I>=1 THEN 1110
1180 Q=Q+1
1190 IF Q>K THEN PRINT "M = ";M;" SWAPS MADE = ";EXH:GOTO 1050
1200 GOTO 1100
1210 RETURN'       END OF SORT
1220 END