	REMARK	*************************************\
		*   P/R100.BAS  PAYROLL CALCULATE   *\
		*   5/14/79              12:50 P.M. *\
		*************************************

%INCLUDE CURSOR
	REMARK THE NUMBERS IN THE FOLLOWING DATA STATEMENTS ARE FROM
	REMARK CALIFORNIA'S "EMPLOYER'S TAX GUIDE" (METHOD C) FOR 1979  PP. 46-47

	RESTORE
	DATA "REGULAR","NEW MONTH","NEW QUARTER","NEW YEAR",5000,10000	REMARK TABLE A
	DATA 750							REMARK TABLE C
	DATA 1000,2000,2100,4200,4210,1580,3160,2100,1580,3160,1580	REMARK TABLE E
	DATA 0,25,33,8,0,25,50,8,1570,3140,1570				REMARK TABLE D & TABLE E (STEP 10)

	DIM F1$(2),F1(36),S1$(2),S1(32),S(96),R2(5),G3(5),R1(2),T2(8),\
	G2$(5),R$(5)
	DEF FNR(Z1)=INT(Z1*100+.5)/100					REMARK  ROUNDING FUNCTION
	GOTO 6000
%INCLUDE SUBS1
%INCLUDE GENINFO
%INCLUDE MSTRIN
%INCLUDE MSTROUT


4150	IF STATE.TAXABLE.PAY<X THEN X=0\				REMARK  DEDUCT AMOUNT X FROM STATE TAXABLE PAY
	ELSE\
	STATE.TAXABLE.PAY=STATE.TAXABLE.PAY-X:\
	DEDUCTION.AMOUNT=DEDUCTION.AMOUNT+STATE.TAXABLE.PAY
	RETURN



4200	DEDUCTION.AMOUNT=FNR(DEDUCTION.AMOUNT)				REMARK  DEDUCT TAX SUBJECT TO TAXABLE PAY
	IF DEDUCTION.AMOUNT < 0 THEN DEDUCTION.AMOUNT=0
	IF DEDUCTION.AMOUNT > GROSS.PAY THEN DEDUCTION.AMOUNT=GROSS.PAY
	GROSS.PAY=GROSS.PAY - DEDUCTION.AMOUNT
	S(A1)=S(A1) + DEDUCTION.AMOUNT					REMARK  ADD DEDUCTION AND ACCUMULATE TO TOTALS
	S(90)=S(90) + DEDUCTION.AMOUNT
	RETURN



5300	FOR I2%=2 TO 7							REMARK  ROUTINE TO WITHHOLD FEDERAL INCOME TAX
	X1%=(I2%*2)+(I5*15)-9

	IF ANNUAL.PAY <= F1(X1%-1) THEN 5345				REMARK  IF ANNUAL PAY IS TOO LOW FOR TAX, JUMP OUT

	IF ANNUAL.PAY <= F1(X1%+1) THEN\
	DEDUCTION.AMOUNT=\
	DEDUCTION.AMOUNT+(ANNUAL.PAY-F1(X1%-1))*F1(X1%-2)/10000:\
	GOTO 5345\
	ELSE\
	DEDUCTION.AMOUNT=\
	DEDUCTION.AMOUNT+(F1(X1%+1)-F1(X1%-1))*F1(X1%-2)/10000

5340	NEXT I2%

	DEDUCTION.AMOUNT=\
	DEDUCTION.AMOUNT+(ANNUAL.PAY-F1(X1%+1))*F1(X1%)/10000

5345	DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/PAY.PERIODS
	A1=85:GOSUB 4200
	RETURN



6000	PRINT CLEAR.SCREEN$;"P/R CALCULATE"				REMARK  DISPLAY PROGRAM I.D. AND ENTRY MASK
	PRINT "ENTER START EMPLOYEE OF ZERO TO EXIT"
	PRINT
	PRINT
	PRINT "START EMPLOYEE NUMBER"
	PRINT "END EMPLOYEE NUMBER"
	PRINT "PERIOD END DATE"


	Y9=10:OPEN "G/I0F010.DAT" RECL 200 AS Y9:GOSUB 700		REMARK  OPEN AND READ GENERAL INFORMATION FILE
	Y6=3
	Y7=4

	Z=INT(G3(3) / 10000)						REMARK  DETERMINE IF MONTHLY OR QUARTERLY PAYROLL
	IF G3(4) <> 1 THEN P1=1	ELSE P1=2				REMARK  IF NOT NEW MONTH, SET 'REGULAR PAYROLL' FLAG
	IF INT((Z-1)/3)=(Z-1)/3 THEN P1=3
	IF Z=1 THEN P1=4
6030	X1=403:X0=G3(3):GOSUB 680					REMARK  DISPLAY PERIOD END DATE
	RESTORE
	FOR I2%=1 TO P1
	READ X0$							REMARK  READ PAYROLL DESCRIPTIONS FROM TABLE
	NEXT I2%
	PRINT "  ";X0$;" PAYROLL"
	OPEN "P/R0F110.DAT" RECL 1150 AS 1				REMARK  OPEN EMPLOYEE MASTER FILE
6040	X1=279:X2=3:X3=0:X4=999:GOSUB 345				REMARK  ENTER START EMPLOYEE NUMBER
	IF X0=0 THEN 7000						REMARK  IF START EMPLOYEE NUMBER=0, END PROGRAM
	E1=X0

	X1=343:X2=3:X3=E1:X4=999:GOSUB 345				REMARK  ENTER END EMPLOYEE NUMBER
	E2=X0
	IF E2 > MSTR.RECORDS THEN E2 = MSTR.RECORDS

	X2 = 1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665			REMARK  VERIFY ENTRY: '1'=O.K.; '0'=RETRY
	IF X0 <> 1 THEN 6040
	X1=64:GOSUB 210
	PRINT "WORKING...DO NOT INTERRUPT"

	OPEN "P/R0F060.DAT" AS Y6					REMARK  OPEN AND READ FEDERAL TAX FILE
	READ #Y6;F1(1),F1(2),F1(3),F1(4),F1(5),F1(6),F1(7),F1(8),F1(9),\
	F1(10),F1(11),F1(12),F1(13),F1(14),F1(15),F1(16),F1(17),F1(18),\
	F1(19),F1(20),F1(21),F1(22),F1(23),F1(24),F1(25),F1(26),F1(27),\
	F1(28),F1(29),F1(30),F1(31),F1(32),F1(33),F1(34),F1(35),F1(36)

	OPEN "P/R0F070.DAT" AS Y7					REMARK  OPEN AND READ STATE TAX FILE
	READ #Y7;S1$,S1(1),S1(2),S1(3),S1(4),S1(5),S1(6),S1(7),S1(8)

	RESTORE								REMARK  READ STATE TAX TABLES FROM DATA STATEMENT
	FOR I2%=1 TO 4:READ X0$:NEXT I2%
	FOR I2%=8 TO 32
	READ S1(I2%)
	NEXT I2%


6100	FOR INDEX = E1 TO E2						REMARK  PROCESS EMPLOYEE RANGE
	X0=INDEX
	GOSUB 745							REMARK  READ EMPLOYEE MASTER RECORD
	IF S(1) = 0 THEN GOTO 6365					REMARK  IF RECORD IS DELETED, SKIP PROCESSING

	

	IF P1=4 THEN\							REMARK  ZERO OUT YEARLY TOTALS
	FOR I2%=25 TO 48:\
	S(I2%)=0:\
	NEXT I2%:\
	S(15)=0


	IF P1=3 OR P1=4\
	THEN\
	FOR I2%=49 TO 72:\						REMARK  RESET QUARTERLY TOTALS
	S(I2%)=0:\
	NEXT I2%

	IF P1=2 OR P1=3 OR P1=4 THEN S(6)=0:S(7)=0:S(10)=0		REMARK  RESET MONTHLY TOTALS


6130	IF S(5) <> 0 OR R2(1)=99\					REMARK  IF CHECK NUMBER <> 0 OR EMPLOYEE INACTIVE,
	THEN\								        SKIP PROCESSING
	FOR I2%=73 TO 90:\
	S(I2%)=0:\
	NEXT I2%:GOTO 6360


	IF R2(1) = 1 THEN A1=S(80) ELSE A1=0				REMARK  CALCULATE HEALTH AND WELFARE PAY

6146	S(79)=FNR((S(73)+S(75)+A1)*S(9))				REMARK  CALCULATE GROSS PAY AND TAXABLE PAY
	S(83)=S(74)+S(76)+S(78)+S(79)+S(81)+S(82)
	GROSS.PAY=S(83)
	IF GROSS.PAY=0 THEN 6360
	TAXABLE.PAY=GROSS.PAY-S(84)

	IF R3$="S" THEN I1=1						REMARK  SET TAX LEVEL POINTER BASED ON MARITAL STATUS
	IF R3$="M" THEN I1=2
	IF R3$="H" THEN I1=3
6165	PAY.PERIODS=26

6170	I5=I1-INT(I1/3)*2
	ANNUAL.PAY=TAXABLE.PAY*PAY.PERIODS - F1(I5*15-8)*R2(2)
	DEDUCTION.AMOUNT=0
	GOSUB 5300							REMARK  CALCULATE AND WITHHOLD FEDERAL INCOME TAX

	DEDUCTION.AMOUNT=S(35)-S(36)+TAXABLE.PAY			REMARK  CALCULATE AND WITHHOLD FICA TAX
	IF DEDUCTION.AMOUNT-TAXABLE.PAY > F1(6) THEN\
	DEDUCTION.AMOUNT=F1(5)*F1(6)-S(39)*10000\
	ELSE\
	DEDUCTION.AMOUNT=TAXABLE.PAY*F1(5)
6210	DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/10000
	A1=87:GOSUB 4200


6215	STATE.TAXABLE.PAY=TAXABLE.PAY*PAY.PERIODS			REMARK  CALCULATE AND WITHHOLD STATE INCOME TAX
	DEDUCTION.AMOUNT=0
	IF I1=1 THEN I5=1						REMARK  SET TAX CUTOFF POINTER
	IF I1=3 OR R2(3) >=2 THEN I5=2

6235	IF STATE.TAXABLE.PAY <= S1(I5+7) THEN 6290
	IF R2(4)>0 THEN\
	STATE.TAXABLE.PAY=STATE.TAXABLE.PAY-FNR(R2(4)*S1(10))		REMARK  DEDUCT ADDITIONAL STATE EXEMPTIONS
	X=S1(I5+10):GOSUB 4150
	IF X>0 THEN X=S1(I1+12):GOSUB 4150 ELSE GOTO 6275
	IF X>0 THEN X=S1(I1+15):GOSUB 4150 ELSE GOTO 6275
	IF X>0 THEN I=0 ELSE GOTO 6275
6265	X=S1(I1+18):GOSUB 4150
	IF X>0 THEN I=I+1 ELSE GOTO 6275
	IF I<4 THEN 6265
	X=S1(I1+29):GOSUB 4150
	IF X>0 THEN I=0 ELSE GOTO 6275
6270	X=S1(I1+18):GOSUB 4150
	IF X>0 THEN I=I+1 ELSE GOTO 6275
	IF I<3 THEN 6270
6275	DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/100
	X=22 + SGN(I1-1)*4+R2(3)
	A1=0
	IF R2(3)>=3 THEN X=X-R2(3)+2:A1=R2(3)-2
6283	DEDUCTION.AMOUNT=DEDUCTION.AMOUNT-S1(X)-A1*S1(SGN(I1-1)*4+25)
	DEDUCTION.AMOUNT=DEDUCTION.AMOUNT/PAY.PERIODS
	A1=86:GOSUB 4200						REMARK  DEDUCT WITHHOLDING AMOUNT FROM EMPLOYEE

6290	DEDUCTION.AMOUNT=S(35)-S(36)+TAXABLE.PAY			REMARK  CALCULATE AND WITHHOLD SDI TAX
	IF DEDUCTION.AMOUNT-TAXABLE.PAY>S1(4) THEN 6320			REMARK  IF PAST SDI CUTOFF, DO NOT DEDUCT IT

	IF DEDUCTION.AMOUNT < S1(4) THEN\				REMARK  IF CUTOFF NOT REACHED, DEDUCT SDI NORMALLY
	DEDUCTION.AMOUNT=TAXABLE.PAY*S1(3):GOTO 6315

6310	DEDUCTION.AMOUNT=S1(4)*S1(3)-S(40)*10000			REMARK  CALCULATE REMAINING SDI IF PART OF THIS CHECK\
									        IS SUBJECT TO A DEDUCTION
6315	DEDUCTION.AMOUNT = DEDUCTION.AMOUNT/10000			REMARK  DEDUCT SDI TAX FROM TAXABLE PAY
	A1=88:GOSUB 4200


6320	FOR I2%=73 TO 90							REMARK  ACCUMULATE ALL DEDUCTIONS FROM Y-T-D AND Q-T-D
	S(I2%-24) = S(I2%-24) + S(I2%)
	S(I2%-48)=S(I2%-48) + S(I2%)
	NEXT I2%

	S(6)=S(6)+S(73)+S(75)+S(77)+S(80)				REMARK  ACCUMULATE TO MONTHLY HOURS


6323	IF R2(1)<> 1 THEN X0=80 ELSE X0=1
	X0 = S(76) - FNR(S(8)/X0*S(75))					REMARK  WITH O/T PAY AND CORPORATE OFFICER PAY
6325	IF R2(5) <>1 THEN 6330						REMARK  ABOVE $1733.00 EXCLUDABLE
	IF S(7) + TAXABLE.PAY - X0 <1733 THEN 6330
	S(10) = S(10) + TAXABLE.PAY - X0
	IF S(7)>1733 THEN 6330
	S(10) = S(10) + S(7) - 1733


6330	S(7) = S(7) + TAXABLE.PAY					REMARK  ACCUMULATE MONTHLY PAY
6340	S(10) = S(10) + X0						REMARK  ACCUMULATE INSURANCE REPORT EXCLUDABLE AMOUNT

	S(4)=G3(3)							REMARK  SET CHECK DATE AT PERIOD END DATE

	S(5)=G2								REMARK  ASSIGN CHECK NUMBER TO EMPLOYEE

	G2=G2+1								REMARK  INCREMENT NEXT CHECK NUMBER
	IF G2>999999 THEN G2=1						REMARK  'ROLL' CHECK NUMBER IF MORE THAN SIX DIGITS

6360	X0=INDEX:GOSUB 750						REMARK  WRITE OUT THE CALCULATED RECORD

6365	NEXT INDEX

6370	GOSUB 720
7000	PRINT CLEAR.SCREEN$;"P/R CALCULATE LOADING MENU"		REMARK  TERMINATE PROGRAM AND LOAD MENU
	CHAIN "P/R000"
