home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib28b.dsk / DECISIONMAKER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  19KB  |  367 lines
  1. 10  REM **********************
  2. 20  REM *    DECISIONMAKER   *
  3. 30  REM * BY RICHARD SCHUBERT*
  4. 40  REM * COPYRIGHT (C) 1986 *
  5. 50  REM * BY MICROSPARC, INC *
  6. 60  REM * CONCORD, MA  01742 *
  7. 70  REM **********************
  8. 80  HOME : VTAB 10: PRINT "NIBBLE DECISIONMAKER BY RICHARD SCHUBERT";: VTAB 12: PRINT "** COPYRIGHT 1986 BY MICROSPARC, INC **": GOSUB 3430
  9. 90 ME = 20:D$ =  CHR$(4):BS$ =  CHR$(8):CR$ =  CHR$(13):UA$ =  CHR$(11):DA$ =  CHR$(10):FS$ =  CHR$(21):EX$ =  CHR$(27):CS$ =  CHR$(95): FOR I = 1 TO 39:UL$ = UL$ +CS$: NEXT : DIM X$(1):X$(0) = "   ":X$(1) = "-->":SX = 4:PS = 1
  10. 100  DIM R(10,ME),D(10,ME),B(10,ME),R1(10,ME),D1(10,ME),B1(10,ME)
  11. 110  DIM T(10),CC(10),RR(10),RV(10),NPV(10),PI(10),IRR(10)
  12. 120 CL =  -868:KBD =  -16384:RST =  -16368:T(DSET) = 0:CC(DSET) = 0:RR(DSET) = 0:RV(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0:DSET = 1:IRR(DSET) = 0:CP = 0
  13. 130  DEF  FN A(X) =  INT(X +.5): DEF  FN B(X) =  INT(X *1000 +.5)/1000
  14. 140 EF = 0: ONERR  GOTO 3350
  15. 150  REM  * MENU *
  16. 160 NC = 17: DIM CM$(NC)
  17. 170  GOSUB 3520
  18. 180  REM  * MAIN MENU *
  19. 190 TL = 1:EM = 0: GOSUB 3540
  20. 200 SL = 1:PX = 31:MX = MITEMS(TL)
  21. 210  GOSUB 3590: IF Z = 20  THEN  PRINT  CHR$(7);: GOTO 210
  22. 220  ON SL GOSUB 250,310,370,580,1110,430,2600,1960
  23. 230  GOTO 190
  24. 240  REM  * DISK OPERATIONS MENU *
  25. 250 TL = 2:EM = 1: GOSUB 3540
  26. 260 SL = 1:PX = 31:MX = MITEMS(TL)
  27. 270  GOSUB 3590: IF Z = 20  THEN  RETURN 
  28. 280  ON SL GOSUB 2810,2640,500
  29. 290  GOTO 250
  30. 300  REM  * INPUT NEW DATA *
  31. 310 TL = 3:EM = 1: GOSUB 3540
  32. 320 SL = 1:PX = 31:MX = MITEMS(TL)
  33. 330  GOSUB 3590: IF Z = 20  THEN  RETURN 
  34. 340  ON SL GOSUB 2000,970,650,740,830,900,1050
  35. 350  GOTO 310
  36. 360  REM  * CHANGE FLOW DATA *
  37. 370 TL = 4:EM = 1: GOSUB 3540
  38. 380 SL = 1:PX = 31:MX = MITEMS(TL)
  39. 390  GOSUB 3590: IF Z = 20  THEN  RETURN 
  40. 400  ON SL GOSUB 2000,2450,2320,2230
  41. 410  GOTO 370
  42. 420  REM  * PRINT OPTIONS *
  43. 430 TL = 5:EM = 1: GOSUB 3540: GOSUB 480
  44. 440 SL = 1:PX = 31:MX = MITEMS(TL)
  45. 450  GOSUB 3590: IF Z = 20  THEN  RETURN 
  46. 460  ON SL GOSUB 2570,530
  47. 470  GOTO 430
  48. 480  VTAB 20: HTAB 5: PRINT "PRINTER: ";: INVERSE : PRINT  MID$ ("OFFON ",1 +3 *(CP),3);: NORMAL : RETURN 
  49. 490  REM  * CATALOG OPTION *
  50. 500 ET = EF:EF = 3: HOME : PRINT : PRINT D$ LEFT$("CATALOG",7 -4 *( PEEK(48896) = 76)): IF F$ < >"?"  THEN  GOSUB 3430
  51. 510 EF = ET: RETURN 
  52. 520  REM  * PRINTER SLOT SELECTION *
  53. 530  HOME 
  54. 540  VTAB 12: PRINT "PRINTER SLOT: ";PS;BS$;: GET Z$: IF Z$ < >CR$  AND Z$ < >EX$  AND (Z$ <"1"  OR Z$ >"7") GOTO 540
  55. 550  IF Z$ = EX$  OR Z$ = CR$  THEN  PRINT : RETURN 
  56. 560  PRINT Z$:PS =  VAL(Z$): GOSUB 3430: RETURN 
  57. 570  REM  * DATA SET *
  58. 580  HOME : VTAB 12: HTAB 1: PRINT "DATA SET (1-10) ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  59. 590  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(DATA SET) BAD PARAMETER": GOSUB 2990: GOTO 580
  60. 600 SET =  VAL(WD$):SET =  FN A(SET)
  61. 610  IF SET <1  OR SET >10  THEN ER$ = "(DATA SET) OUT OF RANGE": GOSUB 2990: RETURN 
  62. 620 DSET = SET
  63. 630  RETURN 
  64. 640  REM  * INFLOW *
  65. 650  IF T(DSET) = 0  THEN ER$ = "(NUMBER OF PERIODS) NOT INPUT": GOSUB 2990: RETURN 
  66. 660  FOR I = 1 TO T(DSET)
  67. 670  HOME : VTAB 12: HTAB 1: PRINT "INFLOW ";I;" ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  68. 680  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(INFLOW) BAD PARAMETER": GOSUB 2990: GOTO 670
  69. 690 R(DSET,I) =  VAL(WD$):R(DSET,I) =  FN A(R(DSET,I))
  70. 700  NEXT 
  71. 710 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  72. 720  RETURN 
  73. 730  REM  * OUTFLOW *
  74. 740  IF T(DSET) = 0  THEN ER$ = "(NUMBER OF PERIODS) NOT INPUT": GOSUB 2990: RETURN 
  75. 750  FOR I = 1 TO T(DSET)
  76. 760  HOME : VTAB 12: HTAB 1: PRINT "OUTFLOW ";I;" ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  77. 770  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(OUTFLOW) BAD PARAMETER": GOSUB 2990: GOTO 760
  78. 780 D(DSET,I) =  VAL(WD$):D(DSET,I) =  FN A(D(DSET,I))
  79. 790  NEXT 
  80. 800 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  81. 810  RETURN 
  82. 820  REM  * RATE OF RETURN *
  83. 830  IF T(DSET) = 0  THEN ER$ = "(NUMBER OF PERIODS) NOT INPUT": GOSUB 2990: RETURN 
  84. 840  HOME : VTAB 12: HTAB 1: PRINT "RETURN RATE ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  85. 850  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(RETURN RATE) BAD PARAMETER": GOSUB 2990: GOTO 840
  86. 860 RR(DSET) =  VAL(WD$):RR(DSET) =  INT(100 *RR(DSET) +.5)/100
  87. 870 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  88. 880  RETURN 
  89. 890  REM  * COST *
  90. 900  IF T(DSET) = 0  THEN ER$ = "(NUMBER OF PERIODS) NOT INPUT": GOSUB 2990: RETURN 
  91. 910  HOME : VTAB 12: HTAB 1: PRINT "COST ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  92. 920  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(COST) BAD PARAMETER": GOSUB 2990: GOTO 910
  93. 930 CC(DSET) =  VAL(WD$):CC(DSET) =  FN A(CC(DSET))
  94. 940 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  95. 950  RETURN 
  96. 960  REM  * NUMBER OF PERIODS *
  97. 970  HOME : VTAB 12: HTAB 1: PRINT "NUMBER OF PERIODS (1-20)";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  98. 980  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(NUMBER OF PERIODS) BAD PARAMETER": GOSUB 2990: GOTO 970
  99. 990 TEST =  VAL(WD$):TEST =  FN A(TEST)
  100. 1000  IF TEST <1  OR TEST >20  THEN ER$ = "(NUMBER OF PERIODS) OUT OF RANGE": GOSUB 2990: GOTO 970
  101. 1010 T(DSET) = TEST
  102. 1020 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  103. 1030  RETURN 
  104. 1040  REM  * END VALUE *  
  105. 1050  IF T(DSET) = 0  THEN ER$ = "(NUMBER OF PERIODS) NOT INPUT": GOSUB 2990: RETURN 
  106. 1060  HOME : VTAB 12: HTAB 1: PRINT "END VALUE ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  107. 1070  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(END VALUE) BAD PARAMETER": GOSUB 2990: GOTO 1060
  108. 1080 RV(DSET) =  VAL(WD$):RV(DSET) =  FN A(RV(DSET))
  109. 1090 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  110. 1100  RETURN 
  111. 1110  REM  * CALCULATE *
  112. 1120  IF T(DSET) = 0  THEN ER$ = "(NUMBER OF PERIODS) NOT INPUT": GOSUB 2990: RETURN 
  113. 1130  IF CP = 1  THEN  PRINT : PRINT D$"PR#"PS
  114. 1140  HOME 
  115. 1150  PRINT "INFLOW AND OUTFLOW DATA ";DSET: PRINT 
  116. 1160  PRINT "PERIOD  INFLOW    OUTFLOW    EXPECTED"
  117. 1170  PRINT "        REVENUES  EXPENSES   PROFITS": REM 8/2/3 SPACES
  118. 1180  PRINT UL$
  119. 1190  FOR I = 1 TO T(DSET)
  120. 1200 B(DSET,I) = R(DSET,I) -D(DSET,I)
  121. 1210 X1$ =  STR$(R(DSET,I))
  122. 1220  IF  RIGHT$(X1$,4) >"D"  THEN X$ = X1$: GOSUB 3500:X1$ = X$: GOTO 1240
  123. 1230 X1$ =  STR$( FN A(R(DSET,I)))
  124. 1240 X2$ =  STR$(D(DSET,I))
  125. 1250  IF  RIGHT$(X2$,4) >"D"  THEN X$ = X2$: GOSUB 3500:X2$ = X$: GOTO 1270
  126. 1260 X2$ =  STR$( FN A(D(DSET,I)))
  127. 1270 X3$ =  STR$(B(DSET,I))
  128. 1280  IF  RIGHT$(X3$,4) >"D"  THEN X$ = X3$: GOSUB 3500:X3$ = X$: GOTO 1300
  129. 1290 X3$ =  STR$( FN A(B(DSET,I)))
  130. 1300  PRINT  SPC( 3 -(I >9));I; SPC( 10 - LEN(X1$));X1$; SPC( 10 - LEN(X2$));X2$; SPC( 11 - LEN(X3$));X3$
  131. 1310  IF CP = 1  THEN 1330
  132. 1320  IF I = 8  OR I = 16  THEN  PRINT : PRINT "PRESS <RETURN> TO CONTINUE ";: GET A$: PRINT : PRINT 
  133. 1330  NEXT 
  134. 1340  PRINT : PRINT "RETURN RATE";: PRINT  SPC( 18);RR(DSET);" %"
  135. 1350  PRINT "COST"; SPC( 25);CC(DSET)
  136. 1360  PRINT "END VALUE"; SPC( 20);RV(DSET)
  137. 1370  PRINT : PRINT "PRESENT VALUE": PRINT 
  138. 1380  PRINT "PERIOD  EXPECTED  ESTIMATED  EXPECTED"
  139. 1390  PRINT "        REVENUES  EXPENSES   PROFITS": REM 8/2/3 SPACES
  140. 1400  PRINT "        (PR. VAL) (PR. VAL)  (PR. VAL)": REM 8 SPACES
  141. 1410  PRINT UL$
  142. 1420 B = 0:R = 0:DD = 0
  143. 1430  FOR I = 1 TO T(DSET)
  144. 1440 R1(DSET,I) = R(DSET,I) *(1 +RR(DSET)/100) ^( -I)
  145. 1450 D1(DSET,I) = D(DSET,I) *(1 +RR(DSET)/100) ^( -I)
  146. 1460 B1(DSET,I) = R1(DSET,I) -D1(DSET,I)
  147. 1470 B = B +B1(DSET,I)
  148. 1480 R = R +R1(DSET,I)
  149. 1490 DD = DD +D1(DSET,I)
  150. 1500 X4$ =  STR$(R1(DSET,I))
  151. 1510  IF  RIGHT$(X4$,4) >"D"  THEN X$ = X4$: GOSUB 3500:X4$ = X$: GOTO 1530
  152. 1520 X4$ =  STR$( FN A(R1(DSET,I)))
  153. 1530 X5$ =  STR$(D1(DSET,I))
  154. 1540  IF  RIGHT$(X5$,4) >"D"  THEN X$ = X5$: GOSUB 3500:X5$ = X$: GOTO 1560
  155. 1550 X5$ =  STR$( FN A(D1(DSET,I)))
  156. 1560 X6$ =  STR$(B1(DSET,I))
  157. 1570  IF  RIGHT$(X6$,4) >"D"  THEN X$ = X6$: GOSUB 3500:X6$ = X$: GOTO 1590
  158. 1580 X6$ =  STR$( FN A(B1(DSET,I)))
  159. 1590  PRINT  SPC( 2 -(I >9));I; SPC( 12 - LEN(X4$));X4$;
  160. 1600  PRINT  SPC( 12 - LEN(X5$));X5$; SPC( 12 - LEN(X6$));X6$
  161. 1610  IF CP = 1  THEN 1630
  162. 1620  IF I = 8  OR I = 16  THEN  PRINT : PRINT "PRESS <RETURN> TO CONTINUE ";: GET A$: PRINT : PRINT 
  163. 1630  NEXT 
  164. 1640 VR = RV(DSET) *(1 +RR(DSET)/100) ^( -T(DSET) -1)
  165. 1650  PRINT : PRINT "PRESENT VALUE OF RESIDUAL";
  166. 1660  PRINT  SPC( 4); FN A(VR)
  167. 1670  PRINT : PRINT "RESULTS OF ANALYSIS"
  168. 1680  PRINT : PRINT "NET PRESENT VALUE OF CASH FLOW"
  169. 1690  PRINT "(INCLUDING RESIDUAL VALUE)";
  170. 1700 NPV(DSET) =  INT(B +VR -CC(DSET) +.5):X1$ =  STR$(NPV(DSET)): IF  RIGHT$(X1$,4) >"D"  THEN X$ = X1$: GOSUB 3500:X1$ = X$
  171. 1710  PRINT  SPC( 3);X1$
  172. 1720  PRINT : PRINT "PROFITABILITY INDEX";: IF DD +CC(DSET) = 0  THEN PI(DSET) = 0: GOTO 1740
  173. 1730 PI(DSET) =  INT(1000 *((R +VR)/(DD +CC(DSET))) +.5)/10
  174. 1740  PRINT  SPC( 10);PI(DSET);" %"
  175. 1750  REM  * INTERNAL RATE OF RETURN *
  176. 1760  IF CP  THEN  PRINT : PRINT D$"PR#0"
  177. 1770  PRINT : INVERSE : PRINT "WORKING  ";: NORMAL :T2 = 0:VP = 2 * PEEK(37):HP =  PEEK(36):PF = 8
  178. 1780  FOR TZ = 0 TO 100  STEP 0.1
  179. 1790 X = 0:PF = 17 -PF: COLOR= PF: PLOT HP,VP
  180. 1800  FOR I = 1 TO T(DSET)
  181. 1810 X = X +B(DSET,I) *(1 +TZ/100) ^( -I)
  182. 1820  NEXT 
  183. 1830 X = X +RV(DSET) *(1 +TZ/100) ^( -T(DSET) -1) -CC(DSET)
  184. 1840  IF X < = 0  THEN T2 = TZ
  185. 1850  IF X < = 0  THEN TZ = 100
  186. 1860  NEXT 
  187. 1870  HTAB 1: CALL  -868: PRINT  CHR$(7): IF CP  THEN  PRINT D$"PR#"PS
  188. 1880  HTAB 1: CALL CL: NORMAL : IF T1 >0  THEN 1890
  189. 1890  PRINT "INTERNAL RATE OF RETURN";
  190. 1900 IRR(DSET) =  INT(100 *T2 +.5)/100
  191. 1910  PRINT  SPC( 6);IRR(DSET);" %"
  192. 1920  IF CP = 1  THEN  PRINT : PRINT D$"PR#0
  193. 1930  PRINT : PRINT "PRESS <RETURN> FOR MENU ";: GET A$
  194. 1940  RETURN 
  195. 1950  REM  * QUIT *
  196. 1960  HOME 
  197. 1970  VTAB 10: INPUT "ARE YOU SURE YOU WANT TO QUIT? ";YN$: IF YN$ < >"Y"  AND YN$ < > CHR$(121)  THEN  RETURN 
  198. 1980  END 
  199. 1990  REM  * DISPLAY *
  200. 2000  HOME 
  201. 2010  IF CP = 1  THEN  PRINT : PRINT D$"PR#"PS
  202. 2020  PRINT "RETURN RATE";: PRINT  SPC( 18);RR(DSET);" %"
  203. 2030  PRINT "COST";: PRINT  SPC( 25);CC(DSET)
  204. 2040  PRINT "END VALUE";: PRINT  SPC( 20);RV(DSET)
  205. 2050  PRINT : PRINT "INFLOW AND OUTFLOW DATA ";DSET: PRINT 
  206. 2060  PRINT "  PERIOD     INFLOW       OUTFLOW": REM 2/5/7 SPACES
  207. 2070  PRINT "            REVENUES      EXPENSES": REM 12/6 SPACES 
  208. 2080  PRINT UL$
  209. 2090  IF T(DSET) = 0  THEN 2200
  210. 2100  FOR I = 1 TO T(DSET)
  211. 2110 X1$ =  STR$(R(DSET,I))
  212. 2120 X2$ =  STR$(D(DSET,I))
  213. 2130  PRINT  SPC( 4 -(I >9));I; SPC( 16 - LEN(X1$));X1$; SPC( 16 - LEN(X2$));X2$
  214. 2140  IF CP = 0  AND (I = 8  OR I = 16)  THEN  PRINT : PRINT "PRESS <RETURN> TO CONTINUE ";: GET A$: PRINT : PRINT 
  215. 2150  NEXT 
  216. 2160  PRINT : PRINT "NET PRESENT VALUE";: PRINT  SPC( 12);NPV(DSET)
  217. 2170  PRINT "PROFITABILITY INDEX";: PRINT  SPC( 10);PI(DSET);" %"
  218. 2180  PRINT "INTERNAL RATE OF RETURN";: PRINT  SPC( 6);IRR(DSET);" %"
  219. 2190  IF CP = 1  THEN  PRINT : PRINT D$"PR#0"
  220. 2200  PRINT : PRINT "PRESS <RETURN> FOR MENU ";: GET A$
  221. 2210  RETURN 
  222. 2220  REM  * DELETE *
  223. 2230  IF T(DSET) = 0  THEN ER$ = "(DELETE) NO DATA TO DELETE": GOSUB 2990: RETURN 
  224. 2240  HOME : VTAB 12: HTAB 1: PRINT "DELETE ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  225. 2250  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(DELETE) BAD PARAMETER": GOSUB 2990: RETURN 
  226. 2260 PT =  VAL(WD$):PT =  FN A(PT): IF PT <1  OR PT >T(DSET)  THEN ER$ = "(DELETE) NOT IN DATA SET": GOSUB 2990: RETURN 
  227. 2270 R(DSET,PT) = 0:D(DSET,PT) = 0: IF PT <T(DSET)  THEN  FOR RM = PT TO T(DSET) -1:R(DSET,RM) = R(DSET,RM +1):D(DSET,RM) = D(DSET,RM +1): NEXT RM
  228. 2280 T(DSET) = T(DSET) -1
  229. 2290 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  230. 2300  RETURN 
  231. 2310  REM  * EDIT *
  232. 2320  IF T(DSET) = 0  THEN ER$ = "(EDIT) NO DATA TO EDIT": GOSUB 2990: RETURN 
  233. 2330  HOME : VTAB 12: HTAB 1: PRINT "EDIT ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN  RETURN 
  234. 2340  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(EDIT) BAD PARAMETER": GOSUB 2990: GOTO 2330
  235. 2350 ED =  VAL(WD$):ED =  FN A(ED): IF ED <1  OR ED >T(DSET)  THEN ER$ = "(EDIT) NOT IN DATA SET": GOSUB 2990: GOTO 2330
  236. 2360  HOME : VTAB 10: PRINT "CURRENT VALUE: "R(DSET,ED): VTAB 23: HTAB 1: PRINT "PRESS <RETURN> TO KEEP CURRENT VALUE": VTAB 12: HTAB 1: PRINT "INFLOW ";ED;" ";: GOSUB 3040: ON IN$ = "" GOTO 2390: IF XF  THEN  RETURN 
  237. 2370  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(INFLOW) BAD PARAMETER": GOSUB 2990: GOTO 2360
  238. 2380 R(DSET,ED) =  VAL(WD$):R(DSET,ED) =  FN A(R(DSET,ED))
  239. 2390  HOME : VTAB 10: PRINT "CURRENT VALUE: "D(DSET,ED): VTAB 23: HTAB 1: PRINT "PRESS <RETURN> TO KEEP CURRENT VALUE": VTAB 12: HTAB 1: PRINT "OUTFLOW ";ED;" ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN 2420
  240. 2400  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(OUTFLOW) BAD PARAMETER": GOSUB 2990: GOTO 2390
  241. 2410 D(DSET,ED) =  VAL(WD$):D(DSET,ED) =  FN A(D(DSET,ED))
  242. 2420 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  243. 2430  RETURN 
  244. 2440  REM  * ADD *
  245. 2450 I = T(DSET) +1: IF I >20  THEN  HOME : VTAB 12: PRINT "MAXIMUM OF "ME" HAS BEEN REACHED.": PRINT "YOU MUST DELETE AN ENTRY TO ADD ANOTHER.": GOSUB 3430: RETURN 
  246. 2460 R(DSET,I) = 0:D(DSET,I) = 0
  247. 2470  HOME : VTAB 12: HTAB 1: PRINT "INFLOW ";I;" ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN 2500
  248. 2480  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(INFLOW) BAD PARAMETER": GOSUB 2990: GOTO 2470
  249. 2490 R(DSET,I) =  VAL(WD$):R(DSET,I) =  FN A(R(DSET,I))
  250. 2500  HOME : VTAB 12: HTAB 1: PRINT "OUTFLOW ";I;" ";: GOSUB 3040: IF IN$ = ""  OR XF  THEN IN$ = "0": GOTO 2530
  251. 2510  GOSUB 3170: IF RESULT < >1  THEN ER$ = "(OUTFLOW) BAD PARAMETER": GOSUB 2990: GOTO 2500
  252. 2520 D(DSET,I) =  VAL(WD$):D(DSET,I) =  FN A(D(DSET,I))
  253. 2530 T(DSET) = T(DSET) +1
  254. 2540 IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  255. 2550  RETURN 
  256. 2560  REM  * PRINT *
  257. 2570 CP = 1 -CP: GOSUB 480
  258. 2580  RETURN 
  259. 2590  REM  * CLEAR *
  260. 2600  IF T(DSET)  THEN  FOR I = 1 TO T(DSET):R(DSET,I) = 0:D(DSET,I) = 0: NEXT I
  261. 2610 T(DSET) = 0:CC(DSET) = 0:RR(DSET) = 0:RV(DSET) = 0:IRR(DSET) = 0:NPV(DSET) = 0:PI(DSET) = 0
  262. 2620  RETURN 
  263. 2630  REM  * SAVE *
  264. 2640 EF = 1: HOME : VTAB 12
  265. 2650  HTAB 1: PRINT "SAVE FILE (? FOR CATALOG)--": PRINT ":";: GOSUB 3040: IF IN$ = ""  OR XF  THEN F$ = "": GOTO 2780
  266. 2660 WD$ = IN$: GOSUB 3450: IF  LEFT$(WD$,1) = "?"  THEN  GOSUB 500: GOTO 2650
  267. 2670  IF QF  THEN ER$ = "(FILE NAME) NOT VALID": GOSUB 2990: GOTO 2640
  268. 2680 F$ = WD$: PRINT : PRINT D$"OPEN";F$: PRINT D$"CLOSE";F$: PRINT D$"DELETE";F$: PRINT D$"OPEN";F$: PRINT D$"WRITE";F$
  269. 2690  FOR DSET = 1 TO 10
  270. 2700  PRINT DSET
  271. 2710  PRINT T(DSET)
  272. 2720  FOR I = 1 TO T(DSET): PRINT R(DSET,I): PRINT D(DSET,I)
  273. 2730  NEXT 
  274. 2740  PRINT CC(DSET): PRINT RR(DSET): PRINT RV(DSET): PRINT IRR(DSET): PRINT NPV(DSET): PRINT PI(DSET)
  275. 2750  NEXT 
  276. 2760  PRINT D$"CLOSE";F$
  277. 2770 DSET = 1
  278. 2780 EF = 0
  279. 2790  RETURN 
  280. 2800  REM  * LOAD *
  281. 2810 EF = 2: HOME : VTAB 12
  282. 2820  HTAB 1: PRINT "LOAD FILE (? FOR CATALOG)--": PRINT ":";: GOSUB 3040: IF IN$ = ""  OR XF  THEN F$ = "": GOTO 2960
  283. 2830 WD$ = IN$: GOSUB 3450: IF  LEFT$(WD$,1) = "?"  THEN  GOSUB 500: GOTO 2820
  284. 2840  IF QF  THEN ER$ = "(FILE NAME) INVALID": GOSUB 2990: GOTO 2810
  285. 2850 F$ = WD$
  286. 2860  PRINT : PRINT D$"VERIFY";F$: PRINT D$"OPEN";F$: PRINT D$"READ";F$
  287. 2870  FOR DSET = 1 TO 10
  288. 2880  INPUT DSET
  289. 2890  INPUT T(DSET)
  290. 2900  FOR I = 1 TO T(DSET): INPUT R(DSET,I): INPUT D(DSET,I)
  291. 2910  NEXT 
  292. 2920  INPUT CC(DSET): INPUT RR(DSET): INPUT RV(DSET): INPUT IRR(DSET): INPUT NPV(DSET): INPUT PI(DSET)
  293. 2930  NEXT 
  294. 2940  PRINT D$"CLOSE";F$
  295. 2950 DSET = 1
  296. 2960 EF = 0
  297. 2970  RETURN 
  298. 2980  REM  * SUPPORT ROUTINES *
  299. 2990  HOME : VTAB 12: HTAB 1
  300. 3000  PRINT "ERROR ";ER$;
  301. 3010  GOSUB 3430
  302. 3020  RETURN 
  303. 3030  REM  * INPUT *
  304. 3040  CALL CL:HP =  PEEK(36):IN$ = "":XF = 0
  305. 3050  PRINT CS$;BS$;
  306. 3060  GET L1$
  307. 3070  IF L1$ = CR$  THEN  CALL CL: RETURN 
  308. 3080  IF L1$ = BS$  AND  LEN(IN$) >1  THEN  PRINT " ";BS$;BS$;:IN$ =  LEFT$(IN$, LEN(IN$) -1): GOTO 3050
  309. 3090  IF L1$ = BS$  AND  LEN(IN$) = 1  THEN  PRINT " ";BS$;BS$;:IN$ = "": GOTO 3050
  310. 3100  IF L1$ = BS$  THEN 3050
  311. 3110  IF L1$ = EX$  THEN  ON IN$ < >"" GOTO 3150:XF = 1: RETURN 
  312. 3120  IF L1$ <" "  THEN  PRINT  CHR$(7);: GOTO 3060
  313. 3130  IF L1$ > = " "  THEN  PRINT L1$;:IN$ = IN$ +L1$
  314. 3140  GOTO 3050
  315. 3150  POKE 36,HP: GOTO 3040
  316. 3160  REM  * GETWORD *
  317. 3170 WD$ = "":RESULT = 0
  318. 3180  IF IN$ = ""  THEN ER$ = "(GETWORD) STRING EMPTY": GOSUB 2990:RESULT = 3: RETURN 
  319. 3190 LC$ =  LEFT$(IN$,1)
  320. 3200  IF  LEN(IN$) >1  THEN IN$ =  RIGHT$(IN$, LEN(IN$) -1): GOTO 3220
  321. 3210 IN$ = ""
  322. 3220  IF LC$ = " "  THEN 3180
  323. 3230  IF LC$ = " "  OR LC$ = ","  THEN 3310
  324. 3240 WD$ = WD$ +LC$
  325. 3250  IF (LC$ <"0"  OR LC$ >"9")  AND LC$ < >"-"  AND LC$ < >"."  OR  LEN(IN$) >20  THEN RESULT = 2
  326. 3260 LC$ =  LEFT$(IN$,1)
  327. 3270  IF  LEN(IN$) >1  THEN IN$ =  RIGHT$(IN$, LEN(IN$) -1): GOTO 3290
  328. 3280 IN$ = ""
  329. 3290  IF IN$ < >""  THEN 3230
  330. 3300 WD$ = WD$ +LC$:RESULT = RESULT +1: RETURN 
  331. 3310 LC$ =  LEFT$(IN$,1): IF LC$ < >" "  THEN  RETURN 
  332. 3320 IN$ =  RIGHT$(IN$, LEN(IN$) -1): IF IN$ = ""  OR XF  THEN 3300
  333. 3330  GOTO 3310
  334. 3340  REM  * ERROR *
  335. 3350 ERR =  PEEK(222):ELINE =  PEEK(218) +256 * PEEK(219): CALL  -3288
  336. 3360  HOME : VTAB 12: HTAB 1
  337. 3370  IF (ER = 11  AND  PEEK(48896) = 76)  OR ER = 6  THEN  PRINT "FILE NOT FOUND": GOTO 3420
  338. 3380  IF ER = 5  THEN  PRINT "NO MORE DATA IN FILE": GOTO 3420
  339. 3390  IF ER = 8  THEN  PRINT "I/O ERROR--CHECK DRIVE DOOR.": GOTO 3420
  340. 3400  IF EF = 1  AND (ER = 53  OR ER = 69  OR ER = 133)  THEN  PRINT "ERROR "ER" IN LINE "EL".": GOTO 190
  341. 3410  PRINT "ERROR "ER" IN LINE "EL".": END 
  342. 3420  GOSUB 3430: ON EF GOTO 2640,2810,500
  343. 3430  VTAB 23: HTAB 6: PRINT "PRESS <RETURN> TO CONTINUE";: GET Z$: PRINT : RETURN 
  344. 3440  REM  * VALIDATE FILE NAME *
  345. 3450 QF = 0: IF  LEN(WD$) >15  THEN QF = 1: GOTO 3490
  346. 3460  FOR I = 1 TO  LEN(WD$):LC$ =  MID$ (WD$,I,1): IF I = 1  AND (LC$ <"A"  OR LC$ >"Z")  AND LC$ < >"?"  THEN I =  LEN(WD$):QF = 1: GOTO 3480
  347. 3470  IF LC$ >"Z"  OR (LC$ <"0"  AND LC$ < >".")  OR (LC$ >"9"  AND LC$ <"A")  THEN QF = 1:I =  LEN(WD$)
  348. 3480  NEXT I
  349. 3490  RETURN 
  350. 3500  IF  LEN(X$) = 14  THEN X$ = " " +X$
  351. 3510 X$ =  STR$( FN B( VAL( LEFT$(X$,11)))) + RIGHT$(X$,4): RETURN 
  352. 3520  RESTORE : READ NMENUS: DIM MENU$(NMENUS,9): FOR I = 1 TO NMENUS: READ MITEMS(I): FOR J = 0 TO MITEMS(I): READ MENU$(I,J): NEXT J,I
  353. 3530  RETURN 
  354. 3540  HOME : IF EM  THEN  PRINT "<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR ";MENU$(EM,0)
  355. 3550  VTAB 1: HTAB 24: PRINT "DATA SET: "DSET
  356. 3560 TL$ = MENU$(TL,0): VTAB 3: HTAB  INT((40 - LEN(TL$))/2): INVERSE : PRINT TL$;: NORMAL 
  357. 3570  FOR I = 1 TO MITEMS(TL): VTAB 3 +2 *I: HTAB 8: PRINT I". "MENU$(TL,I): NEXT 
  358. 3580  VTAB 23: HTAB 1: INVERSE : PRINT " USE ARROWS OR SELECT NUMBER: ";: NORMAL : RETURN 
  359. 3590 N = SL:OS = SL: GOSUB 3620:Z = 0: VTAB 23: HTAB PX: CALL  -868: POKE  -16368,0
  360. 3600  VTAB 23: HTAB PX: PRINT SL;: GET Z$: IF Z$ > = "1"  AND Z$ < =  STR$(MX)  THEN SL =  VAL(Z$):N = OS: GOSUB 3620: GOTO 3590
  361. 3610 Z = (Z$ = FS$  OR Z$ = DA$) -(Z$ = BS$  OR Z$ = UA$) +10 *(Z$ = CR$) +20 *(Z$ = EX$): ON   NOT Z GOTO 3600:SL = SL +Z *(Z <10):SL = SL -MX *(SL >MX) +MX *(SL <1):N = OS: GOSUB 3620: ON Z <10 GOTO 3590: PRINT : RETURN 
  362. 3620  VTAB 3 +2 *N: HTAB SX: PRINT X$(SL = OS);: RETURN 
  363. 3630  DATA 5,8,MAIN MENU,DISK OPERATIONS,INPUT NEW DATA,CHANGE FLOW DATA,SELECT DATA SET,CALCULATE,PRINT OPTIONS,CLEAR,QUIT
  364. 3640  DATA 3,DISK OPERATIONS,LOAD,SAVE,CATALOG
  365. 3650  DATA 7,INPUT NEW DATA,DISPLAY DATA,NUMBER OF PERIODS,INFLOW (NEW DATA),OUTFLOW (NEW DATA),RATE OF RETURN,COST,END VALUE
  366. 3660  DATA 4,CHANGE FLOW DATA,DISPLAY DATA,ADD FLOW DATA,EDIT FLOW DATA,DELETE FLOW DATA
  367. 3670  DATA 2,PRINT OPTIONS,TOGGLE PRINTER STATUS,SELECT SLOT