SET NO DOUBLE 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 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 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 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)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 work on another DATABASE file (Y/N)"; 11025 INPUT Q$ 11030 IF POS(Q$,"y",1)=1 OR POS(Q$,"Y",1)=1 THEN 1 11040 IF POS(Q$,"n",1)=1 OR POS(Q$,"N",1)=1 THEN 14000 11050 GOTO 11020 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 END