home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug087.ark / MAENTRY.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-10-20  |  8.3 KB  |  269 lines
  1.     rem This is the Mailing List Name Entry Program
  2.  
  3. %INCLUDE ALL.BAS
  4.     dim k$(6,20),n(2,20)
  5.     repeat$="------------------------------"
  6.     fill$ = "                               "
  7. fmt1$="####  ####  ##########  /...5...10...15...20.../  "
  8. fmt2$="                        "
  9. fmt2$=fmt2$+"/...5...10...15...20.../  /...5...10...15...20.../  "
  10. fmt2$=fmt2$+"/...5...10...15./  //  /.../  /...5...10.../"
  11.  
  12.     RESTORE
  13.     PRINT CLEAR$:PRINT
  14. 300    print "Enter mailing list file name as up to 4 alphanumeric characters"
  15.     print:print "i.e. MA0."
  16.     print:input line z5$
  17.     if len(z5$)>4 then 300
  18.     z5$="b:"+z5$
  19.     z6$=z5$+"back":z7$=z5$+"size"
  20.  
  21.        print "Is reference no. to be zip code?";:input line temp$
  22.             if  ucase$(left$(temp$,1))="Y" then zip.flag=1
  23.  
  24. 540 K$(6,1)="1 - NEW ENTRY":K$(6,2)=" 2 - EXAMINE EXISTING ENTRY"
  25. 550 K$(6,3)="3 - MODIFY EXISTING ENTRY"
  26. 560 K$(6,4)="4 - DELETE EXISTING ENTRY"
  27. 570 K$(6,5)="5 - CREATE NEW FILE":K$(6,6)="6 - CLEAR EXISTING FILE"
  28. 580 K$(6,7)="7 - BACK-UP AND SORT FILE":K$(6,8)="8 - LIST FILE"
  29. 590 K$(6,9)="9 - FINISHED"
  30. 1075 K$(1,1)="TAG":K$(1,2)="REFERENCE NUMBER":K$(1,3)="NAME"
  31. 1080 K$(1,4)="COMPANY":K$(1,5)="ADDRESS":K$(1,6)="CITY":K$(1,7)="STATE"
  32. 1085 K$(1,8)="ZIP CODE":K$(1,9)="PHONE (AAA) NNN NNNN"
  33.      for z=1 to 9:read n(1,z):next z
  34.      data 4,10,24,24,24,17,2,5,14
  35. 1100 K$(2,1)="1 - TAG":K$(2,2)="2 - REFERENCE NUMBER":K$(2,3)="3 - NAME"
  36. 1105 K$(2,4)="4 - COMPANY":K$(2,5)="5 - ADDRESS":K$(2,6)="6 - CITY"
  37. 1110 K$(2,7)="7 - STATE":K$(2,8)="8 - ZIP CODE"
  38. 1115 K$(2,9)="9 - PHONE (AAA) NNN NNNN":K$(2,10)="10- NONE"
  39.     print clear$:print
  40.  
  41. 1500    if end #1 then 6000
  42.         open z5$ recl 150 as 1
  43.         close 1
  44.         open z7$ as 2
  45.         read #2;z2,z3
  46.         close 2
  47.  
  48. 1600 REM
  49. 1620     print clear$
  50.     if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  51.     PRINT "MAILING LIST ENTRY PROGRAM"
  52.     PRINT "--------------------------"
  53.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  54.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  55.     PRINT               ;TAB(30);Z2-1;" RECORDS USED"
  56.     PRINT
  57. 1650 PRINT "THIS IS A LIST OF OPERATIONS."
  58. 1655 PRINT
  59. 1660 FOR Z=1 TO 9:PRINT K$(6,Z):NEXT Z:PRINT
  60. 1665 PRINT "INDICATE WHAT YOU WOULD LIKE TO DO BY TYPING"
  61. 1670 PRINT "THE CORRESPONDING NUMBER."
  62. 1675 PRINT
  63. 1680 INPUT Z
  64.     IF Z<1 OR Z>9 THEN 1620
  65. 1682 IF Z=1 THEN new$="N"
  66. 1685 ON Z GOSUB 2000,3000,4000,5000,6000,7000,8000,9000,10000
  67. 1690 N(2,1)=0:N(2,2)=0:N$="":new$=""
  68. 1700 FOR Z=1 TO 10:K$(3,Z)="":NEXT Z
  69. 1705 GOTO 1600
  70. 2000 IF Z2>Z3 THEN RETURN
  71. 2001 PRINT CLEAR$:PRINT
  72. 2005 PRINT "RECORD NUMBER";Z2:PRINT
  73. 2015 FOR Z=1 TO 2
  74.     PRINT CUR$
  75. 2020 PRINT TAB(30);left$(repeat$,n(1,z))
  76.     PRINT UP$
  77. 2025 PRINT K$(1,Z);TAB(30);
  78. 2030 INPUT line temp$:PRINT chr$(13)
  79.     PRINT CLEAR$
  80.     n(2,z)=val(temp$)
  81.         if n(2,1)=0 then n(2,1)=z2
  82.         if n(2,2)=0 then n(2,2)=z2
  83. 2035 NEXT Z
  84. 2040 FOR Z=3 TO 9
  85.     PRINT CUR$
  86. 2045 PRINT TAB(30);left$(repeat$,n(1,z))
  87.     PRINT UP$
  88. 2050 PRINT K$(1,Z);TAB(30);
  89. 2055 INPUT line K$(3,Z):PRINT chr$(13)
  90.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  91. 2060 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  92.     PRINT CLEAR$
  93.         if zip.flag=1 then n(2,2)=val(k$(3,8))
  94. 2065 NEXT Z
  95. 2066 N$=""
  96. 2070 FOR Z=3 TO 9:N$=N$+K$(3,Z):NEXT Z
  97. 2100 Z1=Z2
  98. 2105 PRINT clear$:PRINT
  99. 2110 PRINT "RECORD NUMBER";Z1:PRINT
  100. 2115 FOR Z=1 TO 2
  101. 2120 PRINT K$(2,Z);TAB(30);N(2,Z)
  102. 2125 NEXT Z
  103. 2130 FOR Z=3 TO 10
  104. 2135 PRINT K$(2,Z);TAB(30);K$(3,Z)
  105. 2140 NEXT Z
  106. 2145 PRINT
  107. 2150 PRINT "IF AN ITEM IS TO BE CHANGED, TYPE THE APPROPRIATE NUMBER."
  108. 2155 PRINT:INPUT Z
  109. 2160 PRINT
  110. 2165 IF Z>9 THEN 2216
  111. 2170 IF Z<1 THEN 2105
  112. 2175 IF Z>2 THEN 2200
  113. 2180 PRINT TAB(30);left$(repeat$,n(1,z))
  114.     PRINT UP$
  115. 2185 PRINT K$(1,Z);TAB(30);
  116. 2190 INPUT N(2,Z)
  117. 2195 GOTO 2225
  118. 2200 PRINT TAB(30);left$(repeat$,n(1,z))
  119.     PRINT UP$
  120. 2205 PRINT K$(1,Z);TAB(30);
  121. 2210 INPUT line K$(3,Z)
  122.     if len(k$(3,z))>n(1,z) then k$(3,z)=left$(k$(3,z),n(1,z))
  123. 2215 I=(N(1,Z)-LEN(K$(3,Z))):K$(3,Z)=K$(3,Z)+left$(fill$,i)
  124. 2216 N$=""
  125. 2220 FOR I=3 TO 9:N$=N$+K$(3,I):NEXT I
  126. 2225 INPUT "ANY MORE CHANGES";line temp$
  127. 2230 IF ucase$(left$(temp$,1))="Y" then 2105
  128. 2235 print
  129. 2240 INPUT "IS RECORD TO BE ENTERED";line temp$
  130. 2245 print
  131. 2250 if ucase$(left$(temp$,1))="Y" then 2280
  132. 2255 if ucase$(left$(temp$,1))<>"N" then 2235
  133. 2260 print clear$:print
  134. 2270 print "*** RECORD NOT ENTERED ***":print:print
  135. 2275 for z=1 to 200:next z:return
  136. 2280 open z5$ recl 150 as 1
  137.      print #1,z1;n(2,1),n(2,2),n$
  138.      close 1
  139. 2295 if new$="N" then z2=z2+1:open z7$ as 1:print #1;z2,z3:close 1
  140. 2300 return
  141. 3000 print clear$:print
  142. 3005 input "RECORD NUMBER";z1
  143. 3010 if z1>=z2 then 3000
  144. 3012 if z1<1 then return
  145. 3015 open z5$ recl 150 as 1
  146.      read #1,z1;n(2,1),n(2,2),n$
  147.      close 1
  148. 3030 print
  149. 3035 for z=1 to 2
  150. 3040 print k$(1,z);tab(30);n(2,z)
  151. 3045 next z
  152. 3046 z9=1
  153. 3050 for z=3 to 9
  154. 3055 print k$(1,z);tab(30);mid$(n$,z9,n(1,z))
  155. 3060 z9=z9+n(1,z)
  156. 3065 next z
  157. 3070 print
  158. 3075 print "FOR A NEW RECORD NUMBER, TYPE N - RETURN.":PRINT
  159. 3080 PRINT "IF FINISHED, TYPE F - RETURN.":PRINT
  160. 3085 input line temp$
  161. 3090 if ucase$(temp$)="N" then 3000
  162. 3095 return
  163. 4000 print clear$:print
  164. 4005 N$=""
  165. 4010 input "RECORD NUMBER";z1
  166. 4015 if z1<1 then print "*** NO SUCH RECORD ***":goto 1620
  167. 4020 if z1>z3 then print "*** OUT OF RANGE ***":goto 1620
  168. 4025 if z1>=z2 then print "NO RECORD NUMBER";Z1:goto 1620
  169. 4030 open z5$ recl 150 as 1
  170.      read #1,z1;n(2,1),n(2,2),n$
  171.      close 1
  172. 4045 if n(2,1) = 0 then print "*** DELETED RECORD ***":GOTO 1620
  173. 4050 Z9=1
  174. 4055 FOR Z=3 TO 9
  175. 4060 K$(3,Z)=MID$(N$,Z9,N(1,Z))
  176. 4065 Z9=Z9+N(1,Z)
  177. 4070 NEXT Z
  178. 4075 GOTO 2105
  179. 5000 PRINT clear$:print
  180. 5010 input "RECORD NUMBER";z1
  181. 5015 if z1<1 then print "*** NO SUCH RECORD ***":goto 1620
  182. 5020 if z1>z3 then print "*** OUT OF RANGE ***":goto 1620
  183. 5025 if z1>=z2 then print "NO RECORD NUMBER";Z1:goto 1620
  184. 5030 open z5$ recl 150 as 1
  185.      read #1,z1;n(2,1),n(2,2),n$
  186.      close 1
  187. 5045 if n(2,1) = 0 then print "*** DELETED RECORD ***":GOTO 1620
  188. 5050 print
  189. 5055 for z=1 to 2
  190. 5060 print k$(1,z);tab(30);n(2,z)
  191. 5065 next z
  192. 5070 Z9=1
  193. 5055 FOR Z=3 TO 9
  194. 5080 print k$(1,z);tab(30);mid$(n$,z9,n(1,z))
  195. 5085 Z9=Z9+N(1,Z)
  196. 5090 NEXT Z
  197. 5095 print
  198. 5100 input "IS RECORD TO BE DELETED (MUST BE YES TO DELETE)";line temp$
  199. 5105 if ucase$(left$(temp$,1))="N" then return
  200. 5110 if ucase$(temp$)<> "YES" then 5095
  201. 5115 n(2,1)=0
  202. 5120 open z5$ recl 150 as 1
  203.      print #1,z1;n(2,1),n(2,2),n$
  204.      close 1
  205. 5135 return
  206. 6000 print clear$:print
  207. 6005 print "IF YOU HAVE ARRIVED HERE AND HAVE THIS MAILING LIST FILE"
  208. 6010 print "ALREADY ON A DISK, YOU SHOULD INSTALL THAT DISK THEN"
  209. 6016 print "TYPE THE LETTER C FOLLOWED BY A RETURN TO CONTINUE."
  210. 6020 print
  211. 6025 print "IF YOU WISH TO CREATE A NEW FILE, TYPE THE LETTER N"
  212. 6030 print "FOLLOWED BY RETURN.":print
  213. 6035 input line temp$
  214. 6040 if ucase$(temp$)="C" then initialize:goto 1500
  215. 6045 print clear$:print
  216. 6050 input "NUMBER OF RECORDS DESIRED";z3
  217. 6055 print
  218. 6060 n$="":for z=1 to 100:n$=n$+" ":next z:n(2,1)=0:n(2,2)=0
  219. 6065 create z5$ recl 150 as 1
  220. 6070 for z1=1 to z3+2
  221.      print #1,z1;n(2,1),n(2,2),n$
  222. 6085 next z1
  223. 6090 close 1
  224. 6095 print clear$:print
  225. 6100 print "MAILING LIST FILE ";MID$(Z5$,3,4);" CREATED AND CLEARED.":PRINT
  226. 6105 PRINT z3;"RECORDS CREATED.":PRINT
  227. 6110 PRINT "TO CONTINUE, TYPE RETURN.":INPUT line temp$
  228.     z2=1
  229.     create z7$ as 1:print #1;z2,z3:close 1
  230. 6115 goto 1500
  231. 7000 n$="":for z=1 to 100:n$=n$+" ":next z:n(2,1)=0:n(2,2)=0
  232. 7006 input "ARE YOU SURE !!! (YES OR NO)";line temp$
  233. 7007 if ucase$(temp$)<> "YES" then return
  234.      open z5$ recl 150 as 1
  235. 7010 for z1=1 to z3+2
  236.      print #1,z1;n(2,1),n(2,2),n$
  237. 7025 next z1
  238. 7030 close 1
  239. 7035 print clear$:print
  240. 7040 print "MAILING LIST FILE ";mid$(z5$,3,4);" CLEARED!":PRINT
  241. 7045 print "TO CONTINUE, TYPE RETURN."
  242. 7050 INPUT line temp$
  243.     z2=1
  244.     open z7$ as 1:print #1;z2,z3:close 1
  245. 7060 return
  246. 8000 chain "MASORT"
  247. 9000 print clear$:print
  248. 9010 input "Enter number of lines per page.";page
  249. 9015 page1=1
  250. 9020 print clear$:print
  251. 9030 lprinter
  252. 9035 open z5$ recl 150 as 1
  253. 9040 for z1=1 to z2-1
  254. 9045 read #1,z1;n(2,1),n(2,2),n$
  255. 9050 z9=1
  256. 9055 for z=3 to 9
  257. 9060 k$(3,z)=mid$(n$,z9,n(1,z))
  258. 9065 z9=z9+n(1,z)
  259. 9070 next z
  260. 9100 print using fmt1$;z1,n(2,1),n(2,2),k$(3,3)
  261. 9101 print using fmt2$;k$(3,4),k$(3,5),k$(3,6),k$(3,7),k$(3,8),k$(3,9)
  262. 9105 page1=page1+2
  263. 9110 if page1>page then print chr$(12):page1=1
  264. 9120 next z1
  265. 9150 print chr$(12):for z=1 to 100:next z:print chr$(12)
  266.      console
  267. 9155 return
  268. 10000 chain "master6"
  269.