|2010 DIM TITLE$(4),TITLEHORIZ%(4):BLINKNORMAL%=|28:BLINKINSERT%=|29:BLINK2%=|30 'For CGA or EGA adapter, BLINKNORMAL%=6, BLINKINSERT%=4 and BLINK2%=7. For Monochrome adapter, BLINKNORMAL%=13, BLINKINSERT%=9 and BLINK2%=14.
2020 TITLEHORIZ%(1)=2:TITLE$(1)=" Add Record ":TITLEHORIZ%(2)=14:TITLE$(2)=" Modify/Look At Record ":TITLEHORIZ%(3)=37:TITLE$(3)=" Delete Record "
*32 2030 TITLEHORIZ%(4)=52:TITLE$(4)=" Select With "+CHR$(26)+" "+CHR$(27)+" Then Enter"
*33 2030 TITLEHORIZ%(4)=52:TITLE$(4)=" Select With "+CHR$(26)+CHR$(27)+CHR$(24)+CHR$(25)+" Then Enter"
2040 NEWTITLE%=1:LASTTITLE%=1:NEWFILE%=1:LASTFILE%=1:FILEINCREMENT%=2:IF ZQ>6 THEN FILEINCREMENT%=1
2050 CLS:COLOR COLA%(2),0:PRINT TAB(29);"PDS*BASE File Work Menu For":PRINT:Z2=LEN(ZB$):PRINT TAB(INT((75-Z2)/2));ZB$;" Data Base":COLOR 7,0:PRINT:LOCATE ,,1
2060 COLOR COLA%(3),0:FOR J=1 TO 3:LOCATE 5,TITLEHORIZ%(J),0:PRINT TITLE$(J);:NEXT:LOCATE 5,TITLEHORIZ%(LASTTITLE%),0:COLOR 0,COLA%(3):PRINT TITLE$(LASTTITLE%);:COLOR 7,0
2320 A$="":WHILE A$="":A$=INKEY$:WEND:IF ASC(A$)=27 THEN LOCATE 23,38:GOTO 400 ELSE IF ASC(A$)=13 THEN GOTO 2400
*32 2330 IF LEN(A$)=1 THEN SOUND 400,1:GOTO 2320 ELSE A%=ASC(RIGHT$(A$,1)):IF A%<>75 AND A%<>77 THEN SOUND 400,1:GOTO 2320
*33 2330 IF LEN(A$)=1 THEN SOUND 400,1:GOTO 2320 ELSE A%=ASC(RIGHT$(A$,1)):IF A%<>72 AND A%<>75 AND A%<>77 AND A%<>80 THEN SOUND 400,1:GOTO 2320
2340 IF A%=75 THEN NEWTITLE%=LASTTITLE%-1:IF NEWTITLE%=0 THEN NEWTITLE%=3
2350 IF A%=77 THEN NEWTITLE%=LASTTITLE%+1:IF NEWTITLE%=4 THEN NEWTITLE%=1
2360 IF A%=75 OR A%=77 THEN LOCATE 5,TITLEHORIZ%(LASTTITLE%),0:COLOR COLA%(3),0:PRINT TITLE$(LASTTITLE%);:LOCATE 5,TITLEHORIZ%(NEWTITLE%),0:COLOR 0,COLA%(3):PRINT TITLE$(NEWTITLE%);:COLOR 7,0:LASTTITLE%=NEWTITLE%:GOTO 2320
*33 2370 IF A%=72 THEN NEWFILE%=LASTFILE%-1:IF NEWFILE%=0 THEN NEWFILE%=ZQ
*33 2380 IF A%=80 THEN NEWFILE%=LASTFILE%+1:IF NEWFILE%>ZQ THEN NEWFILE%=1
*33 2390 IF A%=72 OR A%=80 THEN LOCATE 6+(LASTFILE%*FILEINCREMENT%),60,0:PRINT SPC(15):LOCATE 6+(NEWFILE%*FILEINCREMENT%),60,0:COLOR 0,COLA%(3):PRINT "Selected File";:COLOR 7,0:LASTFILE%=NEWFILE%:GOTO 2320
*23 2520 ZS=ZA:Y11=0:FOR ZI=1 TO ZQ:IF ZS$(ZA,2)=ZS$(ZI,1) THEN Y11=ZI:ZM=ZI:ZI=ZQ
*23 2530 NEXT:IF Y11=0 THEN BEEP:PRINT "NO MASTER SET FOUND FOR '";ZS$(ZA,1);".":FOR ZI=1 TO 5000:NEXT:RETURN
*23 2540 COLOR COLA%(2),0:PRINT "First Enter ";ZN$(ZM,1,1);" ";:COLOR 7,0:INPUT YC$:IF YC$="" THEN RETURN ELSE ZR$=STRING$(ZSIZE%(ZM,1),32):LSET ZR$=YC$
*23 2550 ZA=ZM:GOSUB 500:GOSUB 600:YM=ZR:ZA=ZS:ZMASTER$=ZN$(ZM,1,1)+"="+YC$:IF ZV>0 THEN ZA=NEWFILE%:PRINT "Strike any key to continue":YQ$=INPUT$(1):RETURN
2560 'Add New Record
2570 PROGLOOP%=1
2580 WHILE PROGLOOP%=1
2590 GOSUB 5000:IF (ZI=1 AND (ZI$(ZS%(ZA,10),ZA)=STRING$(ZSIZE%(ZA,ZS%(ZA,10)),32) OR (FLDTYPE%=4 AND ZI$(ZS%(ZA,10),ZA)=" - - ")) ) OR ESCFLAG%=1 THEN RETURN 'do not create the present record
2600 IF ZS%(ZA,1)=1 THEN ZR$=ZI$(ZS%(ZA,10),ZA):GOSUB 800:ZA=NEWFILE%
*23 2610 IF ZS%(ZA,1)=2 THEN GOSUB 1000:ZA=NEWFILE%
2620 WEND
2800 ' Modify Data Set
2810 Y5=0
*23 2820 IF ZS%(ZA,1)=1 THEN ZM=ZA:GOTO 2850
*23 2830 ZS=ZA:Y11=0:FOR ZI=1 TO ZQ:IF ZS$(ZA,2)=ZS$(ZI,1) THEN Y11=ZI:ZM=Y11:ZI=ZQ
*23 2840 NEXT:IF Y11=0 THEN BEEP:PRINT "NO MASTER SET FOUND FOR '";ZS$(ZA,1);".":FOR ZI=1 TO 5000:NEXT:RETURN
2850 CLS:LOCATE 15,23,0:COLOR 15,0:PRINT "Enter=Return To Menu, \=Same As Last";:COLOR COLA%(2),0:LOCATE 1,1,1:IF ZS%(ZA,1)=1 THEN PRINT "Enter Existing ";ZN$(ZM,1,1); ELSE PRINT "Enter Existing Master ";ZN$(ZM,1,1);
2860 COLOR 7,0:INPUT YC$:IF YC$="" THEN RETURN ELSE IF YC$<>"\" THEN ZR$=STRING$(ZSIZE%(ZM,1),32):LSET ZR$=YC$
*23 2870 IF ZS%(NEWFILE%,1)=2 THEN ZA=ZM
2880 GOSUB 500:GOSUB 600
*23 2890 IF ZS%(NEWFILE%,1)=2 THEN YM=ZR
2900 IF ZV>0 THEN ZA=NEWFILE%:PRINT "Strike any key to continue":YQ$=INPUT$(1):GOTO 2800
2910 IF ZS%(NEWFILE%,1)=1 THEN GOSUB 1500:IF NEWTITLE%=3 THEN GOSUB 3200:GOTO 2850 ELSE ALTM%=1:GOSUB 5000:IF ESCFLAG%=0 THEN GOSUB 750:GOTO 2850 ELSE GOTO 2850
*23 |2920 ZA=ZS:Y2=0:FOR ZI=2 TO |09
*23 |2930 IF ZS$(ZM,ZI)=ZS$(ZS,1) THEN Y2=ZI-1:ZI=|09
*23 2940 NEXT
*23 2950 ZR=ZH(Y2):Y3=0:IF ZR=0 THEN BEEP:PRINT "NO DETAIL DATA FOR THIS MASTER":PRINT "Strike any key to continue";:ZQ$=INPUT$(1):GOTO 2800 'we now have the chain head in the Detail set
*23 2960 ZA=ZS:GOSUB 600:GOSUB 1500:Y3=Y3+1
*23 2970 CURRENTFIRST=1:GOSUB 7000:IF ZR=ZH(Y2) THEN Y3=1
*23 2980 LOCATE 24,16:COLOR COLA%(2),0:PRINT "PgDn=Next, PgUp=Previous Record,";:LOCATE 24,1,0:PRINT "Detail #";:IF Y3>0 THEN PRINT Y3; ELSE IF Y3<>-31999 THEN PRINT "L";(Y3+31999);
*23 2990 IF NEWTITLE%=2 THEN LOCATE 24,49:PRINT " Alt/M=Modify Record";SPC(11);
*23 3000 IF NEWTITLE%=3 THEN LOCATE 24,49:PRINT " Alt/D=Delete Record";SPC(11);
*23 3010 IF ZR=ZE(Y2) THEN LOCATE 24,72,0:SOUND 400,1:COLOR 23,0:PRINT "Last Rec";:COLOR 7,0
*23 3020 COLOR 7,0:YQ$="":WHILE YQ$="":YQ$=INKEY$:WEND:IF ASC(YQ$)=27 OR ASC(YQ$)=13 THEN GOTO 2800
*23 3030 IF LEN(YQ$)=2 THEN PGUP%=0:PGDN%=0:YC%=ASC(RIGHT$(YQ$,1)):GOSUB 5600
*23 3040 IF PGUP%=1 THEN IF Y3<>1 THEN Y3=Y3-2:ZR=ZB:GOTO 2960 ELSE ZR=ZE(Y2):Y3=-32000:GOTO 2960
*23 3050 IF PGDN%=1 THEN IF ZF>0 THEN ZR=ZF:GOTO 2960 ELSE ZR=ZH(Y2):Y3=0:GOTO 2960
*23 3060 IF NEWTITLE%=2 AND ALTM%=1 THEN LOCATE 24,1,0: PRINT " Alt/S or Ctrl/End = Save Modification - Esc = Escape Without Modification ";:GOSUB 5020:PGDN%=1:IF ESCFLAG%=0 THEN GOSUB 750:GOTO 3050 ELSE GOTO 2800
*23 3070 IF NEWTITLE%=3 AND ALTD%=1 THEN GOSUB 3200:PGDN%=1:ALTD%=0:GOTO 3050
*23 3080 GOTO 2800
3200 'Delete Data Record
3210 LOCATE 24,1,0:PRINT SPC(79):LOCATE 24,20,0:SOUND 400,1:COLOR 0,COLA%(2):PRINT "Do You Wish To Delete The Above ";:COLOR 0,COLA%(3):PRINT "N";:LOCATE ,POS(0)-1,1:YQ$="":WHILE YQ$="":YQ$=INKEY$:WEND:PRINT YQ$;:COLOR 7,0
3220 IF YQ$<>"Y" AND YQ$<>"y" THEN RETURN
3230 IF ZS%(ZA,1)=1 THEN GOSUB 1200:RETURN
*23 3240 IF ZS%(ZA,1)=2 THEN YS=ZR:GOSUB 1300
*23 3250 ZA=NEWFILE%:RETURN
5000 ' ** Subroutine to input data **
5010 CURRENTFIRST=1:GOSUB 7000
5020 FOR ZI=CURRENTFIRST TO CURRENTLAST
5030 IF ZS%(ZA,1)=1 AND NEWTITLE%=2 THEN IF ZI=1 AND ZI=ZS%(ZA,10) THEN ZI=ZI+1 'can't modify search value
5080 YC$="":WHILE YC$="":YC$=INKEY$:WEND:POSX%=CSRLIN:POSY%=POS(0) 'strobe keyboard for next character
5090 IF CFLAG%=1 THEN LOCATE 25,1,0:PRINT SPC(79):LOCATE POSX%,POSY%,1:CFLAG%=0
5100 IF LEN(YC$)=2 THEN YC%=ASC(RIGHT$(YC$,1)):GOSUB 5600:GOTO 5190
5110 YC%=ASC(YC$)
5120 IF YC%=27 THEN ZJ=Z2:ESCFLAG%=1:GOTO 5190
5130 IF YC%=8 THEN GOSUB 5500:GOTO 5080
5140 IF YC%=13 THEN ZJ=Z2:GOTO 5190
5150 POSY%=POS(0):ON FLDTYPE% GOSUB 5800,5850,6000,5800:IF CFLAG%=1 THEN LOCATE POSX%,POSY%,1:GOTO 5080
5160 IF INSERT%=1 THEN GOSUB 6200
5170 COLOR 0,COLA%(3):PRINT YC$;:COLOR 7,0:MID$(ZI$(ZI,ZA),ZJ,1)=YC$
5180 IF FLDTYPE%=4 AND (ZJ=2 OR ZJ=5) THEN ZJ=ZJ+1:LOCATE ,POS(0)+1 'skip dash on Date field
5190 NEXT 'ZJ
5200 LOCATE ,,,BLINKNORMAL%,BLINK2%:INSERT%=0:IF ZI=1 THEN IF YC%=13 AND (ZI$(ZI,ZA)=STRING$(Z2,32) OR (FLDTYPE%=4 AND ZI$(ZI,ZA)=" - - ")) THEN RETURN 'finished adding records
5210 IF ESCFLAG%=1 THEN RETURN 'abort from this record
5220 EFLAG%=0
5230 IF MID$(ZN$(ZA,ZI,2),1,1)="R" THEN IF ZI$(ZI,ZA)=STRING$(Z2,32) THEN LOCATE 25,5,0:COLOR 15,0:SOUND 400,1:PRINT "Entry for this item required - Press 'Esc' to cancel the entire entry.";:COLOR 7,0:CFLAG%=1:EFLAG%=1:FLDUP%=0:FLDDOWN%=0
5240 IF FLDTYPE%=4 THEN CFLAG%=1:EFLAG%=1:GOSUB 6100:IF CFLAG%=0 THEN EFLAG%=0
5250 WEND 'EFLAG%
5260 IF ZENDSAVE%=1 AND NEWTITLE%=2 THEN RETURN
5270 LOCATE ZFLDPOSVERT%(ZA,ZI),ZFLDPOSHORIZ%(ZA,ZI),0:COLOR COLA%(3),0:PRINT ZI$(ZI,ZA);:COLOR 7,0:IF FLDUP%=1 THEN IF ZI>1 THEN ZI=ZI-2 ELSE ZI=CURRENTLAST-1
5280 IF HOMEFLAG%=1 THEN ZI=CURRENTFIRST-1
5290 IF ENDFLAG%=1 THEN ZI=CURRENTLAST-1
5293 IF ZS%(ZA,1)=1 AND NEWTITLE%=1 AND ZI=ZS%(ZA,10) THEN ZR$=ZI$(ZS%(ZA,10),ZA):NOMSG%=1:GOSUB 500:GOSUB 600:IF ZV=0 THEN NEWTITLE%=2:GOSUB 1500:GOSUB 7000:NEWTITLE%=1:GOSUB 7000:NOMSG%=0:GOTO 5040
5295 IF PGUP%=1 OR PGDN%=1 THEN ZI=CURRENTLAST
5300 NEXT 'ZI
5310 IF CURRENTLAST < ZS%(ZA,7) THEN CURRENTFIRST=CURRENTLAST+1:GOSUB 7000:GOTO 5020
5315 IF CURRENTFIRST > 1 THEN IF PGUP%=1 THEN CURRENTFIRST=1:GOSUB 7000:GOTO 5020
5320 IF NEWTITLE%=2 THEN GOTO 5020
5330 RETURN
5500 'Subroutine for backspace
5520 IF ZJ=1 THEN RETURN
5530 IF FLDTYPE%=4 AND EFLAG%=0 THEN IF ZJ=3 OR ZJ=7 THEN LOCATE ,POS(0)-2:ZJ=ZJ-2:RETURN 'skip spaces on Date field
5630 IF (YC%=73 AND CURRENTFIRST%>1) OR (YC%=73 AND NEWTITLE%>1) THEN PGUP%=1:ZJ=Z2:RETURN ELSE IF YC%=81 AND NEWTITLE%>1 THEN PGDN%=1:ZJ=Z2:RETURN
5640 IF YC%=75 THEN ZJ=ZJ-1:IF ZJ>0 THEN ZJ=ZJ-1:LOCATE ,POS(0)-1:IF FLDTYPE%=4 AND (ZJ=3 OR ZJ=6) THEN ZJ=ZJ-1:LOCATE ,POS(0)-1:RETURN ELSE RETURN 'left arrow
5650 IF YC%=77 AND ZJ<Z2 THEN LOCATE ,POS(0)+1:IF FLDTYPE%=4 AND (ZJ=3 OR ZJ=6) THEN LOCATE ,POS(0)+1:ZJ=ZJ+1:RETURN ELSE RETURN 'right arrow
5660 IF YC%=71 THEN HOMEFLAG%=1:ZJ=Z2:RETURN 'home key
5670 IF YC%=79 THEN ENDFLAG%=1:ZJ=Z2:RETURN 'end key
5680 IF YC%=117 OR YC%=31 THEN ZJ=Z2:ZENDSAVE%=1:RETURN 'Ctrl/Home or Alt/S to save and exit
5690 IF YC%=50 THEN ALTM%=1:RETURN
5700 IF YC%=32 THEN ALTD%=1:RETURN
5710 IF YC%=82 THEN ZJ=ZJ-1:IF INSERT%=0 AND ZJ<Z2 THEN INSERT%=1:LOCATE ,,,BLINKINSERT%,BLINK2%:RETURN ELSE INSERT%=0:LOCATE ,,,BLINKNORMAL%,BLINK2%:RETURN ' insert key
5720 IF YC%=83 THEN IF ZJ<Z2 THEN FLD$=MID$(ZI$(ZI,ZA),ZJ+1)+" " ELSE FLD$=" " 'delete key
5730 IF YC%=83 THEN COLOR 0,COLA%(3):LOCATE ,,0:PRINT FLD$:COLOR 7,0:LOCATE ZFLDPOSVERT%(ZA,ZI),POSY%,1:MID$(ZI$(ZI,ZA),ZJ)=FLD$:ZJ=ZJ-1:RETURN 'delete key
5860 IF (YC%>47 AND YC%<58) OR YC%=32 OR YC%=43 OR YC%=45 THEN RETURN
5870 SOUND 400,1:CFLAG%=1
5880 LOCATE 25,30,0:COLOR 15,0:PRINT "Must be whole number";:COLOR 7,0
5890 RETURN
6000 'Real number type field
6010 IF (YC%>42 AND YC%<58 AND YC%<>44 AND YC%<>47) OR YC%=32 THEN RETURN
6020 SOUND 400,1:CFLAG%=1
6030 LOCATE 25,32,0:COLOR 15,0:PRINT "Must be a number";:COLOR 7,0
6040 RETURN
6100 'Date type field
6110 ZMTH%=VAL(MID$(ZI$(ZI,ZA),1,2)):ZDAY%=VAL(MID$(ZI$(ZI,ZA),4,2)):ZYR=VAL(MID$(ZI$(ZI,ZA),7,2)):IF MID$(ZI$(ZI,ZA),7,2)="00" THEN ZYR=2000 ELSE IF ZYR=0 THEN SOUND 400,1:LOCATE 25,29,0:COLOR 15,0:PRINT "Year must have a value";:COLOR 7,0:RETURN
6120 IF ZMTH%<10 THEN IF MID$(ZI$(ZI,ZA),1,1)<>"0" THEN MID$(ZI$(ZI,ZA),1,2)=MID$(STR$(ZMTH%),2):LOCATE ZFLDPOSVERT%(ZA,ZI),ZFLDPOSHORIZ%(ZA,ZI),0:COLOR 0,7:PRINT MID$(ZI$(ZI,ZA),1,2);:COLOR 7,0
6130 IF ZDAY%<10 THEN IF MID$(ZI$(ZI,ZA),4,1)<>"0" THEN MID$(ZI$(ZI,ZA),4,2)=MID$(STR$(ZDAY%),2):LOCATE ZFLDPOSVERT%(ZA,ZI),ZFLDPOSHORIZ%(ZA,ZI),0:COLOR 0,7:PRINT MID$(ZI$(ZI,ZA),4,2);:COLOR 7,0
6140 IF ZMTH%<1 OR ZMTH%>12 THEN SOUND 400,1:LOCATE 25,26,0:COLOR 15,0:PRINT "Month must be 01 through 12";:COLOR 7,0:RETURN
6150 IF ZMTH%=2 AND ZDAY%=29 AND ((ZTEST/4)=INT(ZTEST/4)) AND ZTEST<>2000 THEN CFLAG%=0:RETURN
6160 IF ZMTH%=2 AND ZDAY%<=28 THEN CFLAG%=0:RETURN
6170 IF (ZMTH%=1 OR ZMTH%=3 OR ZMTH%=5 OR ZMTH%=7 OR ZMTH%=8 OR ZMTH%=10 OR ZMTH%=12) AND ZDAY% <= 31 THEN CFLAG%=0:RETURN
6180 IF (ZMTH%=4 OR ZMTH%=6 OR ZMTH%=9 OR ZMTH%=11) AND ZDAY%<=30 THEN CFLAG%=0:RETURN
6190 SOUND 400,1:LOCATE 25,25,0:COLOR 15,0:PRINT "Day out of range for the month";:COLOR 7,0:RETURN
6200 'Handle Inserted Character
6210 IF FLDTYPE%=4 OR ZJ=Z2 THEN RETURN 'no insert on Date field or if at end of field
7070 IF NEWTITLE%=1 AND ZS%(NEWFILE%,1)=1 THEN LOCATE 24,1:COLOR COLA%(2),0:PRINT "Esc=Abort";:LOCATE 24,60:PRINT CHR$(17)+CHR$(217)+" On 1st Field=Done";:COLOR 7,0
7075 IF NEWTITLE%=2 AND ZS%(NEWFILE%,1)=1 AND NOMSG%=1 THEN SOUND 400,1:LOCATE 24,12:COLOR COLA%(2),0:PRINT "This Master already exists - Strike any key to continue";: COLOR 7,0:ZQ$=INPUT$(1)
7080 IF NEWTITLE%=1 AND ZS%(NEWFILE%,1)=2 THEN LOCATE 24,1,0:COLOR COLA%(2),0:PRINT "Adding ";ZS$(NEWFILE%,1);" Detail for ";ZMASTER$;:LOCATE 25,1:PRINT "Esc=Abort";:LOCATE 25,73:PRINT CHR$(17)+CHR$(217)+"=Done";:COLOR 7,0
7090 IF NEWTITLE%=2 AND ZS%(NEWFILE%,1)=1 AND NOMSG%=0 THEN LOCATE 24,3,0:COLOR COLA%(2),0:PRINT "Alt/S or Ctrl/End = Save Modification - Esc = Escape Without Modification";:COLOR 7,0