home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / HOME / PMDBASE.ZIP / PC-PM.BAS next >
Encoding:
BASIC Source File  |  1986-11-27  |  19.3 KB  |  455 lines
  1. 10 '**************** INVENTORY FOR PRECIOUS MOMENTS*************************
  2. 20 '                    WRITTEN IN BASICA  09/85
  3. 30 '           FOR CAROLE SKIBBY------------BY ED KRUSE
  4. 40 '************************************************************************
  5. 50 GOSUB 16000
  6. 60 ON ERROR GOTO 14000
  7. 70 DIM PM$(12),MP$(12),SPARE$(2),DESC$(12),SR(2001),SO(2001)
  8. 80 RESTORE
  9. 90 FOR I=1 TO 12:READ DESC$(I):NEXT I
  10. 100 DATA Item Number,Common Name,Title,Retired (Y/N),Signed (Y/N),Members Only Yr.,Marked Symbol,Type Code,Current Value,Initial Cost,Date of Purchase mm/yy,For Personal or Trade
  11. 110 GOSUB 7400:CLOSE
  12. 120 F1$="$$###.##"
  13. 130 F2$="$$#,###.##"
  14. 140 F3$="#######.##"
  15. 500 '********************* MAIN PROGRAM ************************************
  16. 510 CLS
  17. 520 LOCATE 6,27:PRINT "(1) = ADD NEW PIECE":PRINT
  18. 530 PRINT TAB(27);"(2) = SEARCH AND HARDCOPYS":PRINT
  19. 540 PRINT TAB(27);"(3) = INSURANCE REPORT":PRINT
  20. 550 PRINT TAB(27);"(4) = CHANGE EXISTING FILE":PRINT
  21. 560 PRINT TAB(27);"(5) = REVIEW ALL FILES":PRINT
  22. 570 PRINT TAB(27);"(S) = SORT MAIN FILES":PRINT
  23. 580 PRINT TAB(27);"(Q) = END PROGRAM"
  24. 590 LOCATE 4,10:PRINT STRING$(60,176)
  25. 600 FOR I=5 TO 19:LOCATE I,10:PRINT CHR$(176);CHR$(176):NEXT I
  26. 610 LOCATE 20,10:PRINT STRING$(60,176)
  27. 620 FOR I=19 TO 5 STEP-1:LOCATE I,68:PRINT CHR$(176);CHR$(176):NEXT I
  28. 630 LOCATE 2,6:PRINT STRING$(68,178)
  29. 640 FOR I=3 TO 21:LOCATE I,6:PRINT CHR$(178);CHR$(178):NEXT I
  30. 650 LOCATE 22,6:PRINT STRING$(68,178)
  31. 660 FOR I=21 TO 3 STEP-1:LOCATE I,72:PRINT CHR$(178);CHR$(178):NEXT I
  32. 670 LOCATE 4,22:PRINT " Enesco PRECIOUS MOMENTS Collection "
  33. 680 LOCATE 24,60:PRINT "YOUR CHOICE:";:W$=INPUT$(1)
  34. 690 IF W$="S"  OR W$="s" THEN GOSUB 12000:GOTO 740
  35. 700 IF W$="Q"  OR W$="q" THEN 9000
  36. 710 W=VAL(W$):IF W <1 OR W >5 THEN 680
  37. 720 CLS
  38. 730 ON W GOSUB 1000,2000,3000,4000,5000
  39. 740 CLOSE:GOTO 500
  40. 1000 '************************ ADD NEW PEICE *******************************
  41. 1010 GOSUB 6000
  42. 1020 LOCATE 23,25:PRINT "ENTER (Q) AT ANY LINE TO QUIT:"
  43. 1030 RC%=LFN%+1:LOCATE 3,65:PRINT RC%
  44. 1040 L=7:C=35:FL=6:GOSUB 8000:IF IN$="Q" THEN RETURN
  45. 1050 MP$(1)=IN$:IF RT=1 THEN RETURN
  46. 1060 L=8:C=30:FL=35:GOSUB 8000:IF IN$="Q" THEN RETURN
  47. 1070 MP$(2)=IN$:IF RT=1 THEN RETURN
  48. 1080 L=9:C=28:FL=40:GOSUB 8000:IF IN$="Q" THEN RETURN
  49. 1090 MP$(3)=IN$:IF RT=1 THEN RETURN
  50. 1100 L=10:C=35:FL=1:GOSUB 8000:IF IN$="Q" THEN RETURN
  51. 1110 MP$(4)=IN$:IF RT=1 THEN RETURN
  52. 1120 L=11:C=35:FL=1:GOSUB 8000:IF IN$="Q" THEN RETURN
  53. 1130 MP$(5)=IN$:IF RT=1 THEN RETURN
  54. 1140 L=12:C=35:FL=4:GOSUB 8000:IF IN$="Q" THEN RETURN
  55. 1150 MP$(6)=IN$:IF RT=1 THEN RETURN
  56. 1160 L=13:C=35:FL=10:GOSUB 8000:IF IN$="Q" THEN RETURN
  57. 1170 MP$(7)=IN$:IF RT=1 THEN RETURN
  58. 1180 L=14:C=35:FL=2:GOSUB 8000:IF IN$="Q" THEN RETURN
  59. 1190 MP$(8)=IN$:IF RT=1 THEN RETURN
  60. 1200 L=15:C=35:FL=7:GOSUB 8000:IF IN$="Q" THEN RETURN
  61. 1210 MP$(9)=IN$:IF RT=1 THEN RETURN
  62. 1220 L=16:C=35:FL=6:GOSUB 8000:IF IN$="Q" THEN RETURN
  63. 1230 MP$(10)=IN$:IF RT=1 THEN RETURN
  64. 1240 L=17:C=50:FL=5:GOSUB 8000:IF IN$="Q" THEN RETURN
  65. 1250 MP$(11)=IN$:IF RT=1 THEN RETURN
  66. 1260 L=18:C=50:FL=1:GOSUB 8000:IF IN$="Q" THEN RETURN
  67. 1270 MP$(12)=IN$:IF RT=1 THEN RETURN
  68. 1280 LOCATE 23,1:PRINT STRING$(79,32)
  69. 1290 LOCATE 23,30:PRINT "IS THIS CORRECT? ; (Y/N):";:W$=INPUT$(1)
  70. 1300 IF W$="Q" THEN RETURN
  71. 1310 IF W$="N" THEN GOSUB 10000:GOTO 1280
  72. 1320 IF W$ <>"Y" THEN 1280
  73. 1330 CLS:LOCATE 12,25:PRINT "WRITING FILE TO DISK"
  74. 1340 GOSUB 7400:REC%=LFN%+1:GOSUB 7000:GOSUB 7800:CLOSE
  75. 1350 CLS:LOCATE 12,25:PRINT "WRITE ANOTHER FILE?  (Y/N):";:W$=INPUT$(1)
  76. 1360 IF W$="Y" THEN CLS:GOTO 1000
  77. 1370 CLS:GOSUB 12000
  78. 1380 RETURN
  79. 2000 '******************** SEARCH FOR CATAGORY *****************************
  80. 2010 CLS:CNTR=0:AA=0:TCO=0:TVL=0:TAV=0:HC=0:CO=0:VA=0:CTR=0:TL=0:LCTR=0:PGC=1
  81. 2020 CLOSE:SCH$="":SC$="":PB=0:BP=0:PQ=0
  82. 2030 LOCATE 2,34:PRINT "SEARCH MENU:"
  83. 2040 LOCATE 5,25:PRINT "(1) = FOR ITEM NUMBER:":PRINT
  84. 2050 PRINT TAB(25);"(2) = FOR MEMBER YEAR:":PRINT
  85. 2060 PRINT TAB(25);"(3) = FOR SYMBOL:":PRINT
  86. 2070 PRINT TAB(25);"(4) = FOR RETIRED ONLY:":PRINT
  87. 2080 PRINT TAB(25);"(5) = FOR SIGNED ONLY:":PRINT
  88. 2090 PRINT TAB(25);"(6) = FOR TYPE ONLY:":PRINT
  89. 2100 PRINT TAB(25);"(7) = FOR YEAR PERCHASED:":PRINT
  90. 2110 PRINT TAB(25);"(8) = PRINT ALL FILES:":PRINT
  91. 2120 PRINT TAB(25);"(Q) = RETURN TO MAIN MENU:";:PRINT
  92. 2130 LOCATE 3,20:PRINT STRING$(40,176)
  93. 2140 FOR I=3 TO 21:LOCATE I,20:PRINT CHR$(176);CHR$(176):NEXT I
  94. 2150 LOCATE 22,20:PRINT STRING$(40,176)
  95. 2160 FOR I=21 TO 3 STEP-1:LOCATE I,58:PRINT CHR$(176);CHR$(176):NEXT I
  96. 2170 LOCATE 23,34:PRINT "ENTER CHOICE:";:C$=INPUT$(1)
  97. 2180 IF C$="Q" OR C$="q" THEN RETURN
  98. 2190 CH=VAL(C$):PB=0
  99. 2200 IF CH <1 OR CH >8 THEN 2170
  100. 2210 ON CH GOTO 2220,2250,2280,2310,2330,2350,2380,2400
  101. 2220 CLS:LOCATE 12,30:PRINT "ENTER ITEM NUMBER: ";:LINE INPUT SC$
  102. 2230 SCH$=LEFT$(SC$+"     ",6):N=1:TITLE$="ITEM NUMBER":BP=0:PQ=1:CLS:GOTO 2420
  103. 2240 '
  104. 2250 CLS:LOCATE 12,30:PRINT "ENTER MEMBER YEAR; yyyy :";:LINE INPUT SC$
  105. 2260 SCH$=LEFT$(SC$+"  ",4):N=6:TITLE$="MEMBER YEAR":BP=0:CLS:GOTO 2420
  106. 2270 '
  107. 2280 CLS:LOCATE 12,30:PRINT "ENTER SYMBOL: ";:LINE INPUT SC$
  108. 2290 SCH$=LEFT$(SC$+"         ",10):TITLE$="SYMBOL":N=7:BP=0:CLS:GOTO 2420
  109. 2300 '
  110. 2310 CLS:SCH$="Y":N=4:TITLE$="RETIRED":BP=0:GOTO 2420
  111. 2320 '
  112. 2330 CLS:SCH$="Y":N=5:TITLE$="SIGNED":BP=0:GOTO 2420
  113. 2340 '
  114. 2350 CLS:LOCATE 12,30:PRINT "ENTER TYPE: ";:LINE INPUT SC$
  115. 2360 SCH$=LEFT$(SC$+"  ",2):TITLE$="TYPE:":N=8:BP=0:CLS:GOTO 2420
  116. 2370 '
  117. 2380 CLS:LOCATE 12,30:PRINT "ENTER YEAR:  TWO DIGETS:";:LINE INPUT SC$
  118. 2390 SCH$=LEFT$(SC$+"  ",2):TITLE$="YEARS PURCHASES:":BP=1:PB=1:CLS:GOTO 2420
  119. 2400 CLS:BP=1:PB=0:TITLE$="ALL FILES:":GOTO 2420
  120. 2410 '
  121. 2420 CLS:LOCATE 12,25:PRINT "DO YOU WANT A HARDCOPY? (Y/N) ";:HC$=INPUT$(1)
  122. 2430 IF HC$ <CHR$(65) THEN 2420
  123. 2440 IF HC$="Y" OR HC$="y" THEN HC=1 ELSE HC=0
  124. 2450 LOCATE 14,20:PRINT "DO YOU WANT PERSONAL, TRADE OR ALL FILES?:"
  125. 2460 PRINT :PRINT TAB(25);"TYPE OF FILE = ";:LINE INPUT FF$:FF$=LEFT$(FF$,1)
  126. 2470 IF FF$ <"A" THEN FF$="A"
  127. 2480 CLS:IF HC=0 THEN 2550
  128. 2520 LPRINT "PAGE: ";PGC;TAB(30);TITLE$;" ";SC$;TAB(55);"Report Date: ";DATE$
  129. 2530 LPRINT STRING$(78,61)
  130. 2540 IF LCTR=55 THEN RETURN
  131. 2550 GOSUB 7400:GOSUB 7610:RC%=1
  132. 2560 PRINT "Report Date: ";DATE$;TAB(35);TITLE$;"   ";SC$
  133. 2570 AAA$=""
  134. 2580 GET #3,RC%:REC%=VAL(RS$)
  135. 2590 IF OS$="ZZZZZZZ" THEN 2770
  136. 2600    GET #1,REC%
  137. 2610    IF FF$="A" THEN 2630
  138. 2620    IF FF$ <> PM$(12) THEN 2750
  139. 2630    IF BP=1 THEN 2670
  140. 2640    IF PQ=0 THEN 2660
  141. 2650    IF VAL(SCH$)=VAL(PM$(N)) THEN 2670
  142. 2660    IF SCH$ <>PM$(N) THEN 2750
  143. 2670    IF PB=0 THEN 2690
  144. 2680    IF SCH$ <> RIGHT$(PM$(11),2) THEN 2750
  145. 2690    GOSUB 13000
  146. 2700    CNTR=CNTR+1
  147. 2710    IF HC=0 THEN 2740
  148. 2720    LCTR=LCTR+5:IF LCTR <>55 THEN 2740
  149. 2730    PGC=PGC+1:LPRINT CHR$(12):GOSUB 2520:LCTR=0
  150. 2740 PRINT "Searching For: ";TITLE$;" ";SC$;STRING$(8,45);"Press Any Key To Pause-Or-`Q' = Quit"
  151. 2750 AAA$=INKEY$:IF AAA$ >"" THEN 2930
  152. 2760 RC%=RC%+1:GOTO 2580
  153. 2770 PRINT :PRINT TAB(50);"TOTAL COST:  ";:PRINT USING F2$;TCO
  154. 2780 PRINT TAB(50);"TOTAL VALUE: ";:PRINT USING F2$;TVL
  155. 2790 IF HC=0 THEN 2830
  156. 2800 LPRINT STRING$(78,61)
  157. 2810 LPRINT TAB(50);"TOTAL COST:   ";:LPRINT USING F2$;TCO
  158. 2820 LPRINT TAB(50);"TOTAL VALUE:  ";:LPRINT USING F2$;TVL
  159. 2830 IF TCO=0 THEN TAV=TVL:AA=0:GOTO 2845
  160. 2840 TAV=TVL-TCO:AA=(TAV/TCO)*100:GOTO 2850
  161. 2845 IF TVL >0 THEN AA=100
  162. 2850 IF HC=0 THEN 2890
  163. 2860 LPRINT TAB(43);"APPRECIATION VALUE:  ";:LPRINT USING F2$;TAV
  164. 2870 LPRINT TAB(5);"TOTAL # PCS. = ";CNTR;TAB(42);"APPRECIATION PERCENT:";:LPRINT USING F3$;AA;:LPRINT "%"
  165. 2880 LPRINT CHR$(12)
  166. 2890 PRINT TAB(43);"APPRECIATION VALUE: ";:PRINT USING F2$;TAV
  167. 2900 PRINT TAB(5);" TOTAL # PCS. = ";CNTR;TAB(42);"APPRECIATION PERCENT:";:PRINT USING F3$;AA;:PRINT "%"
  168. 2910 PRINT TAB(30);"PRESS RETURN:";:W$=INPUT$(1)
  169. 2920 GOTO 2000
  170. 2930 W$=INPUT$(1):IF W$="Q" THEN 2000 ELSE AAA$="":GOTO 2760
  171. 3000 '********************* INSURANCE REPORT *******************************
  172. 3010 CLS:TP=0:CTR=0:TL=0:LCTR=1:PGC=1
  173. 3020 LOCATE 12,20:PRINT "DO YOU WANT PERSONAL, TRADE OR ALL FILES?"
  174. 3030 PRINT :PRINT TAB(25);"TYPE OF FILE = ";:LINE INPUT FF$:FF$=LEFT$(FF$,1)
  175. 3040 IF FF$ < "A" THEN FF$="A"
  176. 3050 IF FF$="A" THEN FA$="ALL FILES:"
  177. 3060 IF FF$="P" THEN FA$="PERSONAL FILES:"
  178. 3070 IF FF$="T" THEN FA$="TRADE FILES:"
  179. 3080 CLS:PRINT TAB(25);"INSURANCE REPORT:  ";DATE$;SPC(10);FA$
  180. 3090 PRINT STRING$(79,61)
  181. 3100 LPRINT TAB(56);"Name:"
  182. 3110 LPRINT TAB(56);"Street:"
  183. 3120 LPRINT TAB(56);"City,St. & Zip:":LPRINT
  184. 3130 LPRINT "PAGE: ";PGC;TAB(25);"INSURANCE REPORT:  ";DATE$;SPC(10);FA$:LPRINT
  185. 3140 LPRINT STRING$(78,61)
  186. 3150 PRINT "ITEM#";SPC(12);"COMMON NAME";SPC(25);"MARK";SPC(8);"VALUE"
  187. 3160 LPRINT "FILE#   ITEM#";SPC(11);"COMMON NAME";SPC(20);"MARK";SPC(14);"VALUE"
  188. 3170 LPRINT STRING$(78,61):PRINT STRING$(80,61)
  189. 3180 IF LCTR=50 THEN RETURN
  190. 3190 GOSUB 7400:GOSUB 7610:RC%=1
  191. 3200 GET #3,RC%:REC%=VAL(RS$)
  192. 3210 IF OS$="ZZZZZZZ" THEN 3340
  193. 3220    GET #1,REC%
  194. 3230    IF FF$="A" THEN 3250
  195. 3240    IF FF$ <>PM$(12) THEN 3330
  196. 3250    CTR=VAL(PM$(9))
  197. 3260    PRINT PM$(1);SPC(6);PM$(2);SPC(6);PM$(7);
  198. 3270    PRINT USING F1$;CTR
  199. 3275    TP=TP+1
  200. 3280    TL=TL+CTR
  201. 3290    LPRINT REC%;TAB(9);PM$(1);SPC(3);PM$(2);SPC(3);PM$(7);SPC(6);
  202. 3300    LPRINT USING F1$;CTR
  203. 3310    LCTR=LCTR+1:IF LCTR <>50 THEN 3330
  204. 3320    PGC=PGC+1:LPRINT CHR$(12):GOSUB 3130:LCTR=1
  205. 3330 RC%=RC%+1:GOTO 3200
  206. 3340 PRINT STRING$(80,61)
  207. 3350 PRINT TAB(50);"TOTAL VALUE: ";:PRINT USING F2$;TL
  208. 3360 LPRINT STRING$(78,61):LPRINT
  209. 3370 LPRINT " TOTAL # PCS.= ";TP;TAB(50);"TOTAL VALUE:  ";:LPRINT USING F2$;TL
  210. 3380 PRINT:PRINT TAB(50);"PRESS RETURN:";:W$=INPUT$(1)
  211. 3390 RETURN
  212. 4000 '***************** CHANGE EXISTING FILE *******************************
  213. 4010 CLS:LOCATE 8,25:PRINT "FILES START AT #1 AND END AT #";LFN%
  214. 4020 LOCATE 10,30:PRINT "ENTER (Q) TO QUIT:"
  215. 4030 LOCATE 12,30:PRINT "FILE # TO EDIT = ";:LINE INPUT RC$
  216. 4040 IF RC$="Q" OR RC$="q" THEN RETURN
  217. 4050 CLS:REC%=VAL(RC$):IF REC% >LFN% OR REC%=0 THEN 4000
  218. 4060 GOSUB 6000:GOSUB 7400:GET #1,REC%:GOSUB 7200
  219. 4070 LOCATE 3,65:PRINT REC%:GOSUB 11000:GOSUB 10000
  220. 4080 RT=0
  221. 4090 LOCATE 23,1:PRINT STRING$(79,32)
  222. 4100 LOCATE 23,24:PRINT "IS THIS CORRECT:  (Y/N): (Q) TO QUIT: ";:W$=INPUT$(1)
  223. 4110 IF W$="Q" THEN RETURN
  224. 4120 IF W$="N" THEN GOSUB 10000:GOTO 4090
  225. 4130 IF W$ <>"Y" THEN 4090
  226. 4140 CLS:LOCATE 12,25:PRINT "WRITING CORRECTED FILE TO DISK"
  227. 4150 GOSUB 7000:GOSUB 7800:CLOSE
  228. 4160 CLS:LOCATE 12,25:PRINT "EDIT ANOTHER FILE:  (Y/N): ";:W$=INPUT$(1)
  229. 4170 IF W$="Y" OR W$="y" THEN 4000 ELSE RETURN
  230. 4180 RETURN
  231. 5000 '***************** REVIEW ALL FILES ***********************************
  232. 5010 CLS:A$=""
  233. 5020 LOCATE 12,20:PRINT "DO YOU WANT PERSONAL, TRADE OR ALL FILES?"
  234. 5030 PRINT :PRINT TAB(25);"TYPE OF FILES = ";:LINE INPUT FF$:FF$=LEFT$(FF$,1)
  235. 5040 IF FF$ <"A" THEN FF$="A"
  236. 5050 IF FF$="A" THEN FA$="ALL FILES"
  237. 5060 IF FF$="P" THEN FA$="PERSONAL FILES"
  238. 5070 IF FF$="T" THEN FA$="TRADE FILES"
  239. 5080 CLS:GOSUB 6000
  240. 5090 LOCATE 5,27:PRINT " REVIEWING ";FA$;" "
  241. 5100 LOCATE 20,29:PRINT "PRESS ANY KEY TO PAUSE:"
  242. 5110 GOSUB 7400
  243. 5120 FOR REC%=1 TO LFN%
  244. 5130    GET #1,REC%
  245. 5140    IF FF$="A" THEN 5160
  246. 5150    IF FF$ <> PM$(12) THEN 5230
  247. 5160    LOCATE 3,65:PRINT REC%
  248. 5170    GOSUB 7200:GOSUB 11000
  249. 5180    FOR I=1 TO 1200:NEXT I
  250. 5190    A$=INKEY$:IF A$="" THEN 5230
  251. 5200 LOCATE 22,40:PRINT "RETURN TO CONTINUE--(Q) TO QUIT:";:A$=INPUT$(1)
  252. 5210 IF A$="Q" OR A$="q" THEN RETURN
  253. 5220 LOCATE 22,1:PRINT STRING$(80,32):A$=""
  254. 5230 NEXT REC%
  255. 5240 CLOSE
  256. 5250 LOCATE 22,50:PRINT "END OF FILES: PRESS RETURN:";:W$=INPUT$(1)
  257. 5260 RETURN
  258. 6000 '******************* SCREEN ROUTINE *********************************
  259. 6010 LOCATE 1,22:PRINT "TOTAL NUMBER OF FILES ALLOWED IS 2000"
  260. 6020 LOCATE 5,9:PRINT STRING$(62,176)
  261. 6030 FOR I=6 TO 18:LOCATE I,9:PRINT CHR$(176);CHR$(176):NEXT I
  262. 6040 LOCATE 19,9:PRINT STRING$(62,176)
  263. 6050 FOR I=18 TO 6 STEP-1:LOCATE I,69:PRINT CHR$(176);CHR$(176):NEXT I
  264. 6060 L=7:C=12
  265. 6070 FOR J=1 TO 12
  266. 6080    LOCATE L,C:PRINT "(";J;")=";DESC$(J)
  267. 6090    L=L+1
  268. 6100 NEXT J
  269. 6110 LOCATE 3,10:PRINT "Todays Date:";DATE$;SPC(23);"File# - "
  270. 6120 LOCATE 19,31:PRINT " PRECIOUS MOMENTS "
  271. 6130 RETURN
  272. 7000 '********************** SET ARRAY DATA TO BUFFER **********************
  273. 7010 FOR I=1 TO 12
  274. 7020    LSET PM$(I)=MP$(I)
  275. 7030 NEXT I
  276. 7040 RETURN
  277. 7200 '******************* WRITE BUFFER TO ARRAY ***************************
  278. 7210 FOR I=1 TO 12
  279. 7220    MP$(I)=PM$(I)
  280. 7230 NEXT I
  281. 7240 RETURN
  282. 7400 '****************** OPEN MAIN FILES **********************************
  283. 7410 RT=0
  284. 7420 OPEN "R",1,DD$+"PRECIOUS.DAT"
  285. 7430 FIELD #1,6 AS PM$(1),35 AS PM$(2),40 AS PM$(3),1 AS PM$(4),1 AS PM$(5),4 AS PM$(6),10 AS PM$(7),2 AS PM$(8),7 AS PM$(9),6 AS PM$(10),5 AS PM$(11),1 AS PM$(12),5 AS SPARE$,5 AS FIL$
  286. 7440 IF LOF(1)=0 THEN LSET FIL$=STR$(0):PUT 1,1
  287. 7450 GET #1,1:LFN%=VAL(FIL$)
  288. 7460 IF LFN% >2000 THEN CLOSE:GOTO 15000
  289. 7470 RETURN
  290. 7600 '********************** OPEN SORTED KEY FILE *************************
  291. 7610 OPEN "R",3,DD$+"PRECIOUS.KEY",12
  292. 7620 FIELD #3,7 AS OS$,5 AS RS$
  293. 7630 IF LOF(3)=0 THEN PUT#3,1
  294. 7640 RETURN
  295. 7800 '********************** WRITE BUFFER TO DISK ****************************
  296. 7810 PUT#1,REC%
  297. 7820 IF REC% <= LFN% THEN RETURN
  298. 7830 GET 1,1:LSET FIL$=STR$(REC%):PUT 1,1
  299. 7840 LFN%=REC%:RETURN
  300. 8000 '*********************************************************************
  301. 8010 '                   PRINT FIELD NEXT TO DATA PROMPT
  302. 8020 '************************************************************************
  303. 8030 IN$="":W$="":WD=0:WS=WD:WL%=WD:WX%=C
  304. 8040 IF FL=0 THEN FL=1
  305. 8050 LOCATE L,WX%
  306. 8060 PRINT STRING$(ABS(FL),43);
  307. 8070 LOCATE L,WX%
  308. 8080 '++++++++++++++++++++++WAITING FOR DATA INPUT++++++++++++++++++++++++++++
  309. 8090 W$=INPUT$(1)
  310. 8100 IF W$=CHR$(127) THEN 8030
  311. 8110 IF W$=CHR$(8) AND WL%=0 THEN 8070
  312. 8120 IF W$=CHR$(8) AND WL% >0 THEN WX%=((C+WL%)-1):WL%=(WL%-1):IN$=LEFT$(IN$,WL%):LOCATE L,WX%:PRINT CHR$(43):GOTO 8070
  313. 8130 IF W$=CHR$(13) THEN RETURN
  314. 8140 WV=ASC(W$)
  315. 8150 IF WV > 96 AND WV <> 127 THEN WV=WV-32:W$=CHR$(WV)
  316. 8160 IF ABS(FL)=WL% THEN  8210
  317. 8170 IF FL >0 AND W$ >=" " AND W$ <="z" THEN 8220
  318. 8180 IF FL <0 AND W$>"/" AND W$<":" THEN 8220
  319. 8190 IF (W$="." OR W$=",") AND WD=0 THEN WD=1:GOTO 8220
  320. 8200 IF (W$="-" OR W$="+") AND WS=0 AND WL%=0 THEN WS=1:GOTO 8220
  321. 8210 GOTO 8090
  322. 8220 '
  323. 8230 PRINT W$;:IN$=IN$+W$:WL%=WL%+1
  324. 8240 GOTO 8090
  325. 9000 '*********************** END PROGRAM *******************************
  326. 9010 CLS:CLOSE
  327. 9020 FOR I=1 TO 24:PRINT STRING$(79,4):NEXT I
  328. 9030 LOCATE 10,20:PRINT STRING$(40,219)
  329. 9040 FOR I=11 TO 15:LOCATE I,20:PRINT CHR$(219);SPC(38);CHR$(219):NEXT I
  330. 9050 LOCATE 16,20:PRINT  STRING$(40,219)
  331. 9060 LOCATE 12,32:PRINT "HAVE A NICE DAY"
  332. 9070 LOCATE 14,26:PRINT "MAY YOU FIND THAT RARE PIECE"
  333. 9080 FOR T=1 TO 4000:NEXT T
  334. 9090 CLS:END
  335. 10000 '********************* EDIT SUBROUTINE ********************************
  336. 10010 IF FF$="T" THEN FA$="TRADE FILES:"
  337. 10020 RT=1
  338. 10030 LOCATE 23,1:PRINT STRING$(79,32)
  339. 10040 LOCATE 23,15:PRINT "ENTER LINE NUMBER TO CHANGE - OR (Q) TO QUIT: ";:LINE INPUT W$
  340. 10050 IF W$="Q" THEN RT=1:RETURN
  341. 10060 W=VAL(W$):IF W <1 OR W >12 THEN 10000
  342. 10070 ON W GOSUB 1040,1060,1080,1100,1120,1140,1160,1180,1200,1220,1240,1260
  343. 10080 GOTO 10000
  344. 11000 '**************** WRITE ARRAY TO SCREEN DISPLAY ***********************
  345. 11010 LOCATE 7,35:PRINT MP$(1)
  346. 11020 LOCATE 8,30:PRINT MP$(2)
  347. 11030 LOCATE 9,28:PRINT MP$(3)
  348. 11040 LOCATE 10,35:PRINT MP$(4)
  349. 11050 LOCATE 11,35:PRINT MP$(5)
  350. 11060 LOCATE 12,35:PRINT MP$(6)
  351. 11070 LOCATE 13,35:PRINT MP$(7)
  352. 11080 LOCATE 14,35:PRINT MP$(8)
  353. 11090 LOCATE 15,35:PRINT MP$(9)
  354. 11100 LOCATE 16,35:PRINT MP$(10)
  355. 11110 LOCATE 17,50:PRINT MP$(11)
  356. 11120 LOCATE 18,50:PRINT PM$(12)
  357. 11130 RETURN
  358. 12000 '********************** SORT ROUTINE **********************************
  359. 12010 CLS
  360. 12020 LOCATE 4,25:PRINT "SORT FOR PRECIOUS MOMENTS PROGRAM:"
  361. 12030 PRINT:PRINT TAB(25);"  PLEASE WAIT WHILE I SORT DATA:"
  362. 12040 GOSUB 7400
  363. 12050 LOCATE 8,34:PRINT "LOADING ARRAY:"
  364. 12060 DR=0
  365. 12070 FOR REC%=1 TO LFN%
  366. 12080     GET 1,REC%
  367. 12090     SS=VAL(PM$(1))
  368. 12100     IF REC%=1 AND PM$(1) <CHR$(32) THEN 12150
  369. 12110     DR=DR+1
  370. 12120     SO(DR)=SS:SR(DR)=REC%
  371. 12130 NEXT REC%
  372. 12140 GOTO 12190
  373. 12150 LOCATE 12,24:PRINT "CAN NOT FIND ANY DATA IN THIS FILE:"
  374. 12160 PRINT:PRINT TAB(25)"PLEASE CHECK FOR PROPER DATA DISK:"
  375. 12170 LOCATE 20,40:PRINT "PRESS RETURN:";:W$=INPUT$(1)
  376. 12180 RETURN
  377. 12190 LOCATE 12,30:PRINT "SORTING DATA IN ARRAY:"
  378. 12200 N=DR+1
  379. 12210 P=N
  380. 12220 P=INT(P/2)
  381. 12230 IF P=0 THEN 12360
  382. 12240 K=N-P:J=1
  383. 12250 I=J
  384. 12260 L=I+P
  385. 12270 IF SO(I) < SO(L) THEN 12330
  386. 12280 TS=SO(I):TR=SR(I)
  387. 12290 SO(I)=SO(L):SR(I)=SR(L)
  388. 12300 SO(L)=TS:SR(L)=TR
  389. 12310 I=I-P
  390. 12320 IF I >=1 THEN 12260
  391. 12330 J=J+1
  392. 12340 IF J <=K THEN 12250
  393. 12350 GOTO 12220
  394. 12360 '
  395. 12370 LOCATE 16,35:PRINT "END OF SORT:"
  396. 12380 LOCATE 20,30:PRINT "WRITITNG DATA TO DISK:"
  397. 12390 GOSUB 7610:RD=1
  398. 12400 FOR I=1 TO DR+1
  399. 12410 SS$=STR$(SR(I)):IF VAL(SS$) <=0 THEN 12460
  400. 12420 LSET RS$=STR$(SR(I)):LSET OS$=STR$(SO(I))
  401. 12430 'PRINT RD,RS$,OS$,SO(I)
  402. 12440 PUT #3,RD
  403. 12450 RD=RD+1
  404. 12460 NEXT I
  405. 12470 LSET OS$="ZZZZZZZ":LSET RS$="*****":PUT #3,RD
  406. 12480 'PRINT RD,RS$,OS$,SO(I)
  407. 12490 CLOSE:'PRINT "PRESS RETURN:";:W$=INPUT$(1)
  408. 12500 RETURN
  409. 13000 '********************* HARDCOPY SUBROUTINE ****************************
  410. 13010 IF FF$="T" THEN FA$="TRADE FILES:"
  411. 13020 IF FF$="A" THEN FA$="ALL FILES:"
  412. 13030 IF FF$="P" THEN FA$="PERSONAL FILES:"
  413. 13040 PRINT STRING$(79,61)
  414. 13050 PRINT TAB(35);"File# ";REC%" ----- ";FA$;" -----"
  415. 13060 PRINT PM$(1);SPC(2);PM$(2);SPC(2);PM$(7);SPC(2);PM$(11);SPC(2);PM$(10);SPC(2);PM$(9)
  416. 13070 PRINT SPC(8);PM$(3);SPC(1);PM$(8);SPC(4);PM$(4);SPC(4);PM$(5);SPC(4);PM$(6);SPC(4);PM$(12)
  417. 13080 PRINT STRING$(79,61)
  418. 13090 CO=VAL(PM$(10)):VL=VAL(PM$(9))
  419. 13100 TVL=TVL+VL:TCO=TCO+CO
  420. 13110 IF HC=0 THEN RETURN
  421. 13120 LPRINT TAB(35);"File# ";REC%;SPC(20);FA$
  422. 13130 LPRINT PM$(1);SPC(3);PM$(2);SPC(4);"Symbol:";PM$(7);SPC(5);"Type: ";PM$(8)
  423. 13140 LPRINT TAB(10);PM$(3);SPC(1);"Retired: ";PM$(4);SPC(8);"Signed: ";PM$(5)
  424. 13150 LPRINT TAB(4);PM$(12);TAB(10);"Member Yr: ";PM$(6);SPC(2);"Purchased: ";
  425. 13160 LPRINT PM$(11);SPC(2);"Cost: ";:LPRINT USING F1$;CO;
  426. 13170 LPRINT SPC(2);"Value: ";:LPRINT USING F2$;VL
  427. 13180 LPRINT STRING$(78,45)
  428. 13190 RETURN
  429. 14000 '*********************** ERROR ROUTINE *******************************
  430. 14010 CLS:CLOSE
  431. 14020 LOCATE 6,20:PRINT "A ERROR HAS OCCOURED IN RUNNING THE PROGRAM":PRINT
  432. 14030 PRINT TAB(20);"PLEASE CHECK TO SEE IF YOU HAVE THE RIGHT DISK"
  433. 14040 PRINT:PRINT TAB(20);"IN DRIVE `";DD$;"' AND THAT THE FILES HAVE BEEN SORTED"
  434. 14050 LOCATE 14,20:PRINT "WHEN YOU HAVE CHECKED AND ARE READY TO CONTINUE"
  435. 14060 PRINT:PRINT TAB(35);"PRESS RETURN:";:W$=INPUT$(1)
  436. 14070 GOTO 500
  437. 15000 '************************ FILES FULL ROUTINE *******************
  438. 15010 CLS
  439. 15020 LOCATE 12,24:PRINT "THE FILES ARE FULL--2000 RECORDS"
  440. 15030 LOCATE 14,23:PRINT "YOU SHOULD START ANOTHER DATA DISK"
  441. 15040 LOCATE 24,60:PRINT "PRESS RETURN:";:W$=INPUT$(1)
  442. 15050 GOTO 500
  443. 16000 '******************** ASSIGN DATA DRIVE ROUTINE ********************
  444. 16010 CLS
  445. 16020 LOCATE 6,17:PRINT "BE SURE YOU DEPRESS THE CAPS LOCK KEY:"
  446. 16030 LOCATE 10,15:PRINT "ENTER DRIVE WHERE DATA DISK IS AT:  A THRU D"
  447. 16040 LOCATE 12,25:PRINT "DATA DRIVE IS - ";:DA$=INPUT$(1)
  448. 16050 IF DA$ > CHR$(68) THEN CLS:FOR I=1 TO 50:NEXT I:GOTO 16000
  449. 16060 IF DA$ <"A" THEN DD$="A:":GOTO 16080
  450. 16070 DD$=DA$+":"
  451. 16080 PRINT DD$:FOR I=1 TO 100:NEXT I:RETURN
  452. EXT I:GOTO 16000
  453. 16060 IF DA$ <"A" THEN DD$="A:":GOTO 16080
  454. 16070 DD$=DA$+":"
  455. 16080 PRINT DD$:FOR I=1 TO 100:NEXT I:R