home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / zbasic / pia / piaout.bas < prev    next >
Encoding:
BASIC Source File  |  1987-11-03  |  34.1 KB  |  753 lines
  1. 100 DEFINT A,G,I,K,M,N,P,S,T,U,W: DEFDBL B,C,D,L,O
  2. 101 DEFSNG E,F,H,J,Q,R,V,X,Y,Z
  3. 105 REM $INCLUDE: 'COMMON.BAS'
  4. 110 REM $INCLUDE: 'GETSTRN.BAS'
  5. 310 S$=CHR$(12)
  6. 500 U$(1)="NONE": V$="NONE": Y$="": U$(2)="": U$(3)="": U$(4)="": K7=0
  7. 600 REM Get current date
  8. 605 C$=MID$(DATE$,1,2): T(13,1)=VAL(C$)
  9. 610 C$=MID$(DATE$,4,2): T(13,2)=VAL(C$)
  10. 615 C$=MID$(DATE$,7,4): T(13,3)=VAL(C$)
  11. 1000 REM Print warning to turn printer on
  12. 1005 CLS: GOSUB 6400: PRINT "   ";: GOSUB 9870
  13. 1010 PRINT STRING$(30," ");"Prepare printer";STRING$(30," ")
  14. 1015 GOSUB 6400: GOSUB 9850
  15. 1020 PRINT: PRINT: PRINT "   Printer should be on and paper ";
  16. 1025 PRINT "should be positioned"
  17. 1030 PRINT "   1/2 inch below top of form.": PRINT
  18. 1035 GOSUB 6800
  19. 1100 REM Print main menu
  20. 1105 CLS: GOSUB 6400: PRINT "   ";: GOSUB 9870
  21. 1110 PRINT STRING$(29," ");"Print out results";STRING$(29," ")
  22. 1115 GOSUB 6400: GOSUB 9860
  23. 1120 PRINT: PRINT: PRINT "   Enter desired printed output (listed in ";
  24. 1121 PRINT "order of increasing detail):"
  25. 1125 PRINT "      0 to exit printout for this case"
  26. 1130 PRINT "      1 for benefit estimate letter"
  27. 1135 PRINT "      2 for one-page summary (includes indexed earnings)"
  28. 1140 PRINT "      3 for two-page summary"
  29. 1145 PRINT "      4 for details of all calculations"
  30. 1150 PRINT "   > ";: K9=VAL(FNGETSTRN$(1)): GOSUB 9850
  31. 1155 IF K9<0 OR K9>4 THEN BEEP: GOTO 1120
  32. 1160 IF K9=0 THEN 5000
  33. 1161 IF K9=4 AND K7=0 THEN 2000
  34. 1165 ON K9 GOTO 1600,1200,2000,2500
  35. 1200 REM Print one-page summary
  36. 1205 IF U$(1)="NONE" THEN GOSUB 6600
  37. 1206 IF G8 THEN GOSUB 6800
  38. 1207 GOSUB 9850: PRINT "   Printing one-page summary"
  39. 1210 ON A5 GOTO 1215,1220,1225
  40. 1215 LPRINT TAB(25);"R E T I R E M E N T   E S T I M A T E": GOTO 1230
  41. 1220 LPRINT TAB(27);"S U R V I V O R   E S T I M A T E": GOTO 1230
  42. 1225 LPRINT TAB(25);"D I S A B I L I T Y   E S T I M A T E"
  43. 1230 LPRINT: LPRINT: LPRINT: LPRINT TAB(15);
  44. 1231 IF A5=2 THEN 1234
  45. 1232 IF LEN(U$(1)) THEN LPRINT "Wage earner:  ";U$(1);
  46. 1233 GOTO 1235
  47. 1234 IF LEN(Y$) THEN LPRINT "Wage earner:  ";Y$;
  48. 1235 LPRINT TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
  49. 1236 IF LEN(V$) THEN LPRINT TAB(15);"SSN:  ";V$
  50. 1237 LPRINT TAB(15);
  51. 1238 LPRINT "Date of birth:  ";D$(T(5,1));STR$(T(5,2));",";T(5,3)
  52. 1240 IF A5=2 THEN LPRINT TAB(15);"Date of death:  ";D$(T(3,1));T(3,2)
  53. 1245 IF A5<>3 THEN 1250
  54. 1247 LPRINT TAB(15);"Date of onset:  ";D$(T(9,1));STR$(T(9,2));",";
  55. 1248 LPRINT T(9,3)
  56. 1250 LPRINT: LPRINT
  57. 1252 REM Print regular earnings
  58. 1255 LPRINT TAB(28);"R E G U L A R   E A R N I N G S"
  59. 1260 LPRINT: LPRINT
  60. 1261 IF C1>0! THEN 1265
  61. 1262 I1=U3-1950-((U3-1951) MOD 5): IF I1<1 THEN I1=1
  62. 1263 GOTO 1269
  63. 1265 LPRINT USING "     50 ######,.##";C1: I1=1
  64. 1269 I4=(U4-1945-((U4-1951) MOD 5)-I1)/5: I3=I1+I4-1
  65. 1270 FOR K1=I1 TO I3: LPRINT "   ";: FOR K2=0 TO 4
  66. 1275 I2=(50+K1+I4*K2) MOD 100
  67. 1280 IF I2>9 THEN LPRINT USING "  ##";I2; ELSE LPRINT USING "  0#";I2;
  68. 1285 LPRINT USING " ######,.##";O(14+K1+I4*K2);
  69. 1290 NEXT K2: LPRINT: NEXT K1
  70. 1295 IF A(1,2)+A(1,4)=0 THEN 1320
  71. 1300 LPRINT: LPRINT "     Dividend:";
  72. 1305 IF A(1,2)>0 THEN LPRINT USING "########,.##";D(9,2);
  73. 1310 IF A(1,4)>0 THEN LPRINT USING "########,.##";D(9,4);
  74. 1315 LPRINT TAB(60);"Divisor months:";12*N1
  75. 1320 LPRINT: LPRINT
  76. 1322 REM Print indexed earnings
  77. 1325 LPRINT TAB(28);"I N D E X E D   E A R N I N G S"
  78. 1330 LPRINT: LPRINT
  79. 1335 FOR K1=I1 TO I3: LPRINT "   ";: FOR K2=0 TO 4
  80. 1340 I2=(50+K1+I4*K2) MOD 100
  81. 1345 IF I2>9 THEN LPRINT USING "  ##";I2; ELSE LPRINT USING "  0#";I2;
  82. 1350 LPRINT USING " ######,.##";L(3,K1+I4*K2);
  83. 1355 NEXT K2: LPRINT: NEXT K1
  84. 1360 LPRINT: LPRINT "     Dividend:";
  85. 1365 LPRINT USING "##,###,###.##";D(9,3);
  86. 1370 LPRINT TAB(60);"Divisor months:";12*N1
  87. 1400 REM Print bottom part of page
  88. 1405 C$=" ": IF M8<>3 THEN C$="*"
  89. 1410 LPRINT: LPRINT "     Eff.";
  90. 1415 IF C5>=1! THEN LPRINT TAB(34);"Increment";: GOTO 1425
  91. 1420 LPRINT TAB(34);"Reduction";
  92. 1425 LPRINT TAB(57);"Family"
  93. 1430 LPRINT "     date      AIME      PIA       factor      MBA      ";
  94. 1432 LPRINT "maximum"
  95. 1435 LPRINT "     -----    ------    ------    ---------   ------    ";
  96. 1437 LPRINT "-------"
  97. 1440 LPRINT USING "     ##/";T(2,1);: I2=T(2,2) MOD 100
  98. 1442 IF I2>9 THEN LPRINT USING "##";I2; ELSE LPRINT USING "0#";I2;
  99. 1445 LPRINT USING "   ######";D(5,3);
  100. 1450 LPRINT USING "   #####.##";D(1,3);
  101. 1455 LPRINT USING "     #.#####";C5;: LPRINT USING "  #####.##";X2;
  102. 1465 LPRINT C$;: LPRINT USING "  #####.##";X1;: LPRINT C$: LPRINT
  103. 1485 IF C$="*" THEN LPRINT "      *Based on ";F$(M8)
  104. 1490 IF A(1,1)=0 THEN 1495
  105. 1492 LPRINT "       ";F$(1);: LPRINT USING " PIA: ####.##";D(1,1)
  106. 1495 IF A(1,2)=0 THEN 1500
  107. 1497 LPRINT "       ";F$(2);: LPRINT USING " PIA: ####.##";D(1,2)
  108. 1500 IF A(1,4)=0 THEN 1505
  109. 1502 LPRINT "       ";F$(4);: LPRINT USING " PIA: ####.##";D(1,4)
  110. 1505 IF A(1,5)=0 THEN 1510
  111. 1507 LPRINT "       ";F$(5);: LPRINT USING " PIA: ####.##";D(1,5)
  112. 1510 IF A(1,6)=0 THEN 1513
  113. 1512 LPRINT "       ";F$(6);: LPRINT USING " PIA: ####.##";D(1,6)
  114. 1513 IF S2<S4 THEN GOSUB 7300
  115. 1514 IF A5=3 THEN GOSUB 7800
  116. 1515 LPRINT S$: GOTO 1100
  117. 1600 REM Print benefit estimate letter
  118. 1601 IF (A1>4 AND A1<8 AND T3>5 AND T3<8) OR T(2,2)=1936+N2 THEN 1605
  119. 1602 GOSUB 9840: PRINT "   Must be POMS assumptions for letter"
  120. 1603 BEEP: GOSUB 6700: GOTO 1100
  121. 1605 IF U$(1)="NONE" THEN GOSUB 6600
  122. 1606 OPEN "I",1,"ADDRESS.DAT"
  123. 1610 FOR K1=1 TO 4: INPUT #1,T$(K1): NEXT K1: CLOSE #1
  124. 1611 IF G8 THEN GOSUB 6800
  125. 1612 GOSUB 9850: PRINT "   Printing benefit estimate letter"
  126. 1620 LPRINT "      ";STRING$(71,"="): LPRINT
  127. 1625 LPRINT "      S O C I A L   S E C U R I T Y   E S T I M A T E   ";
  128. 1630 LPRINT "O F   B E N E F I T S": LPRINT
  129. 1635 LPRINT "      ";STRING$(71,"="): LPRINT: LPRINT "      ";T$(1)
  130. 1640 LPRINT "      ";T$(2);TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
  131. 1645 LPRINT "      ";T$(3): IF LEN(T$(4)) THEN LPRINT "      ";T$(4)
  132. 1650 LPRINT: LPRINT "      ";STRING$(71,"="): LPRINT
  133. 1652 FOR K1=1 TO 4
  134. 1653 IF LEN(U$(K1)) THEN LPRINT "      ";U$(K1)
  135. 1655 NEXT K1: LPRINT: LPRINT: LPRINT: LPRINT
  136. 1659 IF A5=2 THEN 1662
  137. 1660 IF LEN(U$(1)) THEN LPRINT "      Wage earner:  ";U$(1): LPRINT
  138. 1661 GOTO 1665
  139. 1662 IF LEN(Y$) THEN LPRINT "      Wage earner:  ";Y$: LPRINT
  140. 1665 IF LEN(V$) THEN LPRINT "      SSN:  ";V$: LPRINT: LPRINT: LPRINT
  141. 1670 LPRINT "      This is in response to your request for an estimate";
  142. 1672 LPRINT " of your monthly"
  143. 1675 ON A5 GOTO 1678,1755,1900
  144. 1678 REM Print old-age paragraph
  145. 1680 LPRINT "      Social Security retirement benefit.  Based on our ";
  146. 1682 LPRINT "records and the"
  147. 1685 LPRINT "      estimate you provided of your additional future ";
  148. 1687 LPRINT "earnings, the monthly"
  149. 1690 LPRINT "      benefit estimate, in terms of";1936+N2;
  150. 1695 LPRINT "dollars, is:": LPRINT
  151. 1700 LPRINT "           o";: IF X2>999.99 THEN 1702
  152. 1701 LPRINT USING "$$###";X2;: GOTO 1705
  153. 1702 LPRINT USING "$$####";X2;
  154. 1705 LPRINT " beginning with the month that you attain"
  155. 1710 LPRINT "             age";STR$(T(1,1));
  156. 1715 IF T(1,2)=0 THEN LPRINT: GOTO 1720
  157. 1716 LPRINT " and";STR$(T(1,2));
  158. 1717 IF T(1,2)=1 THEN LPRINT " month" ELSE LPRINT " months"
  159. 1720 IF A7<N4 THEN 1940
  160. 1721 IF C5<1! OR A7>48 THEN 1738
  161. 1722 REM Print age-62 paragraph
  162. 1724 V8=.8: IF T(7,2)=1 THEN V8=.8055556
  163. 1726 V9=V8*V6: V9=FIX(V9): LPRINT
  164. 1728 LPRINT "           o";: IF V9>999.99 THEN 1730
  165. 1729 LPRINT USING "$$###";V9;: GOTO 1731
  166. 1730 LPRINT USING "$$####";V9;
  167. 1731 LPRINT " should you take your benefit at the earliest"
  168. 1732 LPRINT "             possible age of";STR$(T(7,1));
  169. 1734 IF T(7,2) THEN LPRINT " and";T(7,2);"month" ELSE LPRINT
  170. 1736 GOTO 1940
  171. 1738 REM Print normal-retirement-age paragraph
  172. 1739 IF C5>=1! THEN 1940 ELSE LPRINT
  173. 1740 LPRINT "           o";: IF FIX(V6)>999.99 THEN 1742
  174. 1741 LPRINT USING "$$###";FIX(V6);: GOTO 1743
  175. 1742 LPRINT USING "$$####";FIX(V6);
  176. 1743 LPRINT " should you wait and take your benefit at"
  177. 1744 LPRINT "             your normal retirement age of";STR$(T(6,1));
  178. 1746 IF T(6,2) THEN LPRINT " and";T(6,2);"months" ELSE LPRINT
  179. 1748 GOTO 1940
  180. 1755 REM Print survivor paragraph
  181. 1760 ON A4 GOTO 1765,1800,1850
  182. 1765 LPRINT "      Social Security survivor benefits.  Based on our ";
  183. 1767 LPRINT "records and the"
  184. 1770 LPRINT "      estimate you provided of additional future ";
  185. 1772 LPRINT "earnings for the wage"
  186. 1775 LPRINT "      earner, and an assumed date of death of ";D$(T(3,1));
  187. 1777 LPRINT STR$(T(3,2));", the monthly"
  188. 1780 LPRINT "      benefit estimate for each survivor, in terms of";
  189. 1782 LPRINT 1936+N2;"dollars, is:": LPRINT
  190. 1785 LPRINT "           o";: IF X2>999.99 THEN 1787
  191. 1786 LPRINT USING "$$###";X2;: GOTO 1788
  192. 1787 LPRINT USING "$$####";X2;
  193. 1788 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));".": LPRINT
  194. 1790 LPRINT "      Total monthly payments to all survivors would be ";
  195. 1792 LPRINT "limited to";: LPRINT USING "$$####.##";X1;
  196. 1795 LPRINT ".": GOTO 1940
  197. 1800 LPRINT "      Social Security surviving disabled spouse benefit.";
  198. 1802 LPRINT "  Based on our"
  199. 1805 LPRINT "      records and the estimate you provided of ";
  200. 1807 LPRINT "additional future earnings"
  201. 1810 LPRINT "      for the wage earner, and an assumed date of death ";
  202. 1812 LPRINT "of ";D$(T(3,1));STR$(T(3,2));","
  203. 1815 LPRINT "      the monthly benefit estimate, in terms of";1936+N2;
  204. 1820 LPRINT "dollars, is:": LPRINT
  205. 1825 LPRINT "           o";: IF X2>999.99 THEN 1835
  206. 1830 LPRINT USING "$$###";X2;: GOTO 1840
  207. 1835 LPRINT USING "$$####";X2;
  208. 1840 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));"."
  209. 1845 GOTO 1940
  210. 1850 LPRINT "      Social Security surviving spouse benefit.  Based ";
  211. 1852 LPRINT "on our records and"
  212. 1855 LPRINT "      the estimate you provided of additional future";
  213. 1857 LPRINT " earnings for the wage"
  214. 1860 LPRINT "      earner, and an assumed date of death of ";D$(T(3,1));
  215. 1862 LPRINT STR$(T(3,2));", the monthly"
  216. 1865 LPRINT "      benefit estimate, in terms of";1936+N2;"dollars, is:"
  217. 1867 LPRINT: LPRINT "           o";: IF X2>999.99 THEN 1872
  218. 1870 LPRINT USING "$$###";X2;: GOTO 1875
  219. 1872 LPRINT USING "$$####";X2;
  220. 1875 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));"."
  221. 1880 GOTO 1940
  222. 1898 REM Print disability paragraph
  223. 1900 LPRINT "      Social Security disability benefit.  Based on our ";
  224. 1905 LPRINT "records and the"
  225. 1910 LPRINT "      estimate you provided of your additional future ";
  226. 1912 LPRINT "earnings, and an"
  227. 1915 LPRINT "      assumed date of disability onset of ";D$(T(9,1));
  228. 1917 LPRINT STR$(T(9,2));",";STR$(T(9,3));", the monthly"
  229. 1920 LPRINT "      benefit estimate, in terms of";1936+N2;
  230. 1922 LPRINT "dollars, is:": LPRINT
  231. 1925 LPRINT "           o";: IF X2>999.99 THEN 1930
  232. 1927 LPRINT USING "$$###";X2;: GOTO 1935
  233. 1930 LPRINT USING "$$####";X2;
  234. 1935 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));"."
  235. 1940 IF S2<S4 THEN GOSUB 7400
  236. 1945 ON A5 GOSUB 6900,7100,7500
  237. 1950 GOSUB 7200: LPRINT S$: GOTO 1100
  238. 2000 REM Print two-page summary of results
  239. 2002 IF G8 THEN GOSUB 6800
  240. 2005 GOSUB 9850: PRINT "   Printing summary, page 1"
  241. 2010 LPRINT TAB(26);"Summary of Results";
  242. 2011 LPRINT TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3): LPRINT: LPRINT
  243. 2015 LPRINT "      ";A$(A6);" born on ";D$(T(5,1));STR$(T(5,2));",";
  244. 2020 LPRINT T(5,3): ON A5 GOTO 2025,2065,2090
  245. 2025 LPRINT "      Retired in ";D$(T(2,1));T(2,2);"at age";
  246. 2030 LPRINT T(1,1);"and";T(1,2);"months"
  247. 2035 IF T9=1 THEN 2045
  248. 2040 LPRINT "      Previous disability onset on ";D$(T(9,1));
  249. 2042 LPRINT STR$(T(9,2));",";T(9,3)
  250. 2045 LPRINT "      Normal retirement age =";T(6,1);"and";T(6,2);"months"
  251. 2050 IF T(7,1)=0 THEN 2060
  252. 2055 LPRINT "      Early retirement age =";T(7,1);"and";T(7,2);"months"
  253. 2060 GOTO 2105
  254. 2065 LPRINT "      Died in ";D$(T(3,1));T(3,2)
  255. 2070 LPRINT "      Benefits started in ";D$(T(2,1));T(2,2)
  256. 2075 IF T9=1 THEN 2085
  257. 2080 LPRINT "      Previous disability onset in ";D$(T(9,1));
  258. 2082 LPRINT STR$(T(9,2));",";T(9,3)
  259. 2085 LPRINT "      ";N$(A4): IF A4<2 THEN 2105
  260. 2086 LPRINT "      Widow born on ";D$(T(4,1));STR$(T(4,2));",";
  261. 2087 LPRINT T(4,3): IF A4<>2 THEN 2105
  262. 2088 LPRINT "      Widow disabled on ";D$(T(12,1));STR$(T(12,2));",";
  263. 2089 LPRINT T(12,3): GOTO 2105
  264. 2090 LPRINT "      Disabled on ";D$(T(9,1));STR$(T(9,2));",";T(9,3)
  265. 2095 LPRINT "      Benefits started in ";D$(T(2,1));T(2,2);
  266. 2100 LPRINT "at age";T(1,1);"and";T(1,2);"months"
  267. 2105 IF F6<=0! THEN 2107
  268. 2106 LPRINT USING "      Noncovered monthly pension = #####,.##";F6
  269. 2107 LPRINT
  270. 2110 FOR K3=1 TO 6: LPRINT "      ";F$(K3)
  271. 2115 IF A(1,K3)>=1 THEN LPRINT USING "         PIA: $$####.##"; D(1,K3)
  272. 2120 IF A(1,K3)>=1 THEN LPRINT USING "         MFB: $$####.##"; D(8,K3)
  273. 2125 IF A(1,K3)=0 THEN LPRINT "         Not applicable"
  274. 2130 LPRINT: NEXT K3
  275. 2135 LPRINT: LPRINT: LPRINT
  276. 2136 ON M8 GOTO 2137,2137,2139,2137,2141,2139
  277. 2137 LPRINT USING "      Average Monthly Earnings = $$#######";D(5,M8)
  278. 2138 GOTO 2142
  279. 2139 LPRINT USING "      Indexed Monthly Earnings = $$#######";D(5,M8)
  280. 2140 GOTO 2142
  281. 2141 LPRINT USING "      Years of coverage        =      ####";G6
  282. 2142 LPRINT USING "      Primary Insurance Amount = $$####.##";V6
  283. 2143 IF C5<1! THEN 2157
  284. 2145 LPRINT USING "      Number of months of increment = ####";I6
  285. 2150 LPRINT USING "      Delayed increment factor =   #.#####";C5
  286. 2155 GOTO 2165
  287. 2157 LPRINT USING "      Number of months of reduction = ####";I6
  288. 2161 IF A5=2 AND A4=1 THEN 2163
  289. 2162 LPRINT "      Actuarial reduction factor =";: GOTO 2164
  290. 2163 LPRINT "      Benefit factor =            ";
  291. 2164 LPRINT USING " #.#####";C5
  292. 2165 LPRINT USING "      Benefit actually payable = $$####.##";X2
  293. 2170 LPRINT USING "      Maximum Family Benefit =  $$#####.##";X1
  294. 2175 LPRINT: LPRINT: LPRINT
  295. 2180 REM Print assumptions used
  296. 2190 IF T7=0 THEN 2220
  297. 2195 LPRINT "      Benefit increase assumptions:"
  298. 2205 IF A1=8 THEN LPRINT "      ";B$ ELSE LPRINT "      ";W$(A1)
  299. 2220 IF T8=0 THEN 2245
  300. 2225 LPRINT "      Average wage increase assumptions:"
  301. 2240 IF T3=8 THEN LPRINT "      ";M$ ELSE LPRINT "      ";E$(T3)
  302. 2245 IF S2<S4 THEN GOSUB 7400
  303. 2250 IF A5=3 THEN LPRINT: GOSUB 7800
  304. 2255 IF A1<5 OR A1=8 OR T3<6 OR T3=8 THEN GOSUB 7700 ELSE GOSUB 7500
  305. 2260 LPRINT S$
  306. 2300 REM Print earnings and quarters of coverage
  307. 2305 IF G8 THEN GOSUB 6800
  308. 2307 GOSUB 9850: PRINT "   Printing summary, page 2"
  309. 2310 LPRINT "          Earnings Used in PIA Calculation";
  310. 2311 LPRINT TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
  311. 2314 LPRINT: LPRINT: LPRINT STRING$(30," ");"Amount for   Quarters"
  312. 2315 LPRINT STRING$(19," ");"Annual     quarter of      of"
  313. 2316 LPRINT "      year        earnings     coverage    coverage"
  314. 2320 LPRINT: FOR K3=U3 TO U4
  315. 2330 LPRINT USING "      ####";K3;
  316. 2335 LPRINT USING "    ########,.##";O(K3-1936);
  317. 2336 IF K3<1936+N6 THEN LPRINT: GOTO 2340
  318. 2337 LPRINT USING " ########,.##";L(0,K3-1936);
  319. 2338 LPRINT USING "      ####";G(0,K3-1936)
  320. 2340 NEXT K3: IF U4>=1936+N6 THEN 2343
  321. 2341 LPRINT "     ";1936+N6;STRING$(33," ");
  322. 2342 LPRINT USING "####";G(0,N6)
  323. 2343 LPRINT: LPRINT "      QC's for";1936+N6;"include all prior years"
  324. 2344 LPRINT "      Type of earnings:  ";Q$(A3)
  325. 2345 IF T(2,2)<=1951+N4 OR G2<=1951+N4 THEN 2347
  326. 2346 LPRINT "      Projected wage bases:  ";R$(A2)
  327. 2347 IF S2<S4 THEN LPRINT: GOSUB 7300
  328. 2348 IF P6+1950<G2 THEN LPRINT: GOSUB 7600
  329. 2349 IF A5=3 THEN LPRINT: GOSUB 7800
  330. 2350 K7=1: LPRINT S$: IF K9=3 THEN 1100
  331. 2500 REM Print details of calculations
  332. 2600 REM Print Old-Start earnings
  333. 2605 IF A(1,1)=0 THEN 2900
  334. 2607 IF G8 THEN GOSUB 6800
  335. 2608 GOSUB 9850: PRINT "   Printing old-start earnings"
  336. 2610 S3=1: GOSUB 7900
  337. 2615 LPRINT "                 actual        imputed      high N"
  338. 2620 LPRINT "      year      earnings      earnings       years": LPRINT
  339. 2625 FOR K3=1937 TO P6+1950: K1=K3-1936
  340. 2630 LPRINT USING "      ####";K3;
  341. 2635 LPRINT USING "  ########,.##";O(K3-1936);
  342. 2640 LPRINT USING "  ########,.##"; L(1,K1);
  343. 2645 IF G(1,K1)<=0 THEN LPRINT: GOTO 2655
  344. 2650 LPRINT USING "  ########,.##";L(1,K1)
  345. 2655 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
  346. 2657 IF A5=3 THEN LPRINT: GOSUB 7800
  347. 2660 LPRINT S$
  348. 2700 REM Print Old-Start detail
  349. 2702 IF G8 THEN GOSUB 6800
  350. 2703 GOSUB 9850: PRINT "   Printing old-start detail"
  351. 2705 GOSUB 7900
  352. 2710 LPRINT "      Applicable method: ";H$(N9);" Amendments"
  353. 2715 LPRINT "         ";K$(N9): LPRINT
  354. 2720 LPRINT USING "      AME = ######,.##";D(9,1);
  355. 2725 LPRINT USING "/(##*12) =";N8;: LPRINT I9: LPRINT
  356. 2735 LPRINT USING "      PIB = ###.##";F1: LPRINT
  357. 2740 ON N9 GOTO 2825,2745,2755,2755,2755,2755,2755
  358. 2745 LPRINT USING "      1950 PIA = ###.##";D(2,1): LPRINT
  359. 2750 LPRINT USING "      1950 MFB = ###.##";D(4,1): LPRINT: GOTO 2825
  360. 2755 LPRINT "      New-start AME =";D(5,1): LPRINT
  361. 2760 ON N9 GOTO 2825,2825,2825,2825,2825,2765,2780
  362. 2765 LPRINT "      Applicable table: ";G$(P4);" Act": LPRINT
  363. 2770 IF A(2,1)<=0 THEN 2780
  364. 2775 K1=25: K2=A(2,1)+24: U8=G4: GOSUB 6000: GOTO 2825
  365. 2780 IF Q(3,1)>.001 THEN 2795
  366. 2785 LPRINT USING "      December 1978 PIA = ####.##";D(2,1): LPRINT
  367. 2790 GOTO 2810
  368. 2795 LPRINT USING "      December 1978 PIA = ####.##";Q(3,1): LPRINT
  369. 2800 LPRINT USING "      Noncovered monthly pension = #####.##";F6
  370. 2802 LPRINT
  371. 2805 LPRINT USING "      PIA after windfall = ####.##";D(2,1): LPRINT
  372. 2810 LPRINT "      MFB bendpoints =";STR$(Q(7,2));",";STR$(Q(7,3));
  373. 2812 LPRINT ", and";Q(7,4): LPRINT
  374. 2815 LPRINT "      MFB at eligibility =": GOSUB 6200
  375. 2820 IF A(2,1)>0 THEN K1=G9+1: K2=A(2,1)+G9: U8=G4: GOSUB 6000
  376. 2825 GOSUB 6100
  377. 2900 REM Print Old-law earnings
  378. 2905 IF A(1,2)=0 THEN 3100
  379. 2907 IF G8 THEN GOSUB 6800
  380. 2908 GOSUB 9850: PRINT "   Printing old-law earnings"
  381. 2910 S3=2: GOSUB 7900
  382. 2915 LPRINT "                              high N"
  383. 2920 LPRINT "      year      earnings       years": LPRINT
  384. 2925 FOR K3=U3 TO P6+1950: K1=K3-1950
  385. 2930 IF K3<=1950 THEN 2955
  386. 2935 LPRINT USING "      ####";K3;
  387. 2940 LPRINT USING "  ########,.##";O(K3-1936);
  388. 2945 IF G(2,K1)<=0 THEN LPRINT: GOTO 2955
  389. 2950 LPRINT USING "  ########,.##";L(2,K1)
  390. 2955 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
  391. 2957 IF A5=3 THEN LPRINT: GOSUB 7800
  392. 2960 LPRINT S$
  393. 3000 REM Print Old-law detail
  394. 3002 IF G8 THEN GOSUB 6800
  395. 3005 GOSUB 9850: PRINT "   Printing old-law detail"
  396. 3010 GOSUB 7900: GOSUB 6300
  397. 3015 LPRINT USING "      AME = ######,.##";D(9,2);
  398. 3020 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,2): LPRINT
  399. 3030 LPRINT "      Applicable table: ";G$(P4): LPRINT
  400. 3035 IF A(2,2)>0 THEN K1=25: K2=A(2,2)+24: GOSUB 6000
  401. 3040 GOSUB 6100
  402. 3100 REM Print wage-indexed earnings
  403. 3105 IF A(1,3)=0 THEN 3600
  404. 3107 IF G8 THEN GOSUB 6800
  405. 3108 GOSUB 9850: PRINT "   Printing wage-indexed earnings"
  406. 3110 S3=3: GOSUB 7900
  407. 3115 LPRINT "                                 earnings";
  408. 3120 LPRINT "        indexed       high N"
  409. 3125 LPRINT "      year      earnings      * ";
  410. 3130 LPRINT USING "$$#####,.##      earnings       years"; B(5,G9-1+14)
  411. 3140 LPRINT: FOR K3=U3 TO P6+1950: K1=K3-1950
  412. 3145 IF K3<=1950 THEN 3210
  413. 3150 LPRINT USING "      ####";K3;
  414. 3155 LPRINT USING "  ########,.##";O(K3-1936);
  415. 3160 IF G(3,K1)>0 THEN 3185
  416. 3165 IF K3>G9+1949 THEN LPRINT STRING$(19," ");: GOTO 3180
  417. 3170 LPRINT USING " ##############,.##";C(3,K1);
  418. 3180 LPRINT USING "  ########,.##";L(3,K1): GOTO 3210
  419. 3185 IF K3>G9+1949 THEN LPRINT STRING$(19," ");: GOTO 3200
  420. 3190 LPRINT USING " ##############,.##"; C(3,K1);
  421. 3200 LPRINT USING "  ########,.##"; L(3,K1);
  422. 3205 LPRINT USING "  ########,.##"; L(3,K1)
  423. 3210 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
  424. 3212 IF A5=3 THEN LPRINT: GOSUB 7800
  425. 3215 LPRINT S$
  426. 3300 REM Print wage-indexed detail
  427. 3302 IF G8 THEN GOSUB 6800
  428. 3303 GOSUB 9850: PRINT "   Printing wage-indexed detail"
  429. 3305 GOSUB 7900
  430. 3310 LPRINT "      Base year for indexing =";G9+1949: LPRINT
  431. 3315 GOSUB 6300: LPRINT USING "      AIME = #########,.##";D(9,3);
  432. 3320 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,3): LPRINT
  433. 3330 LPRINT "      PIA formula bend points =";Q(8,2);"and";Q(8,3)
  434. 3335 LPRINT: LPRINT "      MFB formula bend points =";STR$(Q(7,2));
  435. 3337 LPRINT ",";STR$(Q(7,3));", and";Q(7,4): LPRINT
  436. 3340 LPRINT "      PIA at eligibility = "
  437. 3345 LPRINT USING "         #.## * ";Q(2,1);
  438. 3350 LPRINT USING "##### +";H(1,3)
  439. 3355 LPRINT USING "         #.## * ";Q(2,2);
  440. 3360 LPRINT USING "##### +";H(2,3)
  441. 3365 LPRINT USING "         #.## * ";Q(2,3);
  442. 3370 LPRINT USING "##### = ";H(3,3);
  443. 3375 IF P1>0 THEN LPRINT USING "#####.##";Q(3,3): GOTO 3395
  444. 3380 LPRINT USING "#####.##";D(2,3)
  445. 3395 IF P1=0 THEN 3495
  446. 3400 LPRINT: LPRINT USING "      Noncovered pension = #####.##";F6
  447. 3410 LPRINT: IF P1>0 THEN 3430
  448. 3415 LPRINT "      Special minimum savings clause:";
  449. 3420 LPRINT G6;"years of coverage": GOTO 3495
  450. 3430 LPRINT "      PIA after windfall"
  451. 3435 IF P1=1 THEN 3480
  452. 3440 LPRINT USING "         #.## * ";Q(4,1);
  453. 3445 LPRINT USING "##### +";H(1,3)
  454. 3450 LPRINT USING "         #.## * ";Q(4,2);
  455. 3455 LPRINT USING "##### +";H(2,3)
  456. 3460 LPRINT USING "         #.## * ";Q(4,3);
  457. 3465 LPRINT USING "##### = ";H(3,3);
  458. 3470 LPRINT USING "#####.##";D(2,3): GOTO 3495
  459. 3480 LPRINT USING "         #####.##";Q(3,3);: LPRINT " - .5* ";
  460. 3485 LPRINT USING "#####.##";F6;
  461. 3490 LPRINT USING " = #####.##";D(2,3)
  462. 3495 LPRINT: LPRINT "      MFB at eligibility ="
  463. 3505 ON P2+1 GOTO 3540,3510,3520,3510
  464. 3510 LPRINT USING "         #.# * ";V7;
  465. 3515 LPRINT USING "#####.##";D(2,3): GOTO 3530
  466. 3520 LPRINT USING "        #.## * ";V7;
  467. 3525 LPRINT USING "#####";D(5,3)
  468. 3530 LPRINT USING "         (MFB cap on DI cases) = #####.##"; D(4,3)
  469. 3535 LPRINT: GOTO 3543
  470. 3540 GOSUB 6200
  471. 3543 U2=G9: GOSUB 7000
  472. 3545 IF A(2,3)>0 THEN K1=G9+1: K2=A(2,3)+G9: U8=G4: GOSUB 6000
  473. 3550 GOSUB 6100
  474. 3600 REM Print transitional guarantee earnings
  475. 3605 IF A(1,4)=0 THEN 3800
  476. 3607 IF G8 THEN GOSUB 6800
  477. 3608 GOSUB 9850: PRINT "   Printing transitional guarantee earnings"
  478. 3610 S3=4: GOSUB 7900
  479. 3615 LPRINT "                               high N"
  480. 3620 LPRINT "      year      earnings        years": LPRINT
  481. 3625 FOR K3=U3 TO P6+1950: K1=K3-1950
  482. 3630 IF K3<=1950 THEN 3655
  483. 3635 LPRINT USING "      ####";K3;
  484. 3640 LPRINT USING "  #######,.##";O(K3-1936);
  485. 3645 IF G(4,K1)<=0 THEN LPRINT: GOTO 3655
  486. 3650 LPRINT USING "  ########,.##";L(4,K1)
  487. 3655 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
  488. 3657 IF A5=3 THEN LPRINT: GOSUB 7800
  489. 3660 LPRINT S$
  490. 3700 REM Print transitional guarantee detail
  491. 3702 IF G8 THEN GOSUB 6800
  492. 3703 GOSUB 9850: PRINT "   Printing transitional guarantee detail"
  493. 3705 GOSUB 7900
  494. 3715 GOSUB 6300: LPRINT USING "      AME =#######,.##";D(9,4);
  495. 3720 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,4): LPRINT
  496. 3730 LPRINT USING "      December 1978 PIA = ####.##";D(2,4): LPRINT
  497. 3735 LPRINT "      MFB bendpoints =";STR$(Q(7,2));",";STR$(Q(7,3));
  498. 3737 LPRINT ", and";Q(7,4): LPRINT
  499. 3740 LPRINT "      MFB at eligibility =": GOSUB 6200
  500. 3745 IF A(2,4)>0 THEN K1=G9+1: K2=A(2,4)+G9: U8=G4: GOSUB 6000
  501. 3750 GOSUB 6100
  502. 3800 REM Print special-minimum earnings
  503. 3805 IF A(1,5)=0 THEN 4100
  504. 3807 IF G8 THEN GOSUB 6800
  505. 3808 GOSUB 9850: PRINT "   Printing special-minimum earnings"
  506. 3810 S3=5: GOSUB 7900
  507. 3815 LPRINT "                              1/4 old-   years of"
  508. 3820 LPRINT "      year      earnings      law base   coverage": LPRINT
  509. 3821 IF U3>1950 THEN 3825
  510. 3822 LPRINT USING "      1937-50 ######,.##";C1;
  511. 3823 LPRINT USING "                    ##";G(5,14)
  512. 3825 FOR K3=U3 TO P6+1950: K1=K3-1936
  513. 3827 IF K1<15 THEN 3847
  514. 3830 LPRINT USING "      ####";K3;
  515. 3835 LPRINT USING "   #######,.##";O(K3-1936);
  516. 3840 LPRINT USING "  ########,.##"; .25*B(4,K1);
  517. 3845 LPRINT USING "       #";G(5,K1)
  518. 3847 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
  519. 3848 IF A5=3 THEN LPRINT: GOSUB 7800
  520. 3850 LPRINT S$
  521. 3900 REM Print special-minimum detail
  522. 3902 IF G8 THEN GOSUB 6800
  523. 3905 GOSUB 9850: PRINT "   Printing special-minimum detail"
  524. 3910 GOSUB 7900: LPRINT "      Years of coverage =";G6: LPRINT
  525. 3915 LPRINT "      Years of coverage over 10 (maximum 20) =";M6: LPRINT
  526. 3925 LPRINT USING "      Amount per year = ##.##";V2: LPRINT
  527. 3930 IF T(2,2)>1978 THEN 3975
  528. 3935 LPRINT "      PIA =";M6;"* ";
  529. 3940 LPRINT USING "##.## = ";V2;
  530. 3945 LPRINT USING "###.##";D(1,5): LPRINT
  531. 3950 LPRINT "      Applicable table for MFB: ";G$(P4): LPRINT
  532. 3955 LPRINT "      AME from table =";D(5,5): LPRINT
  533. 3960 IF A(2,5)>0 THEN K1=25: K2=A(2,5)+24: GOSUB 6000
  534. 3965 LPRINT USING "      PIA from table = ###.##";V4: LPRINT
  535. 3970 LPRINT USING "      MFB = ###.##";D(8,5): LPRINT S$: GOTO 4105
  536. 3975 LPRINT "      January 1979 PIA =";M6;"* ";
  537. 3980 LPRINT USING "##.## = ";V2;
  538. 3985 LPRINT USING "###.##";D(2,5): LPRINT
  539. 3995 IF T(2,2)=1979 AND T(2,1)<6 THEN 4010
  540. 4000 LPRINT USING "      MFB in January 1979 = ###.##";D(4,5): LPRINT
  541. 4005 K1=29: K2=A(2,5)+28: U8=G4: GOSUB 6000
  542. 4010 GOSUB 6100
  543. 4100 REM Print re-indexed widow earnings
  544. 4105 IF A(1,6)=0 THEN 4420
  545. 4107 IF G8 THEN GOSUB 6800
  546. 4108 GOSUB 9850: PRINT "   Printing re-indexed widow earnings"
  547. 4110 S3=6: GOSUB 7900
  548. 4115 LPRINT "                                 earnings";
  549. 4120 LPRINT "        indexed      high N"
  550. 4125 LPRINT "      year      earnings      * ";
  551. 4130 LPRINT USING "$$#####.##"; B(5,M7+13);
  552. 4135 LPRINT "      earnings       years": LPRINT
  553. 4140 FOR K2=U3 TO P6+1950: K1=K2-1950
  554. 4145 IF K2<=1950 THEN 4210
  555. 4150 LPRINT USING "      ####";K2;
  556. 4155 LPRINT USING "  ########,.##";O(K2-1936);
  557. 4160 IF G(6,K1)>0 THEN 4185
  558. 4165 IF K2>M7+1949 THEN LPRINT STRING$(19," ");: GOTO 4180
  559. 4170 LPRINT USING " ##############,.##";C(4,K1);
  560. 4180 LPRINT USING "  ########,.##";L(6,K1): GOTO 4210
  561. 4185 IF K2>M7+1949 THEN LPRINT STRING$(19," ");: GOTO 4200
  562. 4190 LPRINT USING " ##############,.##";C(4,K1);
  563. 4200 LPRINT USING "  ########,.##";L(6,K1);
  564. 4205 LPRINT USING "  ########,.##";L(6,K1)
  565. 4210 NEXT K2: IF S2<S4 THEN LPRINT: GOSUB 7300
  566. 4212 IF A5=3 THEN LPRINT: GOSUB 7800
  567. 4215 LPRINT S$
  568. 4300 REM Print re-indexed widow detail
  569. 4302 IF G8 THEN GOSUB 6800
  570. 4303 GOSUB 9850: PRINT "   Printing re-indexed widow detail"
  571. 4305 GOSUB 7900
  572. 4310 LPRINT "      Widow born on ";D$(T(4,1));STR$(T(4,2));",";T(4,3)
  573. 4315 LPRINT: LPRINT "      Base year for indexing =";M7+1949: LPRINT
  574. 4320 GOSUB 6300: LPRINT USING "      AIME = #########,.##";D(9,6);
  575. 4325 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,6): LPRINT
  576. 4335 LPRINT "      PIA bend points = ";Q(5,2);"and";Q(5,3): LPRINT
  577. 4340 LPRINT "      PIA at eligibility = "
  578. 4345 LPRINT USING "         #.## * ";Q(2,1);
  579. 4350 LPRINT USING "##### +";H(1,6)
  580. 4355 LPRINT USING "         #.## * ";Q(2,2);
  581. 4360 LPRINT USING "##### +";H(2,6)
  582. 4365 LPRINT USING "         #.## * ";Q(2,3);
  583. 4370 LPRINT USING "##### = ";H(3,6);
  584. 4375 LPRINT USING "#####.##";D(2,6): LPRINT
  585. 4380 U2=M7: GOSUB 7000
  586. 4385 IF A(2,6)>0 THEN K1=M7+1: K2=A(2,6)+M7: U8=M2: GOSUB 6000
  587. 4405 LPRINT USING "      PIA at entitlement = $$####.##";D(1,6): LPRINT
  588. 4410 LPRINT "      MFB at entitlement = (same as for wage-indexed)"
  589. 4415 LPRINT S$
  590. 4420 GOTO 1100
  591. 5000 REM End of printout
  592. 5005 PRINT "   Do you wish to do another calculation? (y or n) > ";
  593. 5010 C$=FNGETSTRN$(1): GOSUB 9860
  594. 5011 IF LEN(C$)<=0 THEN BEEP: GOTO 5005
  595. 5012 I4=ASC(C$): IF I4>96 THEN C$=CHR$(I4-32) ELSE C$=CHR$(I4)
  596. 5013 IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 5005
  597. 5015 IF C$<>"Y" THEN 9900
  598. 5020 CLS: GOSUB 9850
  599. 5025 PRINT "   Loading PIA data-input program; please wait..."
  600. 5030 CHAIN "PIAIN"
  601. 6000 REM Subroutine to print out benefit increases
  602. 6005 LPRINT "      CPI increases applied:"
  603. 6010 FOR K4=K1 TO K2
  604. 6015 LPRINT USING "         ##.#";C(2,K4);
  605. 6020 LPRINT " % for";K4+1950
  606. 6025 IF K4<N4+3 OR K4>N4+10 THEN 6045
  607. 6030 IF F(U8,K4-N4-2)<.05 THEN 6045
  608. 6035 LPRINT USING "         ##.#";F(G4,K4-N4-2);
  609. 6040 LPRINT " % for";K4+1950;"catch-up"
  610. 6045 NEXT K4: LPRINT: RETURN
  611. 6100 REM Subroutine to write out PIA and MFB
  612. 6105 LPRINT USING "      PIA at entitlement = $$####.##";D(1,S3): LPRINT
  613. 6110 LPRINT USING "      MFB at entitlement = $$####.##";D(8,S3)
  614. 6112 IF S2<S4 THEN LPRINT: GOSUB 7300
  615. 6113 IF A5=3 THEN LPRINT: GOSUB 7800
  616. 6115 LPRINT S$: RETURN
  617. 6200 REM Subroutine to write out MFB calculation
  618. 6205 LPRINT USING "         #.## * ";Q(1,1);
  619. 6210 LPRINT USING "####.## +";V(1,S3)
  620. 6215 LPRINT USING "         #.## * ";Q(1,2);
  621. 6220 LPRINT USING "####.## +";V(2,S3)
  622. 6225 LPRINT USING "         #.## * ";Q(1,3);
  623. 6230 LPRINT USING "####.## +";V(3,S3)
  624. 6235 LPRINT USING "         #.## * ";Q(1,4);
  625. 6240 LPRINT USING "####.## = ";V(4,S3);
  626. 6245 LPRINT USING "#####.##";D(4,S3): LPRINT: RETURN
  627. 6300 REM Subroutine to write out number of computation years
  628. 6305 LPRINT "      Number of elapsed years =";A9: LPRINT
  629. 6310 LPRINT "      Number of dropout years =";A8: LPRINT
  630. 6315 LPRINT "      Number of computation years =";A9;"-";A8;"=";N1
  631. 6320 LPRINT: RETURN
  632. 6400 REM Subroutine to draw 75 hyphens
  633. 6405 GOSUB 9860: PRINT "   ";STRING$(75,"-"): RETURN
  634. 6600 REM Subroutine to get wage-earner name and SSN
  635. 6605 GOSUB 9860: PRINT "   Enter name of wage-earner (RETURN if none)"
  636. 6610 PRINT "   > ";
  637. 6611 IF A5=2 THEN Y$=FNGETSTRN$(34) ELSE U$(1)=FNGETSTRN$(34): GOTO 6615
  638. 6612 GOSUB 9860: PRINT "   Enter name of beneficiary (RETURN if none)"
  639. 6613 PRINT "   > ";: U$(1)=FNGETSTRN$(34)
  640. 6615 GOSUB 9860: PRINT "   Enter social security number of wage earner";
  641. 6620 PRINT " (RETURN if none)": PRINT "   > ";
  642. 6625 V$=FNGETSTRN$(11)
  643. 6630 GOSUB 9860: PRINT "   Enter first line of address (RETURN if none)"
  644. 6635 PRINT "   > ";: U$(2)=FNGETSTRN$(34)
  645. 6640 IF LEN(U$(2))=0 THEN 6670
  646. 6645 GOSUB 9860: PRINT"   Enter second line of address (RETURN if none)"
  647. 6650 PRINT "   > ";: U$(3)=FNGETSTRN$(34)
  648. 6655 IF LEN(U$(3))=0 THEN 6670
  649. 6660 GOSUB 9860: PRINT "   Enter third line of address (RETURN if none)"
  650. 6665 PRINT "   > ";: U$(4)=FNGETSTRN$(34)
  651. 6670 GOSUB 9850: RETURN
  652. 6700 REM Subroutine to get a RETURN to continue
  653. 6705 GOSUB 9860: PRINT "   Press RETURN to continue  ";
  654. 6710 C$=INKEY$: IF LEN(C$)<1 THEN 6710
  655. 6715 IF ASC(C$)<>13 THEN BEEP: GOTO 6710
  656. 6720 RETURN
  657. 6800 REM Subroutine to get a RETURN for printer ready
  658. 6805 GOSUB 9860: PRINT "   Press RETURN when printer is ready  ";
  659. 6810 C$=INKEY$: IF LEN(C$)<1 THEN 6810
  660. 6815 IF ASC(C$)<>13 THEN BEEP: GOTO 6810
  661. 6820 RETURN
  662. 6900 REM Subroutine to print bottom of letter for old-age
  663. 6905 LPRINT: LPRINT "      It is not possible, of course, to tell you ";
  664. 6910 LPRINT "the actual monthly benefit"
  665. 6915 LPRINT "      you will receive.  The estimates provided could ";
  666. 6920 LPRINT "change--they could"
  667. 6925 LPRINT "      increase or decrease--depending on your actual ";
  668. 6930 LPRINT "future earnings,"
  669. 6935 LPRINT "      future changes in the average wages of all employed";
  670. 6940 LPRINT " persons, and on"
  671. 6945 LPRINT "      future rates of inflation.  (The above estimates ";
  672. 6950 LPRINT "assume that, on"
  673. 6955 LPRINT "      average, the annual increase in average wages in ";
  674. 6960 LPRINT "the economy will": IF T3=6 THEN 6975
  675. 6965 LPRINT "      exceed the annual increase in prices by about 1 ";
  676. 6970 LPRINT "percent.)": RETURN
  677. 6975 LPRINT "      be about 4 percent.)": RETURN
  678. 7000 REM Subroutine to write out real-wage-gain adjustment
  679. 7005 IF U2<=N4 OR T3<>7 THEN RETURN
  680. 7010 LPRINT "      Real-wage-gain adjustment for POMS calculation:"
  681. 7015 LPRINT USING "         Factor = #.##";1!+.01*(U2-N4)
  682. 7020 LPRINT USING "         PIA after adjustment = ####.##";D(3,S3)
  683. 7025 LPRINT USING "         MFB after adjustment = ####.##";D(6,S3)
  684. 7030 LPRINT: RETURN
  685. 7100 REM Subroutine to print bottom of letter for survivors
  686. 7105 LPRINT: LPRINT "      It is not possible, of course, to tell you ";
  687. 7110 LPRINT "the actual monthly benefit"
  688. 7115 LPRINT "      you will receive.  The estimate(s) provided could ";
  689. 7120 LPRINT "change--they could"
  690. 7125 LPRINT "      increase or decrease--depending on the actual ";
  691. 7130 LPRINT "future earnings of the"
  692. 7135 LPRINT "      wage earner, future changes in the average wages of";
  693. 7140 LPRINT " all employed"
  694. 7145 LPRINT "      persons, and on future rates of inflation.  (The ";
  695. 7150 LPRINT "above estimate(s)"
  696. 7155 LPRINT "      assume that, on average, the annual increase in ";
  697. 7160 LPRINT "average wages in the"
  698. 7165 LPRINT "      economy will ";: IF T3=6 THEN 7175
  699. 7166 LPRINT "exceed the annual increase in prices ";
  700. 7170 LPRINT "by about 1 percent.)": RETURN
  701. 7175 LPRINT "be about 4 percent.)": RETURN
  702. 7200 REM Subroutine to print closeout
  703. 7205 LPRINT: LPRINT: LPRINT
  704. 7210 LPRINT TAB(40);"Sincerely yours,": RETURN
  705. 7300 REM Subroutine to print noninsured message
  706. 7305 LPRINT "      Warning! Not insured! Has";S2;"QC's, needs";S4;
  707. 7310 LPRINT "QC's": RETURN
  708. 7400 REM Subroutine to print noninsured paragraph
  709. 7405 LPRINT: LPRINT "      This estimate is theoretical because the ";
  710. 7410 LPRINT "worker is not fully insured."
  711. 7415 LPRINT "      A total of";S4;"quarters are needed; ";
  712. 7416 IF A6=1 THEN LPRINT "he"; ELSE LPRINT "she";
  713. 7420 LPRINT " has only";STR$(S2);".": RETURN
  714. 7500 REM Subroutine to print bottom of letter for disability
  715. 7505 LPRINT: LPRINT "      It is not possible, of course, to tell you ";
  716. 7510 LPRINT "the actual monthly benefit"
  717. 7515 LPRINT "      you will receive.  The estimate provided could ";
  718. 7520 LPRINT "change--it could"
  719. 7525 LPRINT "      increase or decrease--depending on your actual ";
  720. 7530 LPRINT "future earnings,"
  721. 7535 LPRINT "      future changes in the average wages of all employed";
  722. 7540 LPRINT " persons, and on"
  723. 7545 LPRINT "      future rates of inflation.  (The above estimate ";
  724. 7550 LPRINT "assumes that, on"
  725. 7555 LPRINT "      average, the annual increase in average wages in ";
  726. 7560 LPRINT "the economy will": IF T3=6 THEN 7575
  727. 7565 LPRINT "      exceed the annual increase in prices by about 1 ";
  728. 7570 LPRINT "percent.)": RETURN
  729. 7575 LPRINT "      be about 4 percent.)": RETURN
  730. 7600 REM Subroutine to print unused earnings warning
  731. 7605 LPRINT "      Warning! Earnings after";P6+1950;"not used"
  732. 7610 RETURN
  733. 7700 REM Subroutine to print generic warning
  734. 7705 LPRINT: LPRINT "      It is not possible, of course, to tell you ";
  735. 7710 LPRINT "the actual monthly benefit"
  736. 7715 LPRINT "      you will receive.  The estimate provided could ";
  737. 7720 LPRINT "change--it could"
  738. 7725 LPRINT "      increase or decrease--depending on your actual ";
  739. 7730 LPRINT "future earnings,"
  740. 7735 LPRINT "      future changes in the average wages of all employed";
  741. 7740 LPRINT " persons, and on"
  742. 7745 LPRINT "      future rates of inflation.": RETURN
  743. 7800 REM Subroutine to print disability-insured message
  744. 7805 LPRINT "      Warning! Worker is assumed to be disability-insured."
  745. 7810 RETURN
  746. 7900 REM Subroutine to print page heading
  747. 7905 LPRINT TAB(10);F$(S3);TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
  748. 7910 LPRINT: LPRINT: RETURN
  749. 9813 REM For Macintosh, $INCLUDE "COLOR.MAC"
  750. 9814 REM $INCLUDE: 'COLOR.BAS'
  751. 9900 GOSUB 9860: CLS: END
  752. 9999 REM PIAOUT.BAS - 11/03/87 - 02:15 PM
  753.