1  REM   ***   COMMON   ***
2  REM   PI2:  INFORMATION  SYSTEM,  36737A, 2/74 (PILAB, PART 2 OF 2)
6  REM   ***   NEVER R/W FIRST RECORD THRU A MASK   ***
11  REM   ***   ALLOW NUMBER PREFIXES FOR APPROPRIATE COMMANDS   ***
16  REM   ***   L9 HAS TWO MEANINGS - LAST LINE & INSERT   ***
21  REM   ***   ASSIGNMENTS FOR COMMON   ***
26  REM   ***   DIMENSION LOCAL ARRAYS   ***
31  DIM B[20]
36  DIM F[20]
41  DIM H[20]
46  DIM Q[20]
51  REM   ***   ASSIGNMENTS FOR LOCAL ARRAYS   ***
56  MAT B=ZER
61  MAT F=ZER
66  MAT H=ZER
71  REM   ***   DIMENSION LOCAL STRINGS   ***
76  DIM A$[70]
81  DIM B$[70]
86  DIM C$[70]
91  DIM D$[70]
92  DIM E$[70]
96  DIM F$[6]
97  DIM G$[70]
101  DIM H$[70]
106  DIM I$[72]
111  DIM J$[72]
116  DIM K$[72]
121  DIM L$[70]
126  DIM M$[70]
131  DIM N$[70]
132  DIM O$[70]
136  DIM Q$[10]
141  DIM T$[72]
146  DIM U$[72]
151  DIM V$[72]
156  DIM W$[72]
161  DIM X$[72]
166  DIM Y$[72]
171  DIM Z$[72]
176  REM   ***   ASSIGNMENTS FOR LOCAL STRINGS   ***
181  F$="PIDATA"
186  L$="                                   "
191  L$[36,70]=L$
196  L$[70,70]="*"
201  M$=""
206  N$=""
211  Q$="0123456789"
216  REM   ***   ASSIGNMENTS FOR LOCAL VARIABLES   ***
221  T1=250
226  R7=0
231  M0=0
236  REM   ***   FILES   ***
241  FILES *,*
246  ASSIGN F$,1,R9
251  IF R9>2 THEN 466
256  GOSUB 9300
261  IF P9=0 THEN 291
266  PRINT LIN(1),"FILE ";F$;" MUST BE INITIALIZED.",LIN(1)
271  GOTO 526
276  REM
281  REM   ***   MAIN PROGRAM   ***
286  REM
291  READ #1,2
296  GOTO TYP(-1) OF 311,301,311,311
301  READ #1;I$
306  PRINT LIN(1),I$,LIN(1)
311  PRINT LIN(2),"=> ";
316  ENTER T1,T2,I$
321  PRINT 
326  GOSUB 9300
331  IF T2 >= 0 AND T2<T1 THEN 421
336  PRINT "PLEASE TYPE ONE OF THE FOLLOWING COMMANDS:"
341  PRINT "ASSIGN"
346  PRINT "COPY"
351  PRINT "CHANGE"
356  PRINT "DELETE"
361  PRINT "ENTER"
366  PRINT "FIND"
371  PRINT "INSERT"
376  PRINT "LAST"
381  PRINT "LIST"
386  PRINT "PRINT"
391  PRINT "QUIT"
396  PRINT "SORT"
401  PRINT 
406  PRINT "COMMANDS MAY BE ABREVIATED."
411  T1=250
416  GOTO 311
421  REM   ***   TRANSFER TO APPROPRIATE MODULE   ***
426  IF I$[1,1]="L" THEN 2000
431  GOTO 311
436  REM   ***   CHAIN TO APPROPRIATE MODULE   ***
441  PRINT LIN(1),I$;" IS NOT YET AVAILABLE.",LIN(1)
446  GOTO 311
451  PRINT LIN(1),"FILE ";F$;" IS NOT AVAILABLE.",LIN(1)
456  PRINT "THE RETURN VARIABLE IS ";R9
461  GOTO 311
466  REM
471  REM   ***   ASSIGN FILE NAME TO DATA BASE   ***
476  REM
481  PRINT LIN(1),"FILE NAME - ";
486  INPUT F$
491  IF LEN(F$) <= 6 THEN 506
496  PRINT LIN(1),"FILE NAME MUST BE 6 CHARACTERS OR LESS.",LIN(1)
501  GOTO 481
506  GOSUB 9600
511  IF R9<3 THEN 526
516  PRINT LIN(1),"FILE ";F$;" IS NOT AVAILABLE.",LIN(1)
521  GOTO 311
526  REM
531  REM   ***   INITIALIZE FILE PARAMETERS   ***
536  REM
541  GOSUB 9300
546  IF P9=0 THEN 311
551  PRINT LIN(1),"NO. OF RECORDS IN FILE - ";
556  INPUT J$
561  GOSUB 9100
566  IF J$[1,1]#"P" THEN 581
571  PRINT J$
576  GOTO 526
581  R0=Q5
586  K1=0
591  I2=1
596  PRINT LIN(2),"DEFINE DATA BASE STRUCTURE."
601  PRINT LIN(2),"NO.  NAME, LENGTH",LIN(1)
606  K1=K1+1
611  PRINT  USING 616;K1
616  IMAGE #,2D," "
621  INPUT I$
626  IF LEN(I$)=1 THEN 646
631  IF LEN(I$)#3 THEN 656
636  IF I$[1,3]="END" THEN 761
641  GOTO 656
646  IF I$[1,1]="E" THEN 761
651  IF I$[1,1]="Q" THEN 761
656  FOR I1=1 TO LEN(I$)
661  IF I$[I1,I1]="," THEN 691
666  IF I$[I1,I1]="/" THEN 691
671  NEXT I1
676  PRINT LIN(2),"ILLEGAL FORMAT. PLEASE USE ',' OR '/' TO"
681  PRINT "SEPERATE 'NAME' AND 'LENGTH'.",LIN(1)
686  GOTO 611
691  IF I1#1 THEN 706
696  PRINT "FIELD MUST HAVE A NAME."
701  GOTO 611
706  J$=I$[I1+1,LEN(I$)]
711  GOSUB 9100
716  IF J$[1,1]#"P" THEN 731
721  PRINT J$
726  GOTO 611
731  F[K1]=Q5
736  H[K1]=I1-1
741  I3=I2+I1-2
746  H$[I2,I3]=I$[1,I1-1]
751  I2=I3+1
756  GOTO 606
761  IF K1=1 THEN 871
766  F0=K1-1
771  R1=3
776  E0=7
781  E1=7
786  R5=4
791  F9=0
796  M0=0
801  FOR I1=1 TO F0
806  F9=F9+F[I1]
811  NEXT I1
816  IF (2*INT(F9/2)-F9) THEN 831
821  N5=INT(256/(1+(F9+1)/2))
826  GOTO 836
831  N5=INT(256/(1+F9/2))
836  GOSUB 9200
841  PRINT LIN(2),"DATA BASE TITLE - ";
846  ENTER T1,T2,I$
851  IF LEN(I$)=0 THEN 311
856  PRINT #1,2;I$
861  REM   ***   IMPLEMENT DATA MASK CAPABILITY   ***
866  GOTO 246
871  PRINT #1,1
876  PRINT #1,2
881  REM   ***  IS 3740 OK?   ***
886  GOTO 311
2000  REM
2010  GOSUB 9300
2020  L0=E0*(R1-R5)+E1
2030  READ #1,R5
2040  I2=INT(L0/4)
2050  I3=L0-4*I2
2100  FOR I1=1 TO I2
2110  READ #1;T$,U$,V$,W$
2120  FOR K1=1 TO 4
2130  GOSUB 8100
2140  A$="                               "
2150  C1=1
2160  E$=I$[1,31]
2170  B$=I$[32,62]
2180  C$=I$[63,65]
2190  D$=I$[66,70]
2200  FOR I4=1 TO 31
2210  IF E$[I4,I4]="," THEN 2250
2220  NEXT I4
2230  A$=E$
2240  GOTO 4000
2250  J1=I4-1
2270  I6=I4+1
2280  IF I6>29 THEN 2400
2290  FOR I5=I6 TO 29
2300  IF E$[I5,I5+2]="M&M" THEN 2340
2310  NEXT I5
2330  GOTO 2400
2340  A$[1,9]="MR & MRS "
2350  C1=10
2360  I6=I5+3
2400  IF I6>31 THEN 2450
2410  FOR I7=I6 TO 31
2420  IF E$[I7,I7]#" " THEN 2480
2430  NEXT I7
2450  A$[C1,C1+J1-1]=E$[1,J1]
2460  GOTO 4000
2480  J2=I7
2500  IF I6>31 THEN 2540
2510  FOR I7=31 TO J2 STEP -1
2520  IF E$[I7,I7]#" " THEN 2560
2530  NEXT I7
2540  J3=31
2550  GOTO 3000
2560  J3=I7
3000  A$[C1,C1+J3-J2]=E$[J2,J3]
3010  A$[C1+J3-J2+2,C1+J3-J2+J1+1]=E$[1,J1]
4000  I$="                                                                      "
4010  I$[1,LEN(A$)]=A$
4020  I$[32,31+LEN(B$)]=B$
4030  I$[66,70]=D$
4040  GOSUB 8000
4100  RESTORE 
4110  READ G$
4120  IF G$[1,3]="END" THEN 4180
4130  IF G$[1,3]#C$[1,3] THEN 4110
4140  M5=LEN(G$)
4150  M6=M5-5
4160  C$[1,M6]=G$[6,M5]
4170  GOTO 4190
4180  M6=3
4190  C$[M6+1,M6+8]=", CALIF."
4200  GOTO K1 OF 4210,4230,4250,4270
4210  L$=C$
4220  GOTO 4300
4230  M$=C$
4240  GOTO 4300
4250  N$=C$
4260  GOTO 4300
4270  O$=C$
4300  NEXT K1
4305  C1=2
4310  C2=35
4320  C3=69
4330  C4=103
4340  PRINT  USING 4350;TAB(C1),T$[1,31],TAB(C2),U$[1,31]
4350  IMAGE #,2(31A)
4352  PRINT  USING 4354;TAB(C3),V$[1,31],TAB(C4),W$[1,31]
4354  IMAGE 2(31A)
4360  PRINT  USING 4350;TAB(C1),T$[32,62],TAB(C2),U$[32,62]
4370  PRINT  USING 4354;TAB(C3),V$[32,62],TAB(C4),W$[32,62]
4380  PRINT  USING 4350;TAB(C1),L$,TAB(C2),M$
4390  PRINT  USING 4354;TAB(C3),N$,TAB(C4),O$
4400  PRINT  USING 4350;TAB(C1),T$[66,70],TAB(C2),U$[66,70]
4410  PRINT  USING 4354;TAB(C3),V$[66,70],TAB(C4),W$[66,70]
4420  PRINT 
4430  PRINT 
4500  NEXT I1
4510  IF I3=0 THEN 4600
4520  PRINT LIN(10),"LAST ";I3;" ENTRIES NOT PRINTED.",LIN(6)
4600  STOP 
6000  REM
6002  DATA "AGN  AGNEW"
6004  DATA "ALM  ALMADEN"
6006  DATA "ALV  ALVISO"
6008  DATA "APT  APTOS"
6010  DATA "AR   ALUM ROCK"
6012  DATA "ALA  ALAMEDA"
6014  DATA "ATH  ATHERTON"
6016  DATA "ANT  ANTIOCH"
6018  DATA "BL   BEN LOMOND"
6020  DATA "BC   BOULDER CREEK"
6022  DATA "BEL  BELMONT"
6024  DATA "BER  BERKELEY"
6026  DATA "BUR  BURLINGAME"
6028  DATA "CHI  CHICO"
6030  DATA "CAM  CAMPBELL"
6032  DATA "CON  CONCORD"
6034  DATA "CAP  CAPITOLA"
6036  DATA "CAR  CARMEL"
6038  DATA "CP   CAMBRIAN PARK"
6040  DATA "COL  COLMA"
6042  DATA "CUP  CUPERTINO"
6044  DATA "CV   CASTRO VALLEY"
6046  DATA "DAN  DANVILLE"
6048  DATA "DC   DALY CITY"
6050  DATA "EC   EL CERRITO"
6052  DATA "FEL  FELTON"
6054  DATA "FRE  FREMONT"
6056  DATA "GIL  GILROY"
6058  DATA "HIL  HILLSDALE"
6059  DATA "HLB  HILLSBOROUGH"
6060  DATA "HOL  HOLISTER"
6062  DATA "HAY  HAYWARD"
6064  DATA "HAR  HARRIS"
6066  DATA "KEN  KENSINGTON"
6068  DATA "LAF  LAFAYETTE"
6070  DATA "LG   LOS GATOS"
6072  DATA "LIV  LIVERMORE"
6074  DATA "LH   LA HONDA"
6076  DATA "LAL  LOS ALTOS"
6078  DATA "LA   LOS ANGELES"
6080  DATA "LAH  LOS ALTOS HILLS"
6081  DATA "LOD  LODI"
6082  DATA "MF   MOFFET FIELD"
6084  DATA "MAR  MARTINEZ"
6086  DATA "MOR  MORAGA"
6088  DATA "MVA  MILL VALLEY"
6090  DATA "MIL  MILLBRAE"
6092  DATA "MOD  MODESTO"
6094  DATA "MH   MORGAN HILL"
6096  DATA "ML   MOSS LANDING"
6098  DATA "MV   MOUNTAIN VIEW"
6100  DATA "MON  MONTEREY"
6102  DATA "MVI  MONTE VISTA"
6104  DATA "MP   MENLO PARK"
6106  DATA "MLP  MILPITAS"
6108  DATA "MS   MONTE SERENO"
6110  DATA "NEW  NEWARK"
6112  DATA "NIC  NICE"
6114  DATA "ORI  ORINDA"
6116  DATA "OAK  OAKLAND"
6118  DATA "PA   PALO ALTO"
6120  DATA "PAC  PACIFICA"
6122  DATA "PIN  PINOLE"
6124  DATA "PLE  PLEASANTON"
6126  DATA "PH   PLEASANT HILL"
6128  DATA "PV   PORTOLA VALLEY"
6130  DATA "RIC  RICHMOND"
6132  DATA "RC   REDWOOD CITY"
6134  DATA "RE   REDWOOD ESTATES"
6136  DATA "RDM  RIO DEL MAR"
6138  DATA "SAL  SALINAS"
6140  DATA "SF   SAN FRANCISCO"
6142  DATA "SJ   SAN JOSE"
6143  DATA "SAN  SAN JOSE"
6144  DATA "SAU  SAUSALITO"
6146  DATA "SM   SAN MATEO"
6148  DATA "SUN  SUNNYVALE"
6150  DATA "SCZ  SANTA CRUZ"
6152  DATA "SR   SAN RAFAEL"
6154  DATA "SSF  SOUTH SAN FRANCISCO"
6156  DATA "SB   SAN BRUNO"
6158  DATA "SC   SAN CARLOS"
6160  DATA "SAR  SARATOGA"
6162  DATA "SMT  SAN MARTIN"
6164  DATA "SP   SAN PABLO"
6166  DATA "SCL  SANTA CLARA"
6168  DATA "SRO  SANTA ROSA"
6170  DATA "SEA  SEASIDE"
6172  DATA "SAC  SACRAMENTO"
6174  DATA "SL   SAN LEANDRO"
6176  DATA "SV   SCOTTS VALLEY"
6178  DATA "SOQ  SOQUEL"
6180  DATA "STN  STANFORD"
6182  DATA "TIB  TIBURON"
6184  DATA "TOR  TORANCE"
6185  DATA "TUR  TURLOCK"
6186  DATA "WAT  WATSONVILLE"
6188  DATA "WOO  WOODSIDE"
6190  DATA "WC   WALNUT CREEK"
6192  DATA "WG   WILLOW GLEN"
6194  DATA "END"
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 
