10  COM A0$[7]
20  IF LEN(A0$)>0 THEN 50
30  A0$="$INDEX "
40  CHAIN X,"1.A007"
50  REM PROGRAM CONTINUES HERE
60  REM   PROGRAM  INDEX
70  REM
80  DIM A$[72],B$[7],C$[6],D$[26],U$[6]
90  DIM T$[36]
100  T$="HP 2000/ACCESS PROGRAM LIBRARY INDEX"
110  FILES *,*,*,*
120  FILES *
130  ASSIGN "IF1.A100",1,R
140  ASSIGN "IF2.A100",2,R
150  ASSIGN "IF3.A100",3,R
160  ASSIGN "IF4.A100",4,R
170  REM
180  LET U$="------"
190  LET D$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
200  REM
210  PRINT 
220  PRINT TAB(15);T$;LIN(-2)
230  F5=0
260  A$="N"
270  A$=UOS$(A$)
280  IF A$[1,1]#"Y" THEN 320
290  ASSIGN "LP",5,R
300  F5=5
310  PRINT 
320  PRINT "Instructions (Y/N)";
340  LINPUT A$
344  PRINT 
350  A$=UOS$(A$)
370  IF A$="Y" THEN 390
380  GOTO 500
390  REMM
400  PRINT 
410  PRINT "Information is contained in files concerning most commonly"
420  PRINT "used programs. This information is available via the"
430  PRINT "program INDEX. The location of programs listed is LIBRARY"
440  PRINT "(use $ prefix) unless specified otherwise."
450  PRINT 
460  PRINT "THIS MAY BE ACCESSED IN THREE WAYS:"
470  PRINT "    1.  BY THE NAME OF THE PROGRAM, E.G.  INDEX OR $INDEX"
480  PRINT "    2.  BY THE CALL LETTER OF THE SUBJECT LIBRARY, E.G.  B, D, OR F"
490  PRINT "    3.  A LISTING OF ALL PROGRAMS BY USING:  A"
500  PRINT 
510  PRINT "Search for program or subject (S or P)";
520  ENTER 255,X,A$
530  PRINT 
540  IF F5=0 THEN 570
550  PRINT #F5;CTL(1)
560  PRINT #F5;TAB(15);T$
570  A$=UOS$(A$)
580  PRINT 
590  IF A$[1,1]#"S" THEN 880
600  PRINT "Do you wish to see the Table of Contents (Y/N)";
610  ENTER 255,X,A$
620  PRINT 
630  A$=UOS$(A$)
640  IF A$[1,1]#"Y" THEN 810
650  PRINT 
660  PRINT "     SUBJECT LIBRARIES";LIN(-1)
670  PRINT "CALL LETTER";TAB(15);"SUBJECT"
680  PRINT 
690  PRINT "  B";TAB(15);"BUSINESS"
700  PRINT "  C";TAB(15);"CAREER COUNSELING"
710  PRINT "  D";TAB(15);"FINE ARTS"
720  PRINT "  F";TAB(15);"FOREIGN LANGUAGES"
730  PRINT "  G";TAB(15);"GAMES"
740  PRINT "  L";TAB(15);"LANGUAGE ARTS"
750  PRINT "  M";TAB(15);"MATHEMATICS"
760  PRINT "  S";TAB(15);"SCIENCE"
770  PRINT "  H";TAB(15);"SOCIAL STUDIES"
780  PRINT "  T";TAB(15);"STATISTICS & PROBABILITY"
790  PRINT "  U";TAB(15);"UTILITY--PROGRAMMING, DATA HANDLING, EDITING"
800  PRINT "  V";TAB(15);"VOCATIONAL ARTS--DRIVER TRAINING, HOME EC."
810  PRINT 
820  PRINT "ENTER: LIBRARY CALL LETTER";
830  INPUT B$
840  B$=UOS$(B$)
850  PRINT 
860  GOTO 920
870  PRINT 
880  PRINT "ENTER:  NAME ";
890  INPUT B$
900  B$=UOS$(B$)
910  PRINT 
920  LET M=N=0
930  IF B$[1,1]#"$" THEN 980
940  LET B$=B$[2]
950  REM
960  REM    LOOP OVER FILES
970  REM
980  FOR F=1 TO 4
990  IF  END #F THEN 1620
1000  REM
1010  REM    LOOP OVER RECORDS
1020  REM
1030  FOR R=1 TO 999
1040  READ #F,R;S
1050  LET L=INT(S/100)
1060  LET S=S-L*100
1070  LET P=0
1080  IF S=0 THEN 1630
1090  READ #F;A$
1100  LET N=N+1
1110  IF B$=A$ THEN 1270
1120  IF B$="A" THEN 1270
1130  IF L=0 THEN 1150
1140  IF B$=D$[L,L] THEN 1270
1150  FOR I=2 TO S
1160  READ #F;C$
1170  IF C$[1,1]#" " THEN 1210
1180  LET C$[LEN(C$)+1,6]="    "
1190  LET C$[LEN(A$)+1]=C$[2,7-LEN(A$)]
1200  LET C$[1,LEN(A$)]=A$
1210  IF C$=B$ THEN 1270
1220  NEXT I
1230  GOTO 1610
1240  REM
1250  REM    PRINT CONTENTS OF RECORD
1260  REM
1270  READ #F,R;S,A$
1280  LET L=INT(S/100)
1290  LET S=S-L*100
1300  PRINT #F5
1310  PRINT #F5;A$;
1320  PRINT #F5;"   -   ";
1330  IF S=1 THEN 1500
1340  PRINT #F5;"SUBPROGRAMS:  ";
1350  LET C=14
1360  FOR I=2 TO S
1370  IF C<64 THEN 1400
1380  LET C=0
1390  PRINT #F5
1400  READ #F;C$
1410  IF C$[1,1]=" " THEN 1450
1420  PRINT #F5;C$;"  ";
1430  LET C=C+LEN(C$)+2
1440  GOTO 1470
1450  PRINT #F5;A$;C$[2];"  ";
1460  LET C=C+LEN(A$)+LEN(C$)+1
1470  NEXT I
1480  PRINT #F5
1490  PRINT #F5
1500  IF L=0 THEN 1520
1510  PRINT #F5;"LIBRARY:  ";D$[L,L]
1520  READ #F;A$
1530  PRINT #F5
1540  LET M=M+1
1550  FOR I=1 TO 999
1560  IF TYP(-F)=4 OR TYP(F)=3 THEN 1600
1570  READ #F;A$
1580  PRINT #F5;A$
1590  NEXT I
1600  PRINT #F5
1610  NEXT R
1620  NEXT F
1630  IF M>0 THEN 510
1640  PRINT "NO INFORMATION EXISTS FOR ";B$;",";N;"RECORDS SEARCHED"
1650  GOTO 510
1660  END 
