home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug045.ark / P_R100.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  8.3 KB  |  252 lines
  1.     REMARK    *************************************\
  2.         *   P/R100.BAS  PAYROLL CALCULATE   *\
  3.         *   5/14/79              12:50 P.M. *\
  4.         *************************************
  5.  
  6. %INCLUDE CURSOR
  7.     REMARK THE NUMBERS IN THE FOLLOWING DATA STATEMENTS ARE FROM
  8.     REMARK CALIFORNIA'S "EMPLOYER'S TAX GUIDE" (METHOD C) FOR 1979  PP. 46-47
  9.  
  10.     RESTORE
  11.     DATA "REGULAR","NEW MONTH","NEW QUARTER","NEW YEAR",5000,10000    REMARK TABLE A
  12.     DATA 750                            REMARK TABLE C
  13.     DATA 1000,2000,2100,4200,4210,1580,3160,2100,1580,3160,1580    REMARK TABLE E
  14.     DATA 0,25,33,8,0,25,50,8,1570,3140,1570                REMARK TABLE D & TABLE E (STEP 10)
  15.  
  16.     DIM F1$(2),F1(36),S1$(2),S1(32),S(96),R2(5),G3(5),R1(2),T2(8),\
  17.     G2$(5),R$(5)
  18.     DEF FNR(Z1)=INT(Z1*100+.5)/100                    REMARK  ROUNDING FUNCTION
  19.     GOTO 6000
  20. %INCLUDE SUBS1
  21. %INCLUDE GENINFO
  22. %INCLUDE MSTRIN
  23. %INCLUDE MSTROUT
  24.  
  25.  
  26. 4150    IF STATE.TAXABLE.PAY<X THEN X=0\                REMARK  DEDUCT AMOUNT X FROM STATE TAXABLE PAY
  27.     ELSE\
  28.     STATE.TAXABLE.PAY=STATE.TAXABLE.PAY-X:\
  29.     DEDUCTION.AMOUNT=DEDUCTION.AMOUNT+STATE.TAXABLE.PAY
  30.     RETURN
  31.  
  32.  
  33.  
  34. 4200    DEDUCTION.AMOUNT=FNR(DEDUCTION.AMOUNT)                REMARK  DEDUCT TAX SUBJECT TO TAXABLE PAY
  35.     IF DEDUCTION.AMOUNT < 0 THEN DEDUCTION.AMOUNT=0
  36.     IF DEDUCTION.AMOUNT > GROSS.PAY THEN DEDUCTION.AMOUNT=GROSS.PAY
  37.     GROSS.PAY=GROSS.PAY - DEDUCTION.AMOUNT
  38.     S(A1)=S(A1) + DEDUCTION.AMOUNT                    REMARK  ADD DEDUCTION AND ACCUMULATE TO TOTALS
  39.     S(90)=S(90) + DEDUCTION.AMOUNT
  40.     RETURN
  41.  
  42.  
  43.  
  44. 5300    FOR I2%=2 TO 7                            REMARK  ROUTINE TO WITHHOLD FEDERAL INCOME TAX
  45.     X1%=(I2%*2)+(I5*15)-9
  46.  
  47.     IF ANNUAL.PAY <= F1(X1%-1) THEN 5345                REMARK  IF ANNUAL PAY IS TOO LOW FOR TAX, JUMP OUT
  48.  
  49.     IF ANNUAL.PAY <= F1(X1%+1) THEN\
  50.     DEDUCTION.AMOUNT=\
  51.     DEDUCTION.AMOUNT+(ANNUAL.PAY-F1(X1%-1))*F1(X1%-2)/10000:\
  52.     GOTO 5345\
  53.     ELSE\
  54.     DEDUCTION.AMOUNT=\
  55.     DEDUCTION.AMOUNT+(F1(X1%+1)-F1(X1%-1))*F1(X1%-2)/10000
  56.  
  57. 5340    NEXT I2%
  58.  
  59.     DEDUCTION.AMOUNT=\
  60.     DEDUCTION.AMOUNT+(ANNUAL.PAY-F1(X1%+1))*F1(X1%)/10000
  61.  
  62. 5345    DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/PAY.PERIODS
  63.     A1=85:GOSUB 4200
  64.     RETURN
  65.  
  66.  
  67.  
  68. 6000    PRINT CLEAR.SCREEN$;"P/R CALCULATE"                REMARK  DISPLAY PROGRAM I.D. AND ENTRY MASK
  69.     PRINT "ENTER START EMPLOYEE OF ZERO TO EXIT"
  70.     PRINT
  71.     PRINT
  72.     PRINT "START EMPLOYEE NUMBER"
  73.     PRINT "END EMPLOYEE NUMBER"
  74.     PRINT "PERIOD END DATE"
  75.  
  76.  
  77.     Y9=10:OPEN "G/I0F010.DAT" RECL 200 AS Y9:GOSUB 700        REMARK  OPEN AND READ GENERAL INFORMATION FILE
  78.     Y6=3
  79.     Y7=4
  80.  
  81.     Z=INT(G3(3) / 10000)                        REMARK  DETERMINE IF MONTHLY OR QUARTERLY PAYROLL
  82.     IF G3(4) <> 1 THEN P1=1    ELSE P1=2                REMARK  IF NOT NEW MONTH, SET 'REGULAR PAYROLL' FLAG
  83.     IF INT((Z-1)/3)=(Z-1)/3 THEN P1=3
  84.     IF Z=1 THEN P1=4
  85. 6030    X1=403:X0=G3(3):GOSUB 680                    REMARK  DISPLAY PERIOD END DATE
  86.     RESTORE
  87.     FOR I2%=1 TO P1
  88.     READ X0$                            REMARK  READ PAYROLL DESCRIPTIONS FROM TABLE
  89.     NEXT I2%
  90.     PRINT "  ";X0$;" PAYROLL"
  91.     OPEN "P/R0F110.DAT" RECL 1150 AS 1                REMARK  OPEN EMPLOYEE MASTER FILE
  92. 6040    X1=279:X2=3:X3=0:X4=999:GOSUB 345                REMARK  ENTER START EMPLOYEE NUMBER
  93.     IF X0=0 THEN 7000                        REMARK  IF START EMPLOYEE NUMBER=0, END PROGRAM
  94.     E1=X0
  95.  
  96.     X1=343:X2=3:X3=E1:X4=999:GOSUB 345                REMARK  ENTER END EMPLOYEE NUMBER
  97.     E2=X0
  98.     IF E2 > MSTR.RECORDS THEN E2 = MSTR.RECORDS
  99.  
  100.     X2 = 1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK  VERIFY ENTRY: '1'=O.K.; '0'=RETRY
  101.     IF X0 <> 1 THEN 6040
  102.     X1=64:GOSUB 210
  103.     PRINT "WORKING...DO NOT INTERRUPT"
  104.  
  105.     OPEN "P/R0F060.DAT" AS Y6                    REMARK  OPEN AND READ FEDERAL TAX FILE
  106.     READ #Y6;F1(1),F1(2),F1(3),F1(4),F1(5),F1(6),F1(7),F1(8),F1(9),\
  107.     F1(10),F1(11),F1(12),F1(13),F1(14),F1(15),F1(16),F1(17),F1(18),\
  108.     F1(19),F1(20),F1(21),F1(22),F1(23),F1(24),F1(25),F1(26),F1(27),\
  109.     F1(28),F1(29),F1(30),F1(31),F1(32),F1(33),F1(34),F1(35),F1(36)
  110.  
  111.     OPEN "P/R0F070.DAT" AS Y7                    REMARK  OPEN AND READ STATE TAX FILE
  112.     READ #Y7;S1$,S1(1),S1(2),S1(3),S1(4),S1(5),S1(6),S1(7),S1(8)
  113.  
  114.     RESTORE                                REMARK  READ STATE TAX TABLES FROM DATA STATEMENT
  115.     FOR I2%=1 TO 4:READ X0$:NEXT I2%
  116.     FOR I2%=8 TO 32
  117.     READ S1(I2%)
  118.     NEXT I2%
  119.  
  120.  
  121. 6100    FOR INDEX = E1 TO E2                        REMARK  PROCESS EMPLOYEE RANGE
  122.     X0=INDEX
  123.     GOSUB 745                            REMARK  READ EMPLOYEE MASTER RECORD
  124.     IF S(1) = 0 THEN GOTO 6365                    REMARK  IF RECORD IS DELETED, SKIP PROCESSING
  125.  
  126.     
  127.  
  128.     IF P1=4 THEN\                            REMARK  ZERO OUT YEARLY TOTALS
  129.     FOR I2%=25 TO 48:\
  130.     S(I2%)=0:\
  131.     NEXT I2%:\
  132.     S(15)=0
  133.  
  134.  
  135.     IF P1=3 OR P1=4\
  136.     THEN\
  137.     FOR I2%=49 TO 72:\                        REMARK  RESET QUARTERLY TOTALS
  138.     S(I2%)=0:\
  139.     NEXT I2%
  140.  
  141.     IF P1=2 OR P1=3 OR P1=4 THEN S(6)=0:S(7)=0:S(10)=0        REMARK  RESET MONTHLY TOTALS
  142.  
  143.  
  144. 6130    IF S(5) <> 0 OR R2(1)=99\                    REMARK  IF CHECK NUMBER <> 0 OR EMPLOYEE INACTIVE,
  145.     THEN\                                        SKIP PROCESSING
  146.     FOR I2%=73 TO 90:\
  147.     S(I2%)=0:\
  148.     NEXT I2%:GOTO 6360
  149.  
  150.  
  151.     IF R2(1) = 1 THEN A1=S(80) ELSE A1=0                REMARK  CALCULATE HEALTH AND WELFARE PAY
  152.  
  153. 6146    S(79)=FNR((S(73)+S(75)+A1)*S(9))                REMARK  CALCULATE GROSS PAY AND TAXABLE PAY
  154.     S(83)=S(74)+S(76)+S(78)+S(79)+S(81)+S(82)
  155.     GROSS.PAY=S(83)
  156.     IF GROSS.PAY=0 THEN 6360
  157.     TAXABLE.PAY=GROSS.PAY-S(84)
  158.  
  159.     IF R3$="S" THEN I1=1                        REMARK  SET TAX LEVEL POINTER BASED ON MARITAL STATUS
  160.     IF R3$="M" THEN I1=2
  161.     IF R3$="H" THEN I1=3
  162. 6165    PAY.PERIODS=26
  163.  
  164. 6170    I5=I1-INT(I1/3)*2
  165.     ANNUAL.PAY=TAXABLE.PAY*PAY.PERIODS - F1(I5*15-8)*R2(2)
  166.     DEDUCTION.AMOUNT=0
  167.     GOSUB 5300                            REMARK  CALCULATE AND WITHHOLD FEDERAL INCOME TAX
  168.  
  169.     DEDUCTION.AMOUNT=S(35)-S(36)+TAXABLE.PAY            REMARK  CALCULATE AND WITHHOLD FICA TAX
  170.     IF DEDUCTION.AMOUNT-TAXABLE.PAY > F1(6) THEN\
  171.     DEDUCTION.AMOUNT=F1(5)*F1(6)-S(39)*10000\
  172.     ELSE\
  173.     DEDUCTION.AMOUNT=TAXABLE.PAY*F1(5)
  174. 6210    DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/10000
  175.     A1=87:GOSUB 4200
  176.  
  177.  
  178. 6215    STATE.TAXABLE.PAY=TAXABLE.PAY*PAY.PERIODS            REMARK  CALCULATE AND WITHHOLD STATE INCOME TAX
  179.     DEDUCTION.AMOUNT=0
  180.     IF I1=1 THEN I5=1                        REMARK  SET TAX CUTOFF POINTER
  181.     IF I1=3 OR R2(3) >=2 THEN I5=2
  182.  
  183. 6235    IF STATE.TAXABLE.PAY <= S1(I5+7) THEN 6290
  184.     IF R2(4)>0 THEN\
  185.     STATE.TAXABLE.PAY=STATE.TAXABLE.PAY-FNR(R2(4)*S1(10))        REMARK  DEDUCT ADDITIONAL STATE EXEMPTIONS
  186.     X=S1(I5+10):GOSUB 4150
  187.     IF X>0 THEN X=S1(I1+12):GOSUB 4150 ELSE GOTO 6275
  188.     IF X>0 THEN X=S1(I1+15):GOSUB 4150 ELSE GOTO 6275
  189.     IF X>0 THEN I=0 ELSE GOTO 6275
  190. 6265    X=S1(I1+18):GOSUB 4150
  191.     IF X>0 THEN I=I+1 ELSE GOTO 6275
  192.     IF I<4 THEN 6265
  193.     X=S1(I1+29):GOSUB 4150
  194.     IF X>0 THEN I=0 ELSE GOTO 6275
  195. 6270    X=S1(I1+18):GOSUB 4150
  196.     IF X>0 THEN I=I+1 ELSE GOTO 6275
  197.     IF I<3 THEN 6270
  198. 6275    DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/100
  199.     X=22 + SGN(I1-1)*4+R2(3)
  200.     A1=0
  201.     IF R2(3)>=3 THEN X=X-R2(3)+2:A1=R2(3)-2
  202. 6283    DEDUCTION.AMOUNT=DEDUCTION.AMOUNT-S1(X)-A1*S1(SGN(I1-1)*4+25)
  203.     DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/PAY.PERIODS
  204.     A1=86:GOSUB 4200                        REMARK  DEDUCT WITHHOLDING AMOUNT FROM EMPLOYEE
  205.  
  206. 6290    DEDUCTION.AMOUNT=S(35)-S(36)+TAXABLE.PAY            REMARK  CALCULATE AND WITHHOLD SDI TAX
  207.     IF DEDUCTION.AMOUNT-TAXABLE.PAY>S1(4) THEN 6320            REMARK  IF PAST SDI CUTOFF, DO NOT DEDUCT IT
  208.  
  209.     IF DEDUCTION.AMOUNT < S1(4) THEN\                REMARK  IF CUTOFF NOT REACHED, DEDUCT SDI NORMALLY
  210.     DEDUCTION.AMOUNT=TAXABLE.PAY*S1(3):GOTO 6315
  211.  
  212. 6310    DEDUCTION.AMOUNT=S1(4)*S1(3)-S(40)*10000            REMARK  CALCULATE REMAINING SDI IF PART OF THIS CHECK\
  213.                                             IS SUBJECT TO A DEDUCTION
  214. 6315    DEDUCTION.AMOUNT = DEDUCTION.AMOUNT/10000            REMARK  DEDUCT SDI TAX FROM TAXABLE PAY
  215.     A1=88:GOSUB 4200
  216.  
  217.  
  218. 6320    FOR I2%=73 TO 90                            REMARK  ACCUMULATE ALL DEDUCTIONS FROM Y-T-D AND Q-T-D
  219.     S(I2%-24) = S(I2%-24) + S(I2%)
  220.     S(I2%-48)=S(I2%-48) + S(I2%)
  221.     NEXT I2%
  222.  
  223.     S(6)=S(6)+S(73)+S(75)+S(77)+S(80)                REMARK  ACCUMULATE TO MONTHLY HOURS
  224.  
  225.  
  226. 6323    IF R2(1)<> 1 THEN X0=80 ELSE X0=1
  227.     X0 = S(76) - FNR(S(8)/X0*S(75))                    REMARK  WITH O/T PAY AND CORPORATE OFFICER PAY
  228. 6325    IF R2(5) <>1 THEN 6330                        REMARK  ABOVE $1733.00 EXCLUDABLE
  229.     IF S(7) + TAXABLE.PAY - X0 <1733 THEN 6330
  230.     S(10) = S(10) + TAXABLE.PAY - X0
  231.     IF S(7)>1733 THEN 6330
  232.     S(10) = S(10) + S(7) - 1733
  233.  
  234.  
  235. 6330    S(7) = S(7) + TAXABLE.PAY                    REMARK  ACCUMULATE MONTHLY PAY
  236. 6340    S(10) = S(10) + X0                        REMARK  ACCUMULATE INSURANCE REPORT EXCLUDABLE AMOUNT
  237.  
  238.     S(4)=G3(3)                            REMARK  SET CHECK DATE AT PERIOD END DATE
  239.  
  240.     S(5)=G2                                REMARK  ASSIGN CHECK NUMBER TO EMPLOYEE
  241.  
  242.     G2=G2+1                                REMARK  INCREMENT NEXT CHECK NUMBER
  243.     IF G2>999999 THEN G2=1                        REMARK  'ROLL' CHECK NUMBER IF MORE THAN SIX DIGITS
  244.  
  245. 6360    X0=INDEX:GOSUB 750                        REMARK  WRITE OUT THE CALCULATED RECORD
  246.  
  247. 6365    NEXT INDEX
  248.  
  249. 6370    GOSUB 720
  250. 7000    PRINT CLEAR.SCREEN$;"P/R CALCULATE LOADING MENU"        REMARK  TERMINATE PROGRAM AND LOAD MENU
  251.     CHAIN "P/R000"
  252.