500 REM ************************************************************
501 REM *** Main Menu Function Process: Display choices, get choice
502 REM *** then call appropriate routine
503 REM ************************************************************
505 IF CURRENT=-1 THEN C$=" NONE" ELSE C$=STR$(CURRENT)
510 CLS:LOCATE 1,1:A$="Current Record ="+C$:A1$="Number of entered records ="+STR$(GOOD):A2$="Maximum number of records ="+STR$(MAXSIZE):A3$="Current Data Disk Volume: "+V$
530 LOCATE 6,1:A$="---> Main Menu Choices <---":PRINT TAB(40-(LEN(A$)/2));A$
540 LOCATE 8,20:PRINT "G)et A Record.":LOCATE 9,20:PRINT "S)earch For And List Records."
550 LOCATE 10,20:PRINT"A)dd A Record.":LOCATE 11,20:PRINT"D)elete Current Record.":LOCATE 12,20:PRINT"U)pdate Current Record.":LOCATE 13,20:PRINT"X)-tend Work To New Data Diskette."
560 LOCATE 14,20:PRINT"I)nitialize New Data Diskette.":LOCATE 15,20:PRINT"Q)uit And Return To BASIC."
580 A$="Enter your choice (G,S,A,D,U,X,I, or Q): ":LOCATE 18,1:PRINT TAB(40-(LEN(A$)/2));A$:ROW=18:COLUMN=((40-LEN(A$)/2)+LEN(A$)-1):A1%=1:AX$="GgSsAaDdUuXxIiQq":GOSUB 40130
590 IF AN$="" GOTO 580
600 IF AN$="Q" OR AN$="q" THEN CLOSE:GOSUB 50000:CLS:PRINT"Program Finished...":END
610 IF AN$="G" OR AN$="g" THEN GOSUB 680:GOSUB 39000:GOTO 500
620 IF AN$="S" OR AN$="s" THEN GOSUB 680:GOSUB 45000:GOTO 500
630 IF AN$="A" OR AN$="a" THEN GOSUB 41000:GOTO 500
640 IF AN$="D" OR AN$="d" THEN GOSUB 680:PAGE=0:GOSUB 2000:GOSUB 7000:GOSUB 42000:GOTO 500
650 IF AN$="U" OR AN$="u" THEN GOSUB 680:GOSUB 43000:GOTO 500
660 IF AN$="X" OR AN$="x" THEN GOSUB 680:GOSUB 46000:GOTO 500
670 IF AN$="I" OR AN$="i" THEN GOSUB 680:GOSUB 47000:GOTO 500
680 CLS:LOCATE 24,1:PRINT STRING$(79,"=");:RETURN
2000 REM ************************************************************
2001 REM *** Display Screen Info Routine In: PAGE = page #
2002 REM *** or
2003 REM *** FL = field #
2004 REM *** Out: Screen info on that page is
2005 REM *** displayed, then exit to
2006 REM *** caller.
2007 REM ************************************************************
7000 REM ************************************************************
7001 REM *** Display Record Fields Routine In: Page = page #
7002 REM *** Out: Working strings displayed,
7003 REM *** then exit to caller
7004 REM ************************************************************
12000 REM ************************************************************
12001 REM *** Block Record Routine In: Working strings filled
12002 REM *** Out: Record strings filled then exit
12003 REM *** to caller.
12004 REM ************************************************************
17000 REM ************************************************************
17001 REM *** Unblock Record Routine In: Record strings filled
17002 REM *** Out: Working strings filled then
17003 REM *** exit to caller.
17004 REM ************************************************************
22000 REM ************************************************************
22001 REM *** Input A Field Routine In: FL = field number to input
22002 REM *** Out: Working string filled after
22003 REM *** passing edit check, then exit
22004 REM *** to caller.
22005 REM ************************************************************
32000 REM ************************************************************
32001 REM *** Get a Record Routine In: RECNUM = record number to get
32002 REM *** Out: Record strings filled (need to be
32003 REM *** unblocked.)
32004 REM ************************************************************
32010 GET 1,RECNUM:RETURN
33000 REM ************************************************************
33001 REM *** Hash Keyfield Routine In: KY$ = Key field
33002 REM *** Out: RECNUM = Hashed record specifier
33003 REM ************************************************************
33010 FOR ZZ=1 TO LEN(KY$):X#=X#+ZZ*ASC(MID$(KY$,ZZ,1)):NEXT ZZ
45120 LOCATE 25,1:A$="Enter field number to test ":PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$="0123456789":A1%=LEN(STR$(NF)):GOSUB 40130:IF AN$="" GOTO 45120 ELSE FL=VAL(AN$):PAGE=0:GOSUB 2000
47000 REM ************************************************************
47001 REM *** Initialize New Data Disk Function Process: Write records to data
47002 REM *** disk until error
47003 REM *** occurs. Error
47004 REM *** routine will then
47005 REM *** branch back to line
47006 REM *** 47500 where ".DEF"
47007 REM *** file is written.
47008 REM ************************************************************
47010 CLOSE:CURRENT=-1:IN=1:LOCATE 25,1:PRINT STRING$(79,32);:A$="S)pecify number of records, or U)se all available disk space? ":LOCATE 25,1:PRINT A$;