home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib26a.dsk / DECEMBER.1985 / INVEST.ADVISER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  28KB  |  567 lines
  1. 1  REM  *******2.18.86********
  2. 2  REM  *   INVEST.ADVISER   *
  3. 3  REM  * BY ROBERT DOELLING *
  4. 4  REM  * COPYRIGHT (C) 1985 *
  5. 5  REM  * BY MICROSPARC, INC *
  6. 6  REM  * CONCORD, MA  01742 *
  7. 7  REM  **********************
  8. 10  GOTO 5270
  9. 20  REM  * SUBROUTINES *
  10. 30 CV =  PEEK(37)
  11. 40  VTAB CV +1: PRINT : CALL  -958: HTAB 10: INPUT "ENTRY OK? (Y/N)";Q$
  12. 50  IF Q$ = "Y"  OR Q$ = "N"  THEN  RETURN 
  13. 60  PRINT B$: GOTO 40
  14. 70  VTAB 22: PRINT "PRESS <RETURN> TO CONTINUE ";: GET Q$: RETURN 
  15. 80  VTAB 20: PRINT "PRESS";: HTAB 10: INVERSE : PRINT "RETURN";: NORMAL : PRINT " WHEN ENTRY IS CORRECT"
  16. 90  HTAB 11: INVERSE : PRINT " ESC ";: NORMAL : PRINT " TO RETURN TO MAIN MENU"
  17. 100  HTAB 12: INVERSE : PRINT " <- ";: NORMAL : PRINT " TO RESTART ENTRY": RETURN 
  18. 110  REM  * DATE ENTRY ROUTINE *
  19. 120  VTAB 16: HTAB 30: INVERSE : PRINT "00";: NORMAL : PRINT "/00/00";: CALL  -958
  20. 130  PRINT : PRINT : HTAB 4: INPUT "PLEASE ENTER THE MONTH (1-12) ";Q$
  21. 140 X =  INT( VAL(Q$)): IF X <1  OR X >12  THEN  PRINT B$: GOTO 120
  22. 150  VTAB 16: HTAB 30: PRINT X;"/";: INVERSE : PRINT "00";: NORMAL : PRINT "/00";: CALL  -958
  23. 160  PRINT : PRINT : HTAB 4: INPUT "PLEASE ENTER THE DATE (1-31) ";Q$
  24. 170 Y =  INT( VAL(Q$)): IF Y <1  OR Y >31  THEN  PRINT B$: GOTO 150
  25. 180  VTAB 16: HTAB 30: PRINT X;"/";Y;"/";: INVERSE : PRINT "00";: NORMAL : CALL  -958
  26. 190  PRINT : PRINT : INPUT "PLEASE ENTER THE LAST TWO DIGITS OF THE YEAR (I.E. 85) ";Q$
  27. 200 Z =  INT( VAL(Q$)): IF Z >99  THEN  PRINT B$: GOTO 180
  28. 210 Z$ = Q$: IF Z <10  THEN Z$ = "0" + RIGHT$(Z$,1)
  29. 220 V$ =  STR$(X) +"/" + STR$(Y) +"/" +Z$
  30. 230  VTAB 16: HTAB 30: PRINT V$
  31. 240  GOSUB 30: IF Q$ = "N"  THEN 120
  32. 250 V =  INT((365 *Z +30.42 *X +Y) +.5)
  33. 260  RETURN 
  34. 270  REM  * $ FORMAT ROUTINE *
  35. 280 X =  INT(100 *(X +.005))
  36. 290  IF X <0  THEN X =  -X:W$ = "($":AF = 1: GOTO 310
  37. 300 W$ = "$"
  38. 310 X$ =  STR$(X)
  39. 320  IF  LEN(X$) = 9  THEN Z$ = W$ + LEFT$(X$,1) +"," + MID$ (X$,2,3) +"," + MID$ (X$,5,3) +"." + RIGHT$(X$,2): GOTO 370
  40. 330  IF  LEN(X$) >5  THEN Z$ = W$ + LEFT$(X$, LEN(X$) -5) +"," + MID$ (X$, LEN(X$) -4,3) +"." + RIGHT$(X$,2): GOTO 370
  41. 340  IF  LEN(X$) >2  THEN Z$ = W$ + LEFT$(X$, LEN(X$) -2) +"." + RIGHT$(X$,2): GOTO 370
  42. 350  IF  LEN(X$) = 2  THEN Z$ = "0." +X$: GOTO 370
  43. 360 Z$ = W$ +"0.0" +X$
  44. 370  IF AF  THEN AF = 0:Z$ = Z$ +")"
  45. 380  RETURN 
  46. 390  REM  * $ ENTRY ROUTINE *
  47. 400  GOSUB 80
  48. 410 Z$ = "        $0.00":L = 9:V$ = "": REM  8 SPACES
  49. 420  NORMAL : VTAB 18: HTAB 1: PRINT "ENTER HERE -> ";: INVERSE : PRINT Z$
  50. 430  VTAB 18: HTAB 15 + LEN(Z$): GET Q$
  51. 440  IF Q$ =  CHR$(8)  THEN 410
  52. 450  IF Q$ =  CHR$(13)  AND  VAL(V$) = O  THEN  PRINT B$: GOTO 410
  53. 460  IF Q$ =  CHR$(13)  THEN X =  VAL(V$)/100: NORMAL : RETURN 
  54. 470  IF Q$ =  CHR$(27)  THEN  NORMAL : GOTO 1120
  55. 480  IF  LEN(V$) = L  THEN 570
  56. 490  IF  ASC(Q$) <48  OR  ASC(Q$) >57  THEN  PRINT B$: GOTO 420
  57. 500  IF  VAL(Q$) = 0  AND  LEN(V$) = 0  THEN  PRINT B$: GOTO 410
  58. 510 V$ = V$ +Q$
  59. 520  IF  LEN(V$) = 9  THEN Z$ = "$" + LEFT$(V$,1) +"," + MID$ (V$,2,3) +"," + MID$ (V$,5,3) +"." + RIGHT$(V$,2): GOTO 420
  60. 530  IF  LEN(V$) >5  THEN X$ = "$" + LEFT$(V$, LEN(V$) -5) +"," + MID$ (V$, LEN(V$) -4,3) +"." + RIGHT$(V$,2): GOTO 560
  61. 540  IF  LEN(V$) >2  THEN X$ = "$" + LEFT$(V$, LEN(V$) -2) +"." + RIGHT$(V$,2): GOTO 560
  62. 550 X$ = V$
  63. 560 Z$ =  LEFT$(Z$,( LEN(Z$) - LEN(X$))) +X$: GOTO 420
  64. 570  VTAB 18: HTAB 1: CALL  -868: PRINT "THIS IS THE MAXIMUM ENTRY LENGTH!": PRINT B$: FOR PS = 1 TO 1000: NEXT 
  65. 580  VTAB 18: HTAB 1: CALL  -868:Q$ = "": GOTO 420
  66. 590  REM  * STOCK NAME ENTRY ROUTINE *
  67. 600  GOSUB 80
  68. 610  VTAB 13: HTAB 1: PRINT "ENTRY LENGTH CANNOT EXCEED 15 CHARACTERS"
  69. 620  PRINT "DO NOT INSERT SPACES IN THE NAME.": PRINT "INSTEAD, USE PERIODS TO SEPARATE WORDS."
  70. 630 Z$ = "               ":L = 15:V$ = "": REM  15 SPACES
  71. 640  NORMAL : VTAB 18: HTAB 4: PRINT "ENTER HERE -> ";: INVERSE : PRINT Z$
  72. 650  VTAB 18: HTAB 33: GET Q$
  73. 660  IF Q$ =  CHR$(8)  THEN 630
  74. 670  IF Q$ =  CHR$(13)  AND V$ = ""  THEN  PRINT B$: GOTO 630
  75. 680  IF Q$ =  CHR$(13)  THEN  NORMAL : GOTO 770
  76. 690  IF Q$ =  CHR$(27)  THEN 1120
  77. 700  IF (Q$ <"0"  AND Q$ < >".")  OR (Q$ >"9"  AND Q$ <"A")  OR Q$ >"Z"  OR (Q$ <"A"  AND V$ = "")  THEN  PRINT B$: GOTO 640
  78. 710  IF  LEN(V$) = L  THEN  NORMAL : GOTO 750
  79. 720 V$ = V$ +Q$
  80. 730  IF  LEN(V$) = L  THEN Z$ = V$: GOTO 640
  81. 740 Z$ =  LEFT$(Z$,( LEN(Z$) - LEN(V$))) +V$: GOTO 640
  82. 750  VTAB 18: HTAB 1: CALL  -868: PRINT "THIS IS THE MAXIMUM ENTRY LENGTH!": PRINT B$;: FOR PS = 1 TO 1000: NEXT 
  83. 760  VTAB 18: HTAB 1: CALL  -868:Q$ = "": GOTO 640
  84. 770  IF S = 0  THEN  RETURN 
  85. 780  FOR X = 1 TO S
  86. 790  IF V$ = ST$(X)  THEN  VTAB 13: HTAB 1: CALL  -958: INVERSE : PRINT V$;" HAS ALREADY BEEN ENTERED": NORMAL : PRINT : GOSUB 70: VTAB 13: CALL  -958: GOTO 600
  87. 800  NEXT X: RETURN 
  88. 810  REM  * STOCK WORTH ENTRY *
  89. 820  VTAB 16: HTAB 1: CALL  -958: PRINT "DO YOU WANT TO ENTER"
  90. 830  PRINT "   1) PRICE PER SHARE": PRINT "   2) TOTAL PRICE"
  91. 840  VTAB 20: INPUT "ENTER YOUR CHOICE -> ";Q$
  92. 850 Q =  VAL(Q$)
  93. 860  IF Q <1  OR Q >2  THEN 840
  94. 870  IF Q = 1  AND AF = 1  THEN AF = 0: GOSUB 920
  95. 880  IF AF  THEN AF = 0
  96. 890  VTAB 16: HTAB 1: CALL  -958: IF Q = 1  THEN  PRINT "ENTER THE PER SHARE PRICE": GOTO 910
  97. 900  PRINT "ENTER THE TOTAL PRICE"
  98. 910  GOSUB 400: RETURN 
  99. 920  VTAB 16: HTAB 1: CALL  -958: PRINT "ENTER THE NUMBER OF SHARES OWNED        ON ";ID$
  100. 930  GOSUB 950:IS = X: RETURN 
  101. 940  REM  * NUMB. OF SHARES ENTRY *
  102. 950  GOSUB 80
  103. 960 Z$ = ""
  104. 970  VTAB 18: HTAB 1: CALL  -868: PRINT "ENTER HERE -> ";Z$;: GET Q$
  105. 980  IF Q$ =  CHR$(8)  THEN Z$ = "": GOTO 970
  106. 990  IF Q$ =  CHR$(27)  THEN 1120
  107. 1000  IF Q$ =  CHR$(13)  AND  VAL(Z$) = 0  THEN  PRINT B$: GOTO 960
  108. 1010  IF Q$ =  CHR$(13)  THEN X =  VAL(Z$): VTAB 16: HTAB 1: CALL  -958: RETURN 
  109. 1020  IF Q$ =  CHR$(46)  THEN Z$ = Z$ +Q$: GOTO 970
  110. 1030  IF  ASC(Q$) <48  OR  ASC(Q$) >57  THEN  PRINT B$: GOTO 970
  111. 1040 Z$ = Z$ +Q$: GOTO 970
  112. 1050  HOME 
  113. 1060  VTAB 3: HTAB 7: PRINT "NIBBLE INVESTMENT ADVISOR"
  114. 1070  HTAB 12: PRINT "BY R.F.DOELLING"
  115. 1080  HTAB 2: PRINT "COPYRIGHT 1985 BY MICROSPARC, INC."
  116. 1090  VTAB 16: PRINT "ENTER THE CURRENT DATE"
  117. 1100  GOSUB 120:CD$ = V$:CD = V
  118. 1110  REM  * MAIN MENU *
  119. 1120  IF S = 0  THEN 5430
  120. 1130  IF S = 96  THEN  GOSUB 5480
  121. 1140  HOME : HTAB 9: INVERSE : PRINT "$$     MAIN MENU     $$": HTAB 9: PRINT "$$  INVESTMENT LIST  $$": NORMAL 
  122. 1150  GOSUB 1570: IF S <25  THEN 1170
  123. 1160  VTAB 17: HTAB 13: INVERSE : PRINT "L";: NORMAL : PRINT "IST NEXT SCREEN"
  124. 1170  VTAB 18: HTAB 1: INVERSE : PRINT "A";: NORMAL : PRINT "DD AN INVESTMENT";: HTAB 20: INVERSE : PRINT "D";: NORMAL : PRINT "ELETE AN INVESTMENT"
  125. 1180  INVERSE : PRINT "R";: NORMAL : PRINT "ATE OF RETURN";: HTAB 20: INVERSE : PRINT "C";: NORMAL : PRINT "HANGE A LISTING"
  126. 1190  INVERSE : PRINT "E";: NORMAL : PRINT "NTER INCOME";: HTAB 20: INVERSE : PRINT "Q";: NORMAL : PRINT "UIT PROGRAM"
  127. 1200  VTAB 22: HTAB 1: PRINT "ENTER THE LETTER FOR THE TASK YOU WANT";: GET Q$
  128. 1210  IF Q$ = "Q"  AND CF = 1  THEN  GOSUB 4770
  129. 1220  IF Q$ = "Q"  THEN  HOME : VTAB 12: HTAB 1: INPUT "ARE YOU SURE YOU WANT TO QUIT? (Y/N)";YY$: IF YY$ = "Y"  THEN  HOME : VTAB 13: HTAB 12: PRINT "SEE YOU LATER!!!": END 
  130. 1230  IF (Q$ = "Q")  AND (YY$ < >"Y")  THEN  GOTO 1120
  131. 1240  IF Q$ = "A"  AND CF = 1  THEN  GOSUB 4770
  132. 1250  IF Q$ = "A"  THEN Q1 = 1: ON S <96 GOTO 2280: GOTO 1120
  133. 1260  IF Q$ = "D"  THEN 1320
  134. 1270  IF Q$ = "E"  THEN 1370
  135. 1280  IF Q$ = "R"  THEN 1420
  136. 1290  IF Q$ = "C"  THEN 1470
  137. 1300  IF Q$ = "L"  THEN 1150
  138. 1310  PRINT B$: GOTO 1200
  139. 1320  VTAB 18: HTAB 1: CALL  -958: PRINT "ENTER THE NUMBER OF THE LISTING"
  140. 1330  INPUT "YOU WANT TO DELETE -> ";Z$: IF Z$ = "L"  THEN  GOSUB 1570: GOTO 1320
  141. 1340 ZZ =  VAL(Z$): GOSUB 1530: IF AF  THEN 1320
  142. 1350  IF ZZ = I  THEN 4460
  143. 1360 I = ZZ: GOSUB 4650: GOTO 4460
  144. 1370  VTAB 18: HTAB 1: CALL  -958: PRINT "ENTER THE NUMBER OF THE INVESTMENT"
  145. 1380  INPUT "YIELDING THE INCOME -> ";Z$: IF Z$ = "L"  THEN  GOSUB 1570: GOTO 1370
  146. 1390 ZZ =  VAL(Z$): GOSUB 1530: IF AF  THEN 1370
  147. 1400  IF ZZ = I  THEN 2510
  148. 1410  GOSUB 4770:I = ZZ: GOSUB 4650: GOTO 2510
  149. 1420  VTAB 18: HTAB 1: CALL  -958: PRINT "ENTER THE NUMBER OF THE INVESTMENT"
  150. 1430  INPUT "THAT YOU WANT TO ANALYZE -> ";Z$: IF Z$ = "L"  THEN  GOSUB 1570: GOTO 1420
  151. 1440 ZZ =  VAL(Z$): GOSUB 1530: IF AF  THEN 1420
  152. 1450  IF ZZ = I  THEN  GOSUB 3350: GOTO 1120
  153. 1460  GOSUB 4770:I = ZZ: GOSUB 4650: GOSUB 3350: GOTO 1120
  154. 1470  VTAB 18: HTAB 1: CALL  -958: PRINT "ENTER THE NUMBER OF THE LISTING"
  155. 1480  INPUT "THAT YOU WANT TO EDIT -> ";Z$: IF Z$ = "L"  THEN  GOSUB 1570: GOTO 1470
  156. 1490 ZZ =  VAL(Z$): GOSUB 1530: IF AF  THEN 1470
  157. 1500  IF ZZ = I  THEN 1730
  158. 1510  GOSUB 4770:I = ZZ: GOSUB 4650: GOTO 1730
  159. 1520  REM  * CHECK INPUT *
  160. 1530  IF ZZ >0  AND ZZ =  <S  THEN AF = 0: RETURN 
  161. 1540  INVERSE : PRINT "INCORRECT ENTRY": NORMAL : PRINT B$
  162. 1550 AF = 1: GOSUB 70: RETURN 
  163. 1560  REM  * LIST STOCK *
  164. 1570  POKE 34,3: POKE 35,16: CALL  -936
  165. 1580  IF L1 = 49  AND S >72  THEN L1 = 73:L2 = S: GOTO 1650
  166. 1590  IF L1 = 25  AND S >72  THEN L1 = 49:L2 = 72: GOTO 1650
  167. 1600  IF L1 = 25  AND S >48  THEN L1 = 49:L2 = S: GOTO 1650
  168. 1610  IF L1 = 1  AND S >48  THEN L1 = 25:L2 = 48: GOTO 1650
  169. 1620  IF L1 = 1  AND S >24  THEN L1 = 25:L2 = S: GOTO 1650
  170. 1630 L1 = 1: IF S >24  THEN L2 = 24: GOTO 1650
  171. 1640 L2 = S
  172. 1650  VTAB 4: HTAB 1: FOR X = L1 TO L2  STEP 2
  173. 1660  IF X >L2  THEN 1710
  174. 1670  HTAB (3 - LEN( STR$(X))): PRINT X;") ";ST$(X);
  175. 1680  IF X +1 >L2  THEN 1710
  176. 1690  HTAB (22 - LEN( STR$(X +1))): PRINT X +1;") ";ST$(X +1)
  177. 1700  NEXT 
  178. 1710  POKE 34,0: POKE 35,24: RETURN 
  179. 1720  REM  * EDIT STOCK LISTING ROUTINE *
  180. 1730  HOME : INVERSE : HTAB 6: PRINT "INVESTMENT LISTING EDIT ROUTINE"
  181. 1740  NORMAL : PRINT : HTAB 6: PRINT "INVESTMENT: ";ST$(I)
  182. 1750 X = PP: GOSUB 280:PP$ = Z$:X = IW: GOSUB 280:IW$ = Z$
  183. 1760  VTAB 7
  184. 1770  PRINT M$;"  PURCHASE DATE"; TAB( 38 - LEN(PD$));PD$
  185. 1780  PRINT M$;"  INVESTMENT BASIS"; TAB( 38 - LEN(PP$));PP$
  186. 1790  PRINT M$;"  NO. SHARES OWNED"; TAB( 38 - LEN( STR$(NS)));NS
  187. 1800  PRINT M$;"  INT. BASE DATE"; TAB( 38 - LEN(ID$));ID$
  188. 1810  PRINT M$;"  INT. DATE WORTH"; TAB( 38 - LEN(IW$));IW$
  189. 1820  PRINT M$;"  ALL ENTRIES CORRECT-RETURN"
  190. 1830  VTAB 18: HTAB 1: CALL  -958: PRINT "USE ARROWS TO SELECT, AND THEN PRESS": PRINT "<RETURN> TO CHOOSE OPTION."
  191. 1840 CV = 12: POKE  -16368,0
  192. 1850  VTAB CV: HTAB 2: GET Q$
  193. 1860  IF Q$ =  CHR$(13)  THEN 1920
  194. 1870  IF Q$ =  CHR$(21)  OR Q$ =  CHR$(10)  THEN CV = CV +1: IF CV >12  THEN CV = 7: GOTO 1850
  195. 1880  IF Q$ =  CHR$(8)  OR Q$ =  CHR$(11)  THEN CV = CV -1: IF CV <7  THEN CV = 12: GOTO 1850
  196. 1890 QW =  ASC(Q$): IF   NOT ((QW = 21) +(QW = 10) +(QW = 8) +(QW = 11))  THEN  FOR TT = 1 TO 20:QW =  PEEK( -16336): NEXT TT
  197. 1900  GOTO 1850
  198. 1910  REM  * CF=CHANGE FLAG *
  199. 1920  IF CV < >12  THEN CF = 1
  200. 1930  ON (CV -6) GOTO 1940,1970,2020,2040,2090,2140
  201. 1940  VTAB 16: HTAB 1: CALL  -958: PRINT "ENTER NEW PURCHASE DATE": GOSUB 120: GOSUB 2220: IF AF  THEN AF = 0: GOTO 1940
  202. 1950  VTAB 16: HTAB 1: CALL  -958
  203. 1960 PD$ = V$:PV = V: VTAB 7: HTAB 20: CALL  -868: HTAB (38 - LEN(PD$)): PRINT PD$: GOTO 1830
  204. 1970  VTAB 15: HTAB 1: CALL  -958: PRINT "ENTER THE PURCHASE PRICE + COMMISSION"
  205. 1980  GOSUB 820: IF Q = 1  THEN PP = NS *X: GOTO 2000
  206. 1990 PP = X
  207. 2000  VTAB 14: HTAB 1: CALL  -958:X = PP: GOSUB 280:PP$ = Z$
  208. 2010  VTAB 8: HTAB 23: CALL  -868: HTAB (38 - LEN(PP$)): PRINT PP$: GOTO 1830
  209. 2020  VTAB 16: HTAB 1: CALL  -958: PRINT "CORRECT NUMBER OF SHARES": GOSUB 950:NS = X
  210. 2030  VTAB 9: HTAB 22: CALL  -868: HTAB (38 - LEN( STR$(NS))): PRINT NS: GOTO 1830
  211. 2040  VTAB 15: HTAB 1: CALL  -958: PRINT "ENTER AN INTERMEDIATE BASE DATE"
  212. 2050  IF IV = 0  THEN  PRINT "WITHIN THE LAST YEAR": GOTO 2070
  213. 2060  PRINT "FROM ";ID$;" TO ";CD$
  214. 2070  GOSUB 120: GOSUB 2170: IF AF  THEN AF = 0: GOTO 2040
  215. 2080 ID$ = V$:IV = V:AF = 1: GOSUB 4770: IF IW < >0  THEN 1730
  216. 2090  VTAB 15: HTAB 1: CALL  -958: IF IV = 0  THEN  GOSUB 2240: VTAB 15: HTAB 1: CALL  -958: GOTO 2040
  217. 2100  PRINT "ENTER THE INVESTMENT VALUE ON ";ID$:AF = 1: GOSUB 820
  218. 2110  VTAB 15: HTAB 1: CALL  -958: IF Q = 1  THEN IW = X *IS: GOTO 2130
  219. 2120 IW = X
  220. 2130 X = IW: GOSUB 280:IW$ = Z$: GOTO 1730
  221. 2140  IF CF  THEN CF = 0: GOSUB 5010: IF Q1 = 1  THEN  GOSUB 5140:Q1 = 0
  222. 2150  GOTO 1120
  223. 2160  REM  * CHECK INT. DATE *
  224. 2170  VTAB 18: HTAB 1: CALL  -958
  225. 2180  IF V < = PV  THEN  PRINT "THE DATE MUST BE LATER THAN ";PD$: PRINT "THE PURCHASE DATE.":AF = 1: PRINT : GOSUB 70: RETURN 
  226. 2190  IF V <IV  THEN  PRINT "THE DATE MUST BE LATER THAN ";ID$: PRINT "THE PRESENT BASE DATE.":AF = 1: PRINT : GOSUB 70: RETURN 
  227. 2200  IF CD -V >365  THEN  PRINT "THE DATE IS MORE THAN ONE YEAR OLD!":AF = 1: PRINT : GOSUB 70: RETURN 
  228. 2210  VTAB 18: HTAB 1: CALL  -958
  229. 2220  IF V > = CD  THEN  PRINT "THE DATE MUST BE EARLIER THAN TODAY!":AF = 1: PRINT : GOSUB 70: RETURN 
  230. 2230 AF = 0: RETURN 
  231. 2240  PRINT "THERE IS NO INTERMEDIATE DATE ENTERED."
  232. 2250  PRINT : PRINT "YOU NEED TO ENTER ONE BEFORE PROCEEDING": PRINT "WITH THE ENTRY OF THE INTERMEDIATE": PRINT "STOCK VALUE."
  233. 2260  GOSUB 70: RETURN 
  234. 2270  REM  * ADD A STOCK ROUTINE *
  235. 2280  HOME : VTAB 5: HTAB 10: PRINT "NEW INVESTMENT LISTING": HTAB 10: PRINT "----------------------": REM  22 -'S
  236. 2290  VTAB 10: HTAB 5: PRINT "ENTER THE NAME OF THE INVESTMENT"
  237. 2300  GOSUB 600:I = S +1:ST$(I) = V$
  238. 2310 CH = 20 -.5 * LEN(ST$(I))
  239. 2320  VTAB 7: HTAB CH: PRINT ST$(I)
  240. 2330  HTAB CH: FOR X = 1 TO  LEN(ST$(I)): PRINT "-";: NEXT 
  241. 2340  VTAB 10: HTAB 1: CALL  -958: PRINT "ENTER THE DATE THAT THE INVESTMENT WAS": PRINT "MADE."
  242. 2350  VTAB 16: HTAB 1: PRINT "ENTER THE INVESTMENT DATE"
  243. 2360  GOSUB 120: GOSUB 2220: IF AF  THEN AF = 0: GOTO 2340
  244. 2370 PD$ = V$:PV = V
  245. 2380  VTAB 10: HTAB 1: CALL  -958: PRINT "HOW MANY SHARES WERE PURCHASED?": GOSUB 940:NS = X
  246. 2390  VTAB 10: HTAB 1: CALL  -958: PRINT "ENTER THE PURCHASE PRICE INCLUDING THE": PRINT "BROKER'S COMMISSION."
  247. 2400  GOSUB 820
  248. 2410  IF Q = 1  THEN PP = NS *X: GOTO 2430
  249. 2420 PP = X
  250. 2430  VTAB 10: HTAB 1: CALL  -958: PRINT "DO YOU WANT TO ENTER THE NEXT DATE THAT THE INVESTMENT WILL PAY DIVIDENDS OR    INTEREST? (Y/N) -> ";: GET Q$
  251. 2440 S = S +1: IF Q$ = "N"  THEN ND$ = "": GOTO 2490
  252. 2450  IF Q$ < >"Y"  THEN 2430
  253. 2460  VTAB 10: HTAB 1: CALL  -958: PRINT "ENTER THE NEXT DIVIDEND PAY DATE": GOSUB 120
  254. 2470 ND$ = V$
  255. 2480  REM  * Q1=ADD FLAG *
  256. 2490 IW = 0:IV = 0:ID$ = "NONE ENTERED":CF = 1:CF = 1:TI = 0:NI = 0:CG = 0:D = 0: GOTO 1730
  257. 2500  REM  *INCOME ENTRY *
  258. 2510  IF D = 0  THEN 2550
  259. 2520  FOR X = 1 TO D
  260. 2530  IF DT(X) = 1  THEN UU$ = "BY " +ST$(I) +" IN THE LAST YEAR": GOSUB 3230: GOTO 2580
  261. 2540  NEXT 
  262. 2550  IF CD -PV >365  AND IV = 0  THEN UU$ = "BY " +ST$(I) +" IN THE LAST YEAR": GOSUB 3230: GOTO 2580
  263. 2560  IF IV = 0  THEN UU$ = "SINCE " +ST$(I) +" WAS PURCHASED": GOSUB 3230: GOTO 2580
  264. 2570 UU$ = "BY " +ST$(I) +" SINCE " +ID$: GOSUB 3230
  265. 2580  VTAB 19: HTAB 1: CALL  -958: IF ND$ < >""  THEN 2650
  266. 2590  PRINT "THERE IS NO DIVIDEND PAY DATE ENTERED"
  267. 2600  INPUT "DO YOU WANT TO ENTER ONE? (Y/N) -> ";Q$
  268. 2610  IF Q$ = "N"  THEN 2700
  269. 2620  IF Q$ < >"Y"  THEN  PRINT B$: GOTO 2580
  270. 2630  VTAB 19: HTAB 1: CALL  -958: PRINT "ENTER THE NEXT PAYMENT DATE"
  271. 2640  GOSUB 120:ND$ = V$:CF = 1: GOTO 2700
  272. 2650  VTAB 19: HTAB 1: CALL  -958: PRINT "THE NEXT DIV. PAY DATE IS ";ND$: INPUT "DO YOU WANT TO CHANGE IT? (Y/N) ";Q$
  273. 2660  IF Q$ = "N"  THEN 2700
  274. 2670  IF Q$ < >"Y"  THEN  PRINT B$: GOTO 2650
  275. 2680  VTAB 20: HTAB 1: CALL  -958: PRINT "ENTER THE NEXT PAYMENT DATE"
  276. 2690  GOSUB 120:ND$ = V$:CF = 1
  277. 2700  VTAB 16: HTAB 1: CALL  -958: IF D = 0  THEN  PRINT "HAS ANY INCOME BEEN PAID?": GOTO 2720
  278. 2710  PRINT "HAS ANY MORE INCOME BEEN PAID?"
  279. 2720  INPUT " (Y/N) -> ";Q$
  280. 2730  IF Q$ = "N"  THEN 1120
  281. 2740  IF Q$ < >"Y"  THEN  PRINT B$: GOTO 2700
  282. 2750  VTAB 16: HTAB 1: CALL  -958: PRINT "ENTER THE DATE IT WAS PAID"
  283. 2760  GOSUB 120: GOSUB 2210
  284. 2770  IF AF  THEN AF = 0: GOTO 2750
  285. 2780 DV = V:DD$ = V$
  286. 2790  VTAB 16: HTAB 1: CALL  -958: PRINT "ENTER THE AMOUNT PAID"
  287. 2800  GOSUB 400:DA = X
  288. 2810 T$(1) = "A REINVESTED UTILITY DIVIDEND":T$(2) = "A REGULAR STOCK DIVIDEND":T$(3) = "A CAPITAL GAIN DISTRIBUTION"
  289. 2820 T$(4) = "RETURN OF CAPITAL":T$(5) = "NON-TAXABLE INCOME"
  290. 2830  VTAB 16: HTAB 1: CALL  -958: PRINT "WAS THE INCOME"
  291. 2840  FOR X = 1 TO 5
  292. 2850  PRINT X;") ";T$(X)
  293. 2860  NEXT 
  294. 2870  PRINT : INPUT "ENTER THE TYPE (#) -> ";DT$:DT =  VAL(DT$)
  295. 2880  IF DT <1  OR DT >5  THEN  PRINT B$;: GOTO 2830
  296. 2890  IF DT = 1  THEN 2910
  297. 2900  VTAB 16: HTAB 1: CALL  -958: PRINT "WAS THE INCOME REINVESTED? (Y/N) ";: INPUT "";Y$
  298. 2910  VTAB 16: HTAB 1: CALL  -958:X = DA: GOSUB 280
  299. 2920  PRINT Z$;" WAS PAID ON ";DD$;". IT WAS": PRINT T$(DT)
  300. 2930  IF DT = 1  THEN 2960
  301. 2940  IF Y$ = "Y"  THEN  PRINT "THE INCOME WAS REINVESTED": GOTO 2960
  302. 2950  PRINT "THE INCOME WAS NOT REINVESTED"
  303. 2960  GOSUB 80: VTAB 22: HTAB 34: GET Q$
  304. 2970  IF Q$ =  CHR$(27)  THEN 1120
  305. 2980  IF Q$ =  CHR$(8)  THEN 2700
  306. 2990  IF Q$ =  CHR$(13)  THEN  GOSUB 3020: GOSUB 3230: GOTO 2700
  307. 3000  PRINT B$: GOTO 2960
  308. 3010  REM  * INCOME TYPE HANDLING *
  309. 3020  VTAB 16: HTAB 1: CALL  -958: IF DT = 4  AND Y$ = "Y"  THEN  RETURN 
  310. 3030  IF DT = 1  AND CD -DV >365  THEN  RETURN 
  311. 3040 CF = 1: IF DT = 1  THEN 3120
  312. 3050  IF DT = 2  AND Y$ = "Y"  THEN 3120
  313. 3060  IF DT = 2  THEN DT = 3: GOTO 3120
  314. 3070  IF DT = 3  AND Y$ = "Y"  THEN DT = 4: GOTO 3120
  315. 3080  IF DT = 3  THEN DT = 5: GOTO 3120
  316. 3090  IF DT = 4  THEN DT = 6: GOTO 3120
  317. 3100  IF DT = 5  AND Y$ = "Y"  THEN DT = 7: GOTO 3120
  318. 3110 DT = 8
  319. 3120 D = D +1:DD$(D) = DD$:DV(D) = DV:DT(D) = DT:DA(D) = DA:CF = 1:AF = 1
  320. 3130  IF D = 1  THEN 3210
  321. 3140  FOR X = D TO 1  STEP  -1
  322. 3150  IF DV(X) >DV(X -1)  THEN 3210
  323. 3160 DD$ = DD$(X):DD$(X) = DD$(X -1):DD$(X -1) = DD$
  324. 3170 DV = DV(X):DV(X) = DV(X -1):DV(X -1) = DV
  325. 3180 DT = DT(X):DT(X) = DT(X -1):DT(X -1) = DT
  326. 3190 DA = DA(X):DA(X) = DA(X -1):DA(X -1) = DA
  327. 3200  NEXT X
  328. 3210  GOTO 4770
  329. 3220  REM  * LIST INCOME *
  330. 3230  HOME : HTAB 11: INVERSE : PRINT "$$       INCOME       $$": HTAB 11: PRINT "$$   ENTRY  ROUTINE   $$": NORMAL 
  331. 3240  PRINT : IF D = 0  THEN  HTAB 11: PRINT "NO INCOME HAS BEEN PAID": HTAB 6: PRINT UU$: RETURN 
  332. 3250  HTAB 6: PRINT "THE FOLLOWING INCOME HAS BEEN PAID": HTAB 6: PRINT UU$
  333. 3260  PRINT : HTAB 4: PRINT "DATE"; TAB( 14);"AMOUNT"; TAB( 24);"DATE"; TAB( 34);"AMOUNT": PRINT 
  334. 3270  FOR Y = 1 TO 11  STEP 2
  335. 3280 X = DA(Y): GOSUB 280
  336. 3290  HTAB (9 - LEN(DD$(Y))): PRINT DD$(Y);: HTAB (20 - LEN(Z$)): PRINT Z$;
  337. 3300  IF Y = D  THEN  RETURN 
  338. 3310 X = DA(Y +1): GOSUB 280
  339. 3320  HTAB (29 - LEN(DD$(Y +1))): PRINT DD$(Y +1);: HTAB (40 - LEN(Z$)): PRINT Z$
  340. 3330  IF Y +1 = D  THEN  RETURN 
  341. 3340  NEXT : RETURN 
  342. 3350  HOME : INVERSE : HTAB 10: PRINT "$$   ANALYSIS  OF   $$"
  343. 3360  HTAB 10: PRINT "$$  RATE OF RETURN  $$": NORMAL : VTAB 5: HTAB 8
  344. 3370  PRINT "THIS ANALYSIS IS FOR ";NS
  345. 3380  HTAB 8: PRINT "SHARES OF ";ST$(I)
  346. 3390  VTAB 10: HTAB 1: PRINT "ENTER THE CURRENT PRICE": GOSUB 820
  347. 3400  IF Q = 1  THEN CW = X *NS: GOTO 3420
  348. 3410 CW = X
  349. 3420  VTAB 10: HTAB 1: CALL  -958: PRINT "ENTER YOUR TAX RATE (0-50%)": PRINT : HTAB 8: INPUT "-> ";TX$:TX =  VAL(TX$)
  350. 3430  IF TX <0  OR TX >50  THEN  PRINT B$: GOTO 3420
  351. 3440  VTAB 10: HTAB 1: CALL  -958: HTAB 9: PRINT "YOUR TAX RATE IS ";TX;"%": PRINT : GOSUB 30
  352. 3450  IF Q$ = "N"  THEN 3420
  353. 3460 TX = TX/100
  354. 3470  VTAB 10: HTAB 1: CALL  -958: PRINT "DO YOU WANT A PRINTOUT OF THE": INPUT "ANALYSIS? (Y/N) -> ";Q$
  355. 3480  IF Q$ = "N"  THEN CF = 0: GOTO 3510
  356. 3490  IF Q$ < >"Y"  THEN  PRINT B$: GOTO 3470
  357. 3500 CF = 1
  358. 3510 EV = CD:SV = PV:EW = CW:QP = TI:I2 = NI:I3 = CG:BW = PP:SD$ = PD$:ED$ = CD$
  359. 3520  IF D = 0  THEN 3620
  360. 3530  FOR X = 1 TO D
  361. 3540  IF DT(X) = 1  OR DT(X) = 2  OR DT(X) = 3  THEN QP = QP +DA(X)
  362. 3550  IF DT(X) = 1  OR DT(X) = 2  THEN BW = BW +DA(X)
  363. 3560  IF DT(X) = 4  OR DT(X) = 5  THEN I3 = I3 +DA(X)
  364. 3570  IF DT(X) = 4  THEN BW = BW +DA(X)
  365. 3580  IF DT(X) = 6  THEN BW = BW -DA(X)
  366. 3590  IF DT(X) = 7  OR DT(X) = 8  THEN I2 = I2 +DA(X)
  367. 3600  IF DT(X) = 7  THEN BW = BW +DA(X)
  368. 3610  NEXT X
  369. 3620  GOSUB 4210
  370. 3630  IF CF = 0  AND IV = 0  THEN  GOSUB 4050: GOSUB 70: RETURN 
  371. 3640  IF CF = 0  THEN  GOSUB 4050: GOSUB 70: GOTO 3670
  372. 3650  GOSUB 3910
  373. 3660  IF (IV = A)  THEN 3900
  374. 3670 EV = IV:SV = PV:EW = IW:BW = PP:QP = TI:I2 = NI:I3 = CG:SD$ = PD$:ED$ = ID$
  375. 3680  IF D = 0  THEN 3720
  376. 3690  FOR X = 1 TO D
  377. 3700  IF DT(X) = 1  AND DV(X) <IV  THEN QP = QP +DA(X):BW = BW +DA(X)
  378. 3710  NEXT X
  379. 3720  GOSUB 4210
  380. 3730  IF CF = 0  THEN  GOSUB 4050: GOSUB 70: GOTO 3750
  381. 3740  GOSUB 4440: GOSUB 3970
  382. 3750 EV = CD:SV = IV:EW = CW:BW = IW:QP = 0:I2 = 0:I3 = 0:SD$ = ID$:ED$ = CD$
  383. 3760  IF D = 0  THEN 3870
  384. 3770  FOR X = 1 TO D
  385. 3780  IF DT(X) = 1  AND DV(X) >IV  THEN QP = QP +DA(X):BW = BW +DA(X)
  386. 3790  IF DT(X) = 2  OR DT(X) = 3  THEN QP = QP +DA(X)
  387. 3800  IF DT(X) = 2  THEN BW = BW +DA(X)
  388. 3810  IF DT(X) = 4  OR DT(X) = 5  THEN I3 = I3 +DA(X)
  389. 3820  IF DT(X) = 4  THEN BW = BW +DA(X)
  390. 3830  IF DT(X) = 6  AND DV(X) >IV  THEN BW = BW -DA(X)
  391. 3840  IF DT(X) = 7  OR DT(X) = 8  THEN I2 = I2 +DA(X)
  392. 3850  IF DT(X) = 7  THEN BW = BW +DA(X)
  393. 3860  NEXT X
  394. 3870  GOSUB 4210
  395. 3880  IF CF = 0  THEN  GOSUB 4050: GOSUB 70: RETURN 
  396. 3890  GOSUB 4440: GOSUB 3970
  397. 3900  GOSUB 4440: HTAB 5: PRINT UL$:CF = 0: PRINT D$"PR#0": RETURN 
  398. 3910  GOSUB 4440
  399. 3920  HTAB (26 -.5 *( LEN(ST$(I)) + LEN( STR$(NS)) + LEN(PD$))): PRINT NS;" SHARES OF ";ST$(I);" PURCHASED ON ";PD$
  400. 3930  HTAB 32: PRINT "TAX RATE  ";TX$
  401. 3940  HTAB 32: FOR X = 1 TO (10 + LEN( STR$(TX))): PRINT "-";: NEXT : PRINT 
  402. 3950  IF IV < >0  THEN 3970
  403. 3960  PRINT : HTAB 20: PRINT "THERE IS NO INTERMEDIATE DATE ENTERED"
  404. 3970  PRINT : HTAB 15: PRINT "**** FOR THE PERIOD FROM ";SD$;" TO ";ED$;" ****"
  405. 3980  HTAB 16: PRINT "THE INVESTMENT BASIS ON ";SD$;" WAS ";BW$
  406. 3990  HTAB 16: PRINT "THE INVESTMENT WORTH ON ";ED$;" WAS ";EW$
  407. 4000  HTAB 7: PRINT "TAXABLE DIV/INT."; SPC( ((12 - LEN(QP$)) > -1) *(12 - LEN(QP$)));;QP$; SPC( 4);"TAX-FREE DIV/INT."; SPC( ((12 - LEN(I2$)) > -1) *(12 - LEN(I2$)));I2$
  408. 4010  HTAB 2: PRINT "CAP.GAIN DISTRIBUTION"; SPC( ((12 - LEN(I3$)) > -1) *(12 - LEN(I3$)));I3$; SPC( 8);"CAPITAL GAINS"; SPC( ((12 - LEN(CG$)) > -1) *(12 - LEN(CG$)));CG$
  409. 4020  HTAB 11: PRINT "TOTAL RETURN"; SPC( ((12 - LEN(TR$)) > -1) *(12 - LEN(TR$)));TR$; SPC( 4);"ANNUALIZED RETURN"; SPC( ((12 - LEN(Y1$)) > -1) *(12 - LEN(Y1$)));Y1$
  410. 4030  HTAB 7: PRINT "AFTER TAX RETURN"; SPC( ((12 - LEN(AX$)) > -1) *(12 - LEN(AX$)));AX$; SPC( 4);"ANNUALIZED RETURN"; SPC( ((12 - LEN(Y2$)) > -1) *(12 - LEN(Y2$)));Y2$
  411. 4040  PRINT D$"PR#0": PRINT D$: RETURN 
  412. 4050  HOME : PRINT NS;" SHARES OF ";ST$(I)
  413. 4060  PRINT : PRINT "PURCHASED ON ";PD$;"  TAX RATE IS ";TX$
  414. 4070  IF IV < >0  THEN 4090
  415. 4080  PRINT : PRINT "THERE IS NO INTERMEDIATE DATE ENTERED"
  416. 4090  PRINT : PRINT "FOR THE PERIOD ";SD$;" TO ";ED$
  417. 4100  PRINT : PRINT SD$;" BASIS=";BW$
  418. 4110  PRINT ED$;" WORTH=";EW$
  419. 4120  PRINT : PRINT "TAXABLE DIV/INT."; TAB( 30 - LEN(QP$));QP$
  420. 4130  PRINT "TAX-FREE DIV/INT." TAB( 30 - LEN(I2$));I2$
  421. 4140  PRINT "CAP. GAIN DIST."; TAB( 30 - LEN(I3$));I3$
  422. 4150  PRINT "CAPITAL GAINS"; TAB( 30 - LEN(CG$));CG$
  423. 4160  PRINT "TOTAL RETURN"; TAB( 30 - LEN(TR$));TR$
  424. 4170  PRINT "T.R. ANN. YIELD"; TAB( 30 - LEN(Y1$));Y1$
  425. 4180  PRINT "AFTER TAX RETURN"; TAB( 30 - LEN(AX$));AX$
  426. 4190  PRINT "A.T. ANN. YIELD"; TAB( 30 - LEN(Y2$));Y2$
  427. 4200  RETURN 
  428. 4210  IF (CD -PV) <365  THEN CT = 1: GOTO 4230
  429. 4220 CT = .4
  430. 4230 TR = EW -BW +QP +I2 +I3
  431. 4240 TA = TX *(QP +CT *(EW -BW)) +TX *.4 *I3
  432. 4250 AX = TR -TA:Y = 365/(EV -SV)
  433. 4260 X = (TR +BW)/BW: GOSUB 4400:Y1$ = Z$
  434. 4270 X = (AX +BW)/BW: GOSUB 4400:Y2$ = Z$
  435. 4280 X = PP: GOSUB 280:PP$ = Z$
  436. 4290 X = IW: GOSUB 280:IW$ = Z$
  437. 4300 X = QP: GOSUB 280:QP$ = Z$
  438. 4310 X = (EW -BW +D3): GOSUB 280:CG$ = Z$
  439. 4320 X = TR: GOSUB 280:TR$ = Z$
  440. 4330 X = AX: GOSUB 280:AX$ = Z$
  441. 4340 X = BW: GOSUB 280:BW$ = Z$
  442. 4350 X = I2: GOSUB 280:I2$ = Z$
  443. 4360 X = I3: GOSUB 280:I3$ = Z$
  444. 4370 X = EW: GOSUB 280:EW$ = Z$
  445. 4380 TX$ =  STR$(TX *100) +"%"
  446. 4390  RETURN 
  447. 4400  IF X <1  THEN DF = 1
  448. 4410 V = (X ^Y) -1:Z =  INT(1000 *(V +.0005))/10
  449. 4420  IF DF  THEN DF = 0:Z$ = "(" + STR$(Z) +"%)": RETURN 
  450. 4430 Z$ =  STR$(Z) +"%": RETURN 
  451. 4440  PRINT D$"PR#1": PRINT  CHR$(9)"80N": RETURN 
  452. 4450  REM  * DELETE STOCK LISTING *
  453. 4460  HOME : INVERSE : VTAB 5: HTAB 10: PRINT "DELETE LISTING ROUTINE": NORMAL 
  454. 4470  VTAB 8: PRINT "YOU WISH TO ";: INVERSE : PRINT "DELETE ";ST$(I): NORMAL 
  455. 4480  PRINT : PRINT : INPUT "IS THAT CORRECT? (Y/N) ";Q$
  456. 4490  IF Q$ = "N"  THEN 1120
  457. 4500  IF Q$ < >"Y"  THEN  PRINT B$: GOTO 4460
  458. 4510  VTAB 10: HTAB 1: CALL  -958: PRINT "DO YOU WANT A FINAL ANALYSIS BEFORE     THE LISTING IS DELETED? ";: INPUT "";Q$
  459. 4520  IF Q$ = "N"  THEN 4570
  460. 4530  IF Q$ < >"Y"  THEN  PRINT B$: GOTO 4510
  461. 4540  GOSUB 3350
  462. 4550  HOME : PRINT "DO YOU WANT TO CONTINUE DELETING"
  463. 4560  PRINT "THE ";ST$(I);" FILES? ";: INPUT "";Q$: IF Q$ < >"Y"  THEN 1120
  464. 4570  PRINT DE$;ST$(I): PRINT DE$;"STOCK.LIST": IF (S -1) = 0  THEN S = 0: GOTO 5430
  465. 4580  FOR X = I TO S
  466. 4590 ST$(X) = ST$(X +1)
  467. 4600  NEXT 
  468. 4610 S = S -1
  469. 4620  GOSUB 5140:CF = 0:I = 0: GOTO 1120
  470. 4630  REM  IW=0
  471. 4640  REM  * READ STOCK FILES *
  472. 4650  HOME : VTAB 10: HTAB 5: PRINT "READING ";ST$(I);" FILE"
  473. 4660  PRINT OP$;ST$(I)
  474. 4670  PRINT RD$;ST$(I)
  475. 4680  INPUT PD$,PV,NS,PP,ID$,IV,IW,D,ND$,TI,NI,CG
  476. 4690  IF D = 0  THEN 4730
  477. 4700  FOR X = 1 TO D
  478. 4710  INPUT DT(X),DD$(X),DV(X),DA(X)
  479. 4720  NEXT 
  480. 4730  PRINT CL$;ST$(I)
  481. 4740 AF = 1: IF IV = 0  THEN 4770
  482. 4750  IF CD -IV >365  THEN IV = 0:ID$ = "NONE ENTERED":IW = 0
  483. 4760  REM  *DIV.DATE CHECK *
  484. 4770  IF D = 0  THEN 4970
  485. 4780  IF IV = 0  AND CD -DV(1) <365  THEN 4970
  486. 4790 X = 1
  487. 4800  IF X >D  THEN 4970
  488. 4810  IF IV = 0  THEN 4830
  489. 4820  IF DV(X) >IV  THEN 4970
  490. 4830  IF DT(X) = 1  AND CD -DV(X) <365  THEN X = X +1: GOTO 4800
  491. 4840 CF = 1: IF DT(X) = 1  THEN 4920
  492. 4850  IF DT(X) = 2  THEN PP = PP +DA(X):TI = TI +DA(X): GOTO 4920
  493. 4860  IF DT(X) = 3  THEN TI = TI +DA(X): GOTO 4920
  494. 4870  IF DT(X) = 4  THEN CG = CG +DA(X):PP = PP +DA(X): GOTO 4920
  495. 4880  IF DT(X) = 5  THEN CG = CG +DA(X): GOTO 4920
  496. 4890  IF DT(X) = 6  THEN PP = PP -DA(X): GOTO 4920
  497. 4900  IF DT(X) = 7  THEN PP = PP +DA(X):NI = NI +DA(X): GOTO 4920
  498. 4910 NI = NI +DA(X)
  499. 4920  FOR Y = X TO D
  500. 4930 Z = Y +1
  501. 4940 DT(Y) = DT(Z):DD$(Y) = DD$(Z):DV(Y) = DV(Z):DA(Y) = DA(Z)
  502. 4950  NEXT 
  503. 4960 D = D -1: GOTO 4770
  504. 4970  IF AF  THEN AF = 0: RETURN 
  505. 4980  IF CF  THEN CF = 0: GOSUB 5010
  506. 4990  RETURN 
  507. 5000  REM  * WRITE STOCK FILES *
  508. 5010  HOME : VTAB 10: HTAB 5: PRINT "WRITING ";ST$(I);" FILE"
  509. 5020  PRINT OP$;ST$(I)
  510. 5030  PRINT CL$;ST$(I)
  511. 5040  PRINT DE$;ST$(I)
  512. 5050  PRINT OP$;ST$(I)
  513. 5060  PRINT WR$;ST$(I)
  514. 5070  PRINT PD$: PRINT PV: PRINT NS: PRINT PP: PRINT ID$: PRINT IV: PRINT IW: PRINT D: PRINT ND$: PRINT TI: PRINT NI: PRINT CG
  515. 5080  IF D = 0  THEN 5120
  516. 5090  FOR W = 1 TO D
  517. 5100  PRINT DT(W): PRINT DD$(W): PRINT DV(W): PRINT DA(W)
  518. 5110  NEXT 
  519. 5120  PRINT CL$;ST$(I): RETURN 
  520. 5130  REM  * WRITE STOCK LIST *
  521. 5140  HOME : VTAB 10: HTAB 5: PRINT "WRITING STOCK.LIST"
  522. 5150  PRINT OP$;"STOCK.LIST"
  523. 5160  PRINT CL$;"STOCK.LIST"
  524. 5170  PRINT DE$;"STOCK.LIST"
  525. 5180  PRINT OP$;"STOCK.LIST"
  526. 5190  PRINT WR$;"STOCK.LIST"
  527. 5200  PRINT S
  528. 5210  FOR X = 1 TO S
  529. 5220  PRINT ST$(X)
  530. 5230  NEXT 
  531. 5240  PRINT CL$;"STOCK.LIST"
  532. 5250  RETURN 
  533. 5260  REM  * INITIALIZATION *
  534. 5270  ONERR  GOTO 5510
  535. 5280 D$ =  CHR$(4):B$ =  CHR$(7) + CHR$(7) + CHR$(7):M$ =  CHR$(91) +" " + CHR$(93)
  536. 5290 OP$ = D$ +"OPEN ":RD$ = D$ +"READ ":WR$ = D$ +"WRITE ":CL$ = D$ +"CLOSE ":DE$ = D$ +"DELETE "
  537. 5300  DIM ST$(96),DD$(13),DV(13),DA(13),DT(13)
  538. 5310  PRINT D$;"VERIFY STOCK.LIST"
  539. 5320  PRINT OP$;"STOCK.LIST"
  540. 5330  PRINT RD$;"STOCK.LIST"
  541. 5340  INPUT S
  542. 5350  IF S = 0  THEN 5390
  543. 5360  FOR I = 1 TO S
  544. 5370  INPUT ST$(I)
  545. 5380  NEXT 
  546. 5390  PRINT CL$;"STOCK.LIST"
  547. 5400  FOR X = 1 TO 65:UL$ = UL$ +"-": NEXT 
  548. 5410 I = 0: GOTO 1050
  549. 5420  REM  * NO STOCKS ENTERED *
  550. 5430  HOME : VTAB 5: HTAB 1: INVERSE : PRINT "THERE ARE NO STOCKS ENTERED."
  551. 5440  PRINT "TRANSFERRING TO THE ENTRY ROUTINE.": NORMAL 
  552. 5450 Q1 = 1: GOSUB 70
  553. 5460  GOTO 2280
  554. 5470  REM  * LONG STOCK LIST WARNING *
  555. 5480  HOME : VTAB 5: PRINT "THERE ARE 96 STOCKS ON YOUR LIST. THIS": PRINT "IS THE MAXIMUM THAT CAN BE STORED."
  556. 5490  PRINT "YOU WILL NEED TO DELETE A STOCK FROM ": PRINT "THE LISTING BEFORE ANY MORE CAN BE": PRINT "ADDED."
  557. 5500  PRINT : GOSUB 70: RETURN 
  558. 5510  REM  * INIT STOCK LIST FILE *
  559. 5520  IF  PEEK(222) < >6  THEN 5580
  560. 5530  IF  PEEK(222) = 6  THEN  PRINT D$;"OPEN STOCK.LIST"
  561. 5540  PRINT D$;"WRITE STOCK.LIST"
  562. 5550  PRINT 0
  563. 5560  PRINT D$;"CLOSE STOCK.LIST"
  564. 5570  GOTO 5320
  565. 5580  VTAB 20: HTAB 1: CALL  -958: PRINT "ERROR # "; PEEK(222);" OCCURRED"
  566. 5590  PRINT "ON LINE # ";( PEEK(218) +( PEEK(219) *256))
  567. 5600  GOSUB 70:I = 0: GOTO 1120