1 MENU$="    INTRODUCTION    "
2 GOSUB 10
3 RECORDS=1000
4 Y% = CTRLC
5 ON ERROR GOTO 10000
6 DIM UP$(20) \ DIM LO(20) \ DIM IN$(20) \ DIM X$(20)
7 GOTO 100
10 PRINT CHR$(27);"[f";CHR$(27);"[2J"
20 PRINT "===================================================================="
30 PRINT "=                      B_BASE Database Program                     ="
35 PRINT "=                      ";MENU$;"                        ="
40 PRINT "===================================================================="
50 RETURN
100 REM 


 This is the start of the DATABASE file finder



102 PRINT \ PRINT "Do you wish to read the INSTRUCTIONS (Y/N)";\ INPUT Q$
104 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1) THEN 12000
106 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1) THEN 110
108 GOTO 102
110 PRINT \ PRINT \ PRINT "Please enter the Name of the DATABASE file to use,"
111 PRINT "or press return to CREATE a new DATABASE file     ";
120 INPUT DATABASE$
130 IF DATABASE$="" THEN 300
141 PRINT \ PRINT "Is `";DATABASE$;"' the correct name (Y/N)";\ INPUT Q$
142 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1) THEN 500
143 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1) THEN 100
145 GOTO 141
300 REM 


 This is the start of the DATABASE creations section



301 MENU$=" CREATE a DATABASE  "
305 GOSUB 10
310 PRINT \ PRINT \ PRINT "Do you wish to create a new DATABASE file (Y/N)";
320 INPUT Q$
330 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 360
340 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 1
350 GOTO 300
360 REM 


 Creating a new DATABASE file



370 PRINT \ PRINT \ PRINT "Please enter the name of the DATABASE file";
380 INPUT DATABASE$
390 OPEN DATABASE$+".BBS" FOR OUTPUT AS FILE #3
395 LAST_RECORD=1
400 PRINT "Please enter the number of FIELDS for ";DATABASE$;" (20 MAX)";
410 INPUT FIELDS
412 IF FIELDS<1 OR FIELDS>20 THEN 400
415 DIM FIELD$(FIELDS)
417 FOR I=1 TO FIELDS
420 PRINT \ PRINT \ PRINT "Please enter the NAME of FIELD #";I;" ";
430 INPUT FIELD$(I)
440 NEXT I
450 PRINT #3,FIELDS
455 PRINT #3,LAST_RECORD
460 FOR I=1 TO FIELDS
470 PRINT #3,FIELD$(I)
480 NEXT I
490 CLOSE #3
500 REM 


 This is the start of the OPEN DATABASE section



510 GOSUB 10
511 PRINT \ PRINT \ PRINT "                   Searching for ";DATABASE$
520 OPEN DATABASE$+".BBS" FOR INPUT AS FILE #2
530 INPUT #2,FIELDS
535 INPUT #2,LAST_RECORD
540 DIM FIELD$(FIELDS)
545 FIELD$(0)="OPTIONAL KEY FIELD"
550 FOR I=1 TO FIELDS
560 INPUT #2,FIELD$(I)
570 NEXT I
580 CLOSE #2
600 REM 


 OPEN virtual file on DATABASE



611 DIM #1,DATABASE$(1000,20)=80
612 OPEN DATABASE$+".BBD" AS FILE #1, VIRTUAL
614 MENU$="    MAIN SCREEN     "
615 GOSUB 10
617 PRINT \ PRINT TAB(7);"FILE being used is:    ";DATABASE$
620 PRINT \ PRINT \ PRINT TAB(7);"Please select option number and press return"
625 PRINT
630 PRINT TAB(7);"1-ENTER DATA                          5-PRINT REPORT "
635 PRINT
640 PRINT TAB(7);"2-UPDATE DATA                         6-SCREEN REPORT"
645 PRINT
650 PRINT TAB(7);"3-DELETE a RECORD                     7-LIST ALL DATA"
660 PRINT \ PRINT TAB(7);"4-SEARCH                              8-SORT"
662 PRINT \ PRINT TAB(7);"                 0-EXIT "
670 PRINT \ PRINT \ PRINT TAB(25);\ INPUT SELECTION
680 IF SELECTION<0 OR SELECTION>8 THEN 614
690 IF SELECTION=0 THEN 11000
700 ON SELECTION GOSUB 7200,8000,6000,4000,1000,9000,3000,5000
710 GOTO 614
1000 REM 


 This is the start of the REPORT TO PRINTER routine



1001 MENU$="   PRINT a REPORT   "
1002 GOSUB 10
1003 PRINT \ PRINT "PRINT a REPORT of file ";DATABASE$;"."\ PRINT
1004 PRINT \ PRINT "PRINT ALL RECORDS or SEARCHED FOR RECORDS (A/S) ";
1005 INPUT RS$
1006 IF POS(RS$,"a",1)=1 OR POS(RS$,"A",1)=1 THEN 1016
1007 IF POS(RS$,"s",1)=1 OR POS(RS$,"S",1)=1 THEN 1500 
1008 GOTO 1004
1016 PRINT \ PRINT "Report to PRINTER or DISK FILE (P/D)";\ INPUT Q$
1017 IF POS(Q$,"p",1)=1 OR POS(Q$,"P",1)=1 THEN O$="LP:"\ GOTO 1020
1018 IF POS(Q$,"d",1)=1 OR POS(Q$,"D",1)=1 THEN O$=DATABASE$+".DOC"\ GOTO 1020
1019 GOTO 1016
1020 PRINT
1021 PRINT "Do you wish FIELD SEQUENTIAL or RECORD Format (F/R)";\ INPUT Q$
1030 IF POS(Q$,"f",1)=1 OR POS(Q$,"F",1)=1 THEN 1300
1040 IF POS(Q$,"r",1)=1 OR POS(Q$,"R",1)=1 THEN 1060
1050 GOTO 1020
1060 REM This is RECORD Format REPORT
1070 OPEN O$ FOR OUTPUT AS FILE #7, SEQUENTIAL
1080 PRINT #7,CHR$(12);
1090 PRINT #7,TAB(30);DATABASE$;" REPORT                       ";DATE$(0);
1091 PRINT #7,""
1095 FOR I=1 TO FIELDS
1100 FOR R=1 TO LAST_RECORD-1
1120 LO=LEN(DATABASE$(R,I))
1125 IF LO>=LO(I) THEN LO(I)=LO
1130 NEXT R
1150 NEXT I
1151 FOR I=1 TO FIELDS
1152 IF I=1 THEN T=0
1153 PRINT #7,TAB(T);FIELD$(I);
1154 T=T+LO(I)+2
1155 NEXT I
1156 PRINT #7,""
1157 PRINT #7,"==============================================================";
1158 PRINT #7,"==============="
1170 FOR R=1 TO LAST_RECORD-1
1175 IF POS(DATABASE$(R,1),CHR$(1),1)>0 THEN 1230
1177 IF POS(RS$,"s",1)=1 OR POS(RS$,"S",1)=1 AND                              &
        POS(DATABASE$(R,SEARCH),SEARCH$,1)=0 THEN 1230
1180 FOR I=1 TO FIELDS
1190 IF I=1 THEN T=0
1200 PRINT #7,TAB(T);DATABASE$(R,I);
1210 T=T+LO(I)+2
1220 NEXT I
1225 PRINT #7,""
1230 NEXT R
1240 PRINT #7,CHR$(12)
1245 T=0\ CLOSE #7
1250 RETURN
1300 REM 


This is the start of SEQUENTIAL REPORT to PRINTER



1302 PRINT \ PRINT "Do you wish to print with FIELD names (Y/N)";\ INPUT Q$
1304 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN F=1\ GOTO 1310
1306 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN F=2\ GOTO 1310
1308 GOTO 1302
1310 OPEN O$ FOR OUTPUT AS FILE #7,SEQUENTIAL
1320 PRINT #7,CHR$(12);
1330 PRINT #7,TAB(30);DATABASE$;" REPORT                       ";DATE$(0);
1335 PRINT #7,""
1340 PRINT #7,"==============================================================";
1350 PRINT #7,"==============="
1360 PRINT #7,""
1370 FOR R=1 TO LAST_RECORD-1
1375 IF POS(DATABASE$(R,1),CHR$(1),1)>0 THEN 1410
1377 IF POS(RS$,"s",1)=1 OR POS(RS$,"S",1)=1 AND                              &
        POS(DATABASE$(R,SEARCH),SEARCH$,1)=0 THEN 1410

1380 FOR I=1 TO FIELDS
1390 IF F=1 THEN PRINT #7,FIELD$(I);" - ";DATABASE$(R,I)
1395 IF F=2 THEN PRINT #7,DATABASE$(R,I)
1400 NEXT I
1405 PRINT #7,""
1410 NEXT R
1420 PRINT #7,CHR$(12)
1430 CLOSE #7
1490 RETURN
1500 REM 
1520 PRINT \ PRINT \ PRINT "Please enter the FIELD number to SEARCH."
1530 FOR I=0 TO FIELDS
1540 PRINT I;" ";FIELD$(I)
1550 NEXT I
1560 PRINT \ PRINT "Select a NUMBER ( 1 -";FIELDS;")";
1570 INPUT SEARCH
1580 PRINT \ PRINT "Enter the ";FIELD$(SEARCH);" you wish to find."
1590 PRINT \ LINPUT SEARCH$
1600 GOTO 1016
1990 RETURN
3000 REM 


 This is the start of a DATA LIST TO SCREEN routine



3001 MENU$=" DATA LIST to SCREEN"
3002 GOSUB 10
3010 FOR L=1 TO LAST_RECORD-1
3020 FOR F=0 TO FIELDS
3030 IF POS(DATABASE$(L,F),CHR$(1),1)>0 THEN 3040
3035 PRINT L;F;DATABASE$(L,F)
3040 NEXT F
3050 NEXT L
3060 PRINT \ PRINT "Press `RETURN' to Return";\ INPUT Q$
3900 RETURN
4000 REM  


 This is the start of the SEARCH routine



4001 MENU$="       SEARCH       "
4010 GOSUB 10
4020 PRINT \ PRINT \ PRINT "Please enter the FIELD number to SEARCH."
4030 FOR I=0 TO FIELDS
4040 PRINT I;" ";FIELD$(I)
4050 NEXT I
4060 PRINT \ PRINT "Select a NUMBER ( 1 -";FIELDS;")";
4070 INPUT SEARCH
4080 PRINT \ PRINT "Enter the ";FIELD$(SEARCH);" you wish to find."
4090 PRINT \ LINPUT SEARCH$
4095 GOSUB 10
4100 FOR S=1 TO LAST_RECORD-1
4110 IF POS(DATABASE$(S,SEARCH),SEARCH$,1)>0 THEN GOSUB 4200
4120 NEXT S
4130 PRINT \ PRINT "Do you wish to SEARCH  ";DATABASE$;" again (Y/N)";
4140 INPUT Q$
4150 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 4000
4160 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 4500
4170 GOTO 4130
4200 REM 
 Print search data

4202 PRINT
4210 FOR I=0 TO FIELDS
4215 IF POS(DATABASE$(S,I),CHR$(1),1)>0 THEN 4230
4220 PRINT DATABASE$(S,I)
4230 NEXT I
4235 PRINT
4240 RETURN
4500 RETURN
5000 REM 


 This is the Start of the SORT routine



5003 MENU$="        SORT        "
5006 GOSUB 10
5009 PRINT \ PRINT "This is a SORT routine."
5012 PRINT \ PRINT "Select a FIELD to SORT on."
5015 FOR I=0 TO FIELDS
5018 PRINT I;FIELD$(I)
5021 NEXT I
5024 PRINT \ PRINT "Select a NUMBER ( 0 -";FIELDS;")";\ INPUT SORT
5027 IF SORT >FIELDS OR SORT < 0 THEN GOTO 5024
5030 PRINT \ PRINT "Do you wish Asending or Desending order (A/D)";\ INPUT Q$
5036 IF POS(Q$,"a",1)=1 OR POS(Q$,"A",1)=1 THEN S=1\ GOTO 5045
5039 IF POS(Q$,"d",1)=1 OR POS(Q$,"D",1)=1 THEN S=2\ GOTO 5045
5042 GOTO 5030
5045 GOSUB 10
5048 PRINT
5051 IF S=1 THEN PRINT "Sorting ";DATABASE$;" by ";FIELD$(SORT);" Assending."
5054 IF S=2 THEN PRINT "Sorting ";DATABASE$;" by ";FIELD$(SORT);" Desending."
5057  FOR R=1 TO LAST_RECORD-1
5060 IF POS(DATABASE$(R,SORT),CHR$(1),1)>0 THEN GOSUB 5243
5063 NEXT R
5066  PRINT \ PRINT "SORTING"\ PRINT   
5069 S(1) = 1
5072 S(2) = LAST_RECORD - 1
5075 T = 1
5078  IF T = 0 THEN 5189
5081 T = T - 1
5084 I = 2 * T
5087 L = S(I + 1)
5090 M = S(I + 2)
5093  FOR X = 0 TO FIELDS
5096 X$(X) = DATABASE$(L,X)
5099  NEXT X
5102 J = L
5105 K = M + 1
5108 K = K - 1
5111  IF K = J THEN 5147
5114  IF S=1 AND X$(SORT) < DATABASE$(K,SORT) OR X$(SORT) = DATABASE$(K,SORT) THEN 5108
5115  IF S=2 AND X$(SORT) > DATABASE$(K,SORT) OR X$(SORT) = DATABASE$(K,SORT) THEN 5108
5117  FOR X = 0 TO FIELDS
5120 DATABASE$(J,X) = DATABASE$(K,X)
5123  NEXT X
5126 J = J + 1
5129  IF K = J THEN 5147
5132  IF S=1 AND X$(SORT) > DATABASE$(J,SORT) OR X$(SORT) = DATABASE$(J,SORT) THEN 5126
5133  IF S=2 AND X$(SORT) < DATABASE$(J,SORT) OR X$(SORT) = DATABASE$(J,SORT) THEN 5126
5135  FOR X = 0 TO FIELDS
5138 DATABASE$(K,X) = DATABASE$(J,X)
5141  NEXT X
5144  GOTO 5108
5147  FOR X = 0 TO FIELDS
5150 DATABASE$(J,X) = X$(X)
5153  NEXT X
5156  IF M - J < 2 THEN 5171
5159 I = 2 * T
5162 S(I + 1) = J + 1
5165 S(I + 2) = M
5168 T = T + 1
5171  IF K - L < 2 THEN 5078
5174 I = 2 * T
5177 S(I + 1) = L
5180 S(I + 2) = K - 1
5183 T = T + 1
5186  GOTO 5078
5189  REM SORT COMPLEATED  
5192 FOR R=1 TO LAST_RECORD-1
5195 FOR I=0 TO FIELDS
5198 PRINT DATABASE$(R,I)
5201 NEXT I
5204 PRINT
5207 NEXT R
5210 OPEN DATABASE$+".BBS" FOR OUTPUT AS FILE #3
5213 LAST_RECORD=LAST_RECORD-NEW_LAST
5216 NEW_LAST=0
5219 PRINT #3,FIELDS
5222 PRINT #3,LAST_RECORD
5225 FOR I=1 TO FIELDS
5228 PRINT #3,FIELD$(I)
5231 NEXT I
5234 CLOSE #3
5237 RETURN
5240 REM 

 This is an update on DATABASE.BBS for LAST_RECORD in SORT



5243 FOR D=1 TO FIELDS
5246 DATABASE$(R,D)=CHR$(127)
5249 NEXT D
5252 NEW_LAST=NEW_LAST+1
5255 RETURN
5258 RETURN
6000 REM 


 This is the start of the DELETE a RECORD routine



6001 MENU$="   DELETE a RECORD  "
6010 GOSUB 10
6012 PRINT \ PRINT "This is DELETE A RECORD !!! Use this with CARE."
6020 PRINT \ PRINT "Please enter the FIELD number to SEARCH and DELETE."
6030 FOR I=0 TO FIELDS
6040 PRINT I;" ";FIELD$(I)
6050 NEXT I
6060 PRINT \ PRINT "Select a NUMBER ( 1 -";FIELDS;")";
6070 INPUT SEARCH
6080 PRINT \ PRINT "Enter the ";FIELD$(SEARCH);" you wish to find and DELETE"
6090 PRINT \ LINPUT SEARCH$
6095 GOSUB 10
6100 FOR S=1 TO LAST_RECORD-1
6110 IF POS(DATABASE$(S,SEARCH),SEARCH$,1)>0 THEN GOSUB 6200
6120 NEXT S
6125 PRINT
6130 PRINT "Do you wish to DELETE more RECORDS From ";DATABASE$;" (Y/N)";
6140 INPUT Q$
6150 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 6000
6160 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 6900
6170 GOTO 6130
6200 REM 
 Print search to DELETE data

6202 PRINT
6210 FOR I=0 TO FIELDS
6220 PRINT DATABASE$(S,I)
6230 NEXT I
6232 PRINT \ PRINT "Do you want to DELETE this RECORD (Y/N)";\ INPUT Q$
6233 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 6300
6234 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN PRINT \ RETURN
6236 GOTO 6232
6238 PRINT
6240 RETURN
6300 FOR D=0 TO FIELDS
6310 DELETE$(D)=CHR$(1)+DATABASE$(S,D)
6320 DATABASE$(S,D)=DELETE$(D)
6330 NEXT D
6340 RETURN
6900 RETURN
7200 REM  


 This is the start of the DATA ENTRY routine



7210 MENU$="     DATA ENTRY     "
7215 FOR ENTER=LAST_RECORD TO RECORDS
7220 GOSUB 10
7230 PRINT \ PRINT "Entering DATA at RECORD #";LAST_RECORD
7250 FOR IN=0 TO FIELDS
7260 PRINT FIELD$(IN)\ PRINT \ LINPUT IN$(IN)
7270 NEXT IN
7280 GOSUB 10
7290 PRINT \ PRINT "Is this CORRECT "
7295 PRINT
7300 FOR IN=0 TO FIELDS
7310 PRINT FIELD$(IN)
7320 PRINT IN$(IN)
7330 NEXT IN
7340 PRINT \ PRINT "If this is correct PRESS `Y', any other key to restart";
7350 INPUT Q$
7360 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 7400
7370 GOTO 7250
7400 REM This is entering data to the VIRTUAL ARRAY
7410 FOR OUT=0 TO FIELDS
7420 DATABASE$(ENTER,OUT)=IN$(OUT)
7430 NEXT OUT
7440 LAST_RECORD=LAST_RECORD+1
7450 PRINT \ PRINT "Do you wish to enter more RECORDS (Y/N)";
7460 INPUT Q$
7470 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 7490
7480 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 7500
7485 GOTO 7450
7490 NEXT ENTER
7500 OPEN DATABASE$+".BBS" FOR OUTPUT AS FILE #3
7510 PRINT #3,FIELDS
7520 PRINT #3,LAST_RECORD
7530 FOR I=1 TO FIELDS
7540 PRINT #3,FIELD$(I)
7550 NEXT I
7560 CLOSE #3
7990 RETURN
8000 REM  


 This is the start of the UPDATE DATA routine



8001 MENU$="     UPDATE DATA    "
8010 GOSUB 10
8020 PRINT \ PRINT \ PRINT "Please select one option,"
8030 PRINT \ PRINT "1 - UPDATE all RECORDS"
8040 PRINT "2 - UPDATE `searched for' RECORDS"
8041 PRINT \ PRINT "Please make a selection";\ INPUT Q
8042 IF Q<1 OR Q>2 THEN 8041
8050 IF Q=2 THEN GOTO 8350
8052 REM  Start of UPDATE ALL RECORDS
8055 GOSUB 10
8060 FOR R=1 TO LAST_RECORD-1
8065 PRINT \ PRINT
8070 FOR I=0 TO FIELDS
8080 PRINT I;" ";DATABASE$(R,I)
8090 NEXT I
8100 PRINT
8102 PRINT "SELECT A FIELD TO EDIT (0 -";FIELDS;");99 for all";FIELDS+1;"EXIT";
8104 INPUT U
8106 IF U=99 THEN 8124
8108 IF U=FIELDS+1 THEN GOTO 8200
8110 IF U<0 OR U>FIELDS THEN 8102
8122 GOTO 8158
8124 FOR I=0 TO FIELDS
8126 PRINT FIELD$(I);"  ";DATABASE$(R,I);\FOR H=1 TO LEN(DATABASE$(R,I))+2 \ PRINT CHR$(8);\NEXT H
8128 LINPUT UP$(I)
8130 PRINT \ NEXT I
8132 GOSUB 10
8134 PRINT \ PRINT
8136 FOR I=0 TO FIELDS
8138 PRINT UP$(I)
8140 NEXT I
8142 PRINT \ PRINT "Is this correct (Y/N)";\ INPUT Q$
8144 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 8150
8146 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 8070
8148 GOTO 8142
8150 FOR I=0 TO FIELDS
8152 DATABASE$(R,I)=UP$(I)
8154 NEXT I
8156 GOTO 8070
8157 REM -------------------------------------------------------------------
8158 GOSUB 10
8160 PRINT \ PRINT
8162 FOR I=0 TO FIELDS
8164 UP$(I)=DATABASE$(R,I)
8166 PRINT UP$(I)
8168 NEXT I
8170 PRINT \ PRINT
8172 PRINT FIELD$(U);"  ";UP$(U);\FOR H=1 TO LEN(UP$(U))+2 \ PRINT CHR$(8);\NEXT H
8174 LINPUT UP$(U)
8176 PRINT \ PRINT
8178 FOR I=0 TO FIELDS
8180 PRINT UP$(I)
8182 NEXT I
8184 PRINT \ PRINT "Is this correct (Y/N)";\ INPUT Q$
8186 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 8192
8188 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 8158
8190 GOTO 8184
8191 REM 

Continued from Previous page UPDATE DATA



8192 FOR I=0 TO FIELDS
8194 DATABASE$(R,I)=UP$(I)
8196 NEXT I
8198 GOTO 8070
8199 RETURN
8200 REM -----------------------------------------------------------------
8210 NEXT R
8220 PRINT \ PRINT "Do you wish to UPDATE more RECORDS (Y/N)";\ INPUT Q$
8230 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 8000
8240 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN RETURN
8250 GOTO 8220
8260 REM -----------------------------------------------------------------
8350 GOSUB 10
8360 PRINT \ PRINT \ PRINT "Please enter the FIELD number to SEARCH & UPDATE."
8370 FOR I=0 TO FIELDS
8380 PRINT I;" ";FIELD$(I)
8390 NEXT I
8400 PRINT \ PRINT "Select a NUMBER ( 1 -";FIELDS;")";
8410 INPUT SEARCH
8420 PRINT \ PRINT "Enter the ";FIELD$(SEARCH);" you wish to find."
8430 PRINT \ LINPUT SEARCH$
8440 GOSUB 10
8450 FOR S=1 TO LAST_RECORD-1
8460 IF POS(DATABASE$(S,SEARCH),SEARCH$,1)>0 THEN GOSUB 8530
8470 NEXT S
8480 PRINT \ PRINT "Do you wish to UPDATE more RECORDS in ";DATABASE$;" (Y/N)";
8490 INPUT Q$
8500 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 8000
8510 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 8999
8520 GOTO 8480
8530 REM 


 UPDATE searched for data



8540 PRINT
8550 FOR I=0 TO FIELDS
8560 PRINT I;" ";DATABASE$(S,I)
8570 NEXT I
8571 PRINT
8572 PRINT "SELECT A FIELD TO EDIT (0 -";FIELDS;");99 for all";FIELDS+1;"EXIT";
8573 INPUT U
8575 IF U=99 THEN 8580
8576 IF U=FIELDS+1 THEN GOTO 8999
8577 IF U<0 OR U>FIELDS THEN 8571
8579 GOTO 8800
8580 FOR I=0 TO FIELDS
8590 PRINT FIELD$(I);"  ";DATABASE$(S,I);\FOR H=1 TO LEN(DATABASE$(S,I))+2 \ PRINT CHR$(8);\NEXT H
8600 LINPUT UP$(I)
8610 PRINT \ NEXT I
8620 GOSUB 10
8630 PRINT \ PRINT
8640 FOR I=0 TO FIELDS
8650 PRINT UP$(I)
8660 NEXT I
8670 PRINT \ PRINT "Is this correct (Y/N)";\ INPUT Q$
8680 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 8700
8690 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 8540
8695 GOTO 8670
8700 FOR I=0 TO FIELDS
8710 DATABASE$(S,I)=UP$(I)
8720 NEXT I
8730 RETURN
8750 REM ---------------------------------------------------------------
8800 GOSUB 10
8810 PRINT \ PRINT
8815 FOR I=0 TO FIELDS
8820 UP$(I)=DATABASE$(S,I)
8822 PRINT UP$(I)
8825 NEXT I
8826 PRINT \ PRINT
8828 PRINT FIELD$(U);"  ";UP$(U);\FOR H=1 TO LEN(UP$(U))+2 \ PRINT CHR$(8);\NEXT H
8830 LINPUT UP$(U)
8840 PRINT \ PRINT
8850 FOR I=0 TO FIELDS
8860 PRINT UP$(I)
8870 NEXT I
8880 PRINT \ PRINT "Is this correct (Y/N)";\ INPUT Q$
8890 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 8950
8900 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 8800
8910 GOTO 8880
8950 FOR I=0 TO FIELDS
8960 DATABASE$(S,I)=UP$(I)
8970 NEXT I
8980 GOTO 8540
8998 RETURN
8999 RETURN
9000 REM 


 This is the start of the REPORT TO SCREEN routine



9001 MENU$="  REPORT to SCREEN  "
9002 GOSUB 10
9003 PRINT \ PRINT "Report to Screen for file ";DATABASE$;"."\ PRINT
9004 PRINT \ PRINT "PRINT ALL RECORDS or SEARCHED FOR RECORDS (A/S) ";
9005 INPUT RS$
9006 IF POS(RS$,"a",1)=1 OR POS(RS$,"A",1)=1 THEN 9020
9007 IF POS(RS$,"s",1)=1 OR POS(RS$,"S",1)=1 THEN 9500 
9008 GOTO 9004
9020 PRINT "Do you wish FIELD SEQUENTIAL or RECORD Format (F/R)";\ INPUT Q$
9030 IF POS(Q$,"f",1)=1 OR POS(Q$,"F",1)=1 THEN 9300
9040 IF POS(Q$,"r",1)=1 OR POS(Q$,"R",1)=1 THEN 9060
9050 GOTO 9020
9060 REM This is RECORD Format REPORT
9070 PRINT CHR$(27);"[f";CHR$(27);"[2J"
9080 REM
9090 PRINT TAB(30);DATABASE$;" REPORT                       ";DATE$(0);
9092 PRINT ""
9095 FOR I=1 TO FIELDS
9100 FOR R=1 TO LAST_RECORD-1
9120 LO=LEN(DATABASE$(R,I))
9125 IF LO>=LO(I) THEN LO(I)=LO
9130 NEXT R
9150 NEXT I
9151 FOR I=1 TO FIELDS
9152 IF I=1 THEN T=0
9153 PRINT TAB(T);FIELD$(I);
9154 T=T+LO(I)+2
9155 NEXT I
9156 PRINT ""
9157 PRINT "==============================================================";
9158 PRINT "==============="
9170 FOR R=1 TO LAST_RECORD-1
9175 IF POS(DATABASE$(R,1),CHR$(1),1)>0 THEN 9230
9177 IF POS(RS$,"s",1)=1 OR POS(RS$,"S",1)=1 AND                              &
        POS(DATABASE$(R,SEARCH),SEARCH$,1)=0 THEN 9230
9180 FOR I=1 TO FIELDS
9190 IF I=1 THEN T=0
9200 PRINT TAB(T);DATABASE$(R,I);
9210 T=T+LO(I)+2
9220 NEXT I
9225 PRINT ""
9230 NEXT R
9240 PRINT CHR$(12)
9245 PRINT \ PRINT "Press `RETURN' to continue";\ INPUT Q$
9246 IF Q$="" THEN RETURN
9247 GOTO 9245
9250 RETURN
9300 REM This is the start of SEQUENTIAL REPORT to PRINTER
9302 PRINT \ PRINT "Do you wish to print with FIELD names (Y/N)";\ INPUT Q$
9304 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN F=1\ GOTO 9310
9306 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN F=2\ GOTO 9310
9308 GOTO 9302
9310 REM 

This has been continued from last page REPORT to SCREEN



9320 PRINT CHR$(27);"[f";CHR$(27);"[2J"
9330 PRINT TAB(30);DATABASE$;" REPORT                       ";DATE$(0);
9335 PRINT ""
9340 PRINT "==============================================================";
9350 PRINT "==============="
9360 PRINT ""
9370 FOR R=1 TO LAST_RECORD-1
9375 IF POS(DATABASE$(R,1),CHR$(1),1)>0 THEN 9410
9377 IF POS(RS$,"s",1)=1 OR POS(RS$,"S",1)=1 AND                              &
        POS(DATABASE$(R,SEARCH),SEARCH$,1)=0 THEN 9410
9380 FOR I=1 TO FIELDS
9390 IF F=1 THEN PRINT FIELD$(I);" - ";DATABASE$(R,I)
9395 IF F=2 THEN PRINT DATABASE$(R,I)
9400 NEXT I
9405 PRINT ""
9410 NEXT R
9420 PRINT \ PRINT "Press `RETURN' to continue";\ INPUT Q$
9430 IF Q$="" THEN RETURN
9440 GOTO 9420
9500 REM
9520 PRINT \ PRINT \ PRINT "Please enter the FIELD number to SEARCH."
9530 FOR I=0 TO FIELDS
9540 PRINT I;" ";FIELD$(I)
9550 NEXT I
9560 PRINT \ PRINT "Select a NUMBER ( 1 -";FIELDS;")";
9570 INPUT SEARCH
9580 PRINT \ PRINT "Enter the ";FIELD$(SEARCH);" you wish to find."
9590 PRINT \ LINPUT SEARCH$
9600 GOTO 9020
9980 RETURN
10000 REM 


 This is the start of the ERROR HANDLER routine



10001 PRINT ERT$(ERR)
10002 FOR PAUSE=1 TO 1500\ NEXT PAUSE
10010 IF ERR=5 AND ERL=520 THEN RESUME 300
10015 IF ERR=50 THEN RESUME 614
10020 IF ERR=28 THEN Y% = CTRLC \ RESUME 614
10030 IF ERR=52 OR ERR=100 AND ERL=670 THEN RESUME 614
10040 IF ERR>0 OR ERR<11 THEN RESUME 1
10130 RESUME
10200 GOTO 14000
11000 REM 


 This is the start of the EXIT SCREEN



11001 MENU$="        EXIT        "
11003 CLOSE #1
11010 GOSUB 10
11020 PRINT \ PRINT "Do you wish to EDIT THE ";DATABASE$;" REPORT (Y/N)";
11025 INPUT Q$
11030 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 14005
11040 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 11060
11050 GOTO 11020
11060 PRINT \ PRINT "Do you wish to work on another DATABASE file (Y/N)";
11065 INPUT Q$
11070 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 1
11080 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 14000
11090 GOTO 11060
12000 REM 


This is the INSTRUCTION section



12001 MENU$="    INSTRUCTIONS    "
12010 ON ERROR GOTO 12200
12020 OPEN "BBASE.HLP" FOR INPUT AS FILE #5
12030 GOSUB 10
12040 FOR I=1 TO 15
12050 LINPUT #5,HELP$
12060 PRINT HELP$
12070 NEXT I
12080 PRINT \ PRINT "Press `RETURN' to continue";\ INPUT Q$
12090 GOTO 12030
12200 IF ERR=11 THEN CLOSE #5\ RESUME 1
12210 RESUME 1
14000 GOTO 15000
14005 REM THIS IS THE START OF PROSE
14008 Y%=RCTRLC
14010 IN$=DATABASE$+".DOC"
14020 DIM S%(2%)
14030 IL%=LEN(DATABASE$)
14040 ON$=IN$
14050 OL%=IL%
14060 WF$=DATABASE$+".TMP"
14070 WL%=OL%
14080 CF%=0%
14090 F%=0%
14100 ML%=132%
14110 LM%=1%
14120 RM%=79%
14130 WR%=0%
14140 UN%=1%
14200 REM


THIS IS A TEST OF THE CALLABLE PROSE EDITOR



14300 CALL CET BY REF(S%(),IN$,IL%,ON$,OL%,WF$,WL%,CF%,F%,ML%,LM%,RM%,WR%,UN%)
14400 GOTO 11010
15000 END