Listing of file='CREDDL.BAS;01' on disk='vmedia/personal_database-sector.ccvf'
100 REM ** CREDDL - MAY 27,79 ** 110 CLEAR 1000:DIM D$(50),M(50),C(50):FG= PEEK (33265) 120 ADR= 256* PEEK (32941)+ PEEK (32940):DD= PEEK (ADR+ 1):PP= PEEK (ADR+ 4) 130 IF PEEK (ADR+ 2)= 99THEN SAVE "1:CREDDL":LOAD "CRSEG":RUN 140 PLOT 6,0,12,14,6,11,3,17,0 150 PRINT " CREATE DATA DESCRIPTOR FILE " 160 PLOT 6,6,15,3,0,4 170 IF DD= 2THEN INPUT " INSERT DATA DISK - HIT RETURN ";I$ 180 PLOT 3,0,4 190 PRINT TAB( 10):INPUT "ENTER NAME OF DESCRIPTOR FILE: ";F$:REM 200 IF F$= "EXIT"THEN 1050 210 D$= F$:F$= F$+ ".DDL":IF DD= 3THEN F$= "1:"+ F$ 220 PRINT :PRINT TAB( 10) 230 FILE "T",240:FILE "R",1,F$,1:GOTO 660 240 FILE "E",F,E,L:IF E< > 14THEN PRINT "BAD FILE NAME":PRINT :GOTO 190 250 N= 0:P= 1 260 REM ** ENTER FIELD DESCRIPTORS ** 270 PRINT TAB( 10):IF N= 0THEN PRINT "KEY FIELD";TAB( 22) 280 IF N> 0THEN PRINT "FIELD";N;TAB( 22) 290 PRINT "COL("P")"TAB( 34) 300 INPUT ": ";A$:IF A$= "0"OR LEN (A$)= 0THEN 470 310 FOR I= 1TO LEN (A$):IF MID$ (A$,I,1)= " "THEN 340 320 NEXT I 330 PLOT 11:PRINT TAB( 10);"ERROR":GOTO 270 340 D$(N)= MID$ (A$,1,I- 1):A$= MID$ (A$,I+ 1) 350 FOR I= 1TO LEN (A$):IF MID$ (A$,I,1)= " "THEN 370 360 NEXT I:M$= "1":GOTO 410 370 M$= MID$ (A$,I+ 1):J= I 380 IF J= 0THEN J= 1:GOTO 400 390 IF MID$ (A$,J,1)< > "A"OR MID$ (A$,J,1)< > "N"THEN J= J- 1:GOTO 380 400 A$= MID$ (A$,J,I) 410 IF N= 0AND LEFT$ (A$,1)< > "A"THEN 330 420 IF LEFT$ (A$,1)= "N"THEN C(N)= - 4:GOTO 450 430 IF LEFT$ (A$,1)< > "A"THEN 330 440 C(N)= INT (VAL (MID$ (A$,2))):IF C(N)< = 0OR C(N)> 255THEN 330 450 M(N)= INT (VAL (M$)):IF M(N)< 1THEN 330 460 P= P+ ABS (C(N))* M(N):N= N+ 1:GOTO 270 470 REM ** DISPLAY FIELDS ENTERED ** 480 NR= N:GOSUB 910 490 PRINT :PRINT TAB( 10):INPUT "ANY CHANGES (Y/N) ";A$ 500 IF A$< > "N"THEN 560 510 IF C(0)< = 0THEN 480 520 FILE "T",1090:FILE "N",F$,N,24,5:FILE "R",1,F$,1 530 FOR I= 0TO N- 1:PUT 1,I+ 1;D$(I)[16],C(I),M(I):NEXT I 540 FILE "C",1:PRINT :PRINT TAB( 10);"DESCRIPTOR ";D$;" IS STORED" 550 GOTO 1050 560 REM ** EDIT FIELDS ** 570 PRINT :PRINT TAB( 10):INPUT "DELETE OR ADD FIELDS (D/A) ";A$ 580 IF A$= "A"THEN 260 590 PRINT TAB( 10); 600 INPUT "ENTER NAME OF FIELD TO BE DELETED: ";A$ 610 A$= A$+ " ":L= LEN (A$) 620 J= 0:FOR I= 0TO N- 1 630 IF LEFT$ (D$(I)+ " ",L)< > A$THEN D$(J)= D$(I):C(J)= C(I):M(J)= M(I):J= J+ 1 640 IF D$(I)= A$THEN P= P- ABS (C(I))* M(I) 650 NEXT I:N= J:GOTO 470 660 REM ** FILE ALREADY EXIST ** 670 PRINT TAB( 10);"A DESCRIPTOR FILE CALLED ";D$;" ALREADY EXIST." 680 PRINT TAB( 10);"SELECT ONE OF THE FOLLOWING:":PRINT 690 PRINT TAB( 10);"1. CREATE A NEW FILE" 700 PRINT TAB( 10);"2. EDIT THE ABOVE DESCRIPTOR TO CREATE A NEW FILE" 710 PRINT TAB( 10);"3. PRINT DESCRIPTOR - RETURN TO MENU" 720 PRINT TAB( 10);"4. RETURN TO MENU DISPLAY":PRINT 730 PRINT TAB( 20);:INPUT "ENTER NUMBER DESIRED: ";I:REM 740 IF I< 1OR I> 4THEN 730 750 IF I= 1 THEN RUN 760 IF I= 4 THEN 1050 770 FILE "A",1,C,NR,RS,BF:N= NR 780 FOR I1= 0TO NR- 1:GET 1;D$(I1)[16],C(I1),M(I1):NEXT I1:FILE "C",1 790 IF I= 2 THEN 860 800 IF PP= 0 THEN 830 810 PRINT :PRINT TAB( 10):INPUT "OUTPUT TO THE SCREEN OR A PRINTER? ";I$:REM 820 IF LEFT$ (I$,1)= "P"THEN PLOT 27,13 830 GOSUB 900 840 POKE 33265,FG:PRINT :PRINT TAB( 17):INPUT "HIT RETURN TO CONTINUE";I$ 850 GOTO 1050 860 REM ** EDIT OLD DESCRIPTOR ** 870 PRINT :PRINT TAB( 10):INPUT "ENTER NEW NAME OF DESCRIPTOR FILE : ";F$:REM 880 D$= F$:F$= F$+ ".DDL":IF DD= 3THEN F$= "1:"+ F$ 890 GOSUB 900:GOTO 570 900 REM ** PRINT FILE CONTENTS ** 910 FOR I= 4TO 30:PLOT 3,0,I,11:NEXT I 920 PLOT 3,0,4:CL= 1 930 PRINT TAB( 10);"DESCRIPTOR FILE - ";D$;"" 940 PRINT :PRINT TAB( 6);"FIELD NAME";TAB( 26); 950 PRINT "TYPE";TAB( 36);"REPEAT";TAB( 46);"COLUMN" 960 FOR I= 0TO NR- 1:PRINT TAB( 6);D$(I);TAB( 26) 970 IF C(I)= - 4THEN PRINT "N"; 980 IF C(I)> 0THEN PRINT "A";C(I); 990 PRINT TAB( 36);M(I);TAB( 46);CL:CL= CL+ ABS (C(I))* M(I):NEXT I 1000 P= CL:PRINT TAB( 33);"TOTAL LENGTH";TAB( 46);CL- 1 1010 IF C(0)> 0THEN RETURN 1020 PRINT :PRINT TAB( 10);"ERROR - FIRST FIELD MUST BE ALPHA" 1030 PRINT :RETURN 1040 REM ** EXIT PROGRAM - RETURN TO MENU ** 1050 PRINT :PRINT TAB( 10) 1060 IF DD= 2THEN INPUT "INSERT PROGRAM DISK - HIT RETURN ";I$ 1070 LOAD "MAIN":RUN 1080 REM ** PRINT FILE ERROR ** 1090 PRINT :PRINT "FILE ERROR - CAN'T CREATE FILE":GOTO 1050