1 '*************************************
2 '*  A U T O F I L E  -  T D KOLOUCH  *
3 '*                                   *
4 '*  CUSTOM DATA SERVICES, INC.       *
5 '*  PO BOX 13                        *
6 '*  CROMWELL, CT  06416              *
7 '*  TEL# 203-635-1589                *
8 '*************************************
9 GOTO 100
10 'Fix to line 5100 has been merged in this copy.
11 ' *** Input routine ***
12 '
13 IN$ = STRING$(ABS(FL)," "):WD%=0:WS%=0:WL%=0:RC%=0:W$=" "
14 PRINT STRING$(ABS(FL),".");:LOCATE ,POS(0)-ABS(FL)
15 LOCATE ,,1:W$ = INKEY$:IF W$ = "" THEN 15 ELSE IF LEN(W$) = 2 THEN 22
16 IF ABS(FL) = WL% THEN 19 ELSE IF FL>0 AND W$>=" " AND W$<=CHR$(126) THEN 29 ELSE IF FL<0 AND W$>"/" AND W$<":" THEN 29
17 IF W$="." AND WD%=0 THEN WD%=1:GOTO 29
18 IF (W$="-" OR W$="+") AND WS%=0 AND WL%=0 THEN WS%=1:GOTO 29
19 IF W$ = CHR$(8) AND WL%>0 THEN GOSUB 30:MID$(IN$,WL%,1)=" ":WL%=WL%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 15
20 IF W$ = CHR$(27) THEN LOCATE ,POS(0)-WL%:GOTO 13
21 IF W$ = CHR$(13) THEN GOTO 28 ELSE GOTO 15
22 W$ = RIGHT$(W$,1)
23 IF W$ = CHR$(75) AND WL%>0 THEN GOSUB 30:MID$(IN$,WL%,1)=" ":WL%=WL%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 15
24 IF W$ >= CHR$(59) AND W$ <= CHR$(68) AND WL%=0 THEN RC% = ASC(W$)-58:GOTO 28
25 IF W$=CHR$(72) AND WL%=0 THEN RC%=11:GOTO 28
26 IF W$=CHR$(80) AND WL%=0 THEN RC%=12:GOTO 28
27 GOTO 15
28 PRINT STRING$(ABS(FL)-WL%," ");:IN$ = LEFT$(IN$,WL%):LOCATE ,,0:RETURN
29 PRINT W$;:WL%=WL%+1:MID$(IN$,WL%,1)=W$:IF ABS(FL) = 1 THEN 31 ELSE GOTO 15
30 IF MID$(IN$,WL%,1)="." THEN WD%=0 ELSE IF (MID$(IN$,WL%,1)="+" OR MID$(IN$,WL%,1)="-") THEN WS%=0
31 LOCATE ,,0:RETURN
35 '  ** End of input routine  **
100 KEY OFF:FOR X=1 TO 10:KEY X,"":NEXT:WIDTH "LPT1:",255:LOCATE ,,0,2,10
105 DEFINT A-Z:B$=SPACE$(80):B1$=SPACE$(40):ZZ=0:DF$="N"
110 DIM M$(20),KW$(42),NT$(42),KP(42),DL(100),JP$(127)
130 DATA 01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21
131 DATA 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42
140 FOR X = 1 TO 42:READ NT$(X):NEXT
300 CLS:COLOR 15,0:LOCATE 4,25:PRINT STRING$(31,"*"):PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*"
305 PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*"
306 PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)STRING$(31,"*")
310 LOCATE 6,31:PRINT "Welcome to AUTOFILE":LOCATE 8,38:PRINT "from":LOCATE 10,28:PRINT "CUSTOM DATA SERVICES, INC":LOCATE 12,37:PRINT "Ver 1.0":COLOR 7,0
320 GOSUB 6000
500 ON ERROR GOTO 6100
510 LOCATE 17,25:PRINT "> Enter filespec: ";:FL=8:GOSUB 10:IF IN$ = "" THEN CLS:SYSTEM
520 P=INSTR(IN$,".")
530 IF P>0 THEN E$="INVALID -- NO EXTENSION ALLOWED":GOSUB 6010:GOTO 510
540 FS$=IN$
550 OPEN"I",1,FS$+".KEY":ON ERROR GOTO 9000
560 FOR X=1 TO 42:INPUT#1,KW$(X),KP(X):NEXT
570 INPUT #1,KI,KD:CLOSE 1
580 OPEN"R",2,FS$+".IND",256
590 FOR X=1 TO 127:FIELD#2,(X-1)*2ASDU$,2ASJP$(X):NEXT
600 FIELD#2,254ASDU$,2ASJX$
610 OPEN"R",3,FS$+".DAT",256
620 FOR X=1 TO 3:FIELD#3,(X-1)*82ASDU$,80ASHD$(X),2ASHB$(X):NEXT
630 FIELD#3,246ASDU$,2ASHF$,2ASHN$
1000 'Menu
1010 CLS:F$="N"
1020 GOSUB 6070:LOCATE 24,1:PRINT "MAINTENANCE MENU:      " TAB(26)"- Keywords" TAB(42)"- Data" TAB(55)"- End program";:COLOR 0,7:LOCATE 24,24:PRINT "K";:LOCATE 24,40:PRINT "D";:LOCATE 24,53:PRINT "E";:COLOR 7,0
1030 GOSUB 6200
1040 IF IN$="K" OR IN$="k" THEN 2000 ELSE IF IN$="D" OR IN$="d" THEN 3000 ELSE IF IN$="E" OR IN$="e" THEN 4000
1050 GOTO 1030
2000 'Index
2010 CLS
2020 GOSUB 6070:GOSUB 6220
2030 LOCATE 24,1:PRINT "KEYWORD MAINTENANCE:       - Add      - Delete      - Return to menu";:COLOR 0,7:LOCATE 24,26:PRINT "A";:LOCATE 24,37:PRINT "D";:LOCATE 24,51:PRINT "R";:COLOR 7,0
2040 GOSUB 6200:IF IN$="R" OR IN$="r" THEN 1000
2050 IF IN$="D" OR IN$="d" THEN 2300
2055 GOSUB 6080
2060 IF IN$<>"A" AND IN$<>"a" THEN 2030
2070 'Add keys
2080 LOCATE 24,1:PRINT "- ADD -             Enter keyword: ";:FL=12:GOSUB 10:GOSUB 6080:IF IN$="" THEN 2030
2090 IF LEN(IN$)<2 THEN E$="KEYWORDS CANNOT BE ONE CHARACTER LONG":GOSUB 6010:GOTO 2080
2095 IF LEN(IN$)=2 THEN IF IN$>"00" AND IN$<"43" THEN E$="KEYWORD OF 01 TO 42 NOT ALLOWED":GOSUB 6010:GOTO 2080
2100 FOR X=1 TO 42
2110 IF KW$(X)=IN$ THEN E$="DUPLICATE KEYWORD":GOSUB 6010:GOTO 2080
2120 NEXT
2122 FOR X=1 TO 42:IF KP(X)=0 THEN 2130 ELSE NEXT
2125 E$="KEYWORD FILE FULL":GOSUB 6010:GOTO 2030
2130 KW$(X)=IN$:SK$="Y"
2140 IF X>28 THEN DX=X-25:DY=54 ELSE IF X>14 THEN DX=X-11:DY=30 ELSE DX=X+3:DY=6
2150 LOCATE DX,DY:PRINT KW$(X);:LOCATE 24,1:PRINT "Initializing index record";:GOSUB 6300:KP(X)=XI:GOSUB 7150:GOSUB 7160
2155 GOSUB 6080
2160 LOCATE 24,1:PRINT "Reindexing with new keyword";
2170 XD=1:SV$=KW$(X):C=0
2180 GOSUB 6350
2190 IF RK$="Y" THEN GOSUB 6400:C=C+1:LOCATE 24,75:PRINT C;:XD=XD+1:GOTO 2180
2200 GOSUB 6080:GOTO 2030
2300 'Del keys
2310 GOSUB 6080
2320 LOCATE 24,1:PRINT "- DELETE -          Enter keyword #: ";:FL=-2:GOSUB 10:GOSUB 6080:IF IN$="" THEN 2030
2340 N=VAL(IN$):IF N<1 OR N>42 THEN E$="NUMBER MUST BE FROM 1 TO 42":GOSUB 6010:GOTO 2320
2350 IF KP(N)=0 THEN E$="KEYWORD NUMBER NOT IN USE":GOSUB 6010:GOTO 2320
2360 XI=KP(N):LOCATE 24,1:PRINT "Deleting keyword chain";
2370 GOSUB 7100:IS=CVI(JX$):IX=KI:GOSUB 7150:GOSUB 7160
2380 KI=XI:SK$="Y"
2390 IF IS>0 THEN XI=IS:GOTO 2370
2400 KP(N)=0:KW$(N)="":IF N>28 THEN DX=N-25:DY=54 ELSE IF N>14 THEN DX=N-11:DY=30 ELSE DX=N+3:DY=6
2410 LOCATE DX,DY:PRINT SPC(12);
2420 GOSUB 6080:GOTO 2030
3000 'Data
3010 CLS:GOSUB 6070:F$="N"
3020 LOCATE 24,1:PRINT "DATA MAINT:     dd    dit    elete    rint    ext    ind    eturn";:COLOR 0,7:LOCATE 24,16:PRINT "A";:LOCATE 24,22:PRINT "E";:LOCATE 24,29:PRINT "D";:LOCATE 24,38:PRINT "P";
3025 LOCATE 24,46:PRINT "N";:LOCATE 24,53:PRINT "F";:LOCATE 24,60:PRINT "R";:COLOR 7,0
3030 GOSUB 6200:PP=INSTR("AaEeDdPpNnFfRr",IN$):GOSUB 6080
3040 ON PP GOTO 3060,3060,3200,3200,3300,3300,3400,3400,3700,3700,3500,3500,3760,3760
3050 GOTO 3020
3060 'Add
3065 IF DF$="Y" THEN GOSUB 8200
3070 CLS:GOSUB 6070:F$="N":LOCATE 24,1:PRINT "- ADD -";:GOSUB 6075
3080 GOSUB 6000:GOSUB 5000:GOSUB 6080
3090 FOR X=1 TO 20:IF M$(X)<>B$ THEN 3100 ELSE NEXT :GOTO 3000
3100 GOSUB 6780:FR=XD:GF=FR:GOSUB 6600:GOSUB 6880
3110 F$="Y":GOTO 3020
3200 'Edit
3205 IF DF$="Y" THEN GOSUB 8200
3210 IF F$<>"Y" THEN E$="EDIT WHAT?  --  DO IND FIRST":GOSUB 6010:GOTO 3020
3220 LOCATE 24,1:PRINT "- EDIT -";:GOSUB 6075
3230 GOSUB 5000:GOSUB 6080
3240 FOR X=1 TO 20:IF M$(X)<>B$ THEN 3255 ELSE NEXT
3245 IF XD<>GF THEN XD=GF:GOSUB 7200
3250 GOSUB 6840:GOSUB 8000:GOTO 3000
3255 IF XD<>GF THEN XD=GF:GOSUB 7200
3260 GOSUB 6600:GOSUB 6880
3270 GOTO 3020
3300 'Del
3310 IF F$<>"Y" THEN E$="DELETE WHAT?  --  DO IND FIRST":GOSUB 6010:GOTO 3020
3320 LOCATE 24,1:PRINT "- DELETE -            Confirm delete (Y or N) ";:GOSUB 6200:IF IN$="N" OR IN$="n" THEN 3000
3330 IF IN$<>"Y" AND IN$<>"y" THEN 3320
3335 IF XD<>FR THEN XD=FR:GOSUB 7200
3340 GOSUB 6080:GOSUB 6840:GOSUB 8000:F$="D":CLS:GOSUB 6070:GOTO 3020
3400 'Print
3410 IF F$<>"Y" THEN E$="PRINT WHAT?  --  DO IND FIRST":GOSUB 6010:GOTO 3020
3420 LOCATE 24,1:PRINT "- PRINT -         Press 'P' to print or 'C' to cancel";:GOSUB 6200:IF IN$="C" OR IN$="c" THEN 3020 ELSE IF IN$<>"P" AND IN$<>"p" THEN 3420
3430 FOR X=1 TO 20:LPRINT M$(X):NEXT
3440 GOSUB 6080:GOTO 3020
3500 'Find
3510 CLS:GOSUB 6070:GOSUB 6220
3520 XD=1:XE=0:LOCATE 24,1:PRINT "- FIND -     Enter number of keyword or string to search for: ";:FL=15:GOSUB 10:IF IN$="" OR IN$=STRING$(LEN(IN$)," ") THEN 3000 ELSE GOSUB 6080
3530 IN=VAL(IN$)
3540 IF LEN(IN$)<3 AND IN<43 AND IN>0 AND KP(IN)<>0 THEN 3600
3545 'Find string
3550 SV$=IN$:F$="N"
3560 LOCATE 24,1:PRINT "Search on string = ";SV$;
3570 GOSUB 6350:GOSUB 6080:IF RK$="E" THEN E$="END OF FILE":GOSUB 6010:IF F$="N" THEN 3520 ELSE GOTO 3020
3590 XE=XD:XD=GF:GOSUB 7200:GOSUB 8050:GOTO 3020
3600 'Find key
3610 SV$="":XI=KP(IN):GOSUB 7100:GOSUB 7130:LP=0:F$="N"
3620 IF LP=127 THEN 3670
3630 FOR LX=LP+1 TO 127
3640 IP=CVI(JP$(LX)):IF IP=0 THEN 3670
3650 XD=IP:GOSUB 7200:IF GF<>0 THEN GOSUB 8050:LP=LX:GOTO 3020
3660 NEXT LX
3670 IF IX>0 THEN XI=IX:GOSUB 7100:GOSUB 7130:LP=0:GOTO 3630
3675 E$="END OF INDEX":GOSUB 6010:IF F$="N" THEN 3520 ELSE 3020
3700 'Next
3710 IF F$<>"Y" AND F$<>"D" THEN E$="NEXT WHAT?  --  DO IND FIRST":GOSUB 6010:GOTO 3020
3720 IF SV$="" THEN 3620 ELSE XD=XE+1:GOTO 3560
3750 'Return
3760 GOTO 1000
4000 'End
4005 IF DF$="Y" THEN GOSUB 8200
4010 CLS
4020 IF SK$="Y" THEN GOSUB 7000
4030 CLOSE : SYSTEM
5000 ' ** Full screen editor **
5010 LOCATE 3,1,1
5020 WC%=1:WR%=1
5030 W$=INKEY$:IF W$="" THEN 5030
5040 IF W$>= CHR$(32) AND W$<= CHR$(126) THEN 5230 ELSE IF LEN(W$) = 2 THEN 5090
5050 IF W$=CHR$(8) THEN IF WC%>1 THEN WC%=WC%-1:PRINT CHR$(29);:GOTO 5030 ELSE IF WR%>0 THEN WR%=WR%-1:LOCATE WR%+2,80:WC%=80:GOTO 5030
5060 IF W$=CHR$(9) THEN LOCATE WR%+2,80:WC%=80:GOTO 5030
5070 IF W$=CHR$(13) THEN IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,1:WC%=1:GOTO 5030
5080 GOTO 5030
5090 W$=RIGHT$(W$,1)
5100 IF W$=CHR$(75) THEN IF WC%>1 THEN WC%=WC%-1:PRINT CHR$(29);:GOTO 5030 ELSE IF WR%>1 THEN WR%=WR%-1:LOCATE WR%+2,80:WC%=80:GOTO 5030
5110 IF W$=CHR$(15) THEN LOCATE WR%+2,1:WC%=1:GOTO 5030
5120 IF W$=CHR$(77) THEN IF WC%<80 THEN PRINT CHR$(28);:WC%=WC%+1:GOTO 5030 ELSE IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,1:WC%=1:GOTO 5030
5130 IF W$=CHR$(72) THEN IF WR%>1 THEN WR%=WR%-1:LOCATE WR%+2,WC%:GOTO 5030
5140 IF W$=CHR$(80) THEN IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,WC%:GOTO 5030
5150 IF W$=CHR$(73) OR W$=CHR$(71) THEN 5010
5160 IF W$=CHR$(81) THEN LOCATE 22,1:WR%=20:WC%=1:GOTO 5030
5170 IF W$=CHR$(82) THEN IF WC%<80 THEN LOCATE,,0:W1$=" "+MID$(M$(WR%),WC%,80-WC%):MID$(M$(WR%),WC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 5030
5180 IF W$=CHR$(83) THEN IF WC%<80 THEN LOCATE,,0:W1$=+MID$(M$(WR%),WC%+1,81-WC%)+" ":MID$(M$(WR%),WC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 5030
5190 IF W$=CHR$(59) OR W$=CHR$(61) THEN GOSUB 5270:GOTO 5030
5200 IF W$=CHR$(60) THEN GOSUB 5350:GOTO 5030
5210 IF W$=CHR$(62) THEN 5260
5220 GOTO 5030
5230 PRINT W$;:MID$(M$(WR%),WC%,1)=W$:WC%=WC%+1
5240 IF WC%>80 THEN IF WR%<20 THEN WR%=WR%+1:WC%=1:LOCATE WR%+2,1 ELSE WC%=80:PRINT CHR$(29);
5250 GOTO 5030
5260 LOCATE ,,0:RETURN
5270 'OPEN/RPT RTN
5280 LOCATE,,0
5290 IF WR%=20 THEN 5330
5300 FOR W% = 20 TO WR%+1 STEP -1
5310 M$(W%)=M$(W%-1):LOCATE W%+2,1:PRINT M$(W%);
5320 NEXT
5330 IF W$=CHR$(59) THEN M$(WR%)=SPACE$(80)
5340 LOCATE WR%+2,1:PRINT M$(WR%);:PRINT STRING$(81-WC%,29);:LOCATE,,1:RETURN
5350 'CLOSE RTN
5360 LOCATE,,0
5370 IF WR%=20 THEN 5410
5380 FOR W% = WR% TO 19
5390 M$(W%)=M$(W%+1):LOCATE W%+2,1:PRINT M$(W%);
5400 NEXT
5410 M$(20)=SPACE$(80):LOCATE 22,1:PRINT M$(20);
5420 LOCATE WR%+2,WC%,1:RETURN
5430 ' ** End of full screen routine **
6000 FOR X=1 TO 20 :M$(X)=B$:NEXT :RETURN
6010 'Error
6015 BEEP
6020 COLOR 31:LOCATE 25,40-(LEN(E$)/2),0:PRINT E$;
6030 EKEY$=INKEY$:IF EKEY$<>CHR$(27) THEN 6030 ELSE COLOR 7:LOCATE 25,1:PRINT SPC(79);:LOCATE ,,1:RETURN
6070 PRINT FS$ " " STRING$(29-LEN(FS$),"-") " ";:COLOR 0,7:PRINT " A U T O F I L E ";:COLOR 7,0:PRINT " " STRING$(20,"-") " " DATE$;:LOCATE 23,1:PRINT STRING$(80,223);:RETURN
6075 LOCATE 24,22:PRINT "- Open       - Close       - Repeat       - End";:COLOR O,7:LOCATE 24,19:PRINT "F1";:LOCATE 24,32:PRINT "F2";:LOCATE 24,46:PRINT "F3";:LOCATE 24,61:PRINT "F4";:COLOR 7,0:RETURN
6080 LOCATE 24,1:PRINT SPC(79);:RETURN
6100 LOCATE 19,25:PRINT "> File not found. Create? (Y or N) ";:FL=1:GOSUB 10:IF IN$="" THEN 6100
6110 IF IN$<>"N" AND IN$<>"n" AND IN$<>"Y" AND IN$<>"y" THEN 6100
6120 LOCATE 19,25:PRINT B1$;:IF IN$= "N" OR IN$ ="n" THEN RESUME 510
6160 D=0
6170 OPEN "O",1,FS$+".KEY":GOSUB 7020
6180 OPEN "R",2,FS$+".IND":OPEN "R",3,FS$+".DAT"
6190 CLOSE:ON ERROR GOTO 9000:RESUME 580
6200 LOCATE 24,75:PRINT "==> ";:FL=1:GOSUB 10:IF IN$="" THEN 6200
6210 LOCATE 24,75:PRINT SPC(5);:RETURN
6220 'Paint keys
6230 D=0:DX=4:DY=2:FOR X = 1 TO 42:LOCATE DX,DY+D:PRINT NT$(X)+")" " " KW$(X);:DX=DX+1
6240 IF DX>17 THEN DX=4:D=D+24
6250 NEXT :RETURN
6300 'Next avail indx
6310 IF KI=0 THEN XI=(LOF(2)/256)+1:GOTO 6330
6320 XI=KI:GOSUB 7110:KI=CVI(JX$):SK$="Y"
6330 FOR Z=1 TO 127:LSET JP$(Z)=MKI$(ZZ):NEXT :IX=0
6340 RETURN
6350 'String search
6360 IF XD>LOF(3)/256 THEN RK$="E":GOTO 6395
6370 GOSUB 7210
6380 FOR Z=1 TO 4:P=INSTR(HD$(Z),SV$):IF P>0 THEN RK$="Y":GOTO 6395 ELSE NEXT
6390 XD=XD+1:GOTO 6360
6395 RETURN
6400 'Add to indx
6410 IF KP(X)=XI THEN 6440
6420 XI=KP(X)
6430 GOSUB 7100:GOSUB 7130
6440 FOR Z=1 TO 127
6445 IP=CVI(JP$(Z))
6450 IF IP=GF THEN 6560
6455 IF IP=0 THEN 6470
6460 NEXT Z
6470 IF IX>0 THEN XI=IX:GOTO 6430
6480 IF KP(X)=XI THEN 6510
6490 XI=KP(X)
6500 GOSUB 7100:GOSUB 7130
6510 FOR Z=1 TO 127
6515 IP=CVI(JP$(Z))
6520 IF IP=0 THEN LSET JP$(Z)=MKI$(GF):GOSUB 7150:GOSUB 7160:GOTO 6560
6530 NEXT Z
6540 IF IX>0 THEN XI=IX:GOTO 6500
6550 GOSUB 6300:GOTO 6500
6560 RETURN
6600 'Add/rew
6610 LOCATE 24,1:PRINT "Adding/rewriting page";
6620 Y=1:Z=0
6630 FOR X=1 TO 20
6640 IF X+Z+1=21 THEN 6670
6650 IF M$(X+Z+1)<>B$ THEN 6670
6660 Z=Z+1:GOTO 6640
6670 GOSUB 6730:X=X+Z:Z=0
6680 NEXT X
6690 X1=GN:GN=0:GOSUB 7220
6700 IF X1=0 THEN 6720
6710 XD=X1:GOSUB 7200:GOSUB 6840
6720 GOSUB 6080:RETURN
6730 'Load buf
6740 IF Y<>4 THEN 6770
6760 IF GN>0 THEN GOSUB 7220:XD=GN:GOSUB 7200:GOSUB 6810:GOTO 6765
6762 IF KD>0 THEN GN=KD ELSE GN=(LOF(3)/256)+1:IF GN=XD THEN GN=GN+1
6764 GOSUB 7220:GOSUB 6780
6765 Y=1
6770 LSET HD$(Y)=M$(X):LSET HB$(Y)=MKI$(Z):Y=Y+1:RETURN
6780 'Get next
6790 IF KD>0 THEN XD=KD:GOSUB 7200:KD=GN:SK$="Y" ELSE XD=(LOF(3)/256)+1
6800 GOSUB 6810:GF=FR:GN=0:RETURN
6810 'Init
6820 FOR X7=1 TO 3:LSET HD$(X7)=B1$:LSET HB$(X7)=MKI$(ZZ):NEXT
6830 RETURN
6840 'Del page
6850 X1=GN:GN=KD:KD=XD:GOSUB 6810:GF=0:GOSUB 7220:SK$="Y"
6860 IF X1>0 THEN XD=X1:GOSUB 7200:GOTO 6850
6870 RETURN
6880 'Indx page
6885 LOCATE 24,1:PRINT "Indexing file";
6890 FOR X = 1 TO 42
6900 IF KP(X)=0 THEN 6930
6905 FOR Y = 1 TO 20
6910 IF M$(Y)=B$ THEN 6925
6915 P=INSTR(M$(Y),KW$(X))
6920 IF P>0 THEN GOSUB 6400:GOTO 6930
6925 NEXT Y
6930 NEXT X
6935 GOSUB 6080:RETURN
7000 'Write keys
7010 OPEN "O",1,FS$+".KEY"
7020 FOR Z=1 TO 42:WRITE#1,KW$(Z),KP(Z):NEXT
7030 WRITE#1,KI,KD
7040 CLOSE 1:RETURN
7100 'Indx I/O
7110 GET 2,XI:RETURN
7130 IX=CVI(JX$):RETURN
7150 LSET JX$=MKI$(IX):RETURN
7160 PUT 2,XI:RETURN
7200 'Data I/O
7210 GET 3,XD:GF=CVI(HF$):GN=CVI(HN$):RETURN
7220 LSET HF$=MKI$(GF):LSET HN$=MKI$(GN):PUT 3,XD:RETURN
8000 'Add del list
8010 FOR Z=1 TO 100
8020 IF DL(Z)=0 THEN DL(Z)=FR:GOTO 8040
8030 NEXT
8040 DF$="Y":RETURN
8050 'Paint page
8060 FR=GF:CLS:GOSUB 6070:GOSUB 6000
8070 LY=1
8080 FOR LZ=1 TO 3
8085 IF LY>20 THEN 8130
8090 LOCATE LY+2,1:PRINT HD$(LZ);:M$(LY)=HD$(LZ)
8100 LY=LY+CVI(HB$(LZ))+1
8110 NEXT
8120 IF GN>0 THEN XD=GN:GOSUB 7200:GOTO 8080
8130 F$="Y":RETURN
8200 'Indx del maint
8205 GOSUB 6080:LOCATE 24,1:PRINT "Performing index file maintenance";
8210 FOR L=1 TO 42
8220 IF KP(L)=0 THEN 8340
8230 XI=KP(L)
8240 GOSUB 7100:GOSUB 7130
8250 FOR M=1 TO 127
8260 IP=CVI(JP$(M))
8270 IF IP=0 THEN 8320
8280 FOR N=1 TO 100
8290 IF DL(N)=0 THEN 8310
8300 IF IP=DL(N) THEN LSET JP$(M)=MKI$(ZZ):A$="Y" ELSE NEXT N
8310 NEXT M
8320 IF A$="Y" THEN GOSUB 8400:A$="N"
8330 IF IX>0 THEN XI=IX:GOTO 8240
8340 NEXT L
8350 DF$="N"
8360 FOR L=1 TO 100
8365 IF DL(L)=0 THEN 8390
8370 DL(L)=0
8380 NEXT
8390 RETURN
8400 'Shrink
8410 FOR M1=1 TO 126
8420 IP=CVI(JP$(M1))
8430 IF IP>0 THEN 8480
8440 FOR N1=M1+1 TO 127
8450 IQ=CVI(JP$(N1))
8460 IF IQ>0 THEN LSET JP$(M1)=MKI$(IQ):LSET JP$(N1)=MKI$(ZZ):GOTO 8480
8470 NEXT N1:GOTO 8490
8480 NEXT M1
8490 GOSUB 7160:RETURN
9000 RESUME