Category : BASIC Source Code
Archive   : PIA88SRC.ZIP
Filename : PIA88.BAS

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'
130 DIM A(2,6),B(7,114),C(4,100),D(9,6),F(10,8),G(6,114),H(3,6),I(114)
131 DIM J(2,51),K(8,2),L(6,114),O(114),Q(8,4),T(13,3),V(4,6),Z(486)
132 DIM A$(2),D$(12),E$(8),F$(6),G$(10),H$(7),K$(7),N$(3),P$(3),Q$(4)
133 DIM R$(2),T$(4),U$(4),W$(8),X$(2)
134 REM For Macintosh, $INCLUDE "FONTS.MAC"
135 N5=114: N7=N5-14: W3=8
136 A$(1)="Male": N$(1)="Young survivor (child or parent of child)"
137 N$(2)="Disabled widow (aged 50-59)": A$(2)="Female"
140 N$(3)="Aged widow (aged 60 or over)"
145 H$(1)="1939": H$(2)="1950": H$(3)="1950": H$(4)="1965"
150 H$(5)="1967": H$(6)="1977": H$(7)="1977"
155 K$(2)="1950 Conversion Table": K$(3)="1958 Conversion Table"
160 K$(6)="Pre-1977 PIA Table": K$(7)="December 1978 PIA Table"
165 P$(1)="old age": P$(2)="survivor": P$(3)="disability"
170 Q$(1)="year-by-year earnings entered from keyboard"
175 Q$(2)="maximum earnings": Q$(3)="average earnings"
180 Q$(4)="2080 hours at Federal minimum wage"
185 R$(1)="automatic provisions followed"
190 R$(2)="ad hoc wage bases (entered by user)"
195 DATA "1952","1954","1958","1965","1967","1969","1971","1972"
200 DATA "1973","1974"
205 FOR I1=1 TO 10: READ G$(I1): NEXT I1
210 DATA "January","February","March","April","May","June","July"
215 DATA "August","September","October","November","December"
220 FOR I1=1 TO 12: READ D$(I1): NEXT I1
230 F$(1)="Old-Start Calculation"
235 F$(2)="New-Start Calculation (pre-1977 Act)"
240 F$(3)="Wage-Indexed Formula (1977 Act)"
245 F$(4)="Transitional Guarantee (1977 Act)"
250 F$(5)="Special Minimum": F$(6)="Re-Indexed Widow (1983 Act)"
255 X$(1)="no prior disability"
260 X$(2)="disability immediately prior to entitlement"
265 K(0,0)=1: K(0,1)=1: REM Blue on blue (data entry)
270 K(1,0)=10: K(1,1)=0: REM Green (responses)
275 K(2,0)=12: K(2,1)=0: REM Red (errors)
280 K(3,0)=14: K(3,1)=0: REM Yellow (help screens)
285 K(4,0)=3: K(4,1)=0: REM Cyan (help screens)
290 K(5,0)=15: K(5,1)=0: REM White (requested actions)
295 K(6,0)=15: K(6,1)=7: REM White on white
300 K(7,0)=15: K(7,1)=2: REM White on green
305 K(8,0)=14: K(8,1)=1: REM Yellow on blue (titles)
490 REM Set initial colors
495 FOR I1=0 TO 8: K(I1,2)=7: NEXT I1
500 REM Get configuration
505 GOSUB 5000
510 REM Initialize colors
515 GOSUB 5100
1000 REM Print copyright page
1005 GOSUB 9854: CLS: PRINT: PRINT: PRINT: PRINT
1010 PRINT TAB(21);"Social Security PIA Calculation Program"
1015 PRINT: PRINT TAB(34);"version 1988.1"
1017 PRINT: PRINT TAB(34);"October 1987": PRINT: PRINT
1020 PRINT TAB(29);"Office of the Actuary"
1025 PRINT TAB(25);"Social Security Administration"
1030 PRINT: PRINT: PRINT
1035 PRINT TAB(3);"Part of this software was created using the ";
1040 PRINT "QuickBASIC Compiler."
1045 PRINT TAB(3);"Portions of this Code are (C) Copyrighted, ";
1050 PRINT "1987 by Microsoft Corp."
1054 V8=TIMER
1055 IF TIMER-V8<3! THEN 1055
1100 REM Print first page of help
1105 CLS: GOSUB 2000: PRINT " ";: GOSUB 9870
1110 PRINT " Social Security PIA Calculation Program, ";
1115 PRINT "version 1988.1 "
1120 GOSUB 2000: PRINT: GOSUB 9854
1125 PRINT " This program calculates the Primary Insurance Amount ";
1130 PRINT "(PIA), Maximum"
1135 PRINT " Family Benefit (MFB), and ";
1140 PRINT "Monthly Benefit Amount (MBA) for most cases of"
1145 PRINT " Social Security";
1150 PRINT " benefits. The following are specifically considered:"
1155 PRINT " 1. Old-age, survivors, or disability benefits."
1160 PRINT " 2. All PIA calculations (except as noted below)."
1165 PRINT " 3. All amendments to the law through 1987."
1170 PRINT " 4. Projected benefits through 2050.": PRINT
1175 PRINT " The following are some of the limitations:"
1180 PRINT " 1. Some approximations are made for pre-1965 benefits";
1185 PRINT " and the"
1190 PRINT " frozen minimum PIA."
1195 PRINT " 2. Any disability-insured status requirement is ";
1200 PRINT "assumed to be met."
1205 PRINT " 3. Prior closed periods of disability are not ";
1210 PRINT "considered.": PRINT
1215 PRINT " The source program is not copyrighted. Distribution is";
1220 PRINT " encouraged, with"
1225 PRINT " acknowledgment to the Social Security ";
1230 PRINT "Administration, Office of the"
1235 PRINT " Actuary.": GOSUB 2200
1300 REM Print second page of help
1305 CLS: GOSUB 2000: PRINT " ";: GOSUB 9870
1310 PRINT STRING$(28," ");"Running the Program";STRING$(28," ")
1320 GOSUB 2000: PRINT: GOSUB 9854
1325 PRINT " This program is executed by answering the prompts which";
1330 PRINT " appear on the"
1335 PRINT " following screens. Each prompt";
1340 PRINT " should be answered with the requested"
1345 PRINT " data and then ";
1350 PRINT "the RETURN key. When entering numbers, use the number"
1355 PRINT " keys across the top of the keyboard.": PRINT
1360 PRINT " If more than one number is in a single response, the ";
1365 PRINT "numbers should be"
1370 PRINT " separated by slashes. Months and days should be ";
1375 PRINT "entered as 2 digits"
1376 PRINT " (e.g. March 7 would be 03/07). Years may be entered ";
1380 PRINT "as 4 digits, or as"
1385 PRINT " the last 2 digits only if in the 1900's.": PRINT
1390 PRINT " In order to use this program, you must have your Social ";
1395 PRINT "Security earn-"
1396 PRINT " ings record showing earnings for each year, and the ";
1397 PRINT "total number of"
1400 PRINT " quarters of coverage acquired to date."
1405 PRINT
1410 PRINT " Press Ctrl-Break at any time to stop the program."
1415 GOSUB 2200
1800 REM Print menu for next program to run
1805 CLS: GOSUB 2000: PRINT " ";: GOSUB 9870
1810 PRINT STRING$(32," ");"Data Setup";STRING$(33," ")
1815 GOSUB 2000: PRINT: PRINT
1820 GOSUB 9860: PRINT " Enter choice:"
1825 PRINT " 0 to calculate a PIA"
1827 PRINT " 1 to review or change configuration"
1830 PRINT " 2 to review or update historical amounts"
1835 PRINT " 3 to store social security office address"
1840 PRINT " > ";: K8=VAL(FNGETSTRN$(1))
1845 IF K8<0 OR K8>3 THEN BEEP: GOTO 1820
1850 CLS: GOSUB 9850: ON K8+1 GOTO 1855,1865,1875,1885
1855 PRINT " Loading PIA data-input program; please wait..."
1860 CHAIN "PIAIN"
1865 PRINT " Loading configuration program; please wait..."
1870 CHAIN "CONFIG"
1875 PRINT " Loading data-update program; please wait..."
1880 CHAIN "OLDAWBI"
1885 PRINT " Loading address program; please wait..."
1890 CHAIN "ADDRESS"
2000 REM Subroutine to draw 75 hyphens
2005 GOSUB 9860: PRINT " ";STRING$(75,"-"): RETURN
2200 REM Subroutine to get a RETURN
2205 PRINT: GOSUB 9860
2210 PRINT TAB(25);"(press RETURN to continue)";: GOSUB 9854
2215 C$=INKEY$: IF LEN(C$)<1 THEN 2215
2220 IF ASC(C$)<>13 THEN BEEP: GOTO 2215
2225 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 initialize colors
5105 FOR I1=0 TO 8
5110 IF K5>0 THEN K(I1,2)=K(I1,0) ELSE K(I1,2)=7
5115 NEXT I1: RETURN
9813 REM For Macintosh, $INCLUDE "COLOR.MAC"
9814 REM $INCLUDE: 'COLOR.BAS'
9900 GOSUB 9860: CLS: END
9999 REM PIA88.BAS - 10/30/87 - 3:15 PM