bwBASIC/BP100/TELDIR.BAS

1 REM TELDIR  
5 CLS  
10 PRINT  TAB(12); "TELEPHONE DIRECTORY":PRINT   
20 PRINT "THIS PROGRAM SETS UP AN INDEX OF TELEPHONE NUMBERS ALONG WITH  
30 PRINT "THEIR OWNERS. EACH ENTRY CONSISTS OF A PHONE NUMBER, A PERSON,   
35 PRINT "AND A COMMENT. THE PROGRAM MAKES PROVISIONS FOR RECALLING  
40 PRINT "PHONE NUMBER BY NAME. WITH A 16K MACHINE THIS PROGRAM  
45 PRINT "WILL HANDLE 200 NUMBERS. WITH MORE MEMORY MORE NAMES SHOULD  
50 PRINT "FIT, THOUGH THE DIM STATEMENT IN THE PROGRAM WOULD HAVE TO BE   
55 PRINT "CHANGED ACCORDINGLY.  
60 PRINT :PRINT "TO FACILITATE RECALL WE SUGGEST ENTERING NAMES AS  
65 PRINT "LASTNAME*FIRSTNAME E.G. SMITH*TOM. THE COMPUTER NEEDS A  
70 PRINT "PERFECT MATCH TO FIND THE NAME. THE NAME COULD ALSO BE  
75 PRINT "FOUND BY PRINTING A COMPLETE LIST.  
85 GOSUB  10100  
95 CLEAR  3500  
100 DIM  A$(200,3)  
105 GOSUB  1700  
110 CLS:INPUT "ARE DISK DRIVES ATTACHED(Y/N)";DZ$  
115 IF  DZ$<>"Y"  AND  DZ$<>"N"  THEN  GOSUB  10000  
200 CLS  
210 PRINT "            MENU"  
220 PRINT   
225 PRINT "0.QUIT  
230 PRINT "1.SET UP NEW PHONE DIRECTORY  
240 PRINT "2.ADD TO EXISTING DIRECTORY  ALREADY IN MEMORY  
250 PRINT "3.READ IN A DIRECTORY  ON CASSETTE  
260 PRINT "4.SAVE A DIRECTORY  ON CASSETTE  
263 PRINT "5.READ IN A DIRECTORY  ON DISKETTE  
265 PRINT "6.SAVE A DIRECTORY  ON DISKETTE  
270 PRINT "7.REVIEW A DIRECTORY  
280 PRINT "8.MAKE CORRECTIONS  
282 PRINT "9.FIND NAME & PHONE NUMBER  
290 PRINT :INPUT "TYPE APPROPRIATE NUMBER AND ENTER";Z1  
295 IF Z1 = 0 THEN END
300 ON  Z1 GOSUB  400,500,600,700,800,900,1000,1100,2500  
320 GOTO  200  
400 CLS:REM SET UP NEW FILE  
410 N=1  
420 GOSUB  1300  
425 PRINT   
430 INPUT "PRESS 1 FOR MORE,0 TO RETURN TO MENU";Z9  
440 IF  Z9=1 THEN N=N+1:CLS:GOTO  420  
450 IF  Z9=0 THEN RETURN   
460 GOSUB  1600 :GOTO  425  
500 CLS:REM ADD TO FILE IN MEMORY  
510 N=N+1:GOTO  420  
600 REM READ IN A FILE ON CASSETTE  
610 CLS:INPUT "PRESS ENTER WHEN CASSETTE RECORDER IS  READY";Z  
615 ' IF  DZ$="Y"  THEN  CMD"T"  
620 INPUT #-1,N  
630 GOSUB  1400  
635 ON  ERROR  GOTO  200  
640 RETURN   
700 REM SAVE A FILE ON CASSETTE  
710 CLS:INPUT "PRESS ENTER WHEN CASSETTE RECORDER IS READY";Z  
712 ' IF  DZ$="Y"  THEN  CMD"T"  
715 WRITE #-1,N  
720 GOSUB  1500  
730 RETURN   
800 REM READ IN FILE ON DISKETTE  
810 CLS:INPUT "INPUT NAME OF DESIRED DISK FILE";ZD$  
820 OPEN "I",1,ZD$  
825 INPUT # 1,N  
830 GOSUB  1450  
835 CLOSE 1  
840 PRINT :PRINT :PRINT  N;" RECORDS READ."  
850 GOSUB  10100  
890 RETURN   
900 REM WRITE OUT FILE ONTO DISKETTE  
910 CLS:PRINT  "WRITE ONTO DISKETTE OPTION":PRINT   
920 PRINT  "PRESENT DISK FILE IS ";ZD$  
925 INPUT  "NEW DISK FILE(<ENTER> FOR NO CHANGE)";ZD$  
930 OPEN "O",1,ZD$  
940 PRINT  "THERE ARE ";N;" RECORDS":PRINT :GOSUB  10100  
950 WRITE # 1,N  
960 GOSUB  1550  
970 CLOSE 1  
990 RETURN   
1000 REM REVIEW A FILE SUBROUTINE  
1003 INPUT "IS PRINTED OUTPUT DESIRED(Y/N)";Z2$  
1004 IF  Z2$<>"Y"  AND  Z2$<>"N"  THEN  GOSUB  10000:GOTO  1003  
1005 CLS:GOSUB  1700  
1007 IF  Z2$="Y"  THEN  LPRINT  F$(1)  
1010 FOR  J=1  TO  N  
1015 GOSUB  1800  
1020 IF  J/10 <> INT(J/10) THEN GOTO  1040  
1025 PRINT :INPUT "PRESS ENTER TO SEE MORE";Z9  
1030 CLS  
1035 GOSUB  1700  
1040 NEXT  J  
1045 PRINT :INPUT "PRESS ENTER TO RETURN TO MENU";Z9  
1050 RETURN   
1100 REM CORRECTION ROUTINE  
1105 Z2$="N"  
1110 CLS  
1120 INPUT "NAME OF PERSON YOU WISH TO CHANGE";B$  
1130 J=1  
1140 IF  B$=A$(J,1) THEN GOTO  1180  
1150 J=J+1:IF  J<=N THEN GOTO  1140  
1160 PRINT "NO SUCH FILE NAME IN LIST.PRESS ENTER TO RETURN TO MENU  
1170 INPUT  Z9:GOTO  200  
1180 CLS:GOSUB  1800  
1185 IF  Z1=9  THEN  INPUT "2 FOR WRONG NAME,0 TO RETURN TO MENU";Z9:GOTO  1215  
1190 PRINT :PRINT "MAKE APPROPRIATE CHANGES.PRESS ENTER FOR NO CHANGE IN FIELD"  
1200 PRINT :GOSUB  1900  
1210 INPUT "INPUT 2 FOR WRONG NAME,1 FOR  MORE CHANGE,0 TO RETURN TO MENU";Z9  
1215 IF  Z9=2  THEN  GOTO  1150  
1220 IF  Z9=1  THEN  GOTO  1110  
1230 IF  Z9=0  THEN  RETURN   
1240  GOSUB  1600:GOTO  1210  
1300 REM SUBROUTINE INPUTTING FILE DATA FROM KEYBOARD  
1305 INPUT  "LAST NAME*FIRST*NAME          ";A$(N,1)  
1310 INPUT  "A/C-PHONE # E.G.914-425-1535  ";A$(N,2)  
1315 INPUT  "COMMENT                       ";A$(N,3)  
1320 RETURN   
1400 REM INPUT OF FILE FROM CASSETTE  
1405 FOR  L=1  TO  N  
1410 INPUT #-1,A$(L,1),A$(L,2),A$(L,3)  
1415 NEXT  L  
1420 RETURN   
1450 REM INPUT OF FILE FROM DISKETTE  
1460 FOR  L=1  TO  N  
1470 INPUT # 1,A$(L,1),A$(L,2),A$(L,3)  
1480 NEXT  L  
1490 RETURN   
1500 REM OUTPUT OF FILE ONTO CASSETTE  
1505 FOR  L=1  TO  N  
1510 WRITE #-1,A$(L,1),A$(L,2),A$(L,3)  
1515 NEXT  L  
1520 RETURN   
1550 REM OUTPUT OF FILE ONTO DISKETTE  
1560 FOR  L=1  TO  N  
1570 WRITE # 1,A$(L,1),A$(L,2),A$(L,3)  
1580 NEXT  L  
1590 RETURN   
1600 REM INPUT ERROR SUBROUTINE  
1610 PRINT "INPUT ERROR TRY AGAIN"  
1620 FOR  L=1  TO  300:NEXT  L  
1630 RETURN   
1700 REM  HEADING SUBROUTINE  
1710 F$(1)="         NAME               PHONE NUMBER         COMMENT    "  
1720 F$(2)=" %                     %    %           %    %               %  
1730 PRINT  F$(1)  
1740 RETURN   
1800 REM PRINT 1 FILE DATA  
1810 PRINT USING  F$(2);A$(J,1),A$(J,2),A$(J,3)  
1815 IF  Z2$="Y"  THEN  LPRINT  USING  F$(2);A$(J,1),A$(J,2),A$(J,3)  
1820 RETURN   
1900 REM SUBROUTINE FOR INNPUTTING DATA FILE FROM KEYBOARD  
1910 INPUT  "LAST NAME*FIRST*NAME          ";A$(J,1)  
1920 INPUT  "A/C-PHONE # E.G.914-425-1535  ";A$(J,2)  
1930 INPUT  "COMMENT                       ";A$(J,3)  
1940 RETURN   
2500 GOSUB  1100:Z1=0:RETURN   
10000 PRINT "INPUT ERROR! TRY AGAIN":FOR  JZ=1 TO 500:NEXT :RETURN   
10100 INPUT "PRESS ENTER TO CONTINUE";Z9$:RETURN