Listing of file='PARLST.BAS;01' on disk='vmedia/personal_database_dbs_data-sector.ccvf'
100 REM ** PARLST - MAY 26,79 **
110 CLEAR 1000:DIM D(14),ST(130,1),A(14),K(50),P(11)
120 FG= PEEK (33265)
130 PLOT 6,0,12,14,6,37,3,8,0
140 PRINT " P R I N T F I L E W I T H O P T I O N S "
150 PLOT 6,0,15,3,0,3
160 ADR= 256* PEEK (32941)+ PEEK (32940)
170 DD= PEEK (ADR+ 1):TT= PEEK (ADR+ 2):PP= PEEK (ADR+ 4)
180 IF TT= 99THEN SAVE "1:PARLST":LOAD "INXDBS":RUN
190 IF DD< > 2OR PEEK (ADR+ 3)= 99THEN 220
200 PRINT TAB( 10):INPUT "INSERT DATA DISK - HIT RETURN ";I$
210 PLOT 3,0,3,11
220 PRINT TAB( 10):INPUT "ENTER NAME OF RANDOM FILE: ";F$:REM
230 F1$= F$
240 IF DD= 3THEN F$= "1:"+ F$
250 FILE "T",260:GOTO 280:GOTO 260
260 FILE "E",F,E,L:IF E< > 14THEN PRINT TAB( 10);"BAD FILE NAME":GOTO 220
270 PRINT TAB( 10);"CANNOT LOCATE ";F1$;"":GOTO 220
280 FILE "R",3,F$+ ".INF",2
290 SP= 1:GOSUB 3110
300 PRINT TAB( 10);"";F1$;" WAS LAST ACCESSED ON ";M;D;Y:REM
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 FILE "R",2,F$+ ".RND",2
360 FILE "A",2,CR,DL,BS,BF
370 PRINT TAB( 10):INPUT "ENTER NAME OF FORMAT FILE: ";F$:REM
380 F2$= F$
390 IF DD= 3THEN F$= "1:"+ F$
400 FILE "T",410:GOTO 430:GOTO 410
410 FILE "E",F,E,L:IF E< > 14THEN PRINT TAB( 10);"BAD FILE NAME":GOTO 370
420 PRINT TAB( 10);"CANNOT LOCATE ";F2$;"":GOTO 370
430 FILE "R",4,F$+ ".FMT",1
440 FILE "A",4,CR,LN,XZ,BF
450 FILE "C",4:FILE "R",4,F$+ ".FMT",INT (LN/ 7)+ 1
460 PRINT
470 PRINT :PRINT
480 PRINT TAB( 15);"1. COMPLETE LISTING"
490 PRINT TAB( 15);"2. SELECTED LISTING"
500 PRINT TAB( 15);"3. CREATE A SELECTIVE HOLD FILE"
510 PLOT 28,28,28,28
520 PRINT TAB( 10)
530 INPUT "SELECT ONE OF THE FOLLOWING OPTIONS: ";SL:REM
540 IF SL< 1OR SL> 3THEN PLOT 28,11:GOTO 520
550 PRINT :PRINT :PRINT :PRINT
560 IF PP= 0OR SL= 3THEN 590
570 PRINT TAB( 10):INPUT "OUTPUT TO THE SCREEN OR A PRINTER? ";I$:REM
580 IF LEFT$ (I$,1)= "P"THEN PLOT 27,13
590 IF SL> 1 THEN GOSUB 910
600 P= ROOT:IF ROOT= 0THEN PRINT TAB( 10);" EMPTY FILE":GOTO 850
610 PRINT :PRINT
620 IF SL< > 3THEN 680
630 PRINT TAB( 10);:INPUT "ENTER NAME OF HOLD FILE:";HL$:REM
640 IF DD= 3THEN HL$= "1:"+ HL$
650 FILE "N",HL$+ ".HLD",DL- AV- ER+ 1,4,32
660 FILE "R",5,HL$+ ".HLD",1:Z= 1
670 REM
** **
680 GOSUB 3040
690 FOR I= N TO 1 STEP - 1
700 ST(SP,0)= D(I)
710 ST(SP,1)= A(I)
720 SP= SP+ 1
730 NEXT I
740 IF A(0)< > 0 THEN P= A(0):GOTO 680
750 REM
** OPTION CALL **
760 FOR SP= SP- 1 TO 1 STEP - 1
770 D= ST(SP,0)
780 IF SL> 1THEN GOSUB 1890:IF SK(SK)= 0THEN 810
790 IF SL= 3 THEN PUT 5,Z;D:Z= Z+ 1:GOTO 810
800 GOSUB 2840
810 IF ST(SP,1)< > 0 THEN P= ST(SP,1):GOTO 680
820 NEXT SP
830 FILE "C",1,2,3,4
840 IF SL= 3 THEN PUT 5,Z;0:FILE "C",5
850 POKE 33265,FG
860 PRINT TAB( 10):INPUT "DO YOU WANT ANOTHER PRINTING? ";I$
870 IF I$= "Y"THEN POKE ADR+ 3,99:RUN
880 IF DD= 2THEN INPUT " INSERT PROGRAM DISK - HIT RETURN ";I$
890 POKE ADR+ 3,0:LOAD "MAIN":RUN
900 REM
910 DIM EX(50),K$(50),SK(20),KX$(50)
920 A$= "":B$= ""
930 PRINT :PRINT "ENTER":PRINT "SELECTION":PRINT "CRITERIA: ";
940 PRINT TAB( 10):INPUT "";B$:REM
950 A$= A$+ B$:IF RIGHT$ (A$,1)< > "]"THEN 940
960 L= LEN (A$):FOR I= 1 TO L
970 IF MID$ (A$,I,2)= "=<" THEN A$= LEFT$ (A$,I- 1)+ "<="+ MID$ (A$,I+ 2,L- I+ 2)
980 IF MID$ (A$,I,2)= ">=" THEN A$= LEFT$ (A$,I- 1)+ "=>"+ MID$ (A$,I+ 2,L- I+ 2)
990 NEXT I
1000 PRINT TAB( 10);"THIS WILL TAKE AWHILE..."
1010 FOR I= 1 TO 13:READ KX$(I):NEXT I
1020 DATA [,],(,),OR,AND,NOT,<>,<=,=>,<,>,=
1030 J= 14
1040 FOR I= 1 TO LEN (A$)
1050 REM
1060 IF MID$ (A$,I,1)= "-"OR MID$ (A$,I,1)= "."THEN 1090
1070 IF MID$ (A$,I,1)= > "0"AND MID$ (A$,I,1)< = "9"THEN 1090
1080 NEXT I:GOTO 1130
1090 IF MID$ (A$,I,1)= > "+"AND MID$ (A$,I,1)< = "9"THEN KX$(J)= KX$(J)+ MID$ (A$,I,1):I= I+ 1:GOTO 1090
1100 REM
1110 IF MID$ (A$,I,1)= ")"THEN KX$(J)= "":GOTO 1080:REM DO NOT DOCUMENT SUBSCRIPTS
1120 K(J)= VAL (KX$(J)):J= J+ 1:GOTO 1080
1130 FOR I= 1 TO LEN (A$)
1140 IF MID$ (A$,I,1)= "'"THEN 1170
1150 NEXT I:GOTO 1220
1160 REM
1170 KX$(J)= KX$(J)+ MID$ (A$,I,1)
1180 I= I+ 1:IF MID$ (A$,I,1)< > "'"THEN 1170
1190 KX$(J)= KX$(J)+ "'"
1200 I= I+ 1:K$(J)= MID$ (KX$(J),2,LEN (KX$(J))- 2):J= J+ 1:GOTO 1150
1210 REM
1220 FILE "A",3,CR,FL,XZ,BF
1230 VR= J
1240 BY= 1:FOR I= 2 TO FL
1250 GET 3,I;KY$[16],KY,R:IF R= 0 THEN B= 1
1260 I1= 1:KY$= KY$+ " "
1270 IF MID$ (KY$,I1,1)< > " "THEN KX$(J)= KX$(J)+ MID$ (KY$,I1,1):I1= I1+ 1:GOTO 1270
1280 IF R= 1 THEN 1310
1290 Q1$= KX$(J):FOR Q= 1 TO R:Q$= MID$ (STR$ (Q),2):KX$(Q+ J- 1)= Q1$+ "("+ Q$+ ")":NEXT Q
1300 FOR Q= 1 TO R:K(Q+ J- 1)= BY+ (Q- 1)* KY:NEXT Q:J= J+ R:GOTO 1330
1310 K(J)= BY:IF KY< 0 THEN K(J)= - K(J)
1320 J= J+ 1
1330 BY= BY+ ABS (KY)* R:NEXT I
1340 K(J)= BS
1350 M= 1
1360 FOR I= 1TO LEN (A$)
1370 P= 14
1380 IF KX$(P)< > MID$ (A$,I,LEN (KX$(P))) THEN 1400
1390 EX(M)= P:M= M+ 1:I= I+ LEN (KX$(P))- 1:GOTO 1450
1400 IF P< J- 1 THEN P= P+ 1:GOTO 1380
1410 P= 1
1420 IF KX$(P)< > MID$ (A$,I,LEN (KX$(P))) THEN 1440
1430 EX(M)= P:M= M+ 1:I= I+ LEN (KX$(P))- 1:GOTO 1450
1440 IF P< 13 THEN P= P+ 1:GOTO 1420
1450 NEXT I
1460 REM
1470 FOR I= 1 TO M- 1
1480 IF EX(I)< 14AND EX(I)> 7THEN T= EX(I):EX(I)= EX(I+ 1):EX(I+ 1)= T:I= I+ 1
1490 NEXT I
1500 REM
1510 I= 0:S= 0:CT= 0
1520 IF EX(I)< > 1 AND EX(I)< > 3 THEN 1560
1530 IF S= 0 THEN S= I:GOTO 1590
1540 CT= CT+ 1:GOTO 1590
1550 REM
1560 IF EX(I)< > 2 AND EX(I)< > 4 THEN 1590
1570 IF CT= 0THEN F= I:GOTO 1600
1580 CT= CT- 1
1590 IF I< M THEN I= I+ 1:GOTO 1520
1600 IF CT< > 0THEN PRINT TAB( 10);"PARENTHESIS ERROR":GOTO 850
1610 IF S= 0 THEN 1870:REM ALL DONE
1620 REM
1630 EX(S)= 0:EX(F)= 0
1640 FOR PRS= 7 TO 5 STEP - 1
1650 P= 0
1660 FOR I= S TO F
1670 IF EX(I)= 3 THEN P= P+ 1
1680 IF EX(I)< > PRS THEN 1830
1690 IF P> 0 THEN 1850
1700 PTH= 0
1710 J= I+ 1
1720 REM
1730 IF EX(J)> PRS THEN J= J+ 1:GOTO 1730
1740 IF EX(J)= 0 AND J< F THEN J= J+ 1:GOTO 1730
1750 IF EX(J)= 3 THEN PTH= PTH+ 1:J= J+ 1:GOTO 1730
1760 IF EX(J)= 4 THEN PTH= PTH- 1:J= J+ 1:GOTO 1730
1770 IF PTH> 0 THEN J= J+ 1:GOTO 1730
1780 REM
1790 J= J- 1
1800 EX(I)= EX(I+ 1)
1810 IF I< J- 1 THEN I= I+ 1:GOTO 1800
1820 EX(J)= PRS
1830 IF EX(I)= 4 THEN P= P- 1
1840 NEXT I
1850 NEXT PRS
1860 GOTO 1510
1870 RETURN
1880 REM
1890 SK= 0:FOR I= 1 TO M- 1
1900 IF EX(I)= 0 THEN 1960
1910 IF EX(I)> 13 THEN SK= SK+ 1:SK(SK)= EX(I):GOTO 1960
1920 IF EX(I)< 5 THEN PRINT "OPCODE ERROR":END
1930 IF K(SK(SK- 1))< 0 THEN GT= 1:GOTO 1950
1940 GT= 2
1950 ON EX(I)- 4GOSUB 2010,2060,2110,2150,2240,2340,2430,2520,2610
1960 NEXT I
1970 REM
1980 IF SK< > 1THEN PRINT 1940,"STACK=";SK
1990 RETURN :REM SK(SK) WILL BE 1 IF VALID RECORD
2000 REM
2010 IF SK(SK)= 1 OR SK(SK- 1)= 1 THEN SK(SK- 1)= 1:GOTO 2030
2020 SK(SK- 1)= 0
2030 SK= SK- 1
2040 RETURN
2050 REM
2060 IF SK(SK)= 1 AND SK(SK- 1)= 1 THEN 2080
2070 SK(SK- 1)= 0
2080 SK= SK- 1
2090 RETURN
2100 REM
2110 IF SK(SK)= 1 THEN SK(SK)= 0:GOTO 2130
2120 SK(SK)= 1
2130 RETURN
2140 REM
2150 ON GT GOSUB 2700,2760
2160 IF GT= 2 THEN 2190
2170 IF A< > B THEN SK(SK- 1)= 1:GOTO 2210
2180 GOTO 2200
2190 IF A$< > B$ THEN SK(SK- 1)= 1:GOTO 2210
2200 SK(SK- 1)= 0
2210 SK= SK- 1
2220 RETURN
2230 REM
2240 ON GT GOTO 2250,2280
2250 GOSUB 2700
2260 IF A< = B THEN SK(SK- 1)= 1:GOTO 2310
2270 SK(SK- 1)= 0:GOTO 2310
2280 GOSUB 2760
2290 IF A$< = B$THEN SK(SK- 1)= 1:GOTO 2310
2300 SK(SK- 1)= 0
2310 SK= SK- 1
2320 RETURN
2330 REM
2340 ON GT GOSUB 2700,2760
2350 IF GT= 2 THEN 2380
2360 IF A= > B THEN SK(SK- 1)= 1:GOTO 2400
2370 GOTO 2390
2380 IF A$= > B$THEN SK(SK- 1)= 1:GOTO 2400
2390 SK(SP- 1)= 0
2400 SK= SK- 1
2410 RETURN
2420 REM
2430 ON GT GOSUB 2700,2760
2440 IF GT= 2 THEN 2470
2450 IF A< B THEN SK(SK- 1)= 1:GOTO 2490
2460 GOTO 2480
2470 IF A$< B$THEN SK(SK- 1)= 1:GOTO 2490
2480 SK(SK- 1)= 0
2490 SK= SK- 1
2500 RETURN
2510 REM
2520 ON GT GOSUB 2700,2760
2530 IF GT= 2 THEN 2560
2540 IF A> B THEN SK(SK- 1)= 1:GOTO 2580
2550 GOTO 2570
2560 IF A$> B$ THEN SK(SK- 1)= 1:GOTO 2580
2570 SK(SK- 1)= 0
2580 SK= SK- 1
2590 RETURN
2600 REM
2610 ON GT GOSUB 2700,2760
2620 IF GT= 2 THEN 2650
2630 IF A= B THEN SK(SK- 1)= 1:GOTO 2670
2640 GOTO 2660
2650 IF A$= B$ THEN SK(SK- 1)= 1:GOTO 2670
2660 SK(SK- 1)= 0
2670 SK= SK- 1
2680 RETURN
2690 REM
2700 REM GET NUMERIC
2710 IF SK(SK)< VR THEN B= K(SK(SK)):GOTO 2730
2720 GET 2,D,ABS (K(SK(SK)));B
2730 GET 2,D,ABS (K(SK(SK- 1)));A
2740 RETURN
2750 REM
2760 REM GET ALPHA
2770 IF SK(SK)< VR THEN B$= K$(SK(SK)):GOTO 2800
2780 J= SK(SK):L= ABS (K(J+ 1))- K(J)
2790 GET 2,D,K(J);B$[L]
2800 J= SK(SK- 1):L= ABS (K(J+ 1))- K(J)
2810 GET 2,D,K(J);A$[L]
2820 B$= LEFT$ (B$+ " ",L)
2830 RETURN
2840 REM
** D=RECORD RND **
2850 FOR I= 1 TO LN
2860 GET 4,I;K,F0,F1,F2,F3
2870 ON F0+ 2 GOTO 2880,2930,2960
2880 GET 2,D,K;X
2890 IF F2= 0 THEN PRINT RIGHT$ (" "+ STR$ (X),F1);:GOTO 3010
2900 D1= INT (X):E= INT ((1+ X- D1)* 10^ F2)
2910 PRINT RIGHT$ (" "+ STR$ (D1)+ "."+ RIGHT$ (STR$ (E),F2),F1);
2920 GOTO 3010
2930 IF K= - 1 THEN PRINT :GOTO 3010
2940 PRINT SPC( F1);
2950 GOTO 3010
2960 IF F2= 0 THEN F2= 1
2970 IF K+ F1+ F2- 1> BSTHEN L1= BS- K+ 1:GOTO 2990
2980 L1= F1+ F2- 1
2990 GET 2,D,(K+ F2- 1);X$[L1]
3000 PRINT LEFT$ (X$+ " ",F1);
3010 NEXT I
3020 PRINT :RETURN
3030 REM
3040 REM GET P
3050 GET 1,P;N,A(0)
3060 FOR M1= 1 TO N
3070 GET 1,P,(KL+ 8)* M1- (KL- 1);K$(M1)[KL],D(M1),A(M1)
3080 NEXT M1
3090 RETURN
3100 REM
3110 GET 3,1;ROOT,FR,FD,MDY,AV,ER
3120 M= INT (MDY/ 3200)
3130 D= INT ((MDY- M* 3200)/ 100)
3140 Y= MDY- (INT (MDY/ 100)* 100)
3150 RETURN