10  REM*** THIS PROGRAM SORTS FILE 'MASTER' INTO
20  REM***    1.) DIV/LOC SEQUENCE (FILE 'LOCSRT')
30  REM***    2.) NAME SEQUENCE (FILE 'NAMSRT')
40  REM***
50  DIM F$[72],A$[72],B$[72],C$[72],X$[72],Y$[72],Z$[72]
60  DIM U[100],L[100]
65  DIM H[2,2]
70  FILES *,*,*
80  F9=3
90  REM*** ASSIGN FILES
100  F$="MASTER"
110  F=1
120  GOSUB 830
130  F$="WORK"
140  F=3
150  GOSUB 830
160  PRINT "1=DIV/LOC, 2=NAMES, 3=BOTH";
170  INPUT O9
180  GOTO O9 OF 200,230,260
190  GOTO 160
200  REM*** DIV/LOC
210  I1=I2=1
220  GOTO 290
230  REM*** NAMES
240  I1=I2=2
250  GOTO 290
260  REM*** BOTH
270  I1=1
280  I2=2
290  REM*** COUNT ITEMS, PUT IN FILE 'WORK'
300  PRINT "COUNTING ENTRIES"
310  N9=0
320  IF  END #1 THEN 400
330  IF  END #3 THEN 380
340  READ #1;X$,X1,X2,X3,X4,X5
350  N9=N9+1
360  PRINT #3,N9;X$,X1,X2,X3,X4,X5
370  GOTO 340
380  PRINT "FILE 'WORK' IS TOO SMALL. KILL AND RE-OPEN TO A LARGER SIZE."
390  STOP 
400  PRINT N9"RECORDS BEING SORTED"
410  FOR I0=I1 TO I2
420  GOTO I0 OF 430,560
430  REM*** 'LOCSRT' IS DESTINATION FILE FOR DIV/LOC SORT
440  F$="LOCSRT"
450  F=2
460  GOSUB 830
470  REM*** PARAMETERS TO DEFINE MULTIPLE LEVEL SORT
480  REM*** (ID/SYS WITHIN DIV/LOC)
490  N=2
500  H[1,1]=26
510  H[1,2]=31
520  H[2,1]=1
530  H[2,2]=5
540  PRINT "SORTING ON DIV/LOC - BEGIN AT"TIM(1);TIM(0)
550  GOTO 680
560  REM*** 'NAMSRT' IS DESTINATION FILE FOR NAME SORT
570  F$="NAMSRT"
580  F=2
590  GOSUB 830
600  REM*** PARAMETERS TO DEFINE MULTIPLE LEVEL SORT
610  REM*** (ID/SYS WITHIN NAME)
620  N=2
630  H[1,1]=6
640  H[1,2]=25
650  H[2,1]=1
660  H[2,2]=5
670  PRINT "SORTING ON NAMES - BEGIN AT"TIM(1);TIM(0)
680  GOSUB 1070
690  PRINT "END SORT -"TIM(1);TIM(0)
700  PRINT "COPYING FILE 'WORK' TO FILE "F$
710  READ #3,1
720  PRINT #2,1; END 
730  IF  END #3 THEN 810
740  IF  END #2 THEN 760
750  GOTO 780
760  PRINT "FILE "F$" IS TOO SMALL. KILL AND RE-OPEN TO A LARGER SIZE."
770  STOP 
780  READ #3;X$,X1,X2,X3,X4,X5
790  PRINT #2;X$,X1,X2,X3,X4,X5, END 
800  GOTO 780
810  NEXT I0
820  STOP 
830  REM*** ASSIGN FILES
840  ASSIGN F$,F,R8
850  IF R8=0 THEN 880
860  PRINT "FILE "F$" STATUS ="R8
870  STOP 
880  RETURN 
890  REM*** GOSUB TO CONFIGURE SORT FIELD A$ FROM X$.
900  A$=" "
910  B9=1
920  FOR I=1 TO N
930  E9=B9+H[I,2]-H[I,1]
940  A$[B9,E9]=X$[H[I,1],H[I,2]]
950  B9=E9+1
960  NEXT I
970  RETURN 
980  REM*** GOSUB TO CONFIGURE SORT FIELD B$ FROM Y$.
990  B$=" "
1000  B9=1
1010  FOR I=1 TO N
1020  E9=B9+H[I,2]-H[I,1]
1030  B$[B9,E9]=Y$[H[I,1],H[I,2]]
1040  B9=E9+1
1050  NEXT I
1060  RETURN 
1070  REM*** SORT ROUTINE - TSB BILLING
1080  REM*** USES A.C.M. ALGORITHM NO. 347 (VOL 12/NO.3/MAR 1969/PG 186-187)
1090  REM*** STRING (LEN=72) AND 5 NUMERICS IN EACH PHYSICAL RECORD
1100  REM*** PASS IN N9=NO. ITEMS TO BE SORTED.
1110  REM*** PASS IN F9=INDEX OF FILE TO BE SORTED.
1120  REM***
1130  REM***
1140  IF  END #F9 THEN 1160
1150  PRINT #F9,N9+1; END 
1160  REM***
1170  M8=1
1180  I8=I9=1
1190  J8=N9
1200  IF I8 >= J8 THEN 1940
1210  K8=I8
1220  I7=(J8+I8)/2
1230  READ #F9,I7;Y$,Y1,Y2,Y3,Y4,Y5
1240  GOSUB 980
1250  READ #F9,I8;X$,X1,X2,X3,X4,X5
1260  GOSUB 890
1270  IF A$ <= B$ THEN 1370
1280  PRINT #F9,I8;Y$,Y1,Y2,Y3,Y4,Y5
1290  PRINT #F9,I7;X$,X1,X2,X3,X4,X5
1300  Y$=X$
1310  B$=A$
1320  Y1=X1
1330  Y2=X2
1340  Y3=X3
1350  Y4=X4
1360  Y5=X5
1370  L8=J8
1380  READ #F9,J8;X$,X1,X2,X3,X4,X5
1390  GOSUB 890
1400  IF A$ >= B$ THEN 1670
1410  PRINT #F9,J8;Y$,Y1,Y2,Y3,Y4,Y5
1420  PRINT #F9,I7;X$,X1,X2,X3,X4,X5
1430  Y$=X$
1440  B$=A$
1450  Y1=X1
1460  Y2=X2
1470  Y3=X3
1480  Y4=X4
1490  Y5=X5
1500  READ #F9,I8;X$,X1,X2,X3,X4,X5
1510  GOSUB 890
1520  IF A$ <= B$ THEN 1670
1530  PRINT #F9,I7;X$,X1,X2,X3,X4,X5
1540  PRINT #F9,I8;Y$,Y1,Y2,Y3,Y4,Y5
1550  Y$=X$
1560  B$=A$
1570  Y1=X1
1580  Y2=X2
1590  Y3=X3
1600  Y4=X4
1610  Y5=X5
1620  GOTO 1670
1630  READ #F9,K8;X$,X1,X2,X3,X4,X5
1640  GOSUB 890
1650  PRINT #F9,K8;Z$,Z1,Z2,Z3,Z4,Z5
1660  PRINT #F9,L8;X$,X1,X2,X3,X4,X5
1670  L8=L8-1
1680  READ #F9,L8;X$,X1,X2,X3,X4,X5
1690  GOSUB 890
1700  IF A$>B$ THEN 1670
1710  Z$=X$
1720  C$=A$
1730  Z1=X1
1740  Z2=X2
1750  Z3=X3
1760  Z4=X4
1770  Z5=X5
1780  K8=K8+1
1790  READ #F9,K8;X$,X1,X2,X3,X4,X5
1800  GOSUB 890
1810  IF A$<B$ THEN 1780
1820  IF K8 <= L8 THEN 1630
1830  IF (L8-I8) <= (J8-K8) THEN 1890
1840  L[M8]=I8
1850  U[M8]=L8
1860  I8=K8
1870  M8=M8+1
1880  GOTO 1980
1890  L[M8]=K8
1900  U[M8]=J8
1910  J8=L8
1920  M8=M8+1
1930  GOTO 1980
1940  M8=M8-1
1950  IF M8=0 THEN 2180
1960  I8=L[M8]
1970  J8=U[M8]
1980  IF (J8-I8) >= I9 THEN 1210
1990  IF I8=I9 THEN 1200
2000  I8=I8-1
2010  I8=I8+1
2020  IF I8=J8 THEN 1940
2030  READ #F9,I8+1;Y$,Y1,Y2,Y3,Y4,Y5
2040  GOSUB 980
2050  READ #F9,I8;X$,X1,X2,X3,X4,X5
2060  GOSUB 890
2070  IF A$ <= B$ THEN 2010
2080  K8=I8
2090  READ #F9,K8;X$,X1,X2,X3,X4,X5
2100  GOSUB 890
2110  PRINT #F9,K8+1;X$,X1,X2,X3,X4,X5
2120  K8=K8-1
2130  READ #F9,K8;X$,X1,X2,X3,X4,X5
2140  GOSUB 890
2150  IF B$<A$ THEN 2090
2160  PRINT #F9,K8+1;Y$,Y1,Y2,Y3,Y4,Y5
2170  GOTO 2010
2180  RETURN 
2190  END 
