home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
zbasic
/
pia
/
piaout.bas
< prev
next >
Wrap
BASIC Source File
|
1987-11-03
|
35KB
|
753 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: 'GETSTRN.BAS'
310 S$=CHR$(12)
500 U$(1)="NONE": V$="NONE": Y$="": U$(2)="": U$(3)="": U$(4)="": K7=0
600 REM Get current date
605 C$=MID$(DATE$,1,2): T(13,1)=VAL(C$)
610 C$=MID$(DATE$,4,2): T(13,2)=VAL(C$)
615 C$=MID$(DATE$,7,4): T(13,3)=VAL(C$)
1000 REM Print warning to turn printer on
1005 CLS: GOSUB 6400: PRINT " ";: GOSUB 9870
1010 PRINT STRING$(30," ");"Prepare printer";STRING$(30," ")
1015 GOSUB 6400: GOSUB 9850
1020 PRINT: PRINT: PRINT " Printer should be on and paper ";
1025 PRINT "should be positioned"
1030 PRINT " 1/2 inch below top of form.": PRINT
1035 GOSUB 6800
1100 REM Print main menu
1105 CLS: GOSUB 6400: PRINT " ";: GOSUB 9870
1110 PRINT STRING$(29," ");"Print out results";STRING$(29," ")
1115 GOSUB 6400: GOSUB 9860
1120 PRINT: PRINT: PRINT " Enter desired printed output (listed in ";
1121 PRINT "order of increasing detail):"
1125 PRINT " 0 to exit printout for this case"
1130 PRINT " 1 for benefit estimate letter"
1135 PRINT " 2 for one-page summary (includes indexed earnings)"
1140 PRINT " 3 for two-page summary"
1145 PRINT " 4 for details of all calculations"
1150 PRINT " > ";: K9=VAL(FNGETSTRN$(1)): GOSUB 9850
1155 IF K9<0 OR K9>4 THEN BEEP: GOTO 1120
1160 IF K9=0 THEN 5000
1161 IF K9=4 AND K7=0 THEN 2000
1165 ON K9 GOTO 1600,1200,2000,2500
1200 REM Print one-page summary
1205 IF U$(1)="NONE" THEN GOSUB 6600
1206 IF G8 THEN GOSUB 6800
1207 GOSUB 9850: PRINT " Printing one-page summary"
1210 ON A5 GOTO 1215,1220,1225
1215 LPRINT TAB(25);"R E T I R E M E N T E S T I M A T E": GOTO 1230
1220 LPRINT TAB(27);"S U R V I V O R E S T I M A T E": GOTO 1230
1225 LPRINT TAB(25);"D I S A B I L I T Y E S T I M A T E"
1230 LPRINT: LPRINT: LPRINT: LPRINT TAB(15);
1231 IF A5=2 THEN 1234
1232 IF LEN(U$(1)) THEN LPRINT "Wage earner: ";U$(1);
1233 GOTO 1235
1234 IF LEN(Y$) THEN LPRINT "Wage earner: ";Y$;
1235 LPRINT TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
1236 IF LEN(V$) THEN LPRINT TAB(15);"SSN: ";V$
1237 LPRINT TAB(15);
1238 LPRINT "Date of birth: ";D$(T(5,1));STR$(T(5,2));",";T(5,3)
1240 IF A5=2 THEN LPRINT TAB(15);"Date of death: ";D$(T(3,1));T(3,2)
1245 IF A5<>3 THEN 1250
1247 LPRINT TAB(15);"Date of onset: ";D$(T(9,1));STR$(T(9,2));",";
1248 LPRINT T(9,3)
1250 LPRINT: LPRINT
1252 REM Print regular earnings
1255 LPRINT TAB(28);"R E G U L A R E A R N I N G S"
1260 LPRINT: LPRINT
1261 IF C1>0! THEN 1265
1262 I1=U3-1950-((U3-1951) MOD 5): IF I1<1 THEN I1=1
1263 GOTO 1269
1265 LPRINT USING " 50 ######,.##";C1: I1=1
1269 I4=(U4-1945-((U4-1951) MOD 5)-I1)/5: I3=I1+I4-1
1270 FOR K1=I1 TO I3: LPRINT " ";: FOR K2=0 TO 4
1275 I2=(50+K1+I4*K2) MOD 100
1280 IF I2>9 THEN LPRINT USING " ##";I2; ELSE LPRINT USING " 0#";I2;
1285 LPRINT USING " ######,.##";O(14+K1+I4*K2);
1290 NEXT K2: LPRINT: NEXT K1
1295 IF A(1,2)+A(1,4)=0 THEN 1320
1300 LPRINT: LPRINT " Dividend:";
1305 IF A(1,2)>0 THEN LPRINT USING "########,.##";D(9,2);
1310 IF A(1,4)>0 THEN LPRINT USING "########,.##";D(9,4);
1315 LPRINT TAB(60);"Divisor months:";12*N1
1320 LPRINT: LPRINT
1322 REM Print indexed earnings
1325 LPRINT TAB(28);"I N D E X E D E A R N I N G S"
1330 LPRINT: LPRINT
1335 FOR K1=I1 TO I3: LPRINT " ";: FOR K2=0 TO 4
1340 I2=(50+K1+I4*K2) MOD 100
1345 IF I2>9 THEN LPRINT USING " ##";I2; ELSE LPRINT USING " 0#";I2;
1350 LPRINT USING " ######,.##";L(3,K1+I4*K2);
1355 NEXT K2: LPRINT: NEXT K1
1360 LPRINT: LPRINT " Dividend:";
1365 LPRINT USING "##,###,###.##";D(9,3);
1370 LPRINT TAB(60);"Divisor months:";12*N1
1400 REM Print bottom part of page
1405 C$=" ": IF M8<>3 THEN C$="*"
1410 LPRINT: LPRINT " Eff.";
1415 IF C5>=1! THEN LPRINT TAB(34);"Increment";: GOTO 1425
1420 LPRINT TAB(34);"Reduction";
1425 LPRINT TAB(57);"Family"
1430 LPRINT " date AIME PIA factor MBA ";
1432 LPRINT "maximum"
1435 LPRINT " ----- ------ ------ --------- ------ ";
1437 LPRINT "-------"
1440 LPRINT USING " ##/";T(2,1);: I2=T(2,2) MOD 100
1442 IF I2>9 THEN LPRINT USING "##";I2; ELSE LPRINT USING "0#";I2;
1445 LPRINT USING " ######";D(5,3);
1450 LPRINT USING " #####.##";D(1,3);
1455 LPRINT USING " #.#####";C5;: LPRINT USING " #####.##";X2;
1465 LPRINT C$;: LPRINT USING " #####.##";X1;: LPRINT C$: LPRINT
1485 IF C$="*" THEN LPRINT " *Based on ";F$(M8)
1490 IF A(1,1)=0 THEN 1495
1492 LPRINT " ";F$(1);: LPRINT USING " PIA: ####.##";D(1,1)
1495 IF A(1,2)=0 THEN 1500
1497 LPRINT " ";F$(2);: LPRINT USING " PIA: ####.##";D(1,2)
1500 IF A(1,4)=0 THEN 1505
1502 LPRINT " ";F$(4);: LPRINT USING " PIA: ####.##";D(1,4)
1505 IF A(1,5)=0 THEN 1510
1507 LPRINT " ";F$(5);: LPRINT USING " PIA: ####.##";D(1,5)
1510 IF A(1,6)=0 THEN 1513
1512 LPRINT " ";F$(6);: LPRINT USING " PIA: ####.##";D(1,6)
1513 IF S2<S4 THEN GOSUB 7300
1514 IF A5=3 THEN GOSUB 7800
1515 LPRINT S$: GOTO 1100
1600 REM Print benefit estimate letter
1601 IF (A1>4 AND A1<8 AND T3>5 AND T3<8) OR T(2,2)=1936+N2 THEN 1605
1602 GOSUB 9840: PRINT " Must be POMS assumptions for letter"
1603 BEEP: GOSUB 6700: GOTO 1100
1605 IF U$(1)="NONE" THEN GOSUB 6600
1606 OPEN "I",1,"ADDRESS.DAT"
1610 FOR K1=1 TO 4: INPUT #1,T$(K1): NEXT K1: CLOSE #1
1611 IF G8 THEN GOSUB 6800
1612 GOSUB 9850: PRINT " Printing benefit estimate letter"
1620 LPRINT " ";STRING$(71,"="): LPRINT
1625 LPRINT " S O C I A L S E C U R I T Y E S T I M A T E ";
1630 LPRINT "O F B E N E F I T S": LPRINT
1635 LPRINT " ";STRING$(71,"="): LPRINT: LPRINT " ";T$(1)
1640 LPRINT " ";T$(2);TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
1645 LPRINT " ";T$(3): IF LEN(T$(4)) THEN LPRINT " ";T$(4)
1650 LPRINT: LPRINT " ";STRING$(71,"="): LPRINT
1652 FOR K1=1 TO 4
1653 IF LEN(U$(K1)) THEN LPRINT " ";U$(K1)
1655 NEXT K1: LPRINT: LPRINT: LPRINT: LPRINT
1659 IF A5=2 THEN 1662
1660 IF LEN(U$(1)) THEN LPRINT " Wage earner: ";U$(1): LPRINT
1661 GOTO 1665
1662 IF LEN(Y$) THEN LPRINT " Wage earner: ";Y$: LPRINT
1665 IF LEN(V$) THEN LPRINT " SSN: ";V$: LPRINT: LPRINT: LPRINT
1670 LPRINT " This is in response to your request for an estimate";
1672 LPRINT " of your monthly"
1675 ON A5 GOTO 1678,1755,1900
1678 REM Print old-age paragraph
1680 LPRINT " Social Security retirement benefit. Based on our ";
1682 LPRINT "records and the"
1685 LPRINT " estimate you provided of your additional future ";
1687 LPRINT "earnings, the monthly"
1690 LPRINT " benefit estimate, in terms of";1936+N2;
1695 LPRINT "dollars, is:": LPRINT
1700 LPRINT " o";: IF X2>999.99 THEN 1702
1701 LPRINT USING "$$###";X2;: GOTO 1705
1702 LPRINT USING "$$####";X2;
1705 LPRINT " beginning with the month that you attain"
1710 LPRINT " age";STR$(T(1,1));
1715 IF T(1,2)=0 THEN LPRINT: GOTO 1720
1716 LPRINT " and";STR$(T(1,2));
1717 IF T(1,2)=1 THEN LPRINT " month" ELSE LPRINT " months"
1720 IF A7<N4 THEN 1940
1721 IF C5<1! OR A7>48 THEN 1738
1722 REM Print age-62 paragraph
1724 V8=.8: IF T(7,2)=1 THEN V8=.8055556
1726 V9=V8*V6: V9=FIX(V9): LPRINT
1728 LPRINT " o";: IF V9>999.99 THEN 1730
1729 LPRINT USING "$$###";V9;: GOTO 1731
1730 LPRINT USING "$$####";V9;
1731 LPRINT " should you take your benefit at the earliest"
1732 LPRINT " possible age of";STR$(T(7,1));
1734 IF T(7,2) THEN LPRINT " and";T(7,2);"month" ELSE LPRINT
1736 GOTO 1940
1738 REM Print normal-retirement-age paragraph
1739 IF C5>=1! THEN 1940 ELSE LPRINT
1740 LPRINT " o";: IF FIX(V6)>999.99 THEN 1742
1741 LPRINT USING "$$###";FIX(V6);: GOTO 1743
1742 LPRINT USING "$$####";FIX(V6);
1743 LPRINT " should you wait and take your benefit at"
1744 LPRINT " your normal retirement age of";STR$(T(6,1));
1746 IF T(6,2) THEN LPRINT " and";T(6,2);"months" ELSE LPRINT
1748 GOTO 1940
1755 REM Print survivor paragraph
1760 ON A4 GOTO 1765,1800,1850
1765 LPRINT " Social Security survivor benefits. Based on our ";
1767 LPRINT "records and the"
1770 LPRINT " estimate you provided of additional future ";
1772 LPRINT "earnings for the wage"
1775 LPRINT " earner, and an assumed date of death of ";D$(T(3,1));
1777 LPRINT STR$(T(3,2));", the monthly"
1780 LPRINT " benefit estimate for each survivor, in terms of";
1782 LPRINT 1936+N2;"dollars, is:": LPRINT
1785 LPRINT " o";: IF X2>999.99 THEN 1787
1786 LPRINT USING "$$###";X2;: GOTO 1788
1787 LPRINT USING "$$####";X2;
1788 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));".": LPRINT
1790 LPRINT " Total monthly payments to all survivors would be ";
1792 LPRINT "limited to";: LPRINT USING "$$####.##";X1;
1795 LPRINT ".": GOTO 1940
1800 LPRINT " Social Security surviving disabled spouse benefit.";
1802 LPRINT " Based on our"
1805 LPRINT " records and the estimate you provided of ";
1807 LPRINT "additional future earnings"
1810 LPRINT " for the wage earner, and an assumed date of death ";
1812 LPRINT "of ";D$(T(3,1));STR$(T(3,2));","
1815 LPRINT " the monthly benefit estimate, in terms of";1936+N2;
1820 LPRINT "dollars, is:": LPRINT
1825 LPRINT " o";: IF X2>999.99 THEN 1835
1830 LPRINT USING "$$###";X2;: GOTO 1840
1835 LPRINT USING "$$####";X2;
1840 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));"."
1845 GOTO 1940
1850 LPRINT " Social Security surviving spouse benefit. Based ";
1852 LPRINT "on our records and"
1855 LPRINT " the estimate you provided of additional future";
1857 LPRINT " earnings for the wage"
1860 LPRINT " earner, and an assumed date of death of ";D$(T(3,1));
1862 LPRINT STR$(T(3,2));", the monthly"
1865 LPRINT " benefit estimate, in terms of";1936+N2;"dollars, is:"
1867 LPRINT: LPRINT " o";: IF X2>999.99 THEN 1872
1870 LPRINT USING "$$###";X2;: GOTO 1875
1872 LPRINT USING "$$####";X2;
1875 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));"."
1880 GOTO 1940
1898 REM Print disability paragraph
1900 LPRINT " Social Security disability benefit. Based on our ";
1905 LPRINT "records and the"
1910 LPRINT " estimate you provided of your additional future ";
1912 LPRINT "earnings, and an"
1915 LPRINT " assumed date of disability onset of ";D$(T(9,1));
1917 LPRINT STR$(T(9,2));",";STR$(T(9,3));", the monthly"
1920 LPRINT " benefit estimate, in terms of";1936+N2;
1922 LPRINT "dollars, is:": LPRINT
1925 LPRINT " o";: IF X2>999.99 THEN 1930
1927 LPRINT USING "$$###";X2;: GOTO 1935
1930 LPRINT USING "$$####";X2;
1935 LPRINT " beginning with ";D$(T(2,1));",";STR$(T(2,2));"."
1940 IF S2<S4 THEN GOSUB 7400
1945 ON A5 GOSUB 6900,7100,7500
1950 GOSUB 7200: LPRINT S$: GOTO 1100
2000 REM Print two-page summary of results
2002 IF G8 THEN GOSUB 6800
2005 GOSUB 9850: PRINT " Printing summary, page 1"
2010 LPRINT TAB(26);"Summary of Results";
2011 LPRINT TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3): LPRINT: LPRINT
2015 LPRINT " ";A$(A6);" born on ";D$(T(5,1));STR$(T(5,2));",";
2020 LPRINT T(5,3): ON A5 GOTO 2025,2065,2090
2025 LPRINT " Retired in ";D$(T(2,1));T(2,2);"at age";
2030 LPRINT T(1,1);"and";T(1,2);"months"
2035 IF T9=1 THEN 2045
2040 LPRINT " Previous disability onset on ";D$(T(9,1));
2042 LPRINT STR$(T(9,2));",";T(9,3)
2045 LPRINT " Normal retirement age =";T(6,1);"and";T(6,2);"months"
2050 IF T(7,1)=0 THEN 2060
2055 LPRINT " Early retirement age =";T(7,1);"and";T(7,2);"months"
2060 GOTO 2105
2065 LPRINT " Died in ";D$(T(3,1));T(3,2)
2070 LPRINT " Benefits started in ";D$(T(2,1));T(2,2)
2075 IF T9=1 THEN 2085
2080 LPRINT " Previous disability onset in ";D$(T(9,1));
2082 LPRINT STR$(T(9,2));",";T(9,3)
2085 LPRINT " ";N$(A4): IF A4<2 THEN 2105
2086 LPRINT " Widow born on ";D$(T(4,1));STR$(T(4,2));",";
2087 LPRINT T(4,3): IF A4<>2 THEN 2105
2088 LPRINT " Widow disabled on ";D$(T(12,1));STR$(T(12,2));",";
2089 LPRINT T(12,3): GOTO 2105
2090 LPRINT " Disabled on ";D$(T(9,1));STR$(T(9,2));",";T(9,3)
2095 LPRINT " Benefits started in ";D$(T(2,1));T(2,2);
2100 LPRINT "at age";T(1,1);"and";T(1,2);"months"
2105 IF F6<=0! THEN 2107
2106 LPRINT USING " Noncovered monthly pension = #####,.##";F6
2107 LPRINT
2110 FOR K3=1 TO 6: LPRINT " ";F$(K3)
2115 IF A(1,K3)>=1 THEN LPRINT USING " PIA: $$####.##"; D(1,K3)
2120 IF A(1,K3)>=1 THEN LPRINT USING " MFB: $$####.##"; D(8,K3)
2125 IF A(1,K3)=0 THEN LPRINT " Not applicable"
2130 LPRINT: NEXT K3
2135 LPRINT: LPRINT: LPRINT
2136 ON M8 GOTO 2137,2137,2139,2137,2141,2139
2137 LPRINT USING " Average Monthly Earnings = $$#######";D(5,M8)
2138 GOTO 2142
2139 LPRINT USING " Indexed Monthly Earnings = $$#######";D(5,M8)
2140 GOTO 2142
2141 LPRINT USING " Years of coverage = ####";G6
2142 LPRINT USING " Primary Insurance Amount = $$####.##";V6
2143 IF C5<1! THEN 2157
2145 LPRINT USING " Number of months of increment = ####";I6
2150 LPRINT USING " Delayed increment factor = #.#####";C5
2155 GOTO 2165
2157 LPRINT USING " Number of months of reduction = ####";I6
2161 IF A5=2 AND A4=1 THEN 2163
2162 LPRINT " Actuarial reduction factor =";: GOTO 2164
2163 LPRINT " Benefit factor = ";
2164 LPRINT USING " #.#####";C5
2165 LPRINT USING " Benefit actually payable = $$####.##";X2
2170 LPRINT USING " Maximum Family Benefit = $$#####.##";X1
2175 LPRINT: LPRINT: LPRINT
2180 REM Print assumptions used
2190 IF T7=0 THEN 2220
2195 LPRINT " Benefit increase assumptions:"
2205 IF A1=8 THEN LPRINT " ";B$ ELSE LPRINT " ";W$(A1)
2220 IF T8=0 THEN 2245
2225 LPRINT " Average wage increase assumptions:"
2240 IF T3=8 THEN LPRINT " ";M$ ELSE LPRINT " ";E$(T3)
2245 IF S2<S4 THEN GOSUB 7400
2250 IF A5=3 THEN LPRINT: GOSUB 7800
2255 IF A1<5 OR A1=8 OR T3<6 OR T3=8 THEN GOSUB 7700 ELSE GOSUB 7500
2260 LPRINT S$
2300 REM Print earnings and quarters of coverage
2305 IF G8 THEN GOSUB 6800
2307 GOSUB 9850: PRINT " Printing summary, page 2"
2310 LPRINT " Earnings Used in PIA Calculation";
2311 LPRINT TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
2314 LPRINT: LPRINT: LPRINT STRING$(30," ");"Amount for Quarters"
2315 LPRINT STRING$(19," ");"Annual quarter of of"
2316 LPRINT " year earnings coverage coverage"
2320 LPRINT: FOR K3=U3 TO U4
2330 LPRINT USING " ####";K3;
2335 LPRINT USING " ########,.##";O(K3-1936);
2336 IF K3<1936+N6 THEN LPRINT: GOTO 2340
2337 LPRINT USING " ########,.##";L(0,K3-1936);
2338 LPRINT USING " ####";G(0,K3-1936)
2340 NEXT K3: IF U4>=1936+N6 THEN 2343
2341 LPRINT " ";1936+N6;STRING$(33," ");
2342 LPRINT USING "####";G(0,N6)
2343 LPRINT: LPRINT " QC's for";1936+N6;"include all prior years"
2344 LPRINT " Type of earnings: ";Q$(A3)
2345 IF T(2,2)<=1951+N4 OR G2<=1951+N4 THEN 2347
2346 LPRINT " Projected wage bases: ";R$(A2)
2347 IF S2<S4 THEN LPRINT: GOSUB 7300
2348 IF P6+1950<G2 THEN LPRINT: GOSUB 7600
2349 IF A5=3 THEN LPRINT: GOSUB 7800
2350 K7=1: LPRINT S$: IF K9=3 THEN 1100
2500 REM Print details of calculations
2600 REM Print Old-Start earnings
2605 IF A(1,1)=0 THEN 2900
2607 IF G8 THEN GOSUB 6800
2608 GOSUB 9850: PRINT " Printing old-start earnings"
2610 S3=1: GOSUB 7900
2615 LPRINT " actual imputed high N"
2620 LPRINT " year earnings earnings years": LPRINT
2625 FOR K3=1937 TO P6+1950: K1=K3-1936
2630 LPRINT USING " ####";K3;
2635 LPRINT USING " ########,.##";O(K3-1936);
2640 LPRINT USING " ########,.##"; L(1,K1);
2645 IF G(1,K1)<=0 THEN LPRINT: GOTO 2655
2650 LPRINT USING " ########,.##";L(1,K1)
2655 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
2657 IF A5=3 THEN LPRINT: GOSUB 7800
2660 LPRINT S$
2700 REM Print Old-Start detail
2702 IF G8 THEN GOSUB 6800
2703 GOSUB 9850: PRINT " Printing old-start detail"
2705 GOSUB 7900
2710 LPRINT " Applicable method: ";H$(N9);" Amendments"
2715 LPRINT " ";K$(N9): LPRINT
2720 LPRINT USING " AME = ######,.##";D(9,1);
2725 LPRINT USING "/(##*12) =";N8;: LPRINT I9: LPRINT
2735 LPRINT USING " PIB = ###.##";F1: LPRINT
2740 ON N9 GOTO 2825,2745,2755,2755,2755,2755,2755
2745 LPRINT USING " 1950 PIA = ###.##";D(2,1): LPRINT
2750 LPRINT USING " 1950 MFB = ###.##";D(4,1): LPRINT: GOTO 2825
2755 LPRINT " New-start AME =";D(5,1): LPRINT
2760 ON N9 GOTO 2825,2825,2825,2825,2825,2765,2780
2765 LPRINT " Applicable table: ";G$(P4);" Act": LPRINT
2770 IF A(2,1)<=0 THEN 2780
2775 K1=25: K2=A(2,1)+24: U8=G4: GOSUB 6000: GOTO 2825
2780 IF Q(3,1)>.001 THEN 2795
2785 LPRINT USING " December 1978 PIA = ####.##";D(2,1): LPRINT
2790 GOTO 2810
2795 LPRINT USING " December 1978 PIA = ####.##";Q(3,1): LPRINT
2800 LPRINT USING " Noncovered monthly pension = #####.##";F6
2802 LPRINT
2805 LPRINT USING " PIA after windfall = ####.##";D(2,1): LPRINT
2810 LPRINT " MFB bendpoints =";STR$(Q(7,2));",";STR$(Q(7,3));
2812 LPRINT ", and";Q(7,4): LPRINT
2815 LPRINT " MFB at eligibility =": GOSUB 6200
2820 IF A(2,1)>0 THEN K1=G9+1: K2=A(2,1)+G9: U8=G4: GOSUB 6000
2825 GOSUB 6100
2900 REM Print Old-law earnings
2905 IF A(1,2)=0 THEN 3100
2907 IF G8 THEN GOSUB 6800
2908 GOSUB 9850: PRINT " Printing old-law earnings"
2910 S3=2: GOSUB 7900
2915 LPRINT " high N"
2920 LPRINT " year earnings years": LPRINT
2925 FOR K3=U3 TO P6+1950: K1=K3-1950
2930 IF K3<=1950 THEN 2955
2935 LPRINT USING " ####";K3;
2940 LPRINT USING " ########,.##";O(K3-1936);
2945 IF G(2,K1)<=0 THEN LPRINT: GOTO 2955
2950 LPRINT USING " ########,.##";L(2,K1)
2955 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
2957 IF A5=3 THEN LPRINT: GOSUB 7800
2960 LPRINT S$
3000 REM Print Old-law detail
3002 IF G8 THEN GOSUB 6800
3005 GOSUB 9850: PRINT " Printing old-law detail"
3010 GOSUB 7900: GOSUB 6300
3015 LPRINT USING " AME = ######,.##";D(9,2);
3020 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,2): LPRINT
3030 LPRINT " Applicable table: ";G$(P4): LPRINT
3035 IF A(2,2)>0 THEN K1=25: K2=A(2,2)+24: GOSUB 6000
3040 GOSUB 6100
3100 REM Print wage-indexed earnings
3105 IF A(1,3)=0 THEN 3600
3107 IF G8 THEN GOSUB 6800
3108 GOSUB 9850: PRINT " Printing wage-indexed earnings"
3110 S3=3: GOSUB 7900
3115 LPRINT " earnings";
3120 LPRINT " indexed high N"
3125 LPRINT " year earnings * ";
3130 LPRINT USING "$$#####,.## earnings years"; B(5,G9-1+14)
3140 LPRINT: FOR K3=U3 TO P6+1950: K1=K3-1950
3145 IF K3<=1950 THEN 3210
3150 LPRINT USING " ####";K3;
3155 LPRINT USING " ########,.##";O(K3-1936);
3160 IF G(3,K1)>0 THEN 3185
3165 IF K3>G9+1949 THEN LPRINT STRING$(19," ");: GOTO 3180
3170 LPRINT USING " ##############,.##";C(3,K1);
3180 LPRINT USING " ########,.##";L(3,K1): GOTO 3210
3185 IF K3>G9+1949 THEN LPRINT STRING$(19," ");: GOTO 3200
3190 LPRINT USING " ##############,.##"; C(3,K1);
3200 LPRINT USING " ########,.##"; L(3,K1);
3205 LPRINT USING " ########,.##"; L(3,K1)
3210 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
3212 IF A5=3 THEN LPRINT: GOSUB 7800
3215 LPRINT S$
3300 REM Print wage-indexed detail
3302 IF G8 THEN GOSUB 6800
3303 GOSUB 9850: PRINT " Printing wage-indexed detail"
3305 GOSUB 7900
3310 LPRINT " Base year for indexing =";G9+1949: LPRINT
3315 GOSUB 6300: LPRINT USING " AIME = #########,.##";D(9,3);
3320 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,3): LPRINT
3330 LPRINT " PIA formula bend points =";Q(8,2);"and";Q(8,3)
3335 LPRINT: LPRINT " MFB formula bend points =";STR$(Q(7,2));
3337 LPRINT ",";STR$(Q(7,3));", and";Q(7,4): LPRINT
3340 LPRINT " PIA at eligibility = "
3345 LPRINT USING " #.## * ";Q(2,1);
3350 LPRINT USING "##### +";H(1,3)
3355 LPRINT USING " #.## * ";Q(2,2);
3360 LPRINT USING "##### +";H(2,3)
3365 LPRINT USING " #.## * ";Q(2,3);
3370 LPRINT USING "##### = ";H(3,3);
3375 IF P1>0 THEN LPRINT USING "#####.##";Q(3,3): GOTO 3395
3380 LPRINT USING "#####.##";D(2,3)
3395 IF P1=0 THEN 3495
3400 LPRINT: LPRINT USING " Noncovered pension = #####.##";F6
3410 LPRINT: IF P1>0 THEN 3430
3415 LPRINT " Special minimum savings clause:";
3420 LPRINT G6;"years of coverage": GOTO 3495
3430 LPRINT " PIA after windfall"
3435 IF P1=1 THEN 3480
3440 LPRINT USING " #.## * ";Q(4,1);
3445 LPRINT USING "##### +";H(1,3)
3450 LPRINT USING " #.## * ";Q(4,2);
3455 LPRINT USING "##### +";H(2,3)
3460 LPRINT USING " #.## * ";Q(4,3);
3465 LPRINT USING "##### = ";H(3,3);
3470 LPRINT USING "#####.##";D(2,3): GOTO 3495
3480 LPRINT USING " #####.##";Q(3,3);: LPRINT " - .5* ";
3485 LPRINT USING "#####.##";F6;
3490 LPRINT USING " = #####.##";D(2,3)
3495 LPRINT: LPRINT " MFB at eligibility ="
3505 ON P2+1 GOTO 3540,3510,3520,3510
3510 LPRINT USING " #.# * ";V7;
3515 LPRINT USING "#####.##";D(2,3): GOTO 3530
3520 LPRINT USING " #.## * ";V7;
3525 LPRINT USING "#####";D(5,3)
3530 LPRINT USING " (MFB cap on DI cases) = #####.##"; D(4,3)
3535 LPRINT: GOTO 3543
3540 GOSUB 6200
3543 U2=G9: GOSUB 7000
3545 IF A(2,3)>0 THEN K1=G9+1: K2=A(2,3)+G9: U8=G4: GOSUB 6000
3550 GOSUB 6100
3600 REM Print transitional guarantee earnings
3605 IF A(1,4)=0 THEN 3800
3607 IF G8 THEN GOSUB 6800
3608 GOSUB 9850: PRINT " Printing transitional guarantee earnings"
3610 S3=4: GOSUB 7900
3615 LPRINT " high N"
3620 LPRINT " year earnings years": LPRINT
3625 FOR K3=U3 TO P6+1950: K1=K3-1950
3630 IF K3<=1950 THEN 3655
3635 LPRINT USING " ####";K3;
3640 LPRINT USING " #######,.##";O(K3-1936);
3645 IF G(4,K1)<=0 THEN LPRINT: GOTO 3655
3650 LPRINT USING " ########,.##";L(4,K1)
3655 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
3657 IF A5=3 THEN LPRINT: GOSUB 7800
3660 LPRINT S$
3700 REM Print transitional guarantee detail
3702 IF G8 THEN GOSUB 6800
3703 GOSUB 9850: PRINT " Printing transitional guarantee detail"
3705 GOSUB 7900
3715 GOSUB 6300: LPRINT USING " AME =#######,.##";D(9,4);
3720 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,4): LPRINT
3730 LPRINT USING " December 1978 PIA = ####.##";D(2,4): LPRINT
3735 LPRINT " MFB bendpoints =";STR$(Q(7,2));",";STR$(Q(7,3));
3737 LPRINT ", and";Q(7,4): LPRINT
3740 LPRINT " MFB at eligibility =": GOSUB 6200
3745 IF A(2,4)>0 THEN K1=G9+1: K2=A(2,4)+G9: U8=G4: GOSUB 6000
3750 GOSUB 6100
3800 REM Print special-minimum earnings
3805 IF A(1,5)=0 THEN 4100
3807 IF G8 THEN GOSUB 6800
3808 GOSUB 9850: PRINT " Printing special-minimum earnings"
3810 S3=5: GOSUB 7900
3815 LPRINT " 1/4 old- years of"
3820 LPRINT " year earnings law base coverage": LPRINT
3821 IF U3>1950 THEN 3825
3822 LPRINT USING " 1937-50 ######,.##";C1;
3823 LPRINT USING " ##";G(5,14)
3825 FOR K3=U3 TO P6+1950: K1=K3-1936
3827 IF K1<15 THEN 3847
3830 LPRINT USING " ####";K3;
3835 LPRINT USING " #######,.##";O(K3-1936);
3840 LPRINT USING " ########,.##"; .25*B(4,K1);
3845 LPRINT USING " #";G(5,K1)
3847 NEXT K3: IF S2<S4 THEN LPRINT: GOSUB 7300
3848 IF A5=3 THEN LPRINT: GOSUB 7800
3850 LPRINT S$
3900 REM Print special-minimum detail
3902 IF G8 THEN GOSUB 6800
3905 GOSUB 9850: PRINT " Printing special-minimum detail"
3910 GOSUB 7900: LPRINT " Years of coverage =";G6: LPRINT
3915 LPRINT " Years of coverage over 10 (maximum 20) =";M6: LPRINT
3925 LPRINT USING " Amount per year = ##.##";V2: LPRINT
3930 IF T(2,2)>1978 THEN 3975
3935 LPRINT " PIA =";M6;"* ";
3940 LPRINT USING "##.## = ";V2;
3945 LPRINT USING "###.##";D(1,5): LPRINT
3950 LPRINT " Applicable table for MFB: ";G$(P4): LPRINT
3955 LPRINT " AME from table =";D(5,5): LPRINT
3960 IF A(2,5)>0 THEN K1=25: K2=A(2,5)+24: GOSUB 6000
3965 LPRINT USING " PIA from table = ###.##";V4: LPRINT
3970 LPRINT USING " MFB = ###.##";D(8,5): LPRINT S$: GOTO 4105
3975 LPRINT " January 1979 PIA =";M6;"* ";
3980 LPRINT USING "##.## = ";V2;
3985 LPRINT USING "###.##";D(2,5): LPRINT
3995 IF T(2,2)=1979 AND T(2,1)<6 THEN 4010
4000 LPRINT USING " MFB in January 1979 = ###.##";D(4,5): LPRINT
4005 K1=29: K2=A(2,5)+28: U8=G4: GOSUB 6000
4010 GOSUB 6100
4100 REM Print re-indexed widow earnings
4105 IF A(1,6)=0 THEN 4420
4107 IF G8 THEN GOSUB 6800
4108 GOSUB 9850: PRINT " Printing re-indexed widow earnings"
4110 S3=6: GOSUB 7900
4115 LPRINT " earnings";
4120 LPRINT " indexed high N"
4125 LPRINT " year earnings * ";
4130 LPRINT USING "$$#####.##"; B(5,M7+13);
4135 LPRINT " earnings years": LPRINT
4140 FOR K2=U3 TO P6+1950: K1=K2-1950
4145 IF K2<=1950 THEN 4210
4150 LPRINT USING " ####";K2;
4155 LPRINT USING " ########,.##";O(K2-1936);
4160 IF G(6,K1)>0 THEN 4185
4165 IF K2>M7+1949 THEN LPRINT STRING$(19," ");: GOTO 4180
4170 LPRINT USING " ##############,.##";C(4,K1);
4180 LPRINT USING " ########,.##";L(6,K1): GOTO 4210
4185 IF K2>M7+1949 THEN LPRINT STRING$(19," ");: GOTO 4200
4190 LPRINT USING " ##############,.##";C(4,K1);
4200 LPRINT USING " ########,.##";L(6,K1);
4205 LPRINT USING " ########,.##";L(6,K1)
4210 NEXT K2: IF S2<S4 THEN LPRINT: GOSUB 7300
4212 IF A5=3 THEN LPRINT: GOSUB 7800
4215 LPRINT S$
4300 REM Print re-indexed widow detail
4302 IF G8 THEN GOSUB 6800
4303 GOSUB 9850: PRINT " Printing re-indexed widow detail"
4305 GOSUB 7900
4310 LPRINT " Widow born on ";D$(T(4,1));STR$(T(4,2));",";T(4,3)
4315 LPRINT: LPRINT " Base year for indexing =";M7+1949: LPRINT
4320 GOSUB 6300: LPRINT USING " AIME = #########,.##";D(9,6);
4325 LPRINT USING "/(##*12) =";N1;: LPRINT D(5,6): LPRINT
4335 LPRINT " PIA bend points = ";Q(5,2);"and";Q(5,3): LPRINT
4340 LPRINT " PIA at eligibility = "
4345 LPRINT USING " #.## * ";Q(2,1);
4350 LPRINT USING "##### +";H(1,6)
4355 LPRINT USING " #.## * ";Q(2,2);
4360 LPRINT USING "##### +";H(2,6)
4365 LPRINT USING " #.## * ";Q(2,3);
4370 LPRINT USING "##### = ";H(3,6);
4375 LPRINT USING "#####.##";D(2,6): LPRINT
4380 U2=M7: GOSUB 7000
4385 IF A(2,6)>0 THEN K1=M7+1: K2=A(2,6)+M7: U8=M2: GOSUB 6000
4405 LPRINT USING " PIA at entitlement = $$####.##";D(1,6): LPRINT
4410 LPRINT " MFB at entitlement = (same as for wage-indexed)"
4415 LPRINT S$
4420 GOTO 1100
5000 REM End of printout
5005 PRINT " Do you wish to do another calculation? (y or n) > ";
5010 C$=FNGETSTRN$(1): GOSUB 9860
5011 IF LEN(C$)<=0 THEN BEEP: GOTO 5005
5012 I4=ASC(C$): IF I4>96 THEN C$=CHR$(I4-32) ELSE C$=CHR$(I4)
5013 IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 5005
5015 IF C$<>"Y" THEN 9900
5020 CLS: GOSUB 9850
5025 PRINT " Loading PIA data-input program; please wait..."
5030 CHAIN "PIAIN"
6000 REM Subroutine to print out benefit increases
6005 LPRINT " CPI increases applied:"
6010 FOR K4=K1 TO K2
6015 LPRINT USING " ##.#";C(2,K4);
6020 LPRINT " % for";K4+1950
6025 IF K4<N4+3 OR K4>N4+10 THEN 6045
6030 IF F(U8,K4-N4-2)<.05 THEN 6045
6035 LPRINT USING " ##.#";F(G4,K4-N4-2);
6040 LPRINT " % for";K4+1950;"catch-up"
6045 NEXT K4: LPRINT: RETURN
6100 REM Subroutine to write out PIA and MFB
6105 LPRINT USING " PIA at entitlement = $$####.##";D(1,S3): LPRINT
6110 LPRINT USING " MFB at entitlement = $$####.##";D(8,S3)
6112 IF S2<S4 THEN LPRINT: GOSUB 7300
6113 IF A5=3 THEN LPRINT: GOSUB 7800
6115 LPRINT S$: RETURN
6200 REM Subroutine to write out MFB calculation
6205 LPRINT USING " #.## * ";Q(1,1);
6210 LPRINT USING "####.## +";V(1,S3)
6215 LPRINT USING " #.## * ";Q(1,2);
6220 LPRINT USING "####.## +";V(2,S3)
6225 LPRINT USING " #.## * ";Q(1,3);
6230 LPRINT USING "####.## +";V(3,S3)
6235 LPRINT USING " #.## * ";Q(1,4);
6240 LPRINT USING "####.## = ";V(4,S3);
6245 LPRINT USING "#####.##";D(4,S3): LPRINT: RETURN
6300 REM Subroutine to write out number of computation years
6305 LPRINT " Number of elapsed years =";A9: LPRINT
6310 LPRINT " Number of dropout years =";A8: LPRINT
6315 LPRINT " Number of computation years =";A9;"-";A8;"=";N1
6320 LPRINT: RETURN
6400 REM Subroutine to draw 75 hyphens
6405 GOSUB 9860: PRINT " ";STRING$(75,"-"): RETURN
6600 REM Subroutine to get wage-earner name and SSN
6605 GOSUB 9860: PRINT " Enter name of wage-earner (RETURN if none)"
6610 PRINT " > ";
6611 IF A5=2 THEN Y$=FNGETSTRN$(34) ELSE U$(1)=FNGETSTRN$(34): GOTO 6615
6612 GOSUB 9860: PRINT " Enter name of beneficiary (RETURN if none)"
6613 PRINT " > ";: U$(1)=FNGETSTRN$(34)
6615 GOSUB 9860: PRINT " Enter social security number of wage earner";
6620 PRINT " (RETURN if none)": PRINT " > ";
6625 V$=FNGETSTRN$(11)
6630 GOSUB 9860: PRINT " Enter first line of address (RETURN if none)"
6635 PRINT " > ";: U$(2)=FNGETSTRN$(34)
6640 IF LEN(U$(2))=0 THEN 6670
6645 GOSUB 9860: PRINT" Enter second line of address (RETURN if none)"
6650 PRINT " > ";: U$(3)=FNGETSTRN$(34)
6655 IF LEN(U$(3))=0 THEN 6670
6660 GOSUB 9860: PRINT " Enter third line of address (RETURN if none)"
6665 PRINT " > ";: U$(4)=FNGETSTRN$(34)
6670 GOSUB 9850: RETURN
6700 REM Subroutine to get a RETURN to continue
6705 GOSUB 9860: PRINT " Press RETURN to continue ";
6710 C$=INKEY$: IF LEN(C$)<1 THEN 6710
6715 IF ASC(C$)<>13 THEN BEEP: GOTO 6710
6720 RETURN
6800 REM Subroutine to get a RETURN for printer ready
6805 GOSUB 9860: PRINT " Press RETURN when printer is ready ";
6810 C$=INKEY$: IF LEN(C$)<1 THEN 6810
6815 IF ASC(C$)<>13 THEN BEEP: GOTO 6810
6820 RETURN
6900 REM Subroutine to print bottom of letter for old-age
6905 LPRINT: LPRINT " It is not possible, of course, to tell you ";
6910 LPRINT "the actual monthly benefit"
6915 LPRINT " you will receive. The estimates provided could ";
6920 LPRINT "change--they could"
6925 LPRINT " increase or decrease--depending on your actual ";
6930 LPRINT "future earnings,"
6935 LPRINT " future changes in the average wages of all employed";
6940 LPRINT " persons, and on"
6945 LPRINT " future rates of inflation. (The above estimates ";
6950 LPRINT "assume that, on"
6955 LPRINT " average, the annual increase in average wages in ";
6960 LPRINT "the economy will": IF T3=6 THEN 6975
6965 LPRINT " exceed the annual increase in prices by about 1 ";
6970 LPRINT "percent.)": RETURN
6975 LPRINT " be about 4 percent.)": RETURN
7000 REM Subroutine to write out real-wage-gain adjustment
7005 IF U2<=N4 OR T3<>7 THEN RETURN
7010 LPRINT " Real-wage-gain adjustment for POMS calculation:"
7015 LPRINT USING " Factor = #.##";1!+.01*(U2-N4)
7020 LPRINT USING " PIA after adjustment = ####.##";D(3,S3)
7025 LPRINT USING " MFB after adjustment = ####.##";D(6,S3)
7030 LPRINT: RETURN
7100 REM Subroutine to print bottom of letter for survivors
7105 LPRINT: LPRINT " It is not possible, of course, to tell you ";
7110 LPRINT "the actual monthly benefit"
7115 LPRINT " you will receive. The estimate(s) provided could ";
7120 LPRINT "change--they could"
7125 LPRINT " increase or decrease--depending on the actual ";
7130 LPRINT "future earnings of the"
7135 LPRINT " wage earner, future changes in the average wages of";
7140 LPRINT " all employed"
7145 LPRINT " persons, and on future rates of inflation. (The ";
7150 LPRINT "above estimate(s)"
7155 LPRINT " assume that, on average, the annual increase in ";
7160 LPRINT "average wages in the"
7165 LPRINT " economy will ";: IF T3=6 THEN 7175
7166 LPRINT "exceed the annual increase in prices ";
7170 LPRINT "by about 1 percent.)": RETURN
7175 LPRINT "be about 4 percent.)": RETURN
7200 REM Subroutine to print closeout
7205 LPRINT: LPRINT: LPRINT
7210 LPRINT TAB(40);"Sincerely yours,": RETURN
7300 REM Subroutine to print noninsured message
7305 LPRINT " Warning! Not insured! Has";S2;"QC's, needs";S4;
7310 LPRINT "QC's": RETURN
7400 REM Subroutine to print noninsured paragraph
7405 LPRINT: LPRINT " This estimate is theoretical because the ";
7410 LPRINT "worker is not fully insured."
7415 LPRINT " A total of";S4;"quarters are needed; ";
7416 IF A6=1 THEN LPRINT "he"; ELSE LPRINT "she";
7420 LPRINT " has only";STR$(S2);".": RETURN
7500 REM Subroutine to print bottom of letter for disability
7505 LPRINT: LPRINT " It is not possible, of course, to tell you ";
7510 LPRINT "the actual monthly benefit"
7515 LPRINT " you will receive. The estimate provided could ";
7520 LPRINT "change--it could"
7525 LPRINT " increase or decrease--depending on your actual ";
7530 LPRINT "future earnings,"
7535 LPRINT " future changes in the average wages of all employed";
7540 LPRINT " persons, and on"
7545 LPRINT " future rates of inflation. (The above estimate ";
7550 LPRINT "assumes that, on"
7555 LPRINT " average, the annual increase in average wages in ";
7560 LPRINT "the economy will": IF T3=6 THEN 7575
7565 LPRINT " exceed the annual increase in prices by about 1 ";
7570 LPRINT "percent.)": RETURN
7575 LPRINT " be about 4 percent.)": RETURN
7600 REM Subroutine to print unused earnings warning
7605 LPRINT " Warning! Earnings after";P6+1950;"not used"
7610 RETURN
7700 REM Subroutine to print generic warning
7705 LPRINT: LPRINT " It is not possible, of course, to tell you ";
7710 LPRINT "the actual monthly benefit"
7715 LPRINT " you will receive. The estimate provided could ";
7720 LPRINT "change--it could"
7725 LPRINT " increase or decrease--depending on your actual ";
7730 LPRINT "future earnings,"
7735 LPRINT " future changes in the average wages of all employed";
7740 LPRINT " persons, and on"
7745 LPRINT " future rates of inflation.": RETURN
7800 REM Subroutine to print disability-insured message
7805 LPRINT " Warning! Worker is assumed to be disability-insured."
7810 RETURN
7900 REM Subroutine to print page heading
7905 LPRINT TAB(10);F$(S3);TAB(60);D$(T(13,1));STR$(T(13,2));",";T(13,3)
7910 LPRINT: LPRINT: RETURN
9813 REM For Macintosh, $INCLUDE "COLOR.MAC"
9814 REM $INCLUDE: 'COLOR.BAS'
9900 GOSUB 9860: CLS: END
9999 REM PIAOUT.BAS - 11/03/87 - 02:15 PM