Listing of file='DBS16.BAS;01' on disk='vmedia/personal_database-sector.ccvf'
100 REM ** DBS16 - MAY 26,79 **
110 CLEAR 2000:DIM D(14),D1(14),D2(14),P0(10)
120 FILE "T",130:GOTO 160
130 IF E< > 14THEN PRINT TAB( 10);"BAD FILE NAME"
140 IF E= 14THEN PRINT TAB( 10);"CANNOT LOCATE FILE"
150 GOTO 240
160 PLOT 6,0,12,14,6,28,3,3,0
170 PRINT " D A T A B A S E M A N A G E M E N T S Y S T E M "
180 PLOT 6,6,15,3,0,4
190 REM
** GET TRANSFER VALUES **
200 ADR= 256* PEEK (32941)+ PEEK (32940)
210 DD= PEEK (ADR+ 1):TT= PEEK (ADR+ 2):TF= PEEK (ADR+ 3)
220 IF PEEK (ADR+ 2)= 99THEN SAVE "1:DBS16":LOAD "DBSLST":RUN
230 IF DD= 2THEN GOSUB 4100:INPUT "INSERT DATA DISK - HIT RETURN ";I$
240 GOSUB 4100:INPUT "ENTER NAME OF RANDOM FILE: ";F$:REM
250 IF F$= "EXIT" THEN 4020
260 MAX$= "":FOR I= 1TO 19:MAX$= MAX$+ CHR$ (255)
270 P$= F$:IF DD= 3THEN F$= "1:"+ F$
280 REM
** SET-UP .INF FILE **
290 FILE "R",3,F$+ ".INF",2
300 GOSUB 4050
310 GET 3,2;KEY$[16],KL
320 FILE "R",1,F$+ ".INX",3
330 KN= 5:RL= (ABS (KL)+ 8)* KN+ 8
340 RD= INT ((RL+ 127)/ 128)* 128:KN= INT ((RD- 8)/ (ABS (KL)+ 8))
350 DIM A(KN+ 2),P(11),A1(KN+ 2),A2(KN+ 2),ST(30,1)
360 FOR I= 16TO 1STEP - 1:IF MID$ (KEY$,I,1)= " "THEN NEXT I
370 KEY$= LEFT$ (KEY$,I+ 1)
380 FILE "R",2,F$+ ".RND",1:FOR I= 1TO 65:SP$= SP$+ " ":NEXT I:FILE "A",2,CR,DL,BS,BF
390 FILE "A",3,DV,NI,DV,DV:NI= NI* 24
400 IF FRE (0)> NI+ 300THEN FILE "C",3:FILE "R",3,F$+ ".INF",INT (NI/ 120)+ 1
410 FILE "A",2,DV,NI,DV,DV
420 REM
430 DIM K$(KN+ 2),K1$(30),K2$(KN+ 2)
440 V10= KN+ 1:V9= KN:V4= INT (KN/ 2):V8= 2* V4:V5= V4+ 1:V6= V4+ 2:V3= V4- 1
450 NI= INT (LOG (V4* NI+ NI+ 1)/ LOG (V4)+ 1.99)
460 IF NI< 4THEN 510
470 X= INT ((FRE (0)- 500)/ (128* INT ((KN* (KL+ 8)+ 135)/ 128)))
480 IF X> 4THEN FILE "C",1:FILE "R",1,F$+ ".INX",X
490 PLOT 6,2,12
500 REM
** FUNCTION SELECTIOM **
510 PLOT 8,6,2:FOR I= 0TO 4:PLOT 3,0,I,11:NEXT I
520 PLOT 6,29,14,3,21,0
530 PRINT " D A T A B A S E "
540 PLOT 6,2,15
550 PLOT 3,45,0:PRINT "LAST ACCESSED"
560 PLOT 3,47,1:PRINT "";MT;DT;YT;""
570 PLOT 3,0,0:PRINT "FILE NAME - ";P$:REM
580 PLOT 3,0,1:PRINT "RECORDS LEFT -";AV;""
590 PRINT
600 PRINT SPC( 26);"ADD,DELETE,UPDATA,LIST,RANGE,END":PLOT 28
610 INPUT "ENTER FUNCTION: ";A$:REM
620 PE= 30:A$= LEFT$ (A$,1)
630 IF LS$= "R"AND (A$< > "R"OR A$< > "E")THEN PE= 7
640 PLOT 6,2:FOR I= 5TO PE:PLOT 3,0,I,11:NEXT I:PLOT 3,0,5
650 LS$= A$:IF A$= "R"THEN 800
660 IF A$< > "A"AND A$< > "D"AND A$< > "L"AND A$< > "U"AND A$< > "E"THEN 510
670 IF A$= "E"THEN 720
680 PLOT 19,3,23- LEN (KEY$),5:PRINT KEY$;" ";SPC( KL);" "
690 PLOT 6,3,3,23- LEN (KEY$),5
700 PRINT KEY$;" ";:PLOT 6,39:INPUT "";X$:PLOT 6,2,28
710 PLOT 6,2:FOR I= 6TO 30:PLOT 3,0,I,11:NEXT I:PLOT 19,3,0,5
720 T= ROOT:IF A$< > "D"THEN 740
730 GOSUB 1630:IF DE$= "Y"THEN PRINT :PRINT TAB( 20);"KEY DELETED"
740 IF A$= "A"THEN GOSUB 1300
750 IF A$= "E"THEN 3970
760 IF A$= "L"THEN BG= 0:GOSUB 2430
770 IF A$= "U"THEN GOSUB 2960
780 PRINT :PRINT :GOTO 510
790 REM
** RANGE **
800 PLOT 3,0,5,11,10,11,0,3,0,5
810 PRINT TAB( 15);:INPUT "LOWER LIMIT=";LL$
820 PRINT TAB( 15);:INPUT "UPPER LIMIT=";UL$
830 UL$= UL$+ " "
840 PLOT 11
850 IF LL$< = UL$THEN 870
860 PRINT " LOWER LIMIT MUST BE LESS THAN UPPER LIMIT":GOTO 800
870 FOR I= 8TO 31:PLOT 3,0,I,11:NEXT I:PLOT 3,0,8
880 SP= 1:J= 0
890 P= ROOT:IF P= 0THEN PRINT TAB( 15);"NO ACTIVE RECORDS IN FILE":GOTO 510
900 GOSUB 3610
910 I= N
920 K1$(SP)= K$(I)
930 ST(SP,1)= A(I)
940 IF K$(I)< = UL$THEN SP= SP+ 1
950 IF SP> 30THEN PRINT TAB( 15);"STACK OVERFLOW - USE NARROWER RAGE":GOTO 800
960 IF K$(I)> LL$AND I> 1THEN I= I- 1:GOTO 920
970 IF A(I)= 0THEN 1000
980 IF K$(I)< LL$THEN P= A(I):SP= SP- 1:GOTO 900
990 IF K$(I)> LL$THEN P= A(I- 1):GOTO 900
1000 FOR SP= SP- 1TO 1STEP - 1
1010 IF K1$(SP)= > LL$AND K1$(SP)< = UL$THEN PRINT K1$(SP):J= J+ 1
1020 IF J= 20THEN PRINT TAB( 10);:INPUT "DO YOU WANT MORE? ";A$
1030 IF LEFT$ (A$,1)< > "Y"THEN 1050
1040 J= 0:A$= "":FOR I= 8TO 30:PLOT 3,0,I,11:NEXT I:PLOT 3,0,8
1050 IF J= > 20THEN 510
1060 IF ST(SP,1)< > 0THEN P= ST(SP,1):GOTO 900
1070 NEXT SP
1080 GOTO 510
1090 REM
1100 REM
** SEARCH **
1110 IF T= 0THEN I= 1:J= 0:RETURN
1120 P= T:P1= 0:K$(0)= "":P0(P1)= 0
1130 P1= 0
1140 Q= 0
1150 IF P= 0THEN 1280
1160 P1= P1+ 1
1170 P0(P1)= P
1180 GOSUB 3610
1190 K$(0)= ""
1200 K$(N+ 1)= MAX$
1210 I= 0
1220 IF X$> K$(I)THEN I= I+ 1:GOTO 1220
1230 IF LEFT$ (X$+ SP$,KL)= K$(I)THEN J= 1:RETURN
1240 IF K$(I)> X$THEN I= I- 1
1250 Q= P
1260 P= A(I)
1270 IF P< > 0THEN 1150
1280 P= Q:J= 0:IF P< > P0(P1)THEN P1= P1- 1
1290 RETURN
1300 REM
** ADD **
1310 A= 0:K$= X$:J= 0
1320 GOSUB 1100
1330 IF J< > 0THEN PRINT :PRINT TAB( 18);"KEY ALREADY IN FILE":RETURN
1340 IF FD> DLTHEN PRINT :PRINT TAB( 18);"NO SPACE ON DISK":AV= 0:RETURN
1350 GET 2,FD;A2$[1],A3$[1]:FZ= ASC (A2$)* 256+ ASC (A3$)
1360 AV= AV- 1:REM
1370 GOSUB 3540
1380 D= FD:FD= FZ
1390 IF P= 0THEN 1580
1400 GOSUB 3610:I= 0
1410 K$(N+ 1)= MAX$:K$(0)= ""
1420 IF K$(I)< K$THEN I= I+ 1:GOTO 1420
1430 N= N+ 1:FOR M= NTO ISTEP - 1
1440 K$(M+ 1)= K$(M):A(M+ 1)= A(M):D(M+ 1)= D(M)
1450 NEXT M
1460 A(I)= A:K$(I)= K$:D(I)= D
1470 M= 0
1480 IF N< V10THEN 3790
1490 FOR J= 1TO V4:PUT 1,P,(KL+ 8)* J- (KL- 1);K$(J)[KL],D(J),A(J):NEXT J
1500 PUT 1,P;V4,A(0)
1510 GET 1,FR;FT,FT
1520 FOR J= V6TO V10:PUT 1,FR,(KL+ 8)* J- (V6* (KL+ 8)- 9);K$(J)[KL],D(J),A(J):NEXT J
1530 PUT 1,FR;V10- V5,A(V5)
1540 D= D(V5)
1550 K$= K$(V5):A= FR:P1= P1- 1:P= P0(P1):FR= FT
1560 I= 0
1570 GOTO 1390
1580 T= ROOT
1590 GET 1,FR;FT,FT
1600 PUT 1,FR;1,T,K$[KL],D,A
1610 ROOT= FR:FR= FT
1620 RETURN
1630 REM
** DELETE **
1640 K$(0)= "":K1$(0)= "":K2$(0)= ""
1650 DE$= "N":K$= X$
1660 GOSUB 1100
1670 IF J< > 1THEN PRINT :PRINT TAB( 18);"KEY NOT IN FILE":RETURN
1680 DE$= "Y":GOSUB 3610
1690 AV= AV+ 1
1700 PUT 2,D(I);CHR$ (FD/ 256)[1],CHR$ (FDAND 255)[1]
1710 PUT 2,D(I),3;CHR$ (0)[1],CHR$ (0)[1]
1720 FD= D(I)
1730 IF A(0)= 0THEN 1840
1740 Q= A(I):Z= Q
1750 GOSUB 3670
1760 P1= P1+ 1:P0(P1)= Q
1770 IF A1(0)= 0THEN 1790
1780 Q= A1(0):GOTO 1750
1790 K$(I)= K1$(1):D(I)= D1(1)
1800 GOSUB 3790
1810 P= Q:I= 1
1820 GOSUB 3610:GOTO 1840
1830 IF K$(I)< > LEFT$ (X$+ SP$,KL)THEN I= I+ 1:GOTO 1830
1840 N= N- 1
1850 REM
1860 FOR J= ITO N:K$(J)= K$(J+ 1):D(J)= D(J+ 1):A(J)= A(J+ 1):NEXT J
1870 K$(N+ 1)= ""
1880 IF N> V3OR P= ROOTTHEN 2410
1890 REM
1900 I= 0
1910 IF P0(I)< > PTHEN I= I+ 1:GOTO 1910
1920 P1= I
1930 Z= P0(P1- 1)
1940 Q= Z:GOSUB 3670:REM
1950 Y= 0:J= 1
1960 IF A1(J- 1)< > PTHEN J= J+ 1:GOTO 1960
1970 IF J> N1THEN Y= 0:GOTO 2190
1980 Y= A1(J)
1990 IF Y= 0THEN 2190
2000 GOSUB 3730:REM
2010 IF N2< V5THEN 2080:REM
2020 K$(N+ 1)= K1$(J):D(N+ 1)= D1(J):A(N+ 1)= A2(0)
2030 N= N+ 1:GOSUB 3790
2040 K1$(J)= K2$(1):D1(J)= D2(1):GOSUB 3850:REM
2050 FOR I= 0TO N2:A2(I)= A2(I+ 1):D2(I)= D2(I+ 1):K2$(I)= K2$(I+ 1):NEXT I
2060 N2= N2- 1:GOSUB 3910
2070 RETURN
2080 REM
2090 K$(N+ 1)= K1$(J):D(N+ 1)= D1(J):A(N+ 1)= A2(0)
2100 FOR I= 1TO N2
2110 A(N+ 1+ I)= A2(I):K$(N+ 1+ I)= K2$(I):D(N+ 1+ I)= D2(I)
2120 NEXT I
2130 N= V8:GOSUB 3790
2140 PUT 1,Y;0,FR:FR= Y:REM
2150 N= N1:FOR I= 1TO N1:K$(I)= K1$(I):D(I)= D1(I):A(I)= A1(I):NEXT I
2160 A(0)= A1(0):N= N- 1
2170 P= Z:IF N= 0THEN ROOT= A(0):PUT 1,P;0,FR:FR= P:RETURN :REM
2180 I= J:GOTO 1850:REM
2190 REM
2200 J= 1
2210 IF A1(J)< > PTHEN J= J+ 1:GOTO 2210
2220 Y= A1(J- 1)
2230 GOSUB 3730:REM
2240 IF N2< V5THEN 2310:REM
2250 FOR I= V3TO 1STEP - 1:K$(I+ 1)= K$(I):D(I+ 1)= D(I):A(I+ 1)= A(I)
2260 NEXT I
2270 K$(1)= K1$(J):D(1)= D(J):N= V4:GOSUB 3790
2280 K1$(J)= K2$(N2):D1(J)= D2(N2):GOSUB 3850
2290 K2$(N2)= "":A2(N2)= 0:N2= N2- 1:GOSUB 3910
2300 RETURN
2310 REM
2320 PUT 1,Y;V8:FOR I= 1TO V4:PUT 1,Y,(KL+ 8)* I- (KL- 1);K2$(I)[KL],D2(I),A2(I)
2330 NEXT I
2340 PUT 1,Y,5;A2(0):PUT 1,Y,V4* KL+ V5* 8+ 1;K1$(J)[KL],D1(J),A(0)
2350 FOR I= 1TO V8- V5:PUT 1,Y,(KL+ 8)* I+ V4* KL+ V5* 8+ 1;K$(I)[KL],D(I),A(I)
2360 NEXT I
2370 PUT 1,P;0,FR:FR= P:REM
2380 P= Z:GOSUB 3610:I= J:N= N- 1
2390 IF N= 0THEN ROOT= A(0):PUT 1,P;0,FR:FR= P:RETURN
2400 GOTO 1850:REM
2410 IF N= 0THEN ROOT= A(0):PUT 1,P;0,FR:FR= P:RETURN
2420 GOTO 3790:REM
2430 REM
** LIST **
2440 REM -CAN BE REMOVED
2450 K$= X$
2460 IF AF= 1THEN 2490
2470 GOSUB 1100
2480 IF J< > 1THEN PRINT :PRINT TAB( 18);"KEY NOT IN FILE":RETURN
2490 FILE "A",3,CR,NR,BS,BF
2500 BY= 1
2510 PLOT 6,7
2520 FOR M= 2TO NR
2530 GET 3,M;KY$[16],KY,R
2540 IF R< > 1THEN 2770
2550 IF KY< 0THEN 2670
2560 GET 2,D(I),BY;A$[KY]
2570 IF AF= 1THEN A$= SP$
2580 IF M= 2THEN A$= X$
2590 PLOT 6,6:PRINT KY$;" A"
2600 IF KY< 55THEN PLOT 28,9,9,9
2610 PLOT 6,7+ 32* BG:PRINT LEFT$ (A$,KY)
2620 PLOT 6,7
2630 BY= BY+ KY
2640 NEXT M
2650 RETURN
2660 REM
2670 GET 2,D(I),BY;A1
2680 IF AF= 1THEN A1= 0
2690 IF M= 2THEN A1= X
2700 PLOT 6,6:PRINT KY$;" N"
2710 PLOT 28,9,9,9,6,7+ 32* BG:PRINT SPC( 13);""
2720 PLOT 28,9,9,9,6,7+ BG* 32:PRINT A1
2730 PLOT 6,7
2740 BY= BY+ 4
2750 GOTO 2640
2760 REM
2770 FOR M1= 1TO R
2780 IF KY< 0THEN 2890
2790 GET 2,D(I),BY;A$[KY]
2800 IF AF= 1THEN A$= SP$
2810 PLOT 6,6:PRINT KY$;"(";RIGHT$ (STR$ (M1),2);") A"
2820 IF KY< 55THEN PLOT 28,9,9,9
2830 PLOT 6,7+ 32* BG:PRINT LEFT$ (A$,KY)
2840 PLOT 6,7
2850 BY= BY+ KY
2860 NEXT M1
2870 GOTO 2640
2880 REM
2890 GET 2,D(I),BY;A1
2900 IF AF= 1THEN A1= 0
2910 PLOT 6,6:PRINT KY$;"(";RIGHT$ (STR$ (M1),2);") N"
2920 PLOT 28,9,9,9,9,7+ 32* BG:PRINT SPC( 13);""
2930 PLOT 28,9,9,9,6,7+ 32* BG:PRINT A1
2940 BY= BY+ 4
2950 GOTO 2860
2960 REM
** UPDATE **
2970 K$= X$
2980 GOSUB 1100
2990 IF J= 0THEN PRINT :PRINT TAB( 18);"NO PREVIOUS RECORD OF KEY":RETURN
3000 BG= 1:GOSUB 2430:PLOT 3,0,6
3010 BY= ABS (KL)+ 1
3020 IF NR= 2THEN 3170
3030 FOR M= 3TO NR
3040 GET 3,M;KY$[16],KY,R
3050 IF R> 1THEN 3290
3060 IF KY< 0THEN 3200
3070 IF AF= 1THEN A$= SP$
3080 IF KY> 55THEN PLOT 10,6,39:INPUT "";B$:GOTO 3100
3090 PLOT 9,9,9,6,39:INPUT "";B$
3100 IF LEN (B$)= 0THEN B$= LEFT$ (SP$,ABS (KY))
3110 IF ASC (B$)< > 9THEN PUT 2,D(I),BY;B$[KY]
3120 IF ASC (B$)= 9AND AF= 1THEN PUT 2,D(I),BY;SP$[KY]
3130 IF KY> 55AND ASC (B$)< > 9THEN PLOT 28:PRINT LEFT$ (B$+ SP$,KY):GOTO 3150
3140 IF ASC (B$)< > 9THEN PLOT 28,9,9,9:PRINT LEFT$ (B$+ SP$,KY)
3150 BY= BY+ KY
3160 NEXT M
3170 PLOT 6,7:AF= 0
3180 RETURN
3190 REM
3200 IF AF= 1THEN A1= 0
3210 PLOT 9,9,9,6,39:INPUT "";B$
3220 IF LEN (B$)= 0THEN B$= CHR$ (9)
3230 IF ASC (B$)< > 9THEN PUT 2,D(I),BY;VAL (B$)
3240 IF ASC (B$)= 9AND AF= 1THEN PUT 2,D(I),BY;0
3250 IF ASC (B$)< > 9THEN PLOT 28,9,9,9,6,39:PRINT LEFT$ (B$+ SP$,13)
3260 BY= BY+ 4
3270 GOTO 3160
3280 REM
3290 IF KY< 0THEN 3430
3300 FOR M1= 1TO R
3310 IF AF= 1THEN A$= SP$
3320 IF KY> 55THEN PLOT 10,6,39:INPUT "";B$:GOTO 3350
3330 PLOT 9,9,9,6,39:INPUT "";B$
3340 IF LEN (B$)= 0THEN B$= LEFT$ (SP$,KY)
3350 IF ASC (B$)< > 9THEN PUT 2,D(I),BY;B$[KY]
3360 IF ASC (B$)= 9AND AF= 1THEN PUT 2,D(I),BY;A$[KY]
3370 IF KY> 55AND ASC (B$)< > 9THEN PLOT 28:PRINT LEFT$ (B$+ SP$,KY):GOTO 3390
3380 IF ASC (B$)< > 9THEN PLOT 28,9,9,9,6,39:PRINT LEFT$ (B$+ SP$,KY)
3390 BY= BY+ KY
3400 NEXT M1
3410 GOTO 3160
3420 REM
3430 FOR M1= 1TO R
3440 IF AF= 1THEN A1= 0
3450 PLOT 9,9,9,6,39:INPUT "";B$
3460 IF LEN (B$)= 0THEN B$= CHR$ (9)
3470 IF ASC (B$)< > 9THEN PUT 2,D(I),BY;VAL (B$)
3480 IF ASC (B$)= 9AND AF= 1THEN PUT 2,D(I),BY;0
3490 IF ASC (B$)< > 9THEN PLOT 28,9,9,9,6,39:PRINT VAL (B$)
3500 BY= BY+ 4
3510 NEXT M1
3520 GOTO 3160
3530 REM
3540 D(I)= FD
3550 FILE "A",3,CR,NR,BS,BF
3560 GET 3,2;KY$[16],KY
3570 PUT 2,FD;X$[KL]
3580 BY= KL+ 1
3590 AF= 1:D(I)= FD:GOTO 3000
3600 REM
3610 GET 1,P;N,A(0)
3620 FOR M= 1TO N
3630 GET 1,P,(KL+ 8)* M- (KL- 1);K$(M)[KL],D(M),A(M)
3640 NEXT M
3650 RETURN
3660 REM
3670 GET 1,Q;N1,A1(0)
3680 FOR M= 1TO N1
3690 GET 1,Q,(KL+ 8)* M- (KL- 1);K1$(M)[KL],D1(M),A1(M)
3700 NEXT M
3710 RETURN
3720 REM
3730 GET 1,Y;N2,A2(0)
3740 FOR M= 1TO N2
3750 GET 1,Y,(KL+ 8)* M- (KL- 1);K2$(M)[KL],D2(M),A2(M)
3760 NEXT M
3770 RETURN
3780 REM
3790 PUT 1,P;N,A(0)
3800 FOR M= 1TO N
3810 PUT 1,P,(KL+ 8)* M- (KL- 1);K$(M)[KL],D(M),A(M)
3820 NEXT M
3830 RETURN
3840 REM
3850 PUT 1,Q;N1,A1(0)
3860 FOR M= 1TO N
3870 PUT 1,Q,(KL+ 8)* M- (KL- 1);K1$(M)[KL],D1(M),A1(M)
3880 NEXT M
3890 RETURN
3900 REM
3910 PUT 1,Y;N2,A2(0)
3920 FOR M= 1TO N2
3930 PUT 1,Y,(KL+ 8)* M- (KL- 1);K2$(M)[KL],D2(M),A2(M)
3940 NEXT M
3950 RETURN
3960 REM
** END **
3970 INPUT "TODAY IS M,D,Y ";M,D,Y
3980 Y= Y- (INT (Y/ 100)* 100)
3990 MDY= M* 3200+ D* 100+ Y
4000 PUT 3,1;ROOT,FR,FD,MDY,AV,ER
4010 FILE "C",1,2,3:PRINT
4020 IF DD= 2THEN PRINT :PRINT TAB( 10):INPUT "INSERT PROGRAM DISK - HIT RETURN ";I$
4030 LOAD "MAIN":RUN
4040 REM
4050 GET 3,1;ROOT,FR,FD,MDY,AV,ER
4060 MT= INT (MDY/ 3200)
4070 DT= INT ((MDY- MT* 3200)/ 100)
4080 YT= MDY- (INT (MDY/ 100)* 100)
4090 RETURN
4100 PRINT :PRINT TAB( 10);:RETURN