home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / easymail.lzh / MAILIST1.BAS < prev    next >
Encoding:
BASIC Source File  |  1983-12-03  |  39.9 KB  |  743 lines
  1. 10 '(C) Copyright M. Berry and W. Dwinell 1982, 1983
  2. 99 '------------------------------INITILIZE------------------------------------
  3. 100 'KEY OFF:FOR L=1 TO 10:KEY L,"":NEXT L
  4. 101 LOCATE ,,0:KEY OFF:GOSUB 20000:CR$=CHR$(13):ESC$=CHR$(27)
  5. 102 CLS:ON ERROR GOTO 10000
  6. 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$=""
  7. 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"
  8. 105 IF IP$="Y" THEN 7020 ELSE LOCATE 23,1:PRINT STRING$(68," "):GOTO 103
  9. 106 '
  10. 108 RAN$="B:"+RAN$
  11. 110 FOR L=1 TO 10:KEY L,"":NEXT
  12. 120 WIDTH 80
  13. 125 C$=SPACE$(15):S$=SPACE$(2):Z$=SPACE$(5):PH$=SPACE$(12):ST$=SPACE$(20):N1$=SPACE$(10):N2$=SPACE$(15)
  14. 127 COMMON N,RAN$,IN$,NBR$,S,CR$,ESC$
  15. 140 N=0:DIM I$(1000):DIM I1$(1000):DEFINT A-Z'         MAXIUM NBR OF RECORDS
  16. 160 ON ERROR GOTO 10000
  17. 280 IN$=RAN$+".IDX"
  18. 285 NBR$=RAN$+".CTR"
  19. 300 OPEN "i",#3,NBR$
  20. 360 INPUT #3,N
  21. 365 CLOSE 3
  22. 410 OPEN "R",#2,RAN$,79
  23. 420 FIELD 2, 15 AS CF$, 2 AS SF$, 5 AS ZF$, 12 AS PHF$, 20 AS STF$, 10 AS N1F$, 15 AS N2F$
  24. 500 ' ------------------------ MAIN MENU ROUTINE ------------------------------
  25. 520 CLS:I=0:MN=0:KEY 9,")":GOSUB 11300
  26. 540 LOCATE 5,22:COLOR 15,0:PRINT"THE FOLLOWING OPTIONS ARE AVAILABLE":COLOR 7,0
  27. 560 LOCATE 8,32:PRINT"1. Add to file"
  28. 580 LOCATE 9,32:PRINT"2. Sort file"
  29. 600 LOCATE 10,32:PRINT"3. Display file"
  30. 620 LOCATE 11,32:PRINT"4. Correct file"
  31. 640 LOCATE 12,32:PRINT"5. Print file"
  32. 660 LOCATE 13,32:PRINT"6. Delete record"
  33. 665 LOCATE 14,32:PRINT"7. Display last record number"
  34. 670 LOCATE 15,32:PRINT"8. Automatic phone dialer"
  35. 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
  36. 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
  37. 683 IF VAL(I$)=0 THEN GOTO 700
  38. 684 I=VAL(I$)
  39. 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
  40. 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
  41. 720 ON I GOTO 1010,2010,3020,4020,5020,6020,0,12010
  42. 1000 ' --------------------------ADD TO FILE ROUTINE --------------------------
  43. 1010 CLS:LOCATE 1,30:PRINT"RECORD NUMBER ";:GOSUB 11010
  44. 1020 F=0:IF N=0 THEN N=1 ELSE N=N+1
  45. 1040 LOCATE 1,43:PRINT N:GOSUB 11200
  46. 1060 MID$(N1$,1)=SPACE$(10)'  first name
  47. 1080 GOSUB 11400:GOTO 1840
  48. 1282 IF F=1 THEN 1840:' CHECK FOR ERROR CORR
  49. 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$
  50. 1860 IF I$="Y" OR I$="y" THEN 1987
  51. 1880 IF I$="N" OR I$="n" THEN LOCATE 23,1:PRINT STRING$(40,32):GOSUB 11400:GOTO 1840
  52. 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
  53. 1987 IF LEN(N2$)<15 THEN N2$=N2$+" ":GOTO 1987
  54. 1989 IF F1=2 GOTO 4242 ELSE IF F1=3 GOTO 4425 ELSE I$=Z$+N2$+STR$(N):GOSUB 10200
  55. 1990 OPEN IN$ FOR APPEND AS 1:PRINT#1,I$:CLOSE 1:OPEN "O",3,NBR$:PRINT#3,N:CLOSE 3
  56. 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
  57. 1993 IF I$="N" OR I$="n" THEN GOTO 520
  58. 1994 BEEP:LOCATE 23,1:PRINT STRING$(70,32);:LOCATE 23,1:PRINT"You must answer yes or no. Please reenter";:GOTO 1991
  59. 2000 ' ----------------------- SORT ROUTINE ---------------------------------
  60. 2010 CLOSE 2:COLOR 15,0:LOCATE 19,22:PRINT"Loading Sort program.............":CHAIN "MAILSORT.BAS"
  61. 3000 ' --------------------- DISPLAY FILE -------------------------
  62. 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
  63. 3040 LOCATE 8,32:PRINT"1. By record number"
  64. 3060 LOCATE 9,32:PRINT"2. By name"
  65. 3080 LOCATE 10,32:PRINT"3. All"
  66. 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$)
  67. 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
  68. 3140 ON I GOTO 3420,3160,3600,520
  69. 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$
  70. 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
  71. 3172 IF IP$="Y" OR IP$="y" THEN 3020 ELSE IF IP$=ESC$ THEN 3020 ELSE LOCATE 23,1:PRINT STRING$(68," "):GOTO 3160
  72. 3180 F$=I$
  73. 3200 OPEN "I",#1,IN$
  74. 3204 IF EOF(1) THEN 3380
  75. 3205 INPUT #1,I$
  76. 3220 I=LEN(I$):I=I-20:IF MID$(I$,6,LEN(F$))<>F$ THEN 3204 ELSE I = VAL(RIGHT$(I$,I))
  77. 3240 C1=1:GET 2,I
  78. 3260 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  79. 3280 GOSUB 11010:GOSUB 10500:GOSUB 10600
  80. 3320 LOCATE 23,1:PRINT"Type S to return to menu or any other key to continue search";
  81. 3340 I$=INKEY$:IF I$="" THEN 3340
  82. 3360 LOCATE 23,1:PRINT STRING$(75,32);:IF LEFT$(I$,1)="S" OR LEFT$(I$,1)="s" THEN 3380
  83. 3370 GOTO 3204
  84. 3380 CLOSE 1
  85. 3381 IF C1=1 THEN 3400
  86. 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";
  87. 3384 I$=INKEY$:IF I$="" THEN 3384
  88. 3400 GOTO 3020
  89. 3420 CLS:GOSUB 11150
  90. 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
  91. 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$)
  92. 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
  93. 3424 IF I=0 THEN 3020
  94. 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
  95. 3440 GET 2,I
  96. 3460 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  97. 3480 GOSUB 11010:GOSUB 10500:GOSUB 10600
  98. 3500 LOCATE 23,1:PRINT"Press any key to continue"
  99. 3520 I$=INKEY$:IF I$="" THEN 3520 ELSE LOCATE 23,1:PRINT STRING$(75,32);
  100. 3540 GOTO 3020
  101. 3600 CLS:LOCATE 1,30:PRINT "RECORD NUMBER ";:GOSUB 11010:IF S=1 THEN OPEN "I",#1,SRT$:GOTO 3606
  102. 3605 FOR L=1 TO N
  103. 3606 IF S=1 THEN IF EOF(1) GOTO 3840
  104. 3607 IF S=1 THEN INPUT #1,I:GOTO 3640
  105. 3620 I=L
  106. 3640 GET 2,I
  107. 3660 LOCATE 1,44:PRINT USING "####";I
  108. 3680 GOSUB 10500:GOSUB 10600
  109. 3700 FOR T=1 TO 15
  110. 3720 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"F10 ";:COLOR O,7:PRINT" TO HOLD DISPLAY ";:COLOR 7,0
  111. 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
  112. 3745 IF I$=ESC$ THEN IF S=1 GOTO 3860 ELSE T=15:L=N
  113. 3780 NEXT T
  114. 3785 IF S=1 THEN 3606
  115. 3800 NEXT L
  116. 3820 IF I$=ESC$ THEN 3860
  117. 3840 LOCATE 23,20:BEEP:PRINT"End of file. Type any key to return";:IPC=1:PT=O:OF=0:GOSUB 15150
  118. 3860 CLOSE 1:I1$="":GOTO 3020
  119. 4000 ' --------------------------- CORRECTION ROUTINE -------------------------
  120. 4020 I=0:MN=4:F1=2:C1=0:X=0
  121. 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"
  122. 4060 LOCATE 9,30:PRINT"2. By name"
  123. 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$)
  124. 4085 'IF I$=ESC$ THEN GOTO 4560
  125. 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
  126. 4120 IF I = 2 GOTO 4280
  127. 4140 CLS:GOSUB 11150
  128. 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
  129. 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$)
  130. 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
  131. 4200 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I1
  132. 4220 GET 2,I1
  133. 4240 GOSUB 11010:GOSUB 10500:GOSUB 10600:GOTO 1080
  134. 4242 OPEN "I",1,IN$
  135. 4245 FOR L=1 TO N
  136. 4247 INPUT #1,I1$
  137. 4249 I2=LEN(I1$):I2=I2-20:IF VAL(RIGHT$(I1$,I2))=I1 THEN I$(L)=Z$+N2$+STR$(I1) ELSE I$(L)=I1$
  138. 4251 NEXT L
  139. 4253 CLOSE 1
  140. 4255 GOSUB 10400:GOSUB 10200
  141. 4260 GOTO 4040
  142. 4280 CLS:F1=3:GOSUB 11150
  143. 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
  144. 4320 F$=I$
  145. 4340 OPEN "i",1,IN$:OPEN "B:TEMP" FOR APPEND AS 3
  146. 4342 FOR L2= 1 TO N
  147. 4344 INPUT#1,I$:Q=Q+1
  148. 4360 I1=LEN(I$):I1=I1-20:IF MID$(I$,6,LEN(F$))<>F$ THEN I$(Q)=I$:GOTO 4427
  149. 4365 I1=VAL(RIGHT$(I$,I1))
  150. 4380 C1=1:GET 2,I1
  151. 4400 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I1
  152. 4420 GOSUB 11010:GOSUB 10500:GOSUB 10600:GOTO 1080
  153. 4425 I$(Q)=Z$+N2$+STR$(I1):GOSUB 10200
  154. 4427 IF Q=100 THEN GOSUB 4600
  155. 4440 NEXT L2
  156. 4445 CLOSE 1
  157. 4447 GOSUB 4600:CLOSE 3
  158. 4460 IF C1=1 THEN 4500
  159. 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
  160. 4500 LOCATE 23,1:BEEP:PRINT"End of records for ";:COLOR 0,7:PRINT" "F$" ";:COLOR 7,0:PRINT". Type any key to continue";
  161. 4520 I$=INKEY$:IF I$="" THEN 4520 ELSE IF C1=0 THEN 4040
  162. 4540 KILL IN$:GOSUB 4700:GOTO 4040
  163. 4560 F1=0:GOTO 520
  164. 4600 FOR L1=1 TO Q
  165. 4620 PRINT#3,I$(L1)
  166. 4640 NEXT L1
  167. 4660 Q=0:RETURN
  168. 4700 Q=0:OPEN "I",3,"TEMP"
  169. 4720 OPEN IN$ FOR APPEND AS 1
  170. 4740 FOR L=1 TO N
  171. 4760 Q=Q+1
  172. 4780 INPUT#3,I1$(Q)
  173. 4800 IF Q=100 THEN GOSUB 4900
  174. 4820 NEXT L
  175. 4840 GOSUB 4900:CLOSE 1,3:KILL "TEMP":RETURN
  176. 4900 FOR L1=1 TO Q
  177. 4920 PRINT#1,I1$(L1)
  178. 4940 NEXT L1
  179. 4960 Q=0:RETURN
  180. 5000 '---------------------PRINTER ROUTINE --------------------------------
  181. 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
  182. 5025 LOCATE 8,31:PRINT"1 By record number"
  183. 5030 LOCATE 9,31:PRINT"2 By name"
  184. 5035 LOCATE 10,31:PRINT"3 All"
  185. 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$)
  186. 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
  187. 5060 ON I GOTO 5065,5140,5520
  188. 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$
  189. 5067 IF I$="" THEN 5020
  190. 5070 F$=I$
  191. 5073 OPEN "I",#1,IN$
  192. 5075 IF EOF(1) THEN 5115
  193. 5077 INPUT#1,I$
  194. 5080 I=LEN(I$):I=I-20:IF MID$(I$,6,LEN(F$))<>F$ THEN 5075 ELSE I = VAL(RIGHT$(I$,I))
  195. 5085 C1=1:GET 2,I
  196. 5090 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  197. 5095 GOSUB 5495
  198. 5100 LOCATE 23,1:PRINT"Type S to return to menu or any other key to continue search";
  199. 5105 I$=INKEY$:IF I$="" THEN 5105
  200. 5110 LOCATE 23,1:PRINT STRING$(75,32);:IF LEFT$(I$,1)="S" OR LEFT$(I$,1)="s" THEN CLOSE 1:GOTO 5020
  201. 5113 GOTO 5075
  202. 5115 CLOSE 1
  203. 5120 IF C1=1 THEN 5135
  204. 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";
  205. 5130 I$=INKEY$:IF I$="" THEN 5130
  206. 5135 GOTO 5020
  207. 5140 CLS:GOSUB 11150
  208. 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$)
  209. 5142 IF I=0 THEN 5020
  210. 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
  211. 5150 'IF N=0 THEN BEEP:LOCATE 22,1:INPUT"THERE ARE NO RECORDS IN THIS FILE. PRESS ENTER TO CONTINUE",I$:GOTO 520
  212. 5155 GET 2,I
  213. 5160 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  214. 5165 GOSUB 5495:GOSUB 10500
  215. 5170 LOCATE 23,1:PRINT"Type any key to continue";
  216. 5175 I$=INKEY$:IF I$="" THEN 5175 ELSE LOCATE 23,1:PRINT STRING$(75,32);
  217. 5180 GOTO 5020
  218. 5280 '----------------------- PRINT 3-WIDE LABELS------------------------------
  219. 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$
  220. 5287 IF S=1 THEN INPUT#1,I ELSE INPUT#1,I$
  221. 5290 P = P+1
  222. 5295 IF S<>1 THEN I=LEN(I$):I=I-20:I=VAL(RIGHT$(I$,I))
  223. 5300 GET 2,I
  224. 5305 MID$(P$(P),1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
  225. 5310 IF EOF(1) THEN IF P <2 THEN P$(2)="":P$(3)="":GOTO 5325
  226. 5315 IF EOF(1) THEN IF P <3 THEN P$(3)="":GOTO 5325
  227. 5320 IF P <> 3 GOTO 5465         'MUST GET 3 RECORDS BEFORE PRINTING
  228. 5325  FOR L1=1 TO 3
  229. 5330 MID$(A$,1)=MID$(P$(L1),11,15)       'DUMMY FOR LAST NAMES IF NOT THREE
  230. 5335 IF P$(L1)="" THEN 5355
  231. 5340  LPRINT MID$(P$(L1),1,INSTR(P$(L1),"\")-1);" ";MID$(A$,1,INSTR(A$,"\")-1); 'FIRST AND LAST NAMES --PHONE NOT USED
  232. 5345 IF L1 = 1 THEN LPRINT TAB(TAB1);
  233. 5350 IF L1 = 2 THEN LPRINT TAB(TAB2);
  234. 5355 NEXT L1
  235. 5360 LPRINT
  236. 5365 FOR L1=1 TO 3
  237. 5370 IF P$(L1)="" THEN 5390
  238. 5375 LPRINT MID$(P$(L1),38,20);  'STREET ADDRESS
  239. 5380 IF L1 = 1 THEN LPRINT TAB(TAB1);
  240. 5385 IF L1 = 2 THEN LPRINT TAB(TAB2);
  241. 5390 NEXT L1
  242. 5395 LPRINT
  243. 5400 FOR L1 = 1 TO 3
  244. 5405 IF P$(L1)="" THEN 5430
  245. 5410 MID$(A1$,1)=MID$(P$(L1),58,15)
  246. 5415 LPRINT MID$(A1$,1,INSTR(A1$,"\")-1);", ";RIGHT$(P$(L1),8); 'CITY,STATE,ZIP
  247. 5420 IF L1 = 1 THEN LPRINT TAB(TAB1);
  248. 5425 IF L1 = 2 THEN LPRINT TAB(TAB2);
  249. 5430 NEXT L1
  250. 5435 FOR BLINES=0 TO SPACES:IF SPACES =0 THEN 5437 ELSE LPRINT
  251. 5437 NEXT
  252. 5440 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
  253. 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
  254. 5450 IF I1$ = ESC$ THEN GOSUB 5960:GOTO 5470
  255. 5460 P=0:I1$=""
  256. 5465 IF EOF(1)=0 THEN 5287
  257. 5470 GOSUB 5960:CLOSE 1:CLS:GOTO 5520
  258. 5490 GET 2,I
  259. 5495 LPRINT MID$(N1F$,1,INSTR(N1F$,"\")-1);" ";MID$(N2F$,1,INSTR(N2F$,"\")-1)
  260. 5500 LPRINT STF$
  261. 5505 LPRINT MID$(CF$,1,INSTR(CF$,"\")-1);", ";SF$;" ";ZF$
  262. 5507 IF SPACES=<0 THEN 5515
  263. 5510 FOR BLINES=1 TO SPACES:LPRINT
  264. 5512 NEXT
  265. 5515 RETURN
  266. 5520 I=0:MN=7:CLS:GOSUB 11300:COLOR 15,0:LOCATE 5,23:PRINT "THE FOLLOWING OPTIONS ARE AVAILABLE":COLOR 7,0
  267. 5525 LOCATE 8,31:PRINT "1 Listing"
  268. 5530 LOCATE 9,31:PRINT "2 Labels - 1 Wide"
  269. 5535 LOCATE 10,31:PRINT "3 Labels - 2 Wide"
  270. 5540 LOCATE 11,31:PRINT "4 Labels - 3 Wide"
  271. 5550 LOCATE 19,23:PRINT"Type the number of your choice:":GOSUB 11100
  272. 5552 IF I$=ESC$ THEN 5020
  273. 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
  274. 5560 ON I GOTO 5562,5655,5680,5285
  275. 5561 '---------------------- LISTING - SUBROUTINE -----------------------------
  276. 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$
  277. 5563 LPRINT :LPRINT CHR$(14);TITLE$;:LPRINT CHR$(20);'TAB(50)DATE$
  278. 5565 CLS:LOCATE 10,35:PRINT"PRINTING"
  279. 5570 LPRINT CHR$(15):WIDTH "LPT1:",132:LPRINT CHR$(27);"0"
  280. 5575 LPRINT TAB(100) DATE$ :LPRINT :LPRINT
  281. 5580 LPRINT "       NAME";TAB(38)"PHONE";TAB(59)"STREET";TAB(80);"CITY";TAB(95) "ST   ZIP"
  282. 5585 LPRINT STRING$(103,208):LPRINT
  283. 5587 IF S=1 THEN OPEN "i",1,SRT$:GOTO 5592
  284. 5590 FOR L= 1 TO N
  285. 5592 IF S=1 THEN IF EOF(1) GOTO 5645
  286. 5595 IF S=1 THEN INPUT#1,I:GOTO 5610
  287. 5605 I=L
  288. 5610 GET 2,I
  289. 5615 MID$(P$,1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
  290. 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)
  291. 5625 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" to hold printing ";:COLOR 7,0
  292. 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
  293. 5635 IF I$=ESC$ THEN IF S=1 GOTO 5645 ELSE L=N
  294. 5637 IF S=1 THEN 5592
  295. 5640 NEXT:LPRINT :LPRINT
  296. 5645 LPRINT CHR$(146):WIDTH "LPT1:",80:LPRINT CHR$(27);"2"
  297. 5650 CLOSE 1:GOTO 5520
  298. 5655 GOSUB 5905:CLS:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$
  299. 5656 IF S=1 THEN IF EOF(1) GOTO 5670 ELSE INPUT#1,I:GOTO 5660
  300. 5657 FOR L=1 TO N
  301. 5659 I=L
  302. 5660 GOSUB 5490
  303. 5662 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
  304. 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
  305. 5664 IF I$=ESC$ THEN IF S=1 GOTO 5670 ELSE L=N
  306. 5665 IF S=1 GOTO 5656
  307. 5667 NEXT
  308. 5670 CLS:CLOSE 1:GOTO 5520
  309. 5675 '--------------------- 2-WIDE LABELS -------------------------------
  310. 5680 GOSUB 5900
  311. 5681 CLS:P=0:LOCATE 10,35:PRINT"PRINTING":IF S=1 THEN OPEN "I",1,SRT$ ELSE OPEN "I",1,IN$
  312. 5682 IF S=1 THEN INPUT#1,I ELSE INPUT#1,I$
  313. 5685 P = P+1
  314. 5690 IF S<>1 THEN I=LEN(I$):I=I-20:I=VAL(RIGHT$(I$,I))
  315. 5695 GET 2,I
  316. 5700 MID$(P$(P),1)=N1F$+N2F$+PHF$+STF$+CF$+SF$+" "+ZF$
  317. 5705 IF EOF(1) THEN IF P <2 THEN P$(2)="":GOTO 5715
  318. 5710 IF P <> 2 GOTO 5855         'MUST GET 2 RECORDS BEFORE PRINTING
  319. 5715  FOR L1=1 TO 2
  320. 5720 MID$(A$,1)=MID$(P$(L1),11,15)       'DUMMY FOR LAST NAMES IF NOT THREE
  321. 5725 IF P$(L1)="" THEN 5745
  322. 5730  LPRINT MID$(P$(L1),1,INSTR(P$(L1),"\")-1);" ";MID$(A$,1,INSTR(A$,"\")-1); 'FIRST AND LAST NAMES --PHONE NOT USED
  323. 5735 IF L1 = 1 THEN LPRINT TAB(TAB1);
  324. 5740 IF L1 = 2 THEN LPRINT TAB(TAB2);
  325. 5745 NEXT L1
  326. 5750 'LPRINT
  327. 5755 FOR L1=1 TO 2
  328. 5760 IF P$(L1)="" THEN 5780
  329. 5765 LPRINT MID$(P$(L1),38,20);  'STREET ADDRESS
  330. 5770 IF L1 = 1 THEN LPRINT TAB(TAB1);
  331. 5775 IF L1 = 2 THEN LPRINT TAB(TAB2);
  332. 5780 NEXT L1
  333. 5785 'LPRINT
  334. 5790 FOR L1 = 1 TO 2
  335. 5795 IF P$(L1)="" THEN 5820
  336. 5800 MID$(A1$,1)=MID$(P$(L1),58,15)
  337. 5805 LPRINT MID$(A1$,1,INSTR(A1$,"\")-1);", ";RIGHT$(P$(L1),8); 'CITY,STATE,ZIP
  338. 5810 IF L1 = 1 THEN LPRINT TAB(TAB1);
  339. 5815 IF L1 = 2 THEN LPRINT TAB(TAB2);
  340. 5820 NEXT L1
  341. 5825 FOR BLINES=1 TO SPACES:IF SPACES =0 THEN 5827 ELSE LPRINT
  342. 5827 NEXT
  343. 5830 GOSUB 11150:LOCATE 25,59:COLOR 15,0:PRINT"10 ";:COLOR 0,7:PRINT" TO HOLD PRINTING ";:COLOR 7,0
  344. 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
  345. 5840 IF I1$ = ESC$ THEN GOSUB 5960 :GOTO 5470
  346. 5850 P=0:I1$=""
  347. 5855 IF EOF(1) = 0 THEN 5682
  348. 5860 CLOSE 1:CLS:GOTO 5520
  349. 5899 '-----------------------SET TABS SUBROUTINE -----------------------------
  350. 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$)
  351. 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
  352. 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$)
  353. 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$)
  354. 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
  355. 5950 LPRINT CHR$(15);:WIDTH "LPT1:",132:RETURN
  356. 5960 LPRINT CHR$(146):WIDTH "LPT1:",80:RETURN
  357. 6000 ' ---------------------- DELETE ROUTINE ---------------------------------
  358. 6020 I=0:MN=6:KEY 9,"":KEY 10,"":CLS:GOSUB 11300
  359. 6040 LOCATE 5,30:COLOR 15,0:PRINT"DO YOU WANT TO DELETE":COLOR 7,0
  360. 6060 LOCATE 8,32:PRINT"1 By record number"
  361. 6080 LOCATE 9,32:PRINT"2 By last name"
  362. 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$)
  363. 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
  364. 6140 IF I=1 THEN 6155 ELSE IF I=2 THEN 6440
  365. 6145 OPEN "O",3,NBR$:PRINT#3,N:CLOSE 3:IF S=1 THEN S=0:KILL SRT$ ELSE GOTO 520
  366. 6155 CLS:GOSUB 11150
  367. 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$)
  368. 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
  369. 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
  370. 6190 IF I=0 THEN GOTO 6020
  371. 6200 GET 2,I
  372. 6300 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  373. 6320 GOSUB 11010:GOSUB 10500:GOSUB 10600
  374. 6325 GOSUB 11150
  375. 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$
  376. 6360 IF I$="N" OR I$="n" THEN 6020 ELSE IF I$="Y" OR I$="y" THEN 6420
  377. 6400 LOCATE 23,1:BEEP:PRINT"You must enter yes or no. Please reenter":GOTO 6340
  378. 6420 GOSUB 6760:N=N-1:GOTO 6020
  379. 6440 CLS:C1=0:GOSUB 11150
  380. 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$
  381. 6480 F$=I$
  382. 6485 OPEN "I",1,IN$
  383. 6505 IF EOF(1) THEN GOTO 6682 ELSE INPUT#1,IP$
  384. 6520 I=LEN(IP$):I=I-20:IF MID$(IP$,6,LEN(F$))<>F$ THEN 6680 ELSE I=VAL(RIGHT$(IP$,I))
  385. 6540 GET 2,I
  386. 6560 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  387. 6580 GOSUB 11010:GOSUB 10500:GOSUB 10600
  388. 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$
  389. 6640 IF I1$="Y" OR I1$="y" THEN 6700 ELSE IF I1$="N" OR I1$="n" THEN 6680
  390. 6660 LOCATE 23,1:BEEP:PRINT"You must enter yes or no. Please reenter":GOTO 6600
  391. 6680 GOTO 6505
  392. 6682 CLOSE 1:GOTO 6020
  393. 6700 CLOSE 1:GOSUB 6760:N=N-1:GOTO 6020
  394. 6750 ' -------------- ACTUAL DELETE ROUTINE ------------
  395. 6760 OPEN "i",1,IN$
  396. 6800 FOR L1=1 TO N
  397. 6820 INPUT#1,I1$
  398. 6840 IF L1<I GOTO 6920
  399. 6860 GET 2,L1+1
  400. 6880 PUT 2,L1
  401. 6900 IF L1=I GOTO 6940
  402. 6905 I2$=LEFT$(I1$,20)
  403. 6910 I1$=I2$+STR$(L1-1)
  404. 6920 IF L1<I THEN I$(L1)=I1$ ELSE IF L1>I THEN I$(L1-1)=I1$
  405. 6940 NEXT L1
  406. 6960 CLOSE 1
  407. 6968 OPEN "O",1,IN$
  408. 6972 FOR L1=1 TO N-1
  409. 6980 PRINT#1,I$(L1)
  410. 6984 NEXT L1
  411. 6988 CLOSE 1,3
  412. 6992 RETURN
  413. 7020 CLS:CLOSE:IF S=1 THEN KILL SRT$
  414. 7021 SYSTEM
  415. 8000 ' -------------------------DUP ROUTINE ----------------------------------
  416. 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
  417. 8022 IF N=1 THEN RETURN
  418. 8024 C3=0:C2=0
  419. 8030 OPEN "i",#1,IN$
  420. 8034 IF EOF(1) THEN CLOSE 1:GOTO 8262
  421. 8036 INPUT#1,I$
  422. 8040 IF N21$<>MID$(I$,6,15) THEN 8034
  423. 8060 I=VAL(RIGHT$(I$,LEN(I$)-20))
  424. 8080 GET 2,I
  425. 8100 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "I
  426. 8120 GOSUB 11010:GOSUB 10500:GOSUB 10600
  427. 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)
  428. 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$
  429. 8180 IF I$="Y" OR I$="y" THEN C2=1:GOTO 8262
  430. 8200 IF I$="N" OR I$="n" THEN C3=1:GOTO 8240
  431. 8220 LOCATE 23,1:BEEP:PRINT"YOU MUST ANSWER YES OR NO. PLEASE REENTER":FOR T=1 TO 1000:NEXT T:GOTO 8160
  432. 8240 LOCATE 20,1:PRINT STRING$(50,32):LOCATE 22,1:PRINT STRING$(50,32):LOCATE 23,1:PRINT STRING$(50,32)
  433. 8260 GOTO 8034
  434. 8262 IF C2=1 THEN N=N-1:GOTO 8280
  435. 8263 IF C3=0 THEN RETURN
  436. 8265 IF C2=0 THEN N1$=N11$:N2$=N21$:PH$=P1H$:ST$=S1T$:C$=C1$:S$=S1$:Z$=Z1$
  437. 8266 IF F=1 THEN GOTO 8280
  438. 8267 CLS:LOCATE 1,30:PRINT"RECORD NUMBER "N
  439. 8269 GOSUB 11010:GOSUB 10600
  440. 8280 CLOSE 1:RETURN
  441. 9999 '-----------------------ERROR TRAPS AND SUBROUTINES----------------------
  442. 10000 IF ERR = 53 THEN GOTO 10150 ELSE IF ERR = 67 GOTO 10181
  443. 10002 IF ERR=25 THEN CLS:LOCATE 12,10:PRINT "MAKE PRINTER READY THEN HIT ANY KEY TO RESUME":GOTO 10004
  444. 10003 GOTO 10006
  445. 10004 EE$=INKEY$:IF EE$="" THEN 10004 ELSE CLS:LOCATE 10,35:PRINT"PRINTING":RESUME
  446. 10006 IF ERR=27 THEN CLS:LOCATE 12,10:PRINT "REPLACE PAPER IN PRINTER THEN HIT ANY KEY TO RESUME":GOTO 10008
  447. 10007 GOTO 10010
  448. 10008 EE$=INKEY$:IF EE$="" THEN 10008 ELSE RESUME
  449. 10010 IF ERR=61 THEN CLS ELSE GOTO 10020
  450. 10012 LOCATE 11,30:PRINT"DATA DISK IS FULL."
  451. 10014 LOCATE 12,30:PRINT"LAST ENTRY MAY NOT"
  452. 10016 LOCATE 13,30:PRINT"HAVE BEEN ADDED."
  453. 10017 LOCATE 14,30:INPUT"PRESS ENTER TO RESUME.",I$:RESUME 520
  454. 10020 IF ERR = 71 THEN CLS ELSE GOTO 10120
  455. 10025 ER=1:LOCATE 10,30:PRINT"DISK DRIVE NOT READY"
  456. 10040 LOCATE 11,30:PRINT"PLEASE INSERT DATA DISK"
  457. 10060 LOCATE 12,30:PRINT"OR CLOSE DRIVE DOOR":BEEP
  458. 10080 LOCATE 13,30:INPUT"PRESS ENTER TO RESUME",I$:IF MN=3 THEN CLS:LOCATE 1,30:PRINT"RECORD NUMBER":GOSUB 11010
  459. 10100 RESUME
  460. 10120 ON ERROR GOTO 0
  461. 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
  462. 10160 IF I$="Y" OR I$="y" THEN RESUME 410
  463. 10170 LOCATE 15,20:COLOR 0,7:PRINT "THE CURRENT FILES ON DISK B ARE:":LOCATE 17,1:COLOR 7,0:FILES "B:*.*"
  464. 10172 LOCATE 25,20:COLOR 0,7:PRINT "** PRESS ANY KEY TO CONTINUE **";:COLOR 7,0
  465. 10175 A$=INKEY$:IF A$="" THEN 10175
  466. 10180 CLOSE:ERASE I$:ERASE I1$:RESUME 103
  467. 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."
  468. 10182 LOCATE 23,10:PRINT"Please press any key to return to file selection."
  469. 10183 I$=INKEY$:IF I$="" THEN 10183 ELSE CLS:RESUME 103
  470. 10199 ' ---------------------- WRITE R-A FILE TO DISK -----------------
  471. 10200 LSET CF$=C$
  472. 10220 LSET SF$=S$
  473. 10240 LSET ZF$=Z$
  474. 10260 LSET PHF$=PH$
  475. 10280 LSET STF$=ST$
  476. 10300 LSET N1F$=N1$
  477. 10320 LSET N2F$=N2$
  478. 10340 IF F1 = 2 OR F1=3 THEN PUT 2,I1 ELSE PUT #2,N
  479. 10360 RETURN
  480. 10399 ' --------------------------WRITE INDEX FILE TO DISK --------------------
  481. 10400 OPEN "O",#1,IN$
  482. 10420 FOR L=1 TO N:PRINT#1,I$(L):NEXT L
  483. 10440 CLOSE #1:RETURN
  484. 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
  485. 10520 RETURN
  486. 10599 ' ------------------------ PRINT FIELD VALUES -------------------------
  487. 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:
  488. 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$
  489. 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" "
  490. 10620 COLOR 7,0:RETURN
  491. 11000 ' ----------------------- MAIN DISPLAY ROUTINE --------------------------
  492. 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
  493. 11100 LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0
  494. 11120 I$=INKEY$:IF I$="" THEN 11120
  495. 11140 IF VAL(I$)=0 THEN RETURN ELSE I=VAL(I$):RETURN
  496. 11150 LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0:RETURN
  497. 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
  498. 11300 LOCATE 1,34:COLOR 0,7:PRINT" MAILIST1 ":COLOR 7,0:RETURN
  499. 11400 GOSUB 11150:COUNT=0:LOCATE 3,13,1
  500. 11405 I$=INKEY$:IF I$="" THEN 11405
  501. 11410 IF I$=CHR$(9) THEN GOSUB 11510:GOTO 11405 'tab key
  502. 11415 IF LEN(I$)= 2 AND RIGHT$(I$,1)=CHR$(15) THEN GOSUB 11700:GOTO 11405 'back
  503. 11417 IF LEN(I$)=2 AND RIGHT$(I$,1)=>CHR$(16) THEN 11405
  504. 11420 IF I$=CHR$(27) THEN IF MN=4 THEN 4020 ELSE N=N-1:GOTO 520 'Escape to menu
  505. 11430 IF I$=CHR$(13) THEN 13010 'Go check input?
  506. 11435 X=CSRLIN:Y=POS(0):Y=Y-1
  507. 11440 IF I$=CHR$(8) THEN GOSUB 11810:GOTO 11405 'backspace key
  508. 11450 COUNT=COUNT+1:PRINT I$;:GOSUB 13500':PRINT I$;
  509. 11460 GOTO 11405
  510. 11500 '------------------DETERMINE FIELD AND TAB-------------------------
  511. 11510 IF CSRLIN = 3 THEN 11570
  512. 11520 IF CSRLIN = 5 THEN LOCATE 7,7:COUNT=43:RETURN
  513. 11530 IF CSRLIN = 7 THEN 11590
  514. 11540 IF CSRLIN = 9 THEN 11550
  515. 11550 IF POS(0)=>7 AND POS(0)<19 THEN LOCATE 3,13:COUNT=0:RETURN
  516. 11560 LOCATE 3,13:RETURN
  517. 11570 IF POS(0)=>13 AND POS(0) <23 THEN LOCATE 3,41:COUNT=9:RETURN
  518. 11572 IF POS(0)=>41 AND POS(0)<56 THEN LOCATE 5,17:COUNT=23:RETURN
  519. 11580 LOCATE 3,13:COUNT=0:RETURN
  520. 11590 IF POS(0)=>7 AND POS(0) <22 THEN LOCATE 7,37:COUNT=57:RETURN
  521. 11592 IF POS(0)=>37 AND POS(0)<40 THEN LOCATE 7,55:COUNT=59:RETURN
  522. 11594 IF POS(0)=>55 AND POS(0) <60 THEN LOCATE 9,7:COUNT=64:RETURN
  523. 11600 LOCATE 3,13:COUNT=0:RETURN
  524. 11700 '----------------BACK TAB ROUTINE -------------------------------------
  525. 11710 IF CSRLIN = 3 THEN 11770
  526. 11720 IF CSRLIN = 5 THEN LOCATE 3,41:COUNT=9:RETURN
  527. 11730 IF CSRLIN = 7 THEN 11790
  528. 11740 IF CSRLIN = 9 THEN LOCATE 7,55:COUNT=59:RETURN
  529. 11770 IF POS(0)=>13 AND POS(0) <23 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
  530. 11772 IF POS(0)=>41 AND POS(0)<56 THEN LOCATE 3,13:COUNT=0:RETURN
  531. 11780 LOCATE 3,67:COUNT=36:RETURN
  532. 11790 IF POS(0)=>7 AND POS(0) <22 THEN LOCATE 5,17:COUNT=23:RETURN
  533. 11792 IF POS(0)=>37 AND POS(0)<40 THEN LOCATE 7,7:COUNT=43:RETURN
  534. 11794 IF POS(0)=>55 AND POS(0) <60 THEN LOCATE 7,37:COUNT=57:RETURN
  535. 11799 LOCATE 3,13:COUNT=0:RETURN
  536. 11800 '------------------BACKSPACE -----------------------------------------
  537. 11810 IF X = 3 THEN 11870
  538. 11820 IF X = 5 THEN 11822 ELSE 11830
  539. 11822 IF POS(0)=17 THEN X=3:Y=54:GOSUB 11910:RETURN
  540. 11825 GOSUB 11920:RETURN
  541. 11830 IF X = 7 THEN 11890
  542. 11840 IF X = 9 THEN 11842
  543. 11842 IF POS(0)=7 THEN X=7:Y=59:GOSUB 11910:RETURN
  544. 11845 GOSUB 11920:RETURN
  545. 11870 IF POS(0)=13 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
  546. 11872 IF POS(0)=41 THEN Y=21:GOSUB 11910:RETURN
  547. 11880 GOSUB 11920:RETURN
  548. 11890 IF POS(0)=7 THEN X=5:Y=36:GOSUB 11910:RETURN
  549. 11892 IF POS(0)=37 THEN Y=20:GOSUB 11910:RETURN
  550. 11894 IF POS(0)=55 THEN Y=38:GOSUB 11910:RETURN
  551. 11899 GOSUB 11920:RETURN
  552. 11900 '-------------------PRINT '-' FOR BACKSPACE --------------------------
  553. 11910 LOCATE X,Y:PRINT STRING$(1,45):LOCATE X,Y:COUNT=COUNT-1:RETURN
  554. 11920 LOCATE X,Y:PRINT STRING$(1,45):LOCATE X,Y:COUNT=COUNT-1:RETURN
  555. 12010 CLOSE 2:COLOR 15,0:LOCATE 19,22:PRINT"Loading AutoDialer ..............":COLOR 7,0:CHAIN "A:AUTODIAL.BAS"
  556. 13000 '------------------READ SCREEN FOR INPUT ----------------------------
  557. 13010 CR=3:CC=13:LOCATE ,,0:I$="":TEST=0:ERRORN=0
  558. 13015 FOR L=0 TO 8
  559. 13020 IF L=0 THEN 13030 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=10:GOTO 13038
  560. 13030 I$=I$+CHR$(SCREEN(CR,CC+L))
  561. 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
  562. 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$
  563. 13038 GOSUB 13684
  564. 13040 NEXT L:IF ERRORN=1 THEN GOSUB 13700:GOTO 11405
  565. 13050 N1$=STRING$(10," "):I$=I$+"\":MID$(N1$,1)=I$
  566. 13060 CC=41:I$="":TEST=0:ERRORN=0
  567. 13070 FOR L=0 TO 13
  568. 13080 IF L=0 THEN 13090 ELSE IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=13:GOTO 13098
  569. 13090 I$=I$+CHR$(SCREEN(CR,CC+L))
  570. 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
  571. 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$
  572. 13098 GOSUB 13684
  573. 13100 NEXT L:IF ERRORN=1 THEN GOSUB 13740:GOTO 11405
  574. 13110 MID$(N2$,1)=STRING$(15," "):I$=I$+"\":MID$(N2$,1)=I$
  575. 13120 CR=9:CC=7:I$="":ERRORN=0
  576. 13130 FOR L=0 TO 11
  577. 13140 I$=I$+CHR$(SCREEN(CR,CC+L))
  578. 13145 GOSUB 13650
  579. 13150 NEXT L:IF ERRORN=1 THEN GOSUB 13670:GOTO 11405
  580. 13155 MID$(PH$,1)=I$
  581. 13160 CR=5:CC=17:I$="":TEST=0
  582. 13170 FOR L=0 TO 19
  583. 13180 IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=19:GOTO 13200
  584. 13190 I$=I$+CHR$(SCREEN(CR,CC+L))
  585. 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
  586. 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$
  587. 13200 NEXT L
  588. 13210 MID$(ST$,1)=STRING$(20," "):MID$(ST$,1)=I$
  589. 13220 CR=7:CC=7:I$="":TEST=0
  590. 13230 FOR L=0 TO 13
  591. 13240 IF CHR$(SCREEN(CR,CC+L))=CHR$(45) THEN L=13:GOTO 13260
  592. 13250 I$=I$+CHR$(SCREEN(CR,CC+L))
  593. 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
  594. 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$
  595. 13260 NEXT L
  596. 13270 I$=I$+"\":MID$(C$,1)=STRING$(15," "):MID$(C$,1)=I$
  597. 13280 CC=37:I$=""
  598. 13290 FOR L=0 TO 1
  599. 13300 I$=I$+CHR$(SCREEN(CR,CC+L))
  600. 13310 NEXT L
  601. 13315 MID$(S$,1)=I$
  602. 13320 CC=55:I$="":ERRORN=0
  603. 13330 FOR L=0 TO 4
  604. 13340 I$=I$+CHR$(SCREEN(CR,CC+L))
  605. 13345 GOSUB 13610
  606. 13350 NEXT L:IF ERRORN=1 THEN GOSUB 13630:GOTO 11405
  607. 13355 MID$(Z$,1)=I$
  608. 13360 RETURN
  609. 13500 '------------------CHECK COUNT FOR NEXT FIELD ----------------------
  610. 13510 IF COUNT=9 THEN BEEP:LOCATE 3,41:RETURN
  611. 13520 IF COUNT=23 THEN BEEP:LOCATE 5,17:RETURN
  612. 13530 IF COUNT=43 THEN BEEP:LOCATE 7,7:RETURN
  613. 13550 IF COUNT=57 THEN BEEP:LOCATE 7,37:RETURN
  614. 13560 IF COUNT=59 THEN BEEP:LOCATE 7,55:RETURN
  615. 13565 IF COUNT=76 THEN BEEP:LOCATE 3,13:COUNT=0:RETURN
  616. 13568 IF COUNT=64 THEN BEEP:LOCATE 9,7:RETURN
  617. 13570 IF COUNT>78 THEN BEEP:BEEP:GOTO 11400
  618. 13580 RETURN
  619. 13600 '------------------------ TEST FOR NUMERIC ZIP -------------------------
  620. 13610 I3$=CHR$(SCREEN(CR,CC+L)):IF I3$<CHR$(48) OR I3$>CHR$(57) THEN 13620 ELSE RETURN
  621. 13620 ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
  622. 13630 LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,25:PRINT " Zip code must be NUMERIC. ";:LOCATE 7,55,1:COUNT=59:RETURN
  623. 13640 '----------------------- TEST PHONE NUMBER -----------------------------
  624. 13650 I3$=CHR$(SCREEN(CR,CC+L)):IF I3$<CHR$(48) OR I3$>CHR$(57) THEN 13655 ELSE RETURN
  625. 13655 IF I3$=CHR$(45) THEN RETURN
  626. 13660 ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
  627. 13670 LOCATE 23,1:PRINT STRING$(75,32);:LOCATE 23,20:PRINT " Phone number must be NUMERIC. ";:LOCATE 9,7,1:COUNT=64:RETURN
  628. 13680 '----------------------- TEST NAME FIELDS ------------------------------
  629. 13684 I3$=CHR$(SCREEN(CR,CC+L))
  630. 13690 IF L<>0 THEN RETURN ELSE IF I3$=CHR$(45) OR I3$=CHR$(32) THEN GOTO 13695 ELSE RETURN
  631. 13695 ERRORN=1:LOCATE CR,CC+L:COLOR 15,0:PRINT I3$:COLOR 7,0:RETURN
  632. 13700 LOCATE 23,1:PRINT STRING$(75,32):LOCATE 23,20:PRINT " Name fields are required.";:LOCATE 3,13,1:COUNT=0:RETURN
  633. 13740 LOCATE 23,1:PRINT STRING$(75,32):LOCATE 23,20:PRINT " Name fields are required.";:LOCATE 3,41,1:COUNT=9:RETURN
  634. 15000 '-------------------------INKEY ROUTINE -------------------------------
  635. 15150 IP$=STRING$(IPC," "):CT=0:P1=0:PS=POS(0)
  636. 15155 IF OF=1 THEN LOCATE ,,1 ELSE LOCATE ,,0
  637. 15157 I$=INKEY$:IF I$="" THEN 15157 ELSE LOCATE ,,0
  638. 15161 IF I$=CR$ THEN 15200
  639. 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
  640. 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
  641. 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
  642. 15166 IF I$=ESC$ THEN IP$=I$:RETURN
  643. 15170 IF PT=1 THEN PRINT I$;
  644. 15180 CT=CT+1:MID$(IP$,CT,1)=I$
  645. 15190 IF CT=IPC THEN RETURN ELSE GOTO 15155
  646. 15200 FOR L=IPC TO 1 STEP -1
  647. 15210 IF MID$(IP$,L,1)<>" " THEN P1=L:L=1
  648. 15220 NEXT L
  649. 15230 IP$=LEFT$(IP$,P1):RETURN
  650. 19999 '--------------------------OPENING LOGO ---------------------------------
  651. 20000 DIM C$(10,7)
  652. 20010 CLS
  653. 20020 M$(1,1)="█████ █████"
  654. 20030 M$(1,2)=" ████ ████ "
  655. 20040 M$(1,3)=" ██ ███ ██ "
  656. 20050 M$(1,4)=" ██  █  ██ "
  657. 20060 M$(1,5)=" ██     ██ "
  658. 20070 M$(1,6)="███     ███ "
  659. 20080 M$(1,7)="███     ███ "
  660. 20090 C$(1,1)="   ███  "
  661. 20100 C$(1,2)="  █████"
  662. 20110 C$(1,3)=" ███████"
  663. 20120 C$(1,4)="████ ████"
  664. 20130 C$(1,5)="███   ███"
  665. 20140 C$(1,6)="█████████"
  666. 20150 C$(1,7)="███   ███"
  667. 20160 C$(2,1)="███████"
  668. 20170 C$(2,2)="  ███"
  669. 20180 C$(2,3)="  ███"
  670. 20190 C$(2,4)="  ███"
  671. 20200 C$(2,5)="  ███"
  672. 20210 C$(2,6)="  ███"
  673. 20220 C$(2,7)="███████"
  674. 20230 C$(3,1)="████"
  675. 20240 C$(3,2)=" ███"
  676. 20250 C$(3,3)=" ███"
  677. 20260 C$(3,4)=" ███"
  678. 20270 C$(3,5)=" ███"
  679. 20280 C$(3,6)=" ███     █"
  680. 20290 C$(3,7)="██████████"
  681. 20300 C$(5,1)="██████████"
  682. 20310 C$(5,2)="███    ███"
  683. 20320 C$(5,3)="███"
  684. 20330 C$(5,4)="██████████"
  685. 20340 C$(5,5)="      ████"
  686. 20350 C$(5,6)="███   ████"
  687. 20360 C$(5,7)="██████████"
  688. 20370 C$(6,1)="██████████"
  689. 20380 C$(6,2)="██████████"
  690. 20390 C$(6,3)="   ████"
  691. 20400 C$(6,4)="   ████"
  692. 20410 C$(6,5)="   ████"
  693. 20420 C$(6,6)="   ████"
  694. 20430 C$(6,7)="   ████"
  695. 20440 C$(7,1)="████"
  696. 20450 C$(7,2)=" ███"
  697. 20460 C$(7,3)=" ███"
  698. 20470 C$(7,4)=" ███"
  699. 20480 C$(7,5)=" ███"
  700. 20490 C$(7,6)=" ███"
  701. 20500 C$(7,7)="█████"
  702. 20510 FOR Y= 1 TO 7
  703. 20520  LOCATE Y,12:PRINT M$(1,Y) TAB(25) C$(1,Y) TAB(36) C$(2,Y) TAB(45) C$(3,Y)
  704. 20530  LOCATE Y+8,22:PRINT C$(3,Y) TAB(34) C$(2,Y) TAB(44) C$(5,Y) TAB(56) C$(6,Y)
  705. 20540 NEXT Y
  706. 20550 COLOR 23,0
  707. 20560 FOR X= 17 TO 23
  708. 20570 LOCATE X,50:PRINT C$(7,X-16);
  709. 20580 NEXT
  710. 20590 COLOR 7,0
  711. 20600 LOCATE 24,1:PRINT "(C) COPYRIGHT William Dwinell and Mike Berry 1983";
  712. 20610 FOR WAITING=1 TO 3000:NEXT
  713. 20620 CLS
  714. 21140 FLEN=60:DPH=16:WDH=80:BDR=1
  715. 21160 Y=((WDH-FLEN)/2)-1:LOCATE BDR,Y:COLOR 15,0:PRINT CHR$(201);STRING$(FLEN+4,205);CHR$(187)
  716. 21180 FOR I=1 TO DPH:LOCATE I+BDR,Y:PRINT CHR$(186);:LOCATE I+BDR,(FLEN+5+Y):PRINT CHR$(186):NEXT
  717. 21200 LOCATE I+BDR,Y:PRINT CHR$(200);STRING$(FLEN+4,205);CHR$(188):COLOR 7,0
  718. 21220 LOCATE 3,37:COLOR 0,7:PRINT"  MAILIST1  ";:COLOR 7,0
  719. 21240 LOCATE 20,18:PRINT"(C) Copyright William Dwinell and Mike Berry 1983";
  720. 21242 LOCATE 4,36:PRINT" RELEASE 4.0 "
  721. 21244 LOCATE 6,12:PRINT "This program is released to PUBLIC DOMAIN with the provisions ";
  722. 21245 LOCATE 7,12:PRINT "that lines 20000 through 25000 of program remain unmodified.";
  723. 21246 LOCATE 11,12:PRINT "The authors would appreciate knowing of any problems or";
  724. 21247 LOCATE 12,12:PRINT "suggestions for improvements. Please notify by mail or";
  725. 21248 LOCATE 13,12:PRINT "a message on CompuServe, see next frame."
  726. 21249 LOCATE 9,12:PRINT "No portion of this program is to be sold."
  727. 21260 LOCATE 23,30:COLOR 16,7:PRINT" Press any key to continue ";:COLOR 7,0
  728. 21280 I$=INKEY$:IF I$="" GOTO 21280
  729. 21290 FOR NEWSCREEN = 6 TO 15:LOCATE NEWSCREEN,12:PRINT STRING$(61,32):NEXT
  730. 21300 LOCATE 6,12:PRINT "If you find this program is useful to you a contribution";
  731. 21310 LOCATE 7,12:PRINT "in the amount of $15 is suggested."
  732. 21320 LOCATE 9,12:PRINT "All contributers will be notified of enhancements or future";
  733. 21330 LOCATE 10,12:PRINT "releases of MAILIST1. Send contributions to:"
  734. 21340 LOCATE 12,20:PRINT "Mike Berry                 Bill Dwinell"
  735. 21350 LOCATE 13,20:PRINT "PO Box 18708               1144 Hallmark Drive"
  736. 21360 LOCATE 14,20:PRINT "Shreveport, La     or      Shreveport, La."
  737. 21370 LOCATE 15,20:PRINT "71138                      71118"
  738. 21380 LOCATE 16,20:PRINT "CIS 70235,1300             CIS 70055,1145"
  739. 24980 LOCATE 23,30:PRINT STRING$(45,32)
  740. 24990 LOCATE 23,30:COLOR 16,7:PRINT" Press any key to begin ";:COLOR 7,0
  741. 24999 I$=INKEY$:IF I$="" GOTO 24999 ELSE RETURN
  742. 25000 '(C) Copyright William Dwinell and Mike Berry 1983
  743.