bwBASIC/C77B/W2PRINT.BAS

1     rem This is the Federal W2 Printer

%INCLUDE ALL.BAS
500     dim n(2,20),k$(3,20),h(9),s(9),t(4,9)
     print clear$:print
     RESTORE
1055 T$="#,###.##"
1060 U$="##,###.##"
1065 V$="###,###.##"
1075 N(1,3)=24:N(1,4)=24:N(1,5)=24:N(1,6)=17:N(1,7)=2:N(1,8)=5
1080 N(1,9)=14:N(1,10)=11:N(1,11)=8:N(1,12)=8:N(1,13)=1:N(1,14)=1:N(1,15)=1
1120 Z9=1
1145 Z9=0
1200 REM READ TAB VALUES ROUTINE
1400 REM THIS PART GETS CUTOFFS FOR FICA,SDI,FUTA AND SUTA
     open "epc" as 1
     read #1;c1,c2,c3,c4,c5,c6,c7,c8
     close 1
1500 PRINT clear$:PRINT
1510 PRINT "IS PENSION PLAN COVERAGE PROVIDED YOUR EMPLOYEES?":PRINT
1520 INPUT K$(0,20)
1530 PRINT clear$:PRINT
1540 PRINT "DID YOU FAIL TO COLLECT FICA TAX ON EMPLOYEES TIPS, PROVIDE"
1550 PRINT "MORE THAN $50,000 GROUP-TERM LIFE INSURANCE, OR HAVE ANY"
1560 PRINT "STATUTORY EMPLOYEES WHOSE EARNINGS ARE SUBJECT TO FICA BUT"
1570 PRINT "NOT SUBJECT TO FEDERAL INCOME TAX (YES OR NO TO ANY ONE,"
1580 PRINT "TWO, OR ALL THREE)?"
1590 PRINT:INPUT line temp$
          if left$(temp$,1)="y" or left$(temp$,1)="Y" then Y8=1
1600 PRINT clear$:PRINT
1610 PRINT "DID ANY EMPLOYEES HAVE TIPS THAT MUST BE INCLUDED IN BOX 18"
1620 PRINT:INPUT line temp$
     if left$(temp$,1)="y" or left$(temp$,1)="Y" then Y9=1
1630 PRINT clear$:PRINT
1640 PRINT "ENTER STATE NAME FOR BOX 22.":PRINT
1650 INPUT K$(0,19)
3000 REM READ NAME FILE SUBROUTINE
3005 a5=T%(12)
3080 N(1,10)=20:N(1,11)=20
3085 Z9=1:FOR Z=3 TO 11:K$(0,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
3090 N(1,10)=11:N(1,11)=8
3125 REM ROUTINE TO ELIMINATE TRAILING BLANKS
     l8=1
3130 FOR I=3 TO 11
     l9=len(k$(0,i))
3140 for z=l9 to l8 step -1
3150 IF MID$(K$(0,I),Z,1)<>" " THEN 3170
3160 NEXT Z
3170 Z$=""
3180 FOR Z0=1 TO Z
3190 Z$=Z$+MID$(K$(0,I),Z0,1)
3200 NEXT Z0
3210 K$(0,I)="":K$(0,I)=Z$
3220 NEXT I
6000 REM PRINT W2 FORMS
6005 PRINT clear$:PRINT:PRINT "PRINTING W2 FORMS":P0=1
6010 lprinter
6015 open "ep" recl 512 as 1
6020 z3=(size("ep")*block.size)/512
6025 FOR Z2=1 TO Z3
6030 read #1,z2;N(2,1),N(2,2),N$,N,R,H1,H2,H3
6035 IF N(2,2)=0 THEN 6045
6040 NEXT Z2
6045 close 1
6050 Z2=Z2-1
6090 P1=1:P2=41
6095 open "ep" recl 512 as 1
6200 FOR Z1=P1 TO P2
9000 REM GET RECORD AND PRINT
9010 read #1,z1;N(2,1),N(2,2),N$,N,R,H1,H2,H3,          E0,E1,E2,F1,F2,F3,E3,E4,E5,E6,E7,E8,S1,S2,S3,M1,M2,M3
9020 IF N(2,2)=0 THEN 9500
9095 Z9=1:FOR Z=3 TO 15:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
9100 N$=""
9102 IF E2>C1 THEN Z5=C1:GOTO 9110
9104 Z5=E2
9110 T1=T1+E5:T2=T2+E2:T3=T3+F3:T4=T4+Z5:T5=T5+Z6
9120 PRINT clear$:PRINT
9130 IF Y8=1 THEN INPUT "ENTER BOX 17 INFORMATION ";Y6:PRINT
9140 IF Y9=1 THEN INPUT "ENTER BOX 18 INFORMATION ";Z6:PRINT
9200 FOR Z=1 TO 3:print:NEXT Z
9210 print TAB(10);N(2,1);TAB(34);K$(0,11)
9220 print:print
9230 print TAB(11);K$(0,4):print TAB(11);K$(0,5)
9240 print TAB(11);K$(0,6);", ";K$(0,7);"  ";K$(0,8);TAB(44);K$(0,10)
9250 print:print
9260 print TAB(11);K$(3,10);TAB(27);:print using u$;e5;TAB(40);
     print using v$;e2;tab(55);:print using t$;f3;tab(68);:print using u$;z5
9275 print
9280 print TAB(10);K$(3,3);TAB(48);K$(0,20);TAB(55);
     print using t$;y6;tab(68);:print using u$;z6
9300 print:print TAB(11);K$(3,5);TAB(41);
     print using u$;e8;tab(53);:print using v$;e2
9310 print TAB(67);K$(0,19)
9320 print TAB(11);K$(3,6);", ";K$(3,7);"  ";K$(3,8)
9325 print:print
9330 print TAB(68);:print using t$;s3
9350 P0=P0+1
9355 IF P0=4 THEN P0=1:INPUT "TYPE RETURN TO CONTINUE ";line temp$
9400 NEXT Z1
9410 GOSUB 10000
9500 IF Z1>41 THEN GOSUB 10000
9910 close 1
9915 console
9920 CHAIN "master5"
10000 IF Z1+1/3=INT(Z1+1/3) THEN 10500
10010 A=Z1
10020 FOR Z=1 TO Z2
10030 A=A-3
10040 IF A<1 THEN A=A+3:GOTO 10060
10050 NEXT Z
10060 FOR Z=1 TO 8:print:NEXT Z
10070 print TAB(54);"X"
10080 IF A>1 THEN FOR Z=1 TO 21:print:NEXT Z:print TAB(54);"X"
10090 IF A>1 THEN FOR Z=1 TO 12:print:NEXT Z
10500 FOR Z=1 TO 6:print:NEXT Z
10510 print TAB(45);"X"
10520 FOR Z=1 TO 6:print:NEXT Z
10530 print using v$;tab(25);t1;tab(38);t2;tab(53);t3;tab(65);t4
      print:print using v$;tab(65);t5
10560 T1=0:T2=0:T3=0:T4=0:T5=0
10570 RETURN