30 'Telephon written by
40 'Peter Havholm
50 'College Relations Officer
60 'The College of Wooster
70 'Wooster, Ohio 44691
80 'If you make this program better (easily done), please let me know.
100 'This Program is Telephon
110 'Instructions optional
120 PRINT CHR$(26)
130 INPUT"WANT INSTRUCTIONS--ENTER Y OR N";IN$
140 PRINT CHR$(26):IF IN$<>"Y" THEN 710
150 'Initialize Index File (ONCE ONLY!!!)
160 PRINT:PRINT:PRINT:PRINT:INPUT"INITIALIZE INDEX FILE (Y OR N)";G$
170 IF G$="N"THEN 330
180 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
190 PRINT"THIS SHOULD ONLY BE DONE ONCE, OR IT WILL ERASE":PRINT
200 PRINT"A LOT OF HARD WORK.":PRINT:PRINT:PRINT
210 INPUT"ARE YOU SURE YOU WANT TO (Y OR N)";YN$:PRINT
220 IF YN$="N" THEN 330
230 OPEN "R",#2,"B:INDEX",5
240 FIELD #2,5 AS F$
250 IV=1
260 FOR J=1 TO 400
270 LSET F$=MKI$(IV)
280 PUT #2,J
290 NEXT J
300 CLOSE #2
310 PRINT CHR$(26)
320 'Instructions
330 PRINT:PRINT:PRINT:PRINT "Records in this file have five fields:":PRINT
340 PRINT "LAST NAME:    25 CHARACTERS MAXIMUM"
350 PRINT
360 PRINT "FIRST NAME:   10 CHARACTERS MAXIMUM"
370 PRINT
380 PRINT "TITLE:        25 CHARACTERS MAXIMUM"
390 PRINT
400 PRINT "EMPLOYER:     40 CHARACTERS MAXIMUM"
410 PRINT
420 PRINT "TELEPHONE:    13 CHARACTERS MAXIMUM":PRINT:PRINT
430 INPUT"PRESS RETURN TO CONTINUE  ",CO$:PRINT:PRINT:PRINT:PRINT CHR$(26)
440 PRINT "Examples:       ROBINSON"
450 PRINT
460 PRINT "                GEORGE M."
470 PRINT 
480 PRINT "                BUSINESS EDITOR"
490 PRINT
500 PRINT "                THE NEW YORK TIMES"
510 PRINT
520 PRINT "                212-423-7900
530 PRINT
540 PRINT "DO NOT PUT COMMAS IN ANY ENTRY!!!"
550 PRINT:PRINT"ADD DISTINGUISHING NUMBER TO COMMON LAST NAME."
560 PRINT:PRINT"Eg.: 'JOHNSON1' INSTEAD OF JUST 'JOHNSON'."
570 PRINT:PRINT"AND THEN ASK FOR FILE ONLY WITH COMPLETE ENTRY."
580 PRINT:PRINT:INPUT"PRESS RETURN TO CONTINUE  ",M$
590 PRINT CHR$(26)
600 PRINT:PRINT"IT IS A GOOD IDEA TO ENTER A CROSS-LISTING BY"
610 PRINT:PRINT"EMPLOYER EACH TIME YOU ENTER A NAME."
620 PRINT:PRINT"Eg.:"
630 PRINT:PRINT"          PLAIN DEALER1"
640 PRINT:PRINT"          ---------- (10 HYPHENS)"
650 PRINT:PRINT"          EDITOR 'FRIDAY'"
660 PRINT:PRINT"          GEORGE M. ROBINSON
670 PRINT:PRINT"          216-344-4532
680 PRINT:PRINT:PRINT:PRINT:INPUT"PRESS RETURN TO CONTINUE",C
690 PRINT CHR$(26)
700 'Open Main File and Index File; Display Menu
710 OPEN "R",#1,"ROLO",113
720 FIELD #1,25 AS NA$,10 AS NA1$,25 AS TI$,40 AS EMP$,13 AS PH$
730 OPEN "R",#2,"INDEX",5
740 FIELD #2,5 AS F$
750 PRINT CHR$(26):PRINT:PRINT:PRINT:PRINT:PRINT 1,"CREATE NEW ENTRY."
760 PRINT
770 PRINT 2,"DISPLAY NAME & NUMBER."
780 PRINT
790 PRINT 3,"RE-WRITE AN ENTRY."
800 PRINT
810 PRINT 4,"QUIT."
820 PRINT
830 PRINT 5,"PRINT OUT INDEX."
840 PRINT:PRINT 6,"PRINT OUT WHOLE DIRECTORY."
850 PRINT
860 PRINT:PRINT:INPUT"CHOOSE A NUMBER";CHOICE
870 PRINT
880 IF (CHOICE>0) AND (CHOICE<7) THEN 920
890  PRINT "BAD CHOICE NUMBER"
900 PRINT:PRINT:INPUT "PRESS RETURN TO TRY AGAIN",TA
910 GOTO 750
920 ON CHOICE GOSUB 940,1220,1520,1910,1940,2090
930 GOTO 750
940     'Build a new entry
950     INPUT"LAST NAME";N$:PRINT
960     GOSUB 2260
970     FOR I=1 TO 400
980     GET #2,I
990     NUM=CVI(F$)
1000     IF NUM=RECNUM% THEN 1030
1010     IF NUM>1 THEN 1200
1020    GOTO 1070
1030    PRINT "THAT RECORD NUMBER IS IN USE.":PRINT
1040    PRINT "ADD A DIGIT TO THE NAME AND TRY AGAIN.":PRINT
1050    INPUT "PRESS RETURN TO CONTINUE.",RE
1060    GOTO 1190
1070    LSET F$=MKI$(RECNUM%)
1080    PUT #2,I
1090    LSET NA$=N$
1100    INPUT "FIRST NAME";A1$:PRINT
1110    LSET NA1$=A1$
1120    INPUT "TITLE";T$
1130    LSET TI$=T$:PRINT
1140    INPUT "EMPLOYER";E$
1150    LSET EMP$=E$:PRINT
1160    INPUT "PHONE NUMBER";P$
1170    LSET PH$=P$:PRINT
1180    PUT #1,I
1190    I=400
1200    NEXT I
1210    RETURN
1220       'Display an entry
1230       INPUT "NAME";N$:PRINT
1240       GOSUB 2260
1250       FOR I=1 TO 400
1260       GET #2,I
1270       NUM=CVI(F$)
1280       IF NUM<2 THEN 1310
1290       IF NUM<>RECNUM% THEN 1500
1300       GOTO 1360
1310       PRINT "THAT NAME IS NOT IN THE FILE.":PRINT
1320       PRINT "CHECK TO MAKE SURE YOU TYPED CORRECTLY":PRINT
1330       PRINT "AND THEN MAKE A NEW ENTRY.":PRINT
1340       INPUT "PRESS RETURN TO CONTINUE",RE
1350       GOTO 1490
1360       GET #1,I
1370       PRINT CHR$(26)
1380       PRINT NA$:PRINT
1390       PRINT NA1$:PRINT
1400       PRINT TI$:PRINT
1410       PRINT EMP$:PRINT
1420       PRINT PH$:PRINT:PRINT:PRINT:PRINT:PRINT
1430       INPUT "WANT TO PRINT OUT ENTRY (Y OR N)";YN$
1440       IF YN$="Y" THEN 1450 ELSE 1490
1450       LPRINT NA$:LPRINT:LPRINT NA1$:LPRINT:LPRINT TI$:LPRINT:
1460       LPRINT EMP$:LPRINT:LPRINT PH$:LPRINT
1470       FOR J=1 TO 12:PRINT:NEXT J
1480       INPUT "PRESS RETURN TO CONTINUE",RE
1490       I=400
1500       NEXT I
1510       RETURN
1520          'Rewrite an entry
1530          INPUT "LAST NAME";N$
1540          GOSUB 2260
1550          FOR I=1 TO 400
1560          GET #2,I
1570          NUM=CVI(F$)
1580          IF NUM<2 THEN 1610
1590          IF NUM<>RECNUM% THEN 1890
1600          GOTO 1650
1610          PRINT "THAT NAME IS NOT IN THE FILE.":PRINT
1620          PRINT "CHECK TO MAKE SURE YOU TYPED CORRECTLY.":PRINT
1630          INPUT "PRESS RETURN TO CONTINUE.",RE
1640          GOTO 1880
1650          GET #1,I
1660          PRINT CHR$(26)
1670          PRINT "MAKE CHANGES AS EACH ITEM APPEARS.":PRINT
1680          PRINT "IF NO CHANGE, PRESS RETURN.":PRINT
1690          PRINT "YOU CANNOT CHANGE THE LAST NAME":PRINT
1700          PRINT "BECAUSE THAT CHANGES THE RECORD NUMBER.":PRINT
1710          PRINT "MAKE A NEW ENTRY IF THE LAST NAME IS IN ERROR.":PRINT
1720          INPUT "PRESS RETURN TO CONTINUE.",RE
1730          PRINT:PRINT NA$:PRINT NA1$:PRINT TI$:
1740          PRINT EMP$:PRINT PH$:PRINT:PRINT:PRINT
1750          PRINT NA1$:PRINT:INPUT A1$:PRINT
1760          IF A1$<"1" THEN 1780
1770          LSET NA1$=A1$:PRINT
1780          PRINT TI$:PRINT:INPUT I$:PRINT
1790          IF I$<"1" THEN 1810
1800          LSET TI$=I$:PRINT
1810          PRINT EMP$:PRINT:INPUT MP$:PRINT
1820          IF MP$<"1" THEN 1840
1830          LSET EMP$=MP$:PRINT
1840          PRINT PH$:PRINT:INPUT OH$:PRINT
1850          IF OH$<"1" THEN 1870
1860          LSET PH$=OH$:PRINT
1870          PUT #1,I
1880          I=400
1890          NEXT I
1900          RETURN
1910     'Quit
1920     CLOSE
1930     END
1940   'Print out index
1950   FOR I=1 TO 400
1960   GET #2,I
1970   NUM=CVI(F$)
1980   IF NUM>1 THEN 2070
1990   PRINT:PRINT"YOUR FILE HAS";I-1;"NAMES.":PRINT
2000   INPUT"DO YOU WANT THEM ALL PRINTED OUT (Y OR N)";YN$
2010   IF YN$="N" THEN 2060
2020   FOR J=1 TO I-1
2030   GET #1,J
2040   LPRINT NA$;NA1$;"-----  ";PH$:LPRINT
2050   NEXT J
2060   I=400
2070   NEXT I
2080   RETURN
2090        'Print out entire file
2100        FOR I=1 TO 400
2110        GET #2,I
2120        NUM=CVI(F$)
2130        IF NUM>1 THEN 2230
2140        PRINT:PRINT"YOUR FILE HAS";I-1;"NAMES.":PRINT
2150        INPUT"DO YOU WANT THE WHOLE THING PRINTED OUT (Y OR N)";YN$
2160        IF YN$="N" THEN 2220
2170        FOR J=1 TO I-1
2180        GET #1,J
2190        LPRINT NA$:LPRINT NA1$:LPRINT TI$
2200        LPRINT EMP$:LPRINT PH$:LPRINT
2210        NEXT J
2220        I=400
2230        NEXT I
2240        RETURN
2250            'Subroutine to figure out RECNUM%
2260            RECNUM%=0
2270            FOR I=1 TO LEN(N$)
2280            RECNUM%=RECNUM%+((ASC(MID$(N$,I,1)))-48)*(26-I)
2290            NEXT I
2300            RETURN
1 TO LEN(N$)
