home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / zbasic / pia / oldawbi.bas < prev    next >
BASIC Source File  |  1987-10-30  |  10KB  |  231 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. 600 REM Read titles of assumptions from TITLES.DAT
  7. 605 OPEN "I",1,"TITLES.DAT"
  8. 610 PRINT "   Reading titles of assumptions from TITLES.DAT"
  9. 615 FOR I1=1 TO 4: INPUT #1,E$(I1): NEXT I1
  10. 620 CLOSE #1
  11. 1000 REM Retrieve historical amounts
  12. 1005 OPEN "I",1,"OLDAWBI.DAT"
  13. 1006 PRINT "   Reading historical amounts from OLDAWBI.DAT"
  14. 1008 INPUT #1,N4: N2=N4+15: N6=N2-2
  15. 1010 FOR I1=25 TO N4: INPUT #1,C(2,I1): NEXT I1
  16. 1011 FOR I1=1 TO N6: INPUT #1,B(5,I1): NEXT I1
  17. 1012 FOR I1=1 TO N2: INPUT #1,B(1,I1): NEXT I1
  18. 1013 FOR I1=1 TO N2: INPUT #1,B(4,I1): NEXT I1
  19. 1014 FOR I1=1 TO N2: INPUT #1,B(2,I1): NEXT I1
  20. 1015 CLOSE #1
  21. 1018 REM Print historical amount menu
  22. 1020 CLS: GOSUB 2000: PRINT "   ";: GOSUB 9870
  23. 1025 PRINT STRING$(20," ");"Review or update historical amounts";
  24. 1030 PRINT STRING$(20," "): GOSUB 2000: PRINT: PRINT
  25. 1050 GOSUB 9860: PRINT "   Enter choice for review or update"
  26. 1051 PRINT "     0 to skip review of historical amounts"
  27. 1052 PRINT "     1 to review historical amounts"
  28. 1053 PRINT "     2 to update historical amounts"
  29. 1055 PRINT "   > ";: K8=VAL(FNGETSTRN$(1))
  30. 1060 IF K8<0 OR K8>2 THEN BEEP: GOTO 1050
  31. 1065 ON K8+1 GOTO 1800,1100,1068
  32. 1068 REM print warning
  33. 1070 CLS: GOSUB 2000: PRINT "   ";: GOSUB 9870
  34. 1071 PRINT STRING$(33," ");"Warning!";STRING$(34," "): GOSUB 2000
  35. 1073 PRINT: PRINT: GOSUB 9850: PRINT "   You are about to update the ";
  36. 1074 PRINT "historical amounts necessary to compute Social"
  37. 1075 PRINT "   Security benefits.  This should be done once a year, ";
  38. 1076 PRINT "around November 1,"
  39. 1077 PRINT "   when the new amounts are announced.": PRINT
  40. 1078 PRINT "   If you continue, you will need the average wage for";
  41. 1079 PRINT STR$(1937+N6);", the wage base"
  42. 1080 PRINT "   (and old-law wage base) for";STR$(1937+N2);
  43. 1081 PRINT ", and the benefit increase for Dec";STR$(1951+N4);"."
  44. 1082 PRINT "   You will also need the annual minimum wage for";
  45. 1083 PRINT STR$(1937+N2);"; you can assume that"
  46. 1084 PRINT "   it is the same as for 1987:";STR$(B(2,N2));".": PRINT
  47. 1085 PRINT "   All four sets of projected average wages and benefit ";
  48. 1086 PRINT "increases will be": PRINT "   automatically updated once ";
  49. 1087 PRINT "you have updated the historical amounts.": PRINT
  50. 1088 GOSUB 9860: PRINT "   Do you want to continue? (y or n) > ";
  51. 1089 C$=FNGETSTRN$(1): GOSUB 9850
  52. 1090 IF LEN(C$)<=0 THEN BEEP: GOTO 1088
  53. 1091 GOSUB 2100: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 1088
  54. 1095 IF C$<>"Y" THEN 1800
  55. 1100 REM Display average wages
  56. 1103 FOR K1=1 TO N5: B(0,K1)=B(5,K1): NEXT K1
  57. 1105 G1=1937: G2=1936+N6: GOSUB 2200: GOSUB 2700
  58. 1110 GOSUB 9860: LOCATE 22,33: PRINT " Average wages "
  59. 1115 IF K8<2 THEN 1130
  60. 1120 GOSUB 2300: B(5,N6+1)=B(0,G2+1-1936): G2=G2+1
  61. 1130 GOSUB 2800
  62. 1200 REM Display wage bases
  63. 1203 FOR K1=1 TO N5: B(0,K1)=B(1,K1): NEXT K1
  64. 1205 G1=1937: G2=1936+N2: GOSUB 2200: GOSUB 2700
  65. 1210 GOSUB 9860: LOCATE 22,35: PRINT " Wage bases "
  66. 1215 IF K8<2 THEN 1230
  67. 1220 GOSUB 2300: B(1,N2+1)=B(0,G2+1-1936): G2=G2+1
  68. 1230 GOSUB 2800
  69. 1300 REM Display old-law wage bases
  70. 1303 FOR K1=1 TO N5: B(0,K1)=B(4,K1): NEXT K1
  71. 1305 G1=1937: G2=1936+N2: GOSUB 2200: GOSUB 2700
  72. 1310 GOSUB 9860: LOCATE 22,31: PRINT " Old-law wage bases "
  73. 1315 IF K8<2 THEN 1330
  74. 1320 GOSUB 2300: B(4,N2+1)=B(0,G2+1-1936): G2=G2+1
  75. 1330 GOSUB 2800
  76. 1400 REM Display minimum wages
  77. 1403 FOR K1=1 TO N5: B(0,K1)=B(2,K1): NEXT K1
  78. 1405 G1=1937: G2=1936+N2: GOSUB 2200: GOSUB 2700
  79. 1410 GOSUB 9860: LOCATE 22,33: PRINT " Minimum wages "
  80. 1415 IF K8<2 THEN 1430
  81. 1420 GOSUB 2300: B(2,N2+1)=B(0,G2+1-1936): G2=G2+1
  82. 1430 GOSUB 2800
  83. 1500 REM Display benefit increases
  84. 1503 FOR K1=1 TO N7: B(0,K1)=C(2,K1): NEXT K1
  85. 1505 G1=1975: G2=1950+N4: GOSUB 2200: GOSUB 2900
  86. 1510 GOSUB 9860: LOCATE 22,31: PRINT " Benefit increases "
  87. 1515 IF K8<2 THEN 1530
  88. 1520 GOSUB 2300: C(2,N4+1)=B(0,G2+1-1936): G2=G2+1
  89. 1530 GOSUB 2800
  90. 1550 GOSUB 9860: IF K8<2 THEN 1800
  91. 1600 REM Save to disk
  92. 1605 CLS: GOSUB 2000: PRINT "   ";: GOSUB 9870
  93. 1610 PRINT STRING$(31," ");"Save to disk";STRING$(32," ")
  94. 1615 GOSUB 2000: GOSUB 9860
  95. 1620 PRINT: PRINT: PRINT "   Do you want to save the updated values";
  96. 1625 PRINT " to disk? (y or n) > ";: C$=FNGETSTRN$(1): GOSUB 9850
  97. 1626 IF LEN(C$)<=0 THEN BEEP: GOTO 1620
  98. 1627 GOSUB 2100: IF C$<>"Y" AND C$<>"N" THEN BEEP: GOTO 1620
  99. 1630 IF C$<>"Y" THEN 1800
  100. 1635 OPEN "O",1,"OLDAWBI.DAT"
  101. 1640 PRINT "   Writing historical amounts to OLDAWBI.DAT"
  102. 1645 PRINT #1,N4+1
  103. 1650 FOR I1=25 TO N4+1: PRINT #1,USING "###.#";C(2,I1): NEXT I1
  104. 1655 FOR I1=1 TO N6+1: PRINT #1,USING "######.##";B(5,I1): NEXT I1
  105. 1660 FOR I1=1 TO N2+1: PRINT #1,USING "######.##";B(1,I1): NEXT I1
  106. 1665 FOR I1=1 TO N2+1: PRINT #1,USING "######.##";B(4,I1): NEXT I1
  107. 1670 FOR I1=1 TO N2+1: PRINT #1,USING "######.##";B(2,I1): NEXT I1
  108. 1675 CLOSE #1
  109. 1700 REM Update assumptions
  110. 1701 FOR I1=1 TO 4: IF T6>0 THEN 1776
  111. 1702 CLS: GOSUB 2000: PRINT "   ";: GOSUB 9870
  112. 1704 PRINT STRING$(28," ");"Update assumptions";STRING$(29," ")
  113. 1706 GOSUB 2000: GOSUB 9860
  114. 1710 PRINT: PRINT: PRINT "   Updating assumptions, set";I1
  115. 1712 J$="BI"+CHR$(48+I1)+".DAT": OPEN "I",1,J$
  116. 1714 INPUT #1,K1: IF K1=1951+N4 THEN 1722
  117. 1716 GOSUB 9840: PRINT "   Benefit increase assumptions do not start ";
  118. 1718 PRINT "in";1951+N4: PRINT "   Please check assumptions": CLOSE #1
  119. 1720 BEEP: GOSUB 3000: T6=61: GOTO 1776
  120. 1722 FOR K1=N4+1 TO N7: INPUT #1,C(2,K1): NEXT K1
  121. 1724 CLOSE #1: OPEN "O",1,J$
  122. 1726 PRINT #1,1952+N4
  123. 1728 FOR K1=N4+2 TO N7: PRINT #1,USING "###.#";C(2,K1): NEXT K1
  124. 1730 CLOSE #1
  125. 1732 J$="CU"+CHR$(48+I1)+".DAT": OPEN "I",1,J$
  126. 1734 FOR K1=1 TO 8: FOR K2=1 TO 10: INPUT #1,F(K2,K1)
  127. 1736 NEXT K2: NEXT K1: CLOSE #1: OPEN "O",1,J$
  128. 1738 FOR K1=2 TO 8: FOR K2=2 TO 10: PRINT #1,USING "###.#";F(K2,K1)
  129. 1740 NEXT K2: PRINT #1,USING "###.#";0!: NEXT K1
  130. 1742 FOR K2=1 TO 10: PRINT #1,USING "###.#";0!: NEXT K2
  131. 1744 CLOSE #1
  132. 1746 J$="AW"+CHR$(48+I1)+".DAT": OPEN "I",1,J$
  133. 1748 INPUT #1,K1: IF K1=1937+N6 THEN 1756
  134. 1750 GOSUB 9840: PRINT "   Average wage assumptions do not start in";
  135. 1752 PRINT 1937+N6: PRINT "   Please check assumptions": CLOSE #1
  136. 1754 BEEP: GOSUB 3000: T6=62: GOTO 1776
  137. 1756 FOR K1=N6+1 TO N5: INPUT #1,B(6,K1): NEXT K1
  138. 1758 CLOSE #1: OPEN "O",1,J$
  139. 1760 PRINT #1,1938+N6
  140. 1762 FOR K1=N6+2 TO N5: PRINT #1,USING "##.######";B(6,K1): NEXT K1
  141. 1763 CLOSE #1: GOSUB 9860
  142. 1764 IF LEN(E$(I1))>44 THEN 1766
  143. 1765 E$(I1)=E$(I1)+", updated Nov 1,"+STR$(1951+N4)
  144. 1766 PRINT "   Suggested title of assumptions, set";STR$(I1);", is"
  145. 1768 PRINT "   ";E$(I1)
  146. 1770 PRINT "   Press RETURN to accept, or enter new title"
  147. 1772 PRINT "   > ";: E$(0)=FNGETSTRN$(65): GOSUB 9850
  148. 1774 IF LEN(E$(0))>0 THEN E$(I1)=E$(0)
  149. 1776 NEXT I1: IF T6>0 THEN 1800
  150. 1777 OPEN "O",1,"TITLES.DAT"
  151. 1778 PRINT "   Writing titles of assumptions to TITLES.DAT"
  152. 1780 FOR I1=1 TO 4: PRINT #1,CHR$(34);E$(I1);CHR$(34): NEXT I1
  153. 1782 CLOSE #1
  154. 1800 REM Print exit menu
  155. 1805 CLS: GOSUB 2000: PRINT "   ";: GOSUB 9870
  156. 1810 PRINT STRING$(29," ");"Program selection";STRING$(29," ")
  157. 1815 GOSUB 2000: PRINT: PRINT
  158. 1820 GOSUB 9860: PRINT "   Enter desired program:"
  159. 1825 PRINT "     0 to calculate a PIA"
  160. 1826 PRINT "     1 to review or change configuration"
  161. 1830 PRINT "     2 to store social security office address"
  162. 1835 PRINT "   > ";: K8=VAL(FNGETSTRN$(1))
  163. 1840 IF K8<0 OR K8>2 THEN BEEP: GOTO 1820
  164. 1845 CLS: GOSUB 9850: ON K8+1 GOTO 1900,1860,1850
  165. 1850 PRINT "   Loading address program; please wait..."
  166. 1855 CHAIN "ADDRESS"
  167. 1860 PRINT "   Loading configuration program; please wait..."
  168. 1865 CHAIN "CONFIG"
  169. 1900 PRINT "   Loading PIA data-input program; please wait..."
  170. 1905 CHAIN "PIAIN"
  171. 2000 REM Subroutine to draw 75 hyphens
  172. 2005 GOSUB 9860: PRINT "   ";STRING$(75,"-"): RETURN
  173. 2100 REM Subroutine to convert response to one-letter uppercase
  174. 2105 I4=ASC(C$): IF I4>96 THEN C$=CHR$(I4-32) ELSE C$=CHR$(I4)
  175. 2110 RETURN
  176. 2200 REM Subroutine to prepare screen for data
  177. 2205 K4=G1: GOSUB 9820: CLS: I3=1: LOCATE 2,1
  178. 2215 FOR K1=1 TO 20: FOR K2=1 TO 3: GOSUB 9870: IF I3=1 THEN 2230
  179. 2226 PRINT STRING$(13," ");: GOSUB 9860: GOTO 2245
  180. 2230 PRINT "      ";K4;" ";
  181. 2235 IF K1 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9863
  182. 2245 PRINT STRING$(11," ");
  183. 2255 K4=K4+20: IF K4<=G2 THEN I3=1 ELSE I3=0
  184. 2260 NEXT K2: PRINT
  185. 2280 K4=K4-59: IF K4<=G2 THEN I3=1 ELSE I3=0
  186. 2285 NEXT K1: GOSUB 2600: RETURN
  187. 2300 REM Subroutine to request new value
  188. 2305 GOSUB 9860: LOCATE 23,10
  189. 2310 PRINT "Please enter new value"
  190. 2320 U7=((G2-G1+1) MOD 20)+1: U6=(G2-G1+2-U7)/20
  191. 2325 U6=1+24*U6: LOCATE U7+1,U6: GOSUB 9870: PRINT "      ";G2+1;" ";
  192. 2330 IF U7 MOD 2=0 THEN GOSUB 9864 ELSE GOSUB 9860
  193. 2335 PRINT ">";STRING$(10," ");
  194. 2337 LOCATE U7+1,U6+14: B(0,G2+1-1936)=VAL(FNWGETSTRN$(9))
  195. 2340 LOCATE U7+1,U6+13: PRINT USING " ######.## ";B(0,G2+1-1936)
  196. 2345 RETURN
  197. 2600 REM Subroutine to blank message window
  198. 2605 GOSUB 9860
  199. 2610 LOCATE 23,8: PRINT STRING$(65," ");
  200. 2615 LOCATE 24,8: PRINT STRING$(65," ");
  201. 2620 RETURN
  202. 2700 REM Subroutine to put amounts on screen
  203. 2705 U6=14: U7=1: FOR K1=G1 TO G2
  204. 2715 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864
  205. 2720 LOCATE U7+1,U6: PRINT USING " ######.## ";B(0,K1-1936)
  206. 2725 U7=U7+1: IF U7>20 THEN U6=U6+24: U7=1
  207. 2730 NEXT K1: RETURN
  208. 2800 REM Subroutine to print continue message
  209. 2805 GOSUB 9860: LOCATE 23,10
  210. 2810 PRINT "Press RETURN to continue";
  211. 2815 C$=INKEY$: IF LEN(C$)<1 THEN 2815
  212. 2820 IF ASC(C$)<>13 THEN BEEP: GOTO 2815
  213. 2825 RETURN
  214. 2900 REM Subroutine to put benefit increases on screen
  215. 2905 U6=14: U7=1: FOR K1=G1 TO G2
  216. 2915 IF U7 MOD 2=1 THEN GOSUB 9860 ELSE GOSUB 9864
  217. 2920 LOCATE U7+1,U6: PRINT USING "  #####.## ";B(0,K1-1950)
  218. 2925 U7=U7+1: IF U7>20 THEN U6=U6+24: U7=1
  219. 2930 NEXT K1: RETURN
  220. 3000 REM Subroutine to print RETURN message
  221. 3005 GOSUB 9860: PRINT
  222. 3010 PRINT "   Press RETURN to continue";
  223. 3015 C$=INKEY$: IF LEN(C$)<1 THEN 3015
  224. 3020 IF ASC(C$)<>13 THEN BEEP: GOTO 3015
  225. 3025 RETURN
  226. 9800 REM 1-line subroutines
  227. 9813 REM For Macintosh, $INCLUDE "COLOR.MAC"
  228. 9814 REM $INCLUDE: 'COLOR.BAS'
  229. 9900 GOSUB 9860: CLS: END
  230. 9999 REM OLDAWBI.BAS - 10/30/87 - 03:45 PM
  231.