21 DEF FNPH$(X%)=CHR$(X%+128):DEF FNUH(X$)=ASC(X$)-128
100 PRINT
110 PRINT"Enter data............................................Depress E"
120 PRINT"Look up a record......................................Depress L"
130 PRINT"Scan all records......................................Depress S"
140 PRINT"Update a record.......................................Depress U"
150 PRINT"Delete a record.......................................Depress D"
160 PRINT"Exit the program......................................Depress X"
170 PRINT"Initialize the file...................................Depress I"
180 GET 2,1:PRINT"   CURRENT NUMBER OF RECORDS IN FILE=";CVI(KP$);:IF CVI(KP$)<1 THEN PRINT"PLEASE INITIALIZE!":ELSE PRINT
185 PRINT"Please depress the key corresponding to your choice."
1000 PRINT CLS$:REM*BEGIN ENTRY
1005 FC=FC+1
10000 REM*BEGIN FILE LOOK UP
10010 GOSUB 27000:'TRY TO FIND THE RECORD
10200 GOSUB 28000:'UNPACK THE FIELDS
10800 GOSUB 29000:'DISPLAY RECORD IF KEY FIELD MATCHES
11000 REM*BEGIN FILE LOOK UP
11010 GOSUB 27000:'TRY TO FIND THE RECORD
11200 GOSUB 28000:'UNPACK THE FIELDS
11800 GOSUB 29000:'DISPLAY RECORD IF KEY FIELD MATCHES
11810 UF$="":PRINT:PRINT"What field number do you want to update? ";
11820 UX$=INKEY$:IF UX$>="0" AND UX$<="9" THEN PRINT UX$;:UF$=UF$+UX$:GOTO 11820 ELSE IF UX$<>CHR$(13) THEN 11820:ELSE UF=VAL(UF$)
11900 REM*BEGIN OUTPUT*
11998 REM*INSERT CHANGED FIELDS AND SEND TO DISK*
12000 REM*BEGIN RECORD DELETE*
12010 GOSUB 27000:'TRY TO FIND THE RECORD
12200 GOSUB 28000:'UNPACK THE FIELDS
12800 GOSUB 29000:'DISPLAY RECORD IF KEY FIELD MATCHES
12900 REM*DELETE CODE WRITTEN INTO ALL FIELDS*
22000 REM*FIELD TITLES FOR DISPLAY*
25000 IF ERL>35000 AND ERL<36000 THEN RESUME 35000:ELSE IF ERR=6 THEN RESUME NEXT
25001 IF ERR=62 THEN PRINT"YOU DIDN'T INITIALIZE YOUR DATA FILE. DO SO!":FOR I=1 TO 1000:NEXT:RUN
25010 PRINT"ERROR ENCOUNTERED IN LINE";ERL
25015 IF ERR=10 THEN PRINT"You have input a number too large for the field type.":RESUME NEXT
25020 IF ERL<10000 AND ERL>1000 THEN PRINT"You have probably made an error in edit specifications."
25030 PRINT"ERROR NUMBER IS";ERR:CLOSE:END
25999 REM*HASHING ALGORITHM
26000 FOR ZZ=1 TO LEN(ZZ$)
26010 SP=ASC(MID$(ZZ$,ZZ,1)):X#=X#+ZZ*(SP+1/SP)
26020 NEXT
26030 IF X#<1E+17 THEN X#=X#*X#:GOTO 26030
26035 SP=ASC(ZZ$)+ASC(RIGHT$(ZZ$,1)):SP=SP-10*(INT(SP/10)):SP=SP+4:X$=STR$(X#):RP=VAL(MID$(X$,SP,4)):X#=0
27000 REM*LOOK FOR THE RECORD*
27020 'NOW WE HAVE INPUT THE KEY FIELD
27030 ZZ$=KF$:GOSUB 26000:KP=RP:'GO TO HASHING ROUTINE AND GET POSITION
27999 REM*UNPACK FIELDS IN RECORD*
28998 RETURN
28999 REM*DISPLAY FOUND RECORD*
29000 PRINT CLS$;:CL=1
29020 READ R$:CX=LEN(G$(I))
29021 IF CX>10 THEN IF MID$(G$(I),CX-9,10)="          " THEN CX=CX-10:GOTO 29021
29022 IF CX<LEN(G$(I)) THEN G$(I)=LEFT$(G$(I),CX)
29024 LC=POS(0):IF LC<5 THEN PRINT"#";I;"|";R$;"|";G$(I);:GOTO 29030
29025 IF CL>19 THEN GOSUB 41010:GOTO 29024
29026 IF (LC<40 AND LEN(R$)+LEN(G$(I))+37<80) THEN PRINT TAB(40);"#";I;"|";R$;"|";G$(I);:ELSE PRINT:CL=CL+1:GOTO 29024
29030 NEXT:RESTORE:PRINT
29930 IF AN$="S" OR AN$="s" THEN RETURN
29940 PRINT:PRINT"IS THIS IT? (DEPRESS Y IF SO, ANY OTHER IF NOT)";
29950 AN$=INKEY$:IF AN$="" THEN 29950:ELSE PRINT CHR$(13);STRING$(60,32);:PRINT CHR$(13);:IF AN$<>"Y" THEN GOSUB 27040:GOSUB 28000:GOTO 29000
29960 RETURN
29999 REM*NUMERIC FIELD EDIT CHECK SUBROUTINE*
30000 CD=INSTR(CD$,CHR$(32)):IF CD>1 THEN CD$=LEFT$(CD$,CD-1)+MID$(CD$,CD+1):GOTO 30000:ELSE IF CD=1 THEN CD$=MID$(CD$,2):GOTO 30000
30005 FOR ZZ=1 TO LEN(CD$)
30010 IF MID$(CD$,ZZ,1)<"0" OR MID$(CD$,ZZ,1)>"9" THEN IF MID$(CD$,ZZ,1)<>"." AND MID$(CD$,ZZ,1)<>"-" THEN E=1
30020 NEXT:IF E THEN RETURN
30030 CD=INSTR(CD$,"-"):IF CD>0 AND INSTR(CD+1,CD$,"-")>0 THEN E=1:RETURN:ELSE IF (CD>0 AND CD<>1) THEN E=1:RETURN
30040 CD=INSTR(CD$,"."):IF CD>0 AND INSTR(CD+1,CD$,".")>0 THEN E=1:RETURN
30050 RETURN
30999 REM*ALPHA FIELD EDIT CHECK*
31000 FOR ZZ=1 TO LEN(CD$)
31010 IF MID$(CD$,ZZ,1)<="9" AND MID$(CD$,ZZ,1)>="0" THEN E=1
31020 NEXT
31030 RETURN
32000 REM*INITIALIZE*
32010 PRINT"This will erase all previous data, if any.":PRINT"To continue initialization, depress the C key.";
32030 AN$=INKEY$:IF AN$="" THEN 32030:ELSE IF AN$<>"C" THEN RUN
32035 PRINT CLS$:PRINT"This will take a little while. Please be patient."
32060 PUT 2,I
32070 NEXT:LSET KP$=MKI$(1):PUT 2,1:RUN
34999 REM*BEGIN RECORD SCAN*
35001 INPUT"Numeric or alphabetic scan (N/A):";NS$:NS%=ASC(NS$):NS%=NS% AND 95:NS$=CHR$(NS%):IF NS$<>"N" AND NS$<>"A" THEN 35001
35002 INPUT"Smallest (numeric or alpha) to display:";SM$
35003 INPUT"Largest (numeric or alpha) to display:";LA$
35004 INPUT"Should I delay after displaying each record (Y/N)?";DY$:NS%=ASC(DY$):NS%=NS% AND 95:DY$=CHR$(NS%):IF DY$<>"N" AND DY$<>"Y" THEN 35004
35050 GOSUB 28000:'UNPACK THE RECORD
35060 IF NS$="A" AND (G$(NS)<SM$ OR G$(NS)>LA$) THEN 35965
35070 IF NS$="N" AND (VAL(G$(NS))<VAL(SM$) OR VAL(G$(NS))>VAL(LA$)) THEN 35965
35960 GOSUB 29000:'DISPLAY RECORD
35965 IF DY$="Y" THEN 35970 ELSE 35990
35970 FOR J=1 TO 2000:NEXT:'WAIT BEFORE DISPLAYING NEXT RECORD
36000 REM*FIELD LENGTHS AND FIELDING FILE*
36820 FIELD #1,CD% AS DD$,F%(ZZ) AS F$(ZZ):CD%=CD%+F%(ZZ):NEXT:RETURN
38000 CLOSE:NEW
40000 G1=INSTR(G$(UF),"MORE"):IF G1>0 THEN G%=CINT(VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G%),FIX(2+SGN(G%)/2)):RETURN
40010 G1=INSTR(G$(UF),"LESS"):IF G1>0 THEN G!=CSNG(-VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G!),FIX(2+SGN(G!)/2)):RETURN
40020 G1=INSTR(G$(UF),"+"):IF G1>1 THEN G%=CINT(VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G%),FIX(2+SGN(G%)/2)):RETURN
40030 G1=INSTR(G$(UF),"-"):IF G1>1 THEN G!=CSNG(-VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G!),FIX(2+SGN(G!)/2)):RETURN
40040 G1=INSTR(G$(UF),"*"):IF G1>0 THEN G%=CINT(VAL(G$(UF))*VAL(G$)):G$(UF)=MID$(STR$(G%),FIX(2+SGN(G%)/2)):RETURN
40050 G1=INSTR(G$(UF),"/"):IF G1>0 THEN G%=CINT(VAL(G$)/VAL(G$(UF))):G$(UF)=MID$(STR$(G%),FIX(2+SGN(G%)/2)):RETURN
40100 RETURN
40500 G3=0:G2=INSTR(G$(UF),"RO"):IF G2 THEN G3=VAL(MID$(G$(UF),G2+2))
40510 G1=INSTR(G$(UF),"LESS"):IF G1>0 THEN G#=CDBL(-VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2)):GOTO 40570
40520 G1=INSTR(G$(UF),"+"):IF G1>1 THEN G#=CDBL(VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2)):GOTO 40570
40530 G1=INSTR(G$(UF),"-"):IF G1>1 THEN G#=CDBL(-VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2)):GOTO 40570
40540 G1=INSTR(G$(UF),"*"):IF G1>0 THEN G#=CDBL(VAL(G$(UF))*VAL(G$)):G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2)):GOTO 40570
40550 G1=INSTR(G$(UF),"/"):IF G1>0 THEN G#=CDBL(VAL(G$)/VAL(G$(UF))):G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2)):GOTO 40570
40560 G1=INSTR(G$(UF),"MORE"):IF G1>0 THEN G#=CDBL(VAL(G$(UF))+VAL(G$)):G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2))
40570 IF G2<1 THEN RETURN
40580 G#=CDBL(VAL(G$(UF)))
40590 IF G3 THEN FOR G2=1 TO G3:G#=G#*10:NEXT:G#=FIX(G#+.500001#*SGN(G#))
40600 IF G3 THEN FOR G2=1 TO G3:G#=G#/10:NEXT:ELSE G#=FIX(G#+.500001#*SGN(G#))
40610 G$(UF)=MID$(STR$(G#),FIX(2+SGN(G#)/2)):RETURN
41000 IF CL<20 THEN RETURN
41010 PRINT:PRINT"THERE ARE MORE FIELDS! HIT ANY KEY TO SEE THE REST:";
41015 Y$=INKEY$:IF Y$="" THEN 41015:ELSE PRINT CLS$:CL=0:RETURN
:PRINT"THERE ARE MORE FIELDS! HIT ANY KEY TO SEE THE REST:";
41015 Y$=IN