10  REM ***  HP TIME-SHARED BASIC PROGRAM LIBRARY  *********************
11  REM
12  REM         STGSRT:  SORTS STRINGS FROM FILES
13  REM
14  REM         36145 (A107) REV A -- 7/71
15  REM
16  REM ***  CONTRIBUTED PROGRAM  **************************************
17  REM
100  REM  PROGRAM STGSRT SORTS STRINGS OR SUBSTRINGS AMONG FILE RECORDS
110  REM  AND CREATES AN ORDERED DIRECTORY OF THE RECORDS.  A BUCKET
120  REM  SORT IS USED, PACKING THE DIRECTORY INTO A MATRIX WHICH IS
130  REM  THEN WRITTEN ON A SECOND FILE.  EITHER A NUMERIC OR FULL ASCII
140  REM  SORT MAY BE SPECIFIED.
150  REM  VERSION 7/15/71 -- WES
160  REM
170  FILES DATABS,DIREC
180  DIM A$[6],B$[4],C$[11],D$[72]
190  DIM Z$[72]
200  DIM X$[63]
210  DIM B[63],C[63]
220  DIM A[1000],E[1000]
230  R=1000
240  MAT A=ZER
250  MAT B=ZER
260  MAT C=ZER
270  MAT E=ZER
280  FOR J=1 TO R
290  READ #1,J;A$
300  IF  END #1 THEN 330
310  A[J]=J
320  NEXT J
330  R1=J-1
340  MAT E=A
350  PRINT "NUMBER OF DATA RECORDS IN FILE IS "R1
360  PRINT "WHAT IS RELATIVE POSITION OF STRING WITHIN RECORD UPON WHICH TO"
370  PRINT "SORT?  (1, 2, 3, OR 4)  ";
380  INPUT M
390  PRINT "WHAT ARE CHARACTER POSITIONS WITHIN STRING UPON WHICH TO SORT??"
400  PRINT "(IE  1,6   OR   2,30   ETC)  ";
410  INPUT I1,I2
420  PRINT "SPECIFY SORT TYPE AS EITHER ASCII OR NUMERIC  ";
430  INPUT Z$
440  IF Z$="ASCII" THEN 500
450  IF Z$="NUMERIC" THEN 470
460  GOTO 420
470  Q=10
480  X$="0123456789"
490  GOTO 520
500  Q=63
510  X$=" !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ["'92"]^"
520  FOR I=I2 TO I1 STEP -1
530  FOR J=1 TO R1
540  GOSUB M OF 1100,1120,1140,1160
550  GOSUB 710
560  NEXT J
570  GOSUB 800
580  FOR J=1 TO R1
590  GOSUB M OF 1100,1120,1140,1160
600  GOSUB 930
610  NEXT J
620  MAT E=A
630  MAT B=ZER
640  MAT C=ZER
650  PRINT "SORT ON CHARACTER "I"  IS COMPLETE"
660  NEXT I
670  READ #2,1
680  MAT  PRINT #2;E
690  GOTO 1180
700  REM
710  REM   SUBROUTINE TO FILL MAT B
720  REM
730  FOR N=1 TO Q
740  IF Z$[I,I]=X$[N,N] THEN 770
750  NEXT N
760  GOTO 1030
770  B[N]=B[N]+1
780  RETURN 
790  REM
800  REM   SUBROUTINE TO FILL MAT C
810  REM
820  Z=1
830  FOR N=1 TO Q
840  IF B[N]=0 THEN 860
850  GOTO 880
860  C[N]=0
870  GOTO 900
880  C[N]=Z
890  Z=Z+B[N]
900  NEXT N
910  RETURN 
920  REM
930  REM   SUBROUTINE TO SORT DIRECTORY INTO MAT A ON CHARACTER I
940  REM
950  FOR N=1 TO Q
960  IF Z$[I,I]=X$[N,N] THEN 990
970  NEXT N
980  GOTO 1050
990  Z=C[N]
1000  A[Z]=E[J]
1010  C[N]=C[N]+1
1020  RETURN 
1030  PRINT "EXIT FROM MAT B SORT, CHARACTER "I
1040  STOP 
1050  PRINT "EXIT FROM MAT A SORT, CHARACTER "I
1060  STOP 
1070  REM
1080  REM  SUBROUTINE TO IDENTIFY SORTED STRING AS "Z$"
1090  REM
1100  READ #1,E[J];Z$
1110  RETURN 
1120  READ #1,E[J];A$,Z$
1130  RETURN 
1140  READ #1,E[J];A$,B$,Z$
1150  RETURN 
1160  READ #1,E[J];A$,B$,C$,Z$
1170  RETURN 
1180  REM
1190  REM   RESORT AND PRINT OPTIONS
1200  REM
1210  PRINT "PRINT DATA FILE ON CURRENT DIRECTORY ORDER? (YES OR NO) ";
1220  DIM Y$[3]
1230  INPUT Y$
1240  IF Y$="YES" THEN 1270
1250  IF Y$="NO" THEN 1660
1260  GOTO 1210
1270  READ #2,1
1280  MAT  READ #2;E
1290  PRINT LIN(3)
1300  FOR J=1 TO R1
1310  READ #1,E[J];A$,B$,C$,D$
1320  GOSUB M OF 1340,1420,1500,1620
1330  GOTO 1640
1340  X1=55
1350  IF LEN(D$) <= X1 THEN 1400
1360  GOSUB 1770
1370  PRINT A$;TAB(7);"("B$")";TAB(17);D$[1,X]
1380  PRINT TAB(22);D$[X+1,72]
1390  GOTO 1410
1400  PRINT A$;TAB(7);"("B$")";TAB(17);D$
1410  RETURN 
1420  X1=55
1430  IF LEN(D$) <= X1 THEN 1480
1440  GOSUB 1770
1450  PRINT "("B$")";TAB(7);A$;TAB(17);D$[1,X]
1460  PRINT TAB(22);D$[X+1,72]
1470  GOTO 1490
1480  PRINT "("B$")";TAB(7);A$;TAB(17);D$
1490  RETURN 
1500  IF C$[1,2]=Z$ THEN 1530
1510  Z$=C$[1,2]
1520  PRINT LIN(3)
1530  X1=41
1540  IF LEN(D$) <= X1 THEN 1590
1550  GOSUB 1770
1560  PRINT C$;TAB(14);A$;TAB(21);"("B$")";TAB(31);D$[1,X]
1570  PRINT TAB(36);D$[X+1,72]
1580  GOTO 1600
1590  PRINT C$;TAB(14);A$;TAB(21);"("B$")";TAB(31);D$
1600  PRINT 
1610  RETURN 
1620  PRINT A$;TAB(8);D$
1630  RETURN 
1640  NEXT J
1650  PRINT LIN(3)
1660  PRINT "ADDITIONAL SORT ON MORE SIGNIFICANT STRING?  (YES OR NO) ";
1670  DIM P$[3]
1680  INPUT P$
1690  IF P$="YES" THEN 1720
1700  IF P$="NO" THEN 1760
1710  GOTO 1660
1720  READ #2,1
1730  MAT  READ #2;E
1740  GOTO 360
1750  PRINT "TOO MUCH DATA REQUESTED FROM FILE #1"
1760  STOP 
1770  REM SUBROUTINE FOR LONG D$ STRING PRINTS
1780  REM
1790  FOR X=X1 TO INT(X1/2) STEP -1
1800  IF D$[X,X]=" " THEN 1840
1810  IF D$[X,X]="-" THEN 1840
1820  NEXT X
1830  GOTO 1850
1840  RETURN 
1850  PRINT "FAILURE IN LONG D$ SUBROUTINE"
1860  END 
