10 REM- PROGRAM NAME:"EXP047"
20 REM - PROGRAM CONSOLIDATES PAYROLL TRANSACTIONS
     AND ADDS THEM TO "TRANS.NEW" FILE. 
30 REM PAYROLL RECORDS(DF:TRANS.PAY) MUST BE SORTED BEFORE
     RUNNING THIS PROGRAM.
35 REM- AFTER RECS  HAVE BEEN ADDED, DF:TRANS.NEW MUST
     BE RESORTED
40 OPEN "DF:TRANS.PAY" AS FILE 1
50 DIM #1,X$(500)=46
60 OPEN "DF:TRANS.NEW" AS FILE 2
70 DIM #2,T$(5000)=46
80 FOR J%=1 TO 5000
90 LET B$=T$(J%)
100 IF LEFT(B$,7)="9999999" GOTO 120
110 NEXT J%
120 LET K%=K%+1
130 LET A$=X$(K%)
132 IF LEFT(A$,7)="9999999" GOTO 700
135 LET P=P+VAL(MID(A$,35,7))
150 IF LEFT(X$(K%+1),7)<>LEFT(A$,7) GOTO 300
170 GOTO 120
300 LET X9$=NUM$(P)
310 GOSUB 600
320 LET P$=SPACE$(M)+X1$
330 LET T$(J%)=LEFT(A$,34)+P$+MID(A$,42,5)
340 LET J%=J%+1
350 LET P=0
355 GOTO 120
600 LET A=LEN(X9$)
605 LET N=1
610 LET A=A-1
615 IF A>7 GOTO 645
620 LET X1$=MID(X9$,N,A)
630 LET M=7-A
631 IF A>7 THEN LET M=0
640 RETURN
645 IF LEFT(X9$,1)<>" " THEN GOTO 649
647 LET N=N+1
648 LET A=A-1 : GOTO 615
649 STOP
700 LET T$(J%)=A$
710 CLOSE 1,2
715 PRINT "SORT DF:TRANS.NEW NEXT"
720 CHAIN "EXP002"
730 END