0010 REM "FIDO   File Doctor 3.0 - File Doctor Utilities"
0011 REM "Copyright (c) 1999 Computer Consulting and Software"
0020 BEGIN 
0030 PRINT 'BACKGR',$1B04$+"BLUE",'DEFAULT','CS','YELLOW',
0035 REM SET FUNCTION KEYS
0040 PRINT (0)'EE'+'CI'+'WINDOW'("LIST"),
0050 READ RECORD(0,SIZ=1)WINS$
0060 READ RECORD(0,SIZ=ASC(WINS$))X$
0070 PRINT (0)'BE',
0080 LET WINS=ASC(WINS$)
0090 REM   SETESC 9904
0100 PRINT 'EL',"2"+CHR(0)+CHR(2)+"-"+$0D$
0110 PRINT 'FL',"2"+CHR(11)+CHR(2)+"-"+$0D$
0120 PRINT 'EL',"2"+CHR(1)+CHR(2)+"+"+$0D$
0130 PRINT 'FL',"2"+CHR(12)+CHR(2)+"+"+$0D$
0140 PRINT 'EL',"2"+CHR(2)+CHR(2)+"<"+$0D$
0150 PRINT 'EL',"2"+CHR(3)+CHR(2)+">"+$0D$
0160 PRINT 'FL',"2"+CHR(0)+CHR(2)+"H"+$0D$
0170 PRINT 'FL',"2"+CHR(1)+CHR(2)+"A"+$0D$
0180 PRINT 'FL',"2"+CHR(2)+CHR(2)+"D"+$0D$
0190 PRINT 'FL',"2"+CHR(3)+CHR(2)+"C"+$0D$
0200 PRINT 'FL',"2"+CHR(4)+CHR(2)+"P"+$0D$
0210 PRINT 'FL',"2"+CHR(5)+CHR(2)+"K"+$0D$
0220 PRINT 'FL',"2"+CHR(6)+CHR(2)+"Q"+$0D$
0230 PRINT 'FL',"2"+CHR(7)+CHR(2)+"J"+$0D$
0240 PRINT 'FL',"2"+CHR(8)+CHR(2)+"*"+$0D$
0250 PRINT 'FL',"2"+CHR(9)+CHR(2)+"S"+$0D$
0260 LET B$=FILL(10),TYPE$=FILL(6),FIRST=1,TKEY$=" Key:"
0270 GOSUB SCREEN
0280 REM .....................GOSUB HELP
0290 PRINT 'CYAN','WINDOW'(14,12,52,3,""),'CS',
0300 LET KNMB=0
0310 OPEN (82,ERR=0320)"FIDOLST"; GOTO 0340
0320 MKEYED "FIDOLST",4,0,42
0330 OPEN (82)"FIDOLST"
0340 READ (82,KEY="L",DOM=0350)FIDOLST$
0350 PRINT @(1,0),'CYAN',"File: ",'YELLOW',
0360 INPUT FILE$
0370 IF FILE$="*" THEN LET FILE$=FIDOLST$
0380 IF FILE$="H" OR FILE$="h" THEN GOSUB HELP; GOTO 0350
0390 IF FILE$="Q" OR FILE$="q" OR FILE$="EXIT" THEN GOTO 9904
0400 IF FILE$="" THEN GOTO 0350
0410 OPEN (81,ERR=0420)FILE$; GOTO 0460
0420 PRINT 'CYAN','WINDOW'(14,12,52,3,""),'CS',
0430 PRINT @(1,0),'YELLOW',FILE$,'CYAN'," not found... press <Enter>",; INPUT 
0430:*
0440 PRINT 'POP',
0450 GOTO 0350
0460 PRINT 'POP',
0470 LET B$=FID(81),REC=0,KS=0,C=0,MULT$="N",DEFREC=DEC(B$(3,4)),DEFREC$="Def'
0470:d Recs: "+STR(DEFREC); IF DEFREC=0 THEN LET DEFREC$=""
0480 IF B$(1,1)=$00$ THEN LET TYPE$="Indexed",TKEY$=" Ind:"
0490 IF B$(1,1)=$01$ THEN LET TYPE$="Serial"
0500 IF B$(1,1)=$02$ THEN LET TYPE$="Direct",TKEY$=" Key:"
0510 IF B$(1,1)=$03$ THEN LET TYPE$="String"
0520 IF B$(1,1)=$04$ THEN LET TYPE$="Program"
0530 IF B$(1,1)=$05$ THEN LET TYPE$="System"
0540 IF B$(1,1)=$06$ THEN LET TYPE$="Mkeyed",TKEY$=" Key:"
0541 IF B$(1,1)=$46$ THEN LET TYPE$="Mkyd HR",TKEY$=" Key:"
0542 IF B$(1,1)=$66$ THEN LET TYPE$="Mkyd HR",TKEY$=" Key:"
0543 IF B$(1,1)=$86$ THEN LET TYPE$="Mkyd HR",TKEY$=" Key:"
0544 IF B$(1,1)=$C6$ THEN LET TYPE$="Mkyd HR",TKEY$=" Key:"
0550 IF TYPE$(1,1)="P" THEN GOSUB PRGM; CLOSE (82); GOTO DONE
0560 IF TYPE$(2,1)="y" THEN GOSUB SYSTEM; CLOSE (82); GOTO DONE
0570 WRITE (82,KEY="L")FILE$
0580 IF TYPE$(2,1)="t" THEN GOSUB STRG; CLOSE (82); GOTO DONE
0590 CLOSE (82)
0600 IF TYPE$(1,1)<>"M" AND TYPE$(1,1)<>"I" AND TYPE$(1,1)<>"D" THEN GOTO DONE
0600:; REM ...............TO BE REMOVED.......
0610 LET C$=FIN(81)
0620 IF TYPE$(1,1)<>"M" AND TYPE$(1,1)<>"D" THEN GOTO 0670
0630 LET C=DEC(C$(77,4))
0640 LET KS=ASC(B$(2,1)),MULT$="N",KSS=KS
0650 IF KS=0 THEN LET KS=DEC(C$(90,1)),MULT$="Y",KSS=KS
0660 IF MULT$="Y" THEN GOSUB MULTKEY
0670 LET RECSZ=DEC(B$(7,2))
0680 GOSUB SCREEN
0690 GOTO 0810
0700 SCREEN: REM 
0710 PRINT 'CS',
0720 LET PREF$=PFX; IF LEN(PREF$)>72 THEN LET PREF$=PREF$(1,71)+">"
0730 IF FIRST=1 THEN PRINT 'BACKGR',$1B07$+"MAGENTA",@(20,4),FILL(40),@(20,5),
0730:FILL(40),@(20,6),FILL(40),@(20,7),FILL(40),@(20,8),FILL(40),@(20,9),FILL(
0730:40),@(32,4),"File Doctor 3.0",@(28,6),"Copyright 1999, CCS, Inc.",@(26,7)
0730:,"For Advanced File Repair Call",@(32,8),"(949) 855-9020",'BACKGR',$1B05$
0730:+"BLACK",@(22,10),FILL(40),@(60,5),"  ",@(60,6),"  ",@(60,7),"  ",@(60,8)
0730:,"  ",@(60,9),"  ",'BACKGR',$1B04$+"BLUE",; LET FIRST=2; PRINT @(0,22),'C
0730:YAN',"Current Directory: ",'YELLOW',DIR(""),@(0,23),'CYAN',"Prefix: ",'YE
0730:LLOW',PREF$,
0740 IF MULT$="Y" THEN PRINT 'CYAN',@(59,0),"   Key Size:",KS:"###",; LET KNMB
0740:$=STR(KNMB),MLTS$=STR(MLTS); PRINT " (",KNMB$,"/",MLTS$,")",
0750 IF MULT$<>"Y" THEN PRINT 'CYAN',@(59,0),"   Key Size:",KS:"#########",
0760 PRINT @(0,2),"Type: ",TYPE$,@(0,0),"Term: ",FID(0),@(12,0),"(Max Users:",
0760:DEC(INFO(2,0)),")",@(59,1),"   Rec Size:",RECSZ:"#########",
0770 PRINT @(59,2),"   # Fields:",
0780 PRINT @(59,3),"Recs in use:",@(0,3),TKEY$,; IF DEFREC<>0 THEN PRINT @(57-
0780:LEN(DEFREC$),3),DEFREC$,
0790 PRINT @(0,1),"File: ",B$(9),@(31,0),'BR','SB'," File Doctor 3.0 ",'ER','S
0790:F',@(15,2),"Command:     <F1> or 'H' for HELP ",'YELLOW',
0800 RETURN 
0810 IF TYPE$(1,1)="I" THEN READ RECORD(81,ERR=EMPTY)X$; LET SEQ=0; GOTO 1100
0820 EXTRACT (81,KEY="",DOM=0830)*
0830 LET FIRSTK$=KEY(81,ERR=EMPTY)
0840 LET ZZZ$=FILL(KS,CHR(254))
0850 READ (81,KEY=ZZZ$,DOM=0860)*
0860 LET LASTK$=KEYP(81)
0870 EXTRACT (81,KEY="",DOM=0880)*
0880 NEXTREC: 
0890 IF TYPE$(1,1)="I" THEN LET SEQ=SEQ+1; GOTO 1100
0900 EXTRACT RECORD(81,ERR=DONE)X$
0910 GOSUB FLD; GOTO 1120
0920 FLD: 
0930 LET FLD=0,FST=0,REC=REC+1
0940 LET Q$=HTA(X$),X=LEN(Q$)/2
0950 FOR I=1 TO X
0960 LET Y=(I*2)-1
0970 IF Q$(Y,2)="0A" OR Q$(Y,2)="0D" AND FST=0 THEN LET K=(I*2-2)/2,FST=1
0980 IF Q$(Y,2)="0A" OR Q$(Y,2)="0D" THEN LET FLD=FLD+1
0990 NEXT I
1000 PRINT @(71,2),'CYAN',FLD:"#########",
1010 PRINT @(71,3),'CYAN',C:"#########",
1020 LET L0=4; IF FLD=0 THEN DIM Z$[0]; GOTO 1040
1030 DIM Z$[FLD-1]
1040 IF TYPE$(1,1)="I" THEN LET KEY$=STR(SEQ:"######0"); GOTO 1060
1050 LET KEY$=KEY(81)
1060 LET PRINTKEY$=KEY$+CHR(254)+FILL(80),PRINTKEY$=PRINTKEY$(1,51-LEN(DEFREC$
1060:)); IF PRINTKEY$(LEN(PRINTKEY$),1)<>" " THEN LET PRINTKEY$(LEN(PRINTKEY$)
1060:,1)=">"
1070 PRINT 'YELLOW',@(6,3),PRINTKEY$,
1080 RETURN 
1090 IF SEQ=-1 THEN PRINT 'RB',; LET SEQ=0; GOTO 1190
1100 READ RECORD(81,IND=SEQ,END=1110)X$; GOSUB FLD; READ (81,IND=SEQ,END=1110)
1100:Z$[ALL]; GOSUB LNCLR; GOTO 1130
1110 LET SEQ=SEQ-1; PRINT 'RB',; GOTO 1190
1120 READ (81,KEY=KEY$)Z$[ALL]
1130 LET I=1
1140 IF I>FLD THEN GOTO 1570
1150 LET W$=Z$[I-1]+CHR(254); IF LEN(W$)>73 THEN LET W$=W$(1,72)+">"
1160 PRINT @(0,L0),'CYAN',I:"####",": ",'YELLOW',W$,
1170 LET L0=L0+1
1180 IF I/20<>INT(I/20) THEN GOTO 1440
1190 INPUT @(24,2),'YELLOW',Y$,; PRINT @(24,2),'CYAN',FILL(4),@(24,2),
1200 IF Y$="<" AND I>20 THEN LET I=((INT((I-1)/20)-1)*20); GOTO 1430
1210 IF Y$="<" THEN PRINT 'RB',; GOTO 1190
1220 IF Y$="-" AND KEY$=FIRSTK$ THEN PRINT 'RB',; GOTO 1190
1230 REM .....................IF Y$="-" AND REC=1 THEN PRINT 'RB',; GOTO 0850
1240 IF Y$="-" THEN GOTO 1760
1250 IF Y$="h" OR Y$="H" THEN GOSUB HELP; GOTO 1190
1260 IF (Y$="s" OR Y$="S") AND TYPE$(1,1)<>"I" THEN GOSUB MKEY; GOTO 1190
1270 IF (Y$="p" OR Y$="P") AND TYPE$(1,1)<>"I" THEN LET FLAG3=1; GOTO PURGE
1280 IF Y$="c" OR Y$="C" THEN GOSUB CHANGE; GOTO 1190
1290 IF (Y$="d" OR Y$="D") AND TYPE$(1,1)<>"I" THEN LET FLAG2=1; GOTO DLT
1300 IF Y$="q" OR Y$="Q" THEN GOTO DONE
1310 IF (Y$="l" OR Y$="L") AND TYPE$(1,1)<>"I" THEN GOTO LISTKEYS
1320 IF (Y$="z" OR Y$="Z") AND TYPE$(1,1)<>"I" THEN GOTO SIZE
1330 IF Y$="j" OR Y$="J" THEN GOTO JUMP
1340 IF (Y$="a" OR Y$="A") AND TYPE$(1,1)<>"I" THEN LET FLAG4=1; GOTO ADD
1350 IF (Y$="m" OR Y$="M") AND TYPE$(1,1)<>"I" THEN LET FLAG5=1; GOTO MRG
1360 IF Y$="k" OR Y$="K" AND MULT$="Y" THEN GOTO CHGKNUM
1370 IF Y$="x" OR Y$="X" THEN GOSUB SHOWPFX; GOTO 1190
1380 IF Y$=">" THEN GOTO 1430
1390 IF Y$<>"+" AND Y$<>"" THEN GOTO 1190
1400 IF KEY$=LASTK$ THEN PRINT 'RB',; GOTO 1190
1410 REM .........................IF REC=C THEN PRINT 'RB',; GOTO 0850
1420 GOTO 1780
1430 LET L0=4; GOSUB LNCLR
1440 LET I=I+1; GOTO 1140
1450 LNCLR: REM 
1460 FOR J=1 TO 20; PRINT @(0,J+3),'CL',; NEXT J
1470 RETURN 
1480 BACK: REM 
1490 IF TYPE$(1,1)="I" THEN LET SEQ=SEQ-1; EXITTO 1090
1500 LET KP$=KEYP(81)
1510 EXTRACT (81,KEY=KP$)
1520 LET REC=REC-1
1530 LET KP$=KEYP(81,END=DONE)
1540 EXTRACT (81,KEY=KP$)
1550 LET REC=REC-1
1560 RETURN 
1570 INPUT @(24,2),'YELLOW',Y$,; PRINT @(24,2),'CYAN',FILL(4),@(24,2),
1580 IF Y$="<" AND I>20 THEN GOTO 1200
1590 IF Y$="<" THEN PRINT 'RB',; GOTO 1570
1600 IF Y$=">" THEN PRINT 'RB',; GOTO 1570
1610 IF Y$="h" OR Y$="H" THEN GOSUB HELP; GOTO 1570
1620 IF (Y$="s" OR Y$="S") AND TYPE$(1,1)<>"I" THEN GOSUB MKEY; GOTO 1570
1630 IF (Y$="p" OR Y$="P") AND TYPE$(1,1)<>"I" THEN LET FLAG3=2; GOTO PURGE
1640 IF Y$="c" OR Y$="C" THEN GOSUB CHANGE; GOTO 1570
1650 IF (Y$="d" OR Y$="D") AND TYPE$(1,1)<>"I" THEN LET FLAG2=2; GOTO DLT
1660 IF Y$="q" OR Y$="Q" THEN GOTO DONE
1670 IF (Y$="l" OR Y$="L") AND TYPE$(1,1)<>"I" THEN GOTO LISTKEYS
1680 IF (Y$="z" OR Y$="Z") AND TYPE$(1,1)<>"I" THEN GOTO SIZE
1690 IF Y$="j" OR Y$="J" THEN GOTO JUMP
1700 IF (Y$="a" OR Y$="A") AND TYPE$(1,1)<>"I" THEN LET FLAG4=2; GOTO ADD
1710 IF (Y$="m" OR Y$="M") AND TYPE$(1,1)<>"I" THEN LET FLAG5=2; GOTO MRG
1720 IF Y$="k" OR Y$="K" AND MULT$="Y" THEN GOTO CHGKNUM
1730 IF Y$="x" OR Y$="X" THEN GOSUB SHOWPFX; GOTO 1570
1740 IF Y$="-" AND KEY$=FIRSTK$ THEN PRINT 'RB'; GOTO 1570
1750 REM ....................IF Y$="-" AND REC=1 THEN PRINT 'RB'; GOTO 1190
1760 IF Y$="-" THEN GOSUB BACK; GOTO 1800
1770 IF Y$<>"+" AND Y$<>"" THEN GOTO 1570
1780 IF KEY$=LASTK$ THEN PRINT 'RB',; GOTO 1570
1790 REM ........................IF REC=C THEN PRINT 'RB',; GOTO 1190
1800 IF TYPE$(1,1)<>"I" THEN GOSUB LNCLR
1810 GOTO NEXTREC
1820 DONE: REM 
1830 IF Y$="Q" OR Y$="q" THEN GOTO 1840
1840 CLOSE (81); GOTO 0290
1850 CHANGE: REM .........................CHANGE.............................
1860 LET X5=4,X6=1,FLAG=0
1870 PRINT 'GREEN','WINDOW'(0,0,80,X5,""),'CS',
1880 IF FLAG=1 THEN GOTO 1990
1890 PRINT 'CS','GREEN',@(1,0),"Enter Field # to be CHANGED: ",@(62,0),"<ENTER
1890:> to quit",@(41,1),"Type lowercase 'null' to clear field",
1900 INPUT @(30,0),'YELLOW',Y$,'GREEN',
1910 IF Y$="" THEN GOTO 2150
1920 LET N=NUM(Y$,ERR=1890); IF N<>INT(N) THEN GOTO 1890
1930 IF N>I OR N>FLD THEN GOTO 1890
1940 IF N<(INT((I-1)/20)*20)+1 THEN GOTO 1890
1950 LET KEEP$=Z$[N-1]
1960 LET CN=LEN(Z$[N-1])+6
1970 IF CN<78 THEN GOTO 1990
1980 LET CY=INT(CN/78),X5=(CY+2)*2,X6=CY+1,FLAG=1; PRINT 'POP'; GOTO 1870
1990 PRINT @(0,0),'CS','GREEN',"From: ",Z$[N-1],CHR(254),; IF FLAG=0 THEN PRIN
1990:T FILL(71-LEN(Z$[N-1])),
2000 PRINT @(2,X6),"To:",
2010 INPUT @(6,X6),'YELLOW',CHG$,
2020 IF CHG$="null" THEN LET CHG$=""; GOTO 2040
2030 IF CHG$="" THEN GOTO 2130
2040 LET Z$[N-1]=CHG$
2050 IF TYPE$(1,1)="I" THEN WRITE (81,IND=SEQ)Z$[ALL]; GOTO 2100
2060 EXTRACT (81,KEY=KEY$)
2070 IF MULT$="N" THEN WRITE (81,KEY=KEY$,ERR=2090)Z$[ALL]; GOTO 2100
2080 WRITE (81,ERR=2090)Z$[ALL]; GOTO 2100
2090 LET Z$[N-1]=KEEP$; GOTO 1990
2100 LET XX=(N-(INT((N-1)/20)*20))+3
2110 IF LEN(CHG$)>73 THEN PRINT 'POP',@(0,XX),'CL',@(0,XX),'GREEN',N:"####",":
2110: ",'YELLOW',CHG$(1,72)+">",; GOTO 2140
2120 PRINT 'POP',@(0,XX),'CL',@(0,XX),'GREEN',N:"####",": ",'YELLOW',CHG$,CHR(
2120:254),; GOTO 2140
2130 PRINT 'POP',
2140 GOTO CHANGE
2150 PRINT 'POP'
2160 RETURN 
2170 DLT: REM ................................DELETE......................
2180 PRINT 'GREEN','WINDOW'(0,0,80,4,""),
2190 PRINT 'CS','GREEN',@(1,0),"Type 'Y' to DELETE record: ",@(1,1),"(Key=",'Y
2190:ELLOW',KEY$,'GREEN',")",'YELLOW',
2200 INPUT @(28,0),Y$,'GREEN',
2210 IF Y$<>"Y" AND Y$<>"y" THEN GOTO 2360
2220 REMOVE (81,KEY=KEY$,ERR=2360)
2230 PRINT 'CS','GREEN',@(1,0),"Record ",'YELLOW',"DELETED.",'GREEN',
2240 PRINT @(1,1),"press <ENTER>",; INPUT XX$,
2250 IF C=1 THEN PRINT 'POP',; GOTO DONE
2260 IF KEY$<>LASTK$ THEN GOTO 2300
2270 LET KEY$=KEYP(81),LASTK$=KEY$
2280 LET C=C-1,DRCTN=1
2290 PRINT 'POP',; GOSUB 1520; GOTO 1800
2300 LET C=C-1
2310 IF KEY$<>FIRSTK$ THEN GOTO 2340
2320 EXTRACT (81,KEY="",DOM=2330)*
2330 LET FIRSTK$=KEY(81)
2340 PRINT 'POP',
2350 GOTO 1800
2360 PRINT 'POP',
2370 IF FLAG2=1 THEN GOTO 1190
2380 GOTO 1570
2390 HELP: REM .................................HELP...................
2400 PRINT 'BACKGR',$1B07$+"MAGENTA",'WHITE','WINDOW'(0,0,80,24,""),'BACKGR',$
2400:1B07$+"MAGENTA",'DEFAULT','CS','WHITE',
2410 PRINT @(1,0),'BR','SB'," File Doctor ",'ER','SF'," *** Help ***",@(65),"p
2410:ress <Enter>"
2420 PRINT @(1,2),'BR','SB'," Command               Description             ",
2420:'ER','SF',
2430 PRINT @(2,3),"Right Arrow or '+'    move FORWARD one RECORD"
2440 PRINT @(2,4),"Left Arrow  or '-'    move BACK one RECORD"
2450 PRINT @(2,5),"Down Arrow  or '>'    move FORWARD thru FIELDS"
2460 PRINT @(2,6),"Up Arrow    or '<'    move BACK thru FIELDS"
2470 PRINT @(2,7),"L                     LIST all keys in file"
2480 PRINT @(2,8),"Z                     Display largest key/record SIZE"
2490 PRINT @(2,9),"M                     MERGE records into current file"
2500 PRINT @(2,10),"X                     Display Current Directory and Prefix
2500:"
2510 PRINT @(2,11),"H or <F1>             HELP"
2520 PRINT @(2,12),"A or <F2>             ADD a record"
2530 PRINT @(2,13),"D or <F3>             DELETE a record"
2540 PRINT @(2,14),"C or <F4>             CHANGE a record field"
2550 PRINT @(2,15),"P or <F5>             PURGE all or part of FILE"
2560 PRINT @(2,16),"K or <F6>             Change KNUM to next KEY"
2565 PRINT @(2,17),"Q or <F7>             QUIT"
2580 PRINT @(2,18),"J or <F8>             JUMP anywhere in file"
2590 PRINT @(2,19),"* or <F9>             at 'File' prompt, re-loads last file
2590:"
2595 PRINT @(2,20),"S or <F10>            Display Mkey SEGMENTS"
2620 INPUT @(76,0),CCC$,
2630 PRINT 'POP','BACKGR',$1B04$+"BLUE",'YELLOW',; RETURN 
2640 PURGE: REM .............................................PURGE..........
2650 PRINT 'GREEN','WINDOW'(0,0,80,6,""),'CS','GREEN',
2660 PRINT @(1,0),"PURGE records...",
2670 PRINT @(1,1),"From Key:",
2680 PRINT @(1,2),"Thru Key:",
2690 INPUT @(11,1),'YELLOW',FKEY$,
2700 INPUT @(11,2),'YELLOW',TKEY$,
2710 IF TKEY$<FKEY$ THEN GOTO PEND
2720 PRINT @(11,2),TKEY$,
2730 PRINT @(1,3),'GREEN',"Type 'Y' to begin PURGE: ",'YELLOW',
2740 INPUT ANS$,
2750 LET CNTR=0
2760 IF ANS$<>"y" AND ANS$<>"Y" THEN GOTO PEND
2770 EXTRACT (81,KEY=FKEY$,DOM=2780,ERR=2780)
2780 LET KEY$=KEY(81,ERR=2840)
2790 PRINT 'CS','YELLOW',@(1,3),KEY$,
2800 IF KEY$>TKEY$ THEN GOTO 2840
2810 LET CNTR=CNTR+1
2820 REMOVE (81,KEY=KEY$)
2830 GOTO 2780
2840 PRINT 'CS','GREEN',@(1,0),"Purge complete: ",'YELLOW',CNTR,'GREEN',"  rec
2840:ord(s) deleted."
2850 PRINT @(1,3),"press <ENTER>",; INPUT XX$,; PRINT 'POP',
2860 GOTO DONE
2870 PEND: PRINT 'POP',
2880 IF FLAG3=1 THEN GOTO 1190
2890 GOTO 1570
2900 MULTKEY: REM .......................MULTIPLE KEY SPECS..........
2910 LET MK$=C$(86)+$FF$
2920 LET X=POS($FF$=MK$)
2930 LET SEGS=(X-1)/8
2940 DIM KEYNUM[SEGS],FLDNUM[SEGS],OFST[SEGS],LENG[SEGS],ORD$[SEGS]
2950 FOR I=1 TO SEGS
2960 LET CC$=MK$((I-1)*8+1,8)
2970 LET KEYNUM[I]=DEC(CC$(1,1))
2980 LET FLDNUM[I]=DEC(CC$(2,1))
2990 LET OFST[I]=DEC(CC$(3,2))
3000 LET LENG[I]=DEC(CC$(5,1))
3010 LET ORD$[I]="A"; IF CC$(6,1)=$01$ THEN LET ORD$[I]="D"
3020 NEXT I
3030 LET KS=LENG[1],MLTS=KEYNUM[SEGS]
3040 RETURN 
3050 CHGKNUM: REM ..........................CHANGE KNUM.............
3060 LET KNMB=KNMB+1,REC=0
3070 IF KNMB>KEYNUM[SEGS] THEN LET KNMB=0
3080 EXTRACT (81,KNUM=KNMB)
3090 READ (81,KEY="",DOM=3100)
3100 READ (81)
3110 LET KS=LEN(KEYP(81))
3120 GOTO 0680
3130 MKEY: REM .........................DISPLAY MKEYS.............
3140 IF MULT$<>"Y" THEN GOTO 3330
3150 PRINT 'GREEN','WINDOW'(40,0,40,24," Mkey Segments ",'BR')
3160 LET LASTK=-99
3170 LET I=1
3180 GOSUB HDR
3190 GOTO 3210
3200 HDR: PRINT 'CS','GREEN',@(2,0),"Key#   Fld#   Strt   Leng   Ordr",'YELLOW
3200:',; LET L=1; RETURN 
3210 IF KEYNUM[I]<>LASTK AND LASTK<>-99 THEN LET L=L+1
3220 PRINT @(2,L),KEYNUM[I]:"###0",@(9),FLDNUM[I]:"###0",@(16),OFST[I]+1:"###0
3220:",@(23),LENG[I]:"###0",@(33),ORD$[I]
3230 LET LASTK=KEYNUM[I]
3240 LET L=L+1
3250 IF L>=20 THEN GOTO 3290
3260 LET I=I+1
3270 IF I<=SEGS THEN GOTO 3210
3280 GOTO 3310
3290 INPUT @(1,21),'GREEN',"Press <ENTER> for more:",'YELLOW',*
3300 GOSUB HDR; GOTO 3260
3310 INPUT @(1,21),'GREEN',"Press <ENTER> when ready:",*
3320 PRINT 'POP'
3330 RETURN 
3340 ADD: REM ........................ADD A RECORD.......................
3350 PRINT 'GREEN','WINDOW'(0,0,80,4,"")
3360 PRINT 'CS','GREEN',@(7,0),"ADD new Key:",
3370 PRINT @(4,1),"Max key length:",'YELLOW',KSS,
3380 INPUT @(20,0),NEWKEY$,
3390 IF NEWKEY$="" AND FLAG4=1 THEN PRINT 'POP'; GOTO 1190
3400 IF NEWKEY$="" AND FLAG4=2 THEN PRINT 'POP'; GOTO 1570
3410 IF LEN(NEWKEY$)>KSS THEN GOTO 3360
3420 IF MULT$="Y" THEN READ (81,KNUM=0,ERR=3430)
3430 READ (81,KEY=NEWKEY$,ERR=3440); GOTO 3360
3440 IF MULT$<>"Y" THEN GOTO 3510
3450 LET HIGHFLD=0
3460 FOR I=1 TO SEGS
3470 IF FLDNUM[I]>HIGHFLD THEN LET HIGHFLD=FLDNUM[I]
3480 NEXT I
3490 LET NEWKEY$=NEWKEY$+FILL(KSS),NEWKEY$=NEWKEY$(1,KSS)
3500 READ (81,KEY=NEWKEY$,DOM=3510); GOTO 3360
3510 PRINT 'CS','GREEN',@(7,0),"Add new Key: ",'YELLOW',NEWKEY$+CHR(254),
3520 PRINT @(1,1),'GREEN',"Enter # of fields: ",; IF MULT$="Y" THEN PRINT @(40
3520:,1),"(",'YELLOW',HIGHFLD,'GREEN'," minimum )",
3530 INPUT @(20,1),'YELLOW',NEWFLD$,
3540 IF NEWFLD$="" THEN LET NEWKEY$=""; GOTO 3390
3550 LET NEWFLD=NUM(NEWFLD$,ERR=3510)
3560 IF NEWFLD<>INT(NEWFLD) OR NEWFLD<1 THEN GOTO 3510
3570 IF NEWFLD<HIGHFLD THEN GOTO 3510
3580 DIM NEWFLDS$[NEWFLD-1]
3590 IF MULT$<>"Y" THEN GOTO 3650
3600 REM                
3610 FOR I=1 TO SEGS
3620 LET D=FLDNUM[I],E=LENG[I]+OFST[I]
3630 IF LEN(NEWFLDS$[D-1])<E THEN LET NEWFLDS$[D-1]=FILL(E,"-")
3640 NEXT I
3650 IF MULT$<>"Y" THEN WRITE (81,KEY=NEWKEY$,ERR=3510)NEWFLDS$[ALL]; GOTO 368
3650:0
3660 LET NEWFLDS$[0]=NEWKEY$
3670 WRITE (81,ERR=3510)NEWFLDS$[ALL]
3680 LET C=C+1
3690 IF NEWKEY$<FIRSTK$ THEN LET FIRSTK$=NEWKEY$
3700 IF NEWKEY$>LASTK$ THEN LET LASTK$=NEWKEY$
3710 EXTRACT (81,KEY=NEWKEY$)
3720 PRINT 'POP'; GOSUB LNCLR; GOTO NEXTREC
3730 MRG: REM .....................................MERGE...............
3740 PRINT 'GREEN','WINDOW'(0,0,80,6,""),
3750 PRINT 'CS','GREEN',@(1,0),"(Incoming)   MERGE file:",'YELLOW'," C:",'GREE
3750:N',
3760 PRINT @(16,1),"From key:",
3770 PRINT @(16,2),"Thru key:",
3780 INPUT @(28,0),'YELLOW',INC$,'GREEN',
3790 IF INC$="" AND FLAG5=1 THEN PRINT 'POP'; GOTO 1190
3800 IF INC$="" AND FLAG5=2 THEN PRINT 'POP'; GOTO 1570
3810 IF INC$=FILE$ THEN GOTO 3750
3820 OPEN (82,ERR=3750)INC$
3830 LET FID2$=FID(82),MULT2$="N"
3840 LET FIN2$=FIN(82),MCT=0,OVER$=""
3850 LET KS2=ASC(FID2$(2,1)); IF KS2=0 THEN LET KS2=DEC(FIN2$(90,1)),MULT2$="Y
3850:"
3860 IF FID2$(1,1)<>$06$ THEN CLOSE (82); GOTO 3750
3870 IF KS2>KS THEN LET CHK$="Key"; GOTO 3910
3880 LET RECSZ2=DEC(FID2$(7,2))
3890 IF RECSZ2<=RECSZ THEN GOTO 3930
3900 LET CHK$="Record"
3910 PRINT 'CS','GREEN',@(1,0),CHK$," size of file ",'YELLOW',INC$,'GREEN'," i
3910:s too large",@(1,1),"to merge into file ",'YELLOW',FILE$,'GREEN',".",
3920 PRINT @(1,3),"press <ENTER>",'RB',; INPUT Y$,; CLOSE (82); LET INC$=""; G
3920:OTO 3790
3930 INPUT @(26,1),'CL','YELLOW',FROMKEY$,'GREEN',
3940 INPUT @(26,2),'CL','YELLOW',THRUKEY$,'GREEN',
3950 IF THRUKEY$="" THEN LET THRUKEY$=FILL(KS2,"z")
3960 IF THRUKEY$<FROMKEY$ THEN GOTO 3950
3970 PRINT @(26,2),'YELLOW',THRUKEY$,'GREEN',
3980 PRINT @(1,3),"Type 'Y' to begin MERGE: ",'YELLOW',; INPUT Y$,'GREEN','CS'
3980:,
3990 IF Y$<>"Y" AND Y$<>"y" THEN LET INC$=""; CLOSE (82); GOTO 3790
4000 EXTRACT (82,KEY=FROMKEY$,DOM=4020)
4010 NEXTMER: REM 
4020 READ RECORD(82,END=4170)X$
4030 LET KEY2$=KEYP(82)
4040 IF KEY2$>THRUKEY$ THEN GOTO 4170
4050 READ (81,KEY=KEY2$,DOM=4060); GOTO DUP
4060 LET Q$=HTA(X$),X=LEN(Q$)/2,FLD2=0
4070 FOR I=1 TO X
4080 LET Y=(I*2)-1
4090 IF Q$(Y,2)="0A" OR Q$(Y,2)="0D" THEN LET FLD2=FLD2+1
4100 NEXT I
4110 DIM FLDS2$[FLD2-1]
4120 READ (82,KEY=KEY2$)FLDS2$[ALL]
4130 IF MULT$="Y" THEN WRITE (81,ERR=4260)FLDS2$[ALL]
4140 IF MULT$="N" THEN WRITE (81,KEY=KEY2$,ERR=4260)FLDS2$[ALL]
4150 PRINT @(1,3),'CL',KEY2$,; LET MCT=MCT+1
4160 GOTO NEXTMER
4170 PRINT 'CS','GREEN',@(1,0),"Merge complete: ",'YELLOW',MCT,'GREEN'," recor
4170:d(s) added/over-written to file ",'YELLOW',FILE$,'GREEN',".",
4180 PRINT @(1,3),"press <ENTER>",; INPUT Y$; PRINT 'POP'; CLOSE (82); GOTO DO
4180:NE
4190 DUP: REM 
4200 IF OVER$="Y" THEN GOTO 4060
4210 PRINT 'CS','GREEN',@(1,0),"Over-write existing key ",'YELLOW',KEY2$,'GREE
4210:N',"? (Y/N/A): ",'YELLOW',"Y",; INPUT @(36+LEN(KEY2$),0),Y$,
4220 IF Y$="n" OR Y$="N" THEN PRINT 'CS'; GOTO NEXTMER
4230 IF Y$="y" OR Y$="Y" OR Y$="" THEN PRINT 'CS'; GOTO 4060
4240 IF Y$="a" OR Y$="A" THEN PRINT 'CS'; LET OVER$="Y"; GOTO 4060
4250 PRINT 'RB'; GOTO 4210
4260 PRINT 'CS','GREEN',@(1,0),"File compatibility error:  Unable to merge fil
4260:es.",
4270 PRINT @(1,3),"press <ENTER>",'RB',; INPUT Y$,; PRINT 'POP'; CLOSE (82); G
4270:OTO DONE
4280 LISTKEYS: REM .....................LIST KEYS......................
4290 LET TEXT$=" List all keys in file ",M$="########"
4300 PRINT 'GREEN','WINDOW'(0,0,80,25,TEXT$),'CS',
4310 INPUT @(1,1),'CL',"<S>croll or <P>age at a time? ",SORP$
4320 LET SORP$=CVS(SORP$,4); IF POS(SORP$="SP")=0 THEN GOTO 4310 ELSE PRINT 'C
4320:S',
4330 LET Q$=""; IF MULT$="Y" THEN GOTO 4360
4340 INPUT @(1,1),'CL',"Compare Key against Field 1? Y/N ",Q$
4350 LET Q$=CVS(Q$,4); IF POS(Q$="YN")=0 THEN GOTO 4340 ELSE PRINT 'CS',
4360 LET X=0
4370 EXTRACT (81,KEY=KEY$)
4380 READ (81,END=4470)FLD1$
4390 LET K$=KEYP(81)
4400 PRINT 'GREEN',(X+1):M$," ",'YELLOW',K$+CHR(254),
4410 IF K$<>FLD1$ AND Q$="Y" THEN PRINT FLD1$+CHR(254)," Discrepancy Found... 
4410:press <Enter>",; INPUT * ELSE PRINT ""
4420 LET X=X+1
4430 IF X/22<>INT(X/22) THEN GOTO 4380
4440 IF SORP$="S" THEN GOTO 4380
4450 IF X/22=INT(X/22) THEN PRINT 'GREEN'," *** press <ENTER> for more or <Q> 
4450:to quit *** ",'YELLOW',; INPUT X$,; IF X$<>"Q" AND X$<>"q" THEN PRINT 'CS
4450:',; GOTO 4380
4460 PRINT 'POP'; GOTO DONE
4470 PRINT 'GREEN'," *** End of file ***      press <ENTER>",; INPUT X$; PRINT
4470: 'POP'; GOTO DONE
4480 SIZE: REM ........................MAX KEY/RECORD SIZE................
4490 EXTRACT (81,KEY="",DOM=4500)*
4500 LET TEXT$=" Display largest key & record size "
4510 PRINT 'GREEN','WINDOW'(0,1,80,10,TEXT$),'CS',
4520 PRINT @(1,3),'GREEN',"Max key size:  ",@(21),"For key:",
4530 PRINT @(1,5),"Max Rcd size:",@(21),"For key:",
4540 PRINT 'YELLOW',
4550 LET R9=2,K9=0
4560 LET K$=KEY(81,END=4730); READ RECORD(81)A$
4570 PRINT @(5,1),'CL',K$,
4580 IF LEN(K$)<=K9 THEN GOTO 4610
4590 LET K9=LEN(K$)
4600 PRINT @(14,3),K9:"#####",; PRINT @(30,3),'CL',K$,
4610 IF LEN(A$)=0 THEN GOTO 4690
4620 FOR I=R9-1 TO LEN(A$)
4630 IF A$(I,1)=$00$ THEN GOTO 4670
4640 NEXT I
4650 LET J=LEN(A$)
4660 GOTO 4690
4670 LET J=I-1,I=LEN(A$)
4680 NEXT I
4690 IF J<=R9 THEN GOTO 4560
4700 LET R9=J
4710 PRINT @(14,5),R9:"#####",; PRINT @(30,5),'CL',K$,
4720 GOTO 4560
4730 PRINT @(0,7),'GREEN'," *** End of file ***      press <ENTER>",; INPUT X$
4730:; PRINT 'POP'; GOTO DONE
4740 JUMP: REM ........................JUMP TO ANY KEY....................
4750 PRINT 'GREEN','WINDOW'(0,4,80,3,""),'CS',
4760 PRINT 'GREEN'," Jump to",TKEY$," ",'YELLOW',
4770 INPUT J$,
4780 IF TYPE$(1,1)<>"I" THEN GOTO 4800
4790 LET SEQ=NUM(J$,ERR=4760); READ (81,IND=SEQ,ERR=4760); PRINT 'POP',; GOTO 
4790:1100
4800 LET J$=J$+FILL(KS),J$=J$(1,KS)
4810 IF J$>LASTK$ THEN EXTRACT (81,KEY=LASTK$); GOTO 4830
4820 EXTRACT (81,KEY=J$,DOM=4830)*
4830 PRINT 'POP'; GOSUB LNCLR; GOTO NEXTREC
4840 EMPTY: REM ......................NO RECORDS IN FILE...........
4850 PRINT 'GREEN','WINDOW'(0,4,80,3,""),'CS',
4860 PRINT 'GREEN'," No records in file... Add a record now <Y/N>? ",'YELLOW',
4870 INPUT A$,
4880 IF A$<>"Y" AND A$<>"y" AND A$<>"N" AND A$<>"n" THEN GOTO 4860
4890 PRINT 'POP'
4900 IF A$="Y" OR A$="y" THEN GOTO ADD
4910 GOTO DONE
4920 PRGM: 
4930 PRINT 'WINDOW'(14,12,52,3,""),'CS',
4940 PRINT @(1,0),'YELLOW',FILE$,'CYAN'," is a Program... press <Enter>",; INP
4940:UT *
4950 PRINT 'POP',
4960 RETURN 
4970 SYSTEM: 
4980 PRINT 'WINDOW'(14,12,52,3,""),'CS',
4990 PRINT @(1,0),'YELLOW',FILE$,'CYAN'," is a System File... press <Enter>",;
4990: INPUT *
5000 PRINT 'POP',
5010 RETURN 
5020 STRG: 
5030 FOR I=1 TO 7; PRINT @(0,3+I),'CL',; NEXT I
5040 LET B$=FID(81); PRINT @(6,0),B$(9),
5050 PRINT @(6,2),TYPE$,
5060 PRINT 'WINDOW'(0,4,80,19,""),'CS',
5070 NEXTSTR: 
5080 READ (81,END=EOFS)X$
5090 LET X$=CVS(X$,16)
5100 IF LEN(X$)>1248 THEN LET X$=X$(1,1247)+">"
5110 PRINT 'CS',X$,
5120 INPUT @(1,16),"<Enter> for more or <Q> to quit",I$,
5130 IF I$="Q" THEN GOTO 5150 ELSE GOTO NEXTSTR
5140 EOFS: INPUT 'CS',@(1,16),"End of File... press <Enter>",X$,
5150 PRINT 'POP',
5160 RETURN 
5170 SHOWPFX: 
5180 PRINT 'GREEN','WINDOW'(0,0,80,8,""),'CS','GREEN',
5190 PRINT @(1),"Current Directory: ",'YELLOW',DIR(""),'GREEN'
5200 PRINT " "
5210 PRINT @(1),"Prefix: ",'YELLOW',PREF$,'GREEN'
5220 PRINT " "
5230 INPUT @(1,5),"press <Enter>",*
5240 PRINT 'POP',; RETURN 
9899 REM 0
9904 PRINT (0)'EE'+'CI'+'WINDOW'("LIST"),; READ RECORD(0,SIZ=1)WINS2$; READ RE
9904:CORD(0,SIZ=ASC(WINS2$))X$; LET WINS2=ASC(WINS2$); LET X=WINS2-WINS; PRINT
9904: (0)'BE',
9905 IF X=0 THEN GOTO 9909
9906 FOR I=1 TO X
9907 PRINT 'POP',
9908 NEXT I
9909 PRINT 'BACKGR',$1B05$+"BLACK",'DEFAULT','CS','WHITE'
9910 IF FILE$="EXIT" THEN GOTO 9999
9919 RUN "FIMENU",ERR=9920
9920 RUN "RMMENU",ERR=9921
9921 RUN "OSASM",ERR=9922
9922 RUN "SFP",ERR=9923
9999 END