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