IMD 1.16: 29/05/2007 18:43:37 FOGCPM.072 --FOGCPM072MENU BASL HELP BAS HELP-1 BAS3HELP-2 HELP-3 HELP-4 b !"#$%&'()MAIL BASF*+,-./012MERGE BAS 34OPERATE BASq56789:;<=>?@ABCREPORT BAS`DEFGHIJKLMNOREPT-FRMBAS)PQRSTUSORT BAS!VWXYZEDITOR BASV[\]^_`abcdeEDITOR COMfghijklmnopqrstuEDITOR COM>vwxyz{|}-06-00 86 MEASURE BAS+~NEWNAMESBASNEWNAMESDOCiNFLSTATSBAS NFLUPDATBAS-SPELLTSTBAS505-20-84SPL-CPM072 DOCThis is the disk name. 1 ' ELECTRONIC CARD FILE 2 ' By Joe Wiellette 617-731-3178 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 5 ON ERROR GOTO 3260 8 WIDTH 52 10 ' ******** PROGRAM MENU ********** 20 ' 30 ' 50 DEFINT S,L,D,I,J,K,T 100 '************ VARIABLES USED *************** 110 'DLR$ Format for PRINT-USING when printing dollar amounts 130 'TYPE(I,J) Type of field for sector I, field # J 140 'LENGTH(I,J) Length of field as above 150 'LABEL$(I,J) Name assigned by you to each field 160 'DTA$(I,J) The actual data saved within the field 170 'FILE.NAME$ General name of the file 180 'HEADER$ Name of the file containing field headings and other data 190 'CLSCR$ Function to clear the screen and beep terminal 200 'PURPOSE$ Purpose of the file saved in HEADER file 210 'MENU$ Function to print menu of major DEFAULTs 220 'DRIVE$ Drive selected for data and programs 230 'A$(I),A(I) 6 possible headings from heading file - only few used 240 'RECORD$ String of A(1) bytes of raw data loaded from a disk sector 250 'A$(1) File name 260 'A$(2) Notes 270 'A(1) Number of bytes per sector 280 'A(2) Number of disk sectors used for each record 290 'PROGRAM$ Program names branched to from this program 300 'FILECOUNT Total number of fields used on label 310 'FIELDS Temporary input for field number 320 'LINENUM Line number on label 330 'LINES(LINENUM) Fields within line 340 'REPORT$ Name of file containing report form 350 'G(FIELDCOUNT),H(FIELDCOUNT) I,J, identification of fields used 360 'L1,L2 I,J of limit field 370 'DATE$,DATE date entered as limit 380 'L3,L3$ limit as number or string 390 'L4 type of limit (high, low, or exact) 400 'LIMIT$ Yes or No on Limit 410 'SORTFILE$ Sort flag Yes or No 420 'SORT$ Name of sort key file 430 'HIGH,LOW High and low record #'s 440 'F(I) Number of fields for each sector 450 'MONTH, YEAR, JULIAN, DAY Used in date conversion 460 'LN Length of field 470 'D1 Temp used in date conversion 471 'COUNT Current record number counter 472 'M,MM Temp in get record 473 'M$,M$(I) Packed record just retrieved 474 'DELETED$ First character of packed record 475 'F(I),F Temp in record conversion 476 'K Temp counter in print fields 477 'S$(I) Temp packed record 478 'DRIVE$ Drive containing data 500 'L Temporary counter in input subroutine 510 'DEFAULT$ Input choice on return 520 'ALLOWED$ responses allowed on an input 530 'ALLOWED Flag for input allowed=1 not allowed=0 540 'BELL$ Bell 550 'REVERSE$ Turn on reverse video 560 'REVERSE.OFF$ Turn off reverse video 570 'HOME$ Send the cursor to home position 580 'XD Counter for line display on input in operate program 590 'PRT Printer flag(1) for printer or screen (0) 1000 ' 1010 '***************** INITIALIZATION ***************** 1020 ' 1040 DLR$="$$###,###,###.##" 1050 DIM TYPE(10,20), LENGTH(10,20), LABEL$(10,20), DTA$(10,20) 1060 DIM M$(20),S$(10),G(20),H(20) 1070 ' 1080 ' ******** FUNCTIONS USED IN PROGRAM ******* 1090 ' 1100 CLSCR$=CHR$(26) 1120 BELL$=CHR$(7) 1130 REVERSE$=CHR$(27)+CHR$(41) 1140 REVERSE.OFF$=CHR$(27)+CHR$(40) 1150 HOME$=CHR$(30) 1152 UNDER$=CHR$(27)+CHR$(108) 1154 STOP.UNDER$=CHR$(27)+CHR$(109) 1160 ' 1170 ' ************* OPEN FILES NEEDED - GET INITIAL INFORMATION ******** 1180 ' 1190 PRINT CLSCR$ 1200 PRINT UNDER$"1) Old file "STOP.UNDER$"2) New file 3) Skip to HELP "; 1202 DEFAULT$="1":ALLOWED$="123":GOSUB 3130:IF ALLOWED=0 THEN 1200 1204 IF Q$="2" THEN 2000 1206 IF Q$="3" THEN CHAIN"HELP",50,ALL 1210 INPUT"Enter file Name ",FILE.NAME$ 1220 PRINT"Which drive (A or "UNDER$"B"STOP.UNDER$")" 1230 DEFAULT$="B":ALLOWED$="AB":GOSUB 3130 1240 IF ALLOWED=0 THEN PRINT"MUST BE A,B OR C ":GOTO 1220 1260 DRIVE$=Q$+":" 1280 HEADER$=DRIVE$+FILE.NAME$+"X" 1290 OPEN"I",#1,HEADER$ 1300 FOR I= 1 TO 10 1310 INPUT#1,A$(I),A(I) 1320 NEXT I 1330 FOR I= 1 TO A(2) :' ** FOR THE NUMBER OF A(1) BYTE DISK SECTORS ** 1340 INPUT#1,F(I) :' ** GET FIELD #'S FOR EACH SECTOR ** 1350 FOR J= 1 TO F(I) :' ** FOR THE NUMBER OF FIELDS ** 1360 INPUT#1,TYPE(I,J),LENGTH(I,J),LABEL$(I,J) 1370 NEXT J 1380 NEXT I 1390 CLOSE 1 1400 FILE.NAME$=DRIVE$+A$(1) 1410 OPEN"R",#2,FILE.NAME$,A(1) 1420 FIELD#2,A(1) AS RECORD$ 1430 ' 1440 ' 1450 ' 1460 ' 1470 ' ******* MAIN PROGRAM ****** 1480 ' 1490 PRINT CLSCR$ 1500 PRINT"1) Report 1501 PRINT"2) Enter report form 1502 PRINT"3) Labels 1503 PRINT"4) Sort 1504 PRINT UNDER$"5) View, change, add or delete "STOP.UNDER$ 1505 PRINT"6) Merge 1506 PRINT"7) Help 1509 PRINT:PRINT"9) END 1510 PRINT:PRINT"Which "; 1520 DEFAULT$="5":ALLOWED$="12345679":GOSUB 3130:IF ALLOWED=0 THEN 1490 1530 ' 1540 ' ********** EXIT TO ANOTHER PROGRAM ********** 1550 ' 1560 ON Q GOSUB 1600,1610,1620,1630,1640,1650,1660 1570 IF Q=9 THEN END 1580 CHAIN PROGRAM$,50,ALL 1590 STOP 1600 PROGRAM$="REPORT":RETURN 1610 PROGRAM$="REPT-FRM":RETURN 1620 PROGRAM$="MAIL":RETURN 1630 PROGRAM$="SORT":RETURN 1640 PROGRAM$="OPERATE":RETURN 1650 PROGRAM$="MERGE":RETURN 1660 PROGRAM$="HELP":RETURN 2000 ' 2020 CLOSE 2030 PRINT CLSCR$ 2040 PRINT UNDER$"1) Create a new file"STOP.UNDER$ 2050 PRINT"2) Return to MENU 2060 DEFAULT$="1":ALLOWED$="12":GOSUB 3130:IF ALLOWED=0 THEN 2030 2070 IF Q$="2" THEN 1170 2080 PRINT"Which drive (A or "UNDER$"B"STOP.UNDER$")"; 2090 DEFAULT$="B":ALLOWED$="AB":GOSUB 3130:IF ALLOWED=0 THEN 2080 2100 DRIVE$=Q$+":" 2110 PRINT CLSCR$ 2120 INPUT"Enter a name for the file ";A$(1) 2130 IF LEN(A$(1))<1 THEN PRINT"You really must enter something ":GOTO 2120 2140 IF LEN(A$(1))>7 THEN PRINT"Name too long. Use 7 letters or less.":GOTO 2120 2150 FOR I=1 TO LEN(A$(1)) 2160 IF ASC(MID$(A$(1),I,1))>95 THEN PRINT"You must use upper case letters." :GOTO 2120 2170 NEXT I 2190 PRINT"A) 20 B) 40 C) 80 "UNDER$"D) 127 "STOP.UNDER$"E) other size " 2200 PRINT" How many places per card "; 2210 DEFAULT$="D":ALLOWED$="AaBbCcDdEe":GOSUB 3130:IF ALLOWED=0 THEN 2200 2220 IF Q$="A" OR Q$="a" THEN A(1)=21 2230 IF Q$="B" OR Q$="b" THEN A(1)=41 2240 IF Q$="C" OR Q$="c" THEN A(1)=81 2250 IF Q$="D" OR Q$="d" THEN A(1)=128 2260 IF Q$="E" OR Q$="e" THEN INPUT"Size ";A(1): IF A(1)<1 OR A(1)>127 THEN 2260 ELSE A(1)=A(1)+1 2270 ' **** ENTER THE FIELDS ***** 2280 PRINT CLSCR$ 2290 I=1:J=1 2300 LENGTH(1,1)=2:TYPE(1,1)=1:LABEL$(1,1)="DATE ENTERED":LN=2 2310 PRINT"Type of field(Date, Number, $ollar, "UNDER$"String"STOP.UNDER$")"; 2320 ALLOWED$="DdNn$Ss":DEFAULT$="S":GOSUB 3130:IF ALLOWED=0 THEN 2310 2330 IF Q$="S" OR Q$="s" THEN INPUT"Field length ";L: T=4:IF L=0 THEN 2330 2340 IF L>A(1)-1 THEN PRINT"Field length maximum = "A(1)-1:GOTO 2330 2350 IF Q$="D" OR Q$="d" THEN T=1:L=2 2360 IF Q$="N" OR Q$="n" THEN T=2:L=4 2370 IF Q$="$" THEN T=3:L=8 2380 IF LN+L>A(1)-1 THEN F(I)=J:J=1:LN=L:I=I+1:GOTO 2410 2390 LN=LN+L 2400 J=J+1 2410 LENGTH(I,J)=L:TYPE(I,J)=T  2420 INPUT"Field name ";LABEL$(I,J):IF LEN(LABEL$(I,J))<1 THEN 2420 2430 PRINT REVERSE$A(1)-1-LN" left on this card "REVERSE.OFF$ 2440 PRINT"Any more fields (*** = yes) "; 2450 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 3130:IF ALLOWED =0 THEN 2440 2460 IF Q$="Y" OR Q$="y" THEN 2310 2470 A(2)=I 2480 F(I)=J 2490 ' ******* REVIEW CHOICES ******* 2500 PRINT CLSCR$ 2510 FOR K=1 TO I 2520 PRINT"Here are the fields in card "K 2530 FOR L=1 TO F(K) 2540 PRINT LENGTH(K,L)" Spaces"TAB(15)LABEL$(K,L) 2550 USED=USED+LENGTH(K,L) 2560 NEXT L 2570 PRINT"Spaces not used in this card = "A(1)-1-USED 2578 PRINT REVERSE$; 2580 PRINT"Tap return for next card ";:Q$=INPUT$(1):USED =0 2582 PRINT REVERSE.OFF$; 2590 PRINT:NEXT K 2600 PRINT"Are these correct ("UNDER$"Y"STOP.UNDER$"/N)"; 2610 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 3130:IF ALLOWED=0 THEN 2600 2620 IF Q$<>"Y" AND Q$<>"y" THEN 2030 2630 PRINT:PRINT"Do you want to pick a field for 2632 PRINT"INSTANT ACCESS ( "UNDER$"Y"STOP.UNDER$"/N)"; 2640 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 3130:IF ALLOWED=0 THEN 2630 2650 IF Q$<>"Y" AND Q$<>"y" THEN 3000 2660 PRINT 2670 INPUT"Enter field name for access ";NAM$ 2680 FOR N=1 TO 10 2690 FOR P=1 TO 20 2700 IF LABEL$(N,P)=NAM$ THEN 2730 2710 NEXT P,N 2720 PRINT"Can't find it. Try again ":GOTO 2630 2730 A(5)=(N*100)+P 2732 INPUT"Enter the max. # of files ";MAX 2740 R$=DRIVE$+A$(1)+"Z" 2750 N=A(5) 2760 I=INT(N/100):J=N-(I*100) 2770 X=LENGTH(I,J) 2780 OPEN"R",#3,R$,X+4 2790 FIELD#3,X AS S1$,2 AS S2$,2 AS S3$ 2800 LSET S1$="":LSET S2$=MKI$(0):LSET S3$=MKI$(0) 2810 FOR I=1 TO MAX+100 2820 PUT#3,I 2830 NEXT I 3000 R$=DRIVE$+A$(1)+"X" 3010 OPEN"O",#1,R$ 3020 FOR I=1 TO 10 3030 WRITE#1,A$(I),A(I) 3040 NEXT I 3050 FOR I=1 TO A(2) 3060 PRINT#1,F(I) 3070 FOR J=1 TO F(I) 3080 WRITE#1,TYPE(I,J),LENGTH(I,J),LABEL$(I,J) 3090 NEXT J 3100 NEXT I 3110 CLOSE 3120 GOTO 1170 3130 ' 3140 ' * ********* ENTER RESPONSE ******* 3150 ' 3160 PRINT BELL$; 3170 ALLOWED=0 3180 Q$=INPUT$(1) 3190 PRINT Q$ 3200 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 3210 Q=VAL(Q$) 3220 FOR L=1 TO LEN(ALLOWED$) 3230 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 3240 NEXT L 3250 RETURN 3260 ' 3270 ' ERROR TRAPPING 3280 ' 3290 IF ERL=1290 THEN CLOSE: PRINT"File not found ":FOR P=1 TO 500:NEXT P: GOTO 2000 3300 IF ERR=5 OR ERR=62 THEN PRINT"File error - try again":CLOSE:GOTO 1200 3310 ON ERROR GOTO 0 :NEXT P: GOTO 2000 3300 IF ERR=5 OR ERR=62 THEN PRINT"File error - try again":CLOSE:GOTO 1200 3310$ 2800 LSET S1$="":LSET S2$=MKI$(0):LSET S3$=MKI$(0) 2810 FOR I=1 TO MAX+100 2820 PUT#3,I 2830 NEXT I 3000 R$=DRIVE$+A$(1)+"X" 3010 OPEN"O",#1,R$ 3020 FOR I=1 TO 10 3030 WRITE#1,A$(I),A(I) 3040 NEXT I 3050 FOR I=1 TO A(2) 3060 PRINT#1,F(I) 3070 FOR J=1 TO F(I) 3080 WRITE#1,TYPE(I,J),LENGTH(I,J),LABEL$(I,J) 3090 NEXT J 3100 NEXT I 3110 CLOSE 3120 GOTO 1170 3130 ' 3140 ' * ********* ENTER RESPONSE ******* 3150 ' 3160 PRINT BELL$; 3170 ALLOWED=0 3180 Q$=INPUT$(1) 3190 PRINT Q$ 32001 ' ELECTRONIC CARD FILE 2 ' BY Joe Wiellette 617-731-3178 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 50 DEFINT S,L,D,I,J,K,T 52 WIDTH 52 55 ON ERROR GOTO 10000 100 PRINT CLSCR$; 200 PRINT"1) Background information 220 PRINT"2) Program & files used 240 PRINT"3) Create a file 260 PRINT"4) Work on a file 280 PRINT"5) Return to main menu 300 ALLOWED$="12345":GOSUB 5000:IF ALLOWED=0 THEN 100 320 ON Q GOSUB 1000,2000,3000,4000 340 IF Q=5 THEN RUN"MENU 400 CLOSE 450 GOTO 100 1000 ' 1010 ' BACKGROUND INFORMATION 1030 ' 1100 RUN"HELP-1 2000 ' 2010 ' PROGRAMS & FILES USED 2020 ' 2030 COUNT=1 2040 PRINT CLSCR$; 2100 OPEN"I",#1,"HELP-2" 2120 IF EOF(1) THEN 10050:RETURN 2150 LINE INPUT#1,A$ 2160 PRINT A$ 2180 IF COUNT=20 THEN GOSUB 10050:COUNT=1 ELSE COUNT=COUNT+1 2200 GOTO 2120 3000 ' 3010 ' CREATE A FILE 3020 ' 3030 COUNT=1 3040 PRINT CLSCR$; 3100 OPEN"I",#1,"HELP-3" 3120 IF EOF(1) THEN 10050:RETURN 3140 LINE INPUT#1,A$ 3180 PRINT A$ 3190 IF COUNT=20 THEN GOSUB 10050:COUNT=1 ELSE COUNT=COUNT+1 3200 GOTO 3120 4000 ' 4010 ' WORK ON A FILE 4020 ' 4030 PRINT CLSCR$; 4040 COUNT=1 4100 OPEN"I",#1,"HELP-4" 4120 IF EOF(1) THEN 10050:RETURN 4140 LINE INPUT#1,A$ 4160 PRINT A$ 4180 IF COUNT=20 THEN GOSUB 10050:COUNT=1 ELSE COUNT=COUNT+1 4200 GOTO 4120 5000 ' 5010 ' *** ENTER RESPONSE *** 5020 ' 5100 PRINT BELL$; 5110 ALLOWED=0 5120 Q$=INPUT$(1) 5130 PRINT Q$ 5140 IF Q$="y" THEN Q$="Y" 5150 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5160 Q=VAL(Q$) 5170 FOR L=1 TO LEN(ALLOWED$) 5180 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5190 NEXT L 5200 RETURN 5210 ' 5220 ' 10000 REM *********** ERROR HANDLING ************** 10030 IF ERR=13 THEN PRINT"Incorrect type of input. Start over.":CLOSE:GOTO 290 10040 ON ERROR GOTO 0 10050 REM ------- INPUT TO RETURN ----- 10060 PRINT CHR$(7); 10070 PRINT UNDER$" TAP RETURN TO CONTINUE "STOP.UNDER$ 10080 Q$=INPUT$(1) 10090 IF Q$=CHR$(13) THEN Q$="0" 10100 RETURN 10070 PRINT UNDER$" TAP RETURN50 CLSCR$=CHR$(26) 100 GOSUB 1000 120 PRINT:PRINT:PRINT 130 PRINT"1) DESCRIPTION OF FILE SYSTEM 140 PRINT"2) PICTURE OF PROGRAMS USED 160 PRINT"4) LOAD AND RUN MENU 180 PRINT:PRINT 200 PRINT"WHICH "; 220 ALLOWED$="1234":GOSUB 5000:IF ALLOWED=0 THEN 100 250 ON Q GOSUB 2000,3000 260 IF Q=4 THEN RUN"MENU 280 GOTO 100 1000 ' 1010 ' *** DESCRIBE FILES *** 1020 ' 1100 PRINT CLSCR$; 1110 PRINT TAB(15)" ______________ 1120 PRINT TAB(15)" |_____________| | 1130 PRINT TAB(15)" |_____________| | | 1140 PRINT TAB(15)" |_____________| | | | 1150 PRINT TAB(15)" |_____________| | | |_| 1160 PRINT TAB(15)" |_____________| | | |_| 1170 PRINT TAB(15)" | ELECTRONIC | | |_| 1180 PRINT TAB(15)" | CARD | |_| 1190 PRINT TAB(15)" | FILE |_| 1200 PRINT TAB(15)" |_____________| 1500 RETURN 2000 ' 2010 ' DESCRIPTION 2020 ' 2030 PRINT CLSCR$; 2100 PRINT"The MBASIC programming language is designed 2110 PRINT"to use sequential and random files. The E.C.F. 2120 PRINT"set of programs gives you access to random 2130 PRINT"files without having to write a BASIC program. 2140 PRINT" Think of random files as a set of file 2150 PRINT"cards arranged in a tray. Each card can hold 2160 PRINT"up to 127 characters. Your first choice is 2170 PRINT"whether each card will hold 20, 40 or some 2180 PRINT"other number of characters. On a 90 K disk 2190 PRINT"you may fit about 500 127 character cards or 2200 PRINT"1000 60 character cards, along with the other 2210 PRINT"operating files. Normally you would choose a 2220 PRINT"card size so that one rocord, or set of infor- 2230 PRINT"mation would fit on a single card. But it is 2240 PRINT"possible to group up to 10 cards of any size 2250 PRINT"up to 127 characters into one record. The 2260 PRINT"result is that if you ask to see record #3, 2270 PRINT"which may actually consist of 4 successive cards, 2280 PRINT"the programs will usually treat the information 2290 PRINT"as if it were on one big card instead of 4. 2300 PRINT:INPUT"TAP RETURN TO CONTINUE";FAKE$ 2320 PRINT"Information is placed into sections of each 2330 PRINT"record (card, set of cards) called fields. 2340 PRINT"These fields must be defined when you establish 2350 PRINT"the file as to size and type of information. 2360 PRINT"4 types of information may be used. 2370 PRINT" 1) Numeric - uses 4 characters of space 2380 PRINT" 2) Dollar - uses 8 characters of space 2390 PRINT" 3) Date - 2 characters in numeric form 2400 PRINT" 4) String - anything else 2410 PRINT"If you plan a card file of your friends, it 2420 PRINT"may start with a field for the first name. 2430 PRINT"This would be a string field and it would be 2440 PRINT"reasonable to allow about 10 characters. 2450 PRINT"Once you tell the computer to set up a field 2460 PRINT"called FIRST NAME with up to 10 characters, 2470 PRINT"all records (cards) will have 10 characters 2480 PRINT"set aside for this field. If you include a 2490 PRINT"field for AGE and define it as numeric, 4 2500 PRINT"characters of space will automatically be set 2510 PRINT"aside. If you are not going to do any calcu- 2520 PRINT"lations with AGE, you could save two characters 2530 PRINT"of space by defining AGE as a string field. 2540 PRINT:INPUT" TAP RETURN TO CONTINUE ";FAKE$ 2550 PRINT"Each record of your friends might look 2560 PRINT"like this. 2570 PRINT 2572 PRINT" (Characters used) 2574 PRINT"DATE ENTERED ______ (2) 2580 PRINT"FIRST NAME __________ (10) 2590 PRINT"LAST NAME _______________ (15) 2600 PRINT"STREET _________________________ (25) 2610 PRINT"CITY _______________ (15) 2620 PRINT"STATE __ (2) 2630 PRINT"ZIP _____ (5) 2640 PRINT"BIRTH DATE ______ (2) 2650 PRINT"PHONE NUMBER __________ (10) 2660 PRINT"FAVORITE COLOR __________ (10) 2670 PRINT"AVERAGE GIFT PRICE ____________ (8) 2680 PRINT"NUMBER OF CHILDREN ______ (4) 2690 PRINT"# OF YEARS GAVE GIFTS ______ (4) 2700 PRINT 2702 INPUT" TAP RETURN TO CONTINUE";FAKE$ 2710 PRINT"A total of 112 characters have been used. 2720 PRINT"Birth date is entered and displayed as a 6 digit 2730 PRINT"number, but is compacted and saved as a two 2740 PRINT"digit number. The phone and zip numbers are 2750 PRINT"saved as strings since we want them to appear 2760 PRINT"exactly as entered, including leading zeros. 2770 PRINT"Gift price is saved as a dollar amount and 2780 PRINT"number of children and years of gift giving 2790 PRINT"are saved as numbers. 2800 PRINT" Later we can sort, select and print some or 2810 PRINT"all fields of all or selected records. It will 2820 PRINT"be possible, for example, to multiply the # of 2830 PRINT"gifts by the average price and get a total. 2840 PRINT"The DATE ENTERED field is automatically 2850 PRINT"added to each record. 2880 PRINT 2890 INPUT" RETURN TO RE-LIST CHOICES ";FAKE$:RETURN 2900 STOP 3000 REM 3010 PRINT CLSCR$; 3020 PRINT TAB(16)" ______________" 3030 PRINT TAB(16)"| | ___________ 3040 PRINT TAB(16)"|  MENU | <> | CREATE | 3050 PRINT TAB(16)"| PROGRAM | |___FILE____| 3060 PRINT TAB(16)"|______________| 3070 PRINT 3080 PRINT"_____ 1 _____ _____ 5 _____ _____ 3 _____" 3090 PRINT"| > REPORT < | | CHANGE, ADD| | > LABELS < | 3100 PRINT"| | | DELETE OR | | PRINT UP | 3110 PRINT"| ON SCREEN | | VIEW | | TO 6 LINES | 3120 PRINT"| OR PRINTER | | RECORDS | | ON LABELS | 3130 PRINT"|____________| |____________| |____________| 3140 PRINT 3150 PRINT"_____ 2 _____ _____ 6 _____ _____ 4 _____ 3160 PRINT"| ENTER | | > MERGE < | | > SORT < | 3170 PRINT"| FORMAT FOR | | 2 SORTED | | ON ANY | 3180 PRINT"| LABELS OR | | LISTS INTO | | FIELD OR | 3190 PRINT"| REPORT | | 1 LIST | | COMBO. OF | 3200 PRINT"|____________| |____________| |_OF_FIELDS__| 3210 PRINT" 3300 PRINT:PRINT 3320 PRINT" Tap any key to return to MENU 3340 A$=INKEY$ 3350 IF A$="" THEN 3340 3370 RETURN 5000 ' 5010 ' ENTRY 5020 ' 5100 PRINT CHR$(7); 5110 ALLOWED=0 5120 Q$=INPUT$(1) 5130 PRINT Q$ 5140 IF Q$="y" THEN Q$="Y" 5150 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5160 Q=VAL(Q$) 5170 FOR L=1 TO LEN(ALLOWED$) 5180 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5190 NEXT L 5200 RETURN 5210 ' 5220 ' AL(Q$) 5170 FOR L=1 TO LEN(ALLOWED$) 5180 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5190 NEXT L INT"| OR PRINTER | | RECORDS | | ON LABELS | 3130 PRINT"|____________| |____________| |____________| 3140 PRINT 3150 PRINT"_____ 2 _____ _____ 6 _____ _____ 4 _____ 3160 PRINT"| ENTER | | > MERGE < | | > SORT < | 3170 PRINT"| FORMAT FOR | | 2 SORTED | | ON ANY | 3180 PRINT"| LABELS OR | | LISTS INTO | | FIELD OR | 3190 PRINT"| REPORT | | 1 LIST | | COMBO. OF | 3200 PRINT"|____________| |____________| |_OF_FIELDS__| 3210 PRINT" 3300 PRINT:PRINT 3320 PRINT" Tap any key to return to MENU 3340 A$=INKEY$ 3350 IF A$="" THEN 3340 3370 RETURN 5000 ' 5010 ' EN PROGRAMS FREQUENTLY USED: MENU.BAS Access to all programs is through the program MENU. You must always start by running MENU. The main menu display is: 1) Report 2) Enter Report Form 3) Labels 4) Sort 5) View, Add, Change or Delete 6) Merge 7) Help OPERATE.BAS This program (#5 on main menu) allows you to operate on individual records. Delete, change, add and view on the screen. REPORT.BAS Report (#1) is used to print a series of records on the screen or printer. You select the parts of the records to be printed, printing order and criteria for record selection. PROGRAMS USED ONCE IN A WHILE MAIL.BAS Mail (#3) is a program with all the functions of REPORT, but allows you to place the individual fields in a record to fit on a mailing label or other form. REPT-FRM.BAS Report Form (#2) allows you to enter the layout you will use in printing a report or labels, and save as a reference file to be used any time. SORT.BAS The Sort program (#4) will sort all records in a file using one or more fields as a basis. A key file is created which contains a sorted list of record numbers. REPORT and MAIL may both use a sort key file as a basis for printing records. You may have as many key files as you wish. MERGE.BAS Large files may be slow or impossible to sort due to a limited amount of memory in the computer. In this case, sort sections of the file into two or more key files and then use MERGE (#6) to create one large key file. HELP.BAS This program (#7) gives a brief introduction to E.C.F. and may be erased once you grasp the operating procedure for these programs. FILES WHICH MAY BE CREATED MYFILE A file will be created on the data disk under the name you choose. MYFILEX All files must have a header file on the same disk as the records. It contains information about your records. This file will be the same as the name you give to the main file with an X attached to it. You must copy this file when copying MYFILE. MYFILEZ If you elect to have Instant Access to a field in your records, you will find a third file with a Z ending. This is a scratch pad the computer uses to keep track of your records and must also be kept on the data disk. MYSORT Any key files created by sorting may be kept on the disk used in drive A or B. If your data is on drive B and you want to keep this sort file on drive A to save data space, refer to it as A:MYSORT whenever a program asks you for a sort file name.  CREATING A FILE To illustrate the use of Electronic Card File, we will set up a file to record the names of customers buying gas, and include the amount and price of gas purchased. Start by loading MBASIC and running the program MENU. The first choice to be made is between 1) Old file and 2) New file. A choice which is underlined or marked with *** in a menu may be selected by just hitting the "return" key. We choose #2. #1 is then selected from "1) Create a new file or 2) Return from menu." B is selected from the choice "Which drive (A or B)", since we usually want records saved on drive B. We enter the name GAS when asked to "Enter a name for the file." The next choice is tougher and requires that you do some paper work. Each card within the record may hold up to 127 characters. Each record may occupy up to 10 cards, and each card may contain as many as 20 fields. You must decide the most efficient size to make your cards. The first field in a record will always be DATE ENTERED and use two places on the first card of each record. We will select a 40 character card size for our file GAS. The computer then asks for type of field. DATE: If this type of field is used, the date Jan 3, 1982 is entered as 010382, but is compressed and stored as a two digit number. NUMBER: Seven significant digits are stored as a 4 character number. $OLLAR: 12 significant digits with two digits after a decimal are stored as an 8 character number. STRING: You pick the number of characters to appear in this field. They are stored and displayed exactly as entered. The paper work on GAS looks like this: Date entered 2 char. DATE First Name 10 char. STRING Last Name 15 char. STRING Cost per gallon 8 char. $OLLAR # of gallons 4 char. NUMBER We do not need to enter any information on DATE ENTERED since this is automatic. The first field type we enter is STRING for the First Name. Typing either "S" or "return" makes the correct selection. We are then asked for the field length, and enter 10. The computer tells us we now have 28 spaces left on this card (40-2-10=28). The same sequence for Last Name leaves us with 13 spaces. A "$" is entered for the Cost per gallon field. We are not asked for field length since it is automatically set to 8. We do have to enter the name of the field, "Cost per gallon." The # of gallons is entered as a number field by typing an "N" and the field name. This leaves us with 1 character wasted. If the paper work had been carefully done, we might have allotted 16 characters for the Last Name. The answer to "Any more fields" at this point is "N" for no. A review is presented on the screen and we are asked to verify the accuracy of our choices. A yes response brings us to the option of INSTANT ACCESS. This lets us find a record quickly, but takes up disk space since a seperate file must be maintained. We will type "Y" for yes and pick Last Name as the key field. If Instant Access is used you will also be asked for the maximum number of records. The computer will create a key file to accommodate the maximum you enter plus 100. We are then sent back to the beginning of the MENU program. is automatically set to 8. We do have to enter the name of the field, "Cost per gallon." The # of gallons is entered as a number field by typing an "N" and the field name. This leaves us with 1 character wasted. If the paper work had been carefully done, we might have allotted 16 characters for the Last Name. The answer to "Any more fields" at this point is "N" for no. A review is presented on the screen and we are asked to verify the accuracy of our choices. WORKING ON THE FILE Run MBASIC and MENU. Enter a "1" or "return" for Old File, the name of the file and the drive which contains the records. For our example this will be GAS and B. The main menu is then displayed. The choice of "5" or "return" causes the program OPERATE to be loaded and run. You are asked for the current date at the start of this program. It will be entered into any new records as DATE ENTERED. If you do not plan to add any records during this session you may enter any real date your fingers find on the number pad. The major menu will then be displayed: 1) *** ADD DATA 2) CHANGE DATA 3) DELETE DATA 4) VIEW RECORDS 5) RE-HASH RECORDS 6) RETURN TO MAIN MENU 9) END ADD DATA Since we have an empty file in our example so far, we choose Add Data by tapping the "1" or "return" key. The four field names are now displayed along with blanks sh owing the maximum number of characters allowed. FIRST NAME ---------- LAST NAME --------------- COST PER GALLON $------------ # OF GALLONS ------- The cursor will be positioned at First Name and wait for your input. After typing in the data, hit "return" to proceed to Last Name. When the last item has been entered, the data will be flashed back on the screen for your approval. If it is OK then tap "return", if not, enter "N" for no, and you will be asked to try again. The record # will be shown after a successful save. Tap "return" to return to the menu. CHANGE DATA Number 2 on the menu allows you to change data in any record. Key in the record number to be changed and the record data will be displayed. Enter the field # to be changed and the new data you want in that field. The revised record will be displayed and saved. DELETE RECORDS To delete a record tap "3" and enter the record # to be deleted. It will be displayed and you will be asked to verify that you really want this one deleted. A simple return will proceed with the deletion and return to the menu. VIEW RECORDS Selecting #4 will cause the following to show on the screen: 1) Print all 2) *** Select by record # 3) Search 4) Instant access 5) Return to main list PRINT ALL This option will initiate a screen display of records in sequence. You select the lowest and highest number records to print. The computer will display each and wait for you to tap "return" to show the next. SELECT BY RECORD # Enter the record number and it will be displayed on the screen. The computer waits for you to either enter another record number for display or to tap "return" to return to the View Records menu. SEARCH This powerful option allows you to search any field for data. If it is a string field, a match of the first 5 letters/numbers is the search basis. Each matched record is displayed on the screen; tapping "return" continues the search for the next match. Other types of fields may be range searched. You are asked for equal to, greater than or less than type of matching. We could, for example, ask for all records where gas purchases exceed 20 gallons. INSTANT ACCESS If you elected to have a field keyed for instant access, you may call up all fields which exactly match your entry in a few seconds. All the Smiths could be displayed almost as fast as you can hit the return key. Every letter and space in the field must match for a record to be found. RE-HASH RECORDS Hopefully you won't have need for this option. The method used to save keys pointing to records in the instant access option is called hashing. It is possible for the key to become confused after long use, giving errors during an instant access seek. If this happens you may re-hash the file. This can only be done on the same field you originally chose for instant access, and may take a few hours for a long file. REPORTS Option #1 on the main menu selects the program REPORT which allows selective printing of the records on screen or printer. Your first option is to print on: 1) *** SCREEN or 2) PRINTER The follow directions apply to both video and printed reports. The next choice is to use a prepared form or construct your own. A form is prepared by selecting #2 on the main menu. For our example we will construct our own. Our screen now displays the following: 101 DATE ENTERED 102 FIRST NAME 103 LAST NAME 104 COST PER GALLON 105 # OF GALLONS We are asked to select the first field to be printed by entering the field number. For this report I would like to omit printing of date entered and first name. We will start with the last name by entering "103." Next "105" for # of gallons and third "104" for cost per gallon. Entering "0" or tapping "return" ends the selection. You have the option of printing the record number, sequence number or no number at the left side of the page as each record is listed. We will ask for record number. You are now asked if you wish to set limits. The limits may be set on any field much in the same way we used "search" before. We will elect to print only those records which have more than 15 gallons purchased. Only one field may be set for limits. The next option allows us to call in a sort key file and use it as the index for printing the report. You must have already run the sort of course. All you need do is enter the name of the sort key you wish used, and records containing more than 15 gallons will be printed in that order. This sort facil ity used with the limit function above allows great flexibility in report printing. We will use a sort by last names in our example. We are next asked if there is to be a calculation within each record. You are allowed to add, subtract, multiply or divide any numeric or dollar field by another. The result is displayed at the right hand side as each record is printed. We will elect to multiply the cost per gallon by the # of gallons to get a total. The total for each field will also be added to give a grand total at the end of the report. The next to last option is to total numeric or dollar fields and print a sum at the bottom. We will elect to total the number of gallons sold. Only the gallons for records printed will be counted. The low and high records to be listed are the last items to be entered before printing starts. This is another tool to create a highly select printed set of records. Our sample file GAS prints as follows: LAST NAME # OF GALLONS COST PER GALLON -------------------------------------------- 22 Cranshaw 18 $1.33 23.94 13 Garlick 21 $1.24 26.04 85 Mauser 16 $1.33 21.28 3 Simon 18.5 $1.33 24.61 TOTAL = 95.87 # OF GALLONS = 73.5 ENTER A REPORT FORM This program (#2 main menu) allows us to create a file which automatically answers most of the questions asked by the REPORT or MAIL programs. You set up the fields to be printed and make choices concerning any limits to be placed on the records selected. You are first asked for the name to be used for this report form file. It is usually helpful to select a name which relates to the name of the main file, such as GAS-RPT1. The rest of the questions asked are identical to those in the REPORT or MAIL programs. LABELS Selecting #3 on the main menu will cause the program MAIL to be loaded and run. As with the REPORT option, you are able to print on the screen or printer. It is sometimes a help to try things out first on the screen. You may either use a prepared report form or answer questions to define the printing format. 101 DATE ENTERED 102 FIRST NAME 103 LAST NAME 104 COST PER GALLON 105 # OF GALLONS This program differs from Reports in that you may elect to print more than one field per line. Following the above display on the screen we are asked to "Enter field choice for line 1." We enter "103", and are asked "Any more this line" to which we reply "Y" and enter "102" when again asked "Enter field choice for line 1." Selection continues until you answer "N" to "more in this line" and "N" to "any more lines." We have set the label up to look like this: LAST NAME FIRST NAME DATE ENTERED # OF GALLONS COST/GALLON All of the options available in the REPORT program are then presented for the selection of records to be used in printing the labels. Standard 1 by 3.5 inch labels are used. SORT Selecting #4 on the main menu causes the SORT program to be loaded and run. The first question asks you to enter a name for your sort file. It is helpful to pick a name which has something to do with your main file name. We might choose "GAS-SRT1" for a name. You are then asked for a sort field. In our example it would be logical to pick Last Name. Even though we have Last Name as an Instant Access option, it is still necessary to sort on this field if we wish to use it as a basis for printing reports or labels. If there are a lot of Smiths in the list, we might also pick a secondary field of First Name so that the First Names would be sorted within each last name. Choosing a second or third field for the sort will, of course, slow the process considerably. You then tell the computer the lowest and highest record to sort. If you have a lot of records or a large field as a basis, you may elect to sort in two or more batches. A set of small sorts may be combined for use with the Report or Mail program by the Merge program. The Sort program carries on automatically from here. It loads all the records and displays the sort field at the same time. When all are loaded a message will appear telling you that it is sorting. Part way through the sort a count-down to 1 will appear on the screen to show you how close it is to completion. It then saves the sort key file, again showing you what it is up to on the screen. MERGE The MERGE program (#6) allows you to merge two or more sort key files. If our example file GAS was very long, we may have sorted it in three sections, naming the GAS-SRT1, GAS- SRT2 and GAS-SRT3. The merge program  allows us to merge these three into one master sort key to be used with Report or Mail. We are first asked for the first sort key file. We enter "GAS-SRT1." For the second we enter "GAS-SRT2." The program can merge only two files at a time, and the third file, GAS- SRT3, must wait for now. We then enter a name for the result of the two merged files, "GAS- SRTX." The program proceeds to merge the first two into one file called GAS-SRTX. In order to take care of the third small sort file we must again run the MERGE program. This time we enter "GAS-SRTX" as the first file to be merged, and "GAS-SRT3" as the second. The product file this time we will call "GAS-SRTY." The files will wind up as one merged file called "GAS-SRTY" which we will use in Report or Mail programs to select records in sorted order. The four programs used to obtain "GAS-SRTY" may now be erased to free disk space. These are instructions for the computer program Electronic Card File by Joseph Wiellette. They may be used and copied for personal use, but not offered for sale. Brookline, Massachusetts time, and the third file, GAS- SRT3, must wait for now. We then enter a name for the result of the two merged files, "GAS- SRTX." The program proceeds to merge the first two into one file called GAS-SRTX. In order to take care of the third small sort file we must again run the MERGE program. This time we enter "GAS-SRTX" as the first file to be merged, and "GAS-SRT3" as the second. The product file this time we will call "GAS-SRTY." The files will wind up as one merged file called "GAS-SRTY" which we will use in Report or Mail programs to select records in sorted order. The four programs used to obtain "GAS-SRTY" may now be erased to free disk space. These are instructions for the comput1 ' ELECTRONIC CARD FILE 2 ' BY Joe Wiellette 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 10 '********** PROGRAM MAIL **************** 20 ' 30 ' 50 DEFINT S,L,D,I,J,K,T 60 DEFDBL C 100 ' 110 ' ******* MAIN PROGRAM ********** 120 ' 200 PRINT CLSCR$ 210 PRT=0 220 PRINT"1) *** Print labels on printer 222 PRINT"2) Print labels on screen 224 PRINT"3) Return to MENU 230 DEFAULT$="1":ALLOWED$="123":GOSUB 5000: IF ALLOWED=0 THEN 200 240 IF Q=3 THEN CLOSE:RUN"MENU 250 IF Q=1 THEN PRT=1 260 GOSUB 2000 300 GOTO 200 2000 ' 2010 ' ********* MAJOR ROUTINE FOR LABEL PRINTING ********* 2020 ' 2030 PRINT CLSCR$ 2100 PRINT"Use prepared form (*** YES) "; 2110 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 2100 2120 IF Q$="Y" THEN GOSUB 12000 ELSE GOSUB 13000 2130 PRINT CLSCR$ 2200 INPUT"Enter low record number ",LOW 2210 INPUT"Enter high record # (0 for highest)",HIGH 2212 IF HIGH=0 THEN HIGH=INT(A(6)/A(2))-1 2220 IF LOW<1 THEN 2200 2230 FOR IV=LOW TO HIGH 2240 IF SORTFILE$<>"Y" THEN I=IV:GOTO 2250 2242 INPUT#1,I,FAKE$:IF IHIGH THEN 2242 2250 GOSUB 16000 :' ********* GET RECORD ********** 2260 GOSUB 17000 :' ****** CONVERT RECORD TO FIELDS ******** 2270 IF DELETED$<>"A" THEN 2450 2280 ' *** LIMIT CHECK **** 2290 IF LIMIT$<>"Y" THEN 2350 2292 CDTA=VAL(DTA$(L1,L2)) 2300 IF L4=1 AND TYPE(L1,L2)=4 AND LEFT$(L3$,4)=LEFT$(DTA$(L1,L2),4) THEN 2350 2310 IF L4=1 AND TYPE(L1,L2)<>4 AND L3=CDTA THEN 2350 2320 IF L4=2 AND L3CDTA THEN 2350 2340 GOTO 2450 2350 ' ******* PRINT FIELDS CHOSEN ********* 2360 LINENUM=1:K=1 2370 FOR I=1 TO FIELDCOUNT 2380 GOSUB 18000 2390 IF PRT=1 THEN IF LINES(LINENUM)=K THEN LPRINT:LINENUM=LINENUM+1:K=1:GOTO 2410 2392 IF PRT=0 THEN IF LINES(LINENUM)=K THEN PRINT:LINENUM=LINENUM+1:K=1:GOTO 2410 2400 K=K+1 2410 NEXT I 2420 FOR J=1 TO 7-LINENUM 2430 IF PRT=1 THEN LPRINT ELSE PRINT 2440 NEXT J 2450 NEXT IV 2452 INPUT"Tap return to continue ";FAKE$ 2460 CLOSE(1):RETURN 3000 ' 3010 ' *********** END OF MAJOR SECTION ********** 3020 ' 5000 ' 5010 ' *** INPUT *** 5020 ' 5030 PRINT BELL$; 5040 ALLOWED=0 5050 Q$=INPUT$(1) 5060 PRINT Q$ 5070 IF Q$="y" THEN Q$="Y" 5080 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5090 Q=VAL(Q$) 5100 FOR L=1 TO LEN(ALLOWED$) 5110 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5120 NEXT L 5130 RETURN 5140 ' 5150 ' 12000 ' 12010 ' ************** GET FORM FROM A FILE ***************** 12020 ' 12030 ' 12100 PRINT CLSCR$; 12110 INPUT"Enter the name of the report form ",REPORT$ 12120 REPORT$=DRIVE$+REPORT$ 12130 OPEN"I",#3,REPORT$ 12132 INPUT#3,MAIL$ 12140 FIELDCOUNT = 0: LINENUM = 1: LINES(1) =0: Q$="Y": R$="Y" 12200 WHILE R$="Y" 12210 WHILE Q$="Y" 12212 LINES(LINENUM)= LINES(LINENUM)+1 12214 FIELDCOUNT = FIELDCOUNT +1 12220 INPUT#3,FIELDS 12230 G(FIELDCOUNT) = INT(FIELDS/100): H(FIELDCOU NT)= FIELDS-(G(FIELDCOUNT)*100) 12240 INPUT#3,Q$ 12270 WEND :' **** END OF Q LOOP FOR ONE LINE **** 12280 INPUT#3,R$ 12300 LINENUM=LINENUM + 1 12310 LINES(LINENUM)=0 12320 Q$="Y" 12330 WEND :' **** LAST LINE OF LABEL ***** 12400 ' 12410 ' ******** CHECK FOR LIMITS ******** 12420 ' 12430 INPUT#3,LIMIT$ 12440 LIMIT$=LEFT$(LIMIT$,1) 12442 IF LIMIT$<>"Y" THEN 12600 12450 INPUT#3,FIELDS 12460 L1=INT(FIELDS/100) 12470 L2=FIELDS-(L1*100) 12480 IF TYPE(L1,L2)=1 THEN INPUT"Enter date ",DATE$:GOSUB 20000:L3=DATE:INPUT#3,L4 ELSE IF T(L1,L2)<>4 THEN INPUT"Enter limit ",L3:INPUT#3,L4 ELSE INPUT"Enter target ",L3$:L4=1 12600 ' 12610 ' ********* CHECK FOR SORT *********** 12620 ' 12630 INPUT#3,SORTFILE$ 12642 IF SORTFILE$<>"Y" THEN 12730 12650 INPUT#3,SORT$ 12660 OPEN"I",#1,SORT$ 12730 RETURN 12800 ' 12810 '************ END OF LOAD FOR FORMATTED LABEL INPUT ********* 12820 ' 13000 ' 13010 ' *********** ENTER FORMAT FOR LABEL ************* 13020 ' 13030 Q$="Y":R$="Y" 13100 GOSUB 14000: ' ** PRINT HEADER LISTING TO SHOW CHOICES ** 13110 FIELDCOUNT=0:LINENUM=1:LINES(1)=0:Q$="Y":R$="Y" 13120 WHILE R$="Y" 13130 WHILE Q$="Y" 13132 LINES(LINENUM)=LINES(LINENUM)+1 13134 FIELDCOUNT = FIELDCOUNT +1 13140 PRINT"Enter field choice for line "LINENUM; 13142 FIELDS=0 13150 WHILE FIELDS<100 : INPUT FIELDS : WEND 13160 G(FIELDCOUNT)=INT(FIELDS/100) 13170 H(FIELDCOUNT)=FIELDS-(G(FIELDCOUNT)*100) 13180 PRINT"Any more this line (** YES) "; 13190 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 13180 13220 WEND :' *** END OF Q LOOP FOR ONE LINE *** 13230 PRINT"Any more lines (*** YES) "; 13240 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 13230 13250 R$=Q$ 13260 LINENUM=LINENUM + 1 13270 LINES(LINENUM)=0 13280 WEND :' *** LAST LINE OF LABEL **** 13300 ' 13310 ' ******* ENTER LIMITS ********* 13320 ' 13330 PRINT CLSCR$ 13340 PRINT"Do you wish to set limits (** NO) "; 13350 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 13340 13352 LIMIT$=Q$ 13360 IF Q$<>"Y" THEN 13500 13370 INPUT"Enter field to limit (99 to re-list fields) ",FIELDS 13380 IF FIELDS=99 THEN GOSUB 14000:GOTO 13370 13390 L1=INT(FIELDS/100):L2=FIELDS-(L1*100) 13400 IF TYPE(L1,L2)=1 THEN INPUT"Enter target date ",DATE$:GOSUB 20000:L3=DATE:GOTO 13410 13402 IF TYPE(L1,L2)<>4 THEN INPUT"Enter target for field ",L3 ELSE INPUT"Enter target for field ",L3$:L4=1:GOTO 13500 13410 INPUT"1) Equal 2) Low limit 3) High limit ",L4 13500 ' 13510 ' ****** CHECK FOR SORT ******** 13520 ' 13530 PRINT"Want a sort key file (** NO) "; 13540 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 13530 13550 IF Q$<>"Y" THEN RETURN ELSE SORTFILE$="Y" 13560 INPUT"Enter name of sort key file ",SORT$ 13562 SORT$=DRIVE$+SORT$ 13570 OPEN"I",#1,SORT$ 13640 RETURN 14000 ' 14010 ' ********* DISPLAY HEADER LISTINGS *********** 14020 ' 14030 PRINT CLSCR$ 14040 FOR I=1 TO A(2) 14050 FOR J= 1 TO F(I) 14060 FIELDS=(I*100)+J 14070 PRINT FIELDS" "LABEL$(I,J) 14080 NEXT J 14090 NEXT I 14100 RETURN 16000 ' 16100 ' ****** GET CORRECT RECORD ********** 16110 ' 16200 I=(I*A(2))-A(2)+1 16210 FOR M=I TO I+A(2)-1 16220 IF M=0 THEN 16260 16230 GET#2,M 16240 MM=M-I+1 16250 S$(MM)=RECORD$ 16260 NEXT M 16270 RETURN 17000 ' 17100 ' ********* CONVERT RECORD INTO FIELDS ********* 17110 ' 17200 LN=2 17210 DELETED$=LEFT$(S$(1),1) 17220 FOR F=1 TO A(2) 17230 M$=S$(F) 17240 IF M$="" THEN 17300 17250 FOR J=1 TO F(F) 17260 ON TYPE(F,J) GOSUB 17320,17360,17380,17400 17270 LN=LN+LENGTH(F,J) 17280 NEXT J 17290 LN=2 17300 NEXT F 17310 RETURN 17320 ' *** DATE CONVERT ** 17322 DATE$=M$ 17330 GOSUB 20200 17340 DTA$(F,J)=STR$(CVI(MID$(M$,LN,LENGTH(F,J)))) 17350 RETURN 17360 DTA$(F,J)=STR$(CVS(MID$(M$,LN,LENGTH(F,J)))) 17370 RETURN 17380 DTA$(F,J)=STR$(CVD(MID$(M$,LN,LENGTH(F,J)))) 17390 RETURN 17400 DTA$(F,J)=MID$(M$,LN,LENGTH(F,J)) 17410 RETURN 18000 ' 18010 ' ****** ACTUAL FIELD PRINTING ******* 18020 ' 18030 ON TYPE(G(I),H(I)) GOSUB 18050,18090,18120,18150 18040 RETURN 18050 JULIAN = VAL(DTA$(G(I),H(I))):GOSUB 20250 18060 IF VAL(DTA$(G(I),H(I)))>0 THEN IF PRT=1 THEN LPRINT USING"###";MONTH,DAY,YEAR;:LPRINT" "; ELSE PRINT USING"###";MONTH,DAY,YEAR;:PRINT" "; 18070 RETURN 18080 ' 18090 IF PRT=1 THEN LPRINT VAL(DTA$(G(I),H(I)));:LPRINT" "; ELSE PRINT VAL(DTA$(G(I),H(I)));:PRINT" "; 18100 RETURN 18110 ' 18120 IF PRT=1 THEN LPRINT USING DLR$;VAL(DTA$(G(I),H(I)));:LPRINT" "; ELSE PRINT USING DLR$;VAL(DTA$(G(I),H(I)));:PRINT" "; 18130 RETURN 18140 ' 18150 IF PRT=1 THEN LPRINT DTA$(G(I),H(I))" "; ELSE PRINT DTA$(G(I),H(I))" "; 18160 RETURN 20000 ' 20010 ' *********** CONVERT CALANDAR TO JULIAN *********** 20020 ' 20030 MONTH=VAL(LEFT$(DATE$,2)) 20040 DAY=VAL(MID$(DATE$,3,2))   20050 YEAR=VAL(RIGHT$(DATE$,2)) 20060 DATE=INT(30.57*MONTH)+INT(365.25*YEAR-395.25)+DAY 20070 IF(INT(YEAR/4)*4)+1=YEAR THEN DATE=DATE-1 20080 IF MONTH<3 THEN DATE=DATE+1 ELSE IF INT(YEAR/4)*4=YEAR THEN 20090 ELSE DATE=DATE-1 20090 IF DATE>32500 THEN DATE=32500-DATE 20100 RETURN 20200 ' 20210 ' ********* CONVERT JULIAN TO CALANDAR *********** 20220 IF DATE$="" OR VAL(DATE$)=0 THEN RETURN 20230 JULIAN=CVI(MID$(DATE$,LN,LENGTH(F,J))) 20240 IF JULIAN<0 THEN JULIAN=32500-JULIAN 20250 YEAR=INT(JULIAN/365.26)+1 20260 DAY=JULIAN+INT(395.25-365.25*YEAR) 20270 D1=2:IF INT(YEAR/4)*4=YEAR THEN D1=1 20280 IF DAY>91 THEN DAY=DAY+D1 20290 MONTH=INT(DAY/30.57):DAY=DAY-INT(30.57*MONTH) 20300 RETURN (YEAR/4)*4=YEAR THEN D1=1 20280ETURN 18140 ' 18150 IF PRT=1 THEN LPRINT DTA$(G(I),H(I))" "; ELSE PRINT DTA$(G(I),H(I))" "; 18160 RETURN 20000 ' 20010 ' *********** CONVERT CALANDAR TO JULIAN *********** 20020 ' 20030 MONTH=VAL(LEFT$(DATE$,2)) 20040 DAY=VAL(MID$(DATE$,3,2)) 1 ' ELECTRONIC CARD FILE 2 ' BY Joe Wiellette 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 50 DEFINT S,L,D,I,J,K,T 80 CLOSE 90 PRINT CLSCR$; 100 ' MERGE FOR DATABASE 110 ' 120 ' 300 INPUT"Enter name of first list ";FIRST$ 302 FIRST$=DRIVE$+FIRST$ 310 INPUT"Enter name of second list ";SECOND$ 312 SECOND$=DRIVE$+SECOND$ 320 INPUT"Enter name of product list ";THIRD$ 322 THIRD$=DRIVE$+THIRD$ 350 OPEN"I",#1,FIRST$ 360 OPEN"I",#2,SECOND$ 370 OPEN"O",#3,THIRD$ 500 INPUT#1,A,A$ 510 INPUT#2,B,B$ 600 PRINT"A",A,A$ 610 PRINT"B",B,B$ 700 ' 710 ' A"" THEN 2300 2210 NEXT K 2300 PRINT:PRINT 2320 PRINT"1) *** Return to MENU 2330 PRINT"2) END 2340 PRINT" Which "; 2450 Q$=INPUT$(1) 2460 IF Q$=CHR$(13) THEN Q$="1" 2470 IF Q$="1" THEN RUN"MENU 2480 IF Q$<>"2" THEN 2300 2500 END ich "; 2450 Q$=INP,#3,THIRD$ 500 INPUT#1,A,A$ 510 INPUT#2,B,B$ 600 PRINT"A",A,A$ 610 PRINT"B",B,B$ 700 ' 710 ' A6 THEN 82 86 GOSUB 3140 90 CDATE=DATE 200 ' *** OPEN HASH FILE *** 240 IF A(5)=0 THEN 280 250 IH=INT(A(5)/100):JH=A(5)-(IH*100) 252 V$=DRIVE$+A$(1)+"Z" 260 OPEN"R",#3,V$,LENGTH(IH,JH)+4 262 HSHLEN=LENGTH(IH,JH) 270 FIELD#3,LENGTH(IH,JH) AS S1$,2 AS S2$,2 AS S3$ 272 ' ***** GET CHOICE **** 280 PRINT CLSCR$ 290 PRINT"1) *** ADD DATA 300 PRINT"2) CHANGE DATA 310 PRINT"3) DELETE RECORDS 320 PRINT"4) VIEW RECORDS 322 PRINT"5) RE-HASH RECORDS 323 PRINT"6) RETURN TO MAIN MENU 327 PRINT"9) END 330 DEFAULT$="1":ALLOWED$="1234569":GOSUB 5000:IF ALLOWED =0 THEN 280 340 ON Q GOSUB 360,3710,4220,1530,6000 345 IF Q=6 THEN CLOSE:RUN"MENU 346 IF Q=9 THEN END 350 GOTO 280 360 REM ------------------ ENTER DATA TO NEW RECORD --------------------- 370 PRINT CLSCR$; 380 FOR I=1 TO A(2) 390 FOR J=1 TO F(I) 391 IF I=1 AND J=1 THEN 470 400 PRINT REVERSE$; 410 PRINT LABEL$(I,J); 420 PRINT REVERSE.OFF$; 430 PRINT " "; 440 IF TYPE(I,J)=4 THEN GOSUB 3000 450 IF TYPE(I,J)=1 THEN PRINT"______ AS M,D,Y (020980) 460 IF TYPE(I,J)=2 THEN PRINT"_______" 462 IF TYPE(I,J)=3 THEN PRINT"$____________" 470 NEXT J 490 REM -------------------- INPUT DATA ----------- 504 XD=0 520 MM$(I)="A" 530 FOR J=1 TO F(I) 531 IF I=1 AND J=1 THEN MM$(I)=MM$(I)+MKI$(CDATE):GOTO 600 540 XD=XD+1:Y=LEN(LABEL$(I,J))+3 550 GOSUB 3060:REM SCREEN INPUT AS I$ 560 IF LENGTH(I,J)+LEN(LABEL$(I,J))>79 THEN XD=XD+1 570 IF TYPE(I,J)=1 THEN DATE$=I$: GOSUB 3140:MM$(I)=MM$(I)+MKI$(DATE) 580 IF TYPE(I,J)=2 THEN MM$(I)=MM$(I)+MKS$(VAL(I$)) 582 IF TYPE(I,J)=3 THEN MM$(I)=MM$(I)+MKD$(VAL(I$)) 590 IF TYPE(I,J)=4 THEN MM$(I)=MM$(I)+I$ 600 NEXT J 602 PRINT CLSCR$; 630 NEXT I 690 REM --------------- PRINT AND SAVE FORMATTED DATA -------------- 692 FLAGF=1 700 GOSUB 3320 710 GOSUB 3530 712 FLAGF=0 720 PRINT:PRINT 730 PRINT"SHALL WE RECORD THE DATA (*** = Yes)"; 732 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED =0 THEN 730 740 IF Q$="Y" THEN 770 750 PRINT:PRINT:PRINT"THEN WE HAD BETTER START OVER 752 FOR W=1 TO 300:NEXT W 760 GOTO 360 770 GET#2,RI 780 IF LEFT$(RECORD$,1)="A" THEN RI=RI+A(2):GOTO 770 790 FOR M=1 TO A(2) 800 LSET RECORD$=MM$(M) 810 PUT#2,RI 820 RI=RI+1 830 NEXT M 900 REM ----- INSTANT ACCESS FILE KEYS 910 XI=((RI+A(2)-1)/A(2))-1 912 IF FLAGR=1 THEN XI=RECORD 930 IF A(5)=0 THEN 1420:REM no access key 940 I=INT(A(5)/100) 950 J=A(5)-(I*100) :REM CHANGE N VALUE INTO I,J FIELD VALUES 960 N$=DTA$(I,J) 962 GOSUB 970 964 GOTO 1150 970 LHT=101 980 HASHV=0 990 N=LEN(N$) 991 IF FLAGR=1 THEN PRINT RECORD,N$ 1000 B(0)=0:B(1)=0 1010 FOR T=1 TO N 1020 R=INT((T/2-INT(T/2))*2+.05)*SGN(T/2) 1030 A=ASC(MID$(N$,T)) 1040 B(R)=B(R)+A 1050 NEXT T 1060 HASHV=(INT((B(0)/256-INT(B(0)/256))*256+.05)*SGN(B(0)/256))+256*(INT((B(1)/256-INT(B(1)/256))*256+.05)*SGN(B(1)/256)) 1070 HASHV=INT((HASHV/LHT-INT(HASHV/LHT))*LHT+.05)*SGN(HASHV/LHT) 1072 IF HASHV=0 THEN HASHV=1 1080 RETURN 1150 GET#3,HASHV 1155 S2=CVI(S2$) 1160 IF ASC(LEFT$(S1$,1))> 33 THEN 1250 1170 REM --- FIRST SLOT EMPTY -- FILL IT 1180 LSET S1$=DTA$(I,J) 1190 LSET S2$=MKI$(KI) 1191 LSET S3$=MKI$(XI) 1192 PUT#3,HASHV 1194 IF FLAGR=1 THEN RETURN 1195 A(4)=A(4)+1 1200 GOTO 1420 1250 REM ---- FIRST SLOT FILLED --- IS THERE A POINTER TO NEXT? 1260 IF S2=0 THEN S2=A(4) ELSE 1300 1270 LSET S2$=MKI$(S2) 1280 PUT#3,HASHV 1290 LSET S1$=DTA$(I,J) 1291 LSET S3$=MKI$(XI) 1292 LSET S2$=MKI$(KI) 1294 PUT#3,A(4) 1295 A(4)=A(4)+1 1298 GOTO 1420 1300 REM ---- POINTER IN FIRST SLOT -- GET NEXT 1310 GET#3,S2 1312 S3=S2 1320 S2=CVI(S2$) 1322 IF S2<>0 THEN 1310 1330 LSET S2$=MKI$(A(4)) 1332 PUT#3,S3 1340 LSET S1$=DTA$(I,J) 1342 LSET S2$=MKI$(KI) 1344 LSET S3$=MKI$(XI) 1350 PUT#3,A(4) 1360 A(4)=A(4)+1 1420 REM ------ SAVE REVISED HEADER FILE ----- 1430 OPEN"O",#1,HEADER$ 1432 IF RI>A(6) THEN A(6)=RI 1440 FOR I=1 TO 10:WRITE#1,A$(I),A(I):NEXT I 1450 FOR I=1 TO A(2) 1460 PRINT#1,F(I) 1462 FOR J=1 TO F(I):WRITE#1,TYPE(I,J),LENGTH(I,J),LABEL$(I,J):NEXT J:NEXT I 1470 CLOSE 1 1500 IF FLAGR=1 THEN RETURN 1502 PRINT:PRINT"RECORD # : "((RI+A(2)-1)/A(2))-1 1510 PRINT BELL$"Tap return to continue "; 1512 Q$=INPUT$(1) 1520 RETURN 1530 REM -------------------- VIEW RECORDS -------------- 1540 PRINT CLSCR$ 1550 PRINT"1) Print All 1560 PRINT"2) *** Select by Record # 1570 PRINT"3) Search 1580 PRINT"4) Instant access 1582 PRINT"5) Return to Main List 1590 PRINT 1600 PRINT"WHICH "; 1602 ALLOWED$="12345":DEFAULT$="2":GOSUB 5000:IF ALLOWED=0 THEN 1540 1606 IF Q=5 THEN RETURN  1610 ON Q GOSUB 1630,1740,1890,2190 1612 GOTO 1540 1620 RETURN 1630 REM ------------------ PRINT ALL ---------------- 1640 INPUT"Enter low record number ",LOW 1642 INPUT"enter high record number (zero for highest) ",HIGH 1644 IF LOW<1 THEN 1640 1648 IF HIGH =0 THEN HIGH=A(6)/A(2)-1 1650 FOR IV=LOW TO HIGH 1660 I=IV 1670 FLAGA=1:FLAGD=1 1680 GOSUB 1760 1682 IF FLAGR=1 THEN GOSUB 900:GOTO 1710 1690 PRINT:PRINT:PRINT 1700 PRINT"TAP RETURN FOR NEXT "; 1702 Q$=INPUT$(1) 1710 NEXT IV 1720 FLAGD=0 1722 FLAGR=0 1730 RETURN 1740 REM ---------------- SELECT BY RECORD # ------------ 1750 INPUT"Enter Record # (0 TO QUIT) ",I 1760 RECORD=I 1770 IF I=0 THEN RETURN 1780 I=(RECORD*A(2))-A(2)+1 1790 FOR M=I TO I+A(2)-1 1800 GET#2,M 1810 MM=M-I+1 1820 MM$(MM)=RECORD$ 1830 NEXT M 1840 IF FLAGB=1 THEN FLAGB=0:RETURN 1850 GOSUB 3320 1852 IF FLAGR=1 THEN RETURN 1860 GOSUB 3530 1870 IF FLAGA=1 THEN FLAGA=0:RETURN 1880 GOTO 1750 1890 REM ---------------- SEARCH --------------------- 1900 PRINT CLSCR$; 1910 FOR I=1 TO A(2) 1920 FOR J=1 TO F(I) 1930 N=(I*100)+J 1940 PRINT N TAB(7) LABEL$(I,J) 1950 NEXT J,I 1952 LAST=N 1960 PRINT:INPUT"Enter the search field number ";N 1962 IF N<100 OR N>LAST THEN PRINT"Invalid field choice. Try again":GOTO 1960 1970 II=INT(N/100):JJ=N-(II*100) 1972 INPUT"Enter lowest record number to search ";LOW 1980 PRINT"Enter highest record number 1981 INPUT" (zero for current last record) ";HIGH:IF HIGH=0 THEN HIGH=A(6)/A(2)-1 1982 PRINT"String searches show records where first 1983 PRINT" 5 characters match" 1990 INPUT"Enter the object of your search ",SEARCH$ 2000 IF LEN(SEARCH$)<5 THEN SEARCH$=SEARCH$+" ":GOTO 2000 2010 IF TYPE(II,JJ)=1 THEN GOSUB 2140 2012 IF TYPE(II,JJ)=4 THEN Q=1:GOTO 2030 2020 INPUT"1) Equal to 2) Greater than 3) Less than ",Q 2030 FOR IV=LOW TO HIGH 2040 I=IV 2050 FLAGB=1 2060 GOSUB 1760 2070 GOSUB 3320 2080 IF Q=1 AND TYPE(II,JJ)=4 AND LEFT$(DTA$(II,JJ),5)=LEFT$(SEARCH$,5) THEN GOSUB 3530:PRINT:PRINT:GOSUB 10050 2090 IF Q=2 AND TYPE(II,JJ)<4 AND VAL(SEARCH$)VAL(DTA$(II,JJ)) THEN GOSUB 3530:PRINT:PRINT:GOSUB 10050 2120 NEXT IV 2130 RETURN 2140 REM DATE DECODE 2150 I$=SEARCH$ 2160 GOSUB 3140 2170 SEARCH$=STR$(DATE) 2180 RETURN 2190 REM --------------- INSTANT ACCESS TO RECORDS -------------- 2200 PRINT CLSCR$; 2290 INPUT"Enter the object of your search ",N$ 2292 IF LEN(N$)LENGTH(I,J) THEN PRINT"Too many characters. Start over.":GOSUB 10050:GOTO 280 3084 IF TYPE(I,J)=1 AND LEN(I$)<>6 THEN PRINT"Incorrect date - try again":GOSUB 10050:GOTO 280 3090 IF TYPE(I,J)=4 THEN 3100 ELSE 3130 3100 IF LEN(I$)=>LENGTH(I,J) THEN 3130 3110 I$=I$+" " 3120 GOTO 3100 3130 RETURN 3140 REM ----------- ROUTINE TO CONVERT DATE TO JULIAN ---------- 3150 MONTH=VAL(LEFT$(DATE$,2)) 3160 DAY=VAL(MID$(DATE$,3,2)) 3170 YEAR=VAL(RIGHT$(DATE$,2)) 3180 DATE=INT(30.57*MONTH)+INT(365.25*YEAR-395.25)+DAY 3190 IF(INT(YEAR/4)*4)+1=YEAR THEN DATE=DATE-1 3200 IF MONTH<3 THEN DATE=DATE+1:GOTO 3230 3210 IF INT(YEAR/4)*4=YEAR THEN 3230 3220 DATE=DATE-1 3230 IF DATE>32500 THEN DATE=32500-DATE 3232 RETURN 3240 REM ----------- CONVERT JULIAN TO CALNDAR --------------- 3242 IF S$="" THEN RETURN 3250 JULIAN=CVI(MID$(S$,LN,LENGTH(F,J))) 3252 IF JULIAN<0 THEN JULIAN=32500-JULIAN 3260 YEAR=INT(JULIAN/365.26)+1 3270 DAY=JULIAN+INT(395.25-365.25*YEAR) 3280 D1=2:IF INT(YEAR/4)*4=YEAR THEN D1=1 3290 IF DAY>91 THEN DAY=DAY+D1 3300 MONTH=INT(DAY/30.57):DAY=DAY-INT(30.57*MONTH) 3310 RETURN 3320 REM ------------- CONVERT RETREIVED RECORD INTO FIELDS --------------- 3330 LN=2 3340 FOR F=1 TO A(2) 3350 S$=MM$(F) 3360 FOR J=1 TO F(F) 3370 ON TYPE(F,J) GOSUB 3430,3470,3490,3510 3380 LN=LN+LENGTH(F,J) 3390 NEXT J 3400 LN=2 3410 NEXT F 3420 RETURN 3430 REM DATE CONVERT 3440 GOSUB 3240 3450 DTA$(F,J)=STR$(CVI(MID$(S$,LN,LENGTH(F,J)))) 3460 RETURN 3470 DTA$(F,J)=STR$(CVS(MID$(S$,LN,LENGTH(F,J)))) 3480 RETURN 3490 DTA$(F,J)=STR$(CVD(MID$(S$,LN,LENGTH(F,J)))) 3500 RETURN 3510 DTA$(F,J)=MID$(S$,LN,LENGTH(F,J)) 3520 RETURN 3530 REM ---------------- PRINT RECORDS ------------ 3540 PRINT CLSCR$; 3550 IF FLAGF<>1 THEN PRINT TAB(20)"RECORD # "RECORD 3560 IF FLAGD=1 AND LEFT$(RECORD$,1)<>"A" THEN 3700 3570 FOR I=1 TO A(2) 3580 FOR J=1 TO F(I) 3590 PRINT LABEL$(I,J) TAB(20); 3600 ON TYPE(I,J) GOSUB 3640,3670,3690,3670 3610 NEXT J 3620 NEXT I 3630 RETURN 3640 JULIAN=VAL(DTA$(I,J)):GOSUB 3260 3650 IF VAL(DTA$(I,J))>0 THEN PRINT MONTH;DAY;YEAR ELSE PRINT 3660 RETURN 3670 PRINT DTA$(I,J) 3680 RETURN 3690 PRINT USING DLR$;VAL(DTA$(I,J)) 3700 RETURN 3710 REM ---------------- CHANGE DATA ------------------ 3720 INPUT"Enter record # to be changed ";I 3722 IF I<1 OR I>A(6) THEN 3720 3730 FLAGB=1 3740 GOSUB 1760 3750 GOSUB 3320 3760 PRINT CLSCR$; 3770 PRINT TAB(20)"RECORD # "RECORD 3780 FOR I=1 TO A(2) 3790 FOR J=1 TO F(I) 3792 N=(100*I)+J 3800 PRINT N" " LABEL$(I,J) " "; 3810 ON TYPE(I,J) GOSUB 3850,3870,3890,3870 3820 NEXT J 3830 NEXT I 3832 LAST=N 3840 GOTO 3910 3850 DATE=VAL(DTA$(I,J)):GOSUB 3260:PRINT MONTH" "DAY" "YEAR 3860 RETURN 3870 PRINT DTA$(I,J) 3880 RETURN 3890 PRINT USING DLR$;VAL(DTA$(I,J)) 3900 RETURN 3910 PRINT:PRINT 3920 INPUT"Enter field number to be changed ",N 3921 IF N=A(5) THEN PRINT"Access key field - can't change - delete and re-enter":GOSUB 10050:RETURN 3922 I=INT(N/100) 3923 J=N-(I*100) 3925 IF N<100 OR N>LAST THEN PRINT"Invalid field choice. Try again.":GOTO 3920 3930 PRINT"Enter new data" 3940 GOSUB 3080 3950 IF TYPE(I,J)=1 THEN GOSUB 3140:I$=STR$(DATE) 3960 DTA$(I,J)=I$ 3980 FOR I=1 TO A(2) 3982 MM$(I)="A" 3990 FOR J=1 TO F(I) 4000 IF TYPE(I,J)=4 THEN MM$(I)=MM$(I)+DTA$(I,J) 4020 IF TYPE(I,J)=1 THEN MM$(I)=MM$(I)+MKI$(VAL(DTA$(I,J))) 4040 IF TYPE(I,J)=2 THEN MM$(I)=MM$(I)+MKS$(VAL(DTA$(I,J))) 4042 IF TYPE(I,J)=3 THEN MM$(I)=MM$(I)+MKD$(VAL(DTA$(I,J))) 4080 NEXT J 4090 NEXT I 4100 GOSUB 3320 4110 GOSUB 3530 4120 REC=(RECORD*A(2))-A(2) 4130 FOR M=1 TO A(2) 4140 LSET RECORD$=MM$(M) 4150 PUT#2,REC+M 4160 NEXT M 4200 GOSUB 10050 4210 RETURN 4220 REM -------------- DELETE RECORDS ---------------- 4230 PRINT CLSCR$ 4240 INPUT"Enter record # to be deleted ",DEL 4242 IF DEL<1 OR DEL>A(6) THEN 4240 4250 I=DEL 4260 FLAGA=1 4270 GOSUB 1760 4280 PRINT"Delete this one (*** YES) "; 4282 ALLOWED$="YyNn":DEFAULT$="Y":GOSUB 5000:IF ALLOWED=0 THEN 4280 4290 IF Q$="Y" THEN 4300 ELSE 4520 4300 A$="" 4310 I=(DEL*A(2))-A(2)+1 4320 LSET RECORD$=A$ 4330 FOR M=I TO I+A(2)-1 4340 PUT#2,M 4350 NEXT M 4360 IF A(5)=0 THEN 4520 4400 N$=DTA$(IH,JH) 4410 GOSUB 970 4420 GET#3,HASHV 4430 IF RECORD=CVI(S3$) THEN 4500 4440 HASHV=CVI(S2$) 4450 GOTO 4420 4500 LSET S3$=MKI$(0) 4502 LSET S1$="" 4510 PUT#3,HASHV 4520 RETURN 5000 ' 5010 ' *** ENTER RESPONSE *** 5020 ' 5100 PRINT BELL$; 5110 ALLOWED=0 5120 Q$=INPUT$(1) 5130 PRINT Q$ 5140 IF Q$="y" THEN Q$="Y" 5150 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5160 Q=VAL(Q$) 5170 FOR L=1 TO LEN(ALLOWED$) 5180 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5190 NEXT L 5200 RETURN 5210 ' 5220 ' 6000 REM ----------- RE-HASH RECORDS -------------- 6010 PRINT CLSCR$ 6020 A(4)=101 6030 INPUT"Enter field name for access ";NAM$ 6040 FOR N=1 TO 10 6050 FOR P=1 TO 20 6060 IF LABEL$(N,P)=NAM$ THEN 6090 6070 NEXT P,N 6080 PRINT"Can't find it. Start again ":GOTO 6030 6090 A(5)=(N*100)+P 6100 INPUT"Enter max # of files ",MAX 6110 Z=0 6120 LSET S1$="":LSET S2$=MKI$(Z):LSET S3$=MKI$(Z) 6130 FOR I=1 TO MAX 6140 PUT#3,I 6150 NEXT I 6160 INPUT"Enter lowest file number for re-hashing ",LOW 6170 INPUT"Enter highest file number for re-hashing (zero for last record) ",HIGH 6180 IF LOW<1 THEN 6160 6190 IF HIGH=0 THEN HIGH=INT(A(6)/A(2)) 6200 FLAGR=1 6210 GOSUB 1650 6220 GOSUB 1420 6230 FLAGR=0 6240 RETURN 10000 REM *********** ERROR HANDLING ************** 10010 IF ERR=53 THEN PRINT"No such file name.":CLOSE:RESUME 90 10020 IF ERR=7 THEN PRINT"I have to reorganize memory by re-starting":CLOSE:GOTO 280 10030 IF ERR=13 THEN PRINT"Incorrect type of input. Start over.":CLOSE:GOTO 290 10040 ON ERROR GOTO 0 10050 REM ------- INPUT TO RETURN ----- 10060 PRINT CHR$(7);  10070 PRINT"TAP RETURN TO CONTINUE "; 10080 Q$=INPUT$(1) 10090 IF Q$=CHR$(13) THEN Q$="0" 10100 RETURN 060 PRINT CHR$(7); 6090 6070 NEXT P,N 6080 PRINT"Can't find it. Start again ":GOTO 6030 6090 A(5)=(N*100)+P 6100 INPUT"Enter max # of files ",MAX 6110 Z=0 6120 LSET S1$="":LSET S2$=MKI$(Z):LSET S3$=MKI$(Z) 6130 FOR I=1 TO MAX 6140 PUT#3,I 6150 NEXT I 6160 INPUT"Enter lowest file number for re-hashing ",LOW 6170 INPUT"Enter highest file number for re-hashing (zero for last record) ",HIGH 6180 IF LOW<1 THEN 6160 6190 IF HIGH=0 THEN HIGH=INT(A(6)/A(2)) 6200 FLAGR=1 6210 GOSUB 1650 6220 GOSUB 1420 6230 FLAGR=0 6240 RETURN 10000 REM *********** ERROR HANDLING ************** 10010 IF ERR=53 THEN PRINT"No such file name.":CLOSE:RESUME 90 10020 IF ERR=7 THEN PRINT"I have to reorganize memory by re-starting":CLOSE:GOTO 280 10030 IF ERR=13 THEN PRINT"Incorrect type of input. Start over.":CLOSE:GOTO 290 10040 ON ERROR GOTO 0 10050 REM ------- INPUT TO RETURN ----- 10060 PRINT CHR$(7); 1 ' ELECTRONIC CARD FILE 2 ' BY Joe Wiellette 617-731-3178 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 50 DEFINT S,D,L,I,J,K,T,N 60 DEFDBL C 70 WIDTH LPRINT 80 100 ' 110 ' ********* REPORT ********** 120 ' 140 ' 1000 PRINT CLSCR$; 1010 PRINT"1) *** SCREEN 2) PRINTER"; 1020 DEFAULT$="1":ALLOWED$="12":GOSUB 5000:IF ALLOWED=0 THEN 1000 1030 IF Q=2 THEN PRT=1 ELSE PRT=0 2000 ' 2100 ' ******* MAJOR ROUTINE ******** 2110 ' 2120 PRINT CLSCR$ 2122 NUM=1 2124 CALTOT=0 2130 PRINT"Use prepared form (*** NO) ", 2140 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 2130 2150 IF Q$="Y" THEN GOSUB 12000 ELSE GOSUB 13000 2200 INPUT"Enter low record number ",LOW 2210 INPUT"Enter high # (0 for highest) ";HIGH 2212 IF HIGH=0 THEN HIGH=INT(A(6)/A(2)) 2220 PRINT CLSCR$ 2222 ' 2224 ' ****** PRINT HEADING ***** 2226 ' 2230 IF REC$="Y" OR NUM$="Y" THEN IF PRT=1 THEN LPRINT TAB(7); ELSE PRINT TAB(7); 2240 FOR I= 1 TO CH 2242 IF PRT<>1 THEN 2263 2250 IF TYPE(G(I),H(I))<>3 THEN LPRINT LABEL$(G(I),H(I)); 2252 IF TYPE(G(I),H(I))=3 THEN LPRINT SPC(9) LABEL$(G(I),H(I)); 2260 IF TYPE(G(I),H(I))=4 THEN LPRINT SPC(LENGTH(G(I),H(I))-LEN(LABEL$(G(I),H(I)))+1); ELSE LPRINT SPC(9-LEN(LABEL$(G(I),H(I)))); 2261 GOTO 2270 2263 IF TYPE(G(I),H(I))<>3 THEN PRINT LABEL$(G(I),H(I)); 2264 IF TYPE(G(I),H(I))=3 THEN PRINT SPC(9) LABEL$(G(I),H(I)); 2265 IF TYPE(G(I),H(I))=4 THEN PRINT SPC(LENGTH(G(I),H(I))-LEN(LABEL$(G(I),H(I)))+1); ELSE PRINT SPC(9-LEN(LABEL$(G(I),H(I)))); 2270 NEXT I 2280 IF PRT=1 THEN LPRINT ELSE PRINT 2290 IF PRT=1 THEN FOR T=1 TO FLEN+1:LPRINT"-";:NEXT T ELSE FOR T=1 TO FLEN+1:PRINT"-";:NEXT T 2292 ' 2294 ' ******* PRINT DATA ***** 2295 IF PRT=1 THEN LPRINT ELSE PRINT 2296 ' 2300 FOR IV=LOW TO HIGH 2310 IF SORTFILE$<>"Y" THEN I=IV:GOTO 2320 2312 INPUT#1,I,FAKE$:IF IHIGH THEN 2312 2320 GOSUB 16000 :' **** GET RECORD ** 2330 GOSUB 17000 :' **** CONVERT TO FIELDS *** 2340 IF DELETED$<>"A" THEN 2400 2341 GOSUB 15000 : ' **** LIMIT CHECK *** 2342 IF LIMIT.FLAG=1 THEN 2400 2343 IF REC$="Y" THEN IF PRT=1 THEN LPRINT INT((M-1)/A(2)+1)-1; ELSE PRINT INT((M-1)/A(2)+1)-1; 2344 IF NUM$="Y" THEN IF PRT=1 THEN LPRINT NUM;:NUM=NUM+1 ELSE PRINT NUM;:NUM=NUM+1 2390 GOSUB 18000 2392 IF TOTALS$="Y" OR CALC$="Y" THEN GOSUB 4000:'*** SUMS OR CALC **** 2394 IF PRT=1 THEN LPRINT ELSE PRINT 2400 NEXT IV 2500 IF PRT=1 THEN LPRINT:LPRINT ELSE PRINT:PRINT 2510 IF CALC$="Y" THEN IF PRT=1 THEN LPRINT"TOTAL = "CALTOT ELSE PRINT"TOTAL = "CALTOT 2512 IF TOTALS$<>"Y" THEN 2520 2513 FOR R=1 TO TT 2514 IF PRT=1 THEN LPRINT LABEL$(T1(R),T2(R)),CTT(R) ELSE PRINT LABEL$(T1(R),T2(R)),CTT(R) 2516 NEXT R 2520 CLOSE(1) 2540 PRINT:PRINT"1) Return to MENU **** 2550 PRINT"2) Run Report again 2580 DEFAULT$="1":ALLOWED$="12":GOSUB 5000:IF ALLOWED=0 THEN 2540 2590 CLOSE(3) 2600 IF Q=1 THEN RUN"MENU 2620 GOTO 1000 4000 ' 4100 ' ********* SUMS OR CALCULATIONS ************ 4110 ' 4120 IF CALC$<>"Y" THEN 4420 4200 CALC1=VAL(DTA$(C1,C2)):T1=TYPE(C1,C2) 4220 CALC2=VAL(DTA$(C3,C4)):T2=TYPE(C3,C4) 4240 IF FUNC=1 THEN CALC3=CALC1 + CALC2 4260 IF FUNC=2 THEN CALC3=CALC1 - CALC2 4280 IF FUNC=3 THEN CALC3=CALC1 * CALC2 4300 IF FUNC=4 THEN CALC3=CALC1 / CALC2 4320 IF PRT=1 THEN IF TYPE(C1,C2)=3 OR TYPE(C3,C4)=3 THEN LPRINT USING DLR$;CALC3; ELSE LPRINT CALC3; 4322 IF PRT=0 THEN IF TYPE(C1,C2)=3 OR TYPE(C3,C4)=3 THEN PRINT USING DLR$;CALC3; ELSE PRINT CALC3; 4330 CALTOT=CALTOT+CALC3 4400 IF TOTALS$<>"Y" THEN 4600 4420 FOR I=1 TO CH 4430 FOR R=1 TO TT 4450 IF T1(R)=G(I) AND T2(R)=H(I) THEN CTT(R)=CTT(R)+VAL(DTA$(G(I),H(I))) 4460 NEXT R 4470 NEXT I 4600 RETURN 5000 ' 5010 ' ****** ENTRY ROUTINE ***** 5020 ' 5030 PRINT BELL$; 5040 ALLOWED=0 5050 Q$=INPUT$(1) 5060 PRINT Q$ 5070 IF Q$="y" THEN Q$="Y" 5080 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5090 Q=VAL(Q$) 5100 FOR L=1 TO LEN(ALLOWED$) 5110 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5120 NEXT L 5130 RETURN 5140 ' 12000 ' 12100 ' ********** GET PRE-DEFINED REPORT FORM ******* 12110 ' 12120 PRINT CLSCR$; 12200 CH=0:N=1 12220 INPUT"Enter the name of the report file ";REPORT$ 12240 REPORT$=DRIVE$+REPORT$ 12260 OPEN"I",#3,REPORT$ 12270 WHILE N<>0:' ***** GET FIELDS ***** 12272 CH=CH+1 12280 INPUT#3,N 12300 G(CH)=INT(N/100):H(CH)=N-(G(CH)*100) 12330 WEND 12350 INPUT#3,NUM$ 12360 IF NUM$<>"Y" THEN INPUT#3,REC$ 12370 IF NUM$="Y" THEN REC$="N" 12380 IF PRT=1 THEN FLEN=79 ELSE FLEN=51 12400 INPUT#3,LIMIT$ 12420 IF LIMIT$<>"Y" THEN 12600 12440 INPUT#3,N 12450 L1=INT(N/100):L2=N-(L1*100) 12460 IF TYPE(L1,L2)=1 THEN INPUT"Enter target date ",DATE$:GOSUB 20000:L3=DATE:GOTO 12500 12470 IF TYPE(L1,L2)<>4 THEN INPUT"Enter target for field ",L3 ELSE INPUT"Enter target for field ",L3$:L4=1:GOTO 12520 12500 INPUT#3,L4 12520 ' ***** SORT CHECK *** 12600 INPUT#3,SORTFILE$ 12620 IF SORTFILE$<>"Y" THEN 12700 12630 INPUT#3,SORT$ 12640 SORT$=DRIVE$+SORT$ 12650 OPEN"I",#1,SORT$ 12700 ' ***** CALCULATIONS **** 12710 INPUT#3,CALC$ 12720 IF CALC$<>"Y" THEN 12800 12730 INPUT#3,N 12740 C1=INT(N/100):C2=N-(C1*100) 12750 INPUT#3,N 12760 C3=INT(N/100):C4=N-(C3*100) 12770 INPUT#3,FUNC 12800 ' ***** TOTALS **** 12820 INPUT#3,TOTALS$ 12830 IF TOTALS$<>"Y" THEN 12990 12840 TT=1 12850 INPUT#3,N 12860 T1(TT)=INT(N/100):T2(TT)=N-(T1(TT)*100) 12870 IF T1(TT)=0 THEN TT=TT-1:GOTO 12910 12890 TT=TT+1 12900 GOTO 12850 12910 ' 12920 ' 12990 RETURN 13000 ' 13010 ' ******* ENTER FORMAT FOR PRINTING ********* 13020 ' 13100 GOSUB 14000 :' ** PRINT HEADER LISTING TO SHOW CHOICES ** 13110 ' CH=COUNTER ... G(CH),H(CH) 13120 CH=0 13130 PRINT" ENTER FIELD CHOICES 13132 N=1 13140 WHILE N<>0 13142 CH=CH+1 13150 PRINT"(0 to end..99 to re-display choices) # "CH" "; 13152 INPUT N 13160 IF N=99 THEN GOSUB 14000:CH=CH-1 13170 G(CH)=INT(N/100):H(CH)=N-(G(CH)*100) 13180 WEND 13200 ' 13210 ' ******** FIND TOTAL LINE WIDTH *********** 13220 ' 13230 PRINT"Do you want numbering of the list (*** YES) "; 13240 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13230 13242 NUM$=Q$ 13250 IF NUM$<>"Y" THEN PRINT"Do you want record #'s printed (*** YES) ";: DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:PRINT Q$:REC$=Q$:IF ALLOWED=0 THEN 13250 13260 IF NUM$="Y" THEN REC$="N" 13270 IF PRT<>1 THEN FLEN=51 ELSE FLEN=79 13300 ' 13310 ' ******* ESTABLISH FIELD LIMITS ******** 13320 ' 13330 PRINT"Do you wish to set limits (*** NO) "; 13340 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13330 13350 LIMIT$=Q$ 13360 IF LIMIT$<>"Y" THEN 13500 13370 GOSUB 14000 13380 INPUT"Enter field to limit ",N 13390 L1=INT(N/100):L2=N-(L1*100) 13400 IF TYPE(L1,L2)=1 THEN INPUT"Enter target date ",DATE$:GOSUB 20000:L3=DATE:GOTO 13430 13410 IF TYPE(L1,L2)<>4 THEN INPUT"Enter target for field ",L3 ELSE INPUT"Enter target for field ",L3$:L4=1:GOTO 13450 13430 PRINT"1) Equal to 2) Low limit 3) High limit (** 1) "; 13440 DEFAULT$="1":ALLOWED$="123":GOSUB 5000:IF ALLOWED=0 THEN 13430 13442 L4=Q 13450 ' 13500 ' ****** SORT CHECK ******** 13510 ' 13520 PRINT"Do you wish to use a sort key file (*** NO) "; 13530 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13520 13540 IF Q$<>"Y" THEN 13700 ELSE SORTFILE$="Y" 13550 INPUT"Enter name of sort key file ",SORT$ 13552 SORT$=DRIVE$+SORT$ 13560 OPEN"I",#1,SORT$ 13630 ' 13700 ' ***** CALCULATIONS OPTION ****** 13710 ' 13720 PRINT"Do you wish to calculate within records (** NO)"; 13730 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13720 13740 IF Q$<>"Y" THEN 13800 ELSE CALC$="Y" 13750 INPUT"Enter first field for calculation ",N 13760 C1=INT(N/100):C2=N-(C1*100) 13770 INPUT"Enter second field for calculation ",N 13780 C3=INT(N/100):C4=N-(C3*100) 13790 PRINT"1) Add 2) Subtract 3) Multiply 4) Divide 13792 PRINT" (first by/from second) (*** 1) "; 13794 DEFAULT$="1":ALLOWED$="1234":GOSUB 5000:IF ALLOWED=0 THEN 13790 13796 FUNC=Q 13800 PRINT"Do you want to total any fields (*** NO) "; 13810 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13800 13820 TOTALS$=Q$ 13830 IF TOTALS$<>"Y" THEN 13990 13840 TT=1 13850 PRINT"Enter field to be totaled 13852 INPUT" (0 to end, 99 to re-list fields) ";N 13860 T1(TT)=INT(N/100):T2(TT)=N-(T1(TT)*100) 13870 IF T1(TT)=0 THEN TT=TT-1:GOTO 13920 13880 IF T1(TT)=99 THEN GOSUB 14000:GOTO 13850 13890 TT=TT+1 13892 GOTO 13850 13900 PRINT CLSCR$ 13920 FOR I=1 TO TT 13930 PRINT I,LABEL$(T1(I),T2(I)) 13940 NEXT I 13950 PRINT"Are these correct (*** YES) "; 13960 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13950 13970 IF Q$="Y" THEN 13990 ELSE 13800 13990 RETURN 14000 ' 14010 ' ********* DISPLAY HEADER LISTINGS *********** 14020 ' 14030 PRINT CLSCR$ 14040 FOR I=1 TO A(2) 14050 FOR J= 1 TO F(I) 14060 FIELDS=(I*100)+J 14070 PRINT FIELDS" "LABEL$(I,J) 14080 NEXT J 14090 NEXT I 14100 RETURN 15000 ' 15100 ' ******** LIMIT CHECK ********* 15110 ' 15120 LIMIT.FLAG=0 15130 CDTA=VAL(DTA$(L1,L2)) 15200 IF LIMIT$<>"Y" THEN 15500 15220 IF L4=1 AND TYPE(L1,L2)=4 AND LEFT$(L3$,4)=LEFT$(DTA$(L1,L2),4) THEN 15500 15240 IF L4=1 AND TYPE(L1,L2)<>4 AND L3=CDTA THEN 15500 15260 IF L4=2 AND L3CDTA THEN 15500 15300 LIMIT.FLAG=1:' 1=do not PRINT THE DATA 15500 RETURN 16000 ' 16100 ' ****** GET CORRECT RECORD ********** 16110 ' 16200 I=(I*A(2))-A(2)+1 16210 FOR M=I TO I+A(2)-1 16220 IF M=0 THEN 16260 16230 GET#2,M 16240 MM=M-I+1 16250 S$(MM)=RECORD$ 16260 NEXT M 16270 RETURN 17000 ' 17100 ' ********* CONVERT RECORD INTO FIELDS ********* 17110 ' 17200 LN=2 17210 DELETED$=LEFT$(S$(MM),1) 17220 FOR F=1 TO A(2) 17230 M$=S$(F) 17240 IF M$="" THEN 17300 17250 FOR J=1 TO F(F) 17260 ON TYPE(F,J) GOSUB 17320,17360,17380,17400 17270 LN=LN+LENGTH(F,J) 17280 NEXT J 17290 LN=2 17300 NEXT F 17310 RETURN 17320 ' *** DATE CONVERT ** 17322 DATE$=M$ 17330 GOSUB 20200 17340 DTA$(F,J)=STR$(CVI(MID$(M$,LN,LENGTH(F,J)))) 17350 RETURN 17360 DTA$(F,J)=STR$(CVS(MID$(M$,LN,LENGTH(F,J)))) 17370 RETURN 17380 DTA$(F,J)=STR$(CVD(MID$(M$,LN,LENGTH(F,J)))) 17390 RETURN 17400 DTA$(F,J)=MID$(M$,LN,LENGTH(F,J)) 17410 RETURN 18000 ' 18010 ' ****** ACTUAL FIELD PRINTING ******* 18012 IF REC$="Y" OR NUM$="Y" THEN IF PRT=1 THEN LPRINT TAB(7); ELSE PRINT TAB(7); 18020 ' 18022 FOR I=1 TO CH 18030 ON TYPE(G(I),H(I)) GOSUB 18050,18090,18120,18150 18032 NEXT I 18040 RETURN 18050 JULIAN = VAL(DTA$(G(I),H(I))):GOSUB 20250 18060 IF VAL(DTA$(G(I),H(I)))>0 THEN IF PRT=1 THEN LPRINT USING"###";MONTH,DAY,YEAR;:LPRINT" "; ELSE PRINT USING"###";MONTH,DAY,YEAR;:PRINT" "; 18070 RETURN 18080 ' 18090 IF PRT=1 THEN LPRINT VAL(DTA$(G(I),H(I)));:LPRINT" "; ELSE PRINT VAL(DTA$(G(I),H(I)));:PRINT" "; 18100 RETURN 18110 ' 18120 IF PRT=1 THEN LPRINT USING DLR$;VAL(DTA$(G(I),H(I)));:LPRINT" "; ELSE PRINT USING DLR$;VAL(DTA$(G(I),H(I)));:PRINT" "; 18130 RETURN 18140 ' 18150 IF PRT=1 THEN LPRINT DTA$(G(I),H(I))" "; ELSE PRINT DTA$(G(I),H(I))" "; 18160 RETURN 20000 ' 20010 ' *********** CONVERT CALANDAR TO JULIAN *********** 20020 ' 20030 MONTH=VAL(LEFT$(DATE$,2)) 20040 DAY=VAL(MID$(DATE$,3,2)) 20050 YEAR=VAL(RIGHT$(DATE$,2)) 20060 DATE=INT(30.57*MONTH)+INT(365.25*YEAR-395.25)+DAY 20070 IF(INT(YEAR/4)*4)+1=YEAR THEN DATE=DATE-1 20080 IF MONTH<3 THEN DATE=DATE+1 ELSE IF INT(YEAR/4)*4=YEAR THEN 20090 ELSE DATE=DATE-1 20090 IF DATE>32500 THEN DATE=32500-DATE 20100 RETURN 20200 ' 20210 ' ********* CONVERT JULIAN TO CALANDAR *********** 20220 IF DATE$="" THEN RETURN 20230 JULIAN=CVI(MID$(DATE$,LN,LENGTH(F,J))) 20240 IF JULIAN<0 THEN JULIAN=32500-JULIAN 20250 YEAR=INT(JULIAN/365.26)+1 20260 DAY=JULIAN+INT(395.25-365.25*YEAR) 20270 D1=2:IF INT(YEAR/4)*4=YEAR THEN D1=1 20280 IF DAY>91 THEN DAY=DAY+D1 20290 MONTH=INT(DAY/30.57):DAY=DAY-INT(30.57*MONTH) 20300 RETURN (YEAR/4)*4=YEAR THEN D1=1 20280 1 ' ELECTRONIC CARD FILE 2 ' BY Joe Wiellette 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 50 DEFINT S,L,K,I,J,K,T,Q 100 ' ******** REPT-FRM ******** 110 ' 120 ' 130 CH=0:N=1 140 CLOSE 200 PRINT CLSCR$ 220 PRINT"1) Create LABEL form 222 PRINT"2) *** Create REPORT form 224 PRINT"3) Return to MENU 230 PRINT"Which ", 240 DEFAULT$="2":ALLOWED$="123":GOSUB 5000: IF ALLOWED=0 THEN 200 260 IF Q=1 THEN GOSUB 2000 270 IF Q=2 THEN GOSUB 1000 272 IF Q=3 THEN 300 302 CLOSE 310 RUN"MENU 1000 ' 1010 ' ********* CREATE REPORT FORM ******** 1012 PRINT CLSCR; 1020 ' 1120 INPUT"Enter the file name for this report form ";REPORT$ 1140 REPORT$=DRIVE$+REPORT$ 1160 OPEN"O",#3,REPORT$ 1170 GOSUB 4000:' *** PRINT FIELDS *** 1180 WHILE N<>0:' ***** GET FIELDS ***** 1200 CH=CH+1 1220 PRINT"Enter field # for choice #"CH; 1240 INPUT N 1250 PRINT#3,N 1260 WEND 1300 ' 1310 ' ***** NUMBERING/RECORD #'S/LIMITS ****** 1330 ' 1350 PRINT"Do you want list numbering (*** YES) "; 1360 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 1350 1370 PRINT#3,Q$ 1380 IF Q$="Y" THEN 1450 1390 PRINT"Do you want record #'s printed (**YES) "; 1400 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 1390 1410 PRINT#3,Q$ 1450 PRINT"Do you wish to set limits (** NO) "; 1460 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 1450 1470 PRINT#3,Q$ 1480 IF Q$<>"Y" THEN 1600 1490 GOSUB 4000 1500 PRINT:INPUT"Enter field to limit ",N 1510 PRINT#3,N 1520 PRINT"1)** Equal 2) Low limit 3) High limit "; 1530 DEFAULT$="1":ALLOWED$="123":GOSUB 5000: IF ALLOWED=0 THEN 1520:L4=Q 1550 PRINT#3,Q 1600 ' 1610 ' ***** SORT CHECK ****** 1620 ' 1650 PRINT"Do you want a sort key (** NO) "; 1660 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 1650 1670 PRINT#3,Q$ 1680 IF Q$<>"Y" THEN 1750 1690 INPUT"Enter name of sort key file ";SORT$ 1700 PRINT#3,SORT$ 1750 ' 1760 ' ******* CALCULATIONS AND TOTALS ***** 1770 ' 1800 PRINT"Calculate within records (** NO) "; 1810 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 1800 1820 PRINT#3,Q$ 1830 IF Q$<>"Y" THEN 1900 1840 PRINT:INPUT"Enter first field for calculation ",N 1850 PRINT#3,N 1860 PRINT:INPUT"Enter second field for calculation ",N 1870 PRINT#3,N 1880 PRINT"1)** Add 2) Subtract 3) Multiply 1882 PRINT"4) Divide (first by/from second) "; 1884 DEFAULT$="1":ALLOWED$="1234":GOSUB 5000: IF ALLOWED=0 THEN 1880 1890 PRINT#3,Q 1900 PRINT"Total any fields (*** NO) "; 1910 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 1900 1920 PRINT#3,Q$ 1930 IF Q$<>"Y" THEN 1990 1940 PRINT:INPUT"Enter field to be totaled (0 to end) ",N 1960 PRINT#3,N 1962 IF N=0 THEN 1990 1970 GOTO 1940 1990 RETURN 2000 ' 2010 ' ********* CREATE LABEL FORM ******** 2020 ' 2030 PRINT CLSCR$ 2100 INPUT"Enter file name for Label form ";REPORT$ 2110 REPORT$=DRIVE$+REPORT$ 2130 OPEN"O",#3,REPORT$ 2132 PRINT#3,"Y" 2140 GOSUB 4000 2142 FIELDS=0 2150 FIELDCOUNT=0:LINENUM=1:LINES(1)=0:Q$="Y":R$="Y" 2200 WHILE R$="Y" 2220 WHILE Q$="Y" 2230 LINES(LINENUM)=LINES(LINENUM)+1 2240 FIELDCOUNT = FIELDCOUNT + 1 2260 PRINT"Enter field choice for line "LINENUM; 2270 WHILE FIELDS<100 : INPUT FIELDS :WEND 2280 PRINT#3,FIELDS 2290 FIELDS=0 2300 PRINT"Any more this line (**YES) "; 2320 DEFAULT$="Y":ALLOWED$="YyNn": GOSUB 5000:IF ALLOWED=0 THEN 2300 2322 PRINT#3,Q$ 2340 WEND :' *** END OF Q LOOP FOR ONE LINE *** 2360 PRINT"Any more lines (** YES) "; 2670 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 2360 2671 R$=Q$:Q$="Y" 2672 PRINT#3,R$ 2680 LINENUM=LINENUM + 1 2690 LINES(LINUM)=0 2700 WEND :' **** LAST LINE OF LABEL ***** 2750 ' 2760 ' ***** CHECK FOR LIMITS ****** 2770 ' 2800 PRINT CLSCR$ 2810 PRINT"Do you wish to set limits (*** NO) "; 2820 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 2810 2830 PRINT#3,Q$ 2840 IF Q$<>"Y" THEN 3000 2860 INPUT"Enter field to limit ",FIELDS 2870 PRINT#3,FIELDS 2880 PRINT"1) ** Equal 2) Low limit 3) High limit ": 2882 DEFAULT$="1":ALLOWED$="123":GOSUB 5000: IF ALLOWED=0 THEN 2880:L4=Q 2890 PRINT#3,Q 3000 ' 3010 ' ****** CHECK FOR SORT ****** 3020 ' 3100 PRINT"Use a sort key file (*** NO) "; 3110 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 3100 3120 PRINT#3,Q$ 3130 IF Q$<>"Y" THEN 3400 3150 INPUT"Enter name of sort key file ",SORT$ 3160 PRINT#3,SORT$ 3400 CLOSE(3) 3420 RETURN 4000 ' 4010 ' ******** DISPLAY HEADER LISTINGS ******* 4020 ' 4030 PRINT CLSCR$ 4040 FOR I=1 TO A(2) 4050 FOR J=1 TO F(I) 4060 FIELDS=(I*100)+J 4070 PRINT FIELDS" "LABEL$(I,J) 4080 NEXT J 4090 NEXT I 4100 RETURN 5000 ' 5010 ' ****** INPUT ******** 5020 ' 5030 PRINT BELL$; 5040 ALLOWED=0 5050 Q$=INPUT$(1) 5060 PRINT Q$ 5070 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5080 Q=VAL(Q$) 5090 FOR L=1 TO LEN(ALLOWED$) 5100 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5110 NEXT L 5120 RETURN 5130 ' 5140 ' AL(Q$) 5090 FOR L=1 TO LEN(ALLOWED$) 5100 IF MID$(ALLOWED$ limit ": 2882 DEFAULT$="1":ALLOWED$="123":GOSUB 5000: IF ALLOWED=0 THEN 2880:L4=Q 2890 PRINT#3,Q 3000 ' 3010 ' ****** CHECK FOR SORT ****** 3020 ' 3100 PRINT"Use a sort key file (*** NO) "; 3110 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000: IF ALLOWED=0 THEN 3100 3120 PRINT#3,Q$ 3130 IF Q$<>"Y" THEN 3400 3150 INPUT"Enter name of sort key file ",SORT$ 3160 PRINT#3,SORT$ 3400 CLOSE(3) 3420 RETURN 4000 ' 4010 ' ******** DISPLAY HEADER LISTINGS ******* 4020 ' 4030 PRINT CLSCR$ 4040 FOR I=1 TO A(2) 4050 FOR J=1 TO F(I) 4060 FIELDS=(I*100)+J 4070 PRINT FIELDS" "LABEL$(I,J) 4080 NEXT J 4090 NEXT I 4100 RETURN 5000 ' 5010 ' ****** INPUT ******** 5020 ' 5030 PRINT BELL$; 5040 ALLOWED=0 5050 Q$=INPUT$(1) 5060 PRINT Q$ 5070 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5080 Q=VAL(Q$) 5090 FOR L=1 TO LEN(ALLOWED$) 5100 IF MID$(ALLOWED$1 ' ELECTRONIC CARD FILE 2 ' BY Joe Wiellette 617-731-3178 3 ' Permission is granted to use, but not to sell, 4 ' these programs. 10 REM ---------------- SORT (DATABASE) -------------- 50 DEFINT S,L,D,I,J,K,T,B 60 DIM B(A(6)/A(2)-1),B$(A(6)/A(2)-1) 80 K=1 90 PRINT CLSCR$; 240 REM ------------ OPEN RECORD FILES ------------- 310 INPUT"Enter a name for the sort key file ";SORT$ 320 SORT$=DRIVE$+SORT$ 330 OPEN"O",#1,SORT$ 500 GOSUB 4000:REM ------ SHOW HEADER LISTING -------- 520 GOSUB 4090: REM -------- GET FIELD CHOICE -------- 530 INPUT"Enter lowest record # ";LOW 590 INPUT"Enter highest record # (0 for highest) ";HIGH 592 IF HIGH=0 THEN HIGH=A(6)/A(2)-1 600 FOR IV=LOW TO HIGH 610 I=IV 620 GOSUB 4640:REM ----------- LOAD RECORDS ------------ 630 GOSUB 4720:REM ------------- CONVERT RECORD INTO FIELDS ----------- 640 IF DELETED$<>"A" THEN 670 650 GOSUB 4190:REM ----- COMBINE FIELDS ----------- 670 NEXT IV 680 PRINT"************ NOW SORTING ***************** 700 GOSUB 4290:REM --------- SORT ------------- 750 GOSUB 4580:REM ------ PRINT AND SAVE SORT ------ 900 PRINT"END OF SORT" 902 GOSUB 6000:' *** ATTENTION BELL ** 910 PRINT:PRINT 920 PRINT"1) *** RETURN TO MENU 930 PRINT"2) END 940 PRINT" Which "; 950 DEFAULT$="1":ALLOWED$="12":GOSUB 5000: IF ALLOWED=0 THEN 910 960 IF Q$="1" THEN RUN"MENU 970 END 980 ' 990 ' 4000 REM ----------- SHOW HEADER LISTING ------------ 4010 PRINT CLSCR$; 4020 FOR I=1 TO A(2) 4030 FOR J=1 TO F(I) 4040 N=(I*100)+J 4050 PRINT N" "LABEL$(I,J) 4060 NEXT J 4070 NEXT I 4080 RETURN 4090 REM --------------- GET FIELD CHOICE ------------- 4100 REM--CH=COUNTER...G(CH),H(CH) 4110 CH=1 4120 PRINT"Enter field choice for sort "CH; 4130 INPUT"(Enter 0 to end or 99 to display fields) ";N 4140 G(CH)=INT(N/100):H(CH)=N-(G(CH)*100) 4150 IF N=0 THEN CH=CH-1:RETURN 4160 IF N=99 THEN GOSUB 4000:GOTO 4120 4170 CH=CH+1 4180 GOTO 4120 4190 REM ------------- COMBINE FIELDS --------------- 4200 SEARCH$="" 4210 FOR M=1 TO CH 4220 SEARCH$=SEARCH$+DTA$(G(M),H(M)) 4230 NEXT M 4240 B$(K)=SEARCH$ 4250 B(K)=IV 4260 PRINT K,B$(K):K=K+1 4270 RETURN 4280 REM 4290 REM ------------- SORT ------------------- 4300 T=HIGH-LOW +2 4310 N=T-1 4320 L=INT(N/2)+1 4330 N1=N 4340 IF L=1 THEN 4380 4350 L=L-1 4360 A$=B$(L):B=B(L) 4370 GOTO 4430 4380 A$=B$(N1):B=B(N1) 4390 B$(N1)=B$(1):B(N1)=B(1) 4400 N1=N1-1 4410 PRINT N1; 4420 IF N1=1 THEN 4550 4430 J=L 4440 I=J 4450 J=2*J 4460 IF J=N1 THEN 4500 4470 IF J>N1 THEN 4530 4480 IF B$(J)>=B$(J+1) THEN 4500 4490 J=J+1 4500 IF A$=>B$(J) THEN 4530 4510 B$(I)=B$(J):B(I)=B(J) 4520 GOTO 4440 4530 B$(I)=A$:B(I)=B 4540 GOTO 4340 4550 B$(1)=A$:B(1)=B 4560 REM --- END SORT 4570 RETURN 4580 REM -------------- PRINT AND SAVE SORT --------------- 4590 FOR I=1 TO HIGH-LOW+1 4600 PRINT I,B(I),B$(I) 4610 WRITE#1,B(I),B$(I) 4620 NEXT I 4630 RETURN 4640 REM ----------------- LOAD RECORDS ------------ 4650 I=(I*A(2))-A(2)+1 4660 FOR M=I TO I+A(2)-1 4670 GET#2,M 4680 MM=M-I+1 4690 MM$(MM)=RECORD$ 4700 NEXT M 4710 RETURN 4720 REM -------------- CONVERT RECORD INTO FIELDS --------------- 4730 LN=2 4740 DELETED$=LEFT$(MM$(1),1) 4750 FOR F=1 TO A(2) 4760 S$=MM$(F) 4770 FOR J=1 TO F(F) 4780 ON TYPE(F,J) GOSUB 4840,4870,4870,4890 4790 LN=LN+LENGTH(F,J) 4800 NEXT J 4810 LN=2 4820 NEXT F 4830 RETURN 4840 REM --- CONVERT S$ TO DTA$(F,J) 4850 DTA$(F,J)=STR$(CVI(MID$(S$,LN,LENGTH(F,J)))) 4860 RETURN 4870 DTA$(F,J)=STR$(CVS(MID$(S$,LN,LENGTH(F,J)))) 4880 RETURN 4890 DTA$(F,J)=MID$(S$,LN,LENGTH(F,J)) 4900 RETURN 5000 ' 5010 ' ***** INPUT ***** 5020 ' 5030 PRINT BELL$; 5040 ALLOWED=0 5050 Q$=INPUT$(1) 5060 PRINT Q$ 5070 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5080 Q=VAL(Q$) 5090 FOR L=1 TO LEN(ALLOWED$) 5100 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5110 NEXT L 5120 RETURN 5130 ' 5140 ' 6000 ' 6010 ' **** ATTENTION BELL *** 6020 ' 6030 PRINT" Tap any key to continue " 6100 PRINT BELL$; 6110 FOR K=1 TO 300 6120 A$=INKEY$ 6130 IF A$<>"" THEN 6500 6140 NEXT K 6160 GOTO 6100 6500 RETURN " 6100 PRINT BELL$; 6110 FOR K=1 TO 300 6120 A$=INKEY$ 6130 IF A$<>"" THEN=2 4740 DELETED$=LEFT$(MM$(1),1) 4750 FOR F=1 TO A(2) 4760 S$=MM$(F) 4770 FOR J=1 TO F(F) 4780 ON TYPE(F,J) GOSUB 4840,4870,4870,4890 4790 LN=LN+LENGTH(F,J) 4800 NEXT J 4810 LN=2 4820 NEXT F 4830 RETURN 4840 REM --- CONVERT S$ TO DTA$(F,J) 4850 DTA$(F,J)=STR$(CVI(MID$(S$,LN,LENGTH(F,J)))) 4860 RETURN 4870 DTA$(F,J)=STR$(CVS(MID$(S$,LN,LENGTH(F,J)))) 4880 RETURN 4890 DTA$(F,J)=MID$(S$,LN,LENGTH(F,J)) 4900 RETURN 5000 ' 5010 ' ***** INPUT ***** 5020 ' 5030 PRINT BELL$; 5040 ALLOWED=0 5050 Q$=INPUT$(1) 5060 PRINT Q$ 5070 IF Q$=CHR$(13) THEN Q$=DEFAULT$ 5080 Q=VAL(Q$) 5090 FOR L=1 TO LEN(ALLOWED$) 5100 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1 5110 NEXT L 5120 RETURN 5130 ' 5140 ' 6000 ' 6010 ' **** ATTENTION BELL *** 6020 ' 6030 PRINT" Tap any key to continue " 6100 PRINT BELL$; 6110 FOR K=1 TO 300 6120 A$=INKEY$ 6130 IF A$<>"" THEN20 N%=0:FILENAME$="" 30 PRINT CHR$(26);"*REVISED 20 FEB 1982*" 40 A=52 60 NT%=500 95 DIM D$(500) 100 REM 27 SEPT 81 ***TEXT EDITOR*********** 110 NC%=21:DIM C$(21):CS%=0 120 FOR I%=1 TO NC%:READ C$(I%):NEXT I% 160 DATA ADD,DELETE,LIST,LOAD 170 DATA QUIT,SAVE,DITTO,NEXT,SCRATCH 171 DATA INSERT,FIND,CHANGE,SUBLIST,TOP 172 DATA LINE,PRINT,BACK 173 DATA KILL,RENAME,LOAD UNDOC,GLOBAL CHANGE 180 PRINT:PRINT"COMMANDS ARE:" 190 I1=1:FOR I%=1 TO NC%:PRINT C$(I%); 191 IF I%=3*INT(I%/3)THEN 195 192 IF I%=I1 THEN PRINT TAB(17)::I1=I1+3:GOTO 196 193 PRINT TAB(34);:GOTO 196 195 PRINT 196 NEXT I% 200 PRINT:PRINT:GOSUB 8950 201 LINE INPUT"COMMAND: ";A$:GOSUB 8965 203 IF LEN(A$)<1 THEN 180 205 X=0 207 FOR I%=1 TO NC% 209 IF LEN(A$)>LEN(C$(I%))THEN 230 211 IF A$<>LEFT$(C$(I%),LEN(A$))THEN 230 212 IF LEN(A$)=LEN(C$(I%))THEN 250 213 IF X>0 THEN 180 215 X=I% 230 NEXT I%:I%=X 240 IF I%=0 THEN 180 250 ON I% GOTO 500,1000,1500,2000,2500 260 I%=I%-5:ON I% GOTO 3000,3500,4000,4500,5000 270 I%=I%-5:ON I% GOTO 5500,6000,6500,7000,7500 280 I%=I%-5:ON I% GOTO 8000,4750,8750,9000,10000 290 I%=I%-5:ON I% GOTO 11000 400 GOTO 180 500 PRINT"USE '/' TO TERMINATE":REM ADD DATA 520 IF N%<500 THEN 530 522 PRINT"DATA DUMP REQ'D":GOTO 200 530 LINE INPUT D$(N%+1) 540 IF D$(N%+1)="/" THEN 7000 550 N%=N%+1:GOTO 520 1000 IF CS%>=1 THEN 1030:REM *DELETE* 1012 PRINT"NO LINE PRESENT!":GOTO 200 1020 IF CS%>N% THEN 1012 1030 GOSUB 8925 1050 PRINT:PRINT"DELETE IT"; 1060 INPUT A$:GOSUB 8965:Q$="YN":GOSUB 8910 1080 ON Q% GOTO 1100,200,1030 1100 IF CS%=N% THEN 1200 1110 FOR I%=CS% TO (N%-1) 1120 D$(I%)=D$(I%+1) 1130 NEXT I%:GOSUB 8960 1140 N%=N%-1 1150 GOTO 1020 1200 N%=N%-1:CS%=CS%-1:PRINT" *DONE*" 1220 GOSUB 8925:GOTO 200 1500 FOR I%=1 TO 20:PRINT:NEXT I%:REM *LIST* 1520 CL=0 1530 CL=CL+1:PRINT D$(CL) 1550 IF CL=10*INT(CL/10) THEN 1600 1560 IF CL0 THEN 1650 1646 GOTO 7000 1650 GOSUB 8925:GOTO 200 2000 REM *LOAD DATA * 2002 RESET:PRINT:PRINT"drive a:":FILES "A:*.*":PRINT 2004 PRINT:PRINT"drive b:":FILES "B:*.*":PRINT:PRINT 2010 INPUT"DRIVE (A or B)";DR$ 2015 A$=DR$:GOSUB 8965:DR$=A$ 2020 IF DR$<>"A" AND DR$<>"B" THEN 2010 2025 RESET 2030 LINE INPUT"FILENAME (NAME.TYP)";FILENAME$ 2040 A$=FILENAME$:GOSUB 8965:FILENAME$=DR$+":"+A$ 2060 OPEN "I",#1,FILENAME$ 2070 IF EOF(1)THEN 2300 2080 IF N%>=500 THEN 2350 2090 N%=N%+1:LINE INPUT #1,D$(N%) 2100 GOTO 2070 2300 RESET 2310 GOSUB 8955:GOTO 7000 2350 PRINT:PRINT"**CANNOT LOAD ENTIRE FILE**" 2360 GOTO 2300 2500 INPUT"REALLY WANT TO QUIT NOW";A$:GOSUB 8965 2520 Q$="YN":GOSUB 8910 2530 ON Q% GOTO 2550,200,2500 2550 PRINT"*REMOUNT SYSTEM DISK AND HIT return*" 2560 LINE INPUT A$:SYSTEM 3000 REM ***SAVE**** 3010 PRINT:PRINT"READY TO SAVE DATA ON DISK" 3020 PRINT:PRINT"CURRENT FILENAME IS ";FILENAME$ 3030 INPUT"CHANGE THE FILENAME";A$ 3040 A$=LEFT$(A$,1):GOSUB 8965 3050 Q$="YN":GOSUB 8910 3060 ON Q% GOTO 3070,3120,3020 3070 INPUT"DRIVE (A or B)";A$:A$=LEFT$(A$,1):GOSUB 8965 3080 DR$=A$:IF DR$<>"A" AND DR$<>"B" THEN 3070 3085 RESET:FILES (DR$+":*.*"):PRINT 3090 LINE INPUT"FILENAME (NAME.TYP)";A$:GOSUB 8965 3100 FILENAME$=DR$+":"+A$ 3120 RESET:OPEN "O",#1,FILENAME$ 3130 FOR I%=1 TO N% 3140 PRINT #1,D$(I%) 3150 NEXT I% 3160 RESET 3170 GOSUB 8955:GOTO 7000 3500 GOSUB 8925:REM *DITTO* 3520 PRINT"*READY TO DITTO BELOW THIS LINE*" 3570 Q$="!C&":CT=CS% 3580 PRINT:PRINT"LINES TO BE DITTO'D:" 3600 INPUT"FIRST #";S0% 3610 INPUT"LAST #";S1% 3640 IF S0%<1 OR S1%>N% THEN 3800 3644 IF CS%=N% THEN 3850 3650 IF S1%-S0%+N%+1>500 THEN 3800 3655 IF S0%<=CS% AND S1%>=CS% THEN 3820 3656 L1=CS%:L=S0% 3660 FOR K=0 TO S1%-S0% 3670 A$=D$(L):GOSUB 5101 3684 L=L+1:IF S0%>CT THEN L=L+1 3688 NEXT K 3690 PRINT TAB(5);"**DONE**" 3710 GOSUB 8925:Q$="" 3720 GOTO 200 3800 PRINT"*IMPOSSI%BLE!*" 3810 GOTO 3710 3820 PRINT"*MAY NOT OVERLAP CURRENT LINE!*" 3840 GOTO 3710 3850 FOR K=0 TO S1%-S0%:D$(N%+1)=D$(S0%+K) 3870 N%=N%+1:NEXT K 3890 GOTO 3690 4000 IF CS%500 THEN 5220 5105 IF Q$="!C&" THEN 5120 5110 LINE INPUT A$:IF A$="/" THEN 5230 5120 N%=N%+1 5140 FOR I%=(N%+1) TO (CS%+2) STEP -1 5150 D$(I%)=D$(I%-1):NEXT I%:GOSUB 8960 5170 CS%=CS%+1:D$(CS%)=A$ 5190 IF Q$="!C&" THEN RETURN 5210 GOTO 5101 5220 PRINT"DATA DUMP REQ'D" 5230 GOSUB 8925:GOTO 200 5500 REM *FIND STRING* 5510 C%=0:GOSUB 5520:CS%=X1%:GOSUB 8925:GOTO 200 5520 LINE INPUT"STRING TO BE FOUND: ",S0$ 5530 X%=CS%:X1%=0:'subroutine entry point 5540 WHILE X%0 THEN PRINT D$(X1%):GOTO 5620 5610 IF C%=0 THEN PRINT"*NO FIND* '"S0$"'" 5620 RETURN 6000 GOSUB 8925:REM *CHANGE CURRENT* 6006 IF CS%=0 THEN 7000 6010 PRINT"STRING TO BE CHANGED" 6020 LINE INPUT A$:S0$=A$ 6030 L0=LEN(S0$):LD=LEN(D$(CS%)) 6040 IF L0>LD THEN 6010 6050 FOR I%=1 TO LD 6060 IF S0$=MID$(D$(CS%),I%,L0) THEN 6200 6070 IF I%+L0-1>=LD THEN 6090 6080 NEXT I% 6090 PRINT"NO FIND '";S0$;"'" 6100 PRINT"IN STRING:" 6110 GOTO 200 6200 IF I%>1 THEN 6220 6210 S1$="":GOTO 6230 6220 S1$=LEFT$(D$(CS%),(I%-1)) 6230 IF LD-I%-L0+1>0 THEN 6250 6240 S2$="":GOTO 6260 6250 S2$=RIGHT$(D$(CS%),(LD-I%-L0+1)) 6260 PRINT"WHAT DO YOU WANT" 6261 PRINT"'";S0$;"'":PRINT" TO BECOME" 6263 LINE INPUT A$:S0$=A$:D$(CS%)=S1$+S0$ 6270 D$(CS%)=D$(CS%)+S2$ 6280 GOSUB 8925:GOTO 200 6500 PRINT:INPUT"# LINES TO LIST";NZ% 6520 IF NZ%<1 THEN 6500 6530 INPUT"PRINT LINE #'S WITH EACH LINE";A$:GOSUB 8965 6536 Q$="YN":GOSUB 8910:ON Q% GOTO 6540,6540,6530 6540 FOR I%=CS% TO NZ%+CS%:ON Q% GOTO 6546,6550 6546 PRINT I%; 6550 CS%=I%:GOSUB 8927:IF I%=N% THEN 6650 6580 NEXT I% 6650 GOSUB 8925:GOTO 200 7000 PRINT:PRINT" *TOP OF STACK*":CS%=0 7030 GOSUB 8925:GOTO 200 7500 INPUT"LINE #";NZ% 7510 IF NZ%<1 THEN 7000 7530 IF NZ%>N% THEN NZ%=N% 7540 CS%=NZ%:GOSUB 8925:GOTO 200 8000 REM *PRINT * 8004 INPUT"CHAR WIDTH (NORMAL, CONDSD)";A$:GOSUB 8965 8005 Q$="NC":GOSUB 8910:CW=Q%:IF Q%>3 THEN 8004 8007 INPUT"DENSITY (NORM,EMPH,DBL)";A$:GOSUB 8965 8008 Q$="NED":GOSUB 8910:DE=Q%:IF Q%>3 THEN 8007 8010 INPUT"PRINT ENTIRE FILE";A$:GOSUB 8965 8020 Q$="YN":GOSUB 8910:ON Q% GOTO 8070,8040,8010 8040 INPUT"1ST LINE #";S0% 8050 INPUT"LAST LINE #";S1% 8060 GOTO 8071 8070 S0%=1:S1%=N% 8071 INPUT"DOUBLE-WIDTH CHARACTERS";A$:GOSUB 8965 8072 Q$="NY":GOSUB 8910:DW=Q%:IF Q%>2 THEN 8071 8075 IF CW=2 AND DE=2 THEN DE=3 8080 IF S0%<1 OR S0%>N% THEN 200 8090 IF S1%N% THEN S1%=N% 8095 INPUT"AUTO FORM FEED";A$:GOSUB 8965 8096 Q$="YN":GOSUB 8910:IF Q%>2 THEN 8095 8106 PRINT:PRINT:YL=0 8110 PRINT TAB(5);"*TURN ON PRINTER, HIT RETURN*" 8120 LINE INPUT S$ 8121 IF DE=3 THEN LPRINT CHR$(27);"G"; 8122 IF DE=2 THEN LPRINT CHR$(27);"E"; 8123 IF CW=2 THEN LPRINT CHR$(15); 8126 FOR CS%=S0% TO S1% 8127 IF DW=2 THEN LPRINT CHR$(14); 8140 LPRINT D$(CS%):YL=YL+1:IF YL<60 THEN 8143 8141 IF Q%=1 THEN YL=0:LPRINT CHR$(12) 8143 NEXT CS% 8145 IF Q%=1 THEN LPRINT CHR$(12) 8151 IF CW=2 THEN LPRINT CHR$(18) 8152 IF DE=2 THEN LPRINT CHR$(27);"F" 8153 IF DE=3 THEN LPRINT CHR$(27);"H" 8160 GOTO 7000 8750 REM KILL A FILE 8760 INPUT"DRIVE (A or B)";A$:GOSUB 8965 8770 DR$=A$:IF DR$<>"A" AND DR$<>"B" THEN 8760 8780 RESET:FILES (DR$+":*.*"):PRINT 8790 INPUT"READY TO DELETE A FILE";A$:GOSUB 8965 8800 Q$="YN":GOSUB 8910 8810 ON Q% GOTO 8820,200,8790 8820 LINE INPUT"FILE TO DELETE (NAME.TYP)";A$ 8830 GOSUB 8965 8840 FILENAME$=DR$+":"+A$ 8850 KILL FILENAME$:RESET:FILES (DR$+":*.*") 8860 PRINT:GOTO 200 8900 FOR Z=1 TO 1000:NL=NL:NEXT Z:RETURN 8910 A$=LEFT$(A$,1):Q%=LEN(Q$)+1 8912 FOR Z1%=1 TO (Q%-1) 8914 IF A$=MID$(Q$,Z1%,1) THEN Q%=Z1% 8916 NEXT Z1%:RETURN 8925 PRINT:PRINT"LINE #";CS%;"OF";N% 8927 PRINT D$(CS%):RETURN 8950 GOSUB 8955:PRINT TAB(10);"*";500-N%;" LINES FREE*" 8951 RETURN 8955 X=FRE("")+FRE(0) 8956 RETURN 8960 REM IF FNF(0)96 THEN TEMP=TEMP-96+64 8970 TEMP$=TEMP$+CHR$(TEMP) 8971 NEXT ZZ 8972 A$=TEMP$:RETURN 9000 REM RENAME A FILE 9010 INPUT"DRIVE (A or B)";A$:GOSUB 8965:DR$=A$ 9020 Q$="AB":GOSUB 8910:ON Q% GOTO 9030,9030,9010 9030 RESET:FILES (DR$+":*.*"):PRINT 9040 INPUT"READY TO RENAME A FILE";A$:GOSUB 8965 9050 Q$="YN":GOSUB 8910:ON Q% GOTO 9060,200,9040 9060 LINE INPUT"OLD FILENAME (NAME.TYP)";A$:GOSUB 8965 9070 OLDNAME$=DR$+":"+A$ 9080 LINE INPUT"NEW FILENAME (NAME.TYP)";A$:GOSUB 8965 9090 NEWNAME$=DR$+":"+A$ 9100 NAME OLDNAME$ AS NEWNAME$ 9110 RESET:FILES (DR$+":*.*"):PRINT 9120 GOTO 200 10000 REM undoc 10010 RESET 10020 PRINT "drive a:":PRINT 10030 FILES "A:*.*":PRINT:RESET 10040 PRINT:PRINT"drive b:":PRINT 10050 FILES "B:*.*":PRINT 10060 INPUT"drive (a,b)";A$ 10070 A$=LEFT$(A$,1)+":":GOSUB 8965 10075 IF A$<>"A:"AND A$<>"B:"THEN 10060 10080 DR$=A$ 10090 INPUT"filename (name.ext)";A$ 10100 IF MID$(A$,LEN(A$)-3,1)<>"."THEN 10090 10110 GOSUB 8965:FILE$=DR$+A$ 10120 OPEN "I",#1,FILE$ 10130 TEMP$="" 10140 N%=N%+1 10150 IF N%<=NT% THEN 10190 10160 PRINT TAB(10);"*FILE IS TOO BIG*" 10170 N%=NT% 10180 GOTO 10200 10190 IF EOF(1) THEN 10200 ELSE 10240 10200 CLOSE 10210 RESET 10220 IF TEMP$<>"" THEN D$(N%)=TEMP$:PRINT D$(N%) 10230 GOTO 7000 10240 LINE INPUT #1,S$ 10250 IF LEN(S$)>0 THEN 10260 10252 D$(N%)=TEMP$:PRINT D$(N%) 10260 FOR I%=1 TO LEN(S$) 10270 X=ASC(MID$(S$,I%,1)) 10280 IF X>=128 THEN X=X-128 10290 IF X>31 THEN TEMP$=TEMP$+CHR$(X):GOTO 10500 10300 IF X<>13 THEN 10500 10310 D$(N%)=TEMP$:TEMP$="":PRINT D$(N%) 10320 N%=N%+1 10330 IF N%>NT% THEN 10160 10500 NEXT I% 10510 IF LEN(S$)=255 THEN 10190 10520 D$(N%)=TEMP$:TEMP$="":PRINT D$(N%) 10530 GOTO 10140 11000 REM GLOBAL CHANGE 11010 CS%=0:C%=0 11020 LINE INPUT"STRING TO FIND: ",S0$ 11030 LINE INPUT"REPLACE WITH : ",S1$ 11040 IF INSTR(S1$,S0$)=0 THEN 11070 11050 PRINT"*THAT WILL CAUSE MANY ERRORS!*" 11060 GOSUB 8925:GOTO 200 11070 GOSUB 5530 11080 CS%=X1% 11090 IF X1%=0 THEN PRINT C%"strings changed":GOSUB 8925:GOTO 200 11100 C%=C%+1 11110 S2$="" 11120 IF S0%>1 THEN S2$=MID$(D$(CS%),1,S0%-1) 11130 S3$=MID$(D$(CS%),S0%+LEN(S0$)) 11140 D$(CS%)=S2$+S1$+S3$:PRINT D$(CS%) 11150 CS%=CS%-1 11160 GOTO 11070 %),1,S0%-1) 11130 S3$=MID$(D$(CS%),S0%+LEN(S0$)) 11140 D$(CS%)=S2$+S1$+S3$:PRINT D$(CS%) 11150 THEN 10260 10252 D$(N%)=TEMP$:PRINT D$(N%) 10260 FOR I%=1 TO LEN(S$) 10270 X=ASC(MID$(S$,I%,1)) 10280 IF X>=128 THEN X=X-128 10290 IF X>31 THEN TEMP$=TEMP$+CHR$(X):GOTO 10500 10300 IF X<>13 THEN 10500 10310 D$(N%)=TEMP$:TEMP$="":PRINT D$(N%) 10320s#r#"%/!]>#ͳ&q#p!w+~F%a./~GO#^#Vz>a>0ͳ&xGxʬ%^#V#O"/yk+F(6s#r#s#r#&¡%k%ü%>¾%¼%s#rw+>a/a..%2.#6+>1ͳ&s#r>w+a.)a.>#V>Æ(&F(F('O&3%`& `& &%?A#"$"a.]&7#yͿ*.&X{&&>a*6#~ž&3&s#r>#+6#6#6#6@="#wɧø&7?'w##&4##p#.2b ** "|& } +++:~?'4'`':,X/~2,?'**s#r"*##s#r:/*}o|g"*>(G}|v'!"(!("**"*}|ڄ'"6# x…'* ">a:y|ʽ'z+ï'*yr,##~>'> ͳ&s#r w+.>2 (#w+>3ͳ&s#rw+ͳ&xDM"/(*(s#r#(! C(>2ͷ&@(ͳ&(&~#Z(#~+Z(~+x ͳ&s#rw+ɯ2(x_Oͷ&Ô(2(x_Oͳ&9w#w+xʭ(+r+s=¤(w>#w+&~7^#V((!~ѧ7.&.~7!~#fo~)7)#~+~w}D#wx#a.&G!)!9*?>a:c)2>2:o) L))K:)!uLҘ)͑M!)bM)*xʸ)ͳML)͇M!8L͇L)@]T}_|))).&">4W*/y=*/#~+)*x *xG>k+x8*>k+xG F*>k+x#~+>k+>Xͳ&s#r+&W!x*G^#V#~ì*3 < E N !3> ì*!<> ì*!W> ì*!`> ì*!i> ì*O?'y!â'X'wZ'Z'!"  !'͘72!-80!&1Ͷ8P'!"!"6!"8*6":!\*<d9͠4*<#"<*<*:z|p}|IÏ ADD,DELETE,LIST,LOADò QUIT,SAVE,DITTO,NEXT,SCRATCH INSERT,FIND,CHANGE,SUBLIST,TOP LINE,PRINT,BACK W' KILL,RENAME,LOAD UNDOC,GLOBAL CHANGE2!'12!&1Ͷ8>L'*6"B!ó 2*<d90*<8ͤ86D'!U*46H'5 *<85> 2!A8ͩ6>H'8>ï 2!"A8!'0ï 2!'1*<#"<*<*Bz| }|= 2!'12!'1:!&o/!D͒/~!D74| ) Ͷ8G@'*6"K!Ñ *<d974!D74zz7 {zڍ *<d9!D7437!D͏6 *<d974!D74}o|ʺ 6G *<88G*<#"<*<*Kz| }| !G8"<*<| *<72  O *<"<*<7)N*<"<*<7we<*<"<*<7*<"<*<7  2!&1*  |H )W 2!&1 !'o/* d9͒/* d9!&͔6* #" ; *8|ڙ )ҽ 2!&1 *8* z| }|ڜ 2!'12!&0!'o/-!D(/~M!}&͘7ͤ*P7 *8* }o|b * +"R*8= *<d9"*7*<#"<*<*Rz|Q }| }* +" è * +" *8+"82!s&1 !Ò 2!'1*<#"<*<|ڢ )څ Ͷ8T@'ͩ6TL'8T2!T8d916T8'!U*46<'5T * 8ͻ5T : 2!'12!]&1!'o/!D͒/~2!'1M!}&͘7ͤ*P7 I *8|F I  iL2!'12!R&1!J&L2!'12!'12!?&1!7&L2!'12!'1!&&o/-!X(/D!X͘7~X!D͘7X!"&k6X!&k6|g}o| iL!&o/! ͒/D! ͘7~X!&d3!Dd3 ͘7!&͊M !ͲM!JH|a*  |?)j* #" !|,* d9͒/'iLi2!'12!%1a!%o/-!D(/~M!}&͘7ͤ*P7 2!%1!'o/!D͒/)2!'12!%12!'12!m%0! 1!W%o/-!D(/D!37D͘7~M!}&͘7ͤ*P7-!&&o/-!D(/D!37D͘7~X!D͘7X!"&k6X!&k6|g}o|-iLX!P%d3L2!'1!&o/!D͒/~X!&d3!Dd3 ͘7iL!L%͊M !ͲM* "[!!r2*<d91*<#"<*<*[z|}|iLi2!)%1M!#%͘7*888]2!'12! %1!%o/-!a(/!$o/-!c(/*a|u)go*c* z|}|go|g}o|¬*8* }o|*a*c}o|g* # |)Ҭ*a*8z|}|?go*c*8zz{z?go|g}o|¸*888e*a88i*a*c}o|g88m84'z!i8d9D͘7ͩ6iL'8i*a85]sͩ6iL'8iͩ6qL'8q͖5qm62!A8!'0!$1M!$͘7 2!$1Ý2!$1Ý*a*c}o|g88u84'* d9*a86q9d97* #" ͩ6qL'8q͖5quÈ*8* zz:{zA*8#"8 !$o/-!D(/~M!}&͘7ͤ*P7| N* "y!Þ*<d9$7*<#"<*<*yz|}|҈!" 2!$1i*8+"8*8| *8* }o|2 2!&1* # |)ҭM!#%͔64!'o/!D͒/D!&͔6* #" *8##"{* #j*<d9"*7*<+"<*<*{zz~{zJ}*8#"8*8d9D7M!#%͏62!&1 !"}*"8 !$o/!͒/*8"!"** zz{z;*#"*d9!͸3"a*a|))8*"* "*|YY2d91v*}|v2!r$0!0!n$1*8|2!W$1!'o/!D͒/!D͘7!7488*8d97488͑5!8"!*8d9!8*<e7!6X*<8660'57*<#"<*<*z|3}|2!K$0!0!n$12!>$1 *<|e)t!;$͘7Ï*8d9*<+37͘7*<8$776L'56!8$͘7*8d9*<8$776L'9H7͘72!%$12!n$0!0!n$12!$1!'o/!D͒/!D͘7*8d9!d37*8d9"!d3*7 2!'1!$o/-!(/*|ڍ)e!#o/-!D(/~M!}&͘7ͤ*P7**8"*8*P72*<0*<"8'*<* }o|*<#"<*<*z|}| 2!'12!#1!"8 !#o/-!(/*|[)** z|o}|y* "*"8 !#o/-!D(/~M!#͘7ͤ*P88|ڻ)҅!#o/-!D(/~M!#͘7ͤ*P88|)Ҿ!s#o/-!D(/~M!}&͘7ͤ*P7L%!f#o/-!a(/!X#o/-!c(/X!"a* "c!>#o/-!D(/~M!9#͘7ͤ*P88|ڎ)X{5,'{5,'|g}o|ʳͶ8H'*a|)go*a* z|}|go|g}o| *c*azz{z *c* z| }|* "c!(#o/-!D(/~M!}&͘7ͤ*P|C)2!'12!'1Ͷ8@'2!A8!'0!#1!'o/!͒/͠5H'2!-80!#0͠5,'2!-80!#0͠5,'2!-80*c"*a7͠5,'2!-802*8d91ͩ6L'8͌5('3*P|3Ͷ8$'2! -81*8#"8*8*z|K}|*P|g2! -81͠5,'|2!-81͠5,'2!-80!"1͠5H'2!-80!"1!&&o/-!D(/~X!D͘7X!"&k6X!&k6|g}o|µiLX!P%d3L2!'1!"o/-!D(/~M!}&͘7ͤ*P78 !"o/!D͒/~X!&d3!Dd3 ͘7! ͅLiLX!P%d3L2!'1 8L'ÕͶ8ͩ6L'8͖5 'D!37D͘7!M74#"P*P+"!M*!e7!D͏6*"P*#"**z|}|2!'12!#0*80!"0* 12*8d91i2! A8!'0!"0* !}o|g0!"1͚3ͤ8͕368G!"͘7!D74888L'!8D!e7A488͖5'ͩ6'8!8-8d3͘7ͩ6L'8͖5D!͘7!&&o/-!D(/~X!D͘7M!"͘7ͤ*P788iLX!P%d3L2!'1!"o/-!D(/~M!}&͘7ͤ*P7~ P!p"o/!D͒/~X!&d3!Dd3͘7!V"o/!D͒/~X!&d3!Dd3͘7!CKiLX!P%d3L2!'1 iL2!R&12!'1!J&L2!'1iL2!'12!?&12!'1!7&L2!'1!H"o/-!D(/D!37!&d3D͘7~D!C"k6D!>"k6|g}o|?X!D͘7!("o/-!D(/!D74+++D!e7!$"͏6~X!Dd3͘7!&͊M!ͲM!!"͘7* #" * *z|}|'2! A8!'0! "1*" 5!JH|5j!HiL! "͔6g* d9721!|,!͒/!74|څ£* d9721!74"!P *<!e7A488G͌5G'ͩ6G'8G͖5G ' !G8-8d3͘7L ͠5G'L * d97!"͘721* #" * *z|H }| *<#"<*<*z|d }|Ҳ!74|'* d97!"͘721!"8"}!!o/!͒/!!o/!͒/!͸3| 2!!1 *"8*|!2*}0!!1 *}#"}!!͘7*a|$!)E!*8d9*a+e7͘7*8d9!74*a!e7͘7*8d9!d3!d3721*8+"8 )!!strings changed!*THAT WILL CAUSE MANY ERRORS!*!REPLACE WITH : !STRING TO FIND: " " ""*FILE IS TOO BIG*$"'".+"filename (name.ext)A"B:F"A: K"drive (a,b)Y"NEW FILENAME (NAME.TYP)s"OLD FILENAME (NAME.TYP)"READY TO RENAME A FILE"AB" " LINES FREE*"*"OF"FILE TO DELETE (NAME.TYP)"READY TO DELETE A FILE"H"F#E#G #*TURN ON PRINTER, HIT RETURN*+#AUTO FORM FEED<#NYA#DOUBLE-WIDTH CHARACTERS [#LAST LINE # i#1ST LINE #v#PRINT ENTIRE FILE#NED#DENSITY (NORM,EMPH,DBL)#NC#CHAR WIDTH (NORMAL, CONDSD)#LINE ## *TOP OF STACK*#PRINT LINE #'S WITH EACH LINE $# LINES TO LIST $ TO BECOME($WHAT DO YOU WANT;$>$ A$IN STRING: N$NO FIND 'Z$STRING TO BE CHANGEDq$' u$*NO FIND* '$STRING TO BE FOUND: $ **DONE**$$ERASE ALL DATA$*MAY NOT OVERLAP CURRENT LINE!*$*IMPOSSI%BLE!*$$**DONE**$LAST #%FIRST #%LINES TO BE DITTO'D:&%!C& ,%*READY TO DITTO BELOW THIS LINE*O%OS%:*.*Z%CHANGE THE FILENAMEp%CURRENT FILENAME IS %READY TO SAVE DATA ON DISK$%*REMOUNT SYSTEM DISK AND HIT return*%REALLY WANT TO QUIT NOW%**CANNOT LOAD ENTIRE FILE**&I&: &FILENAME (NAME.TYP)!&B%&A)&DRIVE (A or B):&B:*.*B&drive b:M&A:*.*U&drive a:`&*READY TO CONTINUE*v& *DONE*&YN &DELETE IT&NO LINE PRESENT!&/&DATA DUMP REQ'D&USE '/' TO TERMINATE &COMMAND: &COMMANDS ARE:&*REVISED 20 FEB 1982*''Px@zppL} @*@P)*###"'###"'[[[[ BASLIB #200017 5.2 - OWNED BY MICROSOFT, 1979 <ï'ï' o-yOzDM*"9* =##"9Ê(>2'2'*^#V"'##^#V"' 2'!'!!""'!("(6#6P>2(>2(>2(ͦ'?(ͩ'?(6(_}o|gxޠG>?/K2!K7y<=MK:!KxHK> %J{_zWyO!9"N(**ʢ(!6#}¢(|¢(6!T(6#zµ(*|(> #)6#s#r#=(>2H(>2K(>2J(2M("P(!C("[('<= STO+)X,*[(.. . ........ͷ;*i(| ):f(v)*d(|v)[+* s#r* {w#6"g(*N(*d(>2f(X,=Error -!)~<ʜ)=ʜ)#~#)È)#"=)Syntax Error in DATRETURN without GOSU Type MismatcOut of DatIllegal Function CalOverfloOut of Memor Subscript Out of Rang Division By ZerOut of String SpacString Formula Too CompleRESUME without Erro2Field Overflo3Internal Erro4Bad File Numbe5File Not Foun6Bad File Mod7File Already Ope9Disk I/O Erro:File Already Exist=Disk Ful>Input Past En?Bad Record Numbe@Bad File NamCToo Many FileUnprintable Erro!9N#F*~#~Ҍ+~+ʒ+~#~ڌ++^#V###j+###j+|ʞ+~#fo!+= Internal Error - No Line Number C(*~#:,= at line[++X,>!,<,,+!,<,0xS,,}_|W!0,͈T~#fo>= at address|M3}M3X,> xS> xS!9"F(*F(|#)b,}NfQʘ,cQ`i"Y(!,"q(!--"s( - ,A-,,v?͡=*U*U*U*U-}?>*U-}?͊=*U*U ­,,ZA-~#-x͜;-l,!>.)A-͍;͜;͛7ͦJ$- Q-A-"f-G{,xf-PXͦJڴ-!/Oz"yʟ- - Ÿ-O{,y-ͦJڴ- Ÿ-{ ʮ-,> ʮ-ʮ-ʴ-ʴ--ͦJk-"ʿ- -ͦJ- ʿ-,- -ͦJ- -*Y(( 46!/ɷw#-+PøN#"-!9"-"-y2-*Y(|!.*q(!."i(A~#*0|T~.ʳ.L.v?O.}?"0u.ʁ.͡=*U*U*U*UÎ.>*UÎ.͊=*U*U*0|Tʦ.~#"0,.).~.!"i(~,"¾.#"~..# ..".#"0x". .+~ .y͜;Î.=?Redo from Start *-ͷ;!%/o/*-:-O(.*-+~+S/E/E/ +w G/^/++~#fo͛7"-!-5*-~2n/#~#^#V=++ͭ;͏Q(:/b,*Y(|±/!/͍;͜;͛7*s(-ʎR+ʎR+qS.SeʠRERlʸRLʸRqʸRQR:R>R~%(S#7S!8SdRDR?SSR_{_NS^SRK!JxM R?SÎR#JLR?S#ṘMijMKGR=JCQ2U=:|(1F#~#fox1;21ʹ1~#Rí11í;1>"RG:(x1ʌS*(+~<1=1###~1*w(ÌS!v1*}(*(~= 2/<;2*2=2/2:|(> R1>,RW*(#^ ^2X2+=X2͌Sz{p2{_b2b,|¬2}Nʋ2cQ`i"Y(++"(!2"w(!2"u(2|(3l,#)LIP}o|g2> R+|2ÌS!("(!"Y(2|(3!("(!"Y(2|(3!(~6#w~!&3;3N3l,i&.) G~#K3#=3++V30:a3xSb,#)4;ͅ3ͅ3ͭ;ͭ;~#~#fo͍Tɯ2U:*9#V#NX!"U$^3x#)ű3 y<23F~44#~#foy͈TO #~#fox4 4#34!34 323ͭ;ͭ;*3&_ ]~ͭ;o&~#)#^#V++ͭ;o&b,&5͊=U>×4b,/5v?E5͡=U>×4b,&5>U>͍Tb,/5~,"´4#"~44# ·4l,#)"4#E5y͜;͛7*^#V#{4!l("U("W(>2l(4N#F#*U(~=!5}|!5W5 5/5}?E5:l(4*U(|T~=l,&)|T~,S5#"U(ɧf5*W("U(+V+^"W(l,,)>!>!>!>!>!>^#V#^#V#S>ç5>ç5>ç5>ç5>ç5>^#V#^#V#äS>5>5>5>5>5>^#V#!UäS>5>5>5>5>5>^#!TUäS>"6>"6>"6>"6>"6>^#V#!s,äS>K6>K6>K6>K6>K6>s,!UäS>r6>r6>r6>r6>r6>|9!+>Ö6>Ö6>Ö6>Ö6>Ö6>|9ʥ6~#fo##,T^#V#b,͒[ï6^#!Tõ6,T^#V#b,͓\6^#!T6,T^#V#b,[7^#!T-7^#V#^T7b,|#)BKm7PYb,|#)BK ^7 o_A7b,z#)zu7 {7_ҁ7o _ W}͜;ͭ;DMb,v;7~##++-<>͍T+V+^+7+r+sw27|"8+})N#8~#fo :78!9"N(!T(4 ~͈T##)b,|#)!9>͜;+͎8*({ RU8|#)}*(d8_!94:5*9"9~#N#F#P:*: ͈T:yx5: :+++6@#yw#xw+++6###!9~6a:v:::*9#~#~:l,)!*9"9~#^#V#ڽ::͈TÃ:|¨:Ã:++~_w#~Ww#Ã:v:*9DM~#^#V#;::+z;+{;##{z~#q#p_:y;x;DM:~#;:YP+++"96@###{_zW+r+sɷi;*9|G;l,):^#V+"9w#s#r+++r+s##!p;u;*={z* =?ҋ;}|~# ‘;yG4;x͍Tv;-@++*9"9s#r+:*9#~_#~WҠ)b*i~#G>a ͫF}=*U}/o|/g#"U|ͮ=s]}=!U~wɯ2UͫF=Yͮ=*Uͮ=s]ͫF=ͣY>>S?~+(#ó=+(L=!U=>!UU2=# =!UX!U͸>͵U>>=>|}+!n?%Ẁ>]+6!U>fY2U!j?\!f?%W!U%W~_#~W#~OD_Õ[!/FÒ[E]S>ɇ<o&ͮ=s]*U*U̓>"U`i"U!U^#V#N#F#!j?Ó\2_x{'_!U6^wg>͏_K_ü>:U=Gw#¼>>>!U>UͫFUͫF>*U||<ͫF*U ?>!+F>=͑=?E>:U2U:U҈G͒>:U/?4?:?|/g}/oN?!G:UW?͒>"U>2U=K>ajM? L}ͅ=ͫ=sG>2.=`hN?~&F-ʥ?+ʥ?+͑Fڌ@.2@eʷ?E?͑Fl?L?q?Q?:U=?>?~%?@#P@!Q@d?D@Z@͑FͼF͑F@@_{_i@y@@\=ͫF!Z>W?ͫF @Z@å?͑F!Z>!>@Z@͑F@̊=ġ=ͫF>'>=ͫF!>>@͌>@ù@ͨ='>>\>ͨ==ù@e>\>?>{ A0_@HA!UͫF(A:U)AyHA:UDA:UHA:U/HAÈGAVA6+>hA6-\=#60:X=W:U=BBAE!2=F :X=_ ʡAx*¡A{¡AAq͑FAEADA0ʡA,ʡA.A+60{A+6${+p2X=!2=6 e>*U*U20=͈BE~)B: B0 B #~A>DGA"U`i"U#~+pB-GB0OxGpB#~.B`xEeBy B>20=uB|B]BB"U`i"Uu>#W~D:0=BíBBұBE60̊>DE+~0B.Ċ>BͫF>"w#6+B6-/</ B:#p#w#6!2=#zsCDEzDE{>=D̈́A(Cp#6!1=#:V=~ -C*-C+AC͑F-+$0kC#͑FkC++waC.CkC6%DʏC3F=CKA+6%K>Cͯ>~DC_xDEDEE0EC_yw@Cy@C{_xCDECDy4EODGODED*V==DPC͘=ѯDͯ>7~Dyw@OzWOy@=DKD/<~.Ċ>"V=uDBCկͫFD:UҢDF!U͸>-> ÇDDͫFDCOK>ýDF=Dj@åDy@DͫFDt#K>D#F=D=60#DE0E60#=D{!+F>= >;F> 0E/>=mE>=p#=dE!Ur>àEE>>͒>u>F?0È>/{_#zW#yO++ҴE3>#u>p#ڦE>EF>0EN#F#*U/}o|gE"Up#=E0Ew1_cƤ~@zZrN vH Tʚ;@B''d #~: ʑF ʑF ʑF0?<=:U=ҸF7-++͑FNGOFHF+FFN?H#GFl, )M!GG}0?)))صoGM!*G(G}NG0? @G? ))))صo*Ga{ >ͫF:U:U?>:.=2/=2.=l, )l, )gz $)|g}oz(}9o|=gz $)|g}oz3pHI{,qI{0-r{8-sH{(}9o|=gz $)|g}oz%(|/g}/oz(|/g}/oz()"H %(s#r)$(%؃b,}NfQcQ!' ~ʅH ʅH#~zH`iaJ[H>O #~goPY!' ůw͕J:'[MʁQ={Q=¹HѯlQ<ʁQ!% ^#Vr+sb,}M!"AH}NI PYI!H`i>]I!' ~ĐH͕J͵Nb,}NfQ!&,I! ~+ngb,}NfQ! n&*Y(~`QuPDM'~̍H4N#V pʁIzw w+s#r#6#6DM:'ʬI!" s#r#6I! {zVIGw*Y(T]% N#F+q#p###6 vJ͕J:'[M>ŽJ>w+w!(,J7?*Y(' 6#67~~Q#^#fk_JN#~:J++@~Qy@~Q~QH #3K~. KK7J#J2*Hͭ;z ~Q~Q> KK> 8KKb,JGH ͍TJ:H!H„QH ͍T66͕J~+L<ʁQ@L<@LuQL!%w#w#w#w~\L^J) p# bLM _b,JGH<uQb,!H6# SMLb,J2*H!HOM!'HOMGHuQO!G  ~#ͱRy"M~ M>.ͱR M:( W:(;M> ͱRͱRܮRHL~*6?# SMO!!4sM#4sM#4y"ˆMʁQ><"?H>2_(!P"`(:](<2](*[("CH!M"[(b,"AH͓K*m(|M##nHM.H*CHb,Mb,2EHO"FHOb,Nb,2EHO"FHOfQ!)yO)#zO))҈O ҇O#=oO}_}la)ڄQҟO#x„Q"N! "N!) "N!}o|gQQObk:NPQQO1PDM*N*NhP"NPY0P}o|g*N#"N±O1PDM*N*NhP"NPYO2PQ*N! ~#foQQs#rWP:PQdP!dP!& ÈI~# xiPDMPxQP! w!( V6 ʞPzwPxQP! ~!P! ^#V! s#rDM;P͸PQQ}NfQPcQ`i"Y(!Q"b(.QͦJl,!>.)b,|#),(Q-:_(fQ*`(!"("b({4;f$%LQ!EQ*b(7QK|}!"Y(>6>4>?>=>:>7>5>2>3>@>C>l,o&.)!"Y(!/"0ͥQ:n/¶Q=?öQpRQ:R>\2RQʵQͱR+Q~ͱRQ+ͱRQͱRͮR!/2RQROʼQ:RR>\ͱR2Ry{R̴R7 ʢR {R 5RʶQ{R̴RʶQSRʶQͱR> ͱR>Q]R>#QvR6ͮR!/RQ Qx<>ʆRyq#ͱR Q> ͱRRʓR QQ:n/̮RwX,xS>^ͱR@ͱRͮR~ R> ͱRͱR#R"(Ɏ&*( R#~+ R~=jS*(!("(R"(> R> R> 2(> 2(*RïS GSS~#foS##S GSSS>S~+~?~ T+#T+ T&)))^#V#!UUdT>UMT ~#=hT!MT#~ {T {TɅo$ɧGw#‘T{zR&Y !J&\ !'b k !'q t !?&z 7&h } !'̓ ͌ !'͒ !&& !X D!X( ~X!DͶ X!"&X!& |g}o| P !&͡ !  D!  ~X!&!D  !& !!|a*  |?)j* #" !*   ' i6#ҩUYUUK_OU!S_!Uy#U+UK_?S_V_ͣYVV͚YͯV!UYnV:UK_:U/fYX2U:UXK_x/F+N+=V!UW!U>q#p#=W!U%W"TVVV*TY_:U_!UN#F\OYqbWGܔX͒Yx KWBWX!UnYZWj0 TeB׳]h!I.k V_ͣYéWV͚Y!U%W3!Uq#~++w+qWK_DNn"~`35zr1{r1h!IYK_yO2U#XYK_:UʯV5X/<ͯV9K_:UO]G2U!UfY:U2Ux!UUX͝XlX4͒Y:UX!U~++wK_!U4#…X4ʯW+6!UU# Xɯ# ªXͪXX/!UOyw#XG:UX!UVwz# XxX_!U YXxlX!Uw_lX~w# YV_ͣY*YV͚Y!UXV_ͣYFYV͚YͯV!U Xy2U!UT~q+\Yq}YNsY+rYhY W~w+‡YÀY!UÄYs]ãY_!Uw#©YK_ͺY}YYYY]!UF#^#V#N^Y}U~#YG++NyS_UY!U_>,Z Z3D_:Z2_!U6^g>͏_|]>Zak_Z ]ZK_<_ʛZK_ʣZ^kZ]E]|'_wZ!Z̈Z^[͙\êZ>O!U~+>wK_QY$_]K_:UZhZ^ ]ƁZ][!Zg[JÝ\QY$_K__^|Yt&wz^Pc|u~r1$_[3>2U!.[g[^ogs]Ø[ }}{(qnz ^2_͙\g[Ù\^~#_=x͖\<_͘[r[ͅ]Õ[<_K_:U$_Ҩ[/<]K_]g͏_!U[~_#~W#~O^#4^.ͥ_^G~_#~W#~O]$^ͅ][<_K_>OØ[ͅ] \<_ʶ]K_ȯG\"Uy2UFo]]!D*U:UOG\U4^_\o\g.*U:UOzH\o\g.*U:UU\x<=\{_zWxG)yOHG^ͅ]Ö\<_'_K_\y+F+F+Fw`h|\gy\:UO|g}oxG-|»\}¶\$^ElaOõ\!U~Gx]ƀ_w]w+ɷ^_2_x{'_!U6^wg)]z(] >͏_|^{>2U$^/))] =]!U~7w?##wy7O*U*U"U"UajSXk^_JS\E!U_/v_ u_7>{_zW}o|g=l_|g}oڞ_CZQÑ_ o-yOzW{_xGá_ =*="9}w>#w##͛T<++6+69:_~xS#=="=~xS#"=_[ͅ] \<_ʶ]K_ȯG\"Uy2UFo]]!D*U:UOG\U4^_\o\g.*U:UOzH\o\g.*U:UU\x<=\{_zWxG)yOHG^ͅ]Ö\<_'_K_\y+F+F+Fw`h|\gy\:UO|g}oxG-|»\}¶\$^ElaOõ\!U~Gx]ƀ_w]10 DEFDBL A,K,X:DEFINT J,M,N,T:DIM A(20),K(20):T=7 20 PRINT CHR$(26):REM CLEAR SCREEN 30 PRINT" *** MEASURE ***":PRINT:PRINT 31 REM Written by JIM SCHENKEL 415/928-4445. MBASIC 32 REM version 7/11/81 translated from original North 33 REM Star Basic version donated to NorthStar Users' 34 REM Group library in 1978. NSBASIC uses BCD math. 35 REM MBASIC doesn't, but double precision calculation 36 REM should give accurate results to 6 places as printed. 37 REM Data is from CRC HANDBOOK OF CHEMISTRY & 38 REM PHYSICS (58th ed., 1978). Good to 8 places. 39 REM Comments welcome. 40 PRINT"Choose the number of the type of measurement involved" 50 PRINT:RESTORE 380:FOR J=1 TO T:READ A$:PRINT J;A$:NEXT 60 PRINT:INPUT M 70 IF M<1 OR M>7 OR INT(M)<>ABS(M) THEN 40 80 PRINT CHR$(26):PRINT"Choose the number of the units" 90 PRINT"you wish to have converted" 100 GOSUB 740:N1=0 110 READ A$:IF A$="" THEN 130 120 N1=N1+1:PRINT N1;A$:GOTO 110 130 PRINT:INPUT N 140 IF N<=N1 AND N>=1 AND INT(N)=ABS(N) THEN 160 150 PRINT"Sorry, try again":GOTO 100 160 GOSUB 740:FOR J=1 TO N:READ A$:NEXT:PRINT 170 PRINT"How many ";A$;:INPUT X:GOSUB 750:IF M=7 THEN 320 180 FOR I=1 TO N1-1:READ R:K(I)=R:NEXT 190 IF N<>1 THEN 210 200 FOR J=2 TO N1:A(J)=X/K(J-1):NEXT:GOTO 250 210 A(1)=X*K(N-1):FOR J=2 TO N1 220 IF J=N THEN 240 230 A(J)=A(1)/K(J-1) 240 NEXT J 250 FOR J=1 TO N:READ A$:NEXT 260 PRINT:PRINT X;" ";A$;" is equivalent to:":GOSUB 740 270 FOR I=1 TO N1:READ A$:IF I=N THEN 290 278 REM O! in line 280 changes the calculated result to 279 REM single precision. Change to LPRINT for hardcopy.' 280 O!=A(I):PRINT O,A$ 290 NEXT I 300 PRINT:PRINT"Again?":PRINT"1-same units 2-same type 3-different type" 310 Q$=INPUT$(1):ON VAL(Q$) GOTO 160,80,40:END 319 REM Lines 320-370 deal with temperature (special case). 320 IF N=1 THEN 350 330 IF N=2 THEN 360 340 A(1)=X-273.16:A(2)=A(1)*1.8+32:GOTO 370 350 A(3)=X+273.16:A(2)=X*1.8+32:GOTO 370 360 A(1)=(X-32)/1.8:A(3)=A(1)+273.16 370 RESTORE 720:GOTO 250 379 REM Types of measurement follow: 380 DATA " length"," area"," volume"," mass" 390 DATA " energy"," velocity"," temperature" 399 REM Data areas follow, beginning with constants for length. 400 DATA 100,1e5,2.54,30.48,91.44,1.609344e5 410 DATA 1.852e5,1e-8,9.46055e17 420 DATA centimeters, meters, kilometers, inches 430 DATA feet, yards, miles, naut. miles (Int'l) 440 DATA angstroms, light years, "" 450 DATA 1e4,1e10,6.4516,929.0304,8361.2736 460 DATA 25899881000#,40468564# 470 DATA square centimeters, square meters 480 DATA square kilometers, square inches 490 DATA square feet, square yards, square miles 500 DATA acres, "" 510 DATA 1000!,1E+06,16.387064#,28316.847#,764554.86#,29.5735 520 DATA 473.1764700000001#,946.3529400000001#,3785.4118#,4546.09,158987! 530 DATA cubic centimeters, liters, cubic meters 540 DATA cubic inches, cubic feet, cubic yards 550 DATA fluid ounces, fluid pints, fluid quarts 560 DATA gallons, Imperial gallons, barrels (oil),"" 570 DATA 1e3,1e6,28.349523,453.59237,9.0718474e5 580 DATA 31.103486,373.24182,980.665 590 DATA grams, kilograms, metric tons 600 DATA ounces (avoirdupois),pounds (avoirdupois) 610 DATA short tons, Troy ounces, Troy pounds, dynes, "" 620 DATA 3.9683207e-3,9.2744135e-3,1.28408e-3,9.48451e-4 630 DATA 2546.14,3404.6205,9.48451e-11,2.8736047e5,9.30113e-8 640 DATA BTU, calories 650 DATA kilogram meters, foot pounds 660 DATA joules, horsepower hours, kilowatt hours 670 DATA ergs, tons of refrigeration, gram centimeters, "" 680 DATA 27.78,2.54,30.48,.508,44.7 690 DATA centimeters per second, kilometers per hour 700 DATA inches per second, feet per second 710 DATA feet per minute, miles per hour, "" 720 DATA degrees centigrade, degrees Farenheit 730 DATA degrees Kelvin, "" 740 ON M GOTO 760,770,780,790,800,810,820 750 ON M GOTO 830,840,850,860,870,880,890 759 REM Lines 760-820 reset to proper constants. 760 RESTORE 420:RETURN 770 RESTORE 470:RETURN 780 RESTORE 530:RETURN 790 RESTORE 590:RETURN 800 RESTORE 640:RETURN 810 RESTORE 690:RETURN 820 RESTORE 720:RETURN 829 REM Lines 830-890 reset to proper unit names. 830 RESTORE 400:RETURN 840 RESTORE 450:RETURN 850 RESTORE 510:RETURN 860 RESTORE 570:RETURN 870 RESTORE 620:RETURN 880 RESTORE 680:RETURN 890 RETURN 900 REM Additional types of measurement can be 901 REM added by the following steps: 902 REM -- Increase the number of types of 903 REM measurements (T, line 10). 904 REM -- Add the name of the type of measurement 905 REM to the data statement on line 390, or put 906 REM in a new data line at, e.g., 395. Note the 907 REM leading space. 908 REM -- Add appropriate jump vectors to lines 909 REM 740 and 750 (e.g., to lines 825 and 895). 910 REM -- Add line restoring data area for the 911 REM numeric constants (e.g., at line 825). 912 REM -- Add line restoring data area for the 913 REM unit name strings (e.g., at line 895). 914 REM -- Create appropriate data lines. 915 REM Note that there should be one more unit name 916 REM in the list than there are constants. Each 917 REM calculation first converts everything into 918 REM the first units on the list (e.g., centimeters) 919 REM and then multiplies by the constants to 920 REM arrive at the other values. 921 REM -- Be sure that the last data item in the 922 REM list of unit names is the dummy data "". th REM measurements (T, line 10). 904 REM -- Add the name of the type of measurement 905 REM to the data statement on line 390, or put 906 REM in a new data line at, e.g., 395. Note the 907 REM leading space. 908 REM -- Add appropriate jump vectors to lines 909 REM 740 and 750 (e.g., to lines 825 and 895). 910 REM -- Add line restoring data area for the 911 REM numeric constants (e.g., at line 825). 912 REM -- Add line restoring data area for the 913 REM unit name strings (e.g., at line 895). 914 REM -- Create appropriate data lines. 915 REM Note that there should be one more un10 WIDTH 128 20 REM COPYRIGHT (C) 1982-83 BY John Gaudio 30 REM MAY BE REPRODUCED FOR NON COMMERCIAL USE. 40 REM LAST UPDATE 11/04/83 @3:51 PM. 50 REM 60 REM ***************************************** 70 REM STORE DATA FROM OLD LIST.LST TO TEMP 80 LET F=1 90 ON ERROR GOTO 810 100 OPEN "I",#1,"B:LIST.LST" 110 REM IF FILE EXISTS, WRITE IT TO "TEMP" 120 OPEN "O", #2,"B:TEMP" 130 IF EOF (1) THEN 170 140 LINE INPUT #1, A$ 150 PRINT #2, A$ 160 GOTO 130 170 CLOSE #1 180 REM 190 REM ***************************************** 200 REM ADD ENTRIES TO NEW FILE 210 PRINT CHR$(26) 220 PRINT "PLEASE ENTER THE INFORMATION REQUESTED." 230 PRINT "WHEN YOU'RE FINISHED JUST ENTER A RETURN" 240 PRINT "FOR NAME." 250 PRINT 260 LINE INPUT " NAME "; N$ 270 IF N$="" THEN 700 280 LINE INPUT "SALUTATION "; SAL$ 290 LINE INPUT " ADDRESS "; SA$ 300 LINE INPUT " CITY "; CITY$ 310 LINE INPUT " STATE "; STATE$ 320 LINE INPUT " ZIP "; Z$ 330 LINE INPUT " PHONE(S) "; PHONE$ 340 REM 350 REM ***************************************** 360 REM CHECK NEW ENTRIES FOR ACCURACY 370 PRINT 380 PRINT N$ 390 PRINT SA$ 400 PRINT CITY$;", ";STATE$;" "Z$ 410 PRINT 420 PRINT "Dear ";SAL$ 430 PRINT 440 PRINT "PHONE(S) ";PHONE$ 450 PRINT 460 PRINT 470 LINE INPUT "IS THIS CORRECT? "; H$ 480 IF H$="N" THEN 540 490 IF H$="n" THEN 540 500 IF H$="y" THEN 610 510 IF H$="Y" THEN 610 520 PRINT "PLEASE ENTER A Y FOR YES OR AN N FOR NO." 530 GOTO 470 540 PRINT CHR$(26) 550 PRINT "DATA ABANDONED, RE-ENTER";CHR$(7) 560 PRINT 570 GOTO 220 580 REM 590 REM ***************************************** 600 REM ENTER DATA ON FILE 610 PRINT CHR$(26) 620 PRINT "DATA WILL BE ENTERED ON FILE" 630 PRINT 640 WRITE #2, N$,SAL$,SA$,CITY$,STATE$,Z$,PHONE$ 650 PRINT 660 GOTO 220 670 REM 680 REM ***************************************** 690 REM DATA ENTRY COMPLETE, CLOSE & RENAME FILES 700 CLOSE 710 IF F=0 GOTO 750 720 ON ERROR GOTO 850 730 KILL "B:LIST.BAK" 740 NAME "B:LIST.LST" AS "B:LIST.BAK" 750 NAME "B:TEMP" AS "B:LIST.LST" 760 GOTO 870 770 REM 780 REM ***************************************** 790 REM ERROR RECOVERY SECTION, IE FILES LIST.LST 800 REM OR LIST.BAK DID NOT EXIST 810 IF ERR<>53 OR ERL<>100 THEN 860 820 OPEN "O",#2,"B:TEMP" 830 LET F=0 840 RESUME 210 850 IF ERR = 53 THEN RESUME 740 860 PRINT "ERROR ";ERR;" IN LINE ";ERL 870 END O",#2,"B:TEMPY" THEN 610 520 PRINT "PLEASE ENTER A Y FOR YES OR AN N FOR NO." 530 GOTO 470 540 PRINT CHR$(26) 550 PRINT "DATA ABANDONED, RE-ENTER";CHR$(7) 560 PRINT 570 GOTO 220 580 REM 590 REM ***************************************** 600 REM ENTER DATA ON FILE 610 PRINT CHR$(26) 620 PRINT "DATA WILL BE ENTERED ON FILE" 630 PRINT 640 WRITE #2, N$,SAL$,SA$,CITY$,STATE$,Z$,PHONE$ 650 PRINT 660 GOTO 220 670 REM 680 REM ***************************************** 690 REM DATA ENTRY COMPLETE, CLOSE & RENAME FILES 700 CLOSE 710 IF F=0 GOTO 750 720 ON ERROR GOTO 850 730 KILL "B:LIST.BAK" 740 NAME "B:LIST.LST" AS "B:LIST.BAK" 750Th documentatio o NEWNAMES.BA consist o thes two articles. FRO TH DO HOUSE, November 83 FILE AN MBASIC b Joh Gaudio Let' assum you'v don littl wor wit Mbasic yo kno wha variable an loop are an you'r familia wit inpu statements Yo ma eve hav use LPRIN an LLIS t ge thing ou t th printer bu yo don' kno anythin abou usin file wit Mbasic Thi articl i fo you. fil i nothin mor tha informatio store o th dis an give name Whe yo sav progra yo creat file Mbasi itsel i store i file an s i thi articl a writ it Mbasi use tw differen kind o files RANDO ACCES FILE an SEQUENTIA FILES I thi articl we'l conside jus th sequentia files. Yo firs creat fil b usin th OPE statement Th statement 1 OPE "O",#1,"B:NAMES" wil creat fil calle B:NAMES I wil b sequentia file an it' fil numbe wil b 1 A thi poin w ca onl outpu informatio t th file (Th "O stand fo Output) not o cautio i i orde here Ever tim yo ope sequentia fil fo outpu yo eithe creat ne file o wip ou an informatio tha wa i th ol fil o tha name A firs thi seem t b rea problem bu a we'l fin i nex month' article ther ar way t ge aroun it. Onc th fil ha bee opene you'l wan t pu informatio int it Assum yo wan t creat fil wit name an phon number i it Conside th folowin program. 1 OPE "O",#1 "B:NAMES" 2 LIN INPU "NAM " NAM$ 3 I NAM$=" THE 1000 4 LIN INPU "PHONE " PHONE$ 5 WRIT #1,NAM$,PHONE$ 6 PRINT 7 GOT 20 100 CLOSE 101 END Th progra firs open th fil B:NAME fo Outpu a fil numbe 1 I the ask th operato fo nam t b store i NAM an check t se i tha nam i blan (lin 30) I i wa blank i th use jus presse th RETUR ke i respons t th "NAM prompt the th progra goe fro lin 3 t lin 100 wher th fil i close an th progra ends I nam i give though lin 3 i passe up phon numbe i requeste i lin 40 an bot th nam an th phon numbe ar writte t th fil i lin 50 Lin 7 jus take u bac t th reques fo nam an th proces repeat al ove again. Thi particula progra create fil tha ca b use a Mailmerg dat file Th WRIT statemen put quotatio mark aroun eac nam an phon # an seperate the b commas ru o thi progra migh loo somethin like RUN NAM Gaudio Joh J. PHONE 303-934-1407 NAM Smith Bill PHONE 999-534-3210 NAME OK an th file whic ca b rea b WordStar woul loo lik this. "Gaudio Joh J.","303-934-1407" "Smith Bill","999-534-3210" Th comm seperate th nam fro th phone# Th quotatio mark mak i possibl t us comm i eithe th phone o th name withou creatin confusio fo Mailmerge. Onc you'v create thi file entere th data an close th file yo ca us anothe progra t rea th informatio back. 1 OPE "I" #1 "B:NAMES" 2 I EO (1 THE 1000 3 LIN INPU #1 A$ 4 PRIN A$ 5 GOT 20 100 CLOSE 101 END Her th "I i lin 1 cause th fil B:NAME t b opene fo Inpu a fil numbe 1 Lin 2 check t se i th En O th Fil (EOF ha bee reached I w hav reache th en o th fil Mbasi goe t 100 t clos th fil an end I ther ar stil name an phon number available on name/phon pai i inpu fro fil #1 store i th variabl A$ an printe o th screen I lin 5 Mbasi i tol t g bac t lin 2 an star ove again Th resul o runnin thi progra shoul be RUN "Gaudio Joh J.","303-934-1407" "Smith Bill","999-534-3210" OK Whil thi seem prett trivial i doe mak u th cor o syste fo quickl enterin Name Company Address City State Zip Phon Number an more an storin tha informatio i Mailmerg dat file Nex mont we'l loo a wha ca b don t mak i bi friendlie an easie t use I th meantime tak th tim t rea ove you manua an thin abou wha yo migh wan t us thi for Abov all Enjoy! FRO TH DO HOUSE, December 83 DAT ENTR SYSTE I MBASIC b Joh Gaudio Remembe las mont w create shor progra tha prompte yo fo nam an phon number an the create fil t b use wit Mailmerge Wel here' a expande versio o tha program. 10 WIDTH 128 20 REM COPYRIGHT (C) 1982-83 BY John Gaudio 30 REM MAY BE REPRODUCED FOR NON COMMERCIAL USE. 40 REM LAST UPDATE 11/04/83 @3:51 PM. 50 REM 60 REM ***************************************** 70 REM STORE DATA FROM OLD LIST.LST TO TEMP 80 LET F=1 90 ON ERROR GOTO 810 100 OPEN "I",#1,"B:LIST.LST" 110 REM IF FILE EXISTS, WRITE IT TO "TEMP" 120 OPEN "O", #2,"B:TEMP" 130 IF EOF (1) THEN 170 140 LINE INPUT #1, A$ 150 PRINT #2, A$ 160 GOTO 130 170 CLOSE #1 180 REM 190 REM ***************************************** 200 REM ADD ENTRIES TO NEW FILE 210 PRINT CHR$(26) 220 PRINT "PLEASE ENTER THE INFORMATION REQUESTED." 230 PRINT "WHEN YOU'RE FINISHED JUST ENTER A RETURN" 240 PRINT "FOR NAME." 250 PRINT 260 LINE INPUT " NAME "; N$ 270 IF N$="" THEN 700 280 LINE INPUT "SALUTATION "; SAL$ 290 LINE INPUT " ADDRESS "; SA$ 300 LINE INPUT " CITY "; CITY$ 310 LINE INPUT " STATE "; STATE$ 320 LINE INPUT " ZIP "; Z$ 330 LINE INPUT " PHONE(S) "; PHONE$ 340 REM 350 REM ***************************************** 360 REM CHECK NEW ENTRIES FOR ACCURACY 370 PRINT 380 PRINT N$ 390 PRINT SA$ 400 PRINT CITY$;", ";STATE$;" "Z$ 410 PRINT 420 PRINT "Dear ";SAL$ 430 PRINT 440 PRINT "PHONE(S) ";PHONE$ 450 PRINT 460 PRINT 470 LINE INPUT "IS THIS CORRECT? "; H$ 480 IF H$="N" THEN 540 490 IF H$="n" THEN 540 500 IF H$="y" THEN 610 510 IF H$="Y" THEN 610 520 PRINT "PLEASE ENTER A Y FOR YES OR AN N FOR NO." 530 GOTO 470 540 PRINT CHR$(26) 550 PRINT "DATA ABANDONED, RE-ENTER";CHR$(7) 560 PRINT 570 GOTO 220 580 REM 590 REM ***************************************** 600 REM ENTER DATA ON FILE 610 PRINT CHR$(26) 620 PRINT "DATA WILL BE ENTERED ON FILE" 630 PRINT 640 WRITE #2, N$,SAL$,SA$,CITY$,STATE$,Z$,PHONE$ 650 PRINT 660 GOTO 220 670 REM 680 REM ***************************************** 690 REM DATA ENTRY COMPLETE, CLOSE & RENAME FILES 700 CLOSE 710 IF F=0 GOTO 750 720 ON ERROR GOTO 850 730 KILL "B:LIST.BAK" 740 NAME "B:LIST.LST" AS "B:LIST.BAK" 750 NAME "B:TEMP" AS "B:LIST.LST" 760 GOTO 870 770 REM 780 REM ***************************************** 790 REM ERROR RECOVERY SECTION, IE FILES LIST.LST 800 REM OR LIST.BAK DID NOT EXIST 810 IF ERR<>53 OR ERL<>100 THEN 860 820 OPEN "O",#2,"B:TEMP" 830 LET F=0 840 RESUME 210 850 IF ERR = 53 THEN RESUME 740 860 PRINT "ERROR ";ERR;" IN LINE ";ERL 870 END Thi progra accept name salutation address city state zip an phone an create Mailmerg compatabl mailin lis i fil calle LIST.LST I als maintain a ol cop calle LIST.BA i muc th sam wa tha WordSta create backu copie eac tim yo modif document You'l notic tha th progra i broke u int parts s let' loo a eac o thos part an tr t ge fee fo wha the do. 1 Line 10-4 Se th scree widt an provid genera informatio i th for o RE o remar statements. 2 Line 80-17 rea th ol dat fro LIST.LS an writ i t th fil TEMP Th erro trappin i use her s tha th progra doesn' bom th firs tim yo us it whe ther i n LIST.LS t star with 3 I sectio three line 21 t 330 you'r aske t ente th informatio fo eac perso o you mailin list I i als her tha yo tel th progra you'r finishe enterin dat b enterin " RETUR FO NAME." 4 Line 37 t 57 displa th dat fo you giv yo th chanc t accep o rejec it The als sen yo bac t sectio i yo wan t re-ente th data o o t sectio i yo wan t sav th dat yo jus entered. 5 Line 610-66 writ th informatio t th fil TEMP an sen yo bac t sectio 3. 6 Line 700-76 clos th fil TEMP delet th ol LIST.BA fil (i i existed) renam th ol LIST.LS fil a LIST.BAK an renam th TEM fil a LIST.LST The sectio si take yo t th en o th program. 7 Line 810-87 handl th anticipate errors specificall tryin t OPE o KIL file tha d no ye exist Thi occur th firs tw time yo us th program Th firs tim ther i neithe LIST.LS o LIST.BA t OPE o KIL respectively Th secon tim ther i n LIST.BA t KILL Thes specia problem ar handle b th erro trap i thi section an progra executio resume a th appropriat line. No we'l loo a th fil handlin i littl mor detail Notic i sectio w OPE th ol versio o LIST.LS fo input an ne fil calle TEM fo output I lin 14 w rea lin fro LIST.LST an i lin 15 w writ tha lin t TEMP Thi repeat unti we'v rea al th record fro LIST.LST Whe al hav bee read th En O Fil function,(EO i lin 130 i true an w g t lin 170 clos th ol LIST.LST an procee t sectio 3 I i b readin al th ol informatio int th ne fil tha yo avoi th proble o deletin al th ol informatio i sequentia fil ever tim yo ope i fo Output. Section an reall hav nothin t d wit th files Her yo jus ente an confir th dat fo give person We'l discus late i thi articl ho yo migh modif thes sections an sectio t customiz thi progra t you requirements. I t' i sectio 5 lin 640 tha w actuall writ ne informatio t th fil TEMP Quotatio mark ar place aroun eac item an th item ar seperate b comma automaticall becaus w chos th WRIT statement Thi lin i th thir ite tha ha t b change whe yo wan t customiz thi program. I sectio you'l notic tha it' possibl t delet (KILL fil fro insid a Mbasi program an als tha yo ca reNAM file fro insid th program Se line 730-750. B no yo ca se tha w reall haven' don muc mor wit th file tha w di i th previou article bu b puttin th sam statement int dat entr program it' possibl fo u t us thos file to solve a ver practica problem Normall you' pu thi progra o dis wit Mbasic an pu tha dis i th drive The pu blan formatte dis i driv an ru th program cal i NEWNAMES bu yo ca cal i whateve yo want Loa Mbasi an ru NEWNAMES It' reall quit sel explanitory askin yo fo th name salutation address city state zip an phon number(s o eac perso yo wan o you mailin list I the create th fil LIST.LST on lin o whic migh loo somethin lik this. "Joh Gaudio","John","Bo 27826","Denver","CO","80226","(303 934-1407" T us suc fil i Mailmerg you'l nee th statements: .D LIST.LST .R NAME,SAL,ADDR,CITY,STATE,ZIP,PHONE I yo wan t modif thi program yo mus mak thre change i th progra an on i th WordSta Mailmerg file Sa yo wan t ad COMPAN t you lis o items Yo would 1 Ad line sa 285 patterne afte thos abov an belo i. Consider something like: 28 LIN INPU COMPAN " COM$ 2 Ad line perhap 385 t displa th compan nam fo review I mihg read: 38 PRIN $COM 3 Modif lin 64 th statemen tha write informatio t th disk t includ you new variable i thi cas COM$ Th ne lin migh b somethin like: 64 WRIT #2 N$,SAL$,COM$,SA$,CITY$,STATE$,ZIP$,PHONE$ 4 Finall th .R statemen i th WordSta Mailmerg documen mus b change a well It' extremel importan tha th orde o th variable i lin 64 b identica t th orde o th variable i th .R statement an tha non o the b lef out Yo can o course us differen set o name i th tw statement however Th .R statemen tha goe wit th versio o lin 64 abov migh read: .R NAME,SAL,COMPANY,ADDR,CITY,STATE,ZIP,PHONE have sent thi progra t bot th FO an DO libraries an suspec tha i wil fal unde th APPLICATION section Th progra nam wil b NEWNAMES.BAS an thi articl wil serv a documentation probabl unde th titl NEWNAMES.DOC thin you'l fin usin i t b muc easie tha creatin Mailmerg dat file b hand an hop you'l lear fe trick abou fil handling dat entry an erro trappin b lookin mor closel a th program Abov al though hop you'l enjo it!  statemen i th WordSta Mailmerg documen mus b change a well It' extremel importan tha th orde o th variable i lin 64 b identica t th orde o th variable i th .R statement an tha non o the b lef out Yo can o course us differen set o name i th tw statement however Th .R statemen tha goe wit th versio o lin 64 abov migh read: .R NAME,SAL,COMPANY,ADDR,CITY,STATE,ZIP,PHONE have sent thi progra t bot th FO an DO libraries an suspec tha i wil fal unde th APPLICATION section Th progra nam wil b NEWNAMES.BAS an thi articl wil serv a documentation probabl unde th titl NEWNAMES.DOC thin you'l fin usin i t b muc easie tha creatin Mailmerg dat file b hand an hop you'l lear fe trick abou fil handling dat entry a5 ' 400 ' Team stats 410 : 420 ' Variables used 430 ' No = Team number(2) 440 ' Tna$ = Team name(13) 450 ' Wns = Wins(2) 460 ' Los = Losses(2) 470 ' T = ties(2) 480 ' Pct = percentage of wins(5) 490 ' FR = points scored by team(3) 500 ' AGNST = points scored against team(3) 510 ' RATE = power rating(3) 520 : 530 : 540 ' Files used 550 ' NFLFYL= R_A file 560 : 565 DIM K(28,8) 570 ' File initialization 580 OPEN "O",1,"B:NFLFYL" 600 FOR I=1 TO 28 603 READ TNA$ 605 FOR J=1 TO 8 640 K(I,J)=0:K(I,1)=I 645 NEXT J 650 PRINT CHR$(26) 655 PRINT TNA$ 660 INPUT "WHAT IS THE POWER RATING? ";K(I,8) 760 PRINT CHR$(26) 770 PRINT TNA$,K(I,8) 780 LINE INPUT "IS THAT CORRECT? (Y/N) ";R$ 790 IF R$<>"Y" THEN 650 800 ' PRINT TO FILE 805 FOR J=1 TO 8 810 WRITE #1,K(I,J) 815 NEXT J 820 NEXT I 830 ' CLOSE FILE 840 CLOSE 1 850 STOP 860 OPEN "I",1,"B:NFLFYL" 880 FOR I=1 TO 28 885 FOR J=1 TO! 8 890 INPUT #1,K(I,J) 970 PRINT K(I,J); 975 NEXT J:PRINT 980 NEXT I 990 CLOSE 1000 END 1010 DATA BALTIMORE,MIAMI,NEW ENGLAND,N.Y.JETS,BUFFALO,CINCINNATI 1020 DATA PITTSBURGH,HOUSTON,CLEVELAND,OAKLAND,DENVER,SAN DIEGO,SEATTLE 1030 DATA KANSAS CITY,DALLAS,PHILADELPHIA,WASHINGTON,ST. LOUIS 1040 DATA N.Y. GIANTS,MINNESOTA,CHICAGO,DETROIT,GREEN BAY,TAMPA BAY,LOS ANGELES 1050 DATA ATLANTA,SAN FRANCISCO,NEW ORLEANS  1040 DATA N.Y. GIANTS,MINNESOTA,CHICAGO,DETROIT,GREEN BAY,TAMPA BAY,LOS ANGELES 1050LFYL" 600 FOR I=1 TO 28 603 READ TNA$ 605 FOR J=1 TO 8 640 K(I,J)=0:K(I,1)=I 645 NEXT J 650 PRINT CHR$(26) 655 PRINT TNA$ 660 INPUT "WHAT IS THE POWER RATING? ";K(I,8) 760 PRINT CHR$(26) 770 PRINT TNA$,K(I,8) 780 LINE INPUT "IS THAT CORRECT? (Y/N) ";R$ 790 IF R$<>"Y" THEN 650 800 ' PRINT TO FILE 805 FOR J=1 TO 8 810 WRITE #1,K(I,J) 815 NEXT J 820 NEXT I 830 ' CLOSE FILE 840 CLOSE 1 850 STOP 860 OPEN "I",1,"B:NFLFYL" 880 FOR I=1 TO 28 885 FOR J=1 TO150 DIM K(28,8),V$(120),T$(4),U5(120),X(28) 160 V$="BLTMIAMN.E.NY.JBUFFCINCPITTHOUSCLEVOAK DENVS.D.STTLK.C.DALLPHILWASHS.L.NY.GMINNCHI DET G.B.T.B.L.A.ATL.S.F.N.O." 480 INPUT "Results are for which week of season? ",W1 600 'Name of program is NFLUPDAT 640 OPEN "I",1,"B:NFLFYL" 650 FOR I=1 TO 28 660 FOR J=1 TO 8 670 INPUT #1,K(I,J) 680 NEXT J 690 NEXT I 695 CLOSE 697 PRINT" TEAM WON LOST TIED PCT PF PA PR" 700 FOR I=1 TO 28 702 IF I<>1 THEN U5=(I-1)*4 ELSE U5=1 705 PRINT I;" ";MID$(V$,U5,4); 707 Z3=10 710 FOR J=2 TO 8 720 PRINT TAB(Z3);K(I,J); 723 Z3=Z3+5 725 NEXT J 726 PRINT 727 NEXT I 731 INPUT "Do you need to edit any of the numbers? ",A$ 732 IF LEFT$(A$,1)<>"Y" THEN 738 733 INPUT "Number of team wh;ose record needs correction. ",I 734 IF I<1 OR I>28 THEN PRINT"Between 1 and 28.":GOT 733 735 GOSUB 2500 736 INPUT "If another correction needed enter 'Yes",A$ 737 IF LEFT$(A$,1)="Y" THEN 733:PRINT 738 PRINT ENTER THIS WEEK's results.":?:? 739 'Figures stats for the season so far 750 FOR I=1 TO 28 760 F1=0:A1=0 765 IF I<>1 THEN U5=(I-1)*4 ELSE U5=1 767 PRINT MID$(V$,U5,4): 770 INPUT "Score ",F1 772 INPUT "Opponent's score ",A1 775 INPUT "Opponent's power rating from last week ",O 776 PRINT MID$(V$,U5,4),"Score","Opp.score","Opp.power rating" 777 PRINT"",F1,A1,O 778 INPUT "If correct enter 'Y' else 'N' to correct ",B$ 779 IF LEFT$(B$,1)<>"Y" THEN 767 780 H=0 790 H=K(I,8)-O 800 D=0 810 D=F1-A1 820 L=D-H 839 IF F1>A1 THEN K(I,2)=K(I,2)+1:GOTO 870 840 IF F10 THEN K(I,5)=.5:GOTO 1080 900 W2=K(I,2):L2=K(I,3):T2=K(I,4) 910 K(I,5)=(INT(1000*((W2+T2/2)/W1)+.0005))/1000 920 IF L=0 THEN K(I,8)=K(I,8):GOTO 1080 930 IF L<0 THEN 1030 940 IF L<5 THEN K(I,8)=K(I,8):GOTO 1080 950 IF L<10 THEN K(I,8)=K(I,8)+1:GOTO 1080 960 IF L<15 THEN K(I,8)=K(I,8)+2:GOTO 1080 970 IF W1>8 AND L>19 THEN K(I,8)=K(I,8)+2:GOTO 1080 980 IF L<20 THEN K(I,8)=K(I,8)+3:GOTO 1080 990 IF W1>5 AND L>19 THEN K(I,8)=K(I,8)+3:GOTO 1080 1000 IF L>19 THEN K(I,8)=K(I,8)+4:GOTO 1080 1010 IF W1>8 AND L<-15 THEN K(I,8)=K(I,8)-2:GOTO 1080 1020 IF W1>5 AND L<-19 THEN K(I,8)+K(I,8)-3:GOTO 1080 1030 IF L<-19 THEN K(I,8)=K(I,8)-4:GOTO 1080 1040 IF L<-15 THEN K(I,8)=K(I,8)-3:GOTO 1080 1050 IF L<-10 THEN K(I,8)=K(I,8)-2:GOTO 1080 1060 IF L<-5 THEN K(I,8)=K(I,8)-1:GOTO 1080 1070 K(I,8)=K(I,8) 1075 PRINT"T W L T PCT PF PA PR" 1080 PRINT K(I,1);K(I,2);K(I,3);K(I,4);K(I,5);K(I,6);K(I,7);K(I,8) 1082 INPUT "Are the figures correct? ",A$ 1083 IF LEFT$(A$,1)="Y" THEN 1090 ELSE GOSUB 2500 1090 NEXT I 1100 ' 1110 STOP 1120 PRINT 1130 OPEN "O",1,"B:NFLFYL" 1140 FOR I=1 TO 28 1150 FOR J=1 TO 8 1160 WRITE #1,K(I,J) 1170 NEXT J:NEXT I 1180 CLOSE 1200 LPRINT "Team power rating to use week ",W1+1 1210 PRINT 1220 FOR I=1 TO 28 1230 IF I<>1 THEN U5=(I-1)*4 ELSE U5=1 1240 LPRINT K(I,1);TAB(5);MID$(V$,U5,4);TAB 15;K(I,8) 1250 NEXT I 1330 S=S+.0001 1340 FOR I=1 TO 28 1350 S=S+.00001 1360 K(I,5)=K(I,5)+S 1370 NEXT I 1380 T1=0:T2=0 1390 PRINT"To print standings by conf. and division" 1400 PRINT"enter conf and division. To end;, enter 'None'." 1410 INPUT "Conference? ",C$ 1420 INPUT "Division? ",D$ 1425 IF C$="NONE" THEN 1840 1430 INPUT "Number of first and last team in division ",T1,T2 1440 FOR I=T1 TO T2 1450 FOR J=1 TO 8 1460 PRINT K(I,J); 1470 NEXT J:PRINT:NEXT I 1480 FOR I=T1 TO T2 1490 J=5 1500 NEXT I 1510 FOR I=T1 TO T2 1520 X=K(I,5) 1530 X(I)=X 1540 NEXT I 1550 PRINT 1570 FOR I=T1 TO T2-1 1590 FOR J=I+1 TO T2 1600 IF X(J)>=X(I) THEN 1650 1610 SWAP X(I),X(J) 1650 NEXT J:NEXT I 1670 PRINT 1680 PRINT 1700 LPRINT C$,D$ 1710 LPRINT 1720 LPRINT"Team W L T PCT PF PA PR" 1730 LPRINT 1740 FOR I=T2 TO T1 STEP-1 1750 FOR J=T1 TO T2 1760 IF X(I)=K(J,5) THEN T7=J 1770 NEXT J 1780 IF K(T7,1)<>1 THEN U5=(K(T7,1)-1)*4 ELSE U5=1 1790 LPRINT MID$(V$,U5,4); 1800 LPR"INT TAB(6);K(T7,2);TAB(9);K(T7,3);TAB(13);K(T7,4);TAB(17); USING "#.###";K(T7,5); 1805 LPRINT TAB(23);K(T7,6);TAB(27);K(T7,7);TAB(31);K(T7,8) 1810 NEXT I 1830 GOTO 1380 1840 PRINT 1850 PRINT"This will print out a point-spread prediction for" 1860 PRINT"upcoming games." 1870 PRINT:PRINT"Enter numbers of teams as requested." 1880 PRINT"To end the program, enter '99' for the home team." 1890 PRINT:PRINT 1910 INPUT "Home team number? ",X2 1920 IF X2=99 THEN 2140 1930 INPUT "Visiting team number? ",Y2 1940 IF K(X2,1)<>1 THEN U5=(K(X2,1)-1)*4 ELSE U5=1 1950 IF K(Y2,1)<>1 THEN U6=(K(Y2,1)-1)*4 ELSE U6=1 1960 PRINT 1970 LPRINT"Home team and visitors power ratings:" 1980 LPRINT MID$(V$,U5,4);K(X2,8),MID$(V$,U6,4);K(Y2,8) 1990 PRINT 2000 D=K(X2,8)+4-K(Y2,8) 2010 IF D>0 THEN 2020 ELSE 2060 2020 LPRINT MID$(V$,U5,4);" is favored over ";MID$(V$,U6,4);" by ";D;" points." 2030 LPRINT 2050 GOTO 1910 2060 IF D=0 THEN LPRINT"Game is a toss-up between ";MID$(V$,U5,4);" and ";MID$(V$,U6,4):GOTO 1910 2070 LPRINT 2080 PRINT 2100 LPRINT MID$(V$,U6,4);" is favored over ";MID$(V$,U5,4);" by ";ABS(D);" points." 2110 LPRINT 2120 PRINT 2130 GOTO 1910 2150 END 2495 END 2500 X1=2 2510 IF X1=2 THEN B$="Wins" 2520 IF X1=3 THEN B$="Losses" 2530 IF X1=4 THEN B$="Ties" 2540 IF X1=5 THE X1=X1+1: GOTO 2510 2550 IF X1=7 THEN B$="Pnts agnast" 2551 IF X1=8 THEN RETURN 2553 IF I<>1 THE U5=(I-1)*4 ELSE U5=1 2557 PRINT MID$(V$,U5,4);" ":B$;"=";K(I,X1) 2560 IPUT "Is the figure correct? ",A$ 2570 IF LEFT$(A$,1)="Y" THEN X1=X1+1:GOTO 2510 2580 INPUT "Enter correct number",A 2590 K)I,X1)=A:X1=X1+1:GOTO 2510 ? ",A$ 2570 IF LEFT$(A$,1)NT"Home team and visitors power ratings:" 1980 LPRINT MID$(V$,U5,4);K(X2,8),MID$(V$,U6,4);K(Y2,8) 1990 PRINT 2000 D=K(X2,8)+4-K(Y2,8) 2010 IF D>0 THEN 2020 ELSE 2060 2020 LPRINT MID$(V$,U5,4);" is favored over ";MID$(V$,U6,4);" by ";D;" points." 2030 LPRINT 2050 GOTO 1910 2060 IF D=0 THEN LPRINT"Game is a toss-up between ";MID$(V$,U5,4);" and ";MID$(V$,U6,4):GOTO 1910 207010 REM SPELLTST PROGRAM, VERSION 1.0 20 REM WRITTEN BY AUSTIN ARDOIN 26 REM MEMBER 1st FOG SV 30 REM MAR. 4, 1983 40 REM ON AN OSBORNE 1 COMPUTER 90 : 100 REM VARIABLES USED********************* 110 : 120 REM F$ = FILE NAMES 130 REM D$ = DEFINATIONS 135 REM D1$= USER DEFINITION RESPONSE 140 REM W$ = WORDS 145 REM W1$= USER SPELLING RESPONSE 150 REM Q$ = USER RESPONSE 155 REM D = USER RESPONSE FOR DEFINITION SELECTION 157 REM F = USER RESPONSE FOR DIFFERENT FILE 200 REM I = COUNTING VARIABLE 210 REM N = USER RESPONSE 212 REM S = USER RESPONSE FOR SPELLING SELECTION 215 REM T = COUNTING VARIABLES FOR EXTRA TRIALS 216 REM W = COUNTING VARIABLE FOR CORRECT SPELLINGS/DEFINITIONS 217 REM X = COUNTING VARIABLE 220 REM Y = USER RESPONSE 490 : 500 REM PROGRAM INIALIZATION************* 510 : 515 DIM W$(100): DIM D$(100) 520 PRINT CHR$(26) 530 PRINT "DO YOU NEED INSTRUCTIONS (Y/N)?":Q$=INPUT$ (1) 540 IF Q$="N" OR Q$="n" THEN 1000 550 : 560 REM  INSTRUCTIONS********************* 570 : 575 PRINT CHR$(26) 577 PRINT " MEANS PRESS CARRIAGE RETURN." 579 PRINT 580 PRINT "WHEN REQUESTED, ENTER FILE NAME OF 8 CHARACTERS" 590 PRINT "MAXIMUM, AND AN EXTENSION OF 3 CHARACTERS" 600 PRINT "MAXIMUM." 610 PRINT 620 PRINT "WHEN REQUESTED, TYPE THE SPELLING WORD IN UPPER" 630 PRINT "OR LOWER CASE AS APPROPRIATE." 640 PRINT 650 PRINT "WHEN REQUESTED, TYPE THE DEFINATION. CHOOSE THE" 660 PRINT "DEFINITION YOU LIKE BEST IF THE WORD HAS MORE" 665 PRINT "THAN ONE." 690 PRINT 700 PRINT "WHEN ALL SPELLING WORDS AND DEFINITIONS HAVE" 710 PRINT "BEEN ENTERED, TYPE 'DONE' INSTEAD OF THE" 715 PRINT "NEXT SPELLING WORD." 720 PRINT 730 PRINT "OTHER INSTRUCTIONS WILL BE GIVEN AS THE PROGRAM" 740 PRINT "PROGRESSES." 750 PRINT 760 PRINT "PUSH RETURN TO CONTINUE.":Q$=INPUT$ (1) 960 : 970 REM NEW WORD ENTRY ROUTINE************ 980 : 1000 PRINT CHR$(26) 1005 PRINT "DO YOU WANT TO ENTER NEW SPELLING WORDS AND THEIR" 1010 PRINT "DEFINITIONS (Y/N)?";:Q$=INPUT$ (1) 1020 IF Q$="N" OR Q$="n" THEN 2500 1030 PRINT CHR$(26) 1080 PRINT "ENTER DISK DRIVE AND OUTPUT DISK FILE NAME LIKE" 1084 PRINT "THIS:" 1085 PRINT 1090 PRINT " B:11-15-83.SPL : " 1095 PRINT 1100 LINE INPUT F$ 1110 OPEN "O", #1, F$ 1115 : 1150 : 1160 REM ENTRY ROUTINE******************* 1170 : 1180 LET I=1 1200 PRINT CHR$(26) 1201 PRINT "ENTER WORD #";I;": ";:LINE INPUT W$(I) 1205 IF W$(I)="DONE" OR W$(I)="done" OR W$(I)="Done" THEN 2000 1210 PRINT CHR$(26) 1220 PRINT "ENTER DEFINITION OF ";W$(I);": " 1230 LINE INPUT D$(I) 1240 PRINT CHR$(26) 1250 PRINT "YOU TYPED WORD #";I;" AND DEFINITION LIKE THIS:" 1260 PRINT 1270 PRINT W$(I),D$(I) 1280 PRINT 1290 PRINT "ARE THEY CORRECT (Y/N)?":Q$=INPUT$ (1) 1300 IF Q$="N" OR Q$="n" THEN PRINT "THEN RE-";:GOTO 1201 1310 IF Q$="Y" OR Q$="y" THEN WRITE #1, W$(I), D$(I):GOTO 1315 1312 PRINT "PLEASE WE MUST HAVE A 'Y' OR A 'N'":GOTO 1290 1315 LET I=I+1 1320 GOTO 1200 2000 CLOSE #1 2010 PRINT CHR$(26) 2020 PRINT "ENTRIE#S COMPLETED" 2030 PRINT 2040 PRINT "DO YOU WANT TO ENTER WORDS AND DEFINITIONS IN" 2050 PRINT "ANOTHER FILE (Y/N)?":Q$=INPUT$ (1) 2060 IF Q$="Y" OR Q$="y" THEN 1030 2062 PRINT CHR$(26) 2063 PRINT "DO YOU WANT TO TAKE A SPELLING OR DEFINATION" 2064 PRINT "TEST?":Q$=INPUT$ (1) 2065 IF Q$="N" OR Q$="n" THEN 5100 2470 : 2480 REM SPELLING/DEFINITION TEST ROUTINE*********** 2490 : 2500 PRINT CHR$(26) 2510 PRINT "ENTER DATA FILE TO READ WORDS AND DEFINITIONS" 2520 PRINT "FROM (LIKE THIS: B:12-22-83.SPL):" 2525 LINE INPUT F$ 2530 OPEN "I",#1,F$ 2535 LET I = 0 2536 PRINT CHR$(26) 2537 PRINT "READING IN DATA FROM ";F$;"." 2538 PRINT 2539 PRINT "PLEASE STAND BY." 2540 IF EOF (1) THEN 2600 2545 LET I = I+1 2550 INPUT #1, W$(I), D$(I) 2560 GOTO 2540 2600 PRINT CHR$(26) 2605 PRINT "FOR A SPELLING TEST PRESS S" 2610 PRINT "FOR A DEFINITION TEST PRESS D" 2620 Q$=INPUT$ (1) 2630 IF Q$="S" OR Q$="s" THEN 2700 2640 IF Q$="D" OR Q$="d" THEN 4000 2645 PRINT CHR$(26) 2650 PRINT "YOU PRESSED ";Q$:". PLEASE PRESS S OR D" 2660 GOTO 2600 2670 : 2680 REM SPELLING TEST********************* 2690 : 2700 PRINT CHR$(26) 2710 PRINT "ENTER THE WORDS FOR THE FOLLOWING DEFINATIONS." 2712 PRINT "THEY MUST BE EXACTLY AS CONTAINED IN DATA" 2714 PRINT "FILE ";F$;"." 2720 PRINT 2730 PRINT "PUSH RETURN TO START":Q$=INPUT$ (1) 2735 LET T=0:LET W=0 2740 FOR X=1 TO I 2750 PRINT CHR$(26) 2760 PRINT D$(X) 2770 LINE INPUT W1$ 2780 IF W1$=W$(X) THEN GOTO 3000 2790 PRINT "WRONG. DO YOU WANT TO TRY AGAIN (Y/N)?":Q$=INPUT$ (1) 2800 IF Q$="Y" OR Q$="y" THEN LET T=T+1:GOTO 2750 2810 NEXT X 2820 PRINT CHR$(26) 2830 PRINT "NUMBER OF WORDS: ";I 2840 PRINT "NUMBER OF CORRECT SPELLINGS: ";W 2850 PRINT "NUMBER OF SPELLING TRIALS: ";I+T 2855 PRINT 2860 PRINT "TO REPEAT THE SPELLING TEST, PUSH S" 2865 PRINT 2870 PRINT "TO TAKE THE DEFINITION TEST, PUSH D" 2872 PRINT 2875 PRINT "TO TAKE A DIFFERENT SPELLING/DEFINITION TEST," 2876 PRINT "PUSH F" 2877 PRINT 2880 PRINT "TO QUIT, PUSH RETURN" 2890 Q$=INPUT$ (1) 2900 IF Q$="S" OR Q$="s" THEN 2700 2910 IF Q$="D" OR Q$="d" THEN 4000 2915 IF Q$="F" OR Q$="f" THEN CLOSE #1:GOTO 2500 2920 GOTO 5100 3000 PRINT 3002 PRINT "CORRECT! PUSH RETURN FOR NEXT WORD":Q$=INPUT$ (1) 3005 LET W=W+1 3010 GOTO 2810 3970 : 3980 REM DEFINITION TEST***************** 3990 : 4000 PRINT CHR$(26) 4010 PRINT "ENTER DEFINITIONS FOR THE FOLLOWING WORDS." 4012 PRINT "THEY MUST BE EXACTLY AS CONTAINED IN DATA" 4014 PRINT "FILE ";F$;"." 4020 PRINT 4030 PRINT "PUSH RETURN TO START":Q$=INPUT$ (1) 4035 LET T=0:LET W=0 4040 FOR X = 1 TO I 4050 PRINT CHR$(26) 4060 PRINT W$(X) 4070 LINE INPUT D1$ 4080 IF D1$=D$(X) THEN 5000 4090 PRINT "WRONG! DO YOU WANT TO TRY AGAIN (Y/N)?":Q$=INPUT$ (1) 4100 IF Q$="Y" OR Q$="y" THEN LET T=T+1:GOTO 4050 4110 NEXT X 4120 PRINT CHR$(26) 4130 PRINT "NUMBER OF WORDS: ";I 4135 PRINT "NUMBER OF CORRECT DEFINITIONS: ";W 4140 PRINT "NUMBER OF DEFINITION TRIALS: ";I+T 4145 PRINT 4150 PRINT "TO REPEAT DEFINITON TEST, PUSH D" 4160 PRINT 4170 PRINT "TO TAKE THE SPELLING TEST, PUSH S" 4180 PRINT 4190 PRINT "TO TAKE A DIFFERENT SPELLING/DEFINITION TEST," 4200 PRINT "PUSH F" 4205 PRINT 4210 PRINT "TO QUIT, PUSH RETURN" 4220 Q$=INPUT$ (1) 4230 IF Q$="S" OR Q$="s" THEN 2700 4240 IF Q$="D" OR Q$="d" THEN 4000 4250 IF Q$="F" OR Q$="f" THEN CLOSE #1:GOTO 2500 4260 GOTO 5100 5000 PRINT 5002 PRINT "CORRECT! PUSH RETURN FOR NEXT WORD":Q$=INPUT$ (1) 5005 LET W=W+1 5010 PRINT CHR$(26) 5015 GOTO 4110 5100 CLOSE #1 5110 PRINT CHR$(26);"END OF TEST" 5120 END $=INPUT$ (1) 5005 LET W=W+1 5010 PRINT CHR$(26) 5015 GOTO 4070 LINE INPUT D1$ 4080 IF D1$=D$(X) THEN 5000 4090 PRINT "WRONG! DO YOU WANT TO TRY AGAIN (Y/N)?":Q$=INPUT$ (1) 4100 IF Q$="Y" OR Q$="y" THEN LET T=T+1:GOTO 4050 4110 NEXT X 4120 PRINT CHR$(26) 4130 PRINT "NUMBER OF WORDS: ";I 4135 PRINT "NUMBER OF CORRECT DEFINITIONS: ";W 4140 PRINT "NUMBER OF DEFINITION TRIALS: ";I+T 4145 PRINT 4150 PRINT "TO"CAT","FURRY ANIMAL THAT SAYS MEOW" "DOG","FURRY ANIMAL THAT SAYS BOW-WOW" "COW","BIG ANIMAL THAT GIVES MILK AND SAYS MOO" "HORSE","LONG LEGGED ANIMAL PEOPLE RIDE" "HOUSE","STRUCTURE PEOPLE LIVE IN" "CAR","MACHINE PEOPLE DRIVE AND RIDE IN" "BUS","MACHINE THAT CARRIES MANY PEOPLE TO SCHOOL OR WORK" RUCTURE PEOPLE LIVE IN" "CAR","MACHINE PEOPLE DRIVE AND RIDE IN" "BUS","MACSORT BAS!VWXYZEDITOR BASV[\]^_`abcdeEDITOR COMfghijklmnopqrstuEDITOR COM>vwxyz{|}MEASURE BAS+~NEWNAMESBASNEWNAMESDOCiNFLFYL NFLSTATSBAS NFLUPDATBAS-SPELLTSTBAS505-20-84$$$$ This is the release date of the disk. HELP BAS HELP-1 BAS HELP-2  HELP-3 HELP-4 1MAIL BAS *#MERGE BAS 3OPERATE BAS 58REPORT BAS D0REPT-FRMBAS PSORT BAS VEDITOR BAS [+EDITOR COM f_DITOR COM vREPORT .BAS D5 30 12288 96 REPT-FRM.BAS ED CE 5248 41 SORT .BAS 46 A5 4224 33 EDITOR .BAS C5 8C 11008 86 EDITOR .COM 2E 42 24320 190 MEASURE .BAS 01 57 5504 43 NEWNAMES.BAS 30 F3 2432 19 NEWNAMES.DOC 14 79 13440 105 NFLFYL . 00 00 0 0 NFLSTATS.BAS 80 87 1536 12 NFLUPDAT.BAS 7D D1 5760 45 SPELLTST.BAS 46 3C 6784 53 05-20-84 Fog Library Disk FOG-CPM.072 Copyright (1986) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. MBasic programs. Filename Description -06-00 .86 This is the release date of the disk. -CPM072 .DOC This is the description of the disk contents. MENU .BAS 0F44 10K [ElectronicCardFile 1 of 12] MBasic program to manage your mailing list. HELP .BAS 8C7D 2K [ElectronicCardFile 2 of 12] HELP-1 .BAS D73D 7K [ElectronicCardFile 3 of 12] HELP-2 . B2CC 3K [ElectronicCardFile 4 of 12] HELP-3 . 922D 4K [ElectronicCardFile 5 of 12] HELP-4 . F60A 13K [ElectronicCardFile 6 of 12] MAIL .BAS 0F39 9K [ElectronicCardFile 7 of 12] MERGE .BAS A1BC 2K [ElectronicCardFile 8 of 12] OPERATE .BAS 3400 15K [ElectronicCardFile 9 of 12] REPORT .BAS D530 12K [ElectronicCardFile 10 of 12] REPT-FRM.BAS EDCE 6K [ElectronicCardFile 11 of 12] SORT .BAS 46A5 5K [ElectronicCardFile 12 of 12] EDITOR .BAS C58C 11K [Editor 1 of 2] Line oriented editor similar to ED. MBasic source included. EDITOR .COM 2E42 24K [Editor 2 of 2] MEASURE .BAS 0157 6K Metric to US measurement conversions with MBasic. NEWNAMES.BAS 30F3 3K [Newnames 1 of 2] From John Gaudio's MBasic programming tutorial (Feb & Mar, 1984 FOGHORN). This is the name and address file. NEWNAMES.DOC 1479 14K [Newnames 2 of 2] NFLSTATS.BAS 8087 2K [NFL Statistics 1 of 2] MBasic program to track (and update) each team's power rating as published in the "Pro Football Annual". NFLUPDAT.BAS 7DD1 6K [NFL Statistics 2 of 2] SPELLTST.BAS 463C 7K [Spelling Test 1 of 2] Help your children's education with this MBasic program which enables you to set a spelling test or other pre-determined lesson. 05-20-84.SPL 20AF 1K [Spelling Test 2 of 2] onicCardFile 5 of 12] HELP-4 . F60A 13K [ElectronicCardFile 6 of 12] MAIL .BAS 0F3%&'