1000  REM   COMMON
1001  REM   NEVER R/W FIRST RECORD THRU A MASK
1002  REM   ALLOW NUMBER PREFIXES FOR APPROPRIATE COMMANDS
1004  REM   L9 HAS TWO MEANINGS - LAST LINE & INSERT
1100  REM   ASSIGNMENTS FOR COMMON
1200  REM   DIMENSION LOCAL ARRAYS
1201  REM   PI2:  INFORMATION SYSTEM, HP 36737A , 2/74
1202  DIM B[20]
1206  DIM F[20]
1208  DIM H[20]
1217  DIM Q[20]
1300  REM   ***   ASSIGNMENTS FOR LOCAL ARRAYS   ***
1302  MAT B=ZER
1306  MAT F=ZER
1308  MAT H=ZER
1500  REM   ***   DIMENSION LOCAL STRINGS   ***
1501  DIM A$[70]
1502  DIM B$[70]
1503  DIM C$[6]
1504  DIM D$[70]
1506  DIM F$[6]
1508  DIM H$[70]
1509  DIM I$[72]
1510  DIM J$[72]
1511  DIM K$[72]
1512  DIM L$[70]
1513  DIM M$[6]
1514  DIM N$[6]
1517  DIM Q$[10]
1520  DIM T$[72]
1521  DIM U$[72]
1522  DIM V$[72]
1523  DIM W$[72]
1524  DIM X$[72]
1525  DIM Y$[72]
1526  DIM Z$[72]
1600  REM   ***   ASSIGNMENTS FOR LOCAL STRINGS   ***
1606  F$="PIDATA"
1608  L$="                                   "
1609  L$[36,70]=L$
1610  L$[70,70]="*"
1613  M$=""
1614  N$=""
1617  Q$="0123456789"
1700  REM   ***   ASSIGNMENTS FOR LOCAL VARIABLES   ***
1710  T1=250
1720  R7=0
1730  M0=0
1900  REM   ***   FILES   ***
1910  FILES *,*
1920  ASSIGN F$,1,R9
1921  IF R9>2 THEN 3000
1924  GOSUB 9300
1925  IF P9=0 THEN 2005
1926  PRINT LIN(1),"FILE ";F$;" MUST BE INITIALIZED.",LIN(1)
1927  GOTO 3100
2000  REM
2001  REM   ***   MAIN PROGRAM   ***
2002  REM
2005  READ #1,2
2006  GOTO TYP(-1) OF 2010,2007,2010,2010
2007  READ #1;I$
2008  PRINT LIN(1),I$,LIN(1)
2010  PRINT LIN(2),"=> ";
2020  ENTER T1,T2,I$
2030  PRINT 
2035  GOSUB 9300
2040  IF T2 >= 0 AND T2<T1 THEN 2500
2050  PRINT "PLEASE TYPE ONE OF THE FOLLOWING COMMANDS:"
2060  PRINT "ASSIGN"
2062  PRINT "COPY"
2065  PRINT "CHANGE"
2070  PRINT "DELETE"
2090  PRINT "ENTER"
2105  PRINT "FIND"
2110  PRINT "INSERT"
2115  PRINT "LAST"
2120  PRINT "LIST"
2150  PRINT "PRINT"
2160  PRINT "QUIT"
2165  PRINT "SORT"
2170  PRINT 
2180  PRINT "COMMANDS MAY BE ABREVIATED."
2190  T1=250
2200  GOTO 2010
2500  REM   ***   TRANSFER TO APPROPRIATE MODULE   ***
2510  IF I$[1,1]="A" THEN 3000
2512  IF I$[1,2]="CO" THEN 6950
2515  IF I$[1,1]="C" THEN 2730
2520  IF I$[1,1]="D" THEN 2750
2550  IF I$[1,1]="E" THEN 4000
2560  IF I$[1,1]="F" THEN 6500
2570  IF I$[1,1]="I" THEN 7000
2575  IF I$[1,2]="LA" THEN 6900
2580  IF I$[1,1]="L" THEN 6000
2610  IF I$[1,1]="P" THEN 6000
2620  IF I$[1,1]="Q" THEN 9999
2625  IF I$[1,1]="S" THEN 7500
2630  IF I$[1,1]="?" THEN 2050
2640  GOTO 2050
2700  REM   ***   CHAIN TO APPROPRIATE MODULE   ***
2710  PRINT LIN(1),I$;" IS NOT YET AVAILABLE.",LIN(1)
2720  GOTO 2010
2730  S1=0
2740  GOTO 5000
2750  S1=1
2760  GOTO 5000
2762  PRINT LIN(1),"FILE ";F$;" IS NOT AVAILABLE.",LIN(1)
2763  PRINT "THE RETURN VARIABLE IS ";R9
2764  GOTO 2010
3000  REM
3001  REM   ***   ASSIGN FILE NAME TO DATA BASE   ***
3002  REM
3010  PRINT LIN(1),"FILE NAME - ";
3020  INPUT F$
3030  IF LEN(F$) <= 6 THEN 3060
3040  PRINT LIN(1),"FILE NAME MUST BE 6 CHARACTERS OR LESS.",LIN(1)
3050  GOTO 3010
3060  GOSUB 9600
3070  IF R9<3 THEN 3100
3080  PRINT LIN(1),"FILE ";F$;" IS NOT AVAILABLE.",LIN(1)
3090  GOTO 2010
3100  REM
3110  REM   ***   INITIALIZE FILE PARAMETERS   ***
3120  REM
3130  GOSUB 9300
3140  IF P9=0 THEN 2010
3150  PRINT LIN(1),"NO. OF RECORDS IN FILE - ";
3160  INPUT J$
3170  GOSUB 9100
3180  IF J$[1,1]#"P" THEN 3210
3190  PRINT J$
3200  GOTO 3100
3210  R0=Q5
3215  K1=0
3220  I2=1
3225  PRINT LIN(2),"DEFINE DATA BASE STRUCTURE."
3230  PRINT LIN(2),"NO.  NAME, LENGTH",LIN(1)
3240  K1=K1+1
3250  PRINT  USING 3260;K1
3260  IMAGE #,2D," "
3270  INPUT I$
3280  IF LEN(I$)=1 THEN 3320
3290  IF LEN(I$)#3 THEN 3330
3300  IF I$[1,3]="END" THEN 3510
3310  GOTO 3330
3320  IF I$[1,1]="E" THEN 3510
3325  IF I$[1,1]="Q" THEN 3510
3330  FOR I1=1 TO LEN(I$)
3340  IF I$[I1,I1]="," THEN 3400
3350  IF I$[I1,I1]="/" THEN 3400
3360  NEXT I1
3370  PRINT LIN(2),"ILLEGAL FORMAT. PLEASE USE ',' OR '/' TO"
3380  PRINT "SEPERATE 'NAME' AND 'LENGTH'.",LIN(1)
3390  GOTO 3250
3400  IF I1#1 THEN 3404
3401  PRINT "FIELD MUST HAVE A NAME."
3402  GOTO 3250
3404  J$=I$[I1+1,LEN(I$)]
3410  GOSUB 9100
3420  IF J$[1,1]#"P" THEN 3450
3430  PRINT J$
3440  GOTO 3250
3450  F[K1]=Q5
3460  H[K1]=I1-1
3470  I3=I2+I1-2
3480  H$[I2,I3]=I$[1,I1-1]
3490  I2=I3+1
3500  GOTO 3240
3510  IF K1=1 THEN 3720
3512  F0=K1-1
3530  R1=3
3540  E0=7
3550  E1=7
3560  R5=4
3570  F9=0
3580  M0=0
3590  FOR I1=1 TO F0
3600  F9=F9+F[I1]
3610  NEXT I1
3620  IF (2*INT(F9/2)-F9) THEN 3650
3630  N5=INT(256/(1+(F9+1)/2))
3640  GOTO 3660
3650  N5=INT(256/(1+F9/2))
3660  GOSUB 9200
3670  PRINT LIN(2),"DATA BASE TITLE - ";
3680  ENTER T1,T2,I$
3690  IF LEN(I$)=0 THEN 2010
3700  PRINT #1,2;I$
3705  REM   ***   IMPLEMENT DATA MASK CAPABILITY   ***
3710  GOTO 1920
3720  PRINT #1,1
3730  PRINT #1,2
3735  REM   ***  IS 3740 OK?   ***
3740  GOTO 2010
4000  REM
4001  REM   ***   DATA ENTRY   ***
4002  REM
4010  L6=E0*(R1-R5)+E1
4012  L9=E0*(R0-R5+1)
4015  IF E1<E0 THEN 4035
4020  E2=0
4025  R1=R1+1
4030  GOTO 4070
4035  READ #1,R1
4040  FOR I1=1 TO E1
4045  READ #1;I$
4050  K1=I1
4055  GOSUB 8000
4060  NEXT I1
4065  E2=E1
4070  L6=L6+1
4072  IF L6>L9 THEN 4350
4075  I$=L$
4080  PRINT LIN(2),"NO. ";L6
4090  J3=J5=0
4095  I$=L$
4100  FOR J1=1 TO F0
4110  J2=J3+1
4120  J3=J3+H[J1]
4130  J4=J5+1
4140  J5=J5+F[J1]
4150  PRINT H$[J2,J3];" ";
4160  ENTER T1,T2,J$
4165  PRINT 
4170  IF T2<0 THEN 4150
4180  IF LEN(J$)=1 THEN 4220
4190  IF LEN(J$)#4 THEN 4230
4200  IF J$[1,4]="QUIT" THEN 4320
4210  GOTO 4240
4220  IF J$[1,1]="Q" THEN 4320
4230  IF LEN(J$)=0 THEN 4270
4240  IF LEN(J$) <= F[J1] THEN 4260
4250  PRINT LIN(1),"WARNING-EXTRA INPUT IGNORED.",LIN(1)
4260  I$[J4,J5]=J$
4270  NEXT J1
4272  E2=E2+1
4274  K1=E2
4280  GOSUB 8000
4290  IF E2<E0 THEN 4070
4300  GOSUB 8300
4310  GOTO 4020
4320  IF E2=0 THEN 2010
4330  GOSUB 8300
4340  GOTO 2010
4350  PRINT LIN(1),"FILE IS FULL."
4360  GOTO 2010
5000  REM
5001  REM   ***   CHANGE OR DELETE LINES IN FILE   ***
5002  REM
5010  L0=E0*(R1-R5)+E1
5020  PRINT LIN(1),"LINE NO. - ";
5025  ENTER T1,T2,I$
5030  PRINT 
5035  IF I$[1,1]="E" THEN 2010
5040  IF I$[1,1]="Q" THEN 2010
5041  IF LEN(I$)=0 THEN 2010
5045  Q0=1
5050  GOSUB 9000
5055  IF Q1=0 THEN 5075
5060  PRINT J$
5065  GOTO 5020
5075  L3=Q5
5080  IF L3=ABS(INT(L3)) AND L3 >= 1 AND L3 <= L0 THEN 5095
5085  PRINT LIN(1),"LINE NO. MUST BE 1 TO ";L0,LIN(1)
5090  GOTO 5020
5095  R3=INT((L3-1)/E0)+R5
5100  E3=L3-E0*(R3-R5)
5105  READ #1,R3
5110  IF S1>0 THEN 5545
5115  IF R3=R1 THEN 5130
5120  READ #1;T$,U$,V$,W$,X$,Y$,Z$
5125  GOTO 5155
5130  FOR I1=1 TO E1
5135  READ #1;I$
5140  K1=I1
5145  GOSUB 8000
5150  NEXT I1
5155  K1=E3
5160  GOSUB 8100
5165  IF I$[F9,F9]#"*" THEN 5175
5170  I$[F9,F9]=" "
5175  J3=J5=0
5180  FOR J1=1 TO F0
5185  J2=J3+1
5190  J3=J3+H[J1]
5195  J4=J5+1
5200  J5=J5+F[J1]
5205  PRINT H$[J2,J3];" ";I$[J4,J5];" - ";
5210  ENTER T1,T2,J$
5215  PRINT 
5220  IF T2<0 THEN 5205
5225  IF LEN(J$)=0 THEN 5245
5230  IF LEN(J$) <= F[J1] THEN 5240
5235  PRINT LIN(1),"WARNING-EXTRA INPUT IGNORED.",LIN(1)
5239  REM   ***   THIS MAY CAUSE A NON-CONTIGUOUS STRING   ***
5240  I$[J4,J5]=J$
5245  NEXT J1
5250  IF I$[F9,F9]#" " THEN 5260
5255  I$[F9,F9]="*"
5260  K2=E3
5265  GOSUB 8000
5270  READ #1,R3
5275  IF R3=R1 THEN 5290
5280  PRINT #1;T$,U$,V$,W$,X$,Y$,Z$
5285  GOTO 5020
5290  FOR J1=1 TO E1
5295  K1=J1
5300  GOSUB 8100
5305  PRINT #1;I$
5310  NEXT J1
5315  GOTO 5020
5545  L9=L3-(R3-R5)*E0
5550  IF R1=R3 THEN 5685
5555  FOR I1=1 TO R1-R3
5560  READ #1,R3
5565  FOR I3=1 TO E0
5570  READ #1;I$
5575  K1=I3
5580  GOSUB 8000
5585  NEXT I3
5590  GOTO L9 OF 5595,5600,5605,5610,5615,5620,5625
5595  T$=U$
5600  U$=V$
5605  V$=W$
5610  W$=X$
5615  X$=Y$
5620  Y$=Z$
5625  P3=R3+1
5630  READ #1,P3;Z$
5635  READ #1,R3
5640  FOR I4=1 TO E0
5645  K1=I4
5650  GOSUB 8100
5655  PRINT #1;I$
5660  NEXT I4
5665  R3=R3+1
5670  L9=1
5675  NEXT I1
5680  L9=1
5685  IF E1=1 THEN 5820
5690  READ #1,R1
5695  FOR I2=1 TO E1
5700  K1=I2
5705  READ #1;I$
5710  GOSUB 8000
5715  NEXT I2
5720  GOTO L9 OF 5725,5735,5745,5755,5765,5775,5785
5725  T$=U$
5730  IF E1=2 THEN 5780
5735  U$=V$
5740  IF E1=3 THEN 5780
5745  V$=W$
5750  IF E1=4 THEN 5780
5755  W$=X$
5760  IF E1=5 THEN 5780
5765  X$=Y$
5770  IF E1=6 THEN 5780
5775  Y$=Z$
5780  READ #1,R1
5785  FOR I2=1 TO E1-1
5790  K1=I2
5795  GOSUB 8100
5800  PRINT #1;I$
5805  NEXT I2
5810  E1=E1-1
5815  GOTO 5830
5820  PRINT #1,R1
5822  E1=E0
5825  R1=R1-1
5830  GOSUB 9200
5835  GOTO 5010
6000  REM
6001  REM   ***   PRINT OR LIST CONTENTS OF FILE   ***
6002  REM
6003  GOSUB 9300
6005  IF I$[1,1]="P" THEN 6030
6010  IF I$[1,1]#"L" THEN 2010
6015  L7=1
6020  C1=0
6025  GOTO 6035
6030  L7=0
6035  L0=E0*(R1-R5)+E1
6040  PRINT LIN(1),"> ";
6045  ENTER T1,T2,I$
6050  PRINT 
6055  IF I$[1,1]="Q" THEN 2010
6060  IF I$[1,1]="E" THEN 2010
6065  IF I$[1,1]="A" THEN 6260
6070  FOR I1=1 TO LEN(I$)
6075  IF I$[I1,I1]="-" THEN 6195
6080  NEXT I1
6085  J$=I$
6090  GOSUB 9100
6095  IF J$[1,1]#"P" THEN 6110
6100  PRINT J$
6105  GOTO 6040
6110  L3=Q5
6115  IF L3=ABS(INT(L3)) AND L3>0 AND L3 <= L0 THEN 6130
6120  PRINT LIN(1),"LINE NUMBER MUST BE 1 TO ";L0
6125  GOTO 6040
6130  R3=INT((L3-1)/E0)+R5
6135  L9=L3-E0*(R3-R5)
6140  READ #1,R3
6145  FOR I1=1 TO L9
6150  READ #1;I$
6155  NEXT I1
6160  IF L7=0 THEN 6180
6165  GOSUB 9400
6170  PRINT L3;I$[1,F8]
6175  GOTO 6040
6180  GOSUB 9400
6185  PRINT I$[1,F8]
6190  GOTO 6040
6195  J$=I$[1,I1-1]
6200  GOSUB 9100
6205  IF J$[1,1]#"P" THEN 6220
6210  PRINT J$
6215  GOTO 6040
6220  L3=Q5
6225  J$=I$[I1+1,LEN(I$)]
6230  GOSUB 9100
6235  IF J$[1,1]#"P" THEN 6250
6240  PRINT J$
6245  GOTO 6040
6250  L4=Q5
6255  GOTO 6270
6260  L3=1
6265  L4=L0
6270  REM   ***   NEW CODING FOR PRINTING ALL OR PART OF FILE   ***
6275  IF L3=INT(L3) AND L3>0 AND L3 <= L0 THEN 6285
6280  GOTO 6290
6285  IF L4=INT(L4) AND L4 >= L3 AND L4 <= L0 THEN 6300
6290  PRINT LIN(1),"RANGE MUST BE 1 TO ";L0
6295  GOTO 6040
6300  R3=INT((L3-1)/E0)+R5
6305  L9=L3-E0*(R3-R5)
6310  C1=L3-1
6315  READ #1,R3
6320  IF L9=1 THEN 6340
6325  FOR I2=1 TO L9-1
6330  READ #1;I$
6335  NEXT I2
6340  FOR I2=L3 TO L4
6345  READ #1;I$
6350  IF L7=0 THEN 6375
6355  C1=C1+1
6360  GOSUB 9400
6365  PRINT C1;I$[1,F8]
6370  GOTO 6385
6375  GOSUB 9400
6380  PRINT I$[1,F8]
6385  NEXT I2
6390  GOTO 6040
6500  REM
6501  REM   ***   FIND ENTRIES FOR SELECTED PARAMETERS   ***
6502  REM
6505  PRINT 
6510  MAT B=ZER
6550  J3=J5=0
6555  I$=L$
6560  K$=L$
6565  FOR J1=1 TO F0
6570  J2=J3+1
6575  J3=J3+H[J1]
6580  J4=J5+1
6585  J5=J5+F[J1]
6590  PRINT H$[J2,J3];" ";
6595  ENTER T1,T2,J$
6600  PRINT 
6605  IF T2<0 THEN 6590
6610  IF LEN(J$)=1 THEN 6630
6615  IF LEN(J$)#4 THEN 6635
6620  IF J$[1,4]="QUIT" THEN 2010
6625  GOTO 6635
6630  IF J$[1,1]="Q" THEN 2010
6635  IF LEN(J$)=0 THEN 6660
6640  B[J1]=1
6645  IF LEN(J$) <= F[J1] THEN 6655
6650  PRINT LIN(1),"WARNING-EXTRA INPUT IGNORED.",LIN(1)
6655  K$[J4,J5]=J$
6660  NEXT J1
6700  L0=E0*(R1-R5)+E1
6705  PRINT 
6710  READ #1,R5
6715  FOR I1=1 TO L0
6720  READ #1;I$
6725  J5=0
6730  FOR J1=1 TO F0
6735  J4=J5+1
6740  J5=J5+F[J1]
6745  IF B[J1]=0 THEN 6770
6750  IF K$[J4,J5]#I$[J4,J5] THEN 6800
6770  NEXT J1
6780  PRINT  USING 6785;I1
6785  IMAGE #,4D,"  "
6790  GOSUB 9400
6795  PRINT I$
6800  NEXT I1
6810  GOTO 2010
6900  REM
6901  REM   ***   PRINT LAST LINE INFORMATION   ***
6902  REM
6904  GOSUB 9300
6906  IF P9=0 THEN 6912
6908  PRINT LIN(1),"FILE NOT INITIALIZED.",LIN(1)
6910  GOTO 2010
6912  L0=E0*(R1-R5)+E1
6914  PRINT 
6916  PRINT "LAST ENTRY IS NUMBER ";L0
6918  PRINT "LAST RECORD IS ";R1
6920  L9=E0*(R0-R5+1)
6922  PRINT "SPACE AVAILABLE FOR ";L9-L0;" ENTRIES."
6924  PRINT 
6926  GOTO 2010
6950  REM
6951  REM   ***   PI FILE COPY   ***
6952  REM
6953  PRINT LIN(1),"FROM - ";
6954  INPUT F$
6955  ASSIGN F$,1,R9
6956  IF R9<2 THEN 6959
6957  PRINT "FILE ";I$;" CANNOT BE COPIED."
6958  GOTO 2010
6959  PRINT "  TO - ";
6960  INPUT J$
6961  ASSIGN J$,2,R9
6962  IF R9=0 THEN 6965
6963  PRINT "FILE "J$;" CANNOT BE WRIITEN."
6964  GOTO 2010
6965  GOSUB 9300
6966  IF P9=0 THEN 6969
6967  PRINT "FILE ";F$;" IS NOT INITIALIZED."
6968  GOTO 2010
6969  PRINT "NO. OF RECORDS IN ";J$;" - ";
6970  INPUT I$
6971  Q0=1
6972  GOSUB 9000
6973  IF Q1=0 THEN 6976
6974  PRINT J$
6975  GOTO 6969
6976  IF Q5>R0 THEN 6979
6977  PRINT "FILE ";J$;" MUST BE LARGER THAN FILE ";F$
6978  GOTO 2010
6979  R0=Q5
6980  PRINT #2,1;E0,E1,R0,R1,R5,F0,F9,M0,N5
6981  MAT  PRINT #2;F,H
6982  PRINT #2;H$
6983  READ #1,2
6984  GOTO TYP(-1) OF 6987,6985,6987,6987
6985  READ #1,2;I$
6986  PRINT #2,2;I$
6987  IF R1=R5 THEN 6994
6988  FOR I1=R5 TO R1-1
6989  READ #1,I1;T$,U$,V$,W$,X$,Y$,Z$
6990  PRINT #2,I1;T$,U$,V$,W$,X$,Y$,Z$
6991  NEXT I1
6992  READ #1,R1
6993  READ #2,R1
6994  FOR I1=1 TO E1
6995  READ #1;I$
6996  PRINT #2;I$
6997  NEXT I1
6998  PRINT LIN(1),"COPY COMPLETE."'7'7'7'7'7'7'7'7'7'7'7'7'7'7'7'7'7
6999  GOTO 2010
7000  REM
7002  REM   ***   INSERT LINES IN DATA BASE   ***
7004  REM
7020  PRINT LIN(1),"BEFORE LINE - ";
7022  INPUT I$
7024  IF I$[1,1]="Q" THEN 2010
7026  IF I$[1,1]="E" THEN 2010
7028  J$=I$
7030  GOSUB 9100
7032  IF J$[1,1]#"P" THEN 7042
7034  PRINT J$
7036  GOTO 7020
7038  L3=L3+1
7040  GOTO 7052
7042  L3=Q5
7044  L0=E0*(R1-R5)+E1
7046  IF L3=ABS(INT(L3)) AND L3>0 AND L3 <= L0 THEN 7052
7048  PRINT LIN(1),"ILLEGAL LINE NUMBER.",LIN(1)
7050  GOTO 7020
7052  R3=INT((L3-1)/E0)+R5
7054  L9=L3-E0*(R3-R5)
7055  PRINT 
7056  J3=J5=0
7057  I$=L$
7058  FOR J1=1 TO F0
7060  J2=J3+1
7062  J3=J3+H[J1]
7064  J4=J5+1
7066  J5=J5+F[J1]
7068  PRINT H$[J2,J3];" - ";
7070  ENTER T1,T2,J$
7072  PRINT 
7074  IF T2<0 THEN 7068
7076  IF LEN(J$)=1 THEN 7084
7078  IF LEN(J$)#4 THEN 7086
7080  IF J$[1,4]="QUIT" THEN 7020
7082  GOTO 7086
7084  IF J$[1,1]="Q" THEN 7020
7086  IF LEN(J$)=0 THEN 7094
7088  IF LEN(J$) <= F[J1] THEN 7092
7090  PRINT LIN(1),"WARNING-EXTRA INPUT IGNORED.",LIN(1)
7092  I$[J4,J5]=J$
7094  NEXT J1
7100  K$=I$
7102  E2=E0
7104  IF E1=E0 THEN 7112
7106  IF R3=R1 THEN 7112
7108  X1=R1-1
7110  GOTO 7118
7112  X1=R1
7114  IF R3#R1 THEN 7118
7116  E2=E1
7118  FOR I1=R3 TO X1
7120  READ #1,I1
7122  FOR I3=1 TO E2
7124  READ #1;I$
7126  K1=I3
7128  GOSUB 8000
7130  NEXT I3
7132  J$=Z$
7134  IF L9=7 THEN 7182
7136  Z$=Y$
7138  IF L9=6 THEN 7178
7140  Y$=X$
7142  IF L9=5 THEN 7174
7144  X$=W$
7146  IF L9=4 THEN 7170
7148  W$=V$
7150  IF L9=3 THEN 7166
7152  V$=U$
7154  IF L9=2 THEN 7162
7156  U$=T$
7158  T$=K$
7160  GOTO 7184
7162  U$=K$
7164  GOTO 7184
7166  V$=K$
7168  GOTO 7184
7170  W$=K$
7172  GOTO 7184
7174  X$=K$
7176  GOTO 7184
7178  Y$=K$
7180  GOTO 7184
7182  Z$=K$
7184  READ #1,I1
7186  IF R3#R1 OR E1=E0 THEN 7190
7188  E2=E1+1
7190  FOR I2=1 TO E2
7192  K1=I2
7194  GOSUB 8100
7196  PRINT #1;I$
7198  NEXT I2
7200  K$=J$
7202  L9=1
7204  NEXT I1
7206  IF R3=R1 AND E1#E0 THEN 7230
7208  IF X1#R1 THEN 7236
7220  R1=R1+1
7222  E1=1
7224  PRINT #1,R1;K$
7226  GOSUB 9200
7228  GOTO 7038
7230  E1=E1+1
7232  GOSUB 9200
7234  GOTO 7038
7236  READ #1,R1
7238  FOR I2=1 TO E1
7240  READ #1;I$
7242  K1=I2
7244  GOSUB 8000
7246  NEXT I2
7248  GOTO E1 OF 7260,7258,7256,7254,7252,7250
7250  Z$=Y$
7252  Y$=X$
7254  X$=W$
7256  W$=V$
7258  V$=U$
7260  U$=T$
7262  T$=K$
7264  READ #1,R1
7266  E1=E1+1
7268  FOR I2=1 TO E1
7270  K1=I2
7272  GOSUB 8100
7274  PRINT #1;I$
7276  NEXT I2
7278  GOSUB 9200
7280  GOTO 7038
7500  REM
7501  REM   ***   SORT DATA BASE ON ONE FIELD   ***
7502  REM
7504  PRINT LIN(1),"YOU MAY SORT ON ANY ONE FIELD."
7506  PRINT "PLEASE ANSWER YES OR NO.",LIN(1)
7507  GOSUB 9300
7508  J3=J5=0
7510  FOR J1=1 TO F0
7512  J2=J3+1
7514  J3=J3+H[J1]
7516  J4=J5+1
7518  J5=J5+F[J1]
7520  PRINT H$[J2,J3];" - ";
7522  INPUT I$
7524  GOSUB 9990
7526  IF I$[1,1]="Y" THEN 7534
7528  NEXT J1
7530  PRINT "SORT ABORTED."
7532  GOTO 2010
7534  L0=E0*(R1-R5)+E1
7535  PRINT LIN(1),"SORT IN PROGRESS.",LIN(1)
7536  Z1=Z2=1
7538  Z2=Z1+Z2
7540  Z1=Z2-Z1
7542  IF Z2<L0 THEN 7538
7544  FOR Z3=Z1 TO L0
7546  IF Z3-Z1=0 THEN 7590
7548  L3=Z3-Z1
7550  GOSUB 7900
7552  A$=I$
7554  L3=Z3
7556  GOSUB 7900
7558  B$=I$
7560  IF A$[J4,J5] <= B$[J4,J5] THEN 7590
7562  D$=B$
7564  Z4=Z3-Z1
7566  L3=Z4+Z1
7568  J$=A$
7570  GOSUB 7950
7572  Z4=Z4-Z1
7574  IF Z4 <= 0 THEN 7584
7576  L3=Z4
7578  GOSUB 7900
7580  A$=I$
7582  IF A$[J4,J5]>D$[J4,J5] THEN 7566
7584  L3=Z4+Z1
7586  J$=D$
7588  GOSUB 7950
7590  NEXT Z3
7592  Z1=Z2-Z1
7594  Z2=Z2-Z1
7596  IF Z2>1 THEN 7544
7598  PRINT LIN(1),"SORT COMPLETED.",LIN(1)
7600  GOTO 2010
7900  REM
7901  REM   ***   READ STRING NUMBER 'L3'   ***
7902  REM
7903  R3=INT((L3-1)/E0)+R5
7904  READ #1,R3
7905  E3=L3-E0*(R3-R5)
7906  IF R3=R1 THEN 7909
7907  READ #1;T$,U$,V$,W$,X$,Y$,Z$
7908  GOTO 7914
7909  FOR J2=1 TO E1
7910  READ #1;I$
7911  K1=J2
7912  GOSUB 8000
7913  NEXT J2
7914  K1=E3
7915  GOSUB 8100
7916  RETURN 
7950  REM
7951  REM   ***   WRITE STRING NUMBER 'L3'   ***
7952  REM
7953  R3=INT((L3-1)/E0)+R5
7954  READ #1,R3
7955  E3=L3-E0*(R3-R5)
7956  IF R3=R1 THEN 7962
7958  READ #1;T$,U$,V$,W$,X$,Y$,Z$
7960  GOTO 7972
7962  FOR J2=1 TO E1
7964  READ #1;I$
7966  K1=J2
7968  GOSUB 8000
7970  NEXT J2
7972  I$=J$
7974  K1=E3
7975  GOSUB 8000
7976  READ #1,R3
7977  IF R3=R1 THEN 7980
7978  PRINT #1;T$,U$,V$,W$,X$,Y$,Z$
7979  RETURN 
7980  FOR J2=1 TO E1
7981  K1=J2
7982  GOSUB 8100
7983  PRINT #1;I$
7984  NEXT J2
7985  RETURN 
8000  REM
8001  REM   ***   TRANSFER INPUT DATA TO STRINGS   ***
8002  REM
8003  GOTO K1 OF 8004,8006,8008,8010,8012,8014,8016
8004  T$=I$
8005  RETURN 
8006  U$=I$
8007  RETURN 
8008  V$=I$
8009  RETURN 
8010  W$=I$
8011  RETURN 
8012  X$=I$
8013  RETURN 
8014  Y$=I$
8015  RETURN 
8016  Z$=I$
8017  RETURN 
8100  REM
8101  REM   ***   TRANSFER DATA TO OUTPUT STRING   ***
8102  REM
8103  GOTO K1 OF 8104,8106,8108,8110,8112,8114,8116
8104  I$=T$
8105  RETURN 
8106  I$=U$
8107  RETURN 
8108  I$=V$
8109  RETURN 
8110  I$=W$
8111  RETURN 
8112  I$=X$
8113  RETURN 
8114  I$=Y$
8115  RETURN 
8116  I$=Z$
8117  RETURN 
8300  REM
8301  REM   ***   WRITE DATA ON FILE FOR DATA ENTRY   ***
8302  REM
8304  READ #1,R1
8306  FOR J1=1 TO E2
8308  K1=J1
8310  GOSUB 8100
8312  PRINT #1;I$
8314  NEXT J1
8316  E1=E2
8318  GOSUB 9200
8320  RETURN 
8400  REM
8401  REM   ***   EOR/EOF DETECTOR   ***
8402  REM
8404  R5=R8=0
8406  READ #1,R4
8408  GOTO TYP(-1) OF 8410,8418,8414,8414
8410  R8=1
8412  GOTO 8418
8414  PRINT LIN(1),"EOF/EOR DETECTED IN FILE ";F$;" RECORD ";R4,LIN(1)
8416  R5=1
8418  RETURN 
8700  PRINT "T$="T$
8710  PRINT "U$="U$
8720  PRINT "V$="V$
8730  PRINT "W$="W$
8740  PRINT "X$="X$
8750  PRINT "Y$="Y$
8760  PRINT "Z$="Z$
8770  PRINT "I$="I$
8780  PRINT "J$="J$
8790  PRINT "K$="K$
8795  RETURN 
9000  REM
9001  REM   ***   BREAKS INPUT STRING, 'I$', INTO 'Q0' NUMBERS   ***
9002  REM
9003  IF I$[1,1]="," THEN 9028
9004  IF I$[1,1]="/" THEN 9028
9005  Q1=0
9006  MAT Q=ZER
9007  IF I$[1,1]="Z" THEN 9035
9008  J4=1
9009  FOR J2=1 TO Q0
9010  FOR J3=J4 TO LEN(I$)
9011  IF I$[J3,J3]="," THEN 9014
9012  IF I$[J3,J3]="/" THEN 9014
9013  NEXT J3
9014  J$=I$[J4,J3-1]
9015  IF J$[1,1]=" " THEN 9025
9016  J4=J3+1
9017  IF I$[J4,J4]="," THEN 9028
9018  IF I$[J4,J4]="/" THEN 9028
9019  GOSUB 9100
9020  IF J$[1,1]="P" THEN 9030
9021  Q[J2]=Q5
9022  NEXT J2
9023  IF J3<LEN(I$) THEN 9033
9024  RETURN 
9025  PRINT 
9026  PRINT "NOT SUFFICIENT INPUT."
9027  GOTO 9030
9028  PRINT 
9029  PRINT "EXTRA DELIMITER."
9030  PRINT 
9031  Q1=1
9032  RETURN 
9033  PRINT 
9034  PRINT "WARNING - EXTRA INPUT IGNORED."
9035  RETURN 
9100  REM
9101  REM   ***   STRING TO NUMBER CONVERSION   ***
9102  REM
9103  Q2=Q3=Q4=Q5=0
9104  Q6=1
9105  Q7=LEN(J$)
9106  FOR Q8=1 TO Q7
9107  FOR Q9=1 TO 10
9108  IF J$[Q8,Q8]=Q$[Q9,Q9] THEN 9124
9109  NEXT Q9
9110  IF J$[Q8,Q8]#"-" THEN 9117
9111  IF Q8=1 THEN 9115
9112  PRINT LIN(1),"ILLEGAL MINUS SIGN."
9113  J$="PLEASE ENTER NUMBER(S) AGAIN."
9114  RETURN 
9115  Q6=-Q6
9116  GOTO 9129
9117  IF J$[Q8,Q8]#"." THEN 9122
9118  Q2=Q2+1
9119  IF Q2 <= 1 THEN 9129
9120  PRINT LIN(1),"ILLEGAL DECIMAL POINT."
9121  GOTO 9113
9122  PRINT LIN(1),"ILLEGAL CHARACTER IN INPUT STRING."
9123  GOTO 9113
9124  IF Q2=0 THEN 9128
9125  Q3=Q3+1
9126  Q4=Q4+10^(-Q3)*(Q9-1)
9127  GOTO 9129
9128  Q5=10*Q5+(Q9-1)
9129  NEXT Q8
9130  Q5=Q6*(Q4+Q5)
9131  RETURN 
9200  REM
9201  REM   ***   WRITE DATA BASE PARAMETERS IN RECORD ONE   ***
9202  REM
9204  PRINT #1,1;E0,E1,R0,R1,R5,F0,F9,M0,N5
9206  MAT  PRINT #1;F,H
9208  PRINT #1;H$
9210  RETURN 
9300  REM
9301  REM   ***   READ DATA BASE PARAMETERS FROM RECORD ONE   ***
9302  REM
9304  P9=0
9306  READ #1,1
9308  GOTO TYP(-1) OF 9314,9310,9310,9310
9310  P9=1
9312  RETURN 
9314  READ #1,1;E0,E1,R0,R1,R5,F0,F9,M0,N5
9316  MAT  READ #1;F,H
9318  READ #1;H$
9319  L$[F9,F9]="*"
9320  RETURN 
9400  REM
9401  REM   ***   STRIPS TRAILING BLANKS & '*' FROM STRING   ***
9402  REM
9403  F8=LEN(I$)
9404  FOR I5=F8 TO 1 STEP -1
9406  IF I$[I5,I5]=" " THEN 9414
9408  IF I$[I5,I5]="*" THEN 9414
9410  F8=I5
9412  GOTO 9416
9414  NEXT I5
9416  RETURN 
9599  REM   ***   ADD CODING FOR MASK IN 9600   ***
9600  REM
9601  REM   ***   ASSIGN FILE NAME & CHECK RETURN VARIABLE   ***
9602  REM
9603  R6=R8=0
9604  ASSIGN F$,1,R9
9605  IF F$="*4DUM" THEN 9622
9606  IF R9=0 THEN 9622
9607  IF R9=1 THEN 9613
9608  IF R9=2 AND R7=1 THEN 9622
9609  PRINT LIN(1),"THE FILE YOU WANT ";F$;" IS NOT AVAILABLE."
9610  PRINT "THE RETURN VARIABLE IS SET AT ";R9,LIN(1)
9611  R6=1
9612  RETURN 
9613  IF R7=1 THEN 9622
9614  R8=R8+1
9615  IF R8<1000 THEN 9604
9616  PRINT LIN(2),"FILE ";F$;" IS TEMPORARILY BUSY."
9617  PRINT "PLEASE TYPE A 'C' TO CONTINUE OR A 'Q' TO QUIT - ";
9618  INPUT I$
9619  IF I$[1,1]="C" THEN 9603
9620  IF I$[1,1]="Q" THEN 9611
9621  GOTO 9617
9622  RETURN 
9990  REM
9991  REM   ***   YES/NO SCREEN   ***
9992  REM
9993  IF I$[1,1]="Y" THEN 9998
9994  IF I$[1,1]="N" THEN 9998
9995  PRINT "PLEASE TYPE 'YES' OR 'NO' ('Y' OR 'N') - ";
9996  INPUT I$
9997  GOTO 9993
9998  RETURN 
9999  END 
