home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib22a.dsk / NOVEMBER.1984 / COUPMAN.bas < prev   
BASIC Source File  |  2023-02-26  |  20KB  |  485 lines
  1. 10  REM  *******12.26.84*********
  2. 20  REM  *      COUPMAN         *
  3. 30  REM  *    BY GLENN TEMAN    *
  4. 40  REM  *  COPYRIGHT (C) 1984  *
  5. 50  REM  *  BY MICROSPARC, INC  *
  6. 60  REM  *  CONCORD, MA. 01742  *
  7. 70  REM  ************************
  8. 80  REM  -- INITIALIZE --
  9. 90  TEXT 
  10. 100  HOME : PRINT  TAB( 17);"COUPMAN"
  11. 110  FOR I = 1 TO 8: PRINT "-----";: NEXT I
  12. 120  REM  SET DOWN TOP OF TEXT WINDOW
  13. 130  POKE 34,2: VTAB 11: HTAB 20: PRINT "BY"
  14. 140  HTAB 24: PRINT "GLENN TEMAN": VTAB 16: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **"
  15. 150 D$ =  CHR$(4):G$ =  CHR$(7):SL = 1
  16. 160  DIM R%(7),S%(100)
  17. 170  ONERR  GOTO 270
  18. 180  PRINT D$;"OPEN COUPON.FILE,L64"
  19. 190  PRINT D$;"READ COUPON.FILE,R0"
  20. 200  INPUT LN,LR,NC
  21. 210  PRINT D$;"CLOSE COUPON.FILE"
  22. 220  VTAB 20: PRINT NC;" COUPONS ON FILE ..."
  23. 230  PRINT : PRINT "<RETURN> TO CONTINUE ";
  24. 240  GET A$
  25. 250  GOTO 350
  26. 260  REM  -- ONERR RTN --
  27. 270 I =  PEEK(222): PRINT : PRINT D$;"PR#0": PRINT D$;"CLOSE"
  28. 280  IF I < >5  THEN  PRINT : PRINT G$;"<ERROR # ";I;">": GET K$: PRINT : GOTO 350
  29. 290  REM  HANDLE OUT OF DATA ERROR
  30. 300  PRINT D$;"OPEN COUPON.FILE,L64": PRINT D$;"WRITE COUPON.FILE,R0"
  31. 310  PRINT 0: PRINT 0: PRINT 0
  32. 320 LN = 0:LR = 0:NC = 0
  33. 330  GOTO 210
  34. 340  REM  -- MENU --
  35. 350  HOME : VTAB 4
  36. 360  PRINT "1. ENTER COUPONS": PRINT "2. EDIT COUPONS"
  37. 370  PRINT "3. DELETE COUPONS": PRINT "4. LIST/DELETE EXPIRED COUPONS"
  38. 380  PRINT "5. LIST BY PRODUCT": PRINT "6. LIST ALL COUPONS"
  39. 390  PRINT "7. LIST BY CATEGORY": PRINT "8. SEARCH & PRINT COUPONS"
  40. 400  PRINT "9. QUIT"
  41. 410  VTAB 18: PRINT "OPTION?"
  42. 420  VTAB 18: HTAB 9: CALL  -868:M = 1: GOSUB 1930
  43. 430 I =  VAL(I$): IF I <1  OR I >9  THEN  PRINT G$: GOTO 420
  44. 440  IF I = 9  THEN 480: REM  QUIT
  45. 450  ON I GOSUB 870,1480,2090,2430,2920,3340,3920,4340
  46. 460  GOTO 350
  47. 470  REM  -- QUIT --
  48. 480  VTAB 20: PRINT : PRINT "GOODBYE!"
  49. 490  POKE 34,0: REM  RESET TEXT WINDOW
  50. 500  END 
  51. 510  REM  -- TITLES --
  52. 520  VTAB 3: HTAB 1: CALL  -958
  53. 530  INVERSE : PRINT A$: NORMAL 
  54. 540  RETURN 
  55. 550  REM  -- CK CATEGORY --
  56. 560 ER = 0: IF CA$ < >"?"  THEN 750
  57. 570  VTAB 18: HTAB 1: CALL  -958
  58. 580  PRINT "  BE - BEVERAGES": PRINT "  CA - CANNED GOODS"
  59. 590  PRINT "  DE - DESSERTS": PRINT "  ME - MEAT, CHICKEN, FISH"
  60. 600  PRINT "  FR - FROZEN FOODS"
  61. 610  GOSUB 820
  62. 620  PRINT "  WR - WRAPS, FOILS, BAGS"
  63. 630  PRINT "  PA - PAPER TOWELS, TISSUES"
  64. 640  PRINT "  NO - NOODLES, RICE, PASTA"
  65. 650  PRINT "  DA - DAIRY (MILK, CHEESE, ETC)"
  66. 660  PRINT "  SO - SOAPS, DETERGENTS, ETC"
  67. 670  GOSUB 820
  68. 680  PRINT "  MF - MISCELLANEOUS FOODS"
  69. 690  PRINT "  MN - MISCELLANEOUS NON-FOODS"
  70. 700  PRINT "  SP - SPICES, KETCHUP, MUSTARD"
  71. 710  PRINT "  TO - TOILETRIES (SHAVING, ETC)"
  72. 720  PRINT "  CE - CEREAL, BREAD"
  73. 730  GOSUB 820
  74. 740 ER = 1: RETURN 
  75. 750  IF  LEN(CA$) < >2  THEN  PRINT G$:ER = 1: RETURN 
  76. 760  FOR I = 1 TO 29  STEP 2
  77. 770  IF CA$ =  MID$ ("BEDEFRCAMEWRPANODASOMFMNSPTOCE",I,2)  THEN 800
  78. 780  NEXT I
  79. 790 ER = 1: PRINT G$
  80. 800  RETURN 
  81. 810  REM  -- RETURN TO CONTINUE --
  82. 820  VTAB 23: HTAB 1: PRINT "<RETURN> TO CONTINUE ";
  83. 830 M = 0: GOSUB 1930
  84. 840  VTAB 18: HTAB 1: CALL  -958
  85. 850  RETURN 
  86. 860  REM  -- ENTER --
  87. 870 A$ = "ENTER COUPONS": GOSUB 520
  88. 880  VTAB 5: HTAB 1: PRINT "COUPON #:"
  89. 890  PRINT : PRINT "PRODUCT:": PRINT "BRAND:": PRINT "CATEGORY('?' FOR HELP):"
  90. 900  PRINT "EXPIRATION DATE (MM/DD/YY):": PRINT "AMOUNT:"
  91. 910 NU = LN +1: VTAB 5: HTAB 11: CALL  -868: PRINT NU
  92. 920  VTAB 7: HTAB 10: CALL  -868:M = 25: GOSUB 1930:PR$ = I$
  93. 930  IF PR$ = ""  THEN  RETURN 
  94. 940 B$ =  LEFT$(PR$,1): IF B$ <"A"  OR B$ >"Z"  THEN  PRINT G$: GOTO 920
  95. 950  VTAB 8: HTAB 8: CALL  -868:M = 15: GOSUB 1930:BR$ = I$
  96. 960  VTAB 9: HTAB 24: CALL  -868:M = 2: GOSUB 1930:CA$ = I$
  97. 970  GOSUB 560: IF ER  THEN 960
  98. 980  VTAB 10: HTAB 28: CALL  -868:M = 8: GOSUB 1930:ED$ = I$
  99. 990  IF ED$ = ""  THEN ED$ = "999999": GOTO 1010
  100. 1000  GOSUB 1090: IF ER  THEN 980
  101. 1010  VTAB 11: HTAB 9: CALL  -868:M = 6: GOSUB 1930:AM$ = I$
  102. 1020  IF  LEFT$(AM$,1) = "-"  THEN  PRINT G$: GOTO 1010
  103. 1030  VTAB 23: PRINT "FILE? (Y) ";:M = 1: GOSUB 1930
  104. 1040  IF I$ = ""  OR I$ = "Y"  THEN  GOSUB 1190: VTAB 23: HTAB 18: PRINT "<COUPON ";NU;" FILED>"
  105. 1050  VTAB 11: HTAB 9: CALL  -868: VTAB 10: HTAB 28: CALL  -868
  106. 1060  VTAB 9: HTAB 24: CALL  -868: VTAB 8: HTAB 8: CALL  -868
  107. 1070  GOTO 910
  108. 1080  REM  -- CK DATE --
  109. 1090 ER = 0: IF  LEN(ED$) < >8  THEN 1170
  110. 1100 A$ =  LEFT$(ED$,2)
  111. 1110  IF A$ <"01"  OR A$ >"12"  THEN 1170
  112. 1120 B$ =  MID$ (ED$,4,2)
  113. 1130  IF B$ <"01"  OR B$ >"31"  THEN 1170
  114. 1140 C$ =  RIGHT$(ED$,2)
  115. 1150  IF C$ <"83"  OR C$ >"99"  THEN 1170
  116. 1160 ED$ = C$ +A$ +B$: RETURN 
  117. 1170 ER = 1: PRINT G$: RETURN 
  118. 1180  REM  -- FILE --
  119. 1190 NC = NC +1:LN = NU:LR = LR +1:R = LR
  120. 1200  PRINT D$;"OPEN COUPON.FILE,L64"
  121. 1210  PRINT D$;"WRITE COUPON.FILE,R0"
  122. 1220  PRINT LN: PRINT LR: PRINT NC
  123. 1230  PRINT D$;"CLOSE COUPON.FILE"
  124. 1240  IF   NOT R  THEN  RETURN 
  125. 1250  PRINT D$;"OPEN COUPON.FILE,L64"
  126. 1260  PRINT D$;"WRITE COUPON.FILE,R";R
  127. 1270  PRINT NU: PRINT PR$: PRINT ED$
  128. 1280  PRINT CA$: PRINT BR$: PRINT AM$
  129. 1290  PRINT D$;"CLOSE COUPON.FILE"
  130. 1300  RETURN 
  131. 1310  REM  -- LOOKUP BY # --
  132. 1320 R = 0: IF NU <1  OR NU >LN  THEN  PRINT G$: RETURN 
  133. 1330  PRINT D$;"OPEN COUPON.FILE,L64"
  134. 1340  FOR I = 1 TO LR
  135. 1350  PRINT D$;"READ COUPON.FILE,R";I
  136. 1360  INPUT J
  137. 1370  IF J = NU  THEN R = I: GOTO 1400
  138. 1380  NEXT I
  139. 1390  PRINT G$
  140. 1400  PRINT D$;"CLOSE COUPON.FILE"
  141. 1410  RETURN 
  142. 1420  REM  -- REPORT HDR --
  143. 1430  PRINT : IF L < >99  THEN  PRINT  CHR$(12)
  144. 1440 L = 3
  145. 1450  PRINT  SPC( (78 - LEN(T$))/2);T$: PRINT 
  146. 1460  RETURN 
  147. 1470  REM  -- EDIT --
  148. 1480 A$ = "EDIT COUPONS": GOSUB 520
  149. 1490  VTAB 5: HTAB 1: PRINT "COUPON #:"
  150. 1500  PRINT : PRINT "PRODUCT:": PRINT : PRINT "BRAND:"
  151. 1510  PRINT : PRINT "CATEGORY:": PRINT : PRINT "EXPIRATION DATE:": PRINT : PRINT "AMOUNT:"
  152. 1520  VTAB 5: HTAB 11: CALL  -868:M = 6: GOSUB 1930:A$ = I$
  153. 1530  IF A$ = ""  THEN  RETURN 
  154. 1540 NU =  VAL(A$): GOSUB 1320
  155. 1550  IF   NOT R  THEN 1520
  156. 1560  PRINT D$;"OPEN COUPON.FILE,L64"
  157. 1570  PRINT D$;"READ COUPON.FILE,R";R
  158. 1580  INPUT NU,OP$,OE$,OC$,OB$,OA$
  159. 1590  PRINT D$;"CLOSE COUPON.FILE"
  160. 1600  VTAB 8: HTAB 10: PRINT "(";OP$;")"
  161. 1610  PRINT : HTAB 8: PRINT "(";OB$;")"
  162. 1620  PRINT : HTAB 11: PRINT "(";OC$;")"
  163. 1630  PRINT : HTAB 18: IF OE$ = "999999"  THEN  PRINT "(NONE)"
  164. 1640  IF OE$ < >"999999"  THEN  PRINT "("; MID$ (OE$,3,2);"/"; RIGHT$(OE$,2);"/"; LEFT$(OE$,2);")"
  165. 1650  PRINT : HTAB 9: PRINT "(";OA$;")"
  166. 1660  VTAB 7: HTAB 10: CALL  -868:M = 25: GOSUB 1930:PR$ = I$
  167. 1670  IF PR$ = "/"  THEN  PRINT G$: GOTO 1660
  168. 1680  IF PR$ = ""  THEN PR$ = OP$
  169. 1690 B$ =  LEFT$(PR$,1): IF B$ <"A"  OR B$ >"Z"  THEN  PRINT G$: GOTO 1660
  170. 1700  VTAB 9: HTAB 8: CALL  -868:M = 15: GOSUB 1930:BR$ = I$
  171. 1710  IF BR$ = ""  THEN BR$ = OB$
  172. 1720  IF BR$ = "/"  THEN BR$ = ""
  173. 1730  VTAB 11: HTAB 11: CALL  -868:M = 2: GOSUB 1930:CA$ = I$
  174. 1740  IF CA$ = ""  THEN CA$ = OC$
  175. 1750  GOSUB 560: IF ER  THEN 1730
  176. 1760  VTAB 13: HTAB 18: CALL  -868:M = 8: GOSUB 1930:ED$ = I$
  177. 1770  IF ED$ = ""  THEN ED$ = OE$: GOTO 1800
  178. 1780  IF ED$ = "/"  THEN ED$ = "999999": GOTO 1800
  179. 1790  GOSUB 1090: IF ER  THEN 1760
  180. 1800  VTAB 15: HTAB 9: CALL  -868:M = 6: GOSUB 1930:AM$ = I$
  181. 1810  IF AM$ = ""  THEN AM$ = OA$
  182. 1820  IF AM$ = "/"  THEN AM$ = ""
  183. 1830  IF  LEFT$(AM$,1) = "-"  THEN  PRINT G$: GOTO 1800
  184. 1840  VTAB 23: PRINT "FILE? (Y) ";:M = 1: GOSUB 1930
  185. 1850  IF I$ = ""  OR I$ = "Y"  THEN  GOSUB 1250: VTAB 23: HTAB 18: PRINT "<COUPON ";NU;" FILED>"
  186. 1860  VTAB 16: HTAB 1: CALL  -868: VTAB 15: HTAB 9: CALL  -868
  187. 1870  VTAB 14: HTAB 1: CALL  -868: VTAB 13: HTAB 18: CALL  -868
  188. 1880  VTAB 12: HTAB 1: CALL  -868: VTAB 11: HTAB 11: CALL  -868
  189. 1890  VTAB 10: HTAB 1: CALL  -868: VTAB 9: HTAB 8: CALL  -868
  190. 1900  VTAB 8: HTAB 1: CALL  -868: VTAB 7: HTAB 10: CALL  -868
  191. 1910  GOTO 1520
  192. 1920  REM  -- GET RTN --
  193. 1930 I$ = "":F = 0
  194. 1940  FOR G = 1 TO 2  STEP 0
  195. 1950  REM GET CHAR & CK FOR RETURN (13)
  196. 1960  GET K$:K =  ASC(K$): IF K = 13  THEN  PRINT : RETURN 
  197. 1970  REM  CK FOR MAX LENGTH
  198. 1980  IF F = M  AND K >31  THEN  PRINT G$;: GOTO 2070
  199. 1990  REM  CK FOR " , :
  200. 2000  IF K = 34  OR K = 44  OR K = 58  THEN  PRINT G$;: GOTO 2070
  201. 2010  REM  SAVE CHAR IF NOT CTRL CHAR
  202. 2020  IF K >31  THEN  PRINT K$;:I$ = I$ +K$:F = F +1: GOTO 2070
  203. 2030  REM  ALLOW ERASE
  204. 2040  IF K = 8  AND F >1  THEN I$ =  LEFT$(I$,F -1):F = F -1: PRINT K$;" ";K$;: GOTO 2070
  205. 2050  IF K = 8  AND F  THEN I$ = "":F = 0: PRINT K$;" ";K$;: GOTO 2070
  206. 2060  PRINT G$;
  207. 2070  NEXT G
  208. 2080  REM  -- DELETE --
  209. 2090 A$ = "DELETE COUPONS": GOSUB 520
  210. 2100  VTAB 5: HTAB 1: PRINT "COUPON #:"
  211. 2110  PRINT : PRINT "PRODUCT:": PRINT "BRAND:"
  212. 2120  PRINT "CATEGORY:": PRINT "EXPIRATION DATE:": PRINT "AMOUNT:"
  213. 2130  VTAB 5: HTAB 11: CALL  -868:M = 6: GOSUB 1930:A$ = I$
  214. 2140  IF A$ = ""  THEN  RETURN 
  215. 2150 NU =  VAL(A$): GOSUB 1320
  216. 2160  IF   NOT R  THEN 2130
  217. 2170  PRINT D$;"OPEN  COUPON.FILE,L64"
  218. 2180  PRINT D$;"READ COUPON.FILE,R";R
  219. 2190  INPUT J,OP$,OE$,OC$,OB$,OA$
  220. 2200  PRINT D$;"CLOSE COUPON.FILE"
  221. 2210  VTAB 7: HTAB 10: PRINT OP$: HTAB 8: PRINT OB$
  222. 2220  HTAB 11: PRINT OC$: HTAB 18: IF OE$ = "999999"  THEN  PRINT "(NONE)"
  223. 2230  IF OE$ < >"999999"  THEN  PRINT  MID$ (OE$,3,2);"/"; RIGHT$(OE$,2);"/"; LEFT$(OE$,2)
  224. 2240  HTAB 9: PRINT OA$
  225. 2250  VTAB 23: PRINT "DELETE? (N) ";:M = 1: GOSUB 1930
  226. 2260  IF I$ < >"Y"  THEN 2380
  227. 2270  REM  PREPARE TO FILE LAST REC OVER DELETED REC
  228. 2280  IF R = LR  THEN R = 0: GOTO 2350
  229. 2290  REM  GET LAST REC DATA
  230. 2300  PRINT D$;"OPEN COUPON.FILE,L64"
  231. 2310  PRINT D$;"READ COUPON.FILE,R";LR
  232. 2320  INPUT NU,PR$,ED$,CA$,BR$,AM$
  233. 2330  PRINT D$;"CLOSE COUPON.FILE"
  234. 2340  REM  PREP TO REFILE 1ST REC
  235. 2350 NC = NC -1:LR = LR -1
  236. 2360  GOSUB 1200
  237. 2370  VTAB 23: HTAB 15: CALL  -868: PRINT "<COUPON ";J;" DELETED>"
  238. 2380  VTAB 11: HTAB 9: CALL  -868: VTAB 10: HTAB 18: CALL  -868
  239. 2390  VTAB 9: HTAB 11: CALL  -868: VTAB 8: HTAB 8: CALL  -868
  240. 2400  VTAB 7: HTAB 10: CALL  -868
  241. 2410  GOTO 2130
  242. 2420  REM  -- LIST/DELETE EXPIRED COUPONS --
  243. 2430 A$ = "LIST/DELETE EXPIRED COUPONS": GOSUB 520
  244. 2440  VTAB 7: HTAB 1: PRINT "DELETE EXPIRED COUPONS?"
  245. 2450  VTAB 6: HTAB 1: PRINT "LIST ON PRINTER? (Y)"
  246. 2460  VTAB 5: HTAB 1: PRINT "EXPIRATION DATE: ";
  247. 2470  GOSUB 4820: IF TE$ = ""  THEN  RETURN 
  248. 2480 S = 0: VTAB 6: HTAB 22: CALL  -868
  249. 2490 M = 1: GOSUB 1930
  250. 2500  IF I$ = "Y"  OR I$ = ""  THEN S = 56:L = 99:T$ = "EXPIRED COUPONS " +TE$
  251. 2510  VTAB 7: HTAB 25: CALL  -868:M = 1: GOSUB 1930:A$ = I$
  252. 2520 B = 0: IF A$ = "Y"  THEN B = 1: GOTO 2540
  253. 2530  IF A$ < >"N"  THEN  PRINT G$: GOTO 2510
  254. 2540  VTAB 9: HTAB 1: PRINT "ARE YOU SURE? (Y) ";:M = 1: GOSUB 1930
  255. 2550  IF I$ < >"Y"  AND I$ < >""  THEN  PRINT G$: GOTO 2430
  256. 2560  IF   NOT S  THEN  VTAB 6: HTAB 1: CALL  -958
  257. 2570  IF S  THEN  PRINT D$;"PR#";SL
  258. 2580 I = 0: PRINT D$;"OPEN COUPON.FILE,L64"
  259. 2590 I = I +1: IF I >LR  THEN 2870
  260. 2600  PRINT D$;"READ COUPON.FILE,R";I
  261. 2610  INPUT NU,PR$,ED$
  262. 2620  IF ED$ >TD$  THEN 2590
  263. 2630  INPUT CA$,BR$,AM$
  264. 2640  IF S  THEN 2700
  265. 2650  PRINT NU; TAB( 7);PR$;
  266. 2660  PRINT  TAB( 34);AM$: PRINT  SPC( 6);BR$; TAB( 23);
  267. 2670  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  268. 2680  PRINT "  ";CA$
  269. 2690  GOTO 2750
  270. 2700  IF L >S  THEN  GOSUB 1430
  271. 2710  PRINT NU; TAB( 7);PR$; SPC( 27 - LEN(PR$));BR$; SPC( 17 - LEN(BR$));
  272. 2720  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  273. 2730  PRINT "  ";AM$; SPC( 8 - LEN(AM$));CA$
  274. 2740 L = L +1
  275. 2750  IF   NOT B  THEN 2590
  276. 2760  REM  PREP TO FILE LAST REC OVER DELETED REC
  277. 2770 R = I: IF I = LR  THEN R = 0: GOTO 2820
  278. 2780  REM  GET LAST RECORD
  279. 2790  PRINT D$;"READ COUPON.FILE,R";LR
  280. 2800  INPUT NU,PR$,ED$,CA$,BR$,AM$
  281. 2810  REM  PREP TO REFILE 1ST REC
  282. 2820 NC = NC -1:LR = LR -1
  283. 2830  PRINT D$;"CLOSE COUPON.FILE"
  284. 2840  GOSUB 1200: IF R  THEN I = I -1
  285. 2850  PRINT D$;"OPEN COUPON.FILE,L64"
  286. 2860  GOTO 2590
  287. 2870  PRINT D$;"CLOSE COUPON.FILE"
  288. 2880  IF S  THEN  PRINT  CHR$(12): PRINT D$;"PR#0"
  289. 2890  IF   NOT S  THEN  PRINT : PRINT "<RETURN> TO CONTINUE ";:M = 0: GOSUB 1930
  290. 2900  RETURN 
  291. 2910  REM  -- LIST BY PRODUCT --
  292. 2920 A$ = "LIST COUPONS BY PRODUCT": GOSUB 520
  293. 2930  VTAB 6: HTAB 1: PRINT "LIST ON PRINTER? (Y)"
  294. 2940  VTAB 5: HTAB 1: CALL  -868: PRINT "PRODUCT? (ALL) ";
  295. 2950 M = 25: GOSUB 1930:A$ = I$
  296. 2960  IF A$ = ""  OR A$ = "ALL"  THEN B = 0: GOTO 2990
  297. 2970 B = 1:OP$ = A$:A$ =  LEFT$(A$,1)
  298. 2980  IF A$ <"A"  OR A$ >"Z"  THEN  PRINT G$: GOTO 2940
  299. 2990 S = 0: VTAB 6: HTAB 22: CALL  -868
  300. 3000 M = 1: GOSUB 1930: PRINT :A = 0
  301. 3010  IF I$ = "Y"  OR I$ = ""  THEN S = 56:L = 99:T$ = "LIST COUPONS BY PRODUCT"
  302. 3020  IF S  THEN  PRINT D$;"PR#";SL
  303. 3030  PRINT D$;"OPEN COUPON.FILE,L64"
  304. 3040  FOR I = 65 TO 90
  305. 3050 B$ =  CHR$(I):J = 1: IF B  THEN B$ = OP$:J =  LEN(B$)
  306. 3060  FOR R = 1 TO LR
  307. 3070  PRINT D$;"READ COUPON.FILE,R";R
  308. 3080  INPUT NU,PR$
  309. 3090  IF  LEFT$(PR$,J) < >B$  THEN 3250
  310. 3100  INPUT ED$,CA$,BR$,AM$
  311. 3110  IF S  THEN 3180
  312. 3120  PRINT NU; TAB( 7);PR$;
  313. 3130  PRINT  TAB( 34);AM$: PRINT  SPC( 6);BR$; TAB( 23);
  314. 3140  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  315. 3150  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  316. 3160  PRINT "  ";CA$
  317. 3170  GOTO 3240
  318. 3180  IF L >S  THEN  GOSUB 1430
  319. 3190  PRINT NU; TAB( 7);PR$; SPC( 27 - LEN(PR$));BR$; SPC( 17 - LEN(BR$));
  320. 3200  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  321. 3210  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  322. 3220  PRINT "  ";AM$; SPC( 8 - LEN(AM$));CA$
  323. 3230 L = L +1
  324. 3240 A = 1
  325. 3250  NEXT R
  326. 3260  IF B  THEN 3290
  327. 3270  IF (A)  THEN  PRINT :L = L +1:A = 0
  328. 3280  NEXT I
  329. 3290  PRINT D$;"CLOSE COUPON.FILE"
  330. 3300  IF S  THEN  PRINT  CHR$(12): PRINT D$;"PR#0"
  331. 3310  IF   NOT S  THEN  PRINT : PRINT "<RETURN> TO CONTINUE ";:M = 0: GOSUB 1930
  332. 3320  RETURN 
  333. 3330  REM  -- LIST ALL --
  334. 3340 A$ = "LIST ALL COUPONS": GOSUB 520
  335. 3350 L = 99:T$ = "LIST ALL COUPONS":S = 9999
  336. 3360  VTAB 5: HTAB 1: PRINT "LIST ON PRINTER? (Y) ";:M = 1: GOSUB 1930: PRINT 
  337. 3370  IF I$ = "Y"  OR I$ = ""  THEN S = 56: PRINT D$;"PR#";SL
  338. 3380  PRINT D$;"OPEN COUPON.FILE,L64"
  339. 3390  FOR R = 1 TO LR
  340. 3400  PRINT D$;"READ COUPON.FILE,R";R
  341. 3410  INPUT NU,PR$,ED$,CA$,BR$,AM$
  342. 3420  IF L >S  THEN  GOSUB 1430
  343. 3430  PRINT NU; TAB( 7);PR$;: IF S = 9999  THEN 3490
  344. 3440  PRINT  SPC( 27 - LEN(PR$));BR$; SPC( 17 - LEN(BR$));
  345. 3450  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  346. 3460  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  347. 3470  PRINT "  ";AM$; SPC( 8 - LEN(AM$));CA$
  348. 3480  GOTO 3530
  349. 3490  PRINT  TAB( 34);AM$: PRINT  SPC( 6);BR$; TAB( 23);
  350. 3500  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  351. 3510  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  352. 3520  PRINT "  ";CA$
  353. 3530 L = L +1: NEXT R
  354. 3540  IF S = 56  THEN  PRINT  CHR$(12): PRINT D$;"PR#0"
  355. 3550  PRINT D$;"CLOSE COUPON.FILE"
  356. 3560  IF S = 9999  THEN  PRINT : PRINT "<RETURN> TO CONTINUE ";:M = 0: GOSUB 1930
  357. 3570  RETURN 
  358. 3580  REM  -- ASK SELECT PRODUCT --
  359. 3590  VTAB 24: PRINT "<RETURN> FOR MORE";: GOTO 3610
  360. 3600  VTAB 24: PRINT "<RETURN> TO CONTINUE";
  361. 3610  VTAB 23: PRINT 
  362. 3620  PRINT D$;"CLOSE COUPON.FILE"
  363. 3630  IF   NOT S  OR   NOT J  THEN  HTAB 23: GET B$: GOTO 3720
  364. 3640  VTAB 23: HTAB 1: CALL  -868: PRINT "SELECT 1-";J;" OR S)TOP? ";
  365. 3650 M = 2: GOSUB 1930:B$ = I$: IF B$ = ""  THEN 3720
  366. 3660  IF  LEFT$(B$,1) = "S"  THEN J = 99: GOTO 3730
  367. 3670 B =  VAL(B$): IF B <1  OR B >J  THEN  PRINT G$;: GOTO 3640
  368. 3680  IF   NOT R%(B)  THEN  PRINT G$;: GOTO 3640
  369. 3690 S%(0) = S%(0) +1:S%(S%(0)) = R%(B)
  370. 3700  VTAB 6 +B *2: HTAB 1: PRINT "*":R%(B) = 0
  371. 3710  GOTO 3640
  372. 3720 J = 0
  373. 3730  VTAB 7: HTAB 1: CALL  -958: PRINT 
  374. 3750  RETURN 
  375. 3760  REM  -- SEARCH & PRINT BY # --
  376. 3770 NU =  VAL(A$): GOSUB 1320:S%(0) = 0
  377. 3780  IF   NOT R  THEN J = 0: GOTO 3880
  378. 3790  PRINT D$;"OPEN COUPON.FILE,L64"
  379. 3800  PRINT D$;"READ COUPON.FILE,R";R
  380. 3810  INPUT NU,PR$,ED$,CA$,BR$,AM$
  381. 3820  VTAB 8: HTAB 1: PRINT "1) ";
  382. 3830  PRINT NU; TAB( 10);PR$; TAB( 37);CA$
  383. 3840  PRINT "   ";BR$; TAB( 21);AM$; TAB( 29);
  384. 3850  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2)
  385. 3860  IF ED$ = "999999"  THEN  PRINT "(NONE)"
  386. 3870 J = 1:R%(J) = R
  387. 3880  GOSUB 3600
  388. 3890  PRINT D$;"CLOSE COUPON.FILE"
  389. 3900  RETURN 
  390. 3910  REM  -- LIST BY CATEGORY --
  391. 3920 A$ = "LIST COUPONS BY CATEGORY": GOSUB 520
  392. 3930  VTAB 6: HTAB 1: PRINT "LIST ON PRINTER? (Y)"
  393. 3940  VTAB 5: HTAB 1: CALL  -868: PRINT "CATEGORY: (ALL) ";
  394. 3950 M = 3: GOSUB 1930:CA$ = I$
  395. 3960  IF CA$ = ""  OR CA$ = "ALL"  THEN B = 0: GOTO 3990
  396. 3970  GOSUB 560: IF ER  THEN  VTAB 5: HTAB 17: CALL  -868: GOTO 3950
  397. 3980 B = 1:OC$ = CA$
  398. 3990 S = 0: VTAB 6: HTAB 22: CALL  -868
  399. 4000 M = 1: GOSUB 1930: PRINT :A = 0
  400. 4010  IF I$ = "Y"  OR I$ = ""  THEN S = 56:L = 99:T$ = "LIST COUPONS BY CATEGORY"
  401. 4020  IF S  THEN  PRINT D$;"PR#";SL
  402. 4030  PRINT D$;"OPEN COUPON.FILE,L64"
  403. 4040  FOR I = 1 TO 29  STEP 2
  404. 4050  IF   NOT B  THEN OC$ =  MID$ ("BEDEFRCAMEWRPANODASOMFMNSPTOCE",I,2)
  405. 4060  FOR R = 1 TO LR
  406. 4070  PRINT D$;"READ COUPON.FILE,R";R
  407. 4080  INPUT NU,PR$,ED$,CA$
  408. 4090  IF CA$ < >OC$  THEN 4250
  409. 4100  INPUT BR$,AM$
  410. 4110  IF S  THEN 4180
  411. 4120  PRINT NU; TAB( 7);PR$;
  412. 4130  PRINT  TAB( 34);AM$: PRINT  SPC( 6);BR$; TAB( 23);
  413. 4140  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  414. 4150  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  415. 4160  PRINT "  ";CA$
  416. 4170  GOTO 4240
  417. 4180  IF L >S  THEN  GOSUB 1430
  418. 4190  PRINT NU; TAB( 7);PR$; SPC( 27 - LEN(PR$));BR$; SPC( 17 - LEN(BR$));
  419. 4200  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  420. 4210  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  421. 4220  PRINT "  ";AM$; SPC( 8 - LEN(AM$));CA$
  422. 4230 L = L +1
  423. 4240 A = 1
  424. 4250  NEXT R
  425. 4260  IF B  THEN 4290
  426. 4270  IF (A)  THEN  PRINT :L = L +1:A = 0
  427. 4280  NEXT I
  428. 4290  PRINT D$;"CLOSE COUPON.FILE"
  429. 4300  IF S  THEN  PRINT  CHR$(12): PRINT D$;"PR#0"
  430. 4310  IF   NOT S  THEN  PRINT : PRINT "<RETURN> TO CONTINUE ";:M = 0: GOSUB 1930
  431. 4320  RETURN 
  432. 4330  REM  -- SEARCH & PRINT --
  433. 4340 A$ = "SEARCH & PRINT COUPONS": GOSUB 520
  434. 4350  VTAB 6: HTAB 1: PRINT "PRODUCT/COUPON #:"
  435. 4360  VTAB 5: HTAB 1: PRINT "LIST ON PRINTER? (Y) ";
  436. 4370 S = 0:W = 0:M = 1: GOSUB 1930
  437. 4380  IF I$ = "Y"  OR I$ = ""  THEN S = 56:L = 99:T$ = "SEARCH & PRINT COUPONS"
  438. 4390  VTAB 6: HTAB 19: CALL  -958:M = 25: GOSUB 1930:A$ = I$
  439. 4400  IF A$ = ""  AND   NOT S  THEN  RETURN 
  440. 4410  IF A$ = ""  AND W  THEN  PRINT D$;"PR#";SL: PRINT  CHR$(12): PRINT D$;"PR#0"
  441. 4420  IF A$ = ""  THEN  RETURN 
  442. 4430 B$ =  LEFT$(A$,1): IF B$ <"0"  OR B$ >"9"  THEN  GOSUB 4630: GOTO 4450
  443. 4440  GOSUB 3770
  444. 4450  IF   NOT S%(0)  THEN 4390
  445. 4460  POKE 34,8: PRINT D$;"PR#";SL
  446. 4470 W = 1
  447. 4480  FOR I = 1 TO S%(0)
  448. 4490  PRINT D$;"OPEN COUPON.FILE,L64"
  449. 4500  PRINT D$;"READ COUPON.FILE,R";S%(I)
  450. 4510  INPUT NU,PR$,ED$,CA$,BR$,AM$
  451. 4520  PRINT D$;"CLOSE COUPON.FILE"
  452. 4530  IF L >S  THEN  GOSUB 1430
  453. 4540  PRINT NU; TAB( 7);PR$; SPC( 27 - LEN(PR$));BR$; SPC( 17 - LEN(BR$));
  454. 4550  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2);
  455. 4560  IF ED$ = "999999"  THEN  PRINT "(NONE)  ";
  456. 4570  PRINT "  ";AM$; SPC( 8 - LEN(AM$));CA$
  457. 4580 L = L +1
  458. 4590  NEXT I
  459. 4600  PRINT D$;"PR#0": POKE 34,2
  460. 4610  GOTO 4390
  461. 4620  REM  -- LOOKUP PRODUCT --
  462. 4630 J = 0:A =  LEN(A$):S%(0) = 0
  463. 4640  PRINT D$;"OPEN COUPON.FILE,L64"
  464. 4650  FOR I = 1 TO LR
  465. 4660  PRINT D$;"READ COUPON.FILE,R";I
  466. 4670  INPUT NU,PR$
  467. 4680  IF  LEFT$(PR$,A) < >A$  THEN 4770
  468. 4690  INPUT ED$,CA$,BR$,AM$
  469. 4700  IF J = 7  THEN  GOSUB 3590: IF J = 99  THEN 4780
  470. 4710 J = J +1:R%(J) = I
  471. 4720  VTAB 6 +J *2: HTAB 1: PRINT J;") ";
  472. 4730  PRINT NU; TAB( 10);PR$; TAB( 37);CA$
  473. 4740  PRINT "   ";BR$; TAB( 21);AM$; TAB( 29);
  474. 4750  IF ED$ < >"999999"  THEN  PRINT  MID$ (ED$,3,2);"/"; RIGHT$(ED$,2);"/"; LEFT$(ED$,2)
  475. 4760  IF ED$ = "999999"  THEN  PRINT "(NONE)"
  476. 4770  NEXT I
  477. 4780  PRINT D$;"CLOSE COUPON.FILE"
  478. 4790  IF J <99  THEN  GOSUB 3600
  479. 4800  RETURN 
  480. 4810  REM  -- ASK FOR DATE --
  481. 4820 M = 8: GOSUB 1930:ED$ = I$
  482. 4830 TE$ = ED$: IF TE$ = ""  THEN  RETURN 
  483. 4840  GOSUB 1090
  484. 4850  IF ER  THEN  VTAB 5: HTAB 18: CALL  -868: GOTO 4820
  485. 4860 TD$ = ED$: RETURN