Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / basic / library / zbasic / pia / piain.bas < prev next >

Wrap

BASIC Source File | 1988-01-26 | 50.1 KB | 1,145 lines

100 DEFINT A,G,I,K,M,N,P,S,T,U,W: DEFDBL B,C,D,L,O 101 DEFSNG E,F,H,J,Q,R,V,X,Y,Z 105 REM $INCLUDE: 'COMMON.BAS' 110 REM $INCLUDE: 'WGETSTRN.BAS' 115 REM $INCLUDE: 'GETSTRN.BAS' 500 REM Read historical amounts from OLDAWBI.DAT 505 OPEN "I",1,"OLDAWBI.DAT" 510 PRINT " Reading historical amounts from OLDAWBI.DAT" 515 INPUT #1,N4: N2=N4+15: N6=N2-2 520 FOR I1=25 TO N4: INPUT #1,C(2,I1): NEXT I1 525 FOR I1=1 TO N6: INPUT #1,B(5,I1): NEXT I1 530 FOR I1=1 TO N2: INPUT #1,B(1,I1): NEXT I1 535 FOR I1=1 TO N2: INPUT #1,B(4,I1): NEXT I1 540 FOR I1=1 TO N2: INPUT #1,B(2,I1): NEXT I1 545 CLOSE #1 600 REM Read titles of assumptions from TITLES.DAT 605 OPEN "I",1,"TITLES.DAT" 610 PRINT " Reading titles of assumptions from TITLES.DAT" 615 FOR I1=1 TO 4: INPUT #1,E$(I1): W$(I1)=E$(I1): NEXT I1 620 CLOSE #1 700 REM Set titles of built-in assumptions 702 E$(5)="No increase beyond"+STR$(1949+N4)+" average wage" 703 E$(6)="Current POMS calculation (4-percent nominal wage increases)" 705 E$(7)="Proposed POMS calculation (1-percent real wage increases)" 710 E$(8)="Other assumptions (input from keyboard)" 715 W$(5)="No increase beginning with"+STR$(1951+N4)+" benefit increase" 716 W$(6)="Current POMS calculation (no future benefit increases)" 720 W$(7)="Proposed POMS calculation (no future benefit increases)" 725 W$(8)=E$(8) 800 REM Initialize configuration 805 GOSUB 5000 1000 REM Start main program 1001 T6=0: FOR I1=N2+1 TO N5: B(1,I1)=0!: B(4,I1)=0!: NEXT I1 1005 K6=0: GOSUB 2000: PRINT " ";: GOSUB 9870 1006 PRINT STRING$(30," ");"Case selection";STRING$(31," "): GOSUB 2100 1010 PRINT " Enter type of data to be entered:" 1015 PRINT " 0 to enter data from keyboard" 1020 PRINT " 1 to recall and run data previously stored on disk" 1025 PRINT " 2 to modify data previously stored on disk" 1026 PRINT " 3 to delete data previously stored on disk" 1027 PRINT " 4 to display cases stored on disk" 1028 PRINT " > ";: T5=VAL(FNGETSTRN$(1)): GOSUB 9860 1030 IF T5<0 OR T5>4 THEN BEEP: GOTO 1010 1035 ON T5+1 GOTO 1300,1040,1040,1040,1036 1036 GOSUB 6300: GOTO 1005 1040 PRINT " Enter name of file stored on disk (up to 8 characters"; 1041 PRINT " or numbers)": PRINT " > "; 1042 L$=FNGETSTRN$(8): L$=L$+".pia" 1043 ON ERROR GOTO 6100 1045 OPEN "I",1,L$ 1046 ON ERROR GOTO 0: IF K6 THEN 1005 1047 IF T5=3 THEN 1290 1048 GOSUB 9850: PRINT " Reading from ";L$ 1050 INPUT #1,W1: INPUT #1,A6: IF A6<1 OR A6>2 THEN T6=1: GOTO 1280 1055 INPUT #1,T(2,1): IF T(2,1)<1 OR T(2,1)>12 THEN T6=2: GOTO 1280 1056 INPUT #1,T(2,2) 1060 IF T(2,2)<1940 OR T(2,2)>1936+N5 THEN T6=3: GOTO 1280 1070 INPUT #1,T(5,1): IF T(5,1)<1 OR T(5,1)>12 THEN T6=4: GOTO 1280 1075 INPUT #1,T(5,2): IF T(5,2)<1 OR T(5,2)>31 THEN T6=5: GOTO 1280 1076 INPUT #1,T(5,3) 1080 INPUT #1,A5: IF A5<1 OR A5>3 THEN T6=6: GOTO 1280 1085 INPUT #1,A3: IF A3<1 OR A3>4 THEN T6=7: GOTO 1280 1090 INPUT #1,G1 1095 IF G1>1936+N5 OR G1<1937 OR G1<T(5,3) THEN T6=8: GOTO 1280 1100 IF T(5,3)>1936 AND G1<1951 THEN T6=25: GOTO 1280 1105 U3=G1: IF G1<1951 THEN U3=1937 1110 INPUT #1,G2 1115 IF G2>1936+N5 OR G2<G1 THEN T6=9: GOTO 1280 1120 U4=G2: IF G2<1950 THEN U4=1950 1125 IF G2-G1>59 THEN T6=26: GOTO 1280 1127 INPUT #1,G(0,N6): IF G(0,N6)<0 THEN T6=33: GOTO 1280 1130 GOSUB 4500: INPUT #1,T(3,1): INPUT #1,T(3,2) 1132 IF A5<>2 THEN T(3,1)=0: T(3,2)=0: GOTO 1155 1135 IF T(3,1)<1 OR T(3,1)>12 THEN T6=10: GOTO 1280 1140 IF T(3,2)<1940 OR T(3,2)>1936+N5 THEN T6=11: GOTO 1280 1145 IF T(3,2)>T(2,2) THEN T6=12: GOTO 1280 1150 IF T(3,2)=T(2,2) AND T(3,1)>T(2,1) THEN T6=12: GOTO 1280 1155 INPUT #1,A4: IF A5<>2 THEN A4=0: GOTO 1165 1160 IF A4<1 OR A4>3 THEN T6=13: GOTO 1280 1165 INPUT #1,T9: IF T9<1 OR T9>2 THEN T6=23: GOTO 1280 1170 IF A5=3 AND T9=1 THEN T6=24: GOTO 1280 1175 INPUT #1,T(9,1): INPUT #1,T(9,2): INPUT #1,T(9,3) 1180 IF T9=1 THEN 1200 1185 IF T(9,1)<1 OR T(9,1)>12 THEN T6=14: GOTO 1280 1187 IF T(9,2)<1 OR T(9,2)>31 THEN T6=32: GOTO 1280 1190 IF T(9,3)<1940 THEN T6=15: GOTO 1280 1195 IF T(9,3)>1936+N5 THEN T6=16: GOTO 1280 1197 IF T(9,3)<T(2,2) OR (T(9,3)=T(2,2) AND T(9,1)<=T(2,1)) THEN 1200 1198 T6=27: GOTO 1280 1200 INPUT #1,T(4,1): INPUT #1,T(4,2): INPUT #1,T(4,3) 1201 IF A4<=1 THEN 1212 1205 IF T(4,1)<1 OR T(4,1)>12 THEN T6=17: GOTO 1280 1210 IF T(4,2)<1 OR T(4,2)>31 THEN T6=18: GOTO 1280 1211 GOSUB 4550: REM Calculate age of widow 1212 INPUT #1,T(12,1): INPUT #1,T(12,2): INPUT #1,T(12,3) 1213 IF A4<>2 THEN 1220 1214 IF T(12,1)<1 OR T(12,1)>12 THEN T6=34: GOTO 1280 1215 IF T(12,2)<1 OR T(12,2)>31 THEN T6=35: GOTO 1280 1216 IF T(12,3)<1940 THEN T6=36: GOTO 1280 1217 IF T(12,3)>1936+N5 THEN T6=37: GOTO 1280 1218 IF T(12,3)<T(2,2) OR (T(12,3)=T(2,2) AND T(12,1)<=T(2,1)) THEN 1220 1219 T6=38: GOTO 1280 1220 GOSUB 7200: GOSUB 7400: GOSUB 9860: IF T6>0 THEN 1280 1222 GOSUB 9300 1225 INPUT #1,A1: IF A1<1 OR A1>W3 THEN T6=19: GOTO 1280 1230 IF A1=W3 THEN GOSUB 6800 ELSE GOSUB 6900 1232 IF T6>0 THEN 9880 1235 INPUT #1,T3: IF T3<1 OR T3>W3 THEN T6=20: GOTO 1280 1240 IF T3=W3 THEN GOSUB 7900 ELSE GOSUB 7950 1242 IF T6>0 THEN 9880 1245 GOSUB 8000: IF G2>=1950+N4 THEN GOSUB 6000 1250 INPUT #1,A2: IF A2<1 OR A2>2 THEN T6=21: GOTO 1280 1255 IF A2=2 THEN GOSUB 4700 1257 GOSUB 7000 1260 IF A3>1 THEN GOSUB 5400: GOTO 1265 1262 GOSUB 5200: IF T6>0 THEN 1280 1265 INPUT #1,F6: IF F6<0 THEN T6=22: GOTO 1280 1270 CLOSE #1: IF T5<>2 THEN 1505 1272 GOSUB 8100: IF T6>0 THEN 9880 1273 U5=3: IF A3>1 THEN GOSUB 5400: GOTO 1275 1274 GOSUB 2200: GOSUB 2700: GOTO 3000 1275 GOSUB 5500: IF C$="Y" THEN 1272 1278 GOSUB 9600: GOTO 1505 1280 CLOSE #1: GOSUB 9840: PRINT " Error in file ";L$: BEEP 1285 PRINT USING " Error code ##";T6: GOSUB 9860: GOTO 9880 1290 REM Delete file from disk 1291 CLOSE #1 1295 KILL L$ 1296 ON ERROR GOTO 0 1297 GOTO 1005 1300 REM Read case from keyboard 1305 GOSUB 5000: GOSUB 4000: IF A6=0 THEN GOSUB 8750 1306 GOSUB 8700: GOSUB 8800: IF A5=0 THEN GOSUB 8900 1307 GOSUB 5800: IF A3=0 THEN GOSUB 9000 1310 GOSUB 9100: GOSUB 9200: G(0,N6)=0: IF G1<=1936+N6 THEN GOSUB 5900 1312 GOSUB 4500: GOSUB 6750: REM Start death or disability data 1315 IF A5<>2 THEN T(3,1)=0: T(3,2)=0: A4=0: GOTO 1320 1316 GOSUB 8850: REM Get date of death 1317 IF A4=0 THEN GOSUB 8950: REM Get type of survivor 1320 IF A5>2 THEN T9=2: GOTO 1330 1325 IF T9=0 THEN GOSUB 9150 1327 IF T9=1 THEN T(9,1)=0: T(9,2)=0: T(9,3)=0: GOTO 1334 1330 GOSUB 9050: REM Get worker date of disability 1334 IF A4<2 THEN T(4,1)=0: T(4,2)=0: T(4,3)=0: GOTO 1336 1335 GOSUB 6700: GOSUB 9250: GOSUB 4550: REM Calculate age of widow 1336 IF A4<>2 THEN T(12,1)=0: T(12,2)=0: T(12,3)=0: GOTO 1340 1337 GOSUB 8050: REM Get widow date of disability 1340 GOSUB 7200: GOSUB 7400: GOSUB 9860: IF T6>0 THEN 9880 1350 GOSUB 9300: IF T7=0 THEN A1=5 1355 IF A1=0 THEN GOSUB 4800: GOSUB 9350 1360 IF A1=W3 THEN GOSUB 6800 ELSE GOSUB 6900 1362 IF T6>0 THEN 9880 1365 IF T8=0 THEN T3=5 1367 IF T3=0 THEN GOSUB 4900: GOSUB 9400 1370 IF T3=W3 THEN GOSUB 7900 ELSE GOSUB 7950 1372 IF T6>0 THEN 9880 1375 GOSUB 8000: IF G2>=1950+N4 THEN GOSUB 6000 1380 IF T(2,2)<=1951+N4 OR G2<=1951+N4 THEN A2=1: GOTO 1400 1385 IF A2=0 THEN GOSUB 4200: GOSUB 9450 1390 IF A2=2 THEN GOSUB 4700 1395 GOSUB 7000 1400 IF A3>1 THEN GOSUB 5400: GOTO 1405 1401 GOSUB 6400: GOSUB 2200: GOSUB 2300: U5=1: GOTO 3000 1405 F6=0!: IF A5<>2 AND G9>34 THEN GOSUB 9500: GOSUB 5600: GOSUB 9550 1415 GOSUB 5500: IF C$<>"Y" THEN 1430 1420 GOSUB 8100: IF T6>0 THEN 9880 1425 U5=2: IF A3>1 THEN GOSUB 5400: GOTO 1429 1427 GOSUB 2200: GOSUB 2700: GOTO 3000 1429 GOTO 1415 1430 GOSUB 9600 1505 CLS: GOSUB 9850 1506 PRINT " Loading PIA calculation program; please wait..." 1510 CHAIN "PIACAL" 2000 REM Subroutine to clear screen and draw 75 hyphens 2005 CLS: GOSUB 9860: PRINT " ";STRING$(75,"-"): RETURN 2100 REM Subroutine to draw 75 hyphens and skip two lines 2105 GOSUB 9860: PRINT " ";STRING$(75,"-"): PRINT: PRINT: RETURN 2200 REM Subroutine to prepare screen for earnings 2205 K4=G1: GOSUB 9820: CLS: I3=1: LOCATE 2,1 2215 FOR K1=1 TO 20: FOR K2=1 TO 3: GOSUB 9870: IF I3=1 THEN 2230 2226 PRINT " ";: GOSUB 9860: GOTO 2245 2230 PRINT " ";K4;" "; 2235 IF K1 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9863 2245 PRINT " "; 2255 K4=K4+20: IF K4<=G2 THEN I3=1 ELSE I3=0 2260 NEXT K2: PRINT 2280 K4=K4-59: IF K4<=G2 THEN I3=1 ELSE I3=0 2285 NEXT K1: GOSUB 2600: RETURN 2300 REM Subroutine to get earnings from keyboard 2305 GOSUB 2500: U6=14: U7=1: FOR K1=G1 TO G2: I3=1 2310 GOSUB 2450: GOSUB 2400: IF I3=0 THEN GOSUB 2600: GOSUB 2500 2315 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864 2320 LOCATE U7+1,U6: PRINT USING " ######.## ";O(K1-1936) 2325 U7=U7+1: IF U7>20 THEN U6=U6+24: U7=1 2330 NEXT K1: RETURN 2400 REM Subroutine to get one year of earnings 2405 GOSUB 2450: PRINT STRING$(10," "); 2410 LOCATE U7+1,U6+1: O(K1-1936)=VAL(FNWGETSTRN$(9)) 2415 IF O(K1-1936)<=999999.99# AND O(K1-1936)>-1 THEN 2430 2420 I3=0: BEEP 2425 GOSUB 2600: GOSUB 2550: LOCATE U7+1,U6+1: GOTO 2405 2430 RETURN 2450 REM Subroutine to print cursor for earnings entry 2455 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864 2460 LOCATE U7+1,U6: PRINT ">"; 2465 RETURN 2500 REM Subroutine to print earnings entry message 2505 GOSUB 9850: LOCATE 23,10 2510 PRINT "Please enter earnings for each year": RETURN 2550 REM Subroutine to print earnings re-entry message 2555 GOSUB 9840: LOCATE 23,10 2560 PRINT "Please re-enter earnings for this year": RETURN 2600 REM Subroutine to blank message window 2605 GOSUB 9860 2610 LOCATE 23,8: PRINT STRING$(65," "); 2615 LOCATE 24,8: PRINT STRING$(65," "); 2620 RETURN 2650 REM Subroutine to print correct earnings entry message 2655 GOSUB 9850: LOCATE 23,10 2660 PRINT "Please enter correct earnings for this year": RETURN 2700 REM Subroutine to put earnings on screen 2705 U6=14: U7=1: FOR K1=G1 TO G2 2715 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864 2720 LOCATE U7+1,U6: PRINT USING " ######.## ";O(K1-1936) 2725 U7=U7+1: IF U7>20 THEN U6=U6+24: U7=1 2730 NEXT K1: RETURN 2900 REM Subroutine to get y or n response 2905 GOSUB 9830: C$=FNWGETSTRN$(1) 2907 IF LEN(C$)<=0 THEN 2915 2910 GOSUB 4400: IF C$="Y" OR C$="N" THEN RETURN 2915 BEEP: LOCATE 24,62: PRINT " ";: LOCATE 24,62: GOTO 2905 2920 RETURN 3000 REM Partial program to correct earnings record 3005 K1=G1 3010 GOSUB 2600 3015 GOSUB 9860: LOCATE 24,26 3020 PRINT "Are all entries correct? (y or n) > ";: GOSUB 2900 3030 IF C$="Y" THEN GOSUB 9860: CLS: ON U5 GOTO 1405,1429,1275 3035 GOSUB 2600: GOSUB 3550 3065 U6=14: U7=1 3069 REM $IGNORE ON 3070 REM *********************** INKEY Definitions ********************* 3075 FOR K2=11 TO 14: KEY(K2) ON: NEXT K2 3080 ON KEY(11) GOSUB 3300 : REM Cursor up 3085 ON KEY(12) GOSUB 3350 : REM Cursor left 3090 ON KEY(13) GOSUB 3400 : REM Cursor right 3095 ON KEY(14) GOSUB 3450 : REM Cursor down 3110 REM *************************************************************** 3111 REM $IGNORE OFF 3115 GOSUB 2450 3120 C$=INKEY$: IF C$="" THEN 3120 3121 REM For Macintosh, $INCLUDE "KEYS2.MAC" 3122 REM $INCLUDE: 'KEYS.BAS' 3125 BEEP: GOTO 3120 3150 REM Subroutine for data entry 3154 REM $IGNORE ON 3155 FOR K2=11 TO 14: KEY(K2) OFF: NEXT K2 3156 REM $IGNORE OFF 3165 GOSUB 2600: GOSUB 2650 3175 I3=1: GOSUB 2400 3265 IF U7 MOD 2=0 THEN GOSUB 9864 ELSE GOSUB 9860 3270 LOCATE U7+1,U6: PRINT USING " ######.## ";O(K1-1936) 3275 IF K1<G2 THEN 3288 3280 RETURN 3005 3288 GOSUB 2600: GOSUB 3550 3289 REM $IGNORE ON 3290 FOR K2=11 TO 14: KEY(K2) ON: NEXT K2 3291 REM $IGNORE OFF 3295 RETURN 3115 3300 REM Subroutine to handle cursor up 3305 IF K1<=G1 THEN BEEP: GOTO 3325 3307 LOCATE U7+1,U6: PRINT " ";: K1=K1-1 3310 IF (U6=38 OR U6=62) AND U7=1 THEN U6=U6-24: U7=20: GOTO 3320 3315 U7=U7-1 3320 GOSUB 2450 3325 RETURN 3120 3350 REM Subroutine to handle cursor left 3355 IF K1-20<G1 THEN BEEP: GOTO 3365 3357 LOCATE U7+1,U6: PRINT " ";: K1=K1-20 3360 U6=U6-24: GOSUB 2450 3365 RETURN 3120 3400 REM Subroutine to handle cursor right 3405 IF K1+20>G2 THEN BEEP: GOTO 3415 3407 LOCATE U7+1,U6: PRINT " ";: K1=K1+20 3410 U6=U6+24: GOSUB 2450 3415 RETURN 3120 3450 REM Subroutine to handle cursor down 3455 IF K1>=G2 THEN BEEP: GOTO 3475 3457 LOCATE U7+1,U6: PRINT " ";: K1=K1+1 3460 IF U7<20 THEN U7=U7+1: GOTO 3470 3465 U6=U6+24: U7=1 3470 GOSUB 2450 3475 RETURN 3120 3500 REM Subroutine to handle exit 3504 REM $IGNORE ON 3505 FOR K2=11 TO 14: KEY(K2) OFF: NEXT K2 3506 REM $IGNORE OFF 3510 LOCATE U7+1,U6: PRINT " "; 3515 RETURN 3005 3550 REM Subroutine to print correction menu 3553 REM For Macintosh, $INCLUDE "KEYS1.MAC" 3554 REM $IGNORE ON 3555 GOSUB 9850: LOCATE 22,31: PRINT " Correction mode " 3560 LOCATE 23,10: PRINT "-";CHR$(26);" = Right ";CHR$(24); 3565 PRINT " = Up Ins = To enter data" 3570 LOCATE 24,10: PRINT CHR$(27);"- = Left ";CHR$(25); 3575 PRINT " = Down PgDn = To exit correction mode"; 3576 REM $IGNORE OFF 3580 RETURN 3600 REM Subroutine to print month error message 3605 GOSUB 9840: PRINT " Month must be in the range 1-12" 3610 BEEP: GOSUB 9860: RETURN 3700 REM Subroutine to print day error message 3705 GOSUB 9840: PRINT " Day must be in the range 1-31" 3710 BEEP: GOSUB 9860: RETURN 3800 REM Subroutine to print mo/dy/year error message 3805 GOSUB 9840: PRINT " Correct format is mo/dy/year" 3810 BEEP: GOSUB 9860: RETURN 3900 REM Subroutine to print mo/year error message 3905 GOSUB 9840: PRINT " Correct format is mo/year" 3910 BEEP: GOSUB 9860: RETURN 4000 REM Subroutine to print wage-earner info title 4005 GOSUB 2000: PRINT " ";: GOSUB 9870 4010 PRINT STRING$(26," ");"Wage-earner information";STRING$(26," ") 4020 GOSUB 2100: RETURN 4100 REM Subroutine to get y or n response 4105 PRINT " Is this correct? (y or n) > "; 4110 C$=FNGETSTRN$(1): GOSUB 9860 4115 IF LEN(C$)<=0 THEN BEEP: GOTO 4105 4120 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 4105 4125 RETURN 4200 REM Subroutine to print wage base title 4205 GOSUB 2000: PRINT " ";: GOSUB 9870 4210 PRINT STRING$(27," ");"Projected wage bases";STRING$(28," ") 4220 GOSUB 2100: RETURN 4300 REM Subroutine to get title of average wage assumptions 4305 PRINT " Enter title of average wage assumptions" 4310 PRINT " > ";: M$=FNGETSTRN$(65): GOSUB 9860: RETURN 4400 REM Subroutine to convert response to one-letter uppercase 4405 I4=ASC(C$): IF I4>96 THEN C$=CHR$(I4-32) ELSE C$=CHR$(I4) 4410 RETURN 4500 REM Subroutine to calculate worker age at entitlement 4505 T(1,1)=T(2,2)-T(5,3): T(1,2)=T(2,1)-T(5,1) 4510 IF T(5,2)=1 THEN T(1,2)=T(1,2)+1 4515 IF T(1,2)<0 THEN T(1,1)=T(1,1)-1: T(1,2)=T(1,2)+12 4520 IF T(1,2)>11 THEN T(1,1)=T(1,1)+1: T(1,2)=T(1,2)-12 4525 RETURN 4550 REM Subroutine to calculate widow age at entitlement 4555 T(8,1)=T(2,2)-T(4,3): T(8,2)=T(2,1)-T(4,1) 4560 IF T(4,2)=1 THEN T(8,2)=T(8,2)+1 4565 IF T(8,2)<0 THEN T(8,1)=T(8,1)-1: T(8,2)=T(8,2)+12 4570 IF T(8,2)>11 THEN T(8,1)=T(8,1)+1: T(8,2)=T(8,2)-12 4575 RETURN 4600 REM Subroutine to convert catch-up code to one-letter uppercase 4605 I4=ASC(O$): IF I4>96 THEN O$=CHR$(I4-32) ELSE O$=CHR$(I4) 4610 RETURN 4700 REM Subroutine to get specified wage bases 4705 FOR K1=1 TO T(2,2)-1936-N2 4710 IF T5>=1 THEN INPUT #1,B(1,N2+K1): GOTO 4720 4715 PRINT " Enter wage base for";1936+N2+K1;"> "; 4716 B(1,N2+K1)=VAL(FNGETSTRN$(9)): GOSUB 9860 4720 NEXT K1: RETURN 4800 REM Subroutine to print title for benefit increase assumptions 4805 GOSUB 2000: PRINT " ";: GOSUB 9870 4810 PRINT STRING$(23," ");"Benefit increase assumptions"; 4820 PRINT STRING$(24," "): GOSUB 2100: RETURN 4900 REM Subroutine to print title for average wage assumptions 4905 GOSUB 2000: PRINT " ";: GOSUB 9870 4910 PRINT STRING$(25," ");"Average wage assumptions";STRING$(26," ") 4920 GOSUB 2100: RETURN 5000 REM Subroutine to get configuration 5004 ON ERROR GOTO 5030 5005 OPEN "I",1,"CONFIG.DAT": GOSUB 9850 5006 ON ERROR GOTO 0 5010 PRINT " Reading configuration from CONFIG.DAT" 5015 INPUT #1,A6: INPUT #1,A5: INPUT #1,A3: INPUT #1,A4: INPUT #1,T9 5020 INPUT #1,A1: INPUT #1,T3: INPUT #1,A2: INPUT #1,G8: INPUT #1,K5 5025 CLOSE #1: RETURN 5030 REM Handle file error 5035 BEEP: GOSUB 9840: K6=66 5040 PRINT " Configuration file does not exist." 5045 END 5100 REM Subroutine to review earnings (not currently used) 5105 FOR K2=G1 TO G2 5110 PRINT " Worker earnings for";K2;"are";O(K2-1936) 5115 GOSUB 4100: IF C$="Y" THEN 5135 5120 PRINT " Enter worker earnings for";K2;"> "; 5125 O(K2-1936)=VAL(FNGETSTRN$(9)): GOSUB 9860 5130 IF O(K2-1936)>999999.99# OR O(K2-1936)<-1 THEN BEEP: GOTO 5120 5135 NEXT K2: RETURN 5200 REM Subroutine to get earnings from disk file 5205 FOR K2=G1 TO G2 5210 INPUT #1,O(K2-1936) 5215 IF O(K2-1936)>999999.99# OR O(K2-1936)<-1 THEN T6=28: RETURN 5220 NEXT K2: RETURN 5300 REM Subroutine to get specified earnings (not currently used) 5305 FOR K2=G1 TO G2 5310 PRINT " Enter worker earnings for";K2;"> "; 5315 O(K2-1936)=VAL(FNGETSTRN$(9)): GOSUB 9860 5317 IF O(K2-1936)>999999.99# OR O(K2-1936)<-1 THEN BEEP: GOTO 5310 5320 NEXT K2: RETURN 5400 REM Subroutine to project steady earnings 5405 FOR K1=N2+1 TO N5 5410 B(2,K1)=B(2,K1-1)*(B(6,K1)/100!+1!): NEXT K1 5415 FOR K1=G1 TO G2: K2=K1-1936 5420 IF A3=2 THEN O(K2)=B(1,K2) 5425 IF A3=3 THEN O(K2)=B(5,K2) 5430 IF A3=4 THEN O(K2)=B(2,K2) 5435 NEXT K1 5440 RETURN 5500 REM Subroutine to print title for data review 5505 GOSUB 2000: PRINT " ";: GOSUB 9870 5510 PRINT STRING$(32," ");"Data review";STRING$(32," "): GOSUB 2100 5525 PRINT " Do you want to review the data for this case?"; 5530 PRINT " (y or n)> ";: C$=FNGETSTRN$(1): GOSUB 9860 5531 IF LEN(C$)<=0 THEN BEEP: GOTO 5525 5532 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 5525 5535 RETURN 5600 REM Subroutine to print noncovered pension explanation 5605 GOSUB 9850: PRINT " A modified benefit formula generally is "; 5610 PRINT "used to compute benefits for" 5615 PRINT " persons entitled to both a pension based on employment"; 5620 PRINT " after 1956 not" 5625 PRINT " covered by Social Security and a Social Security "; 5630 PRINT "retirement or disa-" 5632 PRINT " bility benefit. However, the difference between the "; 5634 PRINT "Social Security" 5635 PRINT " benefit computed under the modified formula "; 5640 PRINT "and the Social Security" 5645 PRINT " benefit under the regular formula cannot be greater "; 5650 PRINT "than one-half the" 5655 PRINT " amount of the noncovered pension for the first month "; 5660 PRINT "of eligibility for" 5665 PRINT " both the pension and the Social Security benefit. If "; 5670 PRINT "the noncovered" 5675 PRINT " pension is greater than $310, in 1987 dollars, the full"; 5680 PRINT " reduction of the" 5685 PRINT " modified formula will apply.": PRINT 5690 PRINT " For Federal workers who elect into FERS and thus are "; 5695 PRINT "entitled to a" 5697 PRINT " pension split between the CSRS and FERS retirement "; 5698 PRINT "systems, only that" 5700 PRINT " part of the pension attributable to CSRS is a "; 5705 PRINT "noncovered pension.": PRINT: GOSUB 9860: RETURN 5800 REM Subroutine to print earnings and coverage title 5805 GOSUB 2000: PRINT " ";: GOSUB 9870 5810 PRINT STRING$(21," ");"Earnings and coverage information"; 5815 PRINT STRING$(21," "): GOSUB 2100: RETURN 5900 REM Subroutine to get quarters of coverage to date 5905 PRINT " Enter number of quarters of coverage up to and "; 5906 PRINT "including";1936+N6;"> "; 5910 G(0,N6)=VAL(FNGETSTRN$(3)): GOSUB 9860 5915 IF G(0,N6)>=0 THEN 5930 5920 GOSUB 9840: PRINT " Must not be negative" 5925 BEEP: GOSUB 9860: GOTO 5905 5930 RETURN 6000 REM Subroutine to project quarter-of-coverage amounts 6005 GOSUB 9850: PRINT " Projecting quarter-of-coverage amounts" 6010 FOR K1=42 TO N5: L(0,K1)=25!*B(5,K1-2)/B(5,40) 6015 L(0,K1)=FIX(L(0,K1)+.5)*10: NEXT K1: RETURN 6100 REM Subroutine for disk error 6105 BEEP: GOSUB 9840: K6=1 6110 PRINT " *** File error. Please check name. ***" 6115 GOSUB 6200: RESUME NEXT 6200 REM Subroutine to print RETURN message 6205 GOSUB 9860: PRINT 6210 PRINT " Press RETURN to continue"; 6215 C$=INKEY$: IF LEN(C$)<1 THEN 6215 6220 IF ASC(C$)<>13 THEN BEEP: GOTO 6215 6225 RETURN 6300 REM Subroutine to display cases on disk 6305 GOSUB 2000: PRINT " ";: GOSUB 9870 6310 PRINT STRING$(27," ");"Cases stored on disk";STRING$(28," ") 6315 GOSUB 2100: GOSUB 9850 6318 REM For Macintosh, $INCLUDE "DIR.MAC" 6319 REM $IGNORE ON 6320 L$="dir *.pia /w": SHELL L$ 6321 REM $IGNORE OFF 6325 GOSUB 6200: RETURN 6400 REM Subroutine to present intro to earnings entry 6405 GOSUB 2000: PRINT " ";: GOSUB 9870 6410 PRINT STRING$(30," ");"Earnings entry";STRING$(31," "): GOSUB 2100 6415 GOSUB 9850: PRINT " Earnings for each year should be entered "; 6420 PRINT "on the following screen. Each" 6425 PRINT " entry should be less than $1 million (only earnings up "; 6430 PRINT "to the wage base" 6435 PRINT " will be used in any case). Continue with earnings for "; 6440 PRINT "each year, even" 6445 PRINT " if you make a mistake. You can hit RETURN for any year"; 6450 PRINT " for which there" 6455 PRINT " are no earnings.": PRINT 6460 PRINT " If there are any pre-1951 earnings, enter the total of "; 6465 PRINT "such earnings on" 6470 PRINT " the line for 1950.": PRINT 6475 PRINT " After all years are entered, the screen will enter a "; 6480 PRINT "correction mode," 6485 PRINT " where you can use the arrow keys to place the cursor on"; 6490 PRINT " the earnings you" 6495 PRINT " wish to change. Hit the Insert key to start entering "; 6500 PRINT "new earnings, and" 6505 PRINT " the RETURN key when done. Hit the Page Down key to "; 6510 PRINT "leave the correction" 6515 PRINT " mode.": GOSUB 6200: RETURN 6700 REM Subroutine to print title for widow data 6705 GOSUB 2000: PRINT " ";: GOSUB 9870 6710 PRINT STRING$(32," ");"Widow data";STRING$(33," "); 6715 GOSUB 2100: RETURN 6750 REM Subroutine to print title for death or disability 6755 GOSUB 2000: PRINT " ";: GOSUB 9870 6756 PRINT STRING$(23," ");"Death and/or disability data"; 6760 PRINT STRING$(24," "): GOSUB 2100: RETURN 6800 REM Subroutine to get ad hoc benefit increases 6801 IF T5=0 THEN 6811 6802 IF W1<=N4 THEN 6806 6803 GOSUB 9840: PRINT " Benefit increases do not start in";1951+N4 6804 PRINT " Please check input file": CLOSE #1: GOSUB 9860 6805 T6=29: BEEP: RETURN 6806 IF W1=N4 THEN 6811 6807 GOSUB 9840: PRINT " Warning: Benefit increases in input file "; 6808 PRINT "from";1951+W1;" to";1950+N4: PRINT " are being skipped" 6809 FOR K2=W1+1 TO N4: INPUT #1,C(2,N4+1): NEXT K2 6810 GOSUB 9860: BEEP 6811 FOR K2=N4+1 TO T(2,2)-1950 6812 IF T5>=1 THEN INPUT #1,C(2,K2): GOTO 6820 6815 PRINT " Enter benefit increase for";1950+K2;"> "; 6816 C(2,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860 6820 NEXT K2 6824 IF T5=0 THEN 6830 ELSE INPUT #1,O$ 6825 IF LEN(O$)<=0 THEN 6827 6826 GOSUB 4600: IF O$="Y" OR O$="N" THEN 6835 6827 GOSUB 9840: PRINT " Catch-up increase response is not y or n" 6828 PRINT " Please check input file": CLOSE #1: GOSUB 9860 6829 T6=31: BEEP: RETURN 6830 PRINT " Are there any catch-up benefit increases? (y or n) > "; 6831 O$=FNGETSTRN$(1): GOSUB 9860 6832 IF LEN(O$)<=0 THEN BEEP: GOTO 6830 6833 GOSUB 4600: IF O$<>"Y" AND O$<>"N" THEN BEEP: GOTO 6830 6835 IF O$<>"Y" THEN 6870 6840 FOR K2=1 TO 10: FOR K1=1 TO 8 6845 IF T5>=1 THEN INPUT #1,F(K2,K1): GOTO 6865 6850 K3=1950+N4+K2 6855 PRINT " Enter catch-up benefit increase for year of eligibility"; 6860 PRINT K3: PRINT " for increase in Dec";1952+N4+K1;"> "; 6861 F(K2,K1)=VAL(FNGETSTRN$(6)): GOSUB 9860 6865 NEXT K1: NEXT K2: GOTO 6880 6870 FOR K4=1 TO 8: FOR K3=1 TO 10 6875 F(K3,K4)=0!: NEXT K3: NEXT K4 6880 IF T5>=1 THEN LINE INPUT #1,B$: RETURN 6885 GOSUB 7050: RETURN 6900 REM Subroutine to get menu-selected benefit increases (A1<W3) 6905 IF A1>4 THEN 6955 ELSE J$="BI"+CHR$(48+A1)+".DAT" 6909 GOSUB 9850 6910 PRINT " Reading benefit increase assumptions from ";J$ 6915 OPEN "I",2,J$ 6916 INPUT #2,W2: IF W2=1951+N4 THEN 6920 6917 GOSUB 9840: PRINT " Benefit increase assumptions do not start "; 6918 PRINT "in";1951+N4: PRINT " Please check assumptions": CLOSE #2 6919 GOSUB 9860: T6=61: BEEP: RETURN 6920 FOR K2=N4+1 TO N7: INPUT #2, C(2,K2): NEXT K2 6925 CLOSE #2 6930 J$="CU"+CHR$(48+A1)+".DAT" 6935 PRINT " Reading catch-up increase assumptions from ";J$ 6940 OPEN "I",2,J$ 6945 FOR K3=1 TO 8: FOR K4=1 TO 10: INPUT #2, F(K4,K3) 6950 NEXT K4: NEXT K3: CLOSE #2: RETURN 6955 GOSUB 9850: PRINT " Projecting benefit increases": GOSUB 9860 6960 FOR K2=N4+1 TO N7: C(2,K2)=0!: NEXT K2 6965 FOR K4=1 TO 8: FOR K3=1 TO 10 6970 F(K3,K4)=0!: NEXT K3: NEXT K4: RETURN 7000 REM Subroutine to project old and new-law wage bases 7005 PRINT " Projecting wage bases" 7010 FOR K1=1 TO N5: B(7,K1)=B(1,K1): NEXT K1: GOSUB 7100 7015 FOR K1=1 TO N5: B(1,K1)=B(7,K1): NEXT K1 7020 FOR K1=1 TO N5: B(7,K1)=B(4,K1): NEXT K1: GOSUB 7100 7025 FOR K1=1 TO N5: B(4,K1)=B(7,K1): NEXT K1 7030 RETURN 7050 REM Subroutine to get title of benefit increase assumptions 7055 PRINT " Enter title of benefit increase assumptions" 7056 PRINT " > ";: B$=FNGETSTRN$(65): GOSUB 9860 7060 RETURN 7100 REM Subroutine to project the wage base 7105 I2=N2: N3=1 7110 IF B(7,I2)>0 THEN 7150 7115 N3=1 7120 IF C(2,I2+N3-2-14)>=.1 THEN 7135 7122 IF A1=6 AND T3=6 THEN 7135 7125 B(7,I2+N3-1)=B(7,I2-1): N3=N3+1 7130 IF I2+N3>N5 THEN 7150 ELSE 7120 7135 B(7,I2+N3-1)=B(7,I2-1) 7140 FOR I1=1 TO N3: B(7,I2+N3-1)=B(7,I2+N3-1)*(1!+B(6,I2+I1-3)/100!) 7145 NEXT I1: B(7,I2+N3-1)=FIX(B(7,I2+N3-1)/300!+.5)*300 7150 I2=I2+N3: IF I2<=N5 THEN 7110 7155 RETURN 7200 REM This subroutine computes the year of eligibility 7202 GOSUB 9850: PRINT " Computing year of eligibility": GOSUB 9860 7205 A7=T(5,3)+62-1951: REM Start with year before age 62 7210 IF T(5,1)=1 AND T(5,2)=1 THEN A7=A7-1 7215 IF A6=1 AND A7<24 THEN A7=A7+3: IF A7>24 THEN A7=24 7220 IF A5=2 AND A7>T(3,2)-1951 THEN A7=T(3,2)-1951 7225 G9=A7 7230 IF A5<3 AND T(9,3)>0 AND G9>T(9,3)-1951 THEN G9=T(9,3)-1951 7235 IF A5=3 AND G9>T(9,3)-1951 THEN G9=T(9,3)-1951 7239 IF A7<0 THEN A7=0 7240 IF G9<0 THEN G9=0 7241 IF A4<2 THEN 7251 7242 IF A4=3 THEN 7249 7243 IF T(12,1)<7 OR (T(12,1)=7 AND T(12,2)=1) THEN 7245 7244 S5=T(12,3)-1950: GOTO 7246 7245 S5=T(12,3)-1951 7246 I1=T(4,3)+50-1951: IF T(4,1)=1 AND T(4,2)=1 THEN I1=I1-1 7247 IF S5<I1 THEN S5=I1 7248 GOTO 7250 7249 S5=T(4,3)+60-1951: IF T(4,1)=1 AND T(4,2)=1 THEN S5=S5-1 7250 IF S5<0 THEN S5=0 7251 A8=5 7255 I1=G9: I2=G9-(T(5,3)-1929) 7260 IF T(5,1)=1 AND T(5,2)=1 THEN I2=G9-(T(5,3)-1930) 7265 A9=I1: IF A9>I2 THEN A9=I2 7270 IF A9<2 THEN A9=2 7275 IF A9>40 THEN A9=40 7280 IF T(9,3)<1979 THEN 7295 7285 IF T(2,2)>=1981 AND A9/5<5 THEN A8=INT(A9/5) 7290 IF T(2,2)=1980 AND T(2,1)>=7 AND A9/5<5 THEN A8=INT(A9/5) 7295 N1=A9-A8: IF N1<2 THEN N1=2: A8=A9-N1 7300 IF A5>1 THEN 7325 7310 IF G9>=7 THEN 7325 7315 N1=G9-2: IF N1<2 THEN N1=2: A8=A9-N1 7325 G4=G9-N4+1: IF G4<1 THEN G4=1 7330 IF G4>10 THEN G4=10 7332 S4=A9: IF S4<6 THEN S4=6 7335 RETURN 7400 REM This subroutine calculates early or delayed retirement factor 7401 T(7,1)=0: T(7,2)=0: I6=0: GOSUB 9840 7405 IF T(1,1)>0 THEN 7410 7407 PRINT " Inconsistent data (impossible age)" 7408 BEEP: T6=41: RETURN 7410 IF A5=2 THEN 7615 7415 U2=A7: GOSUB 7850: T(6,1)=T(11,1): T(6,2)=T(11,2) 7440 IF A5>1 THEN 7780 7441 T(7,1)=65: T(7,2)=0: IF A6=1 THEN 7444 7442 IF T(2,2)>1956 OR (T(2,2)=1956 AND T(2,1)>=11) THEN T(7,1)=62 7443 GOTO 7445 7444 IF T(2,2)>1961 OR (T(2,2)=1961 AND T(2,1)>=8) THEN T(7,1)=62 7445 IF T(2,2)<1981 OR (T(2,2)=1981 AND T(2,1)<=8) THEN 7447 7446 IF T(5,2)<>2 THEN T(7,2)=1 7447 IF T(1,1)<T(6,1) OR (T(1,1)=T(6,1) AND T(1,2)<T(6,2)) THEN 7575 7450 I3=T(5,1)+T(6,2)+12*(T(5,3)-1971+T(6,1)) 7455 IF T(5,2)=1 THEN I3=I3-1 7460 I1=I3: IF I1<1 THEN I1=1 7465 IF A7>24 THEN 7490 7470 I4=T(5,1)+12*(T(5,3)+72-1971): IF T(5,2)=1 THEN I4=I4-1 7475 IF A7<23 THEN 7495 7480 IF I4>157 THEN I4=157 7485 GOTO 7495 7490 I4=T(5,1)+12*(T(5,3)+70-1971): IF T(5,2)=1 THEN I4=I4-1 7495 I5=T(2,1)+12*(T(2,2)-1971) 7500 I2=I4: IF I2>I5 THEN I2=I5 7505 I6=I2-I1: IF I6<0 THEN I6=0 7510 IF A7<28 THEN C2=1!/1200! 7515 IF A7>=28 AND A7<36 THEN C2=1!/400! 7520 IF A7>35 AND A7<54 THEN C2=((A7-34)/2)/2400!+1/400! 7525 IF A7>=54 THEN C2=2!/300! 7530 C5=1+I6*C2 7535 RETURN 7575 IF T(1,1)<T(7,1) THEN 7600 7580 IF T(1,1)=T(7,1) AND T(1,2)<T(7,2) THEN 7600 7585 I6=(T(6,1)*12+T(6,2))-(T(1,1)*12+T(1,2)) 7590 IF I6>36 THEN C5=.8-((I6-36)*5!/1200!): RETURN 7595 C5=1!-(I6*5!/900!): RETURN 7600 PRINT " Retirement at age";T(1,1);"and";T(1,2); 7601 PRINT "months is impossible;" 7605 PRINT " Earliest possible retirement age is";T(7,1);"and";T(7,2); 7610 PRINT "months": T6=42: BEEP: RETURN 7615 REM Survivor benefits 7616 IF A4=1 THEN C5=.75: RETURN 7620 IF A4>2 THEN 7690 7625 IF T(2,2)>1968 OR (T(2,2)=1968 AND T(2,1)>1) THEN 7640 7630 PRINT " No disabled widow benefits until February 1968" 7635 T6=43: BEEP: RETURN 7640 IF T(8,1)>=50 THEN 7655 7645 PRINT " Disabled widow benefits at age";T(8,1);"and";T(8,2); 7646 PRINT "months is": BEEP 7650 PRINT " impossible; earliest possible age is 50": T6=44: RETURN 7655 IF T(8,1)<60 THEN 7670 7660 PRINT " Disabled widow benefits at age";T(8,1);"and";T(8,2); 7661 PRINT "months is": BEEP 7665 PRINT " not allowed here; rerun as aged widow": T6=45: RETURN 7670 I6=(60-T(8,1))*12-T(8,2): IF T(2,2)>1972 THEN 7680 7675 C5=.69167-(I6*43!/19800!): RETURN 7680 IF T(2,2)<1984 THEN C5=.715-(I6*43!/24000!): RETURN 7685 C5=.715: RETURN 7690 REM Aged widow 7691 IF T(2,2)>1956 OR (T(2,2)=1956 AND T(2,1)>10) THEN 7710 7695 IF T(8,1)>=65 THEN C5=.75: RETURN 7700 PRINT " Aged widow benefits at age";T(8,1);"and";T(8,2); 7701 PRINT "months is": BEEP 7705 PRINT " impossible; earliest possible age is 65": T6=46: RETURN 7710 IF T(2,2)>1965 OR (T(2,2)=1965 AND T(2,1)>8) THEN 7740 7715 IF T(8,1)>=62 THEN 7730 7720 PRINT " Aged widow benefits at age";T(8,1);"and";T(8,2); 7721 PRINT "months is": BEEP 7725 PRINT " impossible; earliest possible age is 62": T6=47: RETURN 7730 IF T(2,2)>1961 OR (T(2,2)=1961 AND T(2,1)>=8) THEN C5=.825: RETURN 7735 C5=.75: RETURN 7740 IF T(8,1)>=60 THEN 7755 7745 PRINT " Aged widow benefits at age";T(8,1);"and";T(8,2); 7746 PRINT "months is": BEEP 7750 PRINT " impossible; earliest possible age is 60": T6=48: RETURN 7755 IF T(2,2)>1972 THEN 7770 7760 IF T(8,1)>=62 THEN C5=.825: RETURN 7765 I6=(62-T(8,1))*12-T(8,2): C5=.825-(I6*5!/900!): RETURN 7770 U2=S5: GOSUB 7850: T(10,1)=T(11,1): T(10,2)=T(11,2) 7771 IF T(8,1)<T(10,1) OR (T(8,1)=T(10,1) AND T(8,2)<T(10,2)) THEN 7773 7772 C5=1!: RETURN 7773 I6=T(10,1)*12+T(10,2)-(T(8,1)*12+T(8,2)) 7774 I1=T(10,1)*12+T(10,2)-60*12 7775 C5=1!-CSNG(I6)*.285/CSNG(I1): RETURN 7780 REM Disability benefits 7781 IF T(2,2)>1959 THEN 7815 7785 IF T(2,2)>1956 THEN 7795 7790 PRINT " No disability benefits until 1957" 7792 BEEP: T6=49: RETURN 7795 IF T(1,1)>=50 THEN 7815 7800 PRINT " Disability benefits at age";T(1,1);"and";T(1,2); 7801 PRINT "months is" 7805 PRINT " impossible; earliest possible age is 50 in";T(2,2) 7810 T6=50: BEEP: RETURN 7815 IF T(1,1)<T(6,1) OR (T(1,1)=T(6,1) AND T(1,2)<T(6,2)) THEN 7830 7820 PRINT " No disability benefits at age";T(6,1);"and";T(6,2); 7825 PRINT "months or later": T6=51: BEEP: RETURN 7830 C5=1!: RETURN 7850 REM Subroutine to calculate normal retirement age 7855 IF U2<49 THEN T(11,2)=0: T(11,1)=65: RETURN 7860 IF U2<54 THEN T(11,2)=2*(U2-48): T(11,1)=65: RETURN 7865 IF U2<66 THEN T(11,2)=0: T(11,1)=66: RETURN 7870 IF U2<71 THEN T(11,2)=2*(U2-65): T(11,1)=66: RETURN 7875 T(11,1)=67: T(11,2)=0: RETURN 7900 REM Subroutine to get ad hoc average wage increases 7901 IF T5=0 THEN 7911 7902 IF W1<=N4 THEN 7906 7903 GOSUB 9840: PRINT " Average wage increases do not start in"; 7904 PRINT 1937+N6: PRINT " Please check input file": CLOSE #1 7905 GOSUB 9860: T6=30: BEEP: RETURN 7906 IF W1=N4 THEN 7911 7907 GOSUB 9840: PRINT " Warning: Average wage increases in input "; 7908 PRINT "file from";1950+W1;" to";1949+N4: PRINT " are being "; 7909 PRINT "skipped": FOR K2=W1+1 TO N4: INPUT #1,C(2,N4+1): NEXT K2 7910 GOSUB 9860: BEEP 7911 FOR K2=N6+1 TO T(2,2)-1936 7912 IF T5>=1 THEN INPUT #1,B(6,K2): GOTO 7917 7913 PRINT " Enter average wage percentage increase for";1936+K2;"> "; 7915 B(6,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860 7917 NEXT K2 7920 IF T5>=1 THEN LINE INPUT #1,M$: RETURN 7925 GOSUB 4300: RETURN 7950 REM Subroutine to get menu-selected average wage increases (T3<W3) 7955 IF T3>4 THEN 7980 ELSE J$="AW"+CHR$(48+T3)+".DAT" 7959 GOSUB 9850 7960 PRINT " Reading average wage increase assumptions from ";J$ 7965 OPEN "I",2,J$ 7966 INPUT #2,W2: IF W2=1937+N6 THEN 7970 7967 GOSUB 9840: PRINT " Average wage assumptions do not start in"; 7968 PRINT 1937+N6: PRINT " Please check assumptions": CLOSE #2 7969 GOSUB 9860: T6=62: BEEP: RETURN 7970 FOR K2=N6+1 TO N5: INPUT #2, B(6,K2): NEXT K2 7975 CLOSE #2: RETURN 7980 GOSUB 9850: PRINT " Projecting average wage increases" 7981 GOSUB 9860 7983 IF T3=6 THEN FOR K2=N6+1 TO N5: B(6,K2)=4!: NEXT K2: RETURN 7985 FOR K2=N6+1 TO N5: B(6,K2)=0!: NEXT K2: RETURN 8000 REM Subroutine to project average wages 8005 FOR K2=N6+1 TO N5: B(5,K2)=B(5,K2-1)*(B(6,K2)/100!+1!) 8010 B(5,K2)=FIX(B(5,K2)*100!+.5): B(5,K2)=B(5,K2)/100!: NEXT K2 8015 RETURN 8050 REM Subroutine to get widow's date of disability onset 8055 PRINT " Enter widow's date of disability onset (mo/dy/year) > "; 8056 C$=FNGETSTRN$(10) 8057 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8055 8058 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8055 8059 G$(0)=MID$(C$,1,2): T(12,1)=VAL(G$(0)) 8060 G$(0)=MID$(C$,4,2): T(12,2)=VAL(G$(0)) 8061 G$(0)=MID$(C$,7,4): T(12,3)=VAL(G$(0)) 8062 IF T(12,3)<100 THEN T(12,3)=1900+T(12,3) 8065 IF T(12,1)<1 OR T(12,1)>12 THEN GOSUB 3600: GOTO 8055 8067 IF T(12,2)<1 OR T(12,2)>31 THEN GOSUB 3700: GOTO 8055 8068 K2=1940: IF T(5,3)>1940 THEN K2=T(5,3) 8070 IF T(12,3)>=K2 AND T(12,3)<1937+N5 THEN 8075 8072 GOSUB 9840: PRINT " Year must be in the range";K2;"-";1936+N5 8073 BEEP: GOSUB 9860: GOTO 8055 8075 IF T(12,3)<T(2,2) OR (T(12,3)=T(2,2) AND T(12,1)<=T(2,1)) THEN 9085 8080 GOSUB 9840: PRINT " Disability onset must precede entitlement" 8084 BEEP: GOSUB 9860: GOTO 8055 8085 GOSUB 9860: RETURN 8100 REM Subroutine to review or modify PIA data 8105 GOSUB 4000: PRINT " ";A$(A6);" worker": GOSUB 4100 8110 IF C$<>"Y" THEN GOSUB 8750 8115 PRINT " Date of entitlement is ";D$(T(2,1));T(2,2) 8120 GOSUB 4100: IF C$<>"Y" THEN GOSUB 8700 8125 PRINT " Date of birth is ";D$(T(5,1));STR$(T(5,2));",";T(5,3) 8130 GOSUB 4100: IF C$<>"Y" THEN GOSUB 8800 8135 PRINT " Type of benefit is ";P$(A5) 8140 GOSUB 4100: IF C$<>"Y" THEN GOSUB 8900 8145 GOSUB 5800: PRINT " Type of earnings is ";Q$(A3) 8150 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9000 8155 PRINT " First year of earnings is";G1 8160 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9100 8165 IF G2<G1 OR U4-U3>59 THEN 8180 8170 PRINT " Last year of earnings is";G2 8175 GOSUB 4100: IF C$="Y" THEN 8185 8180 GOSUB 9200 8185 IF G1>1936+N6 THEN G(0,N6)=0: GOTO 8194 8190 PRINT " Number of quarters of coverage up to";1936+N6;"is"; 8191 PRINT G(0,N6): GOSUB 4100: IF C$<>"Y" THEN GOSUB 5900 8194 GOSUB 4500: GOSUB 6750 8195 IF A5<>2 THEN T(3,1)=0: T(3,2)=0: A4=0: GOTO 8225 8196 IF T(3,1)=0 THEN 8210 8200 PRINT " Date of death is ";D$(T(3,1));T(3,2) 8205 GOSUB 4100: IF C$="Y" THEN 8212 8210 GOSUB 8850 8212 IF A4=0 THEN 8222 8215 PRINT " Type of survivor is ";N$(A4) 8220 GOSUB 4100: IF C$="Y" THEN 8225 8222 GOSUB 8950 8225 IF A5=3 THEN T9=2: GOTO 8245 8230 PRINT " Previous disability:": PRINT " ";X$(T9) 8235 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9150 8240 IF T9=1 THEN T(9,1)=0: T(9,2)=0: T(9,3)=0: GOTO 8270 8245 IF T(9,2)=0 OR T(9,1)=0 THEN 8265 8250 PRINT " Worker's date of disability onset is ";D$(T(9,1)); 8255 PRINT STR$(T(9,2));",";T(9,3): GOSUB 4100: IF C$="Y" THEN 8270 8265 GOSUB 9050 8270 IF A4<=1 THEN 8290 ELSE GOSUB 6700: IF T(4,1)=0 THEN 8285 8275 PRINT " Widow date of birth is ";D$(T(4,1));STR$(T(4,2));","; 8280 PRINT T(4,3): GOSUB 4100: IF C$="Y" THEN 8290 8285 GOSUB 9250: GOSUB 4550: REM Calculate age of widow 8290 IF A4<>2 THEN 8294 ELSE IF T(12,1)=0 THEN 8293 8291 PRINT " Widow's date of disability onset is ";D$(T(12,1)); 8292 PRINT STR$(T(12,2));",";T(12,3): GOSUB 4100: IF C$="Y" THEN 8295 8293 GOSUB 8050: GOTO 8295 8294 T(12,1)=0: T(12,2)=0: T(12,3)=0 8295 GOSUB 7200: GOSUB 7400: GOSUB 9860: IF T6>0 THEN RETURN 8300 GOSUB 9300: IF T7>0 THEN GOSUB 4800 8305 IF T7=0 THEN A1=5: GOTO 8350 8310 PRINT " Benefit increase assumptions:": PRINT " ";W$(A1) 8345 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9350 8350 IF A1<W3 THEN GOSUB 6900: IF T6>0 THEN RETURN ELSE 8399 8355 FOR K2=N4+1 TO T(2,2)-1950 8360 PRINT " Benefit increase for";1950+K2;"is"; 8361 PRINT USING "###.# percent";C(2,K2) 8365 GOSUB 4100: IF C$="Y" THEN 8375 8370 PRINT " Enter benefit increase for";1950+K2;"> "; 8371 C(2,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860 8375 NEXT K2 8376 IF O$="" THEN O$="N" 8377 IF O$="Y" THEN 8381 8378 PRINT " There are no catch-up benefit increases" 8379 GOSUB 4100: IF C$="Y" THEN 8392 8380 O$="Y": GOTO 8384 8381 PRINT " There are catch-up benefit increases" 8382 GOSUB 4100: IF C$="Y" THEN 8384 8383 O$="N": GOTO 8392 8384 FOR K2=1 TO 10: FOR K1=1 TO 8: K3=1950+N4+K2 8385 PRINT " Catch-up benefit increase for year of eligibility";K3 8386 PRINT " for increase in Dec";1952+N4+K1;" is";F(K2,K1) 8387 GOSUB 4100: IF C$="Y" THEN 8391 8388 PRINT " Enter catch-up benefit increase for year of eligibility"; 8389 PRINT K3: PRINT " for increase in Dec";1952+N4+K1;"> "; 8390 F(K2,K1)=VAL(FNGETSTRN$(6)): GOSUB 9860 8391 NEXT K1: NEXT K2 8392 FOR K2=1 TO 10: FOR K1=1 TO 8: F(K2,K1)=0.0: NEXT K1: NEXT K2 8393 IF B$="" THEN 8396 8394 PRINT " Title of benefit increase assumptions:": PRINT " ";B$ 8395 GOSUB 4100: IF C$="Y" THEN 8399 8396 GOSUB 7050 8399 IF T8>0 THEN GOSUB 4900 8400 IF T8=0 THEN T3=5: GOTO 8445 8405 PRINT " Average wage increase assumptions:": PRINT " ";E$(T3) 8440 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9400 8445 IF T3<W3 THEN GOSUB 7950: IF T6>0 THEN RETURN ELSE 8500 8450 FOR K2=N6+1 TO T(2,2)-1936 8455 PRINT " Average wage increase for";1936+K2;"is"; 8456 PRINT USING "###.#### percent";B(6,K2) 8460 GOSUB 4100: IF C$="Y" THEN 8475 8465 PRINT " Enter average wage percentage increase for";1936+K2;"> "; 8470 B(6,K2)=VAL(FNGETSTRN$(6)): GOSUB 9860 8475 NEXT K2 8480 IF M$="" THEN 8495 8485 PRINT " Title of average wage increase assumptions:" 8490 PRINT " ";M$: GOSUB 4100: IF C$="Y" THEN 8500 8495 GOSUB 4300 8500 GOSUB 8000: IF G2>=1950+N4 THEN GOSUB 6000 8505 IF T(2,2)<=1951+N4 OR G2<=1951+N4 THEN A2=1: GOTO 8585 8510 GOSUB 4200: PRINT " Projected wage bases:" 8515 PRINT " ";R$(A2): GOSUB 4100: IF C$="N" THEN GOSUB 9450 8522 IF A2>1 THEN 8525 8523 FOR K1=N2+1 TO N5: B(1,K1)=0: B(4,K1)=0: NEXT K1: GOTO 8550 8525 FOR K1=1 TO T(2,2)-1936-N2 8530 PRINT " Wage base for";1936+N2+K1;"is";B(1,N2+K1) 8535 GOSUB 4100: IF C$="Y" THEN 8545 8540 PRINT " Enter wage base for";1936+N2+K1;"> "; 8541 B(1,N2+K1)=VAL(FNGETSTRN$(9)): GOSUB 9860 8545 NEXT K1 8550 GOSUB 7000 8585 IF A5=2 OR G9<35 THEN F6=0!: GOTO 8600 8587 GOSUB 9500 8590 PRINT USING " Monthly noncovered pension is$$###.##";F6 8595 GOSUB 4100: IF C$<>"Y" THEN GOSUB 9550 8600 RETURN 8700 REM Subroutine to get date of entitlement 8701 GOSUB 9850: PRINT " For old-age benefits, mo/year of "; 8702 PRINT "entitlement cannot be before age 62 and" 8703 PRINT " 1 month unless date of birth is on first or second day "; 8704 PRINT "of month, in" 8705 PRINT " which case initial month of entitlement can be as "; 8706 PRINT "early as month of" 8707 PRINT " 62nd birthday.": GOSUB 9860 8710 PRINT " Enter date of entitlement (mo/year) > "; 8711 C$=FNGETSTRN$(7) 8712 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3900: GOTO 8710 8713 G$(0)=MID$(C$,1,2): T(2,1)=VAL(G$(0)) 8714 G$(0)=MID$(C$,4,4): T(2,2)=VAL(G$(0)) 8715 IF T(2,2)<100 THEN T(2,2)=1900+T(2,2) 8716 IF T(2,1)<1 OR T(2,1)>12 THEN GOSUB 3600: GOTO 8710 8720 IF T(2,2)>1939 AND T(2,2)<1937+N5 THEN 8725 8722 GOSUB 9840: PRINT " Year must be in the range 1940 -";1936+N5 8723 BEEP: GOSUB 9860: GOTO 8710 8725 GOSUB 9860: RETURN 8750 REM Subroutine to get sex of worker 8755 PRINT " Enter sex-of-worker code (1=male, 2=female) > "; 8756 A6=VAL(FNGETSTRN$(1)): GOSUB 9860 8760 IF A6<1 OR A6>2 THEN BEEP: GOTO 8755 8765 RETURN 8800 REM Subroutine to get date of birth 8805 PRINT " Enter date of birth (mo/dy/year) > "; 8806 C$=FNGETSTRN$(10) 8807 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8805 8808 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 8805 8809 G$(0)=MID$(C$,1,2): T(5,1)=VAL(G$(0)) 8810 G$(0)=MID$(C$,4,2): T(5,2)=VAL(G$(0)) 8811 G$(0)=MID$(C$,7,4): T(5,3)=VAL(G$(0)) 8812 IF T(5,1)<1 OR T(5,1)>12 THEN GOSUB 3600: GOTO 8805 8815 IF T(5,2)<1 OR T(5,2)>31 THEN GOSUB 3700: GOTO 8805 8820 IF T(5,3)<100 THEN T(5,3)=1900+T(5,3) 8825 IF T(5,3)<1937+N5 THEN 8830 8827 GOSUB 9840: PRINT " Year cannot be more than";1936+N5 8828 BEEP: GOSUB 9860: GOTO 8805 8830 GOSUB 9860: RETURN 8850 REM Subroutine to get date of death 8855 PRINT " Enter date of death (mo/year) > "; 8856 C$=FNGETSTRN$(7) 8857 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3900: GOTO 8855 8858 G$(0)=MID$(C$,1,2): T(3,1)=VAL(G$(0)) 8859 G$(0)=MID$(C$,4,4): T(3,2)=VAL(G$(0)) 8860 IF T(3,2)<100 THEN T(3,2)=1900+T(3,2) 8865 IF T(3,1)<1 OR T(3,1)>12 THEN GOSUB 3600: GOTO 8855 8869 K2=1940: IF T(5,3)>1940 THEN K2=T(5,3) 8870 IF T(3,2)>=K2 AND T(3,2)<1937+N5 THEN 8875 8872 GOSUB 9840: PRINT " Year must be in the range";K2;"-";1936+N5 8873 BEEP: GOSUB 9860: GOTO 8855 8875 IF T(3,2)<T(2,2) OR (T(3,2)=T(2,2) AND T(3,1)<=T(2,1)) THEN 8885 8880 GOSUB 9840: PRINT " Death must precede entitlement" 8882 BEEP: GOSUB 9860: GOTO 8855 8885 GOSUB 9860: RETURN 8900 REM Subroutine to get type of benefit 8905 PRINT " Enter type of benefit:" 8910 FOR K2=1 TO 3: PRINT " ";K2;"for ";P$(K2): NEXT K2 8915 PRINT " > ";: A5=VAL(FNGETSTRN$(1)): GOSUB 9860 8916 IF A5<1 OR A5>3 THEN BEEP: GOTO 8905 8920 IF A5<>3 THEN RETURN 8925 GOSUB 9850: PRINT " The worker is assumed to be disability-"; 8930 PRINT "insured": GOSUB 6200: RETURN 8950 REM Subroutine to get type of survivor 8955 PRINT " Enter type of survivor claim:" 8960 FOR K2=1 TO 3: PRINT " ";K2;"for ";N$(K2): NEXT K2 8965 PRINT " > ";: A4=VAL(FNGETSTRN$(1)): GOSUB 9860 8966 IF A4<1 OR A4>3 THEN BEEP: GOTO 8955 8970 RETURN 9000 REM Subroutine to get type of earnings 9005 PRINT " Enter type of earnings:" 9010 FOR K2=1 TO 4: PRINT " ";K2;"for ";Q$(K2): NEXT K2 9015 PRINT " > ";: A3=VAL(FNGETSTRN$(1)): GOSUB 9860 9016 IF A3<1 OR A3>4 THEN BEEP: GOTO 9005 9020 RETURN 9050 REM Subroutine to get worker's date of disability onset 9055 PRINT " Enter worker's date of disability onset (mo/dy/year) > "; 9056 C$=FNGETSTRN$(10) 9057 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9055 9058 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9055 9059 G$(0)=MID$(C$,1,2): T(9,1)=VAL(G$(0)) 9060 G$(0)=MID$(C$,4,2): T(9,2)=VAL(G$(0)) 9061 G$(0)=MID$(C$,7,4): T(9,3)=VAL(G$(0)) 9062 IF T(9,3)<100 THEN T(9,3)=1900+T(9,3) 9065 IF T(9,1)<1 OR T(9,1)>12 THEN GOSUB 3600: GOTO 9055 9067 IF T(9,2)<1 OR T(9,2)>31 THEN GOSUB 3700: GOTO 9055 9068 K2=1940: IF T(5,3)>1940 THEN K2=T(5,3) 9070 IF T(9,3)>=K2 AND T(9,3)<1937+N5 THEN 9075 9072 GOSUB 9840: PRINT " Year must be in the range";K2;"-";1936+N5 9073 BEEP: GOSUB 9860: GOTO 9055 9075 IF T(9,3)<T(2,2) OR (T(9,3)=T(2,2) AND T(9,1)<=T(2,1)) THEN 9085 9080 GOSUB 9840: PRINT " Disability onset must precede entitlement" 9084 BEEP: GOSUB 9860: GOTO 9055 9085 IF A5<>2 THEN 9095 9086 IF T(9,3)<T(3,2) OR (T(9,3)=T(3,2) AND T(9,1)<=T(3,1)) THEN 9095 9090 GOSUB 9840: PRINT " Disability onset must precede death" 9091 BEEP: GOSUB 9860: GOTO 9055 9095 GOSUB 9860: RETURN 9100 REM Subroutine to get first year of earnings 9105 PRINT " Enter first year for which there are earnings (enter "; 9106 PRINT "1950": PRINT " if there are any pre-1951 earnings) > "; 9107 G1=VAL(FNGETSTRN$(4)) 9110 IF G1<100 THEN G1=1900+G1 9112 K2=1937: IF T(5,3)>1937 THEN K2=T(5,3) 9113 IF G1<1937+N5 AND G1>=K2 THEN 9120 9114 GOSUB 9840: PRINT " Year must be in the range";K2;"-";1936+N5 9115 BEEP: GOSUB 9860: GOTO 9105 9120 IF T(5,3)<1937 OR G1>1950 THEN 9125 9122 GOSUB 9840: PRINT " Year must be at least 1951" 9123 BEEP: GOSUB 9860: GOTO 9105 9125 U3=G1: IF G1<1951 THEN U3=1937 9130 GOSUB 9860: RETURN 9150 REM Subroutine to get disability code 9160 PRINT " Enter disability code:" 9165 FOR K2=1 TO 2: PRINT " ";K2;"for ";X$(K2): NEXT K2 9175 PRINT " > ";: T9=VAL(FNGETSTRN$(1)): GOSUB 9860 9176 IF T9<1 OR T9>2 THEN BEEP: GOTO 9160 9178 IF T9=1 THEN T(9,1)=0: T(9,2)=0: T(9,3)=0 9180 RETURN 9200 REM Subroutine to get last year of earnings 9205 PRINT " Enter last year for which there are earnings > "; 9206 G2=VAL(FNGETSTRN$(4)) 9210 IF G2<100 THEN G2=1900+G2 9215 IF G2<1937+N5 AND G2>=G1 THEN 9220 9217 GOSUB 9840: PRINT " Year must be in the range";G1;"-";1936+N5 9218 BEEP: GOSUB 9860: GOTO 9205 9220 U4=G2: IF G2<1950 THEN U4=1950 9225 IF G2-G1<61 THEN 9230 9227 GOSUB 9840: PRINT " No more than 60 years of earnings" 9228 BEEP: GOSUB 9860: GOTO 9205 9230 GOSUB 9860: RETURN 9250 REM Subroutine to get widow date of birth 9255 PRINT " Enter widow date of birth (mo/dy/year) > "; 9256 C$=FNGETSTRN$(10) 9257 G$(0)=MID$(C$,3,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9255 9258 G$(0)=MID$(C$,6,1): IF G$(0)<>"/" THEN GOSUB 3800: GOTO 9255 9259 G$(0)=MID$(C$,1,2): T(4,1)=VAL(G$(0)) 9260 G$(0)=MID$(C$,4,2): T(4,2)=VAL(G$(0)) 9261 G$(0)=MID$(C$,7,4): T(4,3)=VAL(G$(0)) 9262 IF T(4,1)<1 OR T(4,1)>12 THEN GOSUB 3600: GOTO 9255 9265 IF T(4,2)<1 OR T(4,2)>31 THEN GOSUB 3700: GOTO 9255 9270 IF T(4,3)<100 THEN T(4,3)=1900+T(4,3) 9275 GOSUB 9860: RETURN 9300 REM Subroutine to see if assumptions are needed 9305 T7=0: T8=0 9310 IF T(2,2)>1951+N4 OR (T(2,2)=1951+N4 AND T(2,1)=12) THEN T7=1 9315 IF T(2,2)>1951+N4 OR (T(2,2)>1949+N4 AND A3=3) THEN T8=1 9320 RETURN 9350 REM Subroutine to get benefit increase assumption trigger 9355 PRINT " Enter benefit increase assumptions:" 9370 FOR K2=1 TO W3: PRINT " ";K2;"for ";W$(K2): NEXT K2 9381 PRINT " > ";: A1=VAL(FNGETSTRN$(1)): GOSUB 9860 9385 IF A1<1 OR A1>W3 THEN BEEP: GOTO 9355 9390 RETURN 9400 REM Subroutine to get average wage assumption trigger 9405 PRINT " Enter average wage (indexing series) assumptions:" 9415 FOR K2=1 TO W3: PRINT " ";K2;"for ";E$(K2): NEXT K2 9426 PRINT " > ";: T3=VAL(FNGETSTRN$(1)): GOSUB 9860 9430 IF T3<1 OR T3>W3 THEN BEEP: GOTO 9405 9435 RETURN 9450 REM Subroutine to get projected wage base trigger 9455 PRINT " Enter wage base change indicator:" 9460 FOR K2=1 TO 2: PRINT " ";K2;"for ";R$(K2): NEXT K2 9465 PRINT " > ";: A2=VAL(FNGETSTRN$(1)): GOSUB 9860 9470 IF A2<1 OR A2>2 THEN BEEP: GOTO 9455 9475 RETURN 9500 REM Subroutine to print title for noncovered pension 9501 GOSUB 2000: PRINT " ";: GOSUB 9870 9502 PRINT STRING$(28," ");"Noncovered pension";STRING$(29," ") 9505 GOSUB 2100: RETURN 9550 REM Subroutine to get amount of noncovered pension 9555 PRINT " Enter amount of monthly noncovered pension. "; 9560 PRINT "(0 if none) > ";: F6=VAL(FNGETSTRN$(9)): GOSUB 9860 9565 IF F6>=0! THEN 9570 9567 GOSUB 9840: PRINT " Must not be negative" 9568 BEEP: GOSUB 9860: GOTO 9555 9570 RETURN 9600 REM Subroutine to save data to disk 9601 GOSUB 2000: PRINT " ";: GOSUB 9870 9602 PRINT STRING$(30," ");"Saving to disk";STRING$(31," ") 9603 GOSUB 2100: GOSUB 9850 9604 PRINT " You can save the data entered for this case. This "; 9605 PRINT "would be useful if you": PRINT " wanted to change just "; 9606 PRINT "part of the data. For instance, you may want to" 9607 PRINT " redo the computation assuming more or fewer years of "; 9608 PRINT "covered earnings in" 9609 PRINT " the future.": PRINT 9613 PRINT " If you save this case, the data will be available to "; 9614 PRINT "any other user of" 9615 PRINT " this disk. If the data is sensitive, you should "; 9616 PRINT "safeguard the disk, or" 9617 PRINT " else use the 'delete a case' option from the 'Case "; 9618 PRINT "Selection' menu when" 9619 PRINT " you are finished with this case.": PRINT: GOSUB 9860 9620 PRINT " Do you want to save this case to disk? (y or n) > "; 9621 C$=FNGETSTRN$(1): GOSUB 9860 9622 IF LEN(C$)<=0 THEN BEEP: GOTO 9620 9623 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 9620 9624 IF C$ <>"Y" THEN RETURN 9625 PRINT " Enter name of file for this case (up to 8 characters"; 9626 PRINT " or numbers)": PRINT " > "; 9627 L$=FNGETSTRN$(8): GOSUB 9860: L$=L$+".pia" 9630 OPEN "O",1,L$: PRINT " Writing to ";L$ 9635 PRINT #1,N4: PRINT #1,A6: PRINT #1,T(2,1): PRINT #1,T(2,2) 9640 PRINT #1,T(5,1): PRINT #1,T(5,2): PRINT #1,T(5,3) 9641 PRINT #1,A5: PRINT #1,A3: PRINT #1,G1: PRINT #1,G2 9645 PRINT #1,G(0,N6): PRINT #1,T(3,1): PRINT #1,T(3,2): PRINT #1,A4 9650 PRINT #1,T9: PRINT #1,T(9,1): PRINT #1,T(9,2): PRINT #1,T(9,3) 9655 PRINT #1,T(4,1): PRINT #1,T(4,2): PRINT #1,T(4,3) 9656 PRINT #1,T(12,1): PRINT #1,T(12,2): PRINT #1,T(12,3) 9660 PRINT #1,A1: IF A1<W3 THEN 9690 9665 FOR K2=N4+1 TO T(2,2)-1950: PRINT #1,USING "##.#";C(2,K2): NEXT K2 9670 PRINT #1,O$: IF O$<>"Y" THEN 9685 9675 FOR K2=1 TO 10: FOR K1=1 TO 8 9680 PRINT #1,USING "##.#";F(K2,K1): NEXT K1: NEXT K2 9685 PRINT #1,B$ 9690 PRINT #1,T3: IF T3<W3 THEN 9710 9695 FOR K2=N6+1 TO T(2,2)-1936: PRINT #1,USING "##.####";B(6,K2) 9700 NEXT K2 9705 PRINT #1,M$ 9710 PRINT #1,A2: IF A2<2 THEN 9725 9715 FOR K1=1 TO T(2,2)-1936-N2: PRINT #1,USING "######";B(1,N2+K1) 9720 NEXT K1 9725 IF A3>1 THEN 9735 9730 FOR K2=G1 TO G2: PRINT #1,USING " ######.##";O(K2-1936): NEXT K2 9735 PRINT #1,USING "######.##";F6: CLOSE #1: RETURN 9800 REM 1-line subroutines 9813 REM For Macintosh, $INCLUDE "COLOR.MAC" 9814 REM $INCLUDE: 'COLOR.BAS' 9880 PRINT " Do you wish to do another calculation? (y or n) > "; 9885 C$=FNGETSTRN$(1): GOSUB 9860 9887 IF LEN(C$)<=0 THEN BEEP: GOTO 9880 9890 GOSUB 4400: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 9880 9895 IF C$="Y" THEN 1000 9900 GOSUB 9860: CLS: END 9999 REM PIAIN.BAS - 1/26/88 - 09:15 AM