home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib29a.dsk / NOVEMBER.1986 / LOAN.SCHED.bas < prev    next >
BASIC Source File  |  2023-02-26  |  6KB  |  123 lines
  1. 10  REM  ************************
  2. 20  REM  * LOAN.SCHED           *
  3. 30  REM  * BY R.K. KLEPAC, PH.D.*
  4. 40  REM  * COPYRIGHT 1986       *
  5. 50  REM  * BY MICROSPARC, INC.  *
  6. 60  REM  * CONCORD, MA 01742    *
  7. 70  REM  ************************
  8. 80  GOTO 260
  9. 90  REM  ******* PAYMENT CALC SBRTN *****
  10. 100 I = J/1200
  11. 110 PMT = (K *I)/(1 -(1 +I) ^( -A(6)))
  12. 120  RETURN 
  13. 130  REM  ******* PRINT USING SUBRTN *****
  14. 140  IF P <0  THEN P = 0
  15. 150 P$ =  STR$( INT((P +.005) *100))
  16. 160  IF  LEN(P$) <3  THEN P$ =  LEFT$("000",(3 - LEN(P$))) +P$
  17. 170  IF  LEN(P$) > = 7  THEN P$ =  LEFT$(P$,5): GOTO 190
  18. 180 P$ =  LEFT$(P$,( LEN(P$) -2)) +"." + RIGHT$(P$,2)
  19. 190 P$ =  RIGHT$("     " +P$,PL): IF  VAL(P$) +1 <P  THEN P$ = "  >9999"
  20. 200  RETURN 
  21. 210  REM  ******* CONTINUE SBRTN *********
  22. 220  VTAB (24): CALL  -868: INVERSE : PRINT BP$" PRESS <RETURN> TO CONTINUE ";: NORMAL : GET DUMMY$: PRINT DUMMY$: RETURN 
  23. 230  REM  ******* CTRL-C TO QUIT SBRTN ***
  24. 240  VTAB 24: INVERSE : PRINT " HOLD DOWN 'CTRL' & PRESS 'C' TO QUIT ";: NORMAL : POKE 35,23: PRINT : RETURN 
  25. 250  REM  ******* MAIN PROGRM SETUP ******
  26. 260 Q$(1) = "LARGEST LOAN AMOUNT": ONERR  GOTO 1190
  27. 270 Q$(2) = "CHANGE IN LOAN AMOUNT"
  28. 280 Q$(3) = "LARGEST INTEREST RATE"
  29. 290 Q$(4) = "CHANGE IN INTEREST RATE"
  30. 300 Q$(5) = "SMALLEST INTEREST RATE"
  31. 310 Q$(6) = "LOAN TERM (MONTHS)"
  32. 320 Q$(7) = "TABLE TO PRNTR OR SCRN (P/S)"
  33. 330 Q$(8) = "PRINTER SLOT"
  34. 340 D$ =  CHR$(4)
  35. 350 BP$ =  CHR$(7)
  36. 360  REM  ******* INPUT PARAMETERS *******
  37. 370  HOME :CE$ = " **  LOAN SCHEDULE  ** ": HTAB 21 -( LEN(CE$)/2): INVERSE : PRINT CE$: NORMAL 
  38. 380 TB = 2
  39. 390  VTAB (TB +1): FOR I = 1 TO 39: PRINT "=";: NEXT : PRINT 
  40. 400  FOR I = 1 TO 6:VT = (TB +(2 *I)): VTAB (VT): CALL  -868
  41. 410  PRINT I". "Q$(I);: HTAB 33: IF A$(I) < >""  THEN  PRINT A$(I): GOTO 480
  42. 420  VTAB (VT): HTAB 33: PRINT A$(I);: CALL  -868: GET X$: PRINT X$: IF X$ < >","  AND X$ < >";"  AND X$ < >":"  THEN  GOTO 440
  43. 430  INVERSE : PRINT : PRINT BP$" USE NO COMMAS OR OTHER PUNCTUATION ": NORMAL : GOTO 420
  44. 440  IF X$ =  CHR$(13)  THEN 480
  45. 450  IF X$ =  CHR$(8)  THEN LA =  LEN(A$(I)): IF LA < = 1  THEN A$(I) = "": GOTO 420
  46. 460  IF X$ =  CHR$(8)  THEN LA = LA -1:A$(I) =  LEFT$(A$(I),LA): GOTO 420
  47. 470 A$(I) = A$(I) +X$: GOTO 420
  48. 480  NEXT 
  49. 490 I = 7: VTAB (TB +(2 *I)): PRINT I". "Q$(I);: IF A$(I) < >""  THEN  HTAB 33: PRINT A$(I): GOTO 510
  50. 500  VTAB (TB +(2 *I)): HTAB 33: INPUT "";A$(I): VTAB (TB +(2 *I)): HTAB 27: PRINT "     "
  51. 510  IF A$(7) = "P"  OR A$(7) = "S"  THEN 530
  52. 520  FLASH : VTAB 16: HTAB 27: CALL  -868: PRINT BP$"(P/S)";: NORMAL : GOTO 500
  53. 530 I = 8: VTAB (TB +(2 *I)): PRINT I". "Q$(I);: IF A$(I) = ""  OR  VAL(A$(I)) <0  OR  VAL(A$(I)) >7  THEN  GOTO 550
  54. 540  HTAB 33: PRINT A$(I): GOTO 570
  55. 550  VTAB (TB +(2 *I)): HTAB 33: CALL  -868: INPUT "";A$(I): GOTO 530
  56. 560  REM  ***** EDIT/EXIT ROUTINES *******
  57. 570  VTAB (TB +17): FOR I = 1 TO 39: PRINT "=";: NEXT : PRINT 
  58. 580  VTAB (TB +21): INVERSE : PRINT " TYPE 'Q' TO QUIT ": NORMAL : VTAB (TB +19): PRINT "ANY CHANGES? (Y/N) -->";: GET Y$: PRINT Y$: CALL  -958
  59. 590  IF Y$ = "Q"  THEN  HOME : VTAB 10: PRINT "TO RESTART PROGRAM, TYPE:": VTAB 12: HTAB 2: PRINT "GOTO 370": VTAB 14: PRINT "THEN PRESS <RETURN>": VTAB 11: END 
  60. 600  IF Y$ = "Y"  THEN  GOTO 720
  61. 610  IF Y$ = "N"  THEN  GOTO 640
  62. 620  IF  ASC(Y$) > = 49  AND  ASC(Y$) < = 56  THEN W$ = Y$: GOTO 730
  63. 630  PRINT BP$: GOTO 570
  64. 640  FOR I = 1 TO 6:A(I) =  VAL(A$(I)): NEXT 
  65. 650 J = 1
  66. 660  IF A$(J) = ""  THEN  VTAB (TB +17): PRINT BP$: INVERSE : PRINT " PLEASE ENTER "Q$(J)" ": NORMAL :W$ =  STR$(J): GOTO 730
  67. 670 J = J +1: IF J = 9  THEN J = 1: GOTO 690
  68. 680  GOTO 660
  69. 690  IF A$(7) = "S"  THEN  GOTO 770
  70. 700  IF A$(7) = "P"  THEN  GOTO 950
  71. 710  PRINT BP$: GOTO 570
  72. 720  VTAB (TB +19): CALL  -868: PRINT "CHANGE WHICH ONE? (1-8) --> ";: GET W$: PRINT W$: VTAB (TB +17)
  73. 730 W =  VAL(W$): IF W <1  OR W >8  THEN  PRINT BP$: GOTO 720
  74. 740  VTAB (TB +19): CALL  -868: INVERSE : PRINT " TYPE NEW ENTRY IN TABLE ABOVE ";: NORMAL 
  75. 750  VTAB (TB +(2 *W)): HTAB 33: CALL  -868: INPUT "";A$(W): GOTO 370
  76. 760  REM  ******* SCREEN OUTPUT **********
  77. 770  ONERR  GOTO 1190
  78. 780  HOME : HTAB (13): INVERSE : PRINT " TERM: ";A(6);" MONTHS ": NORMAL 
  79. 790  VTAB (2): PRINT "   RATE";: IF A(2) = 0  THEN P$ =  STR$( INT(A(1))):PL = 8: GOSUB 190: PRINT P$;: PRINT : GOTO 810
  80. 800  FOR K = A(1) -3 *A(2) TO A(1)  STEP A(2):P$ =  STR$( INT(K)):PL = 8: GOSUB 190: PRINT P$;: NEXT K: PRINT 
  81. 810  VTAB 3: FOR DASH = 0 TO 39: PRINT "-";: NEXT DASH: PRINT : POKE 34,4: GOSUB 240: HOME 
  82. 820  REM  ***.BODY.OF.OUTPUT.TABLE.***
  83. 830 J = A(3)
  84. 840 P = J:PL = 8: GOSUB 140: PRINT P$;: IF A(2) = 0  THEN K = A(1): GOSUB 100:P = PMT:PL = 8: GOSUB 140: PRINT P$: GOTO 890
  85. 850  FOR K = A(1) -3 *A(2) TO A(1)  STEP A(2)
  86. 860  GOSUB 100
  87. 870 P = PMT:PL = 8: GOSUB 140: PRINT P$;
  88. 880  NEXT K
  89. 890 J = J -A(4): IF A(4) = 0  THEN  GOSUB 220: GOTO 930
  90. 900  IF  PEEK(37) <22  AND J >0  AND J >A(5)  THEN 840
  91. 910  GOSUB 220
  92. 920  IF J >0  AND J >A(5)  THEN  GOSUB 240: HOME : GOTO 840
  93. 930  TEXT : HOME : GOTO 370
  94. 940  REM  ******* PRINTER OUTPUT ********
  95. 950  GOSUB 240: ONERR  GOTO 1190
  96. 960  PRINT D$"PR#"A$(8): PRINT :F3 = 0
  97. 970  IF A(4) <.5  THEN F2 = 1
  98. 980  HOME : HTAB (33): PRINT "TERM: ";A(6);" MONTHS"
  99. 990  VTAB (2): PRINT "   RATE";
  100. 1000  FOR K = A(1) -8 *A(2) TO A(1)  STEP A(2):P$ =  STR$( INT(K)):PL = 8: GOSUB 190: PRINT P$;: NEXT K
  101. 1010  PRINT 
  102. 1020  FOR DASH = 1 TO 79: PRINT "-";: NEXT DASH
  103. 1030  PRINT 
  104. 1040  REM 
  105. 1050 J = A(3)
  106. 1060 P = J:PL = 8: GOSUB 140: IF F2  AND  RIGHT$(P$,2) = "00"  THEN  PRINT 
  107. 1070  PRINT P$;
  108. 1080  FOR K = A(1) -8 *A(2) TO A(1)  STEP A(2)
  109. 1090  GOSUB 100
  110. 1100 P = PMT:PL = 8: GOSUB 140: PRINT P$;
  111. 1110  NEXT K
  112. 1120 J = J -A(4): IF F2  THEN 1140
  113. 1130 F3 = F3 +1: IF F3 = 4  THEN F3 = 0: PRINT : GOTO 1150
  114. 1140 J$ =  STR$(J): IF  RIGHT$(J$,2) = "00"  THEN  PRINT : PRINT 
  115. 1150  IF J > = A(5)  AND J >0  THEN  PRINT : GOTO 1060
  116. 1160  PRINT : PRINT D$"PR#0"
  117. 1170  TEXT : HOME : GOTO 370
  118. 1180  REM  ******* ERROR TRAPS **********
  119. 1190 E =  PEEK(222):LINE =  PEEK(218) +256 * PEEK(219)
  120. 1200  IF E = 255  THEN  TEXT : HOME : GOTO 370
  121. 1210  HOME : VTAB 12: PRINT "ERROR "E" IN LINE "LINE
  122. 1220  PRINT : PRINT "<ESC> TO QUIT, <RETURN> TO CHANGE DATA";: GET Z$: IF Z$ < > CHR$(27) GOTO 370
  123. 1230  TEXT : END