10  REM* ALLOWS A000 ID TO UPDATE FILES FOR XREF INDEX PROGRAM USAGE.
20  REM* PROTECTED PROGRAM, IN A000 LIBRARY.
30  REM*AUTHOR:  MR. W. DODDS,  APRIL/74, VSB.
40  REM* VERSION # 0.
50  REM********************
60  REM   DOCUMENTATION.
70  REM********************
80  REM
90  REM* DISCFILE "ADDS" USE SPACE MADE BY "DELETES" AND IF NONE, THEN
100  REM* ADD OCCURS ONTO END OF USED UP SPACE IN FILE.
110  REM
120  REM* FIXED SIZE RECORD LAYOUTS (NOT PROTECTED.  IN A000 LIBRARY.).
130  REM* DISC FILES ARE SEQUENTIALLY AND DIRECTLY READ/WRITTEN.
140  REM
150  REM* RECORD LAYOUTS:  INDEXF- F$,D,C(1)...C(X), 4 RECORDS/BLOCK.
160  REM*                 INDEXC- C$,D,  19 RECORDS/BLOCK.
170  REM*                  INDEXW- WORKFILE FOR UPDATING INDEXF OR INDEXC.
180  REM
190  REM* IF FIRST COLUMN OF INDEXC TITLE IS * THEN TREATED AS TITLE,
200  REM* INSTEAD OF AS CATEGORY, AND DOUBLE SPACED AUTOMATICALLY, ACROSS.
210  REM
220  REM*REM* AT SYSTEM INITIATION TIME; DO THE FOLLOWING, ONCE ONLY:
230  REM*   OPEN-INDEXW,1
240  REM*   OPEN-INDEXC,20    ...IF 380 CATEGORIES; ELSE MORE OR LESS BLOCKS.
250  REM*   OPEN-INDEXF,200   ...IF 800 PROGRAMS; ELSE MORE OR LESS BLOCKS.
260  REM*   TYPE:   535 GO TO 9000
270  REM* NOTE: MAX 999 CATEGORIES; BUT UNLIMITED NUMBER OF PROGRAMS, IF SPACE.
280  REM
290  REM*** VARIABLES.
300  REM*   C-CODES,D-DATE,S-SERVICE,V-VALID CODES,E-ERROR FLAG(1=YES).
310  REM*   T-THRESHOLD DATE,F-FOUND FLAG(1=YES,M-MAX CATEGORIES.
320  REM* X-MAX CATEGORY CODES PER INDEX ENTRY,K-LOOP ETC COUNTER.
330  REM*   N$-NAME,D$-DESCRIPT,F$-N$+D$,C$-CATEGORY,R$REPLY,R-SEARCH.
340  REM*   U$-UPDATE TO F$, B$-70 BLANKS, A$-ANSWER, B-BLOCK, Z-LOOP COUNT.
350  REM*   J-JULIAN DATE FOR UPDATING.
360  REM*******************
370  REM*** INTIALIZE.
380  REM*******************
385  FILES *,*,*
390  ASSIGN "INDEXF",1,Z,"DESCRP"
394  ASSIGN "INDEXC",2,Z,"CATGRY"
396  ASSIGN "INDEXW",3,Z,"WORKFL"
400  DIM V[999],C[10],R[10]
410  LET X=10
420  LET M=380
430  LET J=TIM(2)+TIM(3)*1000
440  DIM U$[70],B$[70],A$[1]
450  DIM F$[70],N$[6],D$[64],R$[72],C$[20]
460  PRINT "NEVER CANCEL INDEXU PROGRAM BY USE OF BREAK NOR CONTROL C."
470  PRINT "OTHERWISE DISC FILES MAY REMAIN NOT UPDATED, IN UNPREDICTABLE WAY."
480  PRINT "PLEASE WAIT DURING 1 MINUTE PAUSES (CAUSED BY DISC SEARCHES)."
490  PRINT "USE SINGLE LETTER REPLIES TO QUESTIONS OF PURPOSE (FASTER)."
500  PRINT "USE * CARRIAGE RETURN AS REPLY IF NO LINE #2 DESCRIPTION."
505  PRINT "FOR DESCRIPTIONS FILE, CHANGES ARE DONE BY DELETING & ADDING."
510  PRINT 
520  LET B$[1,40]="                                        "
530  LET B$[41,70]="                              "
540  MAT V=ZER
550  LET K=1
560  IF  END #2 THEN 680
570  READ #2;C$,D
580  IF C$[1,1]=" " THEN 640
590  IF C$[1,1]="*" THEN 620
600  LET V[K]=1
610  GOTO 650
620  LET V[K]=-1
630  GOTO 650
640  LET V[K]=0
650  LET K=K+1
660  GOTO 570
670  REM**************************************************************
680  REM *** M A I N   L O G I C .
690  REM**************************************************************
700  PRINT LIN(1);"CATEGORIES, DESCRIPTIONS, OR END";
710  INPUT A$
720  IF A$="C" THEN 1460
730  IF A$="D" THEN 820
740  IF A$="E" THEN 9999
750  PRINT "INVALID.  ";
760  GOTO 700
770  REM**************************************************************
780  REM *** R O U T I N E S .
790  REM**************************************************************
800  REM
810  REM*********************************
820  REM *** UPDATE PROGRAM DESCRIPTION AND CODES.
830  REM*********************************
840  PRINT "ADD, REMOVE, OR END";
850  INPUT A$
860  IF A$="A" THEN 920
870  IF A$="R" THEN 1310
880  IF A$="E" THEN 9999
890  PRINT "INVALID.  ";
900  GOTO 840
910  REM***********
920  REM *** ADD. ***
930  REM***********
940  REM* GET NAME, BLOCK.
950  GOSUB 2320
960  IF F=0 THEN 1020
970  PRINT "PROGRAM NAME ALREADY EXISTS."
980  GOSUB 3060
990  GOSUB 3160
1000  PRINT "UPDATE IGNORED."
1010  GOTO 700
1020  IF B0>0 THEN 1060
1030  PRINT "INDEXF FILE IS FULL.  CAN NOT ADD INTO IT UNTIL COPIED INTO";
1040  PRINT " LARGER FILE."
1050  GOTO 700
1060  REM* GET DESCRIPTION.
1070  PRINT "DESCRIPTION, LINE#1";
1080  INPUT R$
1090  IF LEN(R$) <= 32 THEN 1120
1100  PRINT "TOO LONG (32 COLUMNS EXCEEDED)."
1110  GOTO 1070
1120  LET D$=B$[1,64]
1130  LET D$[1,LEN(R$)]=R$
1140  PRINT "             LINE#2";
1150  INPUT R$
1160  IF LEN(R$) <= 32 THEN 1190
1170  PRINT "TOO LONG (32 COLUMNS EXCEEDED)."
1180  GOTO 1140
1190  IF R$[1,1]="*" THEN 1210
1200  LET D$[33,LEN(R$)+32]=R$
1210  REM* GET CODES.
1220  GOSUB 3310
1230  REM* UPDATE DISC.
1240  LET U$[1,6]=N$
1250  LET U$[7,70]=D$
1260  LET N$=B$[1,6]
1270  LET B=B0
1280  GOSUB 3640
1290  GOTO 700
1300  REM***********
1310  REM *** REMOVE. ***
1320  REM***********
1330  REM* GET NAME, BLOCK.
1340  GOSUB 2320
1350  IF F=1 THEN 1380
1360  PRINT "NO SUCH PROGRAM NAME EXISTS.  UPDATE IGNORED."
1370  GOTO 700
1380  REM* BLANK OUT.
1390  LET U$=B$
1400  MAT R=ZER
1410  REM* UPDATE DISC:
1420  LET B=B9
1430  GOSUB 3640
1440  GOTO 700
1450  REM********************************
1460  REM *** UPDATE CATEGORY CODES AND TITLES.
1470  REM********************************
1480  PRINT "ADD, MODIFY, REMOVE, OR END";
1490  INPUT A$
1500  IF A$="A" THEN 1570
1510  IF A$="M" THEN 2020
1520  IF A$="R" THEN 1830
1530  IF A$="E" THEN 9999
1540  PRINT "INVALID.  ";
1550  GOTO 1480
1560  REM***********
1570  REM ***ADD.***
1580  REM***********
1590  REM* GET NEW CODE:
1600  GOSUB 2770
1610  IF F=1 THEN 700
1620  REM* GET CATEGORY TITLE.
1630  GOSUB 1650
1640  GOTO 1770
1650  PRINT "CATEGORY TITLE";
1660  INPUT R$
1670  IF LEN(R$) <= 20 THEN 1700
1680  PRINT "TOO LONG (20 COLUMNS EXCEEDED)."
1690  GOTO 1650
1700  LET C$=B$[1,20]
1710  LET C$[1,LEN(R$)]=R$
1720  IF C$[1,1]="*" THEN 1750
1730  LET V[C]=1
1740  GOTO 1760
1750  LET V[C]=-1
1760  RETURN 
1770  REM* UPDATE DISK:
1780  LET U$=C$
1790  LET C=C9
1800  GOSUB 3990
1810  GOTO 700
1820  REM***********
1830  REM *** REMOVE.***
1840  REM***********
1850  REM* GET OLD CODE.
1860  GOSUB 2640
1870  IF F=0 THEN 700
1880  LET V[C]=0
1890  REM* UPDATE DISC:
1900  LET C=C0
1910  LET U$=B$[1,20]
1920  GOSUB 3990
1930  REM* FIX INDEXF:
1940  IF  END #1 THEN 700
1950  LET B=1
1960  LET R=C0
1970  LET C=0
1980  GOSUB 4220
1990  LET B=B+1
2000  GOTO 1980
2010  REM***********
2020  REM *** MODIFY.***
2030  REM***********
2040  REM* GET OLD, NEW CODES.
2050  GOSUB 2640
2060  IF F=0 THEN 700
2070  GOSUB 2770
2080  REM* GET TITLE, THEN UPDATE V(C).
2090  GOSUB 1650
2094  IF C0=C9 THEN 2100
2096  LET V[C0]=0
2100  LET U$=B$[1,20]
2110  LET C=C0
2120  LET R$=C$
2130  GOSUB 3990
2140  LET C$=R$
2150  LET U$=C$
2160  LET C=C9
2170  GOSUB 3990
2180  IF C0=C9 THEN 700
2190  IF  END #1 THEN 700
2200  LET B=1
2210  LET R=C0
2220  LET C=C9
2230  GOSUB 4220
2240  LET B=B+1
2250  GOTO 2230
2260  STOP 
2270  REM**********************************************************
2280  REM*** S U B R O U T I N E S .
2290  REM**********************************************************
2300  REM
2310  REM******************
2320  REM *** GET PROGRAM NAME & BLOCK, CHECK IF ALREADY EXISTS IN INDEX.
2330  REM******************
2340  PRINT "WHAT IS NAME OF PROGRAM";
2350  INPUT R$
2360  IF R$[1,1]="*" THEN 2590
2370  IF R$[1,1]#"$" THEN 2390
2380  LET R$=R$[2,LEN(R$)]
2390  IF LEN(R$)>6 THEN 2590
2400  LET N$="      "
2410  LET N$[1,LEN(R$)]=R$
2420  IF  END #1 THEN 2610
2430  READ #1,1
2440  LET B0=B9=0
2450  LET B=1
2460  FOR K=1 TO 4
2470  READ #1;F$,D
2480  MAT  READ #1;C
2490  IF B0>0 THEN 2520
2500  IF F$[1,6]#"      " THEN 2520
2510  LET B0=B
2520  IF F$[1,6]#N$ THEN 2560
2530  LET B9=B
2540  LET F=1
2550  GOTO 2620
2560  NEXT K
2570  LET B=B+1
2580  GOTO 2460
2590  PRINT "INVALID.  ";
2600  GOTO 2340
2610  LET F=0
2620  RETURN 
2630  REM******************
2640  REM*** GET OLD, NEW CODES.
2650  REM******************
2660  PRINT "WHAT OLD CODE";
2670  INPUT C0
2680  IF C0 >= 1 AND C0 <= M AND C0=INT(C0) THEN 2710
2690  PRINT "INVALID.  ";
2700  GOTO 2660
2710  LET C=C0
2720  GOSUB 2880
2730  IF F=1 THEN 2750
2740  PRINT "NO SUCH OLD CODE EXISTS.  UPDATE IGNORED."
2750  RETURN 
2760  REM**************
2770  PRINT "WHAT NEW CODE";
2780  INPUT C9
2790  IF C9 >= 1 AND C9 <= M AND C9=INT(C9) THEN 2820
2800  PRINT "INVALID.  ";
2810  GOTO 2770
2820  LET C=C9
2830  GOSUB 2880
2840  IF F=0 THEN 2860
2850  PRINT "NEW CODE ALREADY EXISTS."
2860  RETURN 
2870  REM**************
2880  FOR K=1 TO M
2890  IF C=K AND (V[K]=1 OR V[K]=-1) THEN 2930
2900  NEXT K
2910  LET F=0
2920  GOTO 2940
2930  LET F=1
2940  RETURN 
2950  REM******************
2960  REM*** CHECK VALIDITY OF CODE C, FOR INDEXF UPDATE.
2970  REM******************
2980  FOR Z=1 TO M
2990  IF C=Z AND V[Z]=1 THEN 3030
3000  NEXT Z
3010  LET E=1
3020  GOTO 3040
3030  LET E=0
3040  RETURN 
3050  REM******************
3060  REM***PRINT TITLES, FOR INDEX LISTS.
3070  REM******************
3080  PRINT LIN(2)"$ NAME    DESCRIPTION OF PROGRAM";
3090  PRINT "   ";
3100  PRINT "      CATEGORY CODES THAT APPLY"
3110  PRINT "======    ======================";
3120  PRINT "   ";
3130  PRINT "      ========================="
3140  RETURN 
3150  REM******************
3160  REM*** PRINT PROGRAM NAME, DESCRIPT, CODES.
3170  REM******************
3180  PRINT F$[1,6];"  ";F$[7,38];
3190  IMAGE #,XDDD
3200  FOR K=1 TO 10
3210  IF C[K]=0 THEN 3250
3220  PRINT  USING 3190;C[K]
3230  NEXT K
3240  IF K >= 10 THEN 3260
3250  PRINT 
3260  IF F$[39,70]=B$[39,70] THEN 3280
3270  PRINT "        ";F$[39,70]
3280  PRINT 
3290  RETURN 
3300  REM******************
3310  REM*** GET CODES FOR ADDING TO INDEXF.
3320  REM******************
3330  PRINT "MAX 10 CODES, 1 AT A TIME.  SPECIFY 0 TO INDICATE NO MORE CODES."
3340  MAT R=ZER
3350  FOR K=1 TO X
3360  IF K=1 THEN 3380
3370  PRINT "NEXT ";
3380  PRINT "CODE";
3390  INPUT R[K]
3400  IF R[K]=0 AND K>1 THEN 3440
3410  GOSUB 3460
3420  IF E=1 THEN 3380
3430  NEXT K
3440  RETURN 
3450  REM******************
3460  REM*** VALIDITY CHECK ALL X CODES SPECIFIED, R(K).
3470  REM******************
3480  IF K=1 AND R[K]=0 THEN 3600
3490  IF R[K]#INT(R[K]) THEN 3600
3500  IF R[K]<0 OR R[K]>M THEN 3600
3510  LET K3=0
3520  FOR K1=1 TO X
3530  IF R[K1]#R[K] THEN 3550
3540  LET K3=K3+1
3550  NEXT K1
3560  IF K3>1 THEN 3600
3570  LET C=R[K]
3580  GOSUB 2960
3590  IF E=0 THEN 3620
3600  PRINT "INVALID.  ";
3610  LET E=1
3620  RETURN 
3630  REM*******************
3640  REM*** UPDATE 1 BLOCK OF INDEXF.
3650  REM*******************
3660  READ #1,B
3670  READ #3,1
3680  LET F=0
3690  FOR K=1 TO 4
3700  READ #1;F$,D
3710  MAT  READ #1;C
3720  IF F=1 THEN 3810
3730  IF F$[1,6]#N$ THEN 3810
3740  LET F=1
3750  LET F$=U$
3760  IF F$[1,6]="      " THEN 3790
3770  LET D=J
3780  GOTO 3800
3790  LET D=0
3800  MAT C=R
3810  PRINT #3;F$,D
3820  MAT  PRINT #3;C
3830  NEXT K
3840  GOSUB 3870
3850  RETURN 
3860  REM*******************
3870  REM*** COPY BACK FROM INDEXW TO INDEXF.
3880  REM*******************
3890  READ #1,B
3900  READ #3,1
3910  FOR K=1 TO 4
3920  READ #3;F$,D
3930  MAT  READ #3;C
3940  PRINT #1;F$,D
3950  MAT  PRINT #1;C
3960  NEXT K
3970  RETURN 
3980  REM*******************
3990  REM *** UPDATE 1 BLOCK OF INDEXC.
4000  REM*******************
4010  LET B=INT((C-1)/19)+1
4020  READ #2,B
4030  READ #3,1
4040  FOR K=1 TO 19
4050  READ #2;C$,D
4060  IF C#((B-1)*19+K) THEN 4120
4070  IF U$[1,1]=" " THEN 4100
4080  LET D=J
4090  GOTO 4110
4100  LET D=0
4110  LET C$=U$[1,20]
4120  PRINT #3;C$,D
4130  NEXT K
4140  READ #2,B
4150  READ #3,1
4160  FOR K=1 TO 19
4170  READ #3;C$,D
4180  PRINT #2;C$,D
4190  NEXT K
4200  RETURN 
4210  REM*******************
4220  REM*** MODIFY CODES IN INDEXF WHEN UPDATING INDEXC.
4230  REM*******************
4240  READ #1,B
4250  READ #3,1
4260  FOR K=1 TO 4
4270  READ #1;F$,D
4280  MAT  READ #1;C
4290  FOR Z=1 TO X
4300  IF C[Z]#R THEN 4340
4310  LET C[Z]=C
4320  LET D=J
4330  GOTO 4350
4340  NEXT Z
4350  PRINT #3;F$,D
4360  MAT  PRINT #3;C
4370  NEXT K
4380  REM* COPY BACK FROM INDEXW.
4390  GOSUB 3870
4400  RETURN 
9000  REM****************************************************************
9010  REM*** INITIALIZE FILES, ONCE ONLY, AT SYSTEM SETUP; OR FILE ENLARGING.
9020  REM****************************************************************
9030  LET D=0
9040  LET F$=B$
9050  MAT C=ZER
9060  LET C$=B$[1,20]
9070  IF  END #1 THEN 9120
9080  IF  END #2 THEN 9140
9090  PRINT #1;F$,D
9100  MAT  PRINT #1;C
9110  GOTO 9090
9120  PRINT #2;C$,D
9130  GOTO 9120
9140  PRINT "BOTH FILES NOW INTIALIZED.  PREVIOUS CONTENTS ERASED!"
9999  END 
