PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #169)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “MAILING LIST PROGRAMS”
This disk contains three mailing list programs and a membership
program, all written in BASIC. Mailist1 lets the user add new names
and addresses, and sorts files by either the name or zip code. It
updates, corrects, deletes, and prints files. It also displays a list
of phone numbers and automatically dials selected numbers. It can
add, delete, and sort your files to print labels and report lists.
The Membership program adds, renews, and reviews memberships and club
affiliations.
System Requirements: Two disk drives, BASIC or BASICA
How to Start: Check the MAILIST1.DOC, MEMBER.ASC and
EASYMENU.ASC files for directions. To run the BASIC programs,
consult the directions in GETTING STARTED for your configuration.
Suggested Registration: $15.00 for "Mail List"
File Descriptions:
EASYMAIL ASC Documentation for EASYMAIL.BAS
???MAIL BAS Part of EASYMAIL.BAS (4 files)
LAB????? BAS Part of EASYMAIL.BAS (3 files)
BUILDML BAS Part of EASYMAIL.BAS
EASYMAIL BAS Mailing label system
MAILLIST BAS Another mailing list system
MAILIST1 DOC Documentation for MAILIST1.BAS
MAILIST1 BAS Another mailing list system
????MEMB BAS Part of MEMBERS.BAS (8 files)
MEMBERS BAS Membership system based on EASYMAIL.BAS
MEMBER ASC Documentation for MEMBERS.BAS
????MAIL BAS Part of EASYMAIL (4 files)
MAILMENU BAS Part of EASYMAIL.BAS
MAILSORT BAS Sort for MAILIST1.BAS
ADDMAIL.BAS
5 KEY OFF
10 SCREEN 0,1
15 OPEN "b:maillist.ree" AS #1 LEN=128
16 FIELD #1, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
20 COLOR 15,9,4
25 CLS
30 PRINT " "
40 PRINT " "
50 PRINT " ADD TO MAILING LIST"
60 PRINT " "
70 PRINT " "
80 INPUT " NAME ==>";A$
90 PRINT " "
100 INPUT " ADDRESS LINE 1==>";B$
110 PRINT " "
120 INPUT " ADDRESS LINE 2==>";C$
130 PRINT " "
140 INPUT " CITY/STATE ==>";D$
150 PRINT " "
160 INPUT " ZIP CODE ==>";E#
170 IF E# = 0 THEN 160
210 GET #1,1
220 NEXTAVAIL$ = ZIPCODE$
230 IF NEXTAVAIL$ = " " THEN NEXTAVAIL$ = "000000004"
240 RECNUM# = CVD(ZIPCODE$)
245 RECNUM# = RECNUM# + 1
250 LSET ZIPCODE$ = MKD$(RECNUM#)
260 PUT #1,1
300 GET #1,RECNUM#
320 LSET NAM$ = A$
330 LSET ADD1$=B$
340 LSET ADD2$=C$
350 LSET CITYST$=D$
360 LSET ZIPCODE$=MKD$(E#)
380 PUT #1,RECNUM#
390 PRINT " "
395 PRINT " "
400 PRINT " LABEL ADDED"
410 PRINT " DO YOU WANT TO ADD MORE? Y OR N"
430 K$ = INKEY$: IF K$ = "" THEN 430
440 IF K$ = "Y" THEN 25
450 IF K$ = "N" THEN 500
455 IF K$ = "y" THEN 25
456 IF K$ = "n" THEN 500
460 GOTO 410
500 CLOSE #1
505 CLS
510 CHAIN "b:mailmenu
ADDMEMB.BAS
10 COMMON DRIVEID$,FILEID$,RECNUM2,DRIVEID2$,FILEID2$
20 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
30 FIELD #1, 4 AS EXPDATE$
40 GET #1,1
50 RECNUM2=CVS(EXPDATE$)+1
60 GET #1,RECNUM2
70 CLS
80 PRINT " "
90 PRINT " Add Member"
100 PRINT " "
110 PRINT " "
120 PRINT " Date Subscription Expires (YYMMDD)"
130 INPUT " ==>";DATEE
140 LSET EXPDATE$=MKS$(DATEE)
150 PUT #1,RECNUM2
160 PRINT " "
170 PRINT " Number Assigned ==>";RECNUM2
175 CLOSE #1
180 CHAIN DRIVEID$+"mailmemb"
BROWMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 4
40 OPEN "B:maillist.REE" AS #1 LEN=128
50 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
60 ON ERROR GOTO 270
70 CLS
80 PRINT " "
90 PRINT " BROWSE MAILING LIST"
100 PRINT " "
110 FOR I = 1 TO 3
120 PRINT " "
130 RECNUM = RECNUM + 1
135 IF RECNUM < 5 THEN RECNUM = 5
140 GET #1, RECNUM
150 NM$ = NAM$
160 A1$ = ADD1$
170 A2$ = ADD2$
190 ZIP# = CVD(ZIPCODE$)
195 IF ZIP# = 999999999# THEN 130
200 IF ZIP# = 0 THEN 270
210 CTST$ = CITYST$
220 PRINT " "; NM$
230 IF A1$ <> " " THEN PRINT " "; A1$
240 IF A2$ <> " " THEN PRINT " "; A2$
250 PRINT " "; CTST$
260 PRINT " "; ZIP#
270 NEXT
280 PRINT " "
290 PRINT " SPACE BAR TO CONTINUE"
300 PRINT " Esc KEY TO RETURN TO MENU"
310 PRINT " T KEY TO START OVER"
315 PRINT " B KEY TO BACK UP"
320 K$ = INKEY$: IF K$ = "" THEN 320
330 IF K$ = " " THEN 70
340 IF K$ = CHR$(27) THEN 390
360 IF K$ = "T" THEN RECNUM = 4: GOTO 70
370 IF K$ = "t" THEN RECNUM = 4: GOTO 70
375 IF K$ = "B" THEN RECNUM = RECNUM - 6: GOTO 70
376 IF K$ = "b" THEN RECNUM = RECNUM - 6: GOTO 70
380 GOTO 320
390 CLOSE #1
400 CHAIN "B:dispmail"
BUILDML.BAS
40 PRINT " "
50 PRINT " Warning, the mailing list file"
60 PRINT " is about to be erased."
70 PRINT " "
80 PRINT " Put diskette to contain new"
90 PRINT "file in drive B."
100 PRINT " To continue, press + key.
110 PRINT " Press ESC key to exit"
120 K$=INKEY$:IF K$ = "" THEN 120
130 IF K$ = "+" THEN 150
140 IF K$ = CHR$(27) THEN 610
150 OPEN "b:maillist.ree" AS #1 LEN=128
160 FIELD #1, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
180 LSET ZIPCODE$=MKD$(4)
190 CLS
200 PRINT " "
210 PRINT " SPECIFY FOR COMPANY"
220 PRINT " "
230 PRINT " "
240 INPUT " COMPANY NAME==>";COMP$
250 INPUT " ADDRESS ==>";ADDRES$
260 INPUT " CITY/STATE ==>";CTYST$
270 INPUT " PHONE NUMBER==>";PHONE$
280 LSET NAM$=COMP$
290 LSET ADD1$=ADDRES$
300 LSET ADD2$=PHONE$
310 LSET CITYST$=CTYST$
320 PUT #1,1
330 PRINT " "
340 INPUT " PURPOSE ==>";COMP$
350 INPUT " TITLE 1 ==>";ADDRES$
360 INPUT " TITLE 2 ==>";CTYST$
370 INPUT " RATE ==>";PHONE$
380 LSET NAM$=COMP$
390 LSET ADD1$=ADDRES$
400 LSET ADD2$=PHONE$
410 LSET CITYST$=CTYST$
420 PUT #1,2
421 PRINT " "
422 PRINT "-return address-"
423 INPUT " NAME ==>";COMP$
424 INPUT " ADDRESS ==>";ADDRES$
425 INPUT " ADDRESS 2 ==>";PHONE$
426 INPUT " CITY/STATE ==>";CTYST$
427 INPUT " ZIP CODE ==>";ZIP$
430 LSET NAM$=COMP$
440 LSET ADD1$=ADDRES$
450 LSET ADD2$=PHONE$
460 LSET CITYST$=CTYST$
462 ZIPCD#=VAL(ZIP$)
465 LSET ZIPCODE$=MKD$(ZIPCD#)
470 PUT #1,3
480 PRINT " "
490 COLOR 24,9
495 LOCATE 23,3
500 PRINT "FILE CREATION IN PROGRESS"
505 LOCATE 23,3
510 COLOR 15,9,4
515 Z# = 0
518 A$=MKD$(Z#)
519 ON ERROR GOTO 620
520 FOR I = 4 TO 1000
550 PRINT #1,A$
560 NEXT
570 PRINT #1,"//eof"
590 PRINT " FILE HAS BEEN BUILT "
600 ON ERROR GOTO 0: PUT #1: CLOSE
610 CHAIN "B:MAILMENU"
620 PUT #1: RESUME
BUILMEMB.BAS
10 COMMON DRIVEID$,FILEID$,DRIVEID2$,FILEID2$,RECNUM2
30 CLS
40 PRINT " "
50 PRINT " Warning, the member file is about to be erased."
70 PRINT " "
80 PRINT " Put diskette to contain new file in drive "+DRIVEID$
90 PRINT " "
95 PRINT " "
100 PRINT " To continue, press + key.
110 PRINT " Press ESC key to exit"
120 K$=INKEY$:IF K$ = "" THEN 120
130 IF K$ = "+" THEN 150
140 IF K$ = CHR$(27) THEN 610
150 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
160 FIELD #1, 4 AS EXPDATE$
180 LSET EXPDATE$=MKS$(4)
190 CLS
320 PUT #1,1
330 LSET EXPDATE$=MKS$(0)
420 PUT #1,2
470 PUT #1,3
480 PRINT " "
490 COLOR 24,9
495 LOCATE 23,3
500 PRINT "FILE CREATION IN PROGRESS"
505 LOCATE 23,3
510 COLOR 15,9,4
515 Z% = 0
518 A$=MKI$(Z%)
519 ON ERROR GOTO 620
520 FOR I% = 4 TO 20000
550 PUT #1,I%
560 NEXT
590 PRINT " FILE HAS BEEN BUILT "
600 ON ERROR GOTO 0: PUT #1: CLOSE
610 CHAIN DRIVEID$+"members"
620 PUT #1: RESUME
CHGMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 4
40 OPEN "B:maillist.REE" AS #1 LEN=128
50 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
55 RECNUM = 4
60 CLS
70 PRINT " "
80 PRINT " CHANGE MAILING LIST"
90 PRINT " "
91 PRINT " "
95 INPUT " SEARCH==>";SEARCH$
100 PRINT " "
110 RECNUM = RECNUM + 1
120 IF RECNUM < 5 THEN RECNUM = 5
130 GET #1, RECNUM
140 NM$ = NAM$
150 A1$ = ADD1$
160 A2$ = ADD2$
170 ZIP# = CVD(ZIPCODE$)
180 IF ZIP# = 999999999# THEN 110
190 IF ZIP# = 0 THEN 360
200 CTST$ = CITYST$
210 X=INSTR(NM$,SEARCH$)
220 IF X=0 THEN 230 ELSE 310
230 X=INSTR(A1$,SEARCH$)
240 IF X=0 THEN 250 ELSE 310
250 X=INSTR(A2$,SEARCH$)
260 IF X=0 THEN 270 ELSE 310
270 X=INSTR(CTST$,SEARCH$)
280 IF X=0 THEN 290 ELSE 310
290 X=INSTR(STR$(ZIP#),SEARCH$)
300 IF X=0 THEN 110 ELSE 310
310 PRINT " "; NM$
320 IF A1$ <> " " THEN PRINT " "; A1$
330 IF A2$ <> " " THEN PRINT " "; A2$
340 PRINT " "; CTST$
350 PRINT " "; ZIP#
360 PRINT " "
370 PRINT " SPACE BAR TO CONTINUE"
380 PRINT " Esc KEY TO RETURN TO MENU"
390 PRINT " T KEY TO START OVER"
410 PRINT " C KEY TO CHANGE"
420 K$ = INKEY$: IF K$ = "" THEN 420
430 IF K$ = " " THEN 110
440 IF K$ = CHR$(27) THEN 520
450 IF K$ = "T" THEN RECNUM = 4: GOTO 60
460 IF K$ = "t" THEN RECNUM = 4: GOTO 60
490 IF K$ = "C" THEN 540
500 IF K$ = "c" THEN 540
510 GOTO 420
520 CLOSE #1
530 CHAIN "B:MAILMENU"
531 PRINT " "
532 PRINT " "
540 PRINT " "
541 PRINT " "
542 INPUT " NEW NAME ==>";NN$
544 IF LEN(NN$)=0 THEN NN$=NAM$:DISP$=NN$:GOSUB 800
545 IF NN$="-" THEN NN$=" ":DISP$=NN$:GOSUB 800
560 INPUT " NEW ADDRESS1 ==>";NA1$
562 IF LEN(NA1$)=0 THEN NA1$=ADD1$:DISP$=NA1$:GOSUB 800
563 IF NA1$="-" THEN NA1$=" ":DISP$=NA1$:GOSUB 800
580 INPUT " NEW ADDRESS2 ==>";NA2$
582 IF LEN(NA2$)=0 THEN NA2$=ADD2$:DISP$=NA2$:GOSUB 800
583 IF NA2$="-" THEN NA2$=" ":DISP$=NA2$:GOSUB 800
600 INPUT " NEW CITY/ST ==>";NCT$
602 IF LEN(NCT$)=0 THEN NCT$=CITYST$:DISP$=NCT$:GOSUB 800
603 IF NCT$="-" THEN NCT$=" ":DISP$=NCT$:GOSUB 800
620 INPUT " NEW ZIP CODE ==>";NZIP#
625 IF NZIP#=0 THEN NZIP#=ZIP#:DISP$=STR$(NZIP#):GOSUB 800
630 LSET ZIPCODE$ = MKD$(NZIP#)
640 LSET NAM$=NN$
650 LSET ADD1$=NA1$
660 LSET ADD2$=NA2$
670 LSET CITYST$=NCT$
680 PUT #1,RECNUM
690 PRINT " "
691 PRINT " "
692 PRINT " "
700 PRINT " CHANGE COMPLETED"
701 PRINT " "
702 PRINT " "
703 PRINT " "
704 PRINT " "
705 PRINT " "
706 PRINT " "
707 PRINT " "
710 GOTO 360
800 SLIN=CSRLIN - 1
810 LOCATE SLIN,21
820 PRINT DISP$
830 RETURN
CRC.TXT
PC-SIG Disk No. #169, version v1
The following is a list of the file checksums which should be produced by
the CRCK4 program on disk #9 (and others). If the CRC numbers do not match
you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: ADDMAIL .BAS CRC = F2 34
--> FILE: ADDMEMB .BAS CRC = C9 8A
--> FILE: BROWMAIL.BAS CRC = 9F E6
--> FILE: BUILDML .BAS CRC = 50 12
--> FILE: BUILMEMB.BAS CRC = CB BE
--> FILE: CHGMAIL .BAS CRC = 48 D7
--> FILE: DELMAIL .BAS CRC = 79 10
--> FILE: DISPMAIL.BAS CRC = 01 79
--> FILE: DISPMEMB.BAS CRC = FA 7B
--> FILE: EASYMAIL.ASC CRC = 44 02
--> FILE: EASYMAIL.BAS CRC = 63 9C
--> FILE: LABMAIL .BAS CRC = 6F 80
--> FILE: LABPRINT.BAS CRC = D5 42
--> FILE: LABSELEC.BAS CRC = ED F9
--> FILE: LISTMAIL.BAS CRC = D5 CC
--> FILE: LOCMAIL .BAS CRC = E2 7D
--> FILE: MAILIST1.BAS CRC = 46 D2
--> FILE: MAILIST1.DOC CRC = BC 3D
--> FILE: MAILLIST.BAS CRC = 9A DC
--> FILE: MAILMEMB.BAS CRC = 30 78
--> FILE: MAILMENU.BAS CRC = 63 9C
--> FILE: MAILSORT.BAS CRC = E3 B0
--> FILE: MEMBER .ASC CRC = 81 16
--> FILE: MEMBERS .BAS CRC = 95 18
--> FILE: RENUMEMB.BAS CRC = 19 C2
--> FILE: REORMAIL.BAS CRC = A3 8B
--> FILE: REVUMEMB.BAS CRC = FB D8
--> FILE: STATMAIL.BAS CRC = 44 8A
--> FILE: STATMEMB.BAS CRC = 80 C2
--> FILE: UPDMEMB .BAS CRC = C2 8E
--> FILE: XXX . CRC = AC 95
---------------------> SUM OF CRCS = E1 62
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
DELMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 4
40 OPEN "B:maillist.REE" AS #1 LEN=128
50 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
60 ON ERROR GOTO 350
70 CLS
80 PRINT " "
90 PRINT " DELETE FROM MAILING LIST"
100 PRINT " "
110 PRINT " "
120 INPUT " SEARCH FOR ==>";SEARCH$
130 RECNUM = RECNUM + 1
140 IF RECNUM < 5 THEN RECNUM = 5
150 GET #1, RECNUM
160 ZIP# = CVD(ZIPCODE$)
161 IF ZIP# = 999999999# THEN 130
162 IF ZIP# = 0 THEN 350
170 X=INSTR(NAM$,SEARCH$)
180 IF X = 0 THEN 190 ELSE 290
190 X=INSTR(ADD1$,SEARCH$)
200 IF X = 0 THEN 210 ELSE 290
210 X=INSTR(ADD2$,SEARCH$)
220 IF X = 0 THEN 230 ELSE 290
230 X=INSTR(CITYST$,SEARCH$)
240 IF X = 0 THEN 250 ELSE 290
250 X=INSTR(STR$(ZIP#),SEARCH$)
280 IF X = 0 THEN 130
290 PRINT " "
300 PRINT " "; NAM$
310 IF ADD1$ <> " " THEN PRINT " "; ADD1$
320 IF ADD2$ <> " " THEN PRINT " "; ADD2$
330 PRINT " "; CITYST$
340 PRINT " "; ZIP#
350 PRINT " "
360 PRINT " SPACE BAR TO CONTINUE"
370 PRINT " Esc KEY TO RETURN TO MENU"
380 PRINT " T KEY TO START OVER"
390 PRINT " D KEY TO DELETE"
400 K$ = INKEY$: IF K$ = "" THEN 400
410 IF K$ = " " THEN 130
420 IF K$ = CHR$(27) THEN 490
440 IF K$ = "T" THEN RECNUM = 4: GOTO 70
450 IF K$ = "t" THEN RECNUM = 4: GOTO 70
460 IF K$ = "D" THEN 520
470 IF K$ = "d" THEN 520
480 GOTO 400
490 CLOSE #1
500 CHAIN "B:mailmenu"
510 ZIP#=999999999#
520 ZIP#=999999999#
530 LSET ZIPCODE$=MKD$(ZIP#)
540 PUT #1,RECNUM
550 PRINT " "
560 PRINT " RECORD DELETED "
570 GOTO 350
DISPMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 CLS
40 PRINT " "
50 PRINT " DISPLAY MENU"
60 PRINT " "
80 PRINT " "
85 PRINT " A - BROWSE FILE"
90 PRINT " B - LOCATE AND DISPLAY"
95 PRINT " Esc - RETURN TO MAIN MENU"
100 PRINT " "
110 PRINT " "
120 PRINT " SELECT FUNCTION BY LETTER"
130 K$ = INKEY$: IF K$ = "" THEN 130
140 IF K$ = "A" THEN 200
145 IF K$ = "a" THEN 200
150 IF K$ = "B" THEN 300
160 IF K$ = "b" THEN 300
165 IF K$ = CHR$(27) THEN 400
170 GOTO 130
200 CHAIN "b:browmail"
300 CHAIN "b:locmail"
400 CHAIN "b:mailmenu
DISPMEMB.BAS
10 COMMON DRIVEID$, FILEID$, RECNUM2, DRIVEID2$, FILEID2$
20 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
30 FIELD #1, 4 AS EXPDATE$
35 OPEN DRIVEID2$+FILEID2$ AS #2 LEN=128
38 FIELD #2, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
40 CLS
50 PRINT " "
60 PRINT " Display Members"
70 PRINT " "
80 PRINT " "
90 INPUT " Membership number ==>";RECNUM4
100 IF RECNUM4 = 0 THEN 200
105 RECNUM3=RECNUM4
110 GET #1,RECNUM3
120 RECNUM2=RECNUM3
130 GET #2,RECNUM2
140 GOTO 300
200 PRINT " "
210 INPUT " Search for ==>";SEARCH$
220 GOSUB 1000
230 IF NON=1 THEN PRINT " No Match Found":GOTO 400
240 RECNUM3 = RECNUM
250 GOTO 110
300 PRINT " "
310 PRINT " ";NAM$
320 IF ADD1$ <> SPACE$(30) THEN PRINT " ";ADD1$
330 IF ADD2$ <> SPACE$(30) THEN PRINT " ";ADD2$
340 PRINT " ";CITYST$
350 PRINT " ";CVD(ZIPCODE$)
360 PRINT " "
370 PRINT " Subscription expires --";CVS(EXPDATE$)
380 PRINT " "
390 PRINT " "
400 GOTO 1350
1000 RECNUM = 4
1060 CLS
1120 RECNUM = RECNUM + 1
1130 IF RECNUM < 5 THEN RECNUM = 5
1140 GET #2, RECNUM
1150 ZIP# = CVD(ZIPCODE$)
1160 X=INSTR(NAM$,SEARCH$)
1170 IF X = 0 THEN 1180 ELSE 1280
1180 X=INSTR(ADD1$,SEARCH$)
1190 IF X = 0 THEN 1200 ELSE 1280
1200 X=INSTR(ADD2$,SEARCH$)
1210 IF X = 0 THEN 1220 ELSE 1280
1220 X=INSTR(CITYST$,SEARCH$)
1230 IF X = 0 THEN 1240 ELSE 1280
1240 X=INSTR(STR$(ZIP#),SEARCH$)
1250 IF ZIP# = 999999999# THEN 1120
1260 IF ZIP# = 0 THEN NON=1:GOTO 1340
1270 IF X = 0 THEN 1120
1280 PRINT " "
1340 PRINT " "
1345 RETURN
1350 PRINT " SPACE BAR TO CONTINUE"
1360 PRINT " Esc KEY TO RETURN TO MENU"
1370 PRINT " T KEY TO START OVER"
1380 K$ = INKEY$: IF K$ = "" THEN 1380
1390 IF K$ = " " THEN 100
1400 IF K$ = CHR$(27) THEN 1440
1410 IF K$ = "T" THEN RECNUM = 4: GOTO 40
1420 IF K$ = "t" THEN RECNUM = 4: GOTO 40
1430 GOTO 1380
1440 CLOSE #1
1445 CLOSE #2
1450 CHAIN DRIVEID$+"members"
EASYMAIL.BAS
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
40 CLS
50 PRINT " "
55 PRINT " "
60 PRINT " EASY-MAIL AVAILABLE FUNCTIONS"
70 PRINT " "
80 PRINT " "
90 PRINT " A - DISPLAY MAILING LIST"
100 PRINT " B - ADD TO LIST"
110 PRINT " C - DELETE FROM LIST"
120 PRINT " D - CHANGE LIST"
130 PRINT " E - PRINT LABELS"
140 PRINT " F - PRINT LIST"
150 PRINT " G - REORG FILE"
160 PRINT " H - ERASE/BUILD FILE
170 PRINT " I - STATUS REPORT"
180 PRINT " Esc - EXIT"
190 PRINT " "
200 PRINT " "
210 PRINT " SELECT FUNCTION BY LETTER"
220 K$ = INKEY$: IF K$ = "" THEN 220
230 IF K$ = "A" THEN 440
240 IF K$ = "a" THEN 440
250 IF K$ = "B" THEN 450
260 IF K$ = "b" THEN 450
270 IF K$ = "C" THEN 460
280 IF K$ = "c" THEN 460
290 IF K$ = "D" THEN 470
300 IF K$ = "d" THEN 470
310 IF K$ = "E" THEN 480
320 IF K$ = "e" THEN 480
330 IF K$ = "F" THEN 490
340 IF K$ = "f" THEN 490
350 IF K$ = "G" THEN 500
360 IF K$ = "g" THEN 500
370 IF K$ = "H" THEN 510
380 IF K$ = "h" THEN 510
390 IF K$ = "I" THEN 520
400 IF K$ = "i" THEN 520
410 IF K$ = CHR$(27) THEN 530
420 IF K$ = "J" THEN 530
430 GOTO 220
440 CHAIN "B:DISPMAIL"
450 CHAIN "B:ADDMAIL"
460 CHAIN "B:DELMAIL"
470 CHAIN "B:CHGMAIL"
480 CHAIN "B:LABMAIL"
490 CHAIN "B:LISTMAIL"
500 CHAIN "B:REORMAIL"
510 CHAIN "B:BUILDML"
520 CHAIN "B:STATMAIL"
530 CLS
531 KEY ON
532 END
534 REM FOLLOWING CODE NOT NOW USED
540 PRINT " "
550 PRINT " PLACE DOS DISKETTE IN DRIVE A"
551 PRINT " PRESS ANY KEY TO PROCEED
552 K$ = INKEY$: IF K$ = "" THEN 552
553 CLS
554 CHAIN "IBMPMENU"
LABMAIL.BAS
5 COMMON UP,ENVEL
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
40 CLS
50 PRINT " "
55 PRINT " "
60 PRINT " EASY-MAIL LABEL PRINT FUNCTIONS"
70 PRINT " "
80 PRINT " "
90 PRINT " A - PRINT 1-up LABELS"
100 PRINT " B - PRINT 2-up LABELS"
110 PRINT " C - PRINT ENVELOPES"
180 PRINT " Esc - EXIT"
190 PRINT " "
200 PRINT " "
210 PRINT " SELECT FUNCTION BY LETTER"
220 K$ = INKEY$: IF K$ = "" THEN 220
230 IF K$ = "A" THEN 440
240 IF K$ = "a" THEN 440
250 IF K$ = "B" THEN 450
260 IF K$ = "b" THEN 450
270 IF K$ = "C" THEN 460
280 IF K$ = "c" THEN 460
410 IF K$ = CHR$(27) THEN 530
420 IF K$ = "J" THEN 530
430 GOTO 220
440 UP=1
442 CHAIN "B:LABSELEC"
450 UP=2
452 CHAIN "B:LABSELEC"
460 ENVEL=1
462 CHAIN "B:LABSELEC"
530 CHAIN "B:MAILMENU"
531 KEY ON
532 END
534 REM FOLLOWING CODE NOT NOW USED
540 PRINT " "
550 PRINT " PLACE DOS DISKETTE IN DRIVE A"
551 PRINT " PRESS ANY KEY TO PROCEED
552 K$ = INKEY$: IF K$ = "" THEN 552
553 CLS
554 CHAIN "IBMPMENU"
LABPRINT.BAS
10 COMMON LINPTR%(),NLINES%,MAXLEN,LINBUF$(),TOPROG$,TOFILE$,PGRDATA()
15 DIM LIN$(2,5)
16 OFFSET$=SPACE$(8)
20 CLS
22 PIND%=0
25 PRINT " "
30 PRINT " SELECT PRINTER OPTIONS"
40 PRINT " "
50 PRINT " Print to SCREEN or PRINTER?"
60 INPUT " ==>";RESP1$
70 IF RESP1$ <> "screen" AND RESP1$ <> "printer" THEN 50
80 IF RESP1$ = "screen" THEN PRINTSW=1:NCOPS=1
85 OPEN "b:maillist.ree" AS #1 LEN=128
86 FIELD#1,9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
90 IF RESP1$="printer" THEN PRINTSW=2: GOSUB 1000
100 IF RESP1$="printer" THEN GOSUB 7000
110 IF RESP1$="printer" THEN GOSUB 8000
120 IF RESP1$="printer" THEN LPRINT CHR$(27);"C";CHR$(6);: ON ERROR GOTO 4000
125 FOR J% = 1 TO NCOPS
130 FOR I% = 1 TO NLINES%
140 RECNUM%=CVI(RIGHT$(LINBUF$(LINPTR%(I%)),2))
150 GET #1,RECNUM%
160 ON PRINTSW GOSUB 2000, 3000
170 K$=INKEY$
180 IF K$=CHR$(27) GOTO 5000
190 IF K$ = "S" OR K$="s" THEN GOSUB 6000
200 NEXT
205 NEXT
210 CLOSE #1
211 IF RESP1$="printer" THEN IF PRINTSW2 = 2 THEN LSET NAM$ = "": LSET ADD1$="": LSET ADD2$="": LSET CITYST$="": LSET ZIPCODE$=MKD$(0):GOSUB 3000:GOSUB 3000
220 PRINT " Printing complete"
221 PRINT " "
222 PRINT " ";I%-1;" Labels printed
223 PRINT " "
230 GOTO 5000
1000 PRINT " "
1001 IF PGRDATA(1) = 1 THEN PRINTSW2=1: GOTO 1019
1002 IF PGRDATA(1) = 2 THEN PRINTSW2=2: RETURN
1003 IF PGRDATA(2) <> 1 THEN PRINT " ERROR FOUND";STOP
1004 INPUT " Is Return Address to be Printed";RETANS$:PRINTSW2=3
1005 IF LEFT$(RETANS$,1) = "Y" OR LEFT$(RETANS$,1) = "y" THEN RET$="Y": GOTO 1009
1006 IF LEFT$(RETANS$,1) = "N" OR LEFT$(RETANS$,1) = "n" THEN RET$="N": RETURN
1007 GOTO 1004
1009 GET #1,3
1010 RET1$=NAM$
1011 RET2$=ADD1$
1012 RET3$=ADD2$
1013 RET4$=CITYST$
1014 RET5$=SPACE$(20)+STR$(CVD(ZIPCODE$))
1015 RETURN
1019 PRINT " SELECT PRINT-TYPE OPTION"
1020 PRINT " A - Regular B - Compressed"
1030 PRINT " C - Emphasized D - Large"
1035 PRINT " E - Switch to normal characters"
1036 PRINT " F - Switch to italics"
1040 PRINT " "
1050 PRINT " Select option by letter"
1060 K$=INKEY$:IF K$="" THEN 1060
1070 IF K$="A" OR K$="a" THEN PRT$="":LPRINT CHR$(27);"F";:LPRINT CHR$(18);:RETURN
1080 IF K$="B" OR K$="b" THEN PRT$="":LPRINT CHR$(27);"F":LPRINT CHR$(15):RETURN
1090 IF K$="C" OR K$="c" THEN PRT$="":LPRINT CHR$(27);"E":RETURN
1095 IF K$="D" OR K$="d" THEN LPRINT CHR$(15);" ":PRT$=CHR$(14):RETURN
1096 IF K$="E" OR K$="e" THEN LPRINT CHR$(27);"5":GOTO 1000
1097 IF K$="F" OR K$="f" THEN LPRINT CHR$(27);"4":GOTO 1000
1098 GOTO 1060
2000 PRINT " "
2010 PRINT NAM$
2020 IF ADD1$ <> SPACE$(30) THEN PRINT ADD1$
2030 IF ADD2$<>SPACE$(30) THEN PRINT ADD2$
2040 PRINT CITYST$
2050 PRINT CVD(ZIPCODE$)
2060 RETURN
3000 ON PRINTSW2 GOTO 3010, 3100, 3200
3010 IF RET$="Y" THEN GOSUB 9000: RETURN
3019 LPRINT PRT$;NAM$
3020 IF ADD1$<>SPACE$(30) THEN LPRINT PRT$;ADD1$
3030 IF ADD2$ <> SPACE$(30) THEN LPRINT PRT$;ADD2$
3040 LPRINT PRT$;CITYST$
3050 IF PRT$ <> CHR$(14) THEN LPRINT PRT$;SPACE$(20);CVD(ZIPCODE$) ELSE LPRINT PRT$;SPACE$(16);CVD(ZIPCODE$)
3060 LPRINT CHR$(12);
3070 RETURN
3100 IF PIND%=0 THEN GOTO 3150
3105 PIND%=0
3110 LABL%=2
3120 GOSUB 3160
3125 FOR PRTI% = 1 TO 5
3130 LPRINT PRT$;LIN$(1,PRTI%);OFFSET$;LIN$(2,PRTI%)
3135 NEXT
3140 LPRINT CHR$(12);
3145 RETURN
3150 PIND%=1
3151 LABL%=1
3152 GOSUB 3160
3153 RETURN
3160 FOR PRTI% = 1 TO 5
3161 LIN$(LABL%,PRTI%) = SPACE$(30)
3162 NEXT
3170 PRTI%=1
3171 LIN$(LABL%,PRTI%)=NAM$
3172 IF ADD1$<> SPACE$(30) THEN PRTI%=PRTI%+1: LIN$(LABL%,PRTI%)= ADD1$
3173 IF ADD2$ <> SPACE$(30) THEN PRTI% = PRTI% + 1: LIN$(LABL%,PRTI%)=ADD2$
3174 PRTI% = PRTI% + 1
3175 LIN$(LABL%,PRTI%) = CITYST$+" "
3176 PRTI% = PRTI% + 1
3177 LIN$(LABL%,PRTI%) = SPACE$(20)+STR$(CVD(ZIPCODE$))+SPACE$((10-LEN(STR$(CVD(ZIPCODE$)))))
3180 RETURN
3200 PRINT " Put envelope in printer"
3205 INPUT " Press ENTER to proceed";ANSD$
3210 IF RET$= "Y" THEN GOSUB 3260
3215 LPRINT SPACE$(30);NAM$
3220 IF ADD1$ <> SPACE$(30) THEN LPRINT SPACE$(30);ADD1$
3225 IF ADD2$ <> SPACE$(30) THEN LPRINT SPACE$(30);ADD2$
3230 LPRINT SPACE$(30);CITYST$
3235 LPRINT SPACE$(50);CVD(ZIPCODE$)
3238 LPRINT " "
3239 LPRINT " "
3240 RETURN
3260 LPRINT RET1$:NBLINES%=6
3261 IF RET2$ <> SPACE$(30) THEN LPRINT RET2$:NBLINES%=NBLINES% + 1
3262 IF RET3$ <> SPACE$(30) THEN LPRINT RET3$:NBLINES%=NBLINES% + 1
3263 LPRINT RET4$
3264 LPRINT RET5$
3265 FOR LISUB = 1 TO NBLINES%
3270 LPRINT " "
3275 NEXT
3280 RETURN
4000 PRINT " Printing HELD"
4010 INPUT " Press enter to proceed";RESPE$
4020 RESUME
5000 PRINT " SPACE BAR to continue"
5010 PRINT " Esc KEY to return to menu"
5020 PRINT " T KEY to reprint"
5030 K$=INKEY$: IF K$="" THEN 5030
5040 IF K$=" " THEN IF I% =NLINES% THEN 210
5041 IF K$=" " THEN IF I% < NLINES% THEN 200
5050 IF K$=CHR$(27) THEN CLOSE #1:CHAIN "b:labmail"
5060 IF K$ = "T" OR K$="t" THEN CLOSE #1:GOTO 20
5070 GOTO 5030
6000 PRINT " --------Print Status--------"
6010 PRINT " ";I%;" Labels printed"
6020 PRINT " ";(NLINES%-I%);" Labels remaining"
6030 RETURN
7000 PRINT " "
7010 INPUT " Specify number of copies ==>";NCOPS
7020 RETURN
8000 PRINT " "
8010 PRINT " Do you want only return labels"
8020 INPUT " <yes or no> ==>";RETANS$
8021 IF LEFT$(RETANS$,1) <> "Y" AND LEFT$(RETANS$,1) <> "y" AND LEFT$(RETANS$,1) <> "N" AND LEFT$(RETANS$,1) <> "n" THEN 8020
8025 GOSUB 1005
8030 RETURN
9000 LPRINT RET1$:NBLINES%=6
9010 IF RET2$ <> SPACE$(30) THEN LPRINT RET2$:NBLINES%=NBLINES% + 1
9020 IF RET3$ <> SPACE$(30) THEN LPRINT RET3$:NBLINES%=NBLINES% + 1
9030 LPRINT RET4$
9040 LPRINT RET5$
9045 LPRINT CHR$(12);
9050 RETURN
LABSELEC.BAS
10 COMMON PGRDATA(),LINPTR%(),NLINES%,MAXLEN,LINBUF$(),TOPROG$,TOFILE$
20 MAXLEN=11
30 TOPROG$="b:labprint"
40 TOFILE$=""
50 DIM PGRDATA(5)
60 SCREEN 0,1
70 PGRDATA(1)=UP
80 PGRDATA(2)=ENVEL
90 DIM LINBUF$(1000)
100 DIM LINPTR%(1000)
110 COLOR 15,9,4
120 RECNUM = 4
130 OPEN "B:maillist.REE" AS #1 LEN=128
140 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
150 ON ERROR GOTO 460
160 CLS
170 PRINT " "
180 PRINT " SELECT LABELS TO BE PRINTED"
190 PRINT " "
200 PRINT " "
210 INPUT " SEARCH FOR ==>";SEARCH$
220 GOSUB 540
230 RECNUM% = RECNUM% + 1
240 IF RECNUM% < 5 THEN RECNUM% = 5
250 GET #1, RECNUM%
260 ZIP# = CVD(ZIPCODE$)
270 IF ZIP# = 0 THEN 460
280 IF ZIP# = 999999999# THEN 230
290 X=INSTR(NAM$,SEARCH$)
300 IF X = 0 THEN 310 ELSE 410
310 X=INSTR(ADD1$,SEARCH$)
320 IF X = 0 THEN 330 ELSE 410
330 X=INSTR(ADD2$,SEARCH$)
340 IF X = 0 THEN 350 ELSE 410
350 X=INSTR(CITYST$,SEARCH$)
360 IF X = 0 THEN 370 ELSE 410
370 X=INSTR(STR$(ZIP#),SEARCH$)
380 IF ZIP# = 999999999# THEN 230
390 IF ZIP# = 0 THEN 460
400 IF X = 0 THEN 230
410 LPTRSUB%=LPTRSUB%+1
420 NLINES%=NLINES%+1
430 ON SORTSWITCH GOSUB 830,870,890,910
440 LINPTR%(LPTRSUB%)=NLINES%
450 GOTO 230
460 CLOSE #1
470 IF SORTSWITCH <> 4 GOTO 500
480 PRINT " SORTING BYPASSED"
490 CHAIN "b:labprint"
500 PRINT " Place SORT diskette in drive a"
510 INPUT " Press RETURN when ready";RESPONSE$
520 IF RESPONSE$ = "bypass" THEN 480
530 CHAIN "a:qsort"
540 CLS
550 PRINT " "
560 PRINT " SELECT SORT OPTIONS"
570 PRINT " "
580 PRINT " "
590 PRINT " A - LAST NAME"
600 PRINT " B - CITY/ST"
610 PRINT " C - ZIP CODE"
620 PRINT " D - NO SORT DESIRED"
630 PRINT " Esc - EXIT"
640 PRINT " "
650 PRINT " "
660 PRINT " Enter letter of desired option"
670 K$=INKEY$:IF K$="" THEN 670
680 IF K$="A" OR K$="a" THEN 740
690 IF K$="B" OR K$="b" THEN 760
700 IF K$="C" OR K$="c" THEN 780
710 IF K$="D" OR K$="d" THEN 800
720 IF K$=CHR$(27) THEN 820
730 GOTO 670
740 SORTSWITCH=1
750 RETURN
760 SORTSWITCH=2
770 RETURN
780 SORTSWITCH=3
790 RETURN
800 SORTSWITCH=4
810 RETURN
820 CHAIN "b:labmail
830 LNW$=NAM$
831 FOND%=0
832 FOR SCAN% = 1 TO 30:IF FOND% = 1 THEN 835
833 LC$ = MID$(LNW$,SCAN%,2)
834 IF LC$ = " " THEN FOND% = 1: LNAME$ = LEFT$(LNW$,SCAN%-1)
835 NEXT
837 FOND%=0
838 FOR SCAN%=LEN(LNAME$) TO 1 STEP -1
839 IF FOND% = 1 THEN 843
840 LC$=MID$(LNAME$,SCAN%,1)
841 IF LC$ = " " THEN FOND%=1: LNAMOUT$ = MID$(LNAME$,SCAN%+1)
843 NEXT
850 LINBUF$(LPTRSUB%) = LNAMOUT$+MKI$(RECNUM%)
860 RETURN
870 LNW$=CITYST$
880 GOTO 831
890 LINBUF$(LPTRSUB%) = STR$(ZIP#)+" "+MKI$(RECNUM%)
900 RETURN
910 LINBUF$(LPTRSUB%)=" "+MKI$(RECNUM%)
920 RETURN
LISTMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 4
40 OPEN "B:maillist.REE" AS #1 LEN=128
50 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
70 CLS
80 PRINT " "
90 PRINT " PRINT MAILING LIST"
95 PRINT " "
96 PRINT " "
97 INPUT " SEARCH FOR ==>";SEARCH$
100 PRINT " "
101 GET #1,1
102 COMP$=NAM$
103 X=INSTR(COMP$," ")
104 COMPNAM$=LEFT$(COMP$,X-1)
105 X=LEN(COMPNAM$)
106 OFFSET$=SPACE$((30-X)/2)
107 ENDER# = CVD(ZIPCODE$)
110 ON ERROR GOTO 3000
111 GOSUB 330
112 ZIP#=999999999#
115 WIDTH "LPT1:",132
120 WHILE ZIP# <> 0
130 IF LINECT > 55 THEN GOSUB 310
150 RECNUM = RECNUM + 1
160 IF RECNUM < 5 THEN RECNUM = 5
161 K$=INKEY$: IF K$ = "S" OR K$="s" THEN GOSUB 1000
162 IF K$=CHR$(27) THEN GOTO 2000
170 GET #1, RECNUM
180 NM$ = NAM$
190 A1$ = ADD1$
200 A2$ = ADD2$
210 ZIP# = CVD(ZIPCODE$)
220 IF ZIP# = 999999999# THEN 150
230 IF ZIP# = 0 THEN 260
231 CTST$ = CITYST$
240 X=INSTR(NAM$,SEARCH$)
241 IF X=0 THEN 242 ELSE 250
242 X=INSTR(ADD1$,SEARCH$)
243 IF X=0 THEN 244 ELSE 250
244 X=INSTR(ADD2$,SEARCH$)
245 IF X=0 THEN 246 ELSE 250
246 X=INSTR(CITYST$,SEARCH$)
247 IF X=0 THEN 248 ELSE 250
248 X=INSTR(STR$(ZIP#),SEARCH$)
249 IF X=0 THEN 260
250 IF LEN(STR$(ZIP#)) < 7 THEN LPRINT NM$;" ";A1$;" ";A2$;" ";CTST$;" ";ZIP#:LINECT = LINECT+1 ELSE LPRINT NM$;" ";A1$;" ";A2$;" ";CTST$: LPRINT SPACE$(120);ZIP#: LINECT = LINECT+2
260 WEND
262 FOR I = LINECT TO 56
263 LPRINT " "
264 NEXT
265 PAGECT = PAGECT + 1
266 LPRINT CHR$(18);SPACE$(71);"page";PAGECT
267 LPRINT CHR$(12)
268 PRINT " "
269 GOTO 2000
270 PRINT " "
280 PRINT " MAILING LIST IS COMPLETE"
290 CLOSE #1
300 CHAIN "B:MAILMENU"
310 PAGECT = PAGECT + 1
315 LPRINT " "
320 LPRINT CHR$(18);SPACE$(71);"PAGE";PAGECT
330 LPRINT CHR$(12)
335 LPRINT CHR$(18);" "
338 LPRINT CHR$(14);OFFSET$;COMPNAM$
340 LPRINT CHR$(14);" Mailing List"
350 LPRINT CHR$(15);" "
360 LINECT = 1
370 RETURN
1000 PRINT " --------Status Report--------"
1010 PRINT " ";RECNUM-6;" records printed"
1020 PRINT " ";ENDER#-RECNUM+1;" records remaining"
1030 RETURN
2000 PRINT " SPACE BAR to continue"
2010 PRINT " Esc Key to return to menu"
2020 PRINT " T Key to reprint"
2030 K$=INKEY$: IF K$="" THEN 2030
2040 IF K$=" " THEN IF ZIP#=0 THEN 270 ELSE 170
2050 IF K$="T" OR K$="t" THEN GOTO 2080
2060 IF K$=CHR$(27) THEN RECNUM = 0: GOTO 270
2070 GOTO 2030
2080 IF ZIP#<>0 THEN 2090
2081 PAGECT=0
2082 RECNUM=0
2083 ON ERROR GOTO 0
2084 GOTO 70
2090 ZIP#=99999999#
2093 RECNUM = 0
2095 GOTO 260
3000 IF ERR = 24 THEN RESUME
3010 RESUME
LOCMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 4
40 OPEN "B:maillist.REE" AS #1 LEN=128
50 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
60 ON ERROR GOTO 340
70 CLS
80 PRINT " "
90 PRINT " SEARCH MAILING LIST"
100 PRINT " "
110 PRINT " "
120 INPUT " SEARCH FOR ==>";SEARCH$
130 RECNUM = RECNUM + 1
140 IF RECNUM < 5 THEN RECNUM = 5
150 GET #1, RECNUM
151 ZIP# = CVD(ZIPCODE$)
160 X=INSTR(NAM$,SEARCH$)
170 IF X = 0 THEN 180 ELSE 290
180 X=INSTR(ADD1$,SEARCH$)
190 IF X = 0 THEN 200 ELSE 290
200 X=INSTR(ADD2$,SEARCH$)
210 IF X = 0 THEN 220 ELSE 290
220 X=INSTR(CITYST$,SEARCH$)
230 IF X = 0 THEN 240 ELSE 290
240 X=INSTR(STR$(ZIP#),SEARCH$)
260 IF ZIP# = 999999999# THEN 130
270 IF ZIP# = 0 THEN 340
280 IF X = 0 THEN 130
290 PRINT " "
291 PRINT " "; NAM$
300 IF ADD1$ <> " " THEN PRINT " "; ADD1$
310 IF ADD2$ <> " " THEN PRINT " "; ADD2$
320 PRINT " "; CITYST$
330 PRINT " "; ZIP#
340 PRINT " "
350 PRINT " SPACE BAR TO CONTINUE"
360 PRINT " Esc KEY TO RETURN TO MENU"
370 PRINT " T KEY TO START OVER"
380 K$ = INKEY$: IF K$ = "" THEN 380
390 IF K$ = " " THEN 130
400 IF K$ = CHR$(27) THEN 450
420 IF K$ = "T" THEN RECNUM = 4: GOTO 70
430 IF K$ = "t" THEN RECNUM = 4: GOTO 70
440 GOTO 380
450 CLOSE #1
460 CHAIN "B:dispmail"
MAILIST1.BAS
10 '(C) Copyright M. Berry and W. Dwinell 1982, 1983
99 '------------------------------INITILIZE------------------------------------
100 'KEY OFF:FOR L=1 TO 10:KEY L,"":NEXT L
101 LOCATE ,,0:KEY OFF:GOSUB 20000:CR$=CHR$(13):ESC$=CHR$(27)
102 CLS:ON ERROR GOTO 10000
103 OF=1:IPC=8:PT=1:LOCATE 5,15:PRINT"Enter the File Name you wish to use:":LOCATE 5,52:GOSUB 15150:SWAP RAN$,IP$:IF RAN$=ESC$ THEN RAN$=""
104 IF LEN(RAN$)<>0 THEN GOTO 108 ELSE LOCATE 23,1:BEEP:PRINT"You did not enter a file name. Do you wish to exit program (Y/N)?":LOCATE 23,67:IPC=1:GOSUB 15150:IF IP$="y" THEN IP$="Y"
105 IF IP$="Y" THEN 7020 ELSE LOCATE 23,1:PRINT STRING$(68," "):GOTO 103
106 '
108 RAN$="B:"+RAN$
110 FOR L=1 TO 10:KEY L,"":NEXT
120 WIDTH 80
125 C$=SPACE$(15):S$=SPACE$(2):Z$=SPACE$(5):PH$=SPACE$(12):ST$=SPACE$(20):N1$=SPACE$(10):N2$=SPACE$(15)
127 COMMON N,RAN$,IN$,NBR$,S,CR$,ESC$
140 N=0:DIM I$(1000):DIM I1$(1000):DEFINT A-Z' MAXIUM NBR OF RECORDS
160 ON ERROR GOTO 10000
280 IN$=RAN$+".IDX"
285 NBR$=RAN$+".CTR"
300 OPEN "i",#3,NBR$
360 INPUT #3,N
365 CLOSE 3
410 OPEN "R",#2,RAN$,79
420 FIELD 2, 15 AS CF$, 2 AS SF$, 5 AS ZF$, 12 AS PHF$, 20 AS STF$, 10 AS N1F$, 15 AS N2F$
500 ' ------------------------ MAIN MENU ROUTINE ------------------------------
520 CLS:I=0:MN=0:KEY 9,")":GOSUB 11300
540 LOCATE 5,22:COLOR 15,0:PRINT"THE FOLLOWING OPTIONS ARE AVAILABLE":COLOR 7,0
560 LOCATE 8,32:PRINT"1. Add to file"
580 LOCATE 9,32:PRINT"2. Sort file"
600 LOCATE 10,32:PRINT"3. Display file"
620 LOCATE 11,32:PRINT"4. Correct file"
640 LOCATE 12,32:PRINT"5. Print file"
660 LOCATE 13,32:PRINT"6. Delete record"
665 LOCATE 14,32:PRINT"7. Display last record number"
670 LOCATE 15,32:PRINT"8. Automatic phone dialer"
672 LOCATE 25,1:COLOR 15,0:PRINT"F9 ";:COLOR 0,7:PRINT" TO END PROGRAM ";:LOCATE 25,50:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO FILE SELECTION ";:COLOR 7,0
682 LOCATE ,,0:LOCATE 19,22:PRINT"Type the number of your choice:";:IPC=1:PT=0:OF=1:GOSUB 15150:SWAP IP$,I$:IF I$="" THEN 682 ELSE IF I$=")" THEN 7020 ELSE IF I$=ESC$ THEN CLOSE 2:ERASE I$:ERASE I1$:GOTO 102
683 IF VAL(I$)=0 THEN GOTO 700
684 I=VAL(I$)
685 IF I=7 THEN LOCATE 23,22:PRINT"THERE ARE";:COLOR 15,0:PRINT N;:COLOR 7,0:PRINT"RECORDS IN THIS FILE ";:I=0:GOTO 682
700 IF I<1 OR I>8 THEN LOCATE 23,22:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER BETWEEN 1 AND 8":COLOR 7,0:GOTO 682
720 ON I GOTO 1010,2010,3020,4020,5020,6020,0,12010
1000 ' --------------------------ADD TO FILE ROUTINE --------------------------
1010 CLS:LOCATE 1,30:PRINT"RECORD NUMBER ";:GOSUB 11010
1020 F=0:IF N=0 THEN N=1 ELSE N=N+1
1040 LOCATE 1,43:PRINT N:GOSUB 11200
1060 MID$(N1$,1)=SPACE$(10)' first name
1080 GOSUB 11400:GOTO 1840
1282 IF F=1 THEN 1840:' CHECK FOR ERROR CORR
1840 LOCATE 25,1:PRINT STRING$(26,32);:GOSUB 8020:IF C2=1 THEN C2=0:GOTO 520 ELSE LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,1:PRINT"Is the information displayed correct? ";:IPC=1:PT=0:OF=1:GOSUB 15150:SWAP IP$,I$
1860 IF I$="Y" OR I$="y" THEN 1987
1880 IF I$="N" OR I$="n" THEN LOCATE 23,1:PRINT STRING$(40,32):GOSUB 11400:GOTO 1840
1900 BEEP:LOCATE 23,1:PRINT STRING$(70,32);:LOCATE 23,1:PRINT"You must answer yes or no. Please reenter";:FOR T = 1 TO 2000:NEXT T:GOTO 1840
1987 IF LEN(N2$)<15 THEN N2$=N2$+" ":GOTO 1987
1989 IF F1=2 GOTO 4242 ELSE IF F1=3 GOTO 4425 ELSE I$=Z$+N2$+STR$(N):GOSUB 10200
1990 OPEN IN$ FOR APPEND AS 1:PRINT#1,I$:CLOSE 1:OPEN "O",3,NBR$:PRINT#3,N:CLOSE 3
1991 LOCATE 23,1:PRINT"Record has been written to file. Do you want to input another ";:IPC=1:PT=0:OF=1:GOSUB 15150:SWAP IP$,I$:IF I$="Y" OR I$="y" THEN LOCATE 23,1:PRINT STRING$(70,32);:GOTO 1020
1993 IF I$="N" OR I$="n" THEN GOTO 520
1994 BEEP:LOCATE 23,1:PRINT STRING$(70,32);:LOCATE 23,1:PRINT"You must answer yes or no. Please reenter";:GOTO 1991
2000 ' ----------------------- SORT ROUTINE ---------------------------------
2010 CLOSE 2:COLOR 15,0:LOCATE 19,22:PRINT"Loading Sort program.............":CHAIN "MAILSORT.BAS"
3000 ' --------------------- DISPLAY FILE -------------------------
3020 MN=3:KEY 9,"":KEY 10,")":C1=0:I=0:CLS:GOSUB 11300:LOCATE 5,29:COLOR 15,0:PRINT"DO YOU WANT TO DISPLAY":COLOR 7,0
3040 LOCATE 8,32:PRINT"1. By record number"
3060 LOCATE 9,32:PRINT"2. By name"
3080 LOCATE 10,32:PRINT"3. All"
3100 GOSUB 11150:LOCATE 19,24:PRINT"Type the number of your choice ";:LOCATE 19,POS(0)-1:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 520 ELSE IF VAL(IP$)=0 THEN 3120 ELSE I=VAL(IP$)
3120 IF I<1 OR I>3 THEN LOCATE 23,24:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER FROM 1 TO 4":COLOR 7,0:GOTO 3100
3140 ON I GOTO 3420,3160,3600,520
3160 CLS:GOSUB 11150:LOCATE 7,15:PRINT"Enter name you would like to display:";:LOCATE CSRLIN,POS(0)+1:IPC=15:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 3020 ELSE SWAP I$,IP$
3170 IF LEN(I$)<>0 THEN 3180 ELSE IF I$="" THEN LOCATE 23,1:BEEP:PRINT"You did not enter a name. Do you wish to return to menu (Y/N)";:LOCATE CSRLIN,POS(0)+1:IPC=1:GOSUB 15150
3172 IF IP$="Y" OR IP$="y" THEN 3020 ELSE IF IP$=ESC$ THEN 3020 ELSE LOCATE 23,1:PRINT STRING$(68," "):GOTO 3160
3180 F$=I$
3200 OPEN "I",#1,IN$
3204 IF EOF(1) THEN 3380
3205 INPUT #1,I$
3220 I=LEN(I$):I=I-20:IF MID$(I$,6,LEN(F$))<>F$ THEN 3204 ELSE I = VAL(RIGHT$(I$,I))
3240 C1=1:GET 2,I
3260 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
3280 GOSUB 11010:GOSUB 10500:GOSUB 10600
3320 LOCATE 23,1:PRINT"Type S to return to menu or any other key to continue search";
3340 I$=INKEY$:IF I$="" THEN 3340
3360 LOCATE 23,1:PRINT STRING$(75,32);:IF LEFT$(I$,1)="S" OR LEFT$(I$,1)="s" THEN 3380
3370 GOTO 3204
3380 CLOSE 1
3381 IF C1=1 THEN 3400
3382 LOCATE 23,10:BEEP:PRINT"There is no record for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT" press any key to continue";
3384 I$=INKEY$:IF I$="" THEN 3384
3400 GOTO 3020
3420 CLS:GOSUB 11150
3421 LOCATE 7,15:PRINT"Enter record number you would like to display: ";:LOCATE 7,POS(0)-4:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 3020
3422 IF VAL(IP$)=0 THEN LOCATE 23,1:PRINT SPACE$(77);:LOCATE 23,22:BEEP:PRINT"Record number must be numeric":GOTO 3421:ELSE I=VAL(IP$)
3423 IF I>N THEN LOCATE 23,1:BEEP: PRINT"There are only"N;"records in the file. Please choose a number no larger than"N;:GOTO 3421
3424 IF I=0 THEN 3020
3426 'IF N=0 THEN BEEP:LOCATE 23,1:PRINT"There are no records in this file. Press enter to continue";:IPC=1:PT=0:OF=0:GOSUB 15150:GOTO 520
3440 GET 2,I
3460 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
3480 GOSUB 11010:GOSUB 10500:GOSUB 10600
3500 LOCATE 23,1:PRINT"Press any key to continue"
3520 I$=INKEY$:IF I$="" THEN 3520 ELSE LOCATE 23,1:PRINT STRING$(75,32);
3540 GOTO 3020
3600 CLS:LOCATE 1,30:PRINT "RECORD NUMBER ";:GOSUB 11010:IF S=1 THEN OPEN "I",#1,SRT$:GOTO 3606
3605 FOR L=1 TO N
3606 IF S=1 THEN IF EOF(1) GOTO 3840
3607 IF S=1 THEN INPUT #1,I:GOTO 3640
3620 I=L
3640 GET 2,I
3660 LOCATE 1,44:PRINT USING "####";I
3680 GOSUB 10500:GOSUB 10600
3700 FOR T=1 TO 15
3720 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"F10 ";:COLOR O,7:PRINT" TO HOLD DISPLAY ";:COLOR 7,0
3740 I$=INKEY$:IF I$<>"" THEN IF I$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT" TO CONTINUE ";:COLOR 7,0:PRINT" ";:IPC=1:OF=0:GOSUB 15150
3745 IF I$=ESC$ THEN IF S=1 GOTO 3860 ELSE T=15:L=N
3780 NEXT T
3785 IF S=1 THEN 3606
3800 NEXT L
3820 IF I$=ESC$ THEN 3860
3840 LOCATE 23,20:BEEP:PRINT"End of file. Type any key to return";:IPC=1:PT=O:OF=0:GOSUB 15150
3860 CLOSE 1:I1$="":GOTO 3020
4000 ' --------------------------- CORRECTION ROUTINE -------------------------
4020 I=0:MN=4:F1=2:C1=0:X=0
4040 CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,29:PRINT"DO YOU WANT TO CORRECT":COLOR 7,0:LOCATE 8,30:PRINT"1. By record number"
4060 LOCATE 9,30:PRINT"2. By name"
4080 GOSUB 11150:LOCATE 19,25:PRINT"Type the number of your choice ";:LOCATE 19,POS(0)-1:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 4560 ELSE IF VAL(IP$)=0 THEN 4100 ELSE I=VAL(IP$)
4085 'IF I$=ESC$ THEN GOTO 4560
4100 IF I<1 OR I>2 THEN LOCATE 23,27:BEEP:COLOR 15,0:PRINT"PLEASE TYPE NUMBER 1 OR 2":COLOR 7,0:GOTO 4080
4120 IF I = 2 GOTO 4280
4140 CLS:GOSUB 11150
4160 LOCATE 7,15:PRINT"Enter the number of record you want to correct: ";:LOCATE 7,POS(0)-4:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 4020
4162 IF VAL(IP$)=0 THEN LOCATE 23,1:PRINT SPACE$(77);:LOCATE 23,22:BEEP:PRINT"Record number must be numeric":GOTO 4160:ELSE I1=VAL(IP$)
4180 IF I1>N THEN LOCATE 23,1:BEEP:PRINT"No record found for that number. Do you want to try another ";:LOCATE 23,POS(0)-1:IPC=1:PT=O:OF=0:GOSUB 15150:IF LEFT$(IP$,1)="Y" OR LEFT$(IP$,1)="y" THEN 4140 ELSE GOTO 4560
4200 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I1
4220 GET 2,I1
4240 GOSUB 11010:GOSUB 10500:GOSUB 10600:GOTO 1080
4242 OPEN "I",1,IN$
4245 FOR L=1 TO N
4247 INPUT #1,I1$
4249 I2=LEN(I1$):I2=I2-20:IF VAL(RIGHT$(I1$,I2))=I1 THEN I$(L)=Z$+N2$+STR$(I1) ELSE I$(L)=I1$
4251 NEXT L
4253 CLOSE 1
4255 GOSUB 10400:GOSUB 10200
4260 GOTO 4040
4280 CLS:F1=3:GOSUB 11150
4300 LOCATE 5,15:PRINT"Enter last name of record you want to correct:";:LOCATE 5,POS(0)+1:IPC=15:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 4020 ELSE SWAP IP$,I$:IF I$="" THEN 4020
4320 F$=I$
4340 OPEN "i",1,IN$:OPEN "B:TEMP" FOR APPEND AS 3
4342 FOR L2= 1 TO N
4344 INPUT#1,I$:Q=Q+1
4360 I1=LEN(I$):I1=I1-20:IF MID$(I$,6,LEN(F$))<>F$ THEN I$(Q)=I$:GOTO 4427
4365 I1=VAL(RIGHT$(I$,I1))
4380 C1=1:GET 2,I1
4400 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I1
4420 GOSUB 11010:GOSUB 10500:GOSUB 10600:GOTO 1080
4425 I$(Q)=Z$+N2$+STR$(I1):GOSUB 10200
4427 IF Q=100 THEN GOSUB 4600
4440 NEXT L2
4445 CLOSE 1
4447 GOSUB 4600:CLOSE 3
4460 IF C1=1 THEN 4500
4480 LOCATE 23,1:BEEP:PRINT"There is no record for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT". Type any key to continue";:KILL "B:TEMP":GOTO 4520
4500 LOCATE 23,1:BEEP:PRINT"End of records for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT". Type any key to continue";
4520 I$=INKEY$:IF I$="" THEN 4520 ELSE IF C1=0 THEN 4040
4540 KILL IN$:GOSUB 4700:GOTO 4040
4560 F1=0:GOTO 520
4600 FOR L1=1 TO Q
4620 PRINT#3,I$(L1)
4640 NEXT L1
4660 Q=0:RETURN
4700 Q=0:OPEN "I",3,"TEMP"
4720 OPEN IN$ FOR APPEND AS 1
4740 FOR L=1 TO N
4760 Q=Q+1
4780 INPUT#3,I1$(Q)
4800 IF Q=100 THEN GOSUB 4900
4820 NEXT L
4840 GOSUB 4900:CLOSE 1,3:KILL "TEMP":RETURN
4900 FOR L1=1 TO Q
4920 PRINT#1,I1$(L1)
4940 NEXT L1
4960 Q=0:RETURN
5000 '---------------------PRINTER ROUTINE --------------------------------
5020 KEY 10,")":I=0:MN=5:FOR L=1 TO 3:P$(L)=SPACE$(80):NEXT L:P$=SPACE$(80):A$=SPACE$(15):A1$=SPACE$(15):C1=0:CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,29:PRINT"DO YOU WANT TO PRINT":COLOR 7,0
5025 LOCATE 8,31:PRINT"1 By record number"
5030 LOCATE 9,31:PRINT"2 By name"
5035 LOCATE 10,31:PRINT"3 All"
5050 GOSUB 11150:LOCATE 19,23:PRINT"Type the number of your choice: ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 520 ELSE IF VAL(IP$)=0 THEN 5055 ELSE I=VAL(IP$)
5055 IF I<1 OR I>3 THEN LOCATE 23,23:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER FROM 1 TO 3":COLOR 7,0:GOTO 5050
5060 ON I GOTO 5065,5140,5520
5065 CLS:GOSUB 11150:LOCATE 7,15:PRINT"Enter name you would like to print ";:IPC=15:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 5020 ELSE SWAP IP$,I$
5067 IF I$="" THEN 5020
5070 F$=I$
5073 OPEN "I",#1,IN$
5075 IF EOF(1) THEN 5115
5077 INPUT#1,I$
5080 I=LEN(I$):I=I-20:IF MID$(I$,6,LEN(F$))<>F$ THEN 5075 ELSE I = VAL(RIGHT$(I$,I))
5085 C1=1:GET 2,I
5090 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
5095 GOSUB 5495
5100 LOCATE 23,1:PRINT"Type S to return to menu or any other key to continue search";
5105 I$=INKEY$:IF I$="" THEN 5105
5110 LOCATE 23,1:PRINT STRING$(75,32);:IF LEFT$(I$,1)="S" OR LEFT$(I$,1)="s" THEN CLOSE 1:GOTO 5020
5113 GOTO 5075
5115 CLOSE 1
5120 IF C1=1 THEN 5135
5125 LOCATE 23,1:BEEP:PRINT"There is no record for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT" press any key to continue";
5130 I$=INKEY$:IF I$="" THEN 5130
5135 GOTO 5020
5140 CLS:GOSUB 11150
5141 LOCATE 7,15:PRINT"Enter record number you would like to print ";:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 5020 ELSE I=VAL(IP$)
5142 IF I=0 THEN 5020
5145 IF I>N THEN LOCATE 23,1:BEEP:PRINT"There are only"N"records in the file. Please choose a number no larger than"N:GOTO 5141
5150 'IF N=0 THEN BEEP:LOCATE 22,1:INPUT"THERE ARE NO RECORDS IN THIS FILE. PRESS ENTER TO CONTINUE",I$:GOTO 520
5155 GET 2,I
5160 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
5165 GOSUB 5495:GOSUB 10500
5170 LOCATE 23,1:PRINT"Type any key to continue";
5175 I$=INKEY$:IF I$="" THEN 5175 ELSE LOCATE 23,1:PRINT STRING$(75,32);
5180 GOTO 5020
5280 '----------------------- PRINT 3-WIDE LABELS------------------------------
5285 GOSUB 5910:GOSUB 5950:P=0:KEY 10,")":CLS:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$ ELSE OPEN "I",1,IN$
5287 IF S=1 THEN INPUT#1,I ELSE INPUT#1,I$
5290 P = P+1
5295 IF S<>1 THEN I=LEN(I$):I=I-20:I=VAL(RIGHT$(I$,I))
5300 GET 2,I
5305 MID$(P$(P),1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
5310 IF EOF(1) THEN IF P <2 THEN P$(2)="":P$(3)="":GOTO 5325
5315 IF EOF(1) THEN IF P <3 THEN P$(3)="":GOTO 5325
5320 IF P <> 3 GOTO 5465 'MUST GET 3 RECORDS BEFORE PRINTING
5325 FOR L1=1 TO 3
5330 MID$(A$,1)=MID$(P$(L1),11,15) 'DUMMY FOR LAST NAMES IF NOT THREE
5335 IF P$(L1)="" THEN 5355
5340 LPRINT MID$(P$(L1),1,INSTR(P$(L1),"\")-1);" ";MID$(A$,1,INSTR(A$,"\")-1); 'FIRST AND LAST NAMES --PHONE NOT USED
5345 IF L1 = 1 THEN LPRINT TAB(TAB1);
5350 IF L1 = 2 THEN LPRINT TAB(TAB2);
5355 NEXT L1
5360 LPRINT
5365 FOR L1=1 TO 3
5370 IF P$(L1)="" THEN 5390
5375 LPRINT MID$(P$(L1),38,20); 'STREET ADDRESS
5380 IF L1 = 1 THEN LPRINT TAB(TAB1);
5385 IF L1 = 2 THEN LPRINT TAB(TAB2);
5390 NEXT L1
5395 LPRINT
5400 FOR L1 = 1 TO 3
5405 IF P$(L1)="" THEN 5430
5410 MID$(A1$,1)=MID$(P$(L1),58,15)
5415 LPRINT MID$(A1$,1,INSTR(A1$,"\")-1);", ";RIGHT$(P$(L1),8); 'CITY,STATE,ZIP
5420 IF L1 = 1 THEN LPRINT TAB(TAB1);
5425 IF L1 = 2 THEN LPRINT TAB(TAB2);
5430 NEXT L1
5435 FOR BLINES=0 TO SPACES:IF SPACES =0 THEN 5437 ELSE LPRINT
5437 NEXT
5440 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
5445 I1$=INKEY$:IF I1$<>"" THEN IF I1$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"TO CONTINUE ";:COLOR 7,0:PRINT" ";:IPC=1:OF=0:GOSUB 15150
5450 IF I1$ = ESC$ THEN GOSUB 5960:GOTO 5470
5460 P=0:I1$=""
5465 IF EOF(1)=0 THEN 5287
5470 GOSUB 5960:CLOSE 1:CLS:GOTO 5520
5490 GET 2,I
5495 LPRINT MID$(N1F$,1,INSTR(N1F$,"\")-1);" ";MID$(N2F$,1,INSTR(N2F$,"\")-1)
5500 LPRINT STF$
5505 LPRINT MID$(CF$,1,INSTR(CF$,"\")-1);", ";SF$;" ";ZF$
5507 IF SPACES=<0 THEN 5515
5510 FOR BLINES=1 TO SPACES:LPRINT
5512 NEXT
5515 RETURN
5520 I=0:MN=7:CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,23:PRINT "THE FOLLOWING OPTIONS ARE AVAILABLE":COLOR 7,0
5525 LOCATE 8,31:PRINT "1 Listing"
5530 LOCATE 9,31:PRINT "2 Labels - 1 Wide"
5535 LOCATE 10,31:PRINT "3 Labels - 2 Wide"
5540 LOCATE 11,31:PRINT "4 Labels - 3 Wide"
5550 LOCATE 19,23:PRINT"Type the number of your choice:":GOSUB 11100
5552 IF I$=ESC$ THEN 5020
5555 IF I<1 OR I>4 THEN LOCATE 23,23:BEEP:COLOR 15,0:PRINT"PLEASE TYPE A NUMBER FROM 1 TO 4":COLOR 7,0:GOTO 5550
5560 ON I GOTO 5562,5655,5680,5285
5561 '---------------------- LISTING - SUBROUTINE -----------------------------
5562 CLS:GOSUB 11150:LOCATE 7,15:PRINT"Enter title for listing: ";:IPC=40:PT=1:OF=1:GOSUB 15150:IF I$=ESC$ THEN 5520 ELSE IF LEN(IP$)=0 THEN 5520 ELSE SWAP TITLE$,IP$
5563 LPRINT :LPRINT CHR$(14);TITLE$;:LPRINT CHR$(20);'TAB(50)DATE$
5565 CLS:LOCATE 10,35:PRINT"PRINTING"
5570 LPRINT CHR$(15):WIDTH "LPT1:",132:LPRINT CHR$(27);"0"
5575 LPRINT TAB(100) DATE$ :LPRINT :LPRINT
5580 LPRINT " NAME";TAB(38)"PHONE";TAB(59)"STREET";TAB(80);"CITY";TAB(95) "ST ZIP"
5585 LPRINT STRING$(103,208):LPRINT
5587 IF S=1 THEN OPEN "i",1,SRT$:GOTO 5592
5590 FOR L= 1 TO N
5592 IF S=1 THEN IF EOF(1) GOTO 5645
5595 IF S=1 THEN INPUT#1,I:GOTO 5610
5605 I=L
5610 GET 2,I
5615 MID$(P$,1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
5620 LPRINT MID$(P$,1,INSTR(P$,"\")-1);:LPRINT TAB(16) MID$(P$,11,INSTR(11,P$,"\")-11) TAB(33) MID$(P$,26,12);:LPRINT TAB(56) MID$(P$,38,20);:LPRINT TAB(78) MID$(P$,58,INSTR(58,P$,"\")-58);:LPRINT TAB(95) MID$(P$,73,2);" ";RIGHT$(P$,5)
5625 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" to hold printing ";:COLOR 7,0
5630 I$=INKEY$:IF I$<>"" THEN IF I$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"to continue ";:COLOR 7,0:PRINT" ";:IPC=1:OF=0:PT=0:GOSUB 15150
5635 IF I$=ESC$ THEN IF S=1 GOTO 5645 ELSE L=N
5637 IF S=1 THEN 5592
5640 NEXT:LPRINT :LPRINT
5645 LPRINT CHR$(146):WIDTH "LPT1:",80:LPRINT CHR$(27);"2"
5650 CLOSE 1:GOTO 5520
5655 GOSUB 5905:CLS:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$
5656 IF S=1 THEN IF EOF(1) GOTO 5670 ELSE INPUT#1,I:GOTO 5660
5657 FOR L=1 TO N
5659 I=L
5660 GOSUB 5490
5662 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
5663 I$=INKEY$:IF I$<>"" THEN IF I$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"TO CONTINUE ";:COLOR 7,0:PRINT" ";:IPC=1:OF=0:PT=0:GOSUB 15150
5664 IF I$=ESC$ THEN IF S=1 GOTO 5670 ELSE L=N
5665 IF S=1 GOTO 5656
5667 NEXT
5670 CLS:CLOSE 1:GOTO 5520
5675 '--------------------- 2-WIDE LABELS -------------------------------
5680 GOSUB 5900
5681 CLS:P=0:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$ ELSE OPEN "I",1,IN$
5682 IF S=1 THEN INPUT#1,I ELSE INPUT#1,I$
5685 P = P+1
5690 IF S<>1 THEN I=LEN(I$):I=I-20:I=VAL(RIGHT$(I$,I))
5695 GET 2,I
5700 MID$(P$(P),1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
5705 IF EOF(1) THEN IF P <2 THEN P$(2)="":GOTO 5715
5710 IF P <> 2 GOTO 5855 'MUST GET 2 RECORDS BEFORE PRINTING
5715 FOR L1=1 TO 2
5720 MID$(A$,1)=MID$(P$(L1),11,15) 'DUMMY FOR LAST NAMES IF NOT THREE
5725 IF P$(L1)="" THEN 5745
5730 LPRINT MID$(P$(L1),1,INSTR(P$(L1),"\")-1);" ";MID$(A$,1,INSTR(A$,"\")-1); 'FIRST AND LAST NAMES --PHONE NOT USED
5735 IF L1 = 1 THEN LPRINT TAB(TAB1);
5740 IF L1 = 2 THEN LPRINT TAB(TAB2);
5745 NEXT L1
5750 'LPRINT
5755 FOR L1=1 TO 2
5760 IF P$(L1)="" THEN 5780
5765 LPRINT MID$(P$(L1),38,20); 'STREET ADDRESS
5770 IF L1 = 1 THEN LPRINT TAB(TAB1);
5775 IF L1 = 2 THEN LPRINT TAB(TAB2);
5780 NEXT L1
5785 'LPRINT
5790 FOR L1 = 1 TO 2
5795 IF P$(L1)="" THEN 5820
5800 MID$(A1$,1)=MID$(P$(L1),58,15)
5805 LPRINT MID$(A1$,1,INSTR(A1$,"\")-1);", ";RIGHT$(P$(L1),8); 'CITY,STATE,ZIP
5810 IF L1 = 1 THEN LPRINT TAB(TAB1);
5815 IF L1 = 2 THEN LPRINT TAB(TAB2);
5820 NEXT L1
5825 FOR BLINES=1 TO SPACES:IF SPACES =0 THEN 5827 ELSE LPRINT
5827 NEXT
5830 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
5835 I1$=INKEY$:IF I1$<>"" THEN IF I1$=")" THEN LOCATE 25,63:COLOR 0,7:PRINT"TO CONTINUE ";:COLOR 7,0:PRINT" ";:IPC=1:OF=0:GOSUB 15150
5840 IF I1$ = ESC$ THEN GOSUB 5960 :GOTO 5470
5850 P=0:I1$=""
5855 IF EOF(1) = 0 THEN 5682
5860 CLOSE 1:CLS:GOTO 5520
5899 '-----------------------SET TABS SUBROUTINE -----------------------------
5900 CLS:GOSUB 11150:LOCATE 1,1:PRINT"Enter the FIRST print position for the second label: ";:LOCATE 1,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE TAB1=VAL(IP$)
5905 CLS:GOSUB 11150:LOCATE 1,1:PRINT"Enter the number of spaces you desire between labels: ";:LOCATE 1,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE SPACES=VAL(IP$):RETURN
5910 CLS:GOSUB 11150:LOCATE 1,1:PRINT"Enter the FIRST print position for the second label: ";:LOCATE 1,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE TAB1=VAL(IP$)
5920 LOCATE 3,1:PRINT"Enter the FIRST print position for the third label: ";:LOCATE 3,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE TAB2=VAL(IP$)
5930 GOSUB 11150:LOCATE 5,1:PRINT"Enter the number of spaces you desire between labels: ";:LOCATE 5,POS(0)-1:IPC=3:PT=1:GOSUB 15150:IF IP$=ESC$ THEN 5520 ELSE SPACES=VAL(IP$):RETURN
5950 LPRINT CHR$(15);:WIDTH "LPT1:",132:RETURN
5960 LPRINT CHR$(146):WIDTH "LPT1:",80:RETURN
6000 ' ---------------------- DELETE ROUTINE ---------------------------------
6020 I=0:MN=6:KEY 9,"":KEY 10,"":CLS:GOSUB 11300
6040 LOCATE 5,30:COLOR 15,0:PRINT"DO YOU WANT TO DELETE":COLOR 7,0
6060 LOCATE 8,32:PRINT"1 By record number"
6080 LOCATE 9,32:PRINT"2 By last name"
6100 GOSUB 11150:LOCATE 19,25:PRINT"Type the number of your choice: ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6145 ELSE IF VAL(IP$)=0 THEN 6120 ELSE I=VAL(IP$)
6120 IF I<1 OR I>2 THEN LOCATE 23,26:BEEP:COLOR 15,0:PRINT"PLEASE TYPE NUMBER 1 OR 2":COLOR 7,0:GOTO 6100
6140 IF I=1 THEN 6155 ELSE IF I=2 THEN 6440
6145 OPEN "O",3,NBR$:PRINT#3,N:CLOSE 3:IF S=1 THEN S=0:KILL SRT$ ELSE GOTO 520
6155 CLS:GOSUB 11150
6160 LOCATE 7,15:PRINT"Enter record number you want to delete ";:LOCATE 7,POS(0)-4:IPC=4:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE IF IP$="" THEN BEEP:GOTO 6160 ELSE I=VAL(IP$)
6180 IF N=0 THEN BEEP:LOCATE 23,1:PRINT"There are no records in this file. Press enter to continue ";:IPC=1:PT=0:OF=0:GOTO 520
6185 IF I>N THEN LOCATE 23,1:BEEP:PRINT"There are only"N"records in the file. Please enter a number no larger than"N:GOTO 6160
6190 IF I=0 THEN GOTO 6020
6200 GET 2,I
6300 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
6320 GOSUB 11010:GOSUB 10500:GOSUB 10600
6325 GOSUB 11150
6340 LOCATE 22,1:BEEP:PRINT"Is this the correct record to delete ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE SWAP IP$,I$
6360 IF I$="N" OR I$="n" THEN 6020 ELSE IF I$="Y" OR I$="y" THEN 6420
6400 LOCATE 23,1:BEEP:PRINT"You must enter yes or no. Please reenter":GOTO 6340
6420 GOSUB 6760:N=N-1:GOTO 6020
6440 CLS:C1=0:GOSUB 11150
6460 LOCATE 5,15:PRINT"Enter last name of record you want to delete ";:IPC=15:PT=1:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE IF IP$="" THEN BEEP:GOTO 6460 ELSE SWAP IP$,I$
6480 F$=I$
6485 OPEN "I",1,IN$
6505 IF EOF(1) THEN GOTO 6682 ELSE INPUT#1,IP$
6520 I=LEN(IP$):I=I-20:IF MID$(IP$,6,LEN(F$))<>F$ THEN 6680 ELSE I=VAL(RIGHT$(IP$,I))
6540 GET 2,I
6560 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
6580 GOSUB 11010:GOSUB 10500:GOSUB 10600
6600 I1$=" ":GOSUB 11150:LOCATE 22,1:BEEP:PRINT"Is This the correct record to delete ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 6020 ELSE SWAP IP$,I1$
6640 IF I1$="Y" OR I1$="y" THEN 6700 ELSE IF I1$="N" OR I1$="n" THEN 6680
6660 LOCATE 23,1:BEEP:PRINT"You must enter yes or no. Please reenter":GOTO 6600
6680 GOTO 6505
6682 CLOSE 1:GOTO 6020
6700 CLOSE 1:GOSUB 6760:N=N-1:GOTO 6020
6750 ' -------------- ACTUAL DELETE ROUTINE ------------
6760 OPEN "i",1,IN$
6800 FOR L1=1 TO N
6820 INPUT#1,I1$
6840 IF L1<I GOTO 6920
6860 GET 2,L1+1
6880 PUT 2,L1
6900 IF L1=I GOTO 6940
6905 I2$=LEFT$(I1$,20)
6910 I1$=I2$+STR$(L1-1)
6920 IF L1<I THEN I$(L1)=I1$ ELSE IF L1>I THEN I$(L1-1)=I1$
6940 NEXT L1
6960 CLOSE 1
6968 OPEN "O",1,IN$
6972 FOR L1=1 TO N-1
6980 PRINT#1,I$(L1)
6984 NEXT L1
6988 CLOSE 1,3
6992 RETURN
7020 CLS:CLOSE:IF S=1 THEN KILL SRT$
7021 SYSTEM
8000 ' -------------------------DUP ROUTINE ----------------------------------
8020 IF F1=2 OR F1 = 3 THEN RETURN ELSE N11$=N1$:N21$=N2$:P1H$=PH$:S1T$=ST$:C1$=C$:S1$=S$:Z1$=Z$' SAVE NAMES
8022 IF N=1 THEN RETURN
8024 C3=0:C2=0
8030 OPEN "i",#1,IN$
8034 IF EOF(1) THEN CLOSE 1:GOTO 8262
8036 INPUT#1,I$
8040 IF N21$<>MID$(I$,6,15) THEN 8034
8060 I=VAL(RIGHT$(I$,LEN(I$)-20))
8080 GET 2,I
8100 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
8120 GOSUB 11010:GOSUB 10500:GOSUB 10600
8140 LOCATE 20,1:PRINT"This is a possible duplicate of ";:PRINT MID$(N11$,1,INSTR(N11$,"\")-1)" ";:PRINT MID$(N21$,1,INSTR(N21$,"\")-1)
8160 BEEP:LOCATE 22,1:PRINT"Is this a duplicate entry? ";:IPC=1:PT=0:OF=1:GOSUB 15150:IF IP$=ESC$ THEN 520 ELSE SWAP I$,IP$
8180 IF I$="Y" OR I$="y" THEN C2=1:GOTO 8262
8200 IF I$="N" OR I$="n" THEN C3=1:GOTO 8240
8220 LOCATE 23,1:BEEP:PRINT"YOU MUST ANSWER YES OR NO. PLEASE REENTER":FOR T=1 TO 1000:NEXT T:GOTO 8160
8240 LOCATE 20,1:PRINT STRING$(50,32):LOCATE 22,1:PRINT STRING$(50,32):LOCATE 23,1:PRINT STRING$(50,32)
8260 GOTO 8034
8262 IF C2=1 THEN N=N-1:GOTO 8280
8263 IF C3=0 THEN RETURN
8265 IF C2=0 THEN N1$=N11$:N2$=N21$:PH$=P1H$:ST$=S1T$:C$=C1$:S$=S1$:Z$=Z1$
8266 IF F=1 THEN GOTO 8280
8267 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "N
8269 GOSUB 11010:GOSUB 10600
8280 CLOSE 1:RETURN
9999 '-----------------------ERROR TRAPS AND SUBROUTINES----------------------
10000 IF ERR = 53 THEN GOTO 10150 ELSE IF ERR = 67 GOTO 10181
10002 IF ERR=25 THEN CLS:LOCATE 12,10:PRINT "MAKE PRINTER READY THEN HIT ANY KEY TO RESUME":GOTO 10004
10003 GOTO 10006
10004 EE$=INKEY$:IF EE$="" THEN 10004 ELSE CLS:LOCATE 10,35:PRINT"PRINTING":RESUME
10006 IF ERR=27 THEN CLS:LOCATE 12,10:PRINT "REPLACE PAPER IN PRINTER THEN HIT ANY KEY TO RESUME":GOTO 10008
10007 GOTO 10010
10008 EE$=INKEY$:IF EE$="" THEN 10008 ELSE RESUME
10010 IF ERR=61 THEN CLS ELSE GOTO 10020
10012 LOCATE 11,30:PRINT"DATA DISK IS FULL."
10014 LOCATE 12,30:PRINT"LAST ENTRY MAY NOT"
10016 LOCATE 13,30:PRINT"HAVE BEEN ADDED."
10017 LOCATE 14,30:INPUT"PRESS ENTER TO RESUME.",I$:RESUME 520
10020 IF ERR = 71 THEN CLS ELSE GOTO 10120
10025 ER=1:LOCATE 10,30:PRINT"DISK DRIVE NOT READY"
10040 LOCATE 11,30:PRINT"PLEASE INSERT DATA DISK"
10060 LOCATE 12,30:PRINT"OR CLOSE DRIVE DOOR":BEEP
10080 LOCATE 13,30:INPUT"PRESS ENTER TO RESUME",I$:IF MN=3 THEN CLS:LOCATE 1,30:PRINT"RECORD NUMBER":GOSUB 11010
10100 RESUME
10120 ON ERROR GOTO 0
10150 CLS:LOCATE 12,15:PRINT"File not found. Do you wish to create a new file? ";:IPC=1:PT=0:OF=1:GOSUB 15150
10160 IF I$="Y" OR I$="y" THEN RESUME 410
10170 LOCATE 15,20:COLOR 0,7:PRINT "THE CURRENT FILES ON DISK B ARE:":LOCATE 17,1:COLOR 7,0:FILES "B:*.*"
10172 LOCATE 25,20:COLOR 0,7:PRINT "** PRESS ANY KEY TO CONTINUE **";:COLOR 7,0
10175 A$=INKEY$:IF A$="" THEN 10175
10180 CLOSE:ERASE I$:ERASE I1$:RESUME 103
10181 CLS:BEEP:LOCATE 20,20:PRINT"File name entered:";:COLOR 15,0:LOCATE 20,POS(0)+1:PRINT RIGHT$(RAN$,LEN(RAN$)-2):COLOR 7,0:LOCATE 22,10:PRINT"You have entered an invalid character in the file name."
10182 LOCATE 23,10:PRINT"Please press any key to return to file selection."
10183 I$=INKEY$:IF I$="" THEN 10183 ELSE CLS:RESUME 103
10199 ' ---------------------- WRITE R-A FILE TO DISK -----------------
10200 LSET CF$=C$
10220 LSET SF$=S$
10240 LSET ZF$=Z$
10260 LSET PHF$=PH$
10280 LSET STF$=ST$
10300 LSET N1F$=N1$
10320 LSET N2F$=N2$
10340 IF F1 = 2 OR F1=3 THEN PUT 2,I1 ELSE PUT #2,N
10360 RETURN
10399 ' --------------------------WRITE INDEX FILE TO DISK --------------------
10400 OPEN "O",#1,IN$
10420 FOR L=1 TO N:PRINT#1,I$(L):NEXT L
10440 CLOSE #1:RETURN
10500 MID$(C$,1)=CF$:MID$(S$,1)=SF$:MID$(Z$,1)=ZF$:MID$(PH$,1)=PHF$:MID$(ST$,1)=STF$:MID$(N1$,1)=N1F$:MID$(N2$,1)=N2F$:' CONVERT RA FILES TO REGULAR VARIABLES
10520 RETURN
10599 ' ------------------------ PRINT FIELD VALUES -------------------------
10600 COLOR 0,7:LOCATE 3,12:PRINT" ";:PRINT MID$(N1$,1,INSTR(N1$,"\")-1);:PRINT" ";:COLOR 7,0:PRINT STRING$(12-INSTR(N1$,"\"),32):COLOR 0,7:
10602 LOCATE 3,40:PRINT" ";:PRINT MID$(N2$,1,INSTR(N2$,"\")-1);:PRINT" ";:COLOR 7,0:PRINT STRING$(16-INSTR(N2$,"\"),32):COLOR 0,7:LOCATE 9,7:PRINT PH$:LOCATE 5,16:PRINT" ";:PRINT ST$
10605 LOCATE 7,6:PRINT" ";:PRINT MID$(C$,1,INSTR(C$,"\")-1);:PRINT" ";:COLOR 7,0:PRINT STRING$(16-INSTR(C$,"\"),32):COLOR 0,7:LOCATE 7,36:PRINT" ";:PRINT S$;:PRINT" ";:LOCATE 7,54:PRINT" ";:PRINT Z$;:PRINT" "
10620 COLOR 7,0:RETURN
11000 ' ----------------------- MAIN DISPLAY ROUTINE --------------------------
11010 LOCATE ,,0:LOCATE 3,1:PRINT"FIRST NAME:";:LOCATE 3,30:PRINT"LAST NAME:";:LOCATE 9,1:PRINT"PHONE:";:LOCATE 5,1:PRINT"STREET ADDRESS:";:LOCATE 7,1:PRINT"CITY:";:LOCATE 7,30:PRINT"STATE:";:LOCATE 7,45:PRINT"ZIP CODE:";:RETURN
11100 LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0
11120 I$=INKEY$:IF I$="" THEN 11120
11140 IF VAL(I$)=0 THEN RETURN ELSE I=VAL(I$):RETURN
11150 LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0:RETURN
11200 LOCATE 3,13:PRINT "--------- ":LOCATE 3,41:PRINT "-------------- ":LOCATE 9,7:PRINT "------------ ":LOCATE 5,17:PRINT "------------------- ":LOCATE 7,7:PRINT "-------------- ":LOCATE 7,37:PRINT "-- ":LOCATE 7,55:PRINT "----- ":RETURN
11300 LOCATE 1,34:COLOR 0,7:PRINT" MAILIST1 ":COLOR 7,0:RETURN
11400 GOSUB 11150:COUNT=0:LOCATE 3,13,1
11405 I$=INKEY$:IF I$="" THEN 11405
11410 IF I$=CHR$(9) THEN GOSUB 11510:GOTO 11405 'tab key
11415 IF LEN(I$)= 2 AND RIGHT$(I$,1)=CHR$(15) THEN GOSUB 11700:GOTO 11405 'back
11417 IF LEN(I$)=2 AND RIGHT$(I$,1)=>CHR$(16) THEN 11405
11420 IF I$=CHR$(27) THEN IF MN=4 THEN 4020 ELSE N=N-1:GOTO 520 'Escape to menu
11430 IF I$=CHR$(13) THEN 13010 'Go check input?
11435 X=CSRLIN:Y=POS(0):Y=Y-1
11440 IF I$=CHR$(8) THEN GOSUB 11810:GOTO 11405 'backspace key
11450 COUNT=COUNT+1:PRINT I$;:GOSUB 13500':PRINT I$;
11460 GOTO 11405
11500 '------------------DETERMINE FIELD AND TAB-------------------------
11510 IF CSRLIN = 3 THEN 11570
11520 IF CSRLIN = 5 THEN LOCATE 7,7:COUNT=43:RETURN
11530 IF CSRLIN = 7 THEN 11590
11540 IF CSRLIN = 9 THEN 11550
11550 IF POS(0)=>7 AND POS(0)<19 THEN LOCATE 3,13:COUNT=0:RETURN
11560 LOCATE 3,13:RETURN
11570 IF POS(0)=>13 AND POS(0) <23 THEN LOCATE 3,41:COUNT=9:RETURN
11572 IF POS(0)=>41 AND POS(0)<56 THEN LOCATE 5,17:COUNT=23:RETURN
11580 LOCATE 3,13:COUNT=0:RETURN
11590 IF POS(0)=>7 AND POS(0) <22 THEN LOCATE 7,37:COUNT=57:RETURN
11592 IF POS(0)=>37 AND POS(0)<40 THEN LOCATE 7,55:COUNT=59:RETURN
11594 IF POS(0)=>55 AND POS(0) <60 THEN LOCATE 9,7:COUNT=64:RETURN
11600 LOCATE 3,13:COUNT=0:RETURN
11700 '----------------BACK TAB ROUTINE -------------------------------------
11710 IF CSRLIN = 3 THEN 11770
11720 IF CSRLIN = 5 THEN LOCATE 3,41:COUNT=9:RETURN
11730 IF CSRLIN = 7 THEN 11790
11740 IF CSRLIN = 9 THEN LOCATE 7,55:COUNT=59:RETURN
11770 IF POS(0)=>13 AND POS(0) <23 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
11772 IF POS(0)=>41 AND POS(0)<56 THEN LOCATE 3,13:COUNT=0:RETURN
11780 LOCATE 3,67:COUNT=36:RETURN
11790 IF POS(0)=>7 AND POS(0) <22 THEN LOCATE 5,17:COUNT=23:RETURN
11792 IF POS(0)=>37 AND POS(0)<40 THEN LOCATE 7,7:COUNT=43:RETURN
11794 IF POS(0)=>55 AND POS(0) <60 THEN LOCATE 7,37:COUNT=57:RETURN
11799 LOCATE 3,13:COUNT=0:RETURN
11800 '------------------BACKSPACE -----------------------------------------
11810 IF X = 3 THEN 11870
11820 IF X = 5 THEN 11822 ELSE 11830
11822 IF POS(0)=17 THEN X=3:Y=54:GOSUB 11910:RETURN
11825 GOSUB 11920:RETURN
11830 IF X = 7 THEN 11890
11840 IF X = 9 THEN 11842
11842 IF POS(0)=7 THEN X=7:Y=59:GOSUB 11910:RETURN
11845 GOSUB 11920:RETURN
11870 IF POS(0)=13 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
11872 IF POS(0)=41 THEN Y=21:GOSUB 11910:RETURN
11880 GOSUB 11920:RETURN
11890 IF POS(0)=7 THEN X=5:Y=36:GOSUB 11910:RETURN
11892 IF POS(0)=37 THEN Y=20:GOSUB 11910:RETURN
11894 IF POS(0)=55 THEN Y=38:GOSUB 11910:RETURN
11899 GOSUB 11920:RETURN
11900 '-------------------PRINT '-' FOR BACKSPACE --------------------------
11910 LOCATE X,Y:PRINT STRING$(1,45):LOCATE X,Y:COUNT=COUNT-1:RETURN
11920 LOCATE X,Y:PRINT STRING$(1,45):LOCATE X,Y:COUNT=COUNT-1:RETURN
12010 CLOSE 2:COLOR 15,0:LOCATE 19,22:PRINT"Loading AutoDialer ..............":COLOR 7,0:CHAIN "A:AUTODIAL.BAS"
13000 '------------------READ SCREEN FOR INPUT ----------------------------
13010 CR=3:CC=13:LOCATE ,,0:I$="":TEST=0:ERRORN=0
13015 FOR L=0 TO 8
13020 IF L=0 THEN 13030 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=10:GOTO 13038
13030 I$=I$+CHR$(SCREEN(CR,CC+L))
13034 IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=10:GOTO 13038
13036 IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
13038 GOSUB 13684
13040 NEXT L:IF ERRORN=1 THEN GOSUB 13700:GOTO 11405
13050 N1$=STRING$(10," "):I$=I$+"\":MID$(N1$,1)=I$
13060 CC=41:I$="":TEST=0:ERRORN=0
13070 FOR L=0 TO 13
13080 IF L=0 THEN 13090 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=13:GOTO 13098
13090 I$=I$+CHR$(SCREEN(CR,CC+L))
13094 IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=13:GOTO 13098
13096 IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
13098 GOSUB 13684
13100 NEXT L:IF ERRORN=1 THEN GOSUB 13740:GOTO 11405
13110 MID$(N2$,1)=STRING$(15," "):I$=I$+"\":MID$(N2$,1)=I$
13120 CR=9:CC=7:I$="":ERRORN=0
13130 FOR L=0 TO 11
13140 I$=I$+CHR$(SCREEN(CR,CC+L))
13145 GOSUB 13650
13150 NEXT L:IF ERRORN=1 THEN GOSUB 13670:GOTO 11405
13155 MID$(PH$,1)=I$
13160 CR=5:CC=17:I$="":TEST=0
13170 FOR L=0 TO 19
13180 IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=19:GOTO 13200
13190 I$=I$+CHR$(SCREEN(CR,CC+L))
13194 IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=19:GOTO 13200
13196 IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
13200 NEXT L
13210 MID$(ST$,1)=STRING$(20," "):MID$(ST$,1)=I$
13220 CR=7:CC=7:I$="":TEST=0
13230 FOR L=0 TO 13
13240 IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=13:GOTO 13260
13250 I$=I$+CHR$(SCREEN(CR,CC+L))
13254 IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=0 THEN TEST=TEST+1 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(32) AND TEST=1 THEN I$=LEFT$(I$,LEN(I$)-2):L=13:GOTO 13260
13256 IF TEST=1 AND CHR$(SCREEN(CR,CC+L))<>CHR$(32) THEN TEST=0:I1$=RIGHT$(I$,1):I$=LEFT$(I$,LEN(I$)-1)+I1$
13260 NEXT L
13270 I$=I$+"\":MID$(C$,1)=STRING$(15," "):MID$(C$,1)=I$
13280 CC=37:I$=""
13290 FOR L=0 TO 1
13300 I$=I$+CHR$(SCREEN(CR,CC+L))
13310 NEXT L
13315 MID$(S$,1)=I$
13320 CC=55:I$="":ERRORN=0
13330 FOR L=0 TO 4
13340 I$=I$+CHR$(SCREEN(CR,CC+L))
13345 GOSUB 13610
13350 NEXT L:IF ERRORN=1 THEN GOSUB 13630:GOTO 11405
13355 MID$(Z$,1)=I$
13360 RETURN
13500 '------------------CHECK COUNT FOR NEXT FIELD ----------------------
13510 IF COUNT=9 THEN BEEP:LOCATE 3,41:RETURN
13520 IF COUNT=23 THEN BEEP:LOCATE 5,17:RETURN
13530 IF COUNT=43 THEN BEEP:LOCATE 7,7:RETURN
13550 IF COUNT=57 THEN BEEP:LOCATE 7,37:RETURN
13560 IF COUNT=59 THEN BEEP:LOCATE 7,55:RETURN
13565 IF COUNT=76 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
13568 IF COUNT=64 THEN BEEP:LOCATE 9,7:RETURN
13570 IF COUNT>78 THEN BEEP:BEEP:GOTO 11400
13580 RETURN
13600 '------------------------ TEST FOR NUMERIC ZIP -------------------------
13610 I3$=CHR$(SCREEN(CR,CC+L)):IF I3$<CHR$(48) OR I3$>CHR$(57) THEN 13620 ELSE RETURN
13620 ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
13630 LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,25:PRINT " Zip code must be NUMERIC. ";:LOCATE 7,55,1:COUNT=59:RETURN
13640 '----------------------- TEST PHONE NUMBER -----------------------------
13650 I3$=CHR$(SCREEN(CR,CC+L)):IF I3$<CHR$(48) OR I3$>CHR$(57) THEN 13655 ELSE RETURN
13655 IF I3$=CHR$(45) THEN RETURN
13660 ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
13670 LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,20:PRINT " Phone number must be NUMERIC. ";:LOCATE 9,7,1:COUNT=64:RETURN
13680 '----------------------- TEST NAME FIELDS ------------------------------
13684 I3$=CHR$(SCREEN(CR,CC+L))
13690 IF L<>0 THEN RETURN ELSE IF I3$=CHR$(45) OR I3$=CHR$(32) THEN GOTO 13695 ELSE RETURN
13695 ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
13700 LOCATE 23,1:PRINT STRING$(75,32):LOCATE 23,20:PRINT " Name fields are required.";:LOCATE 3,13,1:COUNT=0:RETURN
13740 LOCATE 23,1:PRINT STRING$(75,32):LOCATE 23,20:PRINT " Name fields are required.";:LOCATE 3,41,1:COUNT=9:RETURN
15000 '-------------------------INKEY ROUTINE -------------------------------
15150 IP$=STRING$(IPC," "):CT=0:P1=0:PS=POS(0)
15155 IF OF=1 THEN LOCATE ,,1 ELSE LOCATE ,,0
15157 I$=INKEY$:IF I$="" THEN 15157 ELSE LOCATE ,,0
15161 IF I$=CR$ THEN 15200
15162 IF I$=CHR$(8) THEN LOCATE CSRLIN,POS(0)-1:PRINT" ";:LOCATE CSRLIN,POS(0)-1:CT=CT-1:IF CT<=0 THEN MID$(IP$,1)=SPACE$(IPC):BEEP:LOCATE CSRLIN,PS:CT=0:GOTO 15155:ELSE MID$(IP$,1)=LEFT$(IP$,CT)+" ":GOTO 15155
15164 IF LEN(I$)=2 THEN IF RIGHT$(I$,1)=CHR$(75) THEN LOCATE CSRLIN,POS(0)-1:PRINT" ";:LOCATE CSRLIN,POS(0)-1:CT=CT-1:IF CT<=0 THEN MID$(IP$,1)=SPACE$(IPC):BEEP:LOCATE CSRLIN,PS:CT=0:GOTO 15155:ELSE MID$(IP$,1)=LEFT$(IP$,CT)+" ":GOTO 15155
15165 IF LEN(I$)= 2 THEN 15155 ELSE IF I$=CHR$(46) THEN GOTO 15155 ELSE IF I$=CHR$(63) THEN 15155 ELSE IF ASC(I$) < 47 AND ASC(I$) > 122 THEN 15155
15166 IF I$=ESC$ THEN IP$=I$:RETURN
15170 IF PT=1 THEN PRINT I$;
15180 CT=CT+1:MID$(IP$,CT,1)=I$
15190 IF CT=IPC THEN RETURN ELSE GOTO 15155
15200 FOR L=IPC TO 1 STEP -1
15210 IF MID$(IP$,L,1)<>" " THEN P1=L:L=1
15220 NEXT L
15230 IP$=LEFT$(IP$,P1):RETURN
19999 '--------------------------OPENING LOGO ---------------------------------
20000 DIM C$(10,7)
20010 CLS
20020 M$(1,1)="█████ █████"
20030 M$(1,2)=" ████ ████ "
20040 M$(1,3)=" ██ ███ ██ "
20050 M$(1,4)=" ██ █ ██ "
20060 M$(1,5)=" ██ ██ "
20070 M$(1,6)="███ ███ "
20080 M$(1,7)="███ ███ "
20090 C$(1,1)=" ███ "
20100 C$(1,2)=" █████"
20110 C$(1,3)=" ███████"
20120 C$(1,4)="████ ████"
20130 C$(1,5)="███ ███"
20140 C$(1,6)="█████████"
20150 C$(1,7)="███ ███"
20160 C$(2,1)="███████"
20170 C$(2,2)=" ███"
20180 C$(2,3)=" ███"
20190 C$(2,4)=" ███"
20200 C$(2,5)=" ███"
20210 C$(2,6)=" ███"
20220 C$(2,7)="███████"
20230 C$(3,1)="████"
20240 C$(3,2)=" ███"
20250 C$(3,3)=" ███"
20260 C$(3,4)=" ███"
20270 C$(3,5)=" ███"
20280 C$(3,6)=" ███ █"
20290 C$(3,7)="██████████"
20300 C$(5,1)="██████████"
20310 C$(5,2)="███ ███"
20320 C$(5,3)="███"
20330 C$(5,4)="██████████"
20340 C$(5,5)=" ████"
20350 C$(5,6)="███ ████"
20360 C$(5,7)="██████████"
20370 C$(6,1)="██████████"
20380 C$(6,2)="██████████"
20390 C$(6,3)=" ████"
20400 C$(6,4)=" ████"
20410 C$(6,5)=" ████"
20420 C$(6,6)=" ████"
20430 C$(6,7)=" ████"
20440 C$(7,1)="████"
20450 C$(7,2)=" ███"
20460 C$(7,3)=" ███"
20470 C$(7,4)=" ███"
20480 C$(7,5)=" ███"
20490 C$(7,6)=" ███"
20500 C$(7,7)="█████"
20510 FOR Y= 1 TO 7
20520 LOCATE Y,12:PRINT M$(1,Y) TAB(25) C$(1,Y) TAB(36) C$(2,Y) TAB(45) C$(3,Y)
20530 LOCATE Y+8,22:PRINT C$(3,Y) TAB(34) C$(2,Y) TAB(44) C$(5,Y) TAB(56) C$(6,Y)
20540 NEXT Y
20550 COLOR 23,0
20560 FOR X= 17 TO 23
20570 LOCATE X,50:PRINT C$(7,X-16);
20580 NEXT
20590 COLOR 7,0
20600 LOCATE 24,1:PRINT "(C) COPYRIGHT William Dwinell and Mike Berry 1983";
20610 FOR WAITING=1 TO 3000:NEXT
20620 CLS
21140 FLEN=60:DPH=16:WDH=80:BDR=1
21160 Y=((WDH-FLEN)/2)-1:LOCATE BDR,Y:COLOR 15,0:PRINT CHR$(201);STRING$(FLEN+4,205);CHR$(187)
21180 FOR I=1 TO DPH:LOCATE I+BDR,Y:PRINT CHR$(186);:LOCATE I+BDR,(FLEN+5+Y):PRINT CHR$(186):NEXT
21200 LOCATE I+BDR,Y:PRINT CHR$(200);STRING$(FLEN+4,205);CHR$(188):COLOR 7,0
21220 LOCATE 3,37:COLOR 0,7:PRINT" MAILIST1 ";:COLOR 7,0
21240 LOCATE 20,18:PRINT"(C) Copyright William Dwinell and Mike Berry 1983";
21242 LOCATE 4,36:PRINT" RELEASE 4.0 "
21244 LOCATE 6,12:PRINT "This program is released to PUBLIC DOMAIN with the provisions ";
21245 LOCATE 7,12:PRINT "that lines 20000 through 25000 of program remain unmodified.";
21246 LOCATE 11,12:PRINT "The authors would appreciate knowing of any problems or";
21247 LOCATE 12,12:PRINT "suggestions for improvements. Please notify by mail or";
21248 LOCATE 13,12:PRINT "a message on CompuServe, see next frame."
21249 LOCATE 9,12:PRINT "No portion of this program is to be sold."
21260 LOCATE 23,30:COLOR 16,7:PRINT" Press any key to continue ";:COLOR 7,0
21280 I$=INKEY$:IF I$="" GOTO 21280
21290 FOR NEWSCREEN = 6 TO 15:LOCATE NEWSCREEN,12:PRINT STRING$(61,32):NEXT
21300 LOCATE 6,12:PRINT "If you find this program is useful to you a contribution";
21310 LOCATE 7,12:PRINT "in the amount of $15 is suggested."
21320 LOCATE 9,12:PRINT "All contributers will be notified of enhancements or future";
21330 LOCATE 10,12:PRINT "releases of MAILIST1. Send contributions to:"
21340 LOCATE 12,20:PRINT "Mike Berry Bill Dwinell"
21350 LOCATE 13,20:PRINT "PO Box 18708 1144 Hallmark Drive"
21360 LOCATE 14,20:PRINT "Shreveport, La or Shreveport, La."
21370 LOCATE 15,20:PRINT "71138 71118"
21380 LOCATE 16,20:PRINT "CIS 70235,1300 CIS 70055,1145"
24980 LOCATE 23,30:PRINT STRING$(45,32)
24990 LOCATE 23,30:COLOR 16,7:PRINT" Press any key to begin ";:COLOR 7,0
24999 I$=INKEY$:IF I$="" GOTO 24999 ELSE RETURN
25000 '(C) Copyright William Dwinell and Mike Berry 1983
MAILLIST.BAS
100 ' MAILLIST by Bob Noble
110 ' IBM Personal Computer BASIC
120 '
130 ' Submitted to the Philadelphia IBM PC Users Club 6-30-82
140 '
150 ' This program creates, appends, edits, displays, and deletes
160 ' variable length records of 10 variable length fields in
170 ' "Mailling List" type files named by the user.
180 '
190 ' The biggest deficiency is the lack of an LPRINT routine for
200 ' printing hard copy. This is because I don't yet have a print-
210 ' er myself. I leave the addition of this function to other
220 ' programers, or until I get a printer.
230 '
240 ' Variables Used
250 ' FILE$ = Name of data file used
260 ' L$ = Name (Last Name of person)
270 ' F$ = First Name of person
280 ' A$ = 1st Next Line
290 ' B$ = 2nd Next Line (optional)
300 ' D$ = 3rd Next Line (optional)
310 ' E$ = 4th Next Line (optional)
320 ' G$ = 5th Next Line (optional)
330 ' C$ = City
340 ' S$ = State
350 ' Z$ = Zip Code
360 '
370 CLS: KEY OFF: LINE INPUT "Enter name of file to be used: ", FILE$
380 '
390 ' Main menu
400 '
410 CLS: PRINT "MAILLIST * * * MAIN MENU File Open: "; FILE$
420 PRINT: PRINT " 1. Add Record(s)"
430 PRINT " 2. Edit Record(s)"
440 PRINT " 3. Display Record(s)"
450 PRINT " 4. Delete Record(s)"
460 PRINT " 5. Task Completed - Return to BASIC"
470 PRINT: INPUT "Make Selection (1-5): ", Q
480 IF Q=5 THEN CLOSE: CLS: KEY ON: END
490 ON Q GOTO 520, 990, 760, 1220
500 '
510 ' * * * * * Data Entry Module
520 OPEN FILE$ FOR APPEND AS #1
530 CLS: PRINT "MAILLIST *** DATA ENTRY File Open: "; FILE$
540 LOCATE 19,10: PRINT "Note: If name is not a person, enter as last name and
550 PRINT " press <ENTER> when `first name' prompt appears."
560 LOCATE 3,1: LINE INPUT " Last Name: ", L$
570 LINE INPUT " First Name: ", F$
580 LOCATE 22,10: PRINT "Note: Press `%' at `Next Line' prompt when ready to enter `city'."
590 LOCATE 5,1: LINE INPUT " Next Line: ", A$
600 LINE INPUT " Next Line: ", B$
610 IF B$ = "%" THEN D$ = "%": E$ = "%": G$ = "%": GOTO 670
620 LINE INPUT " Next Line: ", D$
630 IF D$ = "%" THEN E$ = "%": G$ = "%": GOTO 670
640 LINE INPUT " Next Line: ", E$
650 IF E$ = "%" THEN G$ = "%": GOTO 670
660 LINE INPUT " Next Line: ", G$
670 LINE INPUT " City: ", C$
680 LINE INPUT " State: ", S$
690 LINE INPUT " Zip: ", Z$
700 WRITE#1, L$,F$,A$,B$,D$,E$,G$,C$,S$,Z$
710 '
720 PRINT: LINE INPUT "Do you want to enter more data? (Y/N) ", Q$
730 IF LEFT$(Q$,1)="Y" OR LEFT$(Q$,1)="y" THEN 530 ELSE CLOSE: GOTO 410
740 '
750 ' * * * * * Display File
760 CLS: OPEN "I", 1, FILE$
770 PRINT "MAILLIST * * * Display Routine File Open: "; FILE$
780 PRINT: PRINT "1. Display one record at a time."
790 PRINT "2. Scroll file."
800 PRINT: LINE INPUT "Make Selection (1 or 2): ", Q$
810 CLS
820 LOCATE 25: PRINT "Press <ENTER> to continue.": LOCATE 1
830 IF EOF(1) THEN 950
840 INPUT#1, L$,F$,A$,B$,D$,E$,G$,C$,S$,Z$
850 IF F$="" THEN PRINT L$: GOTO 870
860 PRINT F$ + " " + L$
870 PRINT A$
880 IF B$ <> "%" THEN PRINT B$
890 IF D$ <> "%" THEN PRINT D$
900 IF E$ <> "%" THEN PRINT E$
910 IF G$ <> "%" THEN PRINT G$
920 PRINT C$ + ", " + S$ + " " + Z$
930 IF Q$="2" THEN PRINT: GOTO 830
940 INPUT "",Q$: GOTO 830
950 PRINT "END OF FILE ": LOCATE 25,18: INPUT "return to main menu ",Q$
960 CLOSE: GOTO 410
970 '
980 ' * * * * * Edit File
990 CLS: OPEN "I", 1, FILE$
1000 OPEN "O", 2, "TEMPFIL"
1010 PRINT "MAILLIST * * * Edit Routine File Open: "; FILE$
1020 PRINT: LINE INPUT "Enter last name of record to edit: ", L$
1030 IF LEN(L$) = 0 THEN PRINT "Something must be entered.": GOTO 1020
1040 '
1050 GOSUB 1630: ' * * * Search Subroutine
1060 '
1070 CLS: PRINT "MAILLIST * * * Edit Routine File Open: "; FILE$
1080 GOSUB 1540: ' * * * Display record for field to edit
1090 PRINT: INPUT "Enter selection (0-10): ", Q
1100 IF Q=0 THEN WRITE #2, L1$,F$,A$,B$,D$,E$,G$,C$,S$,Z$: GOTO 1140
1110 LOCATE 17: PRINT "Make changes and move cursor to end of line, then press <ENTER>.": LOCATE 1
1120 ON Q GOSUB 1420,1430,1440,1450,1460,1470,1480,1490,1500,1510
1130 '
1140 GOSUB 1720: ' * * Subroutine to read-write remainder of file to TEMPFIL
1150 '
1160 GOSUB 1770: ' * Subroutine to initialize and copy TEMPFIL back to file
1170 '
1180 ' * * * * * Querry user for more editing
1190 LOCATE 19: LINE INPUT "Do you want to do more editing? (Y/N) ", Q$
1200 IF LEFT$(Q$,1)="Y" OR LEFT$(Q$,1)="y" THEN 990 ELSE 410
1210 '
1220 ' * * * * * Delete Record Routine
1230 CLS: PRINT "MAILLIST * * * Delete Record Routine File Open: "; FILE$
1240 PRINT: LINE INPUT "Enter last name of record to delete: ", L$
1250 OPEN "I", 1, FILE$: OPEN "O", 2, "TEMPFIL"
1260 '
1270 GOSUB 1630: ' * * * Search subroutine
1280 '
1290 CLS: PRINT "MAILLIST * * * Delete Record Routine File Open: "; FILE$
1300 GOSUB 1540: ' * Subroutine to display record
1310 PRINT: LINE INPUT "Enter `0' to delete record, or `1' to save: ", Q$
1320 IF Q$ = "0" THEN GOSUB 1720: ' * * * Write rest of FILE$ to TEMPFIL
1330 IF Q$="1" THEN WRITE #2,L$,F$,A$,B$,D$,E$,G$,C$,S$,Z$: GOSUB 1720: 'ditto
1340 GOSUB 1770: ' * * * Write TEMPFIL back to FILE$
1350 '
1360 ' * * * * * Querry user for more deletions
1370 PRINT: LINE INPUT "Do you want to delete another? ", Q$
1380 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 1230 ELSE 410
1390 '
1400 ' * * * * * Subroutines to edit fields
1410 '
1420 LOCATE 4,5: LINE INPUT L$: GOSUB 1600: RETURN: ' *** Last Name
1430 LOCATE 5,5: LINE INPUT F$: GOSUB 1600: RETURN: ' *** First Name
1440 LOCATE 6,5: LINE INPUT A$: GOSUB 1600: RETURN: ' *** 1st `Next Line'
1450 LOCATE 7,5: LINE INPUT B$: GOSUB 1600: RETURN: ' *** 2nd `Next Line'
1460 LOCATE 8,5: LINE INPUT D$: GOSUB 1600: RETURN: ' *** 3rd `Next Line'
1470 LOCATE 9,5: LINE INPUT E$: GOSUB 1600: RETURN: ' *** 4th `Next Line'
1480 LOCATE 10,5: LINE INPUT G$: GOSUB 1600: RETURN: ' *** 5th `Next Line'
1490 LOCATE 11,5: LINE INPUT C$: GOSUB 1600: RETURN: ' *** City
1500 LOCATE 12,5: LINE INPUT S$: GOSUB 1600: RETURN: ' *** State
1510 LOCATE 13,5: LINE INPUT Q$: GOSUB 1600: RETURN: ' *** Zip Code
1520 '
1530 ' * * * * * Subroutine to Display Field Menu
1540 PRINT: PRINT " 0 = No Changes"
1550 PRINT " 1. "; L$: PRINT " 2. "; F$: PRINT " 3. "; A$: PRINT " 4. "; B$
1560 PRINT " 5. "; D$: PRINT " 6. "; E$: PRINT " 7. "; G$: PRINT " 8. "; C$
1570 PRINT " 9. "; S$: PRINT "10. "; Z$
1580 '
1590 ' * * * * * Subroutine to write edited record to file
1600 WRITE #2, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: RETURN
1610 '
1620 ' * * * * * File Search Subroutine
1630 IF EOF(1) THEN 1670
1640 INPUT #1, L1$, F$, A$, B$, D$, E$, G$, C$, S$, Z$
1650 IF L$ = L1$ THEN RETURN
1660 WRITE #2, L1$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: GOTO 1630
1670 PRINT: PRINT "ERROR Message. "; V$; " not found in "; FILE$
1680 PRINT: LINE INPUT "Press <ENTER> to return to main menu. ", Q$
1690 CLOSE: GOTO 410
1700 '
1710 ' * * * * * Subroutine to read-write remainder of file to TEMPFIL
1720 IF EOF(1) THEN CLOSE: RETURN
1730 INPUT #1, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$
1740 WRITE #2, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: GOTO 1720
1750 '
1760 ' * * * * * Subrountine to initialize and copy TEMPFIL back to file
1770 OPEN "I", 1, "TEMPFIL": OPEN "O", 2, FILE$
1780 IF EOF(1) THEN CLOSE: KILL "TEMPFIL": RETURN
1790 INPUT #1, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$
1800 WRITE #2, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: GOTO 1780
MAILMEMB.BAS
5 COMMON DRIVEID$,FILEID$,RECNUM2,DRIVEID2$,A$,B$,C$,D$,E#
10 SCREEN 0,1
15 OPEN DRIVEID2$+FILEID2$ AS #1 LEN=128
16 FIELD #1, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
20 COLOR 15,9,4
25 CLS
30 PRINT " "
40 PRINT " "
50 PRINT " ADD TO MAILING LIST"
60 PRINT " "
70 PRINT " "
80 INPUT " NAME ==>";A$
90 PRINT " "
100 INPUT " ADDRESS LINE 1==>";B$
110 PRINT " "
120 INPUT " ADDRESS LINE 2==>";C$
130 PRINT " "
140 INPUT " CITY/STATE ==>";D$
150 PRINT " "
160 INPUT " ZIP CODE ==>";E#
170 IF E# = 0 THEN 160
210 GET #1,1
220 NEXTAVAIL$ = ZIPCODE$
230 IF NEXTAVAIL$ = " " THEN NEXTAVAIL$ = "000000004"
240 RECNUM# = CVD(ZIPCODE$)
245 RECNUM# = RECNUM# + 1
246 IF RECNUM# <> RECNUM2 THEN PRINT " ERROR in file -- recnum=";RECNUM#;" recnum2=";RECNUM2:STOP
250 LSET ZIPCODE$ = MKD$(RECNUM#)
260 PUT #1,1
300 GET #1,RECNUM#
320 LSET NAM$ = A$
330 LSET ADD1$=B$
340 LSET ADD2$=C$
350 LSET CITYST$=D$
360 LSET ZIPCODE$=MKD$(E#)
380 PUT #1,RECNUM#
390 PRINT " "
395 PRINT " "
400 PRINT " ADDRESS ADDED"
500 CLOSE #1
510 CHAIN DRIVEID$+"updmemb"
MAILMENU.BAS
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
40 CLS
50 PRINT " "
55 PRINT " "
60 PRINT " EASY-MAIL AVAILABLE FUNCTIONS"
70 PRINT " "
80 PRINT " "
90 PRINT " A - DISPLAY MAILING LIST"
100 PRINT " B - ADD TO LIST"
110 PRINT " C - DELETE FROM LIST"
120 PRINT " D - CHANGE LIST"
130 PRINT " E - PRINT LABELS"
140 PRINT " F - PRINT LIST"
150 PRINT " G - REORG FILE"
160 PRINT " H - ERASE/BUILD FILE
170 PRINT " I - STATUS REPORT"
180 PRINT " Esc - EXIT"
190 PRINT " "
200 PRINT " "
210 PRINT " SELECT FUNCTION BY LETTER"
220 K$ = INKEY$: IF K$ = "" THEN 220
230 IF K$ = "A" THEN 440
240 IF K$ = "a" THEN 440
250 IF K$ = "B" THEN 450
260 IF K$ = "b" THEN 450
270 IF K$ = "C" THEN 460
280 IF K$ = "c" THEN 460
290 IF K$ = "D" THEN 470
300 IF K$ = "d" THEN 470
310 IF K$ = "E" THEN 480
320 IF K$ = "e" THEN 480
330 IF K$ = "F" THEN 490
340 IF K$ = "f" THEN 490
350 IF K$ = "G" THEN 500
360 IF K$ = "g" THEN 500
370 IF K$ = "H" THEN 510
380 IF K$ = "h" THEN 510
390 IF K$ = "I" THEN 520
400 IF K$ = "i" THEN 520
410 IF K$ = CHR$(27) THEN 530
420 IF K$ = "J" THEN 530
430 GOTO 220
440 CHAIN "B:DISPMAIL"
450 CHAIN "B:ADDMAIL"
460 CHAIN "B:DELMAIL"
470 CHAIN "B:CHGMAIL"
480 CHAIN "B:LABMAIL"
490 CHAIN "B:LISTMAIL"
500 CHAIN "B:REORMAIL"
510 CHAIN "B:BUILDML"
520 CHAIN "B:STATMAIL"
530 CLS
531 KEY ON
532 END
534 REM FOLLOWING CODE NOT NOW USED
540 PRINT " "
550 PRINT " PLACE DOS DISKETTE IN DRIVE A"
551 PRINT " PRESS ANY KEY TO PROCEED
552 K$ = INKEY$: IF K$ = "" THEN 552
553 CLS
554 CHAIN "IBMPMENU"
MAILSORT.BAS
2000 ' ----------------------- SORT ROUTINE ---------------------------------
2010 DEFINT A-Z:COMMON N,RAN$,IN$,NBR$,SRT$,S,CR$,ESC$:SRT$=RAN$+".SRT":DIM I1$(1000):DIM I1(1000):ON ERROR GOTO 10000
2020 I=0:MN=2:KEY 9,"":CLS:LOCATE 1,34:COLOR 0,7:PRINT" MAILIST1 ":COLOR 7,0:LOCATE 5,29:COLOR 15,0:PRINT"DO YOU WANT TO SORT BY":COLOR 7,0
2060 LOCATE 8,33:PRINT"1 Last name"
2080 LOCATE 9,33:PRINT"2 Zipcode"
2100 LOCATE 19,24:PRINT"Type the number of your choice:":GOSUB 11100
2105 IF I$=CHR$(27) THEN LOCATE 19,24:COLOR 15,0:PRINT"Loading main program.............":COLOR 7,0:CHAIN "MAILIST1.BAS",110
2120 IF I<1 OR I>2 THEN LOCATE 23,27:BEEP:COLOR 15,0:PRINT"PLEASE TYPE NUMBER 1 OR 2":COLOR 7,0:GOTO 2100
2130 IF I = 2 GOTO 2460
2135 LOCATE 25,1:PRINT SPACE$(30);:LOCATE 19,24:COLOR 15,0:PRINT"Sorting........Please wait......":COLOR 7,0:L=1:OPEN "I",1,IN$
2140 IF EOF(1) THEN CLOSE 1:GOTO 2280
2145 INPUT#1,I1$(L)
2160 I=LEN(I1$(L)):I=I-5
2180 I1$(L)=MID$(I1$(L),6,INSTR(I1$(L),"\")-5):I=I-15:I1$(L)=I1$(L)+STR$(L)
2200 L=L+1:GOTO 2140
2280 M=N
2300 M=INT(M/2):IF M=0 THEN GOTO 2700
2320 K=N-M:FOR L=1 TO K
2340 I=L
2360 J=I+M
2380 IF I1$(I)<I1$(J) THEN 2420
2400 SWAP SV$,I1$(I):SWAP I1$(I),I1$(J):SWAP I1$(J),SV$:I=I-M:IF I-1>=0 THEN 2360
2420 NEXT L:GOTO 2300
2440 ' ----------------------ZIPCODE SORT -------------------------
2460 LOCATE 25,1:PRINT SPACE$(30);:LOCATE 19,24:COLOR 15,0:PRINT"Sorting.......Please wait.......":COLOR 7,0:L=1:OPEN "I",1,IN$
2465 IF EOF(1) THEN CLOSE 1:GOTO 2540
2470 INPUT#1,I$
2480 I=LEN(I$):I=I-20
2485 I1$(L)=" "
2500 MID$(I1$(L),1,5)=I$:I1$(L)=I1$(L)+RIGHT$(I$,I)
2520 L=L+1:GOTO 2465
2540 M=N
2560 M=INT(M/2):IF M=0 THEN GOTO 2700
2580 K=N-M:FOR L=1 TO K
2600 I=L
2620 J=I+M
2640 IF I1$(I)<I1$(J) THEN 2680
2660 SWAP SV$,I1$(I):SWAP I1$(I),I1$(J):SWAP I1$(J),SV$:I=I-M:IF I-1>=0 THEN 2620
2680 NEXT L:GOTO 2560
2700 FOR L=1 TO N:I$=RIGHT$(I1$(L),5)
2702 I=INSTR(I$," "):IF I=1 THEN I=INSTR(2,I$," ")
2704 I1(L)=VAL(RIGHT$(I$,LEN(I$)-I))
2706 NEXT L
2719 S=1:OPEN "o",1,SRT$
2720 FOR L=1 TO N:PRINT#1,I1(L):NEXT L
2740 CLOSE 1:BEEP:LOCATE 19,24:COLOR 15,0:PRINT"Loading main program.............":COLOR 7,0:CHAIN "MAILIST1.BAS",110
10000 IF ERR = 71 THEN CLS ELSE GOTO 10080
10020 LOCATE 10,20:PRINT"DISK DRIVE NOT READY. PLEASE INSERT DATA DISK"
10040 LOCATE 11,20:PRINT"OR CLOSE DRIVE DOOR. PRESS ENTER TO RESUME":BEEP
10060 I$=INKEY$:IF I$=CHR$(13) THEN RESUME ELSE 10060
10080 ON ERROR GOTO 0
11100 LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0
11120 I$=INKEY$:IF I$="" THEN 11120
11140 IF VAL(I$)=0 THEN RETURN ELSE I=VAL(I$):RETURN
MEMBERS.BAS
1 KEY OFF
5 DRIVEID2$="B:"
10 DRIVEID$="A:"
20 FILEID$="MEMBERS.MC"
30 FILEID2$="MAILLIST.REE"
40 COMMON DRIVEID$,FILEID$,DRIVEID2$,FILEID2$
70 CLS
80 PRINT " "
90 PRINT " Membership System"
100 PRINT " "
110 PRINT " "
120 PRINT " A - Add a member"
130 PRINT " B - Renew membership"
140 PRINT " C - Review"
150 PRINT " D - Status"
160 PRINT " E - Display"
170 PRINT " Esc - Exit"
180 PRINT " "
190 PRINT " "
200 PRINT " Select Desired Function"
210 K$=INKEY$: IF K$="" THEN 210
220 IF K$ = "A" OR K$="a" THEN CHAIN DRIVEID$+"addmemb"
230 IF K$="B" OR K$="b" THEN CHAIN DRIVEID$+"renumemb"
240 IF K$="C" OR K$="c" THEN CHAIN DRIVEID$+"revumemb"
250 IF K$="D" OR K$="d" THEN CHAIN DRIVEID$+"statmemb"
260 IF K$="E" OR K$="e" THEN CHAIN DRIVEID$+"dispmemb"
270 IF K$=CHR$(27) THEN 440
280 IF K$="+" THEN CHAIN DRIVEID$+"builmemb"
440 CLS
450 KEY ON
460 END
RENUMEMB.BAS
10 COMMON DRIVEID$, FILEID$, RECNUM2, DRIVEID2$, FILEID2$
20 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
30 FIELD #1, 4 AS EXPDATE$
35 OPEN DRIVEID2$+FILEID2$ AS #2 LEN=128
38 FIELD #2, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
40 CLS
50 PRINT " "
60 PRINT " Renew Membership"
70 PRINT " "
80 PRINT " "
90 INPUT " Membership number ==>";RECNUM4
100 IF RECNUM4 = 0 THEN 200
105 RECNUM3=RECNUM4
110 GET #1,RECNUM3
120 RECNUM2=RECNUM3
130 GET #2,RECNUM2
140 GOTO 300
200 PRINT " "
210 INPUT " Search for ==>";SEARCH$
220 GOSUB 1000
230 IF NON=1 THEN PRINT " No Match Found":GOTO 400
240 RECNUM3 = RECNUM
250 GOTO 110
300 IF CVS(EXPDATE$)=0 THEN PRINT " Member DELETED -- Add as new member":GOTO 390
305 PRINT " "
310 PRINT " ";NAM$
320 IF ADD1$ <> SPACE$(30) THEN PRINT " ";ADD1$
330 IF ADD2$ <> SPACE$(30) THEN PRINT " ";ADD2$
340 PRINT " ";CITYST$
350 PRINT " ";CVD(ZIPCODE$)
360 PRINT " "
370 PRINT " Subscription expires --";CVS(EXPDATE$)
380 PRINT " "
390 PRINT " "
400 GOTO 1350
1000 RECNUM = 4
1060 CLS
1120 RECNUM = RECNUM + 1
1130 IF RECNUM < 5 THEN RECNUM = 5
1140 GET #2, RECNUM
1150 ZIP# = CVD(ZIPCODE$)
1160 X=INSTR(NAM$,SEARCH$)
1170 IF X = 0 THEN 1180 ELSE 1280
1180 X=INSTR(ADD1$,SEARCH$)
1190 IF X = 0 THEN 1200 ELSE 1280
1200 X=INSTR(ADD2$,SEARCH$)
1210 IF X = 0 THEN 1220 ELSE 1280
1220 X=INSTR(CITYST$,SEARCH$)
1230 IF X = 0 THEN 1240 ELSE 1280
1240 X=INSTR(STR$(ZIP#),SEARCH$)
1250 IF ZIP# = 999999999# THEN 1120
1260 IF ZIP# = 0 THEN NON=1:GOTO 1340
1270 IF X = 0 THEN 1120
1280 PRINT " "
1340 PRINT " "
1345 RETURN
1348 PRINT " "
1350 PRINT " SPACE BAR TO CONTINUE"
1360 PRINT " Esc KEY TO RETURN TO MENU"
1370 PRINT " T KEY TO START OVER"
1371 PRINT " R KEY TO RENEW MEMBERSHIP"
1380 K$ = INKEY$: IF K$ = "" THEN 1380
1390 IF K$ = " " THEN 100
1400 IF K$ = CHR$(27) THEN 1440
1410 IF K$ = "T" THEN RECNUM = 4: GOTO 40
1420 IF K$ = "t" THEN RECNUM = 4: GOTO 40
1421 IF K$="R" OR K$="r" THEN GOTO 1500
1430 GOTO 1380
1440 CLOSE #1
1445 CLOSE #2
1450 CHAIN DRIVEID$+"members"
1500 IF CVS(EXPDATE$)=0 THEN 1380
1501 PRINT " "
1510 PRINT " New Expiration Date (YYMMDD)"
1520 INPUT " ==>";DTE
1530 LSET EXPDATE$=MKS$(DTE)
1540 PUT #1,RECNUM3
1545 PRINT " "
1550 PRINT " Subscription Renewed"
1560 GOTO 1348
REORMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 CLS
40 PRINT " "
50 PRINT " "
60 PRINT " REORGANIZE FILE"
70 PRINT " "
80 PRINT " "
90 PRINT " PLACE SCRATCH DISKETTE IN DRIVE A"
100 PRINT " "
110 PRINT " PRESS ANY KEY WHEN READY"
120 PRINT " "
130 K$=INKEY$: IF K$ = "" THEN 130
140 OPEN "B:MAILLIST.REE" AS #1 LEN=128
150 FIELD #1, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
160 OPEN "A:REORGML.REE" AS #2 LEN=128
170 FIELD #2, 9 AS ZIP2$, 30 AS NAM2$, 30 AS ADD12$, 30 AS ADD22$, 29 AS CITYST2$
180 COLOR 23,0,3
190 PRINT " REORG IN PROGRESS"
200 COLOR 15,9,4
210 PRINT " "
220 RECNUM1=0
225 DONE = 0
230 RECNUM2=0
240 FOR I = 1 TO 1000
241 IF DONE=1 THEN 390
250 RECNUM1 = RECNUM1 + 1
260 IF RECNUM1 > 1000 THEN 390
280 GET #1,RECNUM1
290 ZIP# = CVD(ZIPCODE$)
300 IF ZIP# = 999999999# THEN 250
310 LSET ZIP2$ = MKD$(ZIP#)
320 LSET NAM2$ = NAM$
330 LSET ADD12$ = ADD1$
340 LSET ADD22$ = ADD2$
350 LSET CITYST2$ = CITYST$
360 RECNUM2 = RECNUM2 + 1
370 PUT #2, RECNUM2
380 IF ZIP# = 0# THEN DONE=1
390 NEXT
400 RECNUM1 = 0
410 RECNUM2 = 0
420 FOR RECNUM = 1 TO 1000
430 IF ZIP# = 0# THEN 530
440 GET #2,RECNUM
450 ZIP# = CVD(ZIP2$)
460 IF ZIP# = 0# THEN RECNUM2 = RECNUM + 1
470 LSET ZIPCODE$ = MKD$(ZIP#)
480 LSET NAM$ = NAM2$
490 LSET ADD1$ = ADD12$
500 LSET ADD2$ = ADD22$
510 LSET CITYST$ = CITYST2$
520 PUT #1,RECNUM
530 NEXT
540 A$=MKD$(ZIP#)
541 LSET ZIPCODE$ = A$
542 LSET NAM$ = " "
543 LSET ADD1$ = " "
544 LSET ADD2$ = " "
545 LSET CITYST$= " "
550 FOR RECNUM2 = RECNUM TO 1000
560 PUT #1,RECNUM2
570 NEXT
575 LSET ZIPCODE$="//eof"
580 PUT #1,RECNUM2
590 CLOSE #1
600 CLOSE #2
610 PRINT " "
620 PRINT " REORG COMPLETE"
630 PRINT " "
640 CHAIN "B:MAILMENU"
REVUMEMB.BAS
10 COMMON DRIVEID$, FILEID$, RECNUM2, DRIVEID2$, FILEID2$
20 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
30 FIELD #1, 4 AS EXPDATE$
40 OPEN DRIVEID2$+FILEID2$ AS #2 LEN=128
50 FIELD #2, 9 AS ZIPCODE$, 30 AS NAM$, 30 AS ADD1$, 30 AS ADD2$, 29 AS CITYST$
60 CLS
70 PRINT " "
80 PRINT " Review Membership File"
110 PRINT " "
120 PRINT " "
130 INPUT " Expiration Date ==>";EDTE
140 PRINT " "
150 PRINT " Are records to be deleted "
160 INPUT " ==>";ANS$
170 ANSE$=LEFT$(ANS$,1)
180 IF ANSE$ = "Y" OR ANSE$ = "y" THEN DEL$="Y":GOTO 210
190 IF ANSE$ = "N" OR ANSE$ = "n" THEN DEL$="N":GOTO 210
200 GOTO 150
210 GET #1,1
211 LPRINT " List of Membership Expirations as of ";EDTE
212 LPRINT " (DELETE =";DEL$;")"
213 LPRINT "----------------------------------------------------"
220 MAXREC=CVS(EXPDATE$)
230 RECNUM3=4
240 WHILE RECNUM3<MAXREC
250 RECNUM3 = RECNUM3+1
260 GET #1,RECNUM3
270 EDAT = CVS(EXPDATE$)
280 IF EDAT = 0 THEN 300
290 IF EDAT < EDTE THEN GOSUB 390
300 WEND
310 GOTO 510
320 LPRINT " Member # -";RECNUM3
330 LPRINT " ";NAM$
340 IF ADD1$ <> SPACE$(30) THEN LPRINT " ";ADD1$
350 IF ADD2$ <> SPACE$(30) THEN LPRINT " ";ADD2$
360 LPRINT " ";CITYST$
370 LPRINT " ";CVD(ZIPCODE$)
380 RETURN
390 RECNUM2 = RECNUM3
400 GET #2,RECNUM2
410 GOSUB 320
420 IF DEL$ = "N" THEN 480
430 LSET ZIPCODE$ = MKD$(999999999#)
440 PUT #2,RECNUM2
450 LSET EXPDATE$ = MKS$(0)
460 PUT #1,RECNUM3
470 LPRINT " Record deleted"
480 LPRINT "------------------------------"
490 RETURN
510 CLOSE #1
520 CLOSE #2
530 CHAIN DRIVEID$+"members"
STATMAIL.BAS
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 1
40 OPEN "B:maillist.REE" AS #1 LEN=128
50 FIELD #1,9 AS ZIPCODE$, 30 AS NAM$,30 AS ADD1$,30 AS ADD2$, 29 AS CITYST$
60 ON ERROR GOTO 350
70 CLS
80 PRINT " "
90 PRINT " MAILING LIST STATUS"
100 PRINT " "
110 PRINT " "
120 GET #1, RECNUM
130 NM$ = NAM$
140 A1$ = ADD1$
150 A2$ = ADD2$
160 ZIP# = CVD(ZIPCODE$)
170 ZIP# = ZIP# - 4
180 CTST$ = CITYST$
190 PRINT " "
200 PRINT " CUSTOMER DETAILS"
210 PRINT " "
220 PRINT " " NM$
230 PRINT " " A1$
240 PRINT " " CTST$ " "
250 PRINT " " A2$
260 PRINT " "
270 PRINT " "
280 PRINT " NUMBER OF LABELS==>" ZIP#
290 PRINT " "
300 PRINT " "
310 PRINT " "
320 PRINT " SPACE BAR TO RETURN TO MENU"
330 K$ = INKEY$: IF K$ = "" THEN 330
340 IF K$ = " " THEN 360
350 GOTO 330
360 CLOSE #1
370 CHAIN "B:MAILMENU"
STATMEMB.BAS
10 COMMON DRIVEID$, FILEID$, RECNUM2, DRIVEID2$, FILEID2$
20 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
30 FIELD #1, 4 AS EXPDATE$
60 CLS
70 PRINT " "
80 PRINT " Total Membership Status"
110 PRINT " "
120 PRINT " "
210 GET #1,1
220 MAXREC=CVS(EXPDATE$)
230 PRINT " Total membership ==>";MAXREC-4
240 FOR I = 1 TO 1000
250 NEXT
510 CLOSE #1
530 CHAIN DRIVEID$+"members"
UPDMEMB.BAS
10 COMMON DRIVEID$,FILEID$,RECNUM2,DRIVEID2$,FILEID2$
20 OPEN DRIVEID$+FILEID$ AS #1 LEN=4
30 FIELD #1, 4 AS EXPDATE$
40 CLS
50 PRINT " "
60 PRINT " Ready printer ..."
70 ON ERROR GOTO 900
100 LPRINT " Membership Information"
110 LPRINT " "
120 LPRINT A$
130 IF B$<>=SPACE$(30) THEN LPRINT B$
140 IF C$<>=SPACE$(30) THEN LPRINT C$
150 LPRINT D$;E#
160 LPRINT " Welcome to the Interchange. Your membership number "
170 LPRINT " is ";RECNUM2
180 LPRINT " "
190 LPRINT " Please use this number on all orders and correspondence."
200 LPRINT " "
210 GET #1,1
220 LPRINT " "
230 LSET EXPDATE$=MKS$(RECNUM2)
240 LPRINT " "
310 PUT #1,1
320 LPRINT " "
330 LPRINT " "
340 LPRINT " "
350 LPRINT " "
360 LPRINT " "
370 LPRINT " "
380 LPRINT " "
390 LPRINT " "
400 CLOSE #1
410 CHAIN DRIVEID$+"members"
900 RESUME
Directory of PC-SIG Library Disk #0169
Volume in drive A has no label
Directory of A:\
ADDMAIL BAS 1024 3-25-82
ADDMEMB BAS 512 3-30-82
BROWMAIL BAS 1152 2-15-82
BUILDML BAS 1664 3-18-82
BUILMEMB BAS 896 3-30-82
CHGMAIL BAS 2304 3-27-82
CRC TXT 2016 11-15-84 6:34a
CRCK4 COM 1536 10-21-82 7:54p
DELMAIL BAS 1408 3-03-82
DISPMAIL BAS 512 2-15-82
DISPMEMB BAS 1664 3-30-82
EASYMAIL ASC 2176 7-20-82 9:29p
EASYMAIL BAS 1408 2-15-82
LABMAIL BAS 896 3-05-82
LABPRINT BAS 4480 4-03-82
LABSELEC BAS 2432 3-17-82
LISTMAIL BAS 2176 3-27-82
LOCMAIL BAS 1280 3-03-82
MAILIST1 BAS 40832 12-03-83 7:13a
MAILIST1 DOC 26752 12-03-83 7:23a
MAILLIST BAS 7936 7-27-82
MAILMEMB BAS 1024 3-30-82
MAILMENU BAS 1408 2-15-82
MAILSORT BAS 2688 12-03-83 7:14a
MEMBER ASC 1664 5-08-84 4:32p
MEMBERS BAS 896 3-30-82
RENUMEMB BAS 2048 3-31-82
REORMAIL BAS 1536 2-15-82
REVUMEMB BAS 1408 3-31-82
STATMAIL BAS 768 2-15-82
STATMEMB BAS 384 3-31-82
UPDMEMB BAS 768 3-30-82
XXX 1152 5-20-84 8:27p
33 file(s) 120800 bytes
33280 bytes free