2 ! PRINTS DEDUCTION REGISTERS
5 ! PROGRAM NAME:"PDREG" - BY JAC
10 DEF FNZ$(A%,B)
12 IF ABS(B)<1E+6 THEN FNZ$=LEFT(NUM$(B)+SPACE$(A%-LEN(NUM$(B))),A%):GOTO 25
15 A1=FIX(B/1E+6):A2=((B/1E+6)-A1)*1E+6:A3$=NUM$(A1):A4$=RIGHT(NUM$(A2),2%)
16 IF LEN(A4$)<7% THEN A4$="0"+A4$:GOTO 16
18 A3$=LEFT(A3$,INSTR(2%,A3$," ")-1%)+A4$
20 FNZ$=LEFT(A3$+SPACE$(A%-LEN(A3$)),A%)
25 FNEND
30 OPEN "LP:" FOR OUTPUT AS FILE 1%,MODE 66%
35 OPEN "DK1:PAYROL.MST" AS FILE 2%
38 DIM #2%,A$(1500%)=128%,A%(0%):N%=A%(0%)
40 OPEN "DK1:PAYROL.MDR" AS FILE 3%
42 DIM #3%,M$(1500%)=128%,M%(0%),D1$(0%)=8%
45 OPEN "DK1:PAYROL.DED" AS FILE 4%
48 DIM #4%,D$(30%)=32%,D%(0%):D%=D%(0%)
50 OPEN "DK1:PAYROL.RCP" AS FILE 5%
52 DIM #5%,R$(1000%)=64%,R%(0%)
55 Q$="#,###.##":Q1$="###,###,###":Q2$="###,###.##"
58 D3$=LEFT(D1$(0%),2%)+MID(D1$(0%),4%,2%):J%=0%:DIM T(2%)
59 FOR I%=1% TO D%          ! DEDUCTION LOOP
60 T1=0%:T2=0%:F1=0%:F2=0%:M%=0%:J%=J%+1%:L%=0%:GOSUB 400
75 D1$=MID(D$(I%),3%,22%):C1$=LEFT(D$(I%),2%)
80 FOR K%=1% TO N%        ! REGISTER LOOP
85 IF MID(M$(K%),47%,1%)="N" THEN 135    ! CHECK?
90 P%=49%:T%=VAL(MID(M$(K%),48%,1%))
100 FOR H%=0% TO T%              ! CHECK FOR DEDUCTION
105 IF MID(M$(K%),P%,2%)<>C1$ THEN 125
110 GOSUB 450         ! PRINT DEDUCTION
115 IF C1$<>"61" THEN H%=T%:GOTO 130
120 GOSUB 530       ! CHECK TO REMOVE P.E.R. DED.
125 P%=P%+8%
130 NEXT H%            ! NEXT DEDUCTION
135 NEXT K%        ! NEXT EMPLOYEE
140 GOSUB 600          ! PRINT PAGE TOTAL
145 PRINT #1%            ! PRINT DEDUCTION TOTAL
150 PRINT #1%,TAB(21%);
155 PRINT #1%,USING Q1$,F1;
160 PRINT #1%,"*  DEDUCTION TOTAL";TAB(58%);
165 PRINT #1%,USING Q2$,ABS(F2)/100%;
170 IF F2<0% THEN PRINT #1%,"CR*" ELSE PRINT #1%,"  *"
175 PRINT #1%
180 PRINT #1%,"NUMBER OF DEDUCTIONS ";M%;TAB(53%);"CODE ";C1$
185 L1=L1+F1:L2=L2+F2:N1%=N1%+M%:GOSUB 650            ! STORE
190 NEXT I%
195 IF L%<46% THEN 205        ! CHECK FOR END OF PAGE
200 J%=J%+1%:GOSUB 400        ! PRINT HEADING
205 PRINT #1%        ! PRINT FINAL TOTALS
210 PRINT #1%,TAB(21%);
215 PRINT #1%,USING Q1$,L1;
220 PRINT #1%,"**";TAB(44%);"FINAL TOTAL   ";
225 PRINT #1%,USING Q2$,ABS(L2)/100%;
230 IF L2<0% THEN PRINT #1%,"CR**" ELSE PRINT #1%,"  **"
235 PRINT #1%
240 PRINT #1%,"TOTAL DEDUCTION COUNT ";N1%
245 T(I%)=0% FOR I%=0% TO 2%
250 FOR K%=1% TO N%
255 IF MID(A$(K%),117%,1%)="N" THEN 280
260 P%=16%
265 FOR I%=0% TO 2%
270 T(I%)=T(I%)+VAL(MID(M$(K%),P%,7%)):P%=P%+7%
275 NEXT I%
280 NEXT K%
285 R%(0%)=R%(0%)+1%:T$=FNZ$(10%,-T(0%))
290 R$(R%(0%))=D3$+"FEDERAL TAX           0000100000222020         23E"+T$
295 R%(0%)=R%(0%)+1%:T$=FNZ$(10%,-T(1%))
300 R$(R%(0%))=D3$+"STATE TAX             0000100000222030         33E"+T$
305 R%(0%)=R%(0%)+1%:T$=FNZ$(10%,-T(2%))
310 R$(R%(0%))=D3$+"FICA TAX              0000100000222011         43E"+T$
315 PRINT #1%,CHR$(129%):CLOSE 1%,2%,3%,4%,5%:STOP
400 PRINT #1%,CHR$(129%)
405 PRINT #1%,"SCHOOL DIST. 91";TAB(20%);"DEDUCTION REGISTER";TAB(45%);
410 PRINT #1%,D1$(0%);TAB(62%);"PAGE ";J%:PRINT #1%
420 PRINT #1%,TAB(25%);"EMPLOYEE";TAB(57%);"DED."
425 PRINT #1%,"D E S C R I P T I O N     NUMBER  EMPLOYEE NAME";
430 PRINT #1%,TAB(57%);"CODE AMOUNT":PRINT #1%
435 RETURN
450 E$=MID(A$(K%),37%,6%):T1=T1+VAL(MID(E$,3%,4%)):N$=LEFT(A$(K%),24%):
	A=-VAL(MID(M$(K%),P%+2%,6%)):IF A=0% THEN 500 ELSE T2=T2+A:M%=M%+1%
470 PRINT #1%,"  ";D1$;TAB(26%);E$;"  ";N$;C1$;
475 PRINT #1%,USING Q$,ABS(A)/100%;
480 IF A<0% THEN PRINT #1%,"CR" ELSE PRINT #1%
485 L%=L%+1%:IF L%<50% THEN 500
490 GOSUB 600             ! PRINTS PAGE TOTALS
495 J%=J%+1%:L%=0%:GOSUB 400
500 RETURN
530 IF H%=0% THEN 545
535 F3$=NUM$(T%-1%):M$(K%)=LEFT(M$(K%),P%-1%)+RIGHT(M$(K%),P%+8%)+"        "
540 M$(K%)=LEFT(M$(K%),47%)+MID(F3$,2%,1%)+RIGHT(M$(K%),49%)
545 RETURN
600 PRINT #1%
605 PRINT #1%,TAB(21%);
610 PRINT #1%,USING Q1$,T1;
615 F1=F1+T1:T1=0%:PRINT #1%,TAB(58%);
620 PRINT #1%,USING Q2$,ABS(T2)/100%;
625 IF T2<0% THEN PRINT #1%,"CR" ELSE PRINT #1%
630 F2=F2+T2:T2=0%
635 RETURN
650 R%(0%)=R%(0%)+1%:C$="000"+MID(D$(I%),25%,2%)+"00000"+MID(D$(I%),27%,6%)
660 R$(R%(0%))=D3$+D1$+C$+SPACE$(9%)+"63E"+FNZ$(10%,F2)
665 RETURN
670 END