home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / zbasic / pia / piain.bas < prev    next >
BASIC Source File  |  1988-01-26  |  51KB  |  1,145 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: 'WGETSTRN.BAS'
  5. 115 REM $INCLUDE: 'GETSTRN.BAS'
  6. 500 REM Read historical amounts from OLDAWBI.DAT
  7. 505 OPEN "I",1,"OLDAWBI.DAT"
  8. 510 PRINT "   Reading historical amounts from OLDAWBI.DAT"
  9. 515 INPUT #1,N4: N2=N4+15: N6=N2-2
  10. 520 FOR I1=25 TO N4: INPUT #1,C(2,I1): NEXT I1
  11. 525 FOR I1=1 TO N6: INPUT #1,B(5,I1): NEXT I1
  12. 530 FOR I1=1 TO N2: INPUT #1,B(1,I1): NEXT I1
  13. 535 FOR I1=1 TO N2: INPUT #1,B(4,I1): NEXT I1
  14. 540 FOR I1=1 TO N2: INPUT #1,B(2,I1): NEXT I1
  15. 545 CLOSE #1
  16. 600 REM Read titles of assumptions from TITLES.DAT
  17. 605 OPEN "I",1,"TITLES.DAT"
  18. 610 PRINT "   Reading titles of assumptions from TITLES.DAT"
  19. 615 FOR I1=1 TO 4: INPUT #1,E$(I1): W$(I1)=E$(I1): NEXT I1
  20. 620 CLOSE #1
  21. 700 REM Set titles of built-in assumptions
  22. 702 E$(5)="No increase beyond"+STR$(1949+N4)+" average wage"
  23. 703 E$(6)="Current POMS calculation (4-percent nominal wage increases)"
  24. 705 E$(7)="Proposed POMS calculation (1-percent real wage increases)"
  25. 710 E$(8)="Other assumptions (input from keyboard)"
  26. 715 W$(5)="No increase beginning with"+STR$(1951+N4)+" benefit increase"
  27. 716 W$(6)="Current POMS calculation (no future benefit increases)"
  28. 720 W$(7)="Proposed POMS calculation (no future benefit increases)"
  29. 725 W$(8)=E$(8)
  30. 800 REM Initialize configuration
  31. 805 GOSUB 5000
  32. 1000 REM Start main program
  33. 1001 T6=0: FOR I1=N2+1 TO N5: B(1,I1)=0!: B(4,I1)=0!: NEXT I1
  34. 1005 K6=0: GOSUB 2000: PRINT "   ";: GOSUB 9870
  35. 1006 PRINT STRING$(30," ");"Case selection";STRING$(31," "): GOSUB 2100
  36. 1010 PRINT "   Enter type of data to be entered:"
  37. 1015 PRINT "      0 to enter data from keyboard"
  38. 1020 PRINT "      1 to recall and run data previously stored on disk"
  39. 1025 PRINT "      2 to modify data previously stored on disk"
  40. 1026 PRINT "      3 to delete data previously stored on disk"
  41. 1027 PRINT "      4 to display cases stored on disk"
  42. 1028 PRINT "   > ";: T5=VAL(FNGETSTRN$(1)): GOSUB 9860
  43. 1030 IF T5<0 OR T5>4 THEN BEEP: GOTO 1010
  44. 1035 ON T5+1 GOTO 1300,1040,1040,1040,1036
  45. 1036 GOSUB 6300: GOTO 1005
  46. 1040 PRINT "   Enter name of file stored on disk (up to 8 characters";
  47. 1041 PRINT " or numbers)": PRINT "   > ";
  48. 1042 L$=FNGETSTRN$(8): L$=L$+".pia"
  49. 1043 ON ERROR GOTO 6100
  50. 1045 OPEN "I",1,L$
  51. 1046 ON ERROR GOTO 0: IF K6 THEN 1005
  52. 1047 IF T5=3 THEN 1290
  53. 1048 GOSUB 9850: PRINT "   Reading from ";L$
  54. 1050 INPUT #1,W1: INPUT #1,A6: IF A6<1 OR A6>2 THEN T6=1: GOTO 1280
  55. 1055 INPUT #1,T(2,1): IF T(2,1)<1 OR T(2,1)>12 THEN T6=2: GOTO 1280
  56. 1056 INPUT #1,T(2,2)
  57. 1060 IF T(2,2)<1940 OR T(2,2)>1936+N5 THEN T6=3: GOTO 1280
  58. 1070 INPUT #1,T(5,1): IF T(5,1)<1 OR T(5,1)>12 THEN T6=4: GOTO 1280
  59. 1075 INPUT #1,T(5,2): IF T(5,2)<1 OR T(5,2)>31 THEN T6=5: GOTO 1280
  60. 1076 INPUT #1,T(5,3)
  61. 1080 INPUT #1,A5: IF A5<1 OR A5>3 THEN T6=6: GOTO 1280
  62. 1085 INPUT #1,A3: IF A3<1 OR A3>4 THEN T6=7: GOTO 1280
  63. 1090 INPUT #1,G1
  64. 1095 IF G1>1936+N5 OR G1<1937 OR G1<T(5,3) THEN T6=8: GOTO 1280
  65. 1100 IF T(5,3)>1936 AND G1<1951 THEN T6=25: GOTO 1280
  66. 1105 U3=G1: IF G1<1951 THEN U3=1937
  67. 1110 INPUT #1,G2
  68. 1115 IF G2>1936+N5 OR G2<G1 THEN T6=9: GOTO 1280
  69. 1120 U4=G2: IF G2<1950 THEN U4=1950
  70. 1125 IF G2-G1>59 THEN T6=26: GOTO 1280
  71. 1127 INPUT #1,G(0,N6): IF G(0,N6)<0 THEN T6=33: GOTO 1280
  72. 1130 GOSUB 4500: INPUT #1,T(3,1): INPUT #1,T(3,2)
  73. 1132 IF A5<>2 THEN T(3,1)=0: T(3,2)=0: GOTO 1155
  74. 1135 IF T(3,1)<1 OR T(3,1)>12 THEN T6=10: GOTO 1280
  75. 1140 IF T(3,2)<1940 OR T(3,2)>1936+N5 THEN T6=11: GOTO 1280
  76. 1145 IF T(3,2)>T(2,2) THEN T6=12: GOTO 1280
  77. 1150 IF T(3,2)=T(2,2) AND T(3,1)>T(2,1) THEN T6=12: GOTO 1280
  78. 1155 INPUT #1,A4: IF A5<>2 THEN A4=0: GOTO 1165
  79. 1160 IF A4<1 OR A4>3 THEN T6=13: GOTO 1280
  80. 1165 INPUT #1,T9: IF T9<1 OR T9>2 THEN T6=23: GOTO 1280
  81. 1170 IF A5=3 AND T9=1 THEN T6=24: GOTO 1280
  82. 1175 INPUT #1,T(9,1): INPUT #1,T(9,2): INPUT #1,T(9,3)
  83. 1180 IF T9=1 THEN 1200
  84. 1185 IF T(9,1)<1 OR T(9,1)>12 THEN T6=14: GOTO 1280
  85. 1187 IF T(9,2)<1 OR T(9,2)>31 THEN T6=32: GOTO 1280
  86. 1190 IF T(9,3)<1940 THEN T6=15: GOTO 1280
  87. 1195 IF T(9,3)>1936+N5 THEN T6=16: GOTO 1280
  88. 1197 IF T(9,3)<T(2,2) OR (T(9,3)=T(2,2) AND T(9,1)<=T(2,1)) THEN 1200
  89. 1198 T6=27: GOTO 1280
  90. 1200 INPUT #1,T(4,1): INPUT #1,T(4,2): INPUT #1,T(4,3)
  91. 1201 IF A4<=1 THEN 1212
  92. 1205 IF T(4,1)<1 OR T(4,1)>12 THEN T6=17: GOTO 1280
  93. 1210 IF T(4,2)<1 OR T(4,2)>31 THEN T6=18: GOTO 1280
  94. 1211 GOSUB 4550: REM Calculate age of widow
  95. 1212 INPUT #1,T(12,1): INPUT #1,T(12,2): INPUT #1,T(12,3)
  96. 1213 IF A4<>2 THEN 1220
  97. 1214 IF T(12,1)<1 OR T(12,1)>12 THEN T6=34: GOTO 1280
  98. 1215 IF T(12,2)<1 OR T(12,2)>31 THEN T6=35: GOTO 1280
  99. 1216 IF T(12,3)<1940 THEN T6=36: GOTO 1280
  100. 1217 IF T(12,3)>1936+N5 THEN T6=37: GOTO 1280
  101. 1218 IF T(12,3)<T(2,2) OR (T(12,3)=T(2,2) AND T(12,1)<=T(2,1)) THEN 1220
  102. 1219 T6=38: GOTO 1280
  103. 1220 GOSUB 7200: GOSUB 7400: GOSUB 9860: IF T6>0 THEN 1280
  104. 1222 GOSUB 9300
  105. 1225 INPUT #1,A1: IF A1<1 OR A1>W3 THEN T6=19: GOTO 1280
  106. 1230 IF A1=W3 THEN GOSUB 6800 ELSE GOSUB 6900
  107. 1232 IF T6>0 THEN 9880
  108. 1235 INPUT #1,T3: IF T3<1 OR T3>W3 THEN T6=20: GOTO 1280
  109. 1240 IF T3=W3 THEN GOSUB 7900 ELSE GOSUB 7950
  110. 1242 IF T6>0 THEN 9880
  111. 1245 GOSUB 8000: IF G2>=1950+N4 THEN GOSUB 6000
  112. 1250 INPUT #1,A2: IF A2<1 OR A2>2 THEN T6=21: GOTO 1280
  113. 1255 IF A2=2 THEN GOSUB 4700
  114. 1257 GOSUB 7000
  115. 1260 IF A3>1 THEN GOSUB 5400: GOTO 1265
  116. 1262 GOSUB 5200: IF T6>0 THEN 1280
  117. 1265 INPUT #1,F6: IF F6<0 THEN T6=22: GOTO 1280
  118. 1270 CLOSE #1: IF T5<>2 THEN 1505
  119. 1272 GOSUB 8100: IF T6>0 THEN 9880
  120. 1273 U5=3: IF A3>1 THEN GOSUB 5400: GOTO 1275
  121. 1274 GOSUB 2200: GOSUB 2700: GOTO 3000
  122. 1275 GOSUB 5500: IF C$="Y" THEN 1272
  123. 1278 GOSUB 9600: GOTO 1505
  124. 1280 CLOSE #1: GOSUB 9840: PRINT "   Error in file ";L$: BEEP
  125. 1285 PRINT USING "   Error code ##";T6: GOSUB 9860: GOTO 9880
  126. 1290 REM Delete file from disk
  127. 1291 CLOSE #1
  128. 1295 KILL L$
  129. 1296 ON ERROR GOTO 0
  130. 1297 GOTO 1005
  131. 1300 REM Read case from keyboard
  132. 1305 GOSUB 5000: GOSUB 4000: IF A6=0 THEN GOSUB 8750
  133. 1306 GOSUB 8700: GOSUB 8800: IF A5=0 THEN GOSUB 8900
  134. 1307 GOSUB 5800: IF A3=0 THEN GOSUB 9000
  135. 1310 GOSUB 9100: GOSUB 9200: G(0,N6)=0: IF G1<=1936+N6 THEN GOSUB 5900
  136. 1312 GOSUB 4500: GOSUB 6750: REM Start death or disability data
  137. 1315 IF A5<>2 THEN T(3,1)=0: T(3,2)=0: A4=0: GOTO 1320
  138. 1316 GOSUB 8850: REM Get date of death
  139. 1317 IF A4=0 THEN GOSUB 8950: REM Get type of survivor
  140. 1320 IF A5>2 THEN T9=2: GOTO 1330
  141. 1325 IF T9=0 THEN GOSUB 9150
  142. 1327 IF T9=1 THEN T(9,1)=0: T(9,2)=0: T(9,3)=0: GOTO 1334
  143. 1330 GOSUB 9050: REM Get worker date of disability
  144. 1334 IF A4<2 THEN T(4,1)=0: T(4,2)=0: T(4,3)=0: GOTO 1336
  145. 1335 GOSUB 6700: GOSUB 9250: GOSUB 4550: REM Calculate age of widow
  146. 1336 IF A4<>2 THEN T(12,1)=0: T(12,2)=0: T(12,3)=0: GOTO 1340
  147. 1337 GOSUB 8050: REM Get widow date of disability
  148. 1340 GOSUB 7200: GOSUB 7400: GOSUB 9860: IF T6>0 THEN 9880
  149. 1350 GOSUB 9300: IF T7=0 THEN A1=5
  150. 1355 IF A1=0 THEN GOSUB 4800: GOSUB 9350
  151. 1360 IF A1=W3 THEN GOSUB 6800 ELSE GOSUB 6900
  152. 1362 IF T6>0 THEN 9880
  153. 1365 IF T8=0 THEN T3=5
  154. 1367 IF T3=0 THEN GOSUB 4900: GOSUB 9400
  155. 1370 IF T3=W3 THEN GOSUB 7900 ELSE GOSUB 7950
  156. 1372 IF T6>0 THEN 9880
  157. 1375 GOSUB 8000: IF G2>=1950+N4 THEN GOSUB 6000
  158. 1380 IF T(2,2)<=1951+N4 OR G2<=1951+N4 THEN A2=1: GOTO 1400
  159. 1385 IF A2=0 THEN GOSUB 4200: GOSUB 9450
  160. 1390 IF A2=2 THEN GOSUB 4700
  161. 1395 GOSUB 7000
  162. 1400 IF A3>1 THEN GOSUB 5400: GOTO 1405
  163. 1401 GOSUB 6400: GOSUB 2200: GOSUB 2300: U5=1: GOTO 3000
  164. 1405 F6=0!: IF A5<>2 AND G9>34 THEN GOSUB 9500: GOSUB 5600: GOSUB 9550
  165. 1415 GOSUB 5500: IF C$<>"Y" THEN 1430
  166. 1420 GOSUB 8100: IF T6>0 THEN 9880
  167. 1425 U5=2: IF A3>1 THEN GOSUB 5400: GOTO 1429
  168. 1427 GOSUB 2200: GOSUB 2700: GOTO 3000
  169. 1429 GOTO 1415
  170. 1430 GOSUB 9600
  171. 1505 CLS: GOSUB 9850
  172. 1506 PRINT "   Loading PIA calculation program; please wait..."
  173. 1510 CHAIN "PIACAL"
  174. 2000 REM Subroutine to clear screen and draw 75 hyphens
  175. 2005 CLS: GOSUB 9860: PRINT "   ";STRING$(75,"-"): RETURN
  176. 2100 REM Subroutine to draw 75 hyphens and skip two lines
  177. 2105 GOSUB 9860: PRINT "   ";STRING$(75,"-"): PRINT: PRINT: RETURN
  178. 2200 REM Subroutine to prepare screen for earnings
  179. 2205 K4=G1: GOSUB 9820: CLS: I3=1: LOCATE 2,1
  180. 2215 FOR K1=1 TO 20: FOR K2=1 TO 3: GOSUB 9870: IF I3=1 THEN 2230
  181. 2226 PRINT "             ";: GOSUB 9860: GOTO 2245
  182. 2230 PRINT "      ";K4;" ";
  183. 2235 IF K1 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9863
  184. 2245 PRINT "           ";
  185. 2255 K4=K4+20: IF K4<=G2 THEN I3=1 ELSE I3=0
  186. 2260 NEXT K2: PRINT
  187. 2280 K4=K4-59: IF K4<=G2 THEN I3=1 ELSE I3=0
  188. 2285 NEXT K1: GOSUB 2600: RETURN
  189. 2300 REM Subroutine to get earnings from keyboard
  190. 2305 GOSUB 2500: U6=14: U7=1: FOR K1=G1 TO G2: I3=1
  191. 2310 GOSUB 2450: GOSUB 2400: IF I3=0 THEN GOSUB 2600: GOSUB 2500
  192. 2315 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864
  193. 2320 LOCATE U7+1,U6: PRINT USING " ######.## ";O(K1-1936)
  194. 2325 U7=U7+1: IF U7>20 THEN U6=U6+24: U7=1
  195. 2330 NEXT K1: RETURN
  196. 2400 REM Subroutine to get one year of earnings
  197. 2405 GOSUB 2450: PRINT STRING$(10," ");
  198. 2410 LOCATE U7+1,U6+1: O(K1-1936)=VAL(FNWGETSTRN$(9))
  199. 2415 IF O(K1-1936)<=999999.99# AND O(K1-1936)>-1 THEN 2430
  200. 2420 I3=0: BEEP
  201. 2425 GOSUB 2600: GOSUB 2550: LOCATE U7+1,U6+1: GOTO 2405
  202. 2430 RETURN
  203. 2450 REM Subroutine to print cursor for earnings entry
  204. 2455 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864
  205. 2460 LOCATE U7+1,U6: PRINT ">";
  206. 2465 RETURN
  207. 2500 REM Subroutine to print earnings entry message
  208. 2505 GOSUB 9850: LOCATE 23,10
  209. 2510 PRINT "Please enter earnings for each year": RETURN
  210. 2550 REM Subroutine to print earnings re-entry message
  211. 2555 GOSUB 9840: LOCATE 23,10
  212. 2560 PRINT "Please re-enter earnings for this year": RETURN
  213. 2600 REM Subroutine to blank message window
  214. 2605 GOSUB 9860
  215. 2610 LOCATE 23,8: PRINT STRING$(65," ");
  216. 2615 LOCATE 24,8: PRINT STRING$(65," ");
  217. 2620 RETURN
  218. 2650 REM Subroutine to print correct earnings entry message
  219. 2655 GOSUB 9850: LOCATE 23,10
  220. 2660 PRINT "Please enter correct earnings for this year": RETURN
  221. 2700 REM Subroutine to put earnings on screen
  222. 2705 U6=14: U7=1: FOR K1=G1 TO G2
  223. 2715 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864
  224. 2720 LOCATE U7+1,U6: PRINT USING " ######.## ";O(K1-1936)
  225. 2725 U7=U7+1: IF U7>20 THEN U6=U6+24: U7=1
  226. 2730 NEXT K1: RETURN
  227. 2900 REM Subroutine to get y or n response
  228. 2905 GOSUB 9830: C$=FNWGETSTRN$(1)
  229. 2907 IF LEN(C$)<=0 THEN 2915
  230. 2910 GOSUB 4400: IF C$="Y" OR C$="N" THEN RETURN
  231. 2915 BEEP: LOCATE 24,62: PRINT " ";: LOCATE 24,62: GOTO 2905
  232. 2920 RETURN
  233. 3000 REM Partial program to correct earnings record
  234. 3005 K1=G1
  235. 3010 GOSUB 2600
  236. 3015 GOSUB 9860: LOCATE 24,26
  237. 3020 PRINT "Are all entries correct? (y or n) > ";: GOSUB 2900
  238. 3030 IF C$="Y" THEN GOSUB 9860: CLS: ON U5 GOTO 1405,1429,1275
  239. 3035 GOSUB 2600: GOSUB 3550
  240. 3065 U6=14: U7=1
  241. 3069 REM $IGNORE ON
  242. 3070 REM *********************** INKEY Definitions *********************
  243. 3075 FOR K2=11 TO 14: KEY(K2) ON: NEXT K2
  244. 3080 ON KEY(11) GOSUB 3300      : REM Cursor up
  245. 3085 ON KEY(12) GOSUB 3350      : REM Cursor left
  246. 3090 ON KEY(13) GOSUB 3400      : REM Cursor right
  247. 3095 ON KEY(14) GOSUB 3450      : REM Cursor down
  248. 3110 REM ***************************************************************
  249. 3111 REM $IGNORE OFF
  250. 3115 GOSUB 2450
  251. 3120 C$=INKEY$: IF C$="" THEN 3120
  252. 3121 REM For Macintosh, $INCLUDE "KEYS2.MAC"
  253. 3122 REM $INCLUDE: 'KEYS.BAS'
  254. 3125 BEEP: GOTO 3120
  255. 3150 REM Subroutine for data entry
  256. 3154 REM $IGNORE ON
  257. 3155 FOR K2=11 TO 14: KEY(K2) OFF: NEXT K2
  258. 3156 REM $IGNORE OFF
  259. 3165 GOSUB 2600: GOSUB 2650
  260. 3175 I3=1: GOSUB 2400
  261. 3265 IF U7 MOD 2=0 THEN GOSUB 9864 ELSE GOSUB 9860
  262. 3270 LOCATE U7+1,U6: PRINT USING " ######.## ";O(K1-1936)
  263. 3275 IF K1<G2 THEN 3288
  264. 3280 RETURN 3005
  265. 3288 GOSUB 2600: GOSUB 3550
  266. 3289 REM $IGNORE ON
  267. 3290 FOR K2=11 TO 14: KEY(K2) ON: NEXT K2
  268. 3291 REM $IGNORE OFF
  269. 3295 RETURN 3115
  270. 3300 REM Subroutine to handle cursor up
  271. 3305 IF K1<=G1 THEN BEEP: GOTO 3325
  272. 3307 LOCATE U7+1,U6: PRINT " ";: K1=K1-1
  273. 3310 IF (U6=38 OR U6=62) AND U7=1 THEN U6=U6-24: U7=20: GOTO 3320
  274. 3315 U7=U7-1
  275. 3320 GOSUB 2450
  276. 3325 RETURN 3120
  277. 3350 REM Subroutine to handle cursor left
  278. 3355 IF K1-20<G1 THEN BEEP: GOTO 3365
  279. 3357 LOCATE U7+1,U6: PRINT " ";: K1=K1-20
  280. 3360 U6=U6-24: GOSUB 2450
  281. 3365 RETURN 3120
  282. 3400 REM Subroutine to handle cursor right
  283. 3405 IF K1+20>G2 THEN BEEP: GOTO 3415
  284. 3407 LOCATE U7+1,U6: PRINT " ";: K1=K1+20
  285. 3410 U6=U6+24: GOSUB 2450
  286. 3415 RETURN 3120
  287. 3450 REM Subroutine to handle cursor down
  288. 3455 IF K1>=G2 THEN BEEP: GOTO 3475
  289. 3457 LOCATE U7+1,U6: PRINT " ";: K1=K1+1
  290. 3460 IF U7<20 THEN U7=U7+1: GOTO 3470
  291. 3465 U6=U6+24: U7=1
  292. 3470 GOSUB 2450
  293. 3475 RETURN 3120
  294. 3500 REM Subroutine to handle exit
  295. 3504 REM $IGNORE ON
  296. 3505 FOR K2=11 TO 14: KEY(K2) OFF: NEXT K2
  297. 3506 REM $IGNORE OFF
  298. 3510 LOCATE U7+1,U6: PRINT " ";
  299. 3515 RETURN 3005
  300. 3550 REM Subroutine to print correction menu
  301. 3553 REM For Macintosh, $INCLUDE "KEYS1.MAC"
  302. 3554 REM $IGNORE ON
  303. 3555 GOSUB 9850: LOCATE 22,31: PRINT " Correction mode "
  304. 3560 LOCATE 23,10: PRINT "-";CHR$(26);" = Right   ";CHR$(24);
  305. 3565 PRINT " = Up             Ins = To enter data"
  306. 3570 LOCATE 24,10: PRINT CHR$(27);"- = Left    ";CHR$(25);
  307. 3575 PRINT " = Down          PgDn = To exit correction mode";
  308. 3576 REM $IGNORE OFF
  309. 3580 RETURN
  310. 3600 REM Subroutine to print month error message
  311. 3605 GOSUB 9840: PRINT "   Month must be in the range 1-12"
  312. 3610 BEEP: GOSUB 9860: RETURN
  313. 3700 REM Subroutine to print day error message
  314. 3705 GOSUB 9840: PRINT "   Day must be in the range 1-31"
  315. 3710 BEEP: GOSUB 9860: RETURN
  316. 3800 REM Subroutine to print mo/dy/year error message
  317. 3805 GOSUB 9840: PRINT "   Correct format is mo/dy/year"
  318. 3810 BEEP: GOSUB 9860: RETURN
  319. 3900 REM Subroutine to print mo/year error message
  320. 3905 GOSUB 9840: PRINT "   Correct format is mo/year"
  321. 3910 BEEP: GOSUB 9860: RETURN
  322. 4000 REM Subroutine to print wage-earner info title
  323. 4005 GOSUB 2000: PRINT "   ";: GOSUB 9870
  324. 4010 PRINT STRING$(26," ");"Wage-earner information";STRING$(26," ")
  325. 4020 GOSUB 2100: RETURN
  326. 4100 REM Subroutine to get y or n response
  327. 4105 PRINT "   Is this correct? (y or n) > ";
  328. 4110 C$=FNGETSTRN$(1): GOSUB 9860
  329. 4115 IF LEN(C$)<=0 THEN BEEP: GOTO 4105
  330. 4120 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 4105
  331. 4125 RETURN
  332. 4200 REM Subroutine to print wage base title
  333. 4205 GOSUB 2000: PRINT "   ";: GOSUB 9870
  334. 4210 PRINT STRING$(27," ");"Projected wage bases";STRING$(28," ")
  335. 4220 GOSUB 2100: RETURN
  336. 4300 REM Subroutine to get title of average wage assumptions
  337. 4305 PRINT "   Enter title of average wage assumptions"
  338. 4310 PRINT "   > ";: M$=FNGETSTRN$(65): GOSUB 9860: RETURN
  339. 4400 REM Subroutine to convert response to one-letter uppercase
  340. 4405 I4=ASC(C$): IF I4>96 THEN C$=CHR$(I4-32) ELSE C$=CHR$(I4)
  341. 4410 RETURN
  342. 4500 REM Subroutine to calculate worker age at entitlement
  343. 4505 T(1,1)=T(2,2)-T(5,3): T(1,2)=T(2,1)-T(5,1)
  344. 4510 IF T(5,2)=1 THEN T(1,2)=T(1,2)+1
  345. 4515 IF T(1,2)<0 THEN T(1,1)=T(1,1)-1: T(1,2)=T(1,2)+12
  346. 4520 IF T(1,2)>11 THEN T(1,1)=T(1,1)+1: T(1,2)=T(1,2)-12
  347. 4525 RETURN
  348. 4550 REM Subroutine to calculate widow age at entitlement
  349. 4555 T(8,1)=T(2,2)-T(4,3): T(8,2)=T(2,1)-T(4,1)
  350. 4560 IF T(4,2)=1 THEN T(8,2)=T(8,2)+1
  351. 4565 IF T(8,2)<0 THEN T(8,1)=T(8,1)-1: T(8,2)=T(8,2)+12
  352. 4570 IF T(8,2)>11 THEN T(8,1)=T(8,1)+1: T(8,2)=T(8,2)-12
  353. 4575 RETURN
  354. 4600 REM Subroutine to convert catch-up code to one-letter uppercase
  355. 4605 I4=ASC(O$): IF I4>96 THEN O$=CHR$(I4-32) ELSE O$=CHR$(I4)
  356. 4610 RETURN
  357. 4700 REM Subroutine to get specified wage bases
  358. 4705 FOR K1=1 TO T(2,2)-1936-N2
  359. 4710 IF T5>=1 THEN INPUT #1,B(1,N2+K1): GOTO 4720
  360. 4715 PRINT "   Enter wage base for";1936+N2+K1;"> ";
  361. 4716 B(1,N2+K1)=VAL(FNGETSTRN$(9)): GOSUB 9860
  362. 4720 NEXT K1: RETURN
  363. 4800 REM Subroutine to print title for benefit increase assumptions
  364. 4805 GOSUB 2000: PRINT "   ";: GOSUB 9870
  365. 4810 PRINT STRING$(23," ");"Benefit increase assumptions";
  366. 4820 PRINT STRING$(24," "): GOSUB 2100: RETURN
  367. 4900 REM Subroutine to print title for average wage assumptions
  368. 4905 GOSUB 2000: PRINT "   ";: GOSUB 9870
  369. 4910 PRINT STRING$(25," ");"Average wage assumptions";STRING$(26," ")
  370. 4920 GOSUB 2100: RETURN
  371. 5000 REM Subroutine to get configuration
  372. 5004 ON ERROR GOTO 5030
  373. 5005 OPEN "I",1,"CONFIG.DAT": GOSUB 9850
  374. 5006 ON ERROR GOTO 0
  375. 5010 PRINT "   Reading configuration from CONFIG.DAT"
  376. 5015 INPUT #1,A6: INPUT #1,A5: INPUT #1,A3: INPUT #1,A4: INPUT #1,T9
  377. 5020 INPUT #1,A1: INPUT #1,T3: INPUT #1,A2: INPUT #1,G8: INPUT #1,K5
  378. 5025 CLOSE #1: RETURN
  379. 5030 REM Handle file error
  380. 5035 BEEP: GOSUB 9840: K6=66
  381. 5040 PRINT "   Configuration file does not exist."
  382. 5045 END
  383. 5100 REM Subroutine to review earnings (not currently used)
  384. 5105 FOR K2=G1 TO G2
  385. 5110 PRINT "   Worker earnings for";K2;"are";O(K2-1936)
  386. 5115 GOSUB 4100: IF C$="Y" THEN 5135
  387. 5120 PRINT "   Enter worker earnings for";K2;"> ";
  388. 5125 O(K2-1936)=VAL(FNGETSTRN$(9)): GOSUB 9860
  389. 5130 IF O(K2-1936)>999999.99# OR O(K2-1936)<-1 THEN BEEP: GOTO 5120
  390. 5135 NEXT K2: RETURN
  391. 5200 REM Subroutine to get earnings from disk file
  392. 5205 FOR K2=G1 TO G2
  393. 5210 INPUT #1,O(K2-1936)
  394. 5215 IF O(K2-1936)>999999.99# OR O(K2-1936)<-1 THEN T6=28: RETURN
  395. 5220 NEXT K2: RETURN
  396. 5300 REM Subroutine to get specified earnings (not currently used)
  397. 5305 FOR K2=G1 TO G2
  398. 5310 PRINT "   Enter worker earnings for";K2;"> ";
  399. 5315 O(K2-1936)=VAL(FNGETSTRN$(9)): GOSUB 9860
  400. 5317 IF O(K2-1936)>999999.99# OR O(K2-1936)<-1 THEN BEEP: GOTO 5310
  401. 5320 NEXT K2: RETURN
  402. 5400 REM Subroutine to project steady earnings
  403. 5405 FOR K1=N2+1 TO N5
  404. 5410 B(2,K1)=B(2,K1-1)*(B(6,K1)/100!+1!): NEXT K1
  405. 5415 FOR K1=G1 TO G2: K2=K1-1936
  406. 5420 IF A3=2 THEN O(K2)=B(1,K2)
  407. 5425 IF A3=3 THEN O(K2)=B(5,K2)
  408. 5430 IF A3=4 THEN O(K2)=B(2,K2)
  409. 5435 NEXT K1
  410. 5440 RETURN
  411. 5500 REM Subroutine to print title for data review
  412. 5505 GOSUB 2000: PRINT "   ";: GOSUB 9870
  413. 5510 PRINT STRING$(32," ");"Data review";STRING$(32," "): GOSUB 2100
  414. 5525 PRINT "   Do you want to review the data for this case?";
  415. 5530 PRINT " (y or n)> ";: C$=FNGETSTRN$(1): GOSUB 9860
  416. 5531 IF LEN(C$)<=0 THEN BEEP: GOTO 5525
  417. 5532 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 5525
  418. 5535 RETURN
  419. 5600 REM Subroutine to print noncovered pension explanation
  420. 5605 GOSUB 9850: PRINT "   A modified benefit formula generally is ";
  421. 5610 PRINT "used to compute benefits for"
  422. 5615 PRINT "   persons entitled to both a pension based on employment";
  423. 5620 PRINT " after 1956 not"
  424. 5625 PRINT "   covered by Social Security and a Social Security ";
  425. 5630 PRINT "retirement or disa-"
  426. 5632 PRINT "   bility benefit.  However, the difference between the ";
  427. 5634 PRINT "Social Security"
  428. 5635 PRINT "   benefit computed under the modified formula ";
  429. 5640 PRINT "and the Social Security"
  430. 5645 PRINT "   benefit under the regular formula cannot be greater ";
  431. 5650 PRINT "than one-half the"
  432. 5655 PRINT "   amount of the noncovered pension for the first month ";
  433. 5660 PRINT "of eligibility for"
  434. 5665 PRINT "   both the pension and the Social Security benefit.  If ";
  435. 5670 PRINT "the noncovered"
  436. 5675 PRINT "   pension is greater than $310, in 1987 dollars, the full";
  437. 5680 PRINT " reduction of the"
  438. 5685 PRINT "   modified formula will apply.": PRINT
  439. 5690 PRINT "   For Federal workers who elect into FERS and thus are ";
  440. 5695 PRINT "entitled to a"
  441. 5697 PRINT "   pension split between the CSRS and FERS retirement ";
  442. 5698 PRINT "systems, only that"
  443. 5700 PRINT "   part of the pension attributable to CSRS is a ";
  444. 5705 PRINT "noncovered pension.": PRINT: GOSUB 9860: RETURN
  445. 5800 REM Subroutine to print earnings and coverage title
  446. 5805 GOSUB 2000: PRINT "   ";: GOSUB 9870
  447. 5810 PRINT STRING$(21," ");"Earnings and coverage information";
  448. 5815 PRINT STRING$(21," "): GOSUB 2100: RETURN
  449. 5900 REM Subroutine to get quarters of coverage to date
  450. 5905 PRINT "   Enter number of quarters of coverage up to and ";
  451. 5906 PRINT "including";1936+N6;"> ";
  452. 5910 G(0,N6)=VAL(FNGETSTRN$(3)): GOSUB 9860
  453. 5915 IF G(0,N6)>=0 THEN 5930
  454. 5920 GOSUB 9840: PRINT "   Must not be negative"
  455. 5925 BEEP: GOSUB 9860: GOTO 5905
  456. 5930 RETURN
  457. 6000 REM Subroutine to project quarter-of-coverage amounts
  458. 6005 GOSUB 9850: PRINT "   Projecting quarter-of-coverage amounts"
  459. 6010 FOR K1=42 TO N5: L(0,K1)=25!*B(5,K1-2)/B(5,40)
  460. 6015 L(0,K1)=FIX(L(0,K1)+.5)*10: NEXT K1: RETURN
  461. 6100 REM Subroutine for disk error
  462. 6105 BEEP: GOSUB 9840: K6=1
  463. 6110 PRINT "   *** File error.  Please check name. ***"
  464. 6115 GOSUB 6200: RESUME NEXT
  465. 6200 REM Subroutine to print RETURN message
  466. 6205 GOSUB 9860: PRINT
  467. 6210 PRINT "   Press RETURN to continue";
  468. 6215 C$=INKEY$: IF LEN(C$)<1 THEN 6215
  469. 6220 IF ASC(C$)<>13 THEN BEEP: GOTO 6215
  470. 6225 RETURN
  471. 6300 REM Subroutine to display cases on disk
  472. 6305 GOSUB 2000: PRINT "   ";: GOSUB 9870
  473. 6310 PRINT STRING$(27," ");"Cases stored on disk";STRING$(28," ")
  474. 6315 GOSUB 2100: GOSUB 9850
  475. 6318 REM For Macintosh, $INCLUDE "DIR.MAC"
  476. 6319 REM $IGNORE ON
  477. 6320 L$="dir *.pia /w": SHELL L$
  478. 6321 REM $IGNORE OFF
  479. 6325 GOSUB 6200: RETURN
  480. 6400 REM Subroutine to present intro to earnings entry
  481. 6405 GOSUB 2000: PRINT "   ";: GOSUB 9870
  482. 6410 PRINT STRING$(30," ");"Earnings entry";STRING$(31," "): GOSUB 2100
  483. 6415 GOSUB 9850: PRINT "   Earnings for each year should be entered ";
  484. 6420 PRINT "on the following screen.  Each"
  485. 6425 PRINT "   entry should be less than $1 million (only earnings up ";
  486. 6430 PRINT "to the wage base"
  487. 6435 PRINT "   will be used in any case).  Continue with earnings for ";
  488. 6440 PRINT "each year, even"
  489. 6445 PRINT "   if you make a mistake.  You can hit RETURN for any year";
  490. 6450 PRINT " for which there"
  491. 6455 PRINT "   are no earnings.": PRINT
  492. 6460 PRINT "   If there are any pre-1951 earnings, enter the total of ";
  493. 6465 PRINT "such earnings on"
  494. 6470 PRINT "   the line for 1950.": PRINT
  495. 6475 PRINT "   After all years are entered, the screen will enter a ";
  496. 6480 PRINT "correction mode,"
  497. 6485 PRINT "   where you can use the arrow keys to place the cursor on";
  498. 6490 PRINT " the earnings you"
  499. 6495 PRINT "   wish to change.  Hit the Insert key to start entering ";
  500. 6500 PRINT "new earnings, and"
  501. 6505 PRINT "   the RETURN key when done.  Hit the Page Down key to ";
  502. 6510 PRINT "leave the correction"
  503. 6515 PRINT "   mode.": GOSUB 6200: RETURN
  504. 6700 REM Subroutine to print title for widow data
  505. 6705 GOSUB 2000: PRINT "   ";: GOSUB 9870
  506. 6710 PRINT STRING$(32," ");"Widow data";STRING$(33," ");
  507. 6715 GOSUB 2100: RETURN
  508. 6750 REM Subroutine to print title for death or disability
  509. 6755 GOSUB 2000: PRINT "   ";: GOSUB 9870
  510. 6756 PRINT STRING$(23," ");"Death and/or disability data";
  511. 6760 PRINT STRING$(24," "): GOSUB 2100: RETURN
  512. 6800 REM Subroutine to get ad hoc benefit increases
  513. 6801 IF T5=0 THEN 6811
  514. 6802 IF W1<=N4 THEN 6806
  515. 6803 GOSUB 9840: PRINT "   Benefit increases do not start in";1951+N4
  516. 6804 PRINT "   Please check input file": CLOSE #1: GOSUB 9860
  517. 6805 T6=29: BEEP: RETURN
  518. 6806 IF W1=N4 THEN 6811
  519. 6807 GOSUB 9840: PRINT "   Warning:  Benefit increases in input file ";
  520. 6808 PRINT "from";1951+W1;" to";1950+N4: PRINT "   are being skipped"
  521. 6809 FOR K2=W1+1 TO N4: INPUT #1,C(2,N4+1): NEXT K2
  522. 6810 GOSUB 9860: BEEP
  523. 6811 FOR K2=N4+1 TO T(2,2)-1950
  524. 6812 IF T5>=1 THEN INPUT #1,C(2,K2): GOTO 6820
  525. 6815 PRINT "   Enter benefit increase for";1950+K2;"> ";
  526. 6816 C(2,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860
  527. 6820 NEXT K2
  528. 6824 IF T5=0 THEN 6830 ELSE INPUT #1,O$
  529. 6825 IF LEN(O$)<=0 THEN 6827
  530. 6826 GOSUB 4600: IF O$="Y" OR O$="N" THEN 6835
  531. 6827 GOSUB 9840: PRINT "   Catch-up increase response is not y or n"
  532. 6828 PRINT "   Please check input file": CLOSE #1: GOSUB 9860
  533. 6829 T6=31: BEEP: RETURN
  534. 6830 PRINT "   Are there any catch-up benefit increases? (y or n) > ";
  535. 6831 O$=FNGETSTRN$(1): GOSUB 9860
  536. 6832 IF LEN(O$)<=0 THEN BEEP: GOTO 6830
  537. 6833 GOSUB 4600: IF O$<>"Y" AND O$<>"N" THEN BEEP: GOTO 6830
  538. 6835 IF O$<>"Y" THEN 6870
  539. 6840 FOR K2=1 TO 10: FOR K1=1 TO 8
  540. 6845 IF T5>=1 THEN INPUT #1,F(K2,K1): GOTO 6865
  541. 6850 K3=1950+N4+K2
  542. 6855 PRINT "   Enter catch-up benefit increase for year of eligibility";
  543. 6860 PRINT K3: PRINT "   for increase in Dec";1952+N4+K1;"> ";
  544. 6861 F(K2,K1)=VAL(FNGETSTRN$(6)): GOSUB 9860
  545. 6865 NEXT K1: NEXT K2: GOTO 6880
  546. 6870 FOR K4=1 TO 8: FOR K3=1 TO 10
  547. 6875 F(K3,K4)=0!: NEXT K3: NEXT K4
  548. 6880 IF T5>=1 THEN LINE INPUT #1,B$: RETURN
  549. 6885 GOSUB 7050: RETURN
  550. 6900 REM Subroutine to get menu-selected benefit increases (A1<W3)
  551. 6905 IF A1>4 THEN 6955 ELSE J$="BI"+CHR$(48+A1)+".DAT"
  552. 6909 GOSUB 9850
  553. 6910 PRINT "   Reading benefit increase assumptions from ";J$
  554. 6915 OPEN "I",2,J$
  555. 6916 INPUT #2,W2: IF W2=1951+N4 THEN 6920
  556. 6917 GOSUB 9840: PRINT "   Benefit increase assumptions do not start ";
  557. 6918 PRINT "in";1951+N4: PRINT "   Please check assumptions": CLOSE #2
  558. 6919 GOSUB 9860: T6=61: BEEP: RETURN
  559. 6920 FOR K2=N4+1 TO N7: INPUT #2, C(2,K2): NEXT K2
  560. 6925 CLOSE #2
  561. 6930 J$="CU"+CHR$(48+A1)+".DAT"
  562. 6935 PRINT "   Reading catch-up increase assumptions from ";J$
  563. 6940 OPEN "I",2,J$
  564. 6945 FOR K3=1 TO 8: FOR K4=1 TO 10: INPUT #2, F(K4,K3)
  565. 6950 NEXT K4: NEXT K3: CLOSE #2: RETURN
  566. 6955 GOSUB 9850: PRINT "   Projecting benefit increases": GOSUB 9860
  567. 6960 FOR K2=N4+1 TO N7: C(2,K2)=0!: NEXT K2
  568. 6965 FOR K4=1 TO 8: FOR K3=1 TO 10
  569. 6970 F(K3,K4)=0!: NEXT K3: NEXT K4: RETURN
  570. 7000 REM Subroutine to project old and new-law wage bases
  571. 7005 PRINT "   Projecting wage bases"
  572. 7010 FOR K1=1 TO N5: B(7,K1)=B(1,K1): NEXT K1: GOSUB 7100
  573. 7015 FOR K1=1 TO N5: B(1,K1)=B(7,K1): NEXT K1
  574. 7020 FOR K1=1 TO N5: B(7,K1)=B(4,K1): NEXT K1: GOSUB 7100
  575. 7025 FOR K1=1 TO N5: B(4,K1)=B(7,K1): NEXT K1
  576. 7030 RETURN
  577. 7050 REM Subroutine to get title of benefit increase assumptions
  578. 7055 PRINT "   Enter title of benefit increase assumptions"
  579. 7056 PRINT "   > ";: B$=FNGETSTRN$(65): GOSUB 9860
  580. 7060 RETURN
  581. 7100 REM Subroutine to project the wage base
  582. 7105 I2=N2: N3=1
  583. 7110 IF B(7,I2)>0 THEN 7150
  584. 7115 N3=1
  585. 7120 IF C(2,I2+N3-2-14)>=.1 THEN 7135
  586. 7122 IF A1=6 AND T3=6 THEN 7135
  587. 7125 B(7,I2+N3-1)=B(7,I2-1): N3=N3+1
  588. 7130 IF I2+N3>N5 THEN 7150 ELSE 7120
  589. 7135 B(7,I2+N3-1)=B(7,I2-1)
  590. 7140 FOR I1=1 TO N3: B(7,I2+N3-1)=B(7,I2+N3-1)*(1!+B(6,I2+I1-3)/100!)
  591. 7145 NEXT I1: B(7,I2+N3-1)=FIX(B(7,I2+N3-1)/300!+.5)*300
  592. 7150 I2=I2+N3: IF I2<=N5 THEN 7110
  593. 7155 RETURN
  594. 7200 REM This subroutine computes the year of eligibility
  595. 7202 GOSUB 9850: PRINT "   Computing year of eligibility": GOSUB 9860
  596. 7205 A7=T(5,3)+62-1951: REM Start with year before age 62
  597. 7210 IF T(5,1)=1 AND T(5,2)=1 THEN A7=A7-1
  598. 7215 IF A6=1 AND A7<24 THEN A7=A7+3: IF A7>24 THEN A7=24
  599. 7220 IF A5=2 AND A7>T(3,2)-1951 THEN A7=T(3,2)-1951
  600. 7225 G9=A7
  601. 7230 IF A5<3 AND T(9,3)>0 AND G9>T(9,3)-1951 THEN G9=T(9,3)-1951
  602. 7235 IF A5=3 AND G9>T(9,3)-1951 THEN G9=T(9,3)-1951
  603. 7239 IF A7<0 THEN A7=0
  604. 7240 IF G9<0 THEN G9=0
  605. 7241 IF A4<2 THEN 7251
  606. 7242 IF A4=3 THEN 7249
  607. 7243 IF T(12,1)<7 OR (T(12,1)=7 AND T(12,2)=1) THEN 7245
  608. 7244 S5=T(12,3)-1950: GOTO 7246
  609. 7245 S5=T(12,3)-1951
  610. 7246 I1=T(4,3)+50-1951: IF T(4,1)=1 AND T(4,2)=1 THEN I1=I1-1
  611. 7247 IF S5<I1 THEN S5=I1
  612. 7248 GOTO 7250
  613. 7249 S5=T(4,3)+60-1951: IF T(4,1)=1 AND T(4,2)=1 THEN S5=S5-1
  614. 7250 IF S5<0 THEN S5=0
  615. 7251 A8=5
  616. 7255 I1=G9: I2=G9-(T(5,3)-1929)
  617. 7260 IF T(5,1)=1 AND T(5,2)=1 THEN I2=G9-(T(5,3)-1930)
  618. 7265 A9=I1: IF A9>I2 THEN A9=I2
  619. 7270 IF A9<2 THEN A9=2
  620. 7275 IF A9>40 THEN A9=40
  621. 7280 IF T(9,3)<1979 THEN 7295
  622. 7285 IF T(2,2)>=1981 AND A9/5<5 THEN A8=INT(A9/5)
  623. 7290 IF T(2,2)=1980 AND T(2,1)>=7 AND A9/5<5 THEN A8=INT(A9/5)
  624. 7295 N1=A9-A8: IF N1<2 THEN N1=2: A8=A9-N1
  625. 7300 IF A5>1 THEN 7325
  626. 7310 IF G9>=7 THEN 7325
  627. 7315 N1=G9-2: IF N1<2 THEN N1=2: A8=A9-N1
  628. 7325 G4=G9-N4+1: IF G4<1 THEN G4=1
  629. 7330 IF G4>10 THEN G4=10
  630. 7332 S4=A9: IF S4<6 THEN S4=6
  631. 7335 RETURN
  632. 7400 REM This subroutine calculates early or delayed retirement factor
  633. 7401 T(7,1)=0: T(7,2)=0: I6=0: GOSUB 9840
  634. 7405 IF T(1,1)>0 THEN 7410
  635. 7407 PRINT "   Inconsistent data (impossible age)"
  636. 7408 BEEP: T6=41: RETURN
  637. 7410 IF A5=2 THEN 7615
  638. 7415 U2=A7: GOSUB 7850: T(6,1)=T(11,1): T(6,2)=T(11,2)
  639. 7440 IF A5>1 THEN 7780
  640. 7441 T(7,1)=65: T(7,2)=0: IF A6=1 THEN 7444
  641. 7442 IF T(2,2)>1956 OR (T(2,2)=1956 AND T(2,1)>=11) THEN T(7,1)=62
  642. 7443 GOTO 7445
  643. 7444 IF T(2,2)>1961 OR (T(2,2)=1961 AND T(2,1)>=8) THEN T(7,1)=62
  644. 7445 IF T(2,2)<1981 OR (T(2,2)=1981 AND T(2,1)<=8) THEN 7447
  645. 7446 IF T(5,2)<>2 THEN T(7,2)=1
  646. 7447 IF T(1,1)<T(6,1) OR (T(1,1)=T(6,1) AND T(1,2)<T(6,2)) THEN 7575
  647. 7450 I3=T(5,1)+T(6,2)+12*(T(5,3)-1971+T(6,1))
  648. 7455 IF T(5,2)=1 THEN I3=I3-1
  649. 7460 I1=I3: IF I1<1 THEN I1=1
  650. 7465 IF A7>24 THEN 7490
  651. 7470 I4=T(5,1)+12*(T(5,3)+72-1971): IF T(5,2)=1 THEN I4=I4-1
  652. 7475 IF A7<23 THEN 7495
  653. 7480 IF I4>157 THEN I4=157
  654. 7485 GOTO 7495
  655. 7490 I4=T(5,1)+12*(T(5,3)+70-1971): IF T(5,2)=1 THEN I4=I4-1
  656. 7495 I5=T(2,1)+12*(T(2,2)-1971)
  657. 7500 I2=I4: IF I2>I5 THEN I2=I5
  658. 7505 I6=I2-I1: IF I6<0 THEN I6=0
  659. 7510 IF A7<28 THEN C2=1!/1200!
  660. 7515 IF A7>=28 AND A7<36 THEN C2=1!/400!
  661. 7520 IF A7>35 AND A7<54 THEN C2=((A7-34)/2)/2400!+1/400!
  662. 7525 IF A7>=54 THEN C2=2!/300!
  663. 7530 C5=1+I6*C2
  664. 7535 RETURN
  665. 7575 IF T(1,1)<T(7,1) THEN 7600
  666. 7580 IF T(1,1)=T(7,1) AND T(1,2)<T(7,2) THEN 7600
  667. 7585 I6=(T(6,1)*12+T(6,2))-(T(1,1)*12+T(1,2))
  668. 7590 IF I6>36 THEN C5=.8-((I6-36)*5!/1200!): RETURN
  669. 7595 C5=1!-(I6*5!/900!): RETURN
  670. 7600 PRINT "   Retirement at age";T(1,1);"and";T(1,2);
  671. 7601 PRINT "months is impossible;"
  672. 7605 PRINT "   Earliest possible retirement age is";T(7,1);"and";T(7,2);
  673. 7610 PRINT "months": T6=42: BEEP: RETURN
  674. 7615 REM Survivor benefits
  675. 7616 IF A4=1 THEN C5=.75: RETURN
  676. 7620 IF A4>2 THEN 7690
  677. 7625 IF T(2,2)>1968 OR (T(2,2)=1968 AND T(2,1)>1) THEN 7640
  678. 7630 PRINT "   No disabled widow benefits until February 1968"
  679. 7635 T6=43: BEEP: RETURN
  680. 7640 IF T(8,1)>=50 THEN 7655
  681. 7645 PRINT "   Disabled widow benefits at age";T(8,1);"and";T(8,2);
  682. 7646 PRINT "months is": BEEP
  683. 7650 PRINT "   impossible; earliest possible age is 50": T6=44: RETURN
  684. 7655 IF T(8,1)<60 THEN 7670
  685. 7660 PRINT "   Disabled widow benefits at age";T(8,1);"and";T(8,2);
  686. 7661 PRINT "months is": BEEP
  687. 7665 PRINT "   not allowed here; rerun as aged widow": T6=45: RETURN
  688. 7670 I6=(60-T(8,1))*12-T(8,2): IF T(2,2)>1972 THEN 7680
  689. 7675 C5=.69167-(I6*43!/19800!): RETURN
  690. 7680 IF T(2,2)<1984 THEN C5=.715-(I6*43!/24000!): RETURN
  691. 7685 C5=.715: RETURN
  692. 7690 REM Aged widow
  693. 7691 IF T(2,2)>1956 OR (T(2,2)=1956 AND T(2,1)>10) THEN 7710
  694. 7695 IF T(8,1)>=65 THEN C5=.75: RETURN
  695. 7700 PRINT "   Aged widow benefits at age";T(8,1);"and";T(8,2);
  696. 7701 PRINT "months is": BEEP
  697. 7705 PRINT "   impossible; earliest possible age is 65": T6=46: RETURN
  698. 7710 IF T(2,2)>1965 OR (T(2,2)=1965 AND T(2,1)>8) THEN 7740
  699. 7715 IF T(8,1)>=62 THEN 7730
  700. 7720 PRINT "   Aged widow benefits at age";T(8,1);"and";T(8,2);
  701. 7721 PRINT "months is": BEEP
  702. 7725 PRINT "   impossible; earliest possible age is 62": T6=47: RETURN
  703. 7730 IF T(2,2)>1961 OR (T(2,2)=1961 AND T(2,1)>=8) THEN C5=.825: RETURN
  704. 7735 C5=.75: RETURN
  705. 7740 IF T(8,1)>=60 THEN 7755
  706. 7745 PRINT "   Aged widow benefits at age";T(8,1);"and";T(8,2);
  707. 7746 PRINT "months is": BEEP
  708. 7750 PRINT "   impossible; earliest possible age is 60": T6=48: RETURN
  709. 7755 IF T(2,2)>1972 THEN 7770
  710. 7760 IF T(8,1)>=62 THEN C5=.825: RETURN
  711. 7765 I6=(62-T(8,1))*12-T(8,2): C5=.825-(I6*5!/900!): RETURN
  712. 7770 U2=S5: GOSUB 7850: T(10,1)=T(11,1): T(10,2)=T(11,2)
  713. 7771 IF T(8,1)<T(10,1) OR (T(8,1)=T(10,1) AND T(8,2)<T(10,2)) THEN 7773
  714. 7772 C5=1!: RETURN
  715. 7773 I6=T(10,1)*12+T(10,2)-(T(8,1)*12+T(8,2))
  716. 7774 I1=T(10,1)*12+T(10,2)-60*12
  717. 7775 C5=1!-CSNG(I6)*.285/CSNG(I1): RETURN
  718. 7780 REM Disability benefits
  719. 7781 IF T(2,2)>1959 THEN 7815
  720. 7785 IF T(2,2)>1956 THEN 7795
  721. 7790 PRINT "   No disability benefits until 1957"
  722. 7792 BEEP: T6=49: RETURN
  723. 7795 IF T(1,1)>=50 THEN 7815
  724. 7800 PRINT "   Disability benefits at age";T(1,1);"and";T(1,2);
  725. 7801 PRINT "months is"
  726. 7805 PRINT "   impossible; earliest possible age is 50 in";T(2,2)
  727. 7810 T6=50: BEEP: RETURN
  728. 7815 IF T(1,1)<T(6,1) OR (T(1,1)=T(6,1) AND T(1,2)<T(6,2)) THEN 7830
  729. 7820 PRINT "   No disability benefits at age";T(6,1);"and";T(6,2);
  730. 7825 PRINT "months or later": T6=51: BEEP: RETURN
  731. 7830 C5=1!: RETURN
  732. 7850 REM Subroutine to calculate normal retirement age
  733. 7855 IF U2<49 THEN T(11,2)=0: T(11,1)=65: RETURN
  734. 7860 IF U2<54 THEN T(11,2)=2*(U2-48): T(11,1)=65: RETURN
  735. 7865 IF U2<66 THEN T(11,2)=0: T(11,1)=66: RETURN
  736. 7870 IF U2<71 THEN T(11,2)=2*(U2-65): T(11,1)=66: RETURN
  737. 7875 T(11,1)=67: T(11,2)=0: RETURN
  738. 7900 REM Subroutine to get ad hoc average wage increases
  739. 7901 IF T5=0 THEN 7911
  740. 7902 IF W1<=N4 THEN 7906
  741. 7903 GOSUB 9840: PRINT "   Average wage increases do not start in";
  742. 7904 PRINT 1937+N6: PRINT "   Please check input file": CLOSE #1
  743. 7905 GOSUB 9860: T6=30: BEEP: RETURN
  744. 7906 IF W1=N4 THEN 7911
  745. 7907 GOSUB 9840: PRINT "   Warning:  Average wage increases in input ";
  746. 7908 PRINT "file from";1950+W1;" to";1949+N4: PRINT "   are being ";
  747. 7909 PRINT "skipped": FOR K2=W1+1 TO N4: INPUT #1,C(2,N4+1): NEXT K2
  748. 7910 GOSUB 9860: BEEP
  749. 7911 FOR K2=N6+1 TO T(2,2)-1936
  750. 7912 IF T5>=1 THEN INPUT #1,B(6,K2): GOTO 7917
  751. 7913 PRINT "   Enter average wage percentage increase for";1936+K2;"> ";
  752. 7915 B(6,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860
  753. 7917 NEXT K2
  754. 7920 IF T5>=1 THEN LINE INPUT #1,M$: RETURN
  755. 7925 GOSUB 4300: RETURN
  756. 7950 REM Subroutine to get menu-selected average wage increases (T3<W3)
  757. 7955 IF T3>4 THEN 7980 ELSE J$="AW"+CHR$(48+T3)+".DAT"
  758. 7959 GOSUB 9850
  759. 7960 PRINT "   Reading average wage increase assumptions from ";J$
  760. 7965 OPEN "I",2,J$
  761. 7966 INPUT #2,W2: IF W2=1937+N6 THEN 7970
  762. 7967 GOSUB 9840: PRINT "   Average wage assumptions do not start in";
  763. 7968 PRINT 1937+N6: PRINT "   Please check assumptions": CLOSE #2
  764. 7969 GOSUB 9860: T6=62: BEEP: RETURN
  765. 7970 FOR K2=N6+1 TO N5: INPUT #2, B(6,K2): NEXT K2
  766. 7975 CLOSE #2: RETURN
  767. 7980 GOSUB 9850: PRINT "   Projecting average wage increases"
  768. 7981 GOSUB 9860
  769. 7983 IF T3=6 THEN FOR K2=N6+1 TO N5: B(6,K2)=4!: NEXT K2: RETURN
  770. 7985 FOR K2=N6+1 TO N5: B(6,K2)=0!: NEXT K2: RETURN
  771. 8000 REM Subroutine to project average wages
  772. 8005 FOR K2=N6+1 TO N5: B(5,K2)=B(5,K2-1)*(B(6,K2)/100!+1!)
  773. 8010 B(5,K2)=FIX(B(5,K2)*100!+.5): B(5,K2)=B(5,K2)/100!: NEXT K2
  774. 8015 RETURN
  775. 8050 REM Subroutine to get widow's date of disability onset
  776. 8055 PRINT "   Enter widow's date of disability onset (mo/dy/year) > ";
  777. 8056 C$=FNGETSTRN$(10)
  778. 8057 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8055
  779. 8058 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8055
  780. 8059 G$(0)=MID$(C$,1,2): T(12,1)=VAL(G$(0))
  781. 8060 G$(0)=MID$(C$,4,2): T(12,2)=VAL(G$(0))
  782. 8061 G$(0)=MID$(C$,7,4): T(12,3)=VAL(G$(0))
  783. 8062 IF T(12,3)<100 THEN T(12,3)=1900+T(12,3)
  784. 8065 IF T(12,1)<1 OR T(12,1)>12 THEN GOSUB 3600: GOTO 8055
  785. 8067 IF T(12,2)<1 OR T(12,2)>31 THEN GOSUB 3700: GOTO 8055
  786. 8068 K2=1940: IF T(5,3)>1940 THEN K2=T(5,3)
  787. 8070 IF T(12,3)>=K2 AND T(12,3)<1937+N5 THEN 8075
  788. 8072 GOSUB 9840: PRINT "   Year must be in the range";K2;"-";1936+N5
  789. 8073 BEEP: GOSUB 9860: GOTO 8055
  790. 8075 IF T(12,3)<T(2,2) OR (T(12,3)=T(2,2) AND T(12,1)<=T(2,1)) THEN 9085
  791. 8080 GOSUB 9840: PRINT "   Disability onset must precede entitlement"
  792. 8084 BEEP: GOSUB 9860: GOTO 8055
  793. 8085 GOSUB 9860: RETURN
  794. 8100 REM Subroutine to review or modify PIA data
  795. 8105 GOSUB 4000: PRINT "   ";A$(A6);" worker": GOSUB 4100
  796. 8110 IF C$<>"Y" THEN GOSUB 8750
  797. 8115 PRINT "   Date of entitlement is ";D$(T(2,1));T(2,2)
  798. 8120 GOSUB 4100: IF C$<>"Y" THEN GOSUB 8700
  799. 8125 PRINT "   Date of birth is ";D$(T(5,1));STR$(T(5,2));",";T(5,3)
  800. 8130 GOSUB 4100: IF C$<>"Y" THEN GOSUB 8800
  801. 8135 PRINT "   Type of benefit is ";P$(A5)
  802. 8140 GOSUB 4100: IF C$<>"Y" THEN GOSUB 8900
  803. 8145 GOSUB 5800: PRINT "   Type of earnings is ";Q$(A3)
  804. 8150 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9000
  805. 8155 PRINT "   First year of earnings is";G1
  806. 8160 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9100
  807. 8165 IF G2<G1 OR U4-U3>59 THEN 8180
  808. 8170 PRINT "   Last year of earnings is";G2
  809. 8175 GOSUB 4100: IF C$="Y" THEN 8185
  810. 8180 GOSUB 9200
  811. 8185 IF G1>1936+N6 THEN G(0,N6)=0: GOTO 8194
  812. 8190 PRINT "   Number of quarters of coverage up to";1936+N6;"is";
  813. 8191 PRINT G(0,N6): GOSUB 4100: IF C$<>"Y" THEN GOSUB 5900
  814. 8194 GOSUB 4500: GOSUB 6750
  815. 8195 IF A5<>2 THEN T(3,1)=0: T(3,2)=0: A4=0: GOTO 8225
  816. 8196 IF T(3,1)=0 THEN 8210
  817. 8200 PRINT "   Date of death is ";D$(T(3,1));T(3,2)
  818. 8205 GOSUB 4100: IF C$="Y" THEN 8212
  819. 8210 GOSUB 8850
  820. 8212 IF A4=0 THEN 8222
  821. 8215 PRINT "   Type of survivor is ";N$(A4)
  822. 8220 GOSUB 4100: IF C$="Y" THEN 8225
  823. 8222 GOSUB 8950
  824. 8225 IF A5=3 THEN T9=2: GOTO 8245
  825. 8230 PRINT "   Previous disability:": PRINT "   ";X$(T9)
  826. 8235 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9150
  827. 8240 IF T9=1 THEN T(9,1)=0: T(9,2)=0: T(9,3)=0: GOTO 8270
  828. 8245 IF T(9,2)=0 OR T(9,1)=0 THEN 8265
  829. 8250 PRINT "   Worker's date of disability onset is ";D$(T(9,1));
  830. 8255 PRINT STR$(T(9,2));",";T(9,3): GOSUB 4100: IF C$="Y" THEN 8270
  831. 8265 GOSUB 9050
  832. 8270 IF A4<=1 THEN 8290 ELSE GOSUB 6700: IF T(4,1)=0 THEN 8285
  833. 8275 PRINT "   Widow date of birth is ";D$(T(4,1));STR$(T(4,2));",";
  834. 8280 PRINT T(4,3): GOSUB 4100: IF C$="Y" THEN 8290
  835. 8285 GOSUB 9250: GOSUB 4550: REM Calculate age of widow
  836. 8290 IF A4<>2 THEN 8294 ELSE IF T(12,1)=0 THEN 8293
  837. 8291 PRINT "   Widow's date of disability onset is ";D$(T(12,1));
  838. 8292 PRINT STR$(T(12,2));",";T(12,3): GOSUB 4100: IF C$="Y" THEN 8295
  839. 8293 GOSUB 8050: GOTO 8295
  840. 8294 T(12,1)=0: T(12,2)=0: T(12,3)=0
  841. 8295 GOSUB 7200: GOSUB 7400: GOSUB 9860: IF T6>0 THEN RETURN
  842. 8300 GOSUB 9300: IF T7>0 THEN GOSUB 4800
  843. 8305 IF T7=0 THEN A1=5: GOTO 8350
  844. 8310 PRINT "   Benefit increase assumptions:": PRINT "   ";W$(A1)
  845. 8345 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9350
  846. 8350 IF A1<W3 THEN GOSUB 6900: IF T6>0 THEN RETURN ELSE 8399
  847. 8355 FOR K2=N4+1 TO T(2,2)-1950
  848. 8360 PRINT "   Benefit increase for";1950+K2;"is";
  849. 8361 PRINT USING "###.# percent";C(2,K2)
  850. 8365 GOSUB 4100: IF C$="Y" THEN 8375
  851. 8370 PRINT "   Enter benefit increase for";1950+K2;"> ";
  852. 8371 C(2,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860
  853. 8375 NEXT K2
  854. 8376 IF O$="" THEN O$="N"
  855. 8377 IF O$="Y" THEN 8381
  856. 8378 PRINT "   There are no catch-up benefit increases"
  857. 8379 GOSUB 4100: IF C$="Y" THEN 8392
  858. 8380 O$="Y": GOTO 8384
  859. 8381 PRINT "   There are catch-up benefit increases"
  860. 8382 GOSUB 4100: IF C$="Y" THEN 8384
  861. 8383 O$="N": GOTO 8392
  862. 8384 FOR K2=1 TO 10: FOR K1=1 TO 8: K3=1950+N4+K2
  863. 8385 PRINT "   Catch-up benefit increase for year of eligibility";K3
  864. 8386 PRINT "   for increase in Dec";1952+N4+K1;" is";F(K2,K1)
  865. 8387 GOSUB 4100: IF C$="Y" THEN 8391
  866. 8388 PRINT "   Enter catch-up benefit increase for year of eligibility";
  867. 8389 PRINT K3: PRINT "   for increase in Dec";1952+N4+K1;"> ";
  868. 8390 F(K2,K1)=VAL(FNGETSTRN$(6)): GOSUB 9860
  869. 8391 NEXT K1: NEXT K2
  870. 8392 FOR K2=1 TO 10: FOR K1=1 TO 8: F(K2,K1)=0.0: NEXT K1: NEXT K2
  871. 8393 IF B$="" THEN 8396
  872. 8394 PRINT "   Title of benefit increase assumptions:": PRINT "   ";B$
  873. 8395 GOSUB 4100: IF C$="Y" THEN 8399
  874. 8396 GOSUB 7050
  875. 8399 IF T8>0 THEN GOSUB 4900
  876. 8400 IF T8=0 THEN T3=5: GOTO 8445
  877. 8405 PRINT "   Average wage increase assumptions:": PRINT "   ";E$(T3)
  878. 8440 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9400
  879. 8445 IF T3<W3 THEN GOSUB 7950: IF T6>0 THEN RETURN ELSE 8500
  880. 8450 FOR K2=N6+1 TO T(2,2)-1936
  881. 8455 PRINT "   Average wage increase for";1936+K2;"is";
  882. 8456 PRINT USING "###.#### percent";B(6,K2)
  883. 8460 GOSUB 4100: IF C$="Y" THEN 8475
  884. 8465 PRINT "   Enter average wage percentage increase for";1936+K2;"> ";
  885. 8470 B(6,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860
  886. 8475 NEXT K2
  887. 8480 IF M$="" THEN 8495
  888. 8485 PRINT "   Title of average wage increase assumptions:"
  889. 8490 PRINT "   ";M$: GOSUB 4100: IF C$="Y" THEN 8500
  890. 8495 GOSUB 4300
  891. 8500 GOSUB 8000: IF G2>=1950+N4 THEN GOSUB 6000
  892. 8505 IF T(2,2)<=1951+N4 OR G2<=1951+N4 THEN A2=1: GOTO 8585
  893. 8510 GOSUB 4200: PRINT "   Projected wage bases:"
  894. 8515 PRINT "   ";R$(A2): GOSUB 4100: IF C$="N" THEN GOSUB 9450
  895. 8522 IF A2>1 THEN 8525
  896. 8523 FOR K1=N2+1 TO N5: B(1,K1)=0: B(4,K1)=0: NEXT K1: GOTO 8550
  897. 8525 FOR K1=1 TO T(2,2)-1936-N2
  898. 8530 PRINT "   Wage base for";1936+N2+K1;"is";B(1,N2+K1)
  899. 8535 GOSUB 4100: IF C$="Y" THEN 8545
  900. 8540 PRINT "   Enter wage base for";1936+N2+K1;"> ";
  901. 8541 B(1,N2+K1)=VAL(FNGETSTRN$(9)): GOSUB 9860
  902. 8545 NEXT K1
  903. 8550 GOSUB 7000
  904. 8585 IF A5=2 OR G9<35 THEN F6=0!: GOTO 8600
  905. 8587 GOSUB 9500
  906. 8590 PRINT USING "   Monthly noncovered pension is$$###.##";F6
  907. 8595 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9550
  908. 8600 RETURN
  909. 8700 REM Subroutine to get date of entitlement
  910. 8701 GOSUB 9850: PRINT "   For old-age benefits, mo/year of ";
  911. 8702 PRINT "entitlement cannot be before age 62 and"
  912. 8703 PRINT "   1 month unless date of birth is on first or second day ";
  913. 8704 PRINT "of month, in"
  914. 8705 PRINT "   which case initial month of entitlement can be as ";
  915. 8706 PRINT "early as month of"
  916. 8707 PRINT "   62nd birthday.": GOSUB 9860
  917. 8710 PRINT "   Enter date of entitlement (mo/year) > ";
  918. 8711 C$=FNGETSTRN$(7)
  919. 8712 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3900: GOTO 8710
  920. 8713 G$(0)=MID$(C$,1,2): T(2,1)=VAL(G$(0))
  921. 8714 G$(0)=MID$(C$,4,4): T(2,2)=VAL(G$(0))
  922. 8715 IF T(2,2)<100 THEN T(2,2)=1900+T(2,2)
  923. 8716 IF T(2,1)<1 OR T(2,1)>12 THEN GOSUB 3600: GOTO 8710
  924. 8720 IF T(2,2)>1939 AND T(2,2)<1937+N5 THEN 8725
  925. 8722 GOSUB 9840: PRINT "   Year must be in the range 1940 -";1936+N5
  926. 8723 BEEP: GOSUB 9860: GOTO 8710
  927. 8725 GOSUB 9860: RETURN
  928. 8750 REM Subroutine to get sex of worker
  929. 8755 PRINT "   Enter sex-of-worker code (1=male, 2=female) > ";
  930. 8756 A6=VAL(FNGETSTRN$(1)): GOSUB 9860
  931. 8760 IF A6<1 OR A6>2 THEN BEEP: GOTO 8755
  932. 8765 RETURN
  933. 8800 REM Subroutine to get date of birth
  934. 8805 PRINT "   Enter date of birth (mo/dy/year) > ";
  935. 8806 C$=FNGETSTRN$(10)
  936. 8807 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8805
  937. 8808 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8805
  938. 8809 G$(0)=MID$(C$,1,2): T(5,1)=VAL(G$(0))
  939. 8810 G$(0)=MID$(C$,4,2): T(5,2)=VAL(G$(0))
  940. 8811 G$(0)=MID$(C$,7,4): T(5,3)=VAL(G$(0))
  941. 8812 IF T(5,1)<1 OR T(5,1)>12 THEN GOSUB 3600: GOTO 8805
  942. 8815 IF T(5,2)<1 OR T(5,2)>31 THEN GOSUB 3700: GOTO 8805
  943. 8820 IF T(5,3)<100 THEN T(5,3)=1900+T(5,3)
  944. 8825 IF T(5,3)<1937+N5 THEN 8830
  945. 8827 GOSUB 9840: PRINT "   Year cannot be more than";1936+N5
  946. 8828 BEEP: GOSUB 9860: GOTO 8805
  947. 8830 GOSUB 9860: RETURN
  948. 8850 REM Subroutine to get date of death
  949. 8855 PRINT "   Enter date of death (mo/year) > ";
  950. 8856 C$=FNGETSTRN$(7)
  951. 8857 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3900: GOTO 8855
  952. 8858 G$(0)=MID$(C$,1,2): T(3,1)=VAL(G$(0))
  953. 8859 G$(0)=MID$(C$,4,4): T(3,2)=VAL(G$(0))
  954. 8860 IF T(3,2)<100 THEN T(3,2)=1900+T(3,2)
  955. 8865 IF T(3,1)<1 OR T(3,1)>12 THEN GOSUB 3600: GOTO 8855
  956. 8869 K2=1940: IF T(5,3)>1940 THEN K2=T(5,3)
  957. 8870 IF T(3,2)>=K2 AND T(3,2)<1937+N5 THEN 8875
  958. 8872 GOSUB 9840: PRINT "   Year must be in the range";K2;"-";1936+N5
  959. 8873 BEEP: GOSUB 9860: GOTO 8855
  960. 8875 IF T(3,2)<T(2,2) OR (T(3,2)=T(2,2) AND T(3,1)<=T(2,1)) THEN 8885
  961. 8880 GOSUB 9840: PRINT "   Death must precede entitlement"
  962. 8882 BEEP: GOSUB 9860: GOTO 8855
  963. 8885 GOSUB 9860: RETURN
  964. 8900 REM Subroutine to get type of benefit
  965. 8905 PRINT "   Enter type of benefit:"
  966. 8910 FOR K2=1 TO 3: PRINT "     ";K2;"for ";P$(K2): NEXT K2
  967. 8915 PRINT "   > ";: A5=VAL(FNGETSTRN$(1)): GOSUB 9860
  968. 8916 IF A5<1 OR A5>3 THEN BEEP: GOTO 8905
  969. 8920 IF A5<>3 THEN RETURN
  970. 8925 GOSUB 9850: PRINT "   The worker is assumed to be disability-";
  971. 8930 PRINT "insured": GOSUB 6200: RETURN
  972. 8950 REM Subroutine to get type of survivor
  973. 8955 PRINT "   Enter type of survivor claim:"
  974. 8960 FOR K2=1 TO 3: PRINT "     ";K2;"for ";N$(K2): NEXT K2
  975. 8965 PRINT "   > ";: A4=VAL(FNGETSTRN$(1)): GOSUB 9860
  976. 8966 IF A4<1 OR A4>3 THEN BEEP: GOTO 8955
  977. 8970 RETURN
  978. 9000 REM Subroutine to get type of earnings
  979. 9005 PRINT "   Enter type of earnings:"
  980. 9010 FOR K2=1 TO 4: PRINT "     ";K2;"for ";Q$(K2): NEXT K2
  981. 9015 PRINT "   > ";: A3=VAL(FNGETSTRN$(1)): GOSUB 9860
  982. 9016 IF A3<1 OR A3>4 THEN BEEP: GOTO 9005
  983. 9020 RETURN
  984. 9050 REM Subroutine to get worker's date of disability onset
  985. 9055 PRINT "   Enter worker's date of disability onset (mo/dy/year) > ";
  986. 9056 C$=FNGETSTRN$(10)
  987. 9057 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9055
  988. 9058 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9055
  989. 9059 G$(0)=MID$(C$,1,2): T(9,1)=VAL(G$(0))
  990. 9060 G$(0)=MID$(C$,4,2): T(9,2)=VAL(G$(0))
  991. 9061 G$(0)=MID$(C$,7,4): T(9,3)=VAL(G$(0))
  992. 9062 IF T(9,3)<100 THEN T(9,3)=1900+T(9,3)
  993. 9065 IF T(9,1)<1 OR T(9,1)>12 THEN GOSUB 3600: GOTO 9055
  994. 9067 IF T(9,2)<1 OR T(9,2)>31 THEN GOSUB 3700: GOTO 9055
  995. 9068 K2=1940: IF T(5,3)>1940 THEN K2=T(5,3)
  996. 9070 IF T(9,3)>=K2 AND T(9,3)<1937+N5 THEN 9075
  997. 9072 GOSUB 9840: PRINT "   Year must be in the range";K2;"-";1936+N5
  998. 9073 BEEP: GOSUB 9860: GOTO 9055
  999. 9075 IF T(9,3)<T(2,2) OR (T(9,3)=T(2,2) AND T(9,1)<=T(2,1)) THEN 9085
  1000. 9080 GOSUB 9840: PRINT "   Disability onset must precede entitlement"
  1001. 9084 BEEP: GOSUB 9860: GOTO 9055
  1002. 9085 IF A5<>2 THEN 9095
  1003. 9086 IF T(9,3)<T(3,2) OR (T(9,3)=T(3,2) AND T(9,1)<=T(3,1)) THEN 9095
  1004. 9090 GOSUB 9840: PRINT "   Disability onset must precede death"
  1005. 9091 BEEP: GOSUB 9860: GOTO 9055
  1006. 9095 GOSUB 9860: RETURN
  1007. 9100 REM Subroutine to get first year of earnings
  1008. 9105 PRINT "   Enter first year for which there are earnings (enter ";
  1009. 9106 PRINT "1950": PRINT "   if there are any pre-1951 earnings) > ";
  1010. 9107 G1=VAL(FNGETSTRN$(4))
  1011. 9110 IF G1<100 THEN G1=1900+G1
  1012. 9112 K2=1937: IF T(5,3)>1937 THEN K2=T(5,3)
  1013. 9113 IF G1<1937+N5 AND G1>=K2 THEN 9120
  1014. 9114 GOSUB 9840: PRINT "   Year must be in the range";K2;"-";1936+N5
  1015. 9115 BEEP: GOSUB 9860: GOTO 9105
  1016. 9120 IF T(5,3)<1937 OR G1>1950 THEN 9125
  1017. 9122 GOSUB 9840: PRINT "   Year must be at least 1951"
  1018. 9123 BEEP: GOSUB 9860: GOTO 9105
  1019. 9125 U3=G1: IF G1<1951 THEN U3=1937
  1020. 9130 GOSUB 9860: RETURN
  1021. 9150 REM Subroutine to get disability code
  1022. 9160 PRINT "   Enter disability code:"
  1023. 9165 FOR K2=1 TO 2: PRINT "     ";K2;"for ";X$(K2): NEXT K2
  1024. 9175 PRINT "   > ";: T9=VAL(FNGETSTRN$(1)): GOSUB 9860
  1025. 9176 IF T9<1 OR T9>2 THEN BEEP: GOTO 9160
  1026. 9178 IF T9=1 THEN T(9,1)=0: T(9,2)=0: T(9,3)=0
  1027. 9180 RETURN
  1028. 9200 REM Subroutine to get last year of earnings
  1029. 9205 PRINT "   Enter last year for which there are earnings > ";
  1030. 9206 G2=VAL(FNGETSTRN$(4))
  1031. 9210 IF G2<100 THEN G2=1900+G2
  1032. 9215 IF G2<1937+N5 AND G2>=G1 THEN 9220
  1033. 9217 GOSUB 9840: PRINT "   Year must be in the range";G1;"-";1936+N5
  1034. 9218 BEEP: GOSUB 9860: GOTO 9205
  1035. 9220 U4=G2: IF G2<1950 THEN U4=1950
  1036. 9225 IF G2-G1<61 THEN 9230
  1037. 9227 GOSUB 9840: PRINT "   No more than 60 years of earnings"
  1038. 9228 BEEP: GOSUB 9860: GOTO 9205
  1039. 9230 GOSUB 9860: RETURN
  1040. 9250 REM Subroutine to get widow date of birth
  1041. 9255 PRINT "   Enter widow date of birth (mo/dy/year) > ";
  1042. 9256 C$=FNGETSTRN$(10)
  1043. 9257 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9255
  1044. 9258 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9255
  1045. 9259 G$(0)=MID$(C$,1,2): T(4,1)=VAL(G$(0))
  1046. 9260 G$(0)=MID$(C$,4,2): T(4,2)=VAL(G$(0))
  1047. 9261 G$(0)=MID$(C$,7,4): T(4,3)=VAL(G$(0))
  1048. 9262 IF T(4,1)<1 OR T(4,1)>12 THEN GOSUB 3600: GOTO 9255
  1049. 9265 IF T(4,2)<1 OR T(4,2)>31 THEN GOSUB 3700: GOTO 9255
  1050. 9270 IF T(4,3)<100 THEN T(4,3)=1900+T(4,3)
  1051. 9275 GOSUB 9860: RETURN
  1052. 9300 REM Subroutine to see if assumptions are needed
  1053. 9305 T7=0: T8=0
  1054. 9310 IF T(2,2)>1951+N4 OR (T(2,2)=1951+N4 AND T(2,1)=12) THEN T7=1
  1055. 9315 IF T(2,2)>1951+N4 OR (T(2,2)>1949+N4 AND A3=3) THEN T8=1
  1056. 9320 RETURN
  1057. 9350 REM Subroutine to get benefit increase assumption trigger
  1058. 9355 PRINT "   Enter benefit increase assumptions:"
  1059. 9370 FOR K2=1 TO W3: PRINT "     ";K2;"for ";W$(K2): NEXT K2
  1060. 9381 PRINT "   > ";: A1=VAL(FNGETSTRN$(1)): GOSUB 9860
  1061. 9385 IF A1<1 OR A1>W3 THEN BEEP: GOTO 9355
  1062. 9390 RETURN
  1063. 9400 REM Subroutine to get average wage assumption trigger
  1064. 9405 PRINT "   Enter average wage (indexing series) assumptions:"
  1065. 9415 FOR K2=1 TO W3: PRINT "     ";K2;"for ";E$(K2): NEXT K2
  1066. 9426 PRINT "   > ";: T3=VAL(FNGETSTRN$(1)): GOSUB 9860
  1067. 9430 IF T3<1 OR T3>W3 THEN BEEP: GOTO 9405
  1068. 9435 RETURN
  1069. 9450 REM Subroutine to get projected wage base trigger
  1070. 9455 PRINT "   Enter wage base change indicator:"
  1071. 9460 FOR K2=1 TO 2: PRINT "     ";K2;"for ";R$(K2): NEXT K2
  1072. 9465 PRINT "   > ";: A2=VAL(FNGETSTRN$(1)): GOSUB 9860
  1073. 9470 IF A2<1 OR A2>2 THEN BEEP: GOTO 9455
  1074. 9475 RETURN
  1075. 9500 REM Subroutine to print title for noncovered pension
  1076. 9501 GOSUB 2000: PRINT "   ";: GOSUB 9870
  1077. 9502 PRINT STRING$(28," ");"Noncovered pension";STRING$(29," ")
  1078. 9505 GOSUB 2100: RETURN
  1079. 9550 REM Subroutine to get amount of noncovered pension
  1080. 9555 PRINT "   Enter amount of monthly noncovered pension. ";
  1081. 9560 PRINT "(0 if none) > ";: F6=VAL(FNGETSTRN$(9)): GOSUB 9860
  1082. 9565 IF F6>=0! THEN 9570
  1083. 9567 GOSUB 9840: PRINT "   Must not be negative"
  1084. 9568 BEEP: GOSUB 9860: GOTO 9555
  1085. 9570 RETURN
  1086. 9600 REM Subroutine to save data to disk
  1087. 9601 GOSUB 2000: PRINT "   ";: GOSUB 9870
  1088. 9602 PRINT STRING$(30," ");"Saving to disk";STRING$(31," ")
  1089. 9603 GOSUB 2100: GOSUB 9850
  1090. 9604 PRINT "   You can save the data entered for this case.  This ";
  1091. 9605 PRINT "would be useful if you": PRINT "   wanted to change just ";
  1092. 9606 PRINT "part of the data.  For instance, you may want to"
  1093. 9607 PRINT "   redo the computation assuming more or fewer years of ";
  1094. 9608 PRINT "covered earnings in"
  1095. 9609 PRINT "   the future.": PRINT
  1096. 9613 PRINT "   If you save this case, the data will be available to ";
  1097. 9614 PRINT "any other user of"
  1098. 9615 PRINT "   this disk.  If the data is sensitive, you should ";
  1099. 9616 PRINT "safeguard the disk, or"
  1100. 9617 PRINT "   else use the 'delete a case' option from the 'Case ";
  1101. 9618 PRINT "Selection' menu when"
  1102. 9619 PRINT "   you are finished with this case.": PRINT: GOSUB 9860
  1103. 9620 PRINT "   Do you want to save this case to disk? (y or n) > ";
  1104. 9621 C$=FNGETSTRN$(1): GOSUB 9860
  1105. 9622 IF LEN(C$)<=0 THEN BEEP: GOTO 9620
  1106. 9623 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 9620
  1107. 9624 IF C$ <>"Y" THEN RETURN
  1108. 9625 PRINT "   Enter name of file for this case (up to 8 characters";
  1109. 9626 PRINT " or numbers)": PRINT "   > ";
  1110. 9627 L$=FNGETSTRN$(8): GOSUB 9860: L$=L$+".pia"
  1111. 9630 OPEN "O",1,L$: PRINT "   Writing to ";L$
  1112. 9635 PRINT #1,N4: PRINT #1,A6: PRINT #1,T(2,1): PRINT #1,T(2,2)
  1113. 9640 PRINT #1,T(5,1): PRINT #1,T(5,2): PRINT #1,T(5,3)
  1114. 9641 PRINT #1,A5: PRINT #1,A3: PRINT #1,G1: PRINT #1,G2
  1115. 9645 PRINT #1,G(0,N6): PRINT #1,T(3,1): PRINT #1,T(3,2): PRINT #1,A4
  1116. 9650 PRINT #1,T9: PRINT #1,T(9,1): PRINT #1,T(9,2): PRINT #1,T(9,3)
  1117. 9655 PRINT #1,T(4,1): PRINT #1,T(4,2): PRINT #1,T(4,3)
  1118. 9656 PRINT #1,T(12,1): PRINT #1,T(12,2): PRINT #1,T(12,3)
  1119. 9660 PRINT #1,A1: IF A1<W3 THEN 9690
  1120. 9665 FOR K2=N4+1 TO T(2,2)-1950: PRINT #1,USING "##.#";C(2,K2): NEXT K2
  1121. 9670 PRINT #1,O$: IF O$<>"Y" THEN 9685
  1122. 9675 FOR K2=1 TO 10: FOR K1=1 TO 8
  1123. 9680 PRINT #1,USING "##.#";F(K2,K1): NEXT K1: NEXT K2
  1124. 9685 PRINT #1,B$
  1125. 9690 PRINT #1,T3: IF T3<W3 THEN 9710
  1126. 9695 FOR K2=N6+1 TO T(2,2)-1936: PRINT #1,USING "##.####";B(6,K2)
  1127. 9700 NEXT K2
  1128. 9705 PRINT #1,M$
  1129. 9710 PRINT #1,A2: IF A2<2 THEN 9725
  1130. 9715 FOR K1=1 TO T(2,2)-1936-N2: PRINT #1,USING "######";B(1,N2+K1)
  1131. 9720 NEXT K1
  1132. 9725 IF A3>1 THEN 9735
  1133. 9730 FOR K2=G1 TO G2: PRINT #1,USING " ######.##";O(K2-1936): NEXT K2
  1134. 9735 PRINT #1,USING "######.##";F6: CLOSE #1: RETURN
  1135. 9800 REM 1-line subroutines
  1136. 9813 REM For Macintosh, $INCLUDE "COLOR.MAC"
  1137. 9814 REM $INCLUDE: 'COLOR.BAS'
  1138. 9880 PRINT "   Do you wish to do another calculation? (y or n) > ";
  1139. 9885 C$=FNGETSTRN$(1): GOSUB 9860
  1140. 9887 IF LEN(C$)<=0 THEN BEEP: GOTO 9880
  1141. 9890 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 9880
  1142. 9895 IF C$="Y" THEN 1000
  1143. 9900 GOSUB 9860: CLS: END
  1144. 9999 REM PIAIN.BAS - 1/26/88 - 09:15 AM
  1145.