rem This is the Payroll Calculation Program %INCLUDE ALL.BAS dim aa(11,5),b(11,5),c(11,5),d(11,5),e(11,5),f(2,10) dim n(2,20),k$(6,20) z5$="b:ep":z7$=z5$+"size" l$="$##,###.##":u$="##########":v$="####" print clear$:print RESTORE 1300 N(1,1)=8:N(1,2)=10:N(1,3)=24:N(1,4)=24:N(1,5)=24:N(1,6)=17 1305 N(1,7)=2:N(1,8)=5:N(1,9)=14:N(1,10)=11:N(1,11)=8:N(1,12)=8 1310 N(1,13)=1:N(1,14)=1:N(1,15)=1:N(1,16)=4:N(1,17)=6 1460 print clear$:print 1500 if end #1 then 40000 if end #2 then 15000 open z5$ recl 512 as 1 close 1 open z7$ as 2 read #2;z2,z3 close 2 1600 if z2>z3 then print "*** OUT OF RECORD SPACE ***" 1620 print clear$:PRINT "PAYROLL CALCULATION PROGRAM" PRINT "---------------------------" PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS" PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN" PRINT ;TAB(30);Z2-1;" RECORDS USED" PRINT z2=z2-1 1635 PRINT "NUMBER OF EMPLOYEES";Z2 1650 PRINT:PRINT "CALCULATING PAYROLL":PRINT:PRINT"*** PLEASE WAIT ***" 1690 FOR Z=1 TO 20:N(2,Z)=0:N(0,Z)=0:NEXT Z 1695 N$="" 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z 2000 open "b:es" as 1 for x=1 to 11 read #1;c(x,1),c(x,2),c(x,3),c(x,4),c(x,5) read #1;d(x,1),d(x,2),d(x,3),d(x,4),d(x,5) read #1;e(x,1),e(x,2),e(x,3),e(x,4),e(x,5) next x for x=1 to 8 read #1;f(1,x) next x for x=1 to 8 read #1;f(2,x) next x close 1 3000 open "b:ef" as 1 for x=1 to 8 read #1;aa(x,1),aa(x,2),aa(x,3),aa(x,4),aa(x,5) read #1;b(x,1),b(x,2),b(x,3),b(x,4),b(x,5) next x close 1 5200 REM THIS PART GETS THE CUTOFF VALUES - C1=FICA CUTOFF; C2=FICA % 5205 REM C3=SDI CUTOFF; C4=SDI %; C5= FUTA CUTOFF; C6=FUTA %; C7=SUTA CUTOFF 5210 open "b:epc" as 1 read #1;c1,c2,c3,c4,c5,c6,c7,c8 close 1 5500 REM IN THE PAYROLL CALCULATIONS THAT FOLLOW, THESE GENERAL 5505 REM CONSIDERATIONS ARE USED. IF THE EMPLOYEE IS AN HOURLY EMPLOYEE, 5510 REM HIS PAY IS CALCULATED ON THE FULL HOURS ENTERED. HIS OVERTIME 5515 REM HOURS ARE MULTIPLIED BY 1.5 AND 2 AND ADDED TO REGULAR OR OTHER 5520 REM HOURS TO GET TOTAL HOURS. IF THE EMPLOYEE IS A SALARIED EMPLOYEE, 5525 REM THE FULL HOURS ARE POSTED BUT PAY IS CALCULATED ON 40 HOURS FOR 5530 REM WEEKLY; 80 HOURS FOR BIWEEKLY; 86.66667 HOURS FOR SEMIMONTHLY; AND 5535 REM 173.33333 HOURS FOR MONTHLY. THE PAY PERIODS PER YEAR ARE 52 FOR 5540 REM WEEKLY; 26 FOR BIWEEKLY; 24 FOR SEMIMONTHLY; AND 12 FOR MONTHLY. 6000 open "b:ep" recl 512 as 1 6010 open "b:tm" recl 128 as 2 6015 N$="" 6020 FOR I=1 TO Z2 6030 read #1,i;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 read #2,i;n(0,1),n(0,2),k$(3,3),t1,t2,t3,t4,t5,t6,t7,t8,t9 6060 M1=T3:REM SAVE MISCELLANEOUS DEDUCTIONS 6070 Z9=1:FOR Z=3 TO 15:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z if k$(3,12)<>" " then 9020 6080 GOSUB 20000 6090 GOSUB 30000 8018 REM 8020 REM THIS PART CALCULATES FICA USING YTD GROSS (E2) AND CURRENT (E0) 8022 REM 8024 IF E2>C1 THEN F1=0 8026 IF E2>C1 THEN 8040 8028 IF E2+E0>C1 THEN F1=(E2+E0-C1)*C2 8030 IF E2+E0>C1 THEN 8040 8035 IF E2+E0<=C1 THEN F1=E0*C2 8036 REM 8038 REM NOW CALCULATE STATE DISABILITY INSURANCE 8039 REM 8040 IF E2>C3 THEN S1=0 8041 IF E2>C3 THEN 8050 8042 IF E2+E0>C3 THEN S1=(E2+E0-C3)*C4 8043 IF E2+E0>C3 THEN 8050 8044 IF E2+E0<=C3 THEN S1=E0*C4 8045 REM 8646 REM NOW COMES FEDERAL INCOME TAX CALCULATION 8047 REM 8050 P3=P1-(N*1000): REM ANNUALIZED AMOUNT SUBJECT TO WH 8052 Z=0 8056 IF K$(3,13)="M" THEN 8100 8057 IF K$(3,13)="H" THEN 8100 8058 FOR X=1 TO 8 8059 IF P3>AA(X,1) AND P3<=AA(X,2) THEN Z=AA(X,3)+((P3-AA(X,5))*AA(X,4)) 8060 IF P3>AA(X,1) AND P3<=AA(X,2) THEN 8070 8062 NEXT X 8070 IF K$(3,15)="W" THEN E3=Z/52 8071 IF K$(3,15)="B" THEN E3=Z/26 8072 IF K$(3,15)="S" THEN E3=Z/24 8074 IF K$(3,15)="M" THEN E3=Z/12 8080 GOTO 8200 8100 FOR X=1 TO 8 8102 IF P3>B(X,1) AND P3<=B(X,2) THEN Z=B(X,3)+((P3-B(X,5))*B(X,4)) 8104 IF P3>B(X,1) AND P3<=B(X,2) THEN 8120 8106 NEXT X 8120 IF K$(3,15)="W" THEN E3=Z/52 8121 IF K$(3,15)="B" THEN E3=Z/26 8122 IF K$(3,15)="S" THEN E3=Z/24 8124 IF K$(3,15)="M" THEN E3=Z/12 8130 GOTO 8200 8200 REM 8202 REM THIS IS THE CALIFORNIA STATE INCOME TAX CALCULATION 8204 REM WHICH USES TABLES IN A SIMILAR MANNER TO THE FEDERAL TAX 8206 REM CALCULATIONS. IT HAS BEEN DELIBERATELY AND CAREFULLY 8208 REM PARTITIONED AND EXPLAINED IN ORDER TO ALLOW YOUR PARTICULAR 8210 REM STATE INCOME TAX CALCULATIONS TO BE INSERTED. THESE MAY 8212 REM FOLLOW THE TABLES PROCEDURES OF CALIFORNIA OR THEY MAY BE 8214 REM SIMPLY A PERCENTAGE OF THE FEDERAL. 8216 REM 8218 REM THESE CALIFORNIA CALCULATIONS FOLLOW THE DE 44 FORM FOR THE 8220 REM "EXACT CALCULATION" METHOD AS DESCRIBED IN THAT BOOKLET. 8222 REM THEY DO NOT ALLOW FOR THE CALCULATION OF EXTRA ALLOWANCES 8224 REM FOR ITEMIZED DEDUCTIONS. THIS WOULD REQUIRE A COMPLETE 8226 REM REARRANGEMENT OF THE PAYROLL UNIT RECORD, AN EXTRA TABLE, 8228 REM AND AN ADDITIONAL SET OF CALCULATIONS. 8230 REM 8231 Z=0 8232 IF K$(3,13)="S" THEN GOSUB 8300 8234 IF K$(3,13)="M" THEN GOSUB 8400 8236 IF K$(3,13)="H" THEN GOSUB 8500 8238 GOTO 9000 8300 IF P1<=5000 THEN E6=0 8302 IF P1<=5000 THEN RETURN 8304 P1=P1-1000 8306 FOR X=1 TO 11 8308 IF P1>=C(X,1) AND P1=C(X,1) AND P18 THEN N=8 8352 Z=Z-F(1,N) 8360 IF Z<=0 THEN E6=0 8362 IF Z<=0 THEN RETURN 8364 IF K$(3,15)="W" THEN E6=Z/52 8365 IF K$(3,15)="B" THEN E6=Z/26 8366 IF K$(3,15)="S" THEN E6=Z/24 8367 IF K$(3,15)="M" THEN E6=Z/12 8370 RETURN 8400 IF N<=1 AND P1<=5000 THEN E6=0 8401 IF N<=1 AND P1<=5000 THEN RETURN 8402 IF N>1 AND P1<=10000 THEN E6=0 8403 IF N>1 AND P1<=10000 THEN RETURN 8404 IF N<=1 THEN P1=P1-1000 8405 IF N>1 THEN P1=P1-2000 8406 FOR X=1 TO 11 8408 IF P1>=D(X,1) AND P1=D(X,1) AND P18 THEN N=8 8452 Z=Z-F(2,N) 8460 IF Z<=0 THEN E6=0 8462 IF Z<=0 THEN RETURN 8464 IF K$(3,15)="W" THEN E6=Z/52 8465 IF K$(3,15)="B" THEN E6=Z/26 8466 IF K$(3,15)="S" THEN E6=Z/24 8467 IF K$(3,15)="M" THEN E6=Z/12 8470 RETURN 8500 IF P1<=10000 THEN E6=0 8502 IF P1<=10000 THEN RETURN 8504 P1=P1-2000 8506 FOR X=1 TO 11 8508 IF P1>=E(X,1) AND P1=E(X,1) AND P18 THEN N=8 8552 Z=Z-F(2,N) 8560 IF Z<=0 THEN E6=0 8562 IF Z<=0 THEN RETURN 8564 IF K$(3,15)="W" THEN E6=Z/52 8565 IF K$(3,15)="B" THEN E6=Z/26 8566 IF K$(3,15)="S" THEN E6=Z/24 8567 IF K$(3,15)="M" THEN E6=Z/12 8570 RETURN 9000 print #1,i;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 9015 N$="" 9020 NEXT I 9030 close 1 9040 close 2 10000 chain "master5" 15000 print clear$:print:print "CHECKING FILE LENGTH" PRINT:PRINT "*** PLEASE WAIT ***" open z5$ recl 512 as 1 z3=(size(z5$)*block.size)/512 for z2=1 to z3 read #1,z2;n(2,1),n(2,2) if n(2,2)=0 then 15300 next z2 15300 z3=int(z3)-2 close 1 create z7$ as 1 print #1;z2,z3 close 1 GOTO 1500 20000 REM THIS PART CALCULATES TOTAL HOURS 20010 H4=T4+(T5*1.5)+(T6*2)+T7+T8+T9:REM H4=HOURS FOR CALCULATION PURPOSES 20020 H1=T4+T5+T6+T7+T8+T9 20030 IF K$(3,14)="S" THEN GOSUB 25000 20500 RETURN 25000 REM THIS PART SETS H4 FOR PAYROLL CALCULATIONS TO A VALUE 25010 REM DETERMINED BY THE PAYROLL PERIOD 25020 IF K$(3,15)="W" THEN H4=40 25030 IF K$(3,15)="B" THEN H4=80 25040 IF K$(3,15)="S" THEN H4=86.66667 25050 IF K$(3,15)="M" THEN H4=173.33333 25500 RETURN 30000 REM THIS CALCULATES ANNUALIZED PAY BASED ON LENGTH OF PAY PERIOD 30010 E0=(H4*R)+T2: REM - GROSS PAY FOR PAYROLL PERIOD 30020 IF K$(3,15)="W" THEN P1=E0*52 30030 IF K$(3,15)="B" THEN P1=E0*26 30040 IF K$(3,15)="S" THEN P1=E0*24 30050 IF K$(3,15)="M" THEN P1=E0*12 34995 RETURN 40000 print "Install payroll disk in drive B." input "Type return to continue ";line temp$ initialize goto 1460