home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG088.ARK / EPJOTRAN.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  8KB  |  244 lines
  1.      rem This is the Payroll Calculation Program
  2.  
  3. %INCLUDE ALL.BAS
  4.      dim aa(11,5),b(11,5),c(11,5),d(11,5),e(11,5),f(2,10)
  5.      dim n(2,20),k$(6,20)
  6.      z5$="b:ep":z7$=z5$+"size"
  7.      l$="$##,###.##":u$="##########":v$="####"
  8.      print clear$:print
  9.      RESTORE
  10. 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
  11. 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
  12. 1310 N(1,13)=1:N(1,14)=1:N(1,15)=1:N(1,16)=4:N(1,17)=6
  13. 1460    print clear$:print
  14.  
  15. 1500    if end #1 then 40000
  16.     if end #2 then 15000
  17.         open z5$ recl 512 as 1
  18.         close 1
  19.         open z7$ as 2
  20.         read #2;z2,z3
  21.         close 2
  22.  
  23. 1600    if z2>z3 then print "*** OUT OF RECORD SPACE ***"
  24. 1620    print clear$:PRINT "PAYROLL CALCULATION PROGRAM"
  25.         PRINT      "---------------------------"
  26.     PRINT:PRINT "THERE ARE ";Z3;" AVAILABLE RECORDS"
  27.     PRINT "OF THESE THERE ARE:";TAB(30);(Z3-Z2)+1;" RECORDS OPEN"
  28.     PRINT                      ;TAB(30);Z2-1;" RECORDS USED"
  29.     PRINT
  30.  
  31.      z2=z2-1
  32. 1635 PRINT "NUMBER OF EMPLOYEES";Z2
  33. 1650 PRINT:PRINT "CALCULATING PAYROLL":PRINT:PRINT"*** PLEASE WAIT ***"
  34. 1690 FOR Z=1 TO 20:N(2,Z)=0:N(0,Z)=0:NEXT Z
  35. 1695 N$=""
  36. 1700 FOR Z=1 TO 20:K$(3,Z)="":NEXT Z
  37. 2000 open "b:es" as 1
  38.      for x=1 to 11
  39.      read #1;c(x,1),c(x,2),c(x,3),c(x,4),c(x,5)
  40.      read #1;d(x,1),d(x,2),d(x,3),d(x,4),d(x,5)
  41.      read #1;e(x,1),e(x,2),e(x,3),e(x,4),e(x,5)
  42.      next x
  43.      for x=1 to 8
  44.      read #1;f(1,x)
  45.      next x
  46.      for x=1 to 8
  47.      read #1;f(2,x)
  48.      next x
  49.      close 1
  50. 3000 open "b:ef" as 1
  51.      for x=1 to 8
  52.      read #1;aa(x,1),aa(x,2),aa(x,3),aa(x,4),aa(x,5)
  53.      read #1;b(x,1),b(x,2),b(x,3),b(x,4),b(x,5)
  54.      next x
  55.      close 1
  56. 5200 REM THIS PART GETS THE CUTOFF VALUES - C1=FICA CUTOFF; C2=FICA %
  57. 5205 REM C3=SDI CUTOFF; C4=SDI %; C5= FUTA CUTOFF; C6=FUTA %; C7=SUTA CUTOFF
  58. 5210 open "b:epc" as 1
  59.      read #1;c1,c2,c3,c4,c5,c6,c7,c8
  60.      close 1
  61. 5500 REM IN THE PAYROLL CALCULATIONS THAT FOLLOW, THESE GENERAL
  62. 5505 REM CONSIDERATIONS ARE USED. IF THE EMPLOYEE IS AN HOURLY EMPLOYEE,
  63. 5510 REM HIS PAY IS CALCULATED ON THE FULL HOURS ENTERED. HIS OVERTIME
  64. 5515 REM HOURS ARE MULTIPLIED BY 1.5 AND 2 AND ADDED TO REGULAR OR OTHER
  65. 5520 REM HOURS TO GET TOTAL HOURS. IF THE EMPLOYEE IS A SALARIED EMPLOYEE,
  66. 5525 REM THE FULL HOURS ARE POSTED BUT PAY IS CALCULATED ON 40 HOURS FOR
  67. 5530 REM WEEKLY; 80 HOURS FOR BIWEEKLY; 86.66667 HOURS FOR SEMIMONTHLY; AND
  68. 5535 REM 173.33333 HOURS FOR MONTHLY. THE PAY PERIODS PER YEAR ARE 52 FOR
  69. 5540 REM WEEKLY; 26 FOR BIWEEKLY; 24 FOR SEMIMONTHLY; AND 12 FOR MONTHLY.
  70. 6000 open "b:ep" recl 512 as 1
  71. 6010 open "b:tm" recl 128 as 2
  72. 6015 N$=""
  73. 6020 FOR I=1 TO Z2
  74. 6030 read #1,i;n(2,1),n(2,2),n$,n,r,h1,h2,h3,e0,e1,e2,f1,f2,f3,\
  75.           e3,e4,e5,e6,e7,e8,s1,s2,s3,m1,m2,m3
  76.      read #2,i;n(0,1),n(0,2),k$(3,3),t1,t2,t3,t4,t5,t6,t7,t8,t9
  77. 6060 M1=T3:REM SAVE MISCELLANEOUS DEDUCTIONS
  78. 6070 Z9=1:FOR Z=3 TO 15:K$(3,Z)=MID$(N$,Z9,N(1,Z)):Z9=Z9+N(1,Z):NEXT Z
  79.  
  80.     if k$(3,12)<>"        " then 9020
  81.  
  82. 6080 GOSUB 20000
  83. 6090 GOSUB 30000
  84. 8018 REM
  85. 8020 REM THIS PART CALCULATES FICA USING YTD GROSS (E2) AND CURRENT (E0)
  86. 8022 REM
  87. 8024 IF E2>C1 THEN F1=0
  88. 8026 IF E2>C1 THEN 8040
  89. 8028 IF E2+E0>C1 THEN F1=(E2+E0-C1)*C2
  90. 8030 IF E2+E0>C1 THEN 8040
  91. 8035 IF E2+E0<=C1 THEN F1=E0*C2
  92. 8036 REM
  93. 8038 REM NOW CALCULATE STATE DISABILITY INSURANCE
  94. 8039 REM
  95. 8040 IF E2>C3 THEN S1=0
  96. 8041 IF E2>C3 THEN 8050
  97. 8042 IF E2+E0>C3 THEN S1=(E2+E0-C3)*C4
  98. 8043 IF E2+E0>C3 THEN 8050
  99. 8044 IF E2+E0<=C3 THEN S1=E0*C4
  100. 8045 REM
  101. 8646 REM NOW COMES FEDERAL INCOME TAX CALCULATION
  102. 8047 REM
  103. 8050 P3=P1-(N*1000): REM ANNUALIZED AMOUNT SUBJECT TO WH
  104. 8052 Z=0
  105. 8056 IF K$(3,13)="M" THEN 8100
  106. 8057 IF K$(3,13)="H" THEN 8100
  107. 8058 FOR X=1 TO 8
  108. 8059 IF P3>AA(X,1) AND P3<=AA(X,2) THEN Z=AA(X,3)+((P3-AA(X,5))*AA(X,4))
  109. 8060 IF P3>AA(X,1) AND P3<=AA(X,2) THEN  8070
  110. 8062 NEXT X
  111. 8070 IF K$(3,15)="W" THEN E3=Z/52
  112. 8071 IF K$(3,15)="B" THEN E3=Z/26
  113. 8072 IF K$(3,15)="S" THEN E3=Z/24
  114. 8074 IF K$(3,15)="M" THEN E3=Z/12
  115. 8080 GOTO 8200
  116. 8100 FOR X=1 TO 8
  117. 8102 IF P3>B(X,1) AND P3<=B(X,2) THEN Z=B(X,3)+((P3-B(X,5))*B(X,4))
  118. 8104 IF P3>B(X,1) AND P3<=B(X,2) THEN  8120
  119. 8106 NEXT X
  120. 8120 IF K$(3,15)="W" THEN E3=Z/52
  121. 8121 IF K$(3,15)="B" THEN E3=Z/26
  122. 8122 IF K$(3,15)="S" THEN E3=Z/24
  123. 8124 IF K$(3,15)="M" THEN E3=Z/12
  124. 8130 GOTO 8200
  125. 8200 REM
  126. 8202 REM THIS IS THE CALIFORNIA STATE INCOME TAX CALCULATION
  127. 8204 REM WHICH USES TABLES IN A SIMILAR MANNER TO THE FEDERAL TAX
  128. 8206 REM CALCULATIONS. IT HAS BEEN DELIBERATELY AND CAREFULLY
  129. 8208 REM PARTITIONED AND EXPLAINED IN ORDER TO ALLOW YOUR PARTICULAR
  130. 8210 REM STATE INCOME TAX CALCULATIONS TO BE INSERTED. THESE MAY
  131. 8212 REM FOLLOW THE TABLES PROCEDURES OF CALIFORNIA OR THEY MAY BE
  132. 8214 REM SIMPLY A PERCENTAGE OF THE FEDERAL.
  133. 8216 REM
  134. 8218 REM THESE CALIFORNIA CALCULATIONS FOLLOW THE DE 44 FORM FOR THE
  135. 8220 REM "EXACT CALCULATION" METHOD AS DESCRIBED IN THAT BOOKLET.
  136. 8222 REM THEY DO NOT ALLOW FOR THE CALCULATION OF EXTRA ALLOWANCES
  137. 8224 REM FOR ITEMIZED DEDUCTIONS. THIS WOULD REQUIRE A COMPLETE
  138. 8226 REM REARRANGEMENT OF THE PAYROLL UNIT RECORD, AN EXTRA TABLE,
  139. 8228 REM AND AN ADDITIONAL SET OF CALCULATIONS.
  140. 8230 REM
  141. 8231 Z=0
  142. 8232 IF K$(3,13)="S" THEN GOSUB 8300
  143. 8234 IF K$(3,13)="M" THEN GOSUB 8400
  144. 8236 IF K$(3,13)="H" THEN GOSUB 8500
  145. 8238 GOTO 9000
  146. 8300 IF P1<=5000 THEN E6=0
  147. 8302 IF P1<=5000 THEN RETURN
  148. 8304 P1=P1-1000
  149. 8306 FOR X=1 TO 11
  150. 8308 IF P1>=C(X,1) AND P1<C(X,2) THEN Z=C(X,3)+((P1-C(X,5))*C(X,4))
  151. 8310 IF P1>=C(X,1) AND P1<C(X,2) THEN  8350
  152. 8320 NEXT X
  153. 8350 IF N=0 THEN 8360
  154. 8351 IF N>8 THEN N=8
  155. 8352 Z=Z-F(1,N)
  156. 8360 IF Z<=0 THEN E6=0
  157. 8362 IF Z<=0 THEN RETURN
  158. 8364 IF K$(3,15)="W" THEN E6=Z/52
  159. 8365 IF K$(3,15)="B" THEN E6=Z/26
  160. 8366 IF K$(3,15)="S" THEN E6=Z/24
  161. 8367 IF K$(3,15)="M" THEN E6=Z/12
  162. 8370 RETURN
  163. 8400 IF N<=1 AND P1<=5000 THEN E6=0
  164. 8401 IF N<=1 AND P1<=5000 THEN RETURN
  165. 8402 IF N>1 AND P1<=10000 THEN E6=0
  166. 8403 IF N>1 AND P1<=10000 THEN RETURN
  167. 8404 IF N<=1 THEN P1=P1-1000
  168. 8405 IF N>1 THEN P1=P1-2000
  169. 8406 FOR X=1 TO 11
  170. 8408 IF P1>=D(X,1) AND P1<D(X,2) THEN Z=D(X,3)+((P1-D(X,5))*D(X,4))
  171. 8410 IF P1>=D(X,1) AND P1<D(X,2) THEN  8450
  172. 8420 NEXT X
  173. 8450 IF N=0 THEN 8460
  174. 8451 IF N>8 THEN N=8
  175. 8452 Z=Z-F(2,N)
  176. 8460 IF Z<=0 THEN E6=0
  177. 8462 IF Z<=0 THEN RETURN
  178. 8464 IF K$(3,15)="W" THEN E6=Z/52
  179. 8465 IF K$(3,15)="B" THEN E6=Z/26
  180. 8466 IF K$(3,15)="S" THEN E6=Z/24
  181. 8467 IF K$(3,15)="M" THEN E6=Z/12
  182. 8470 RETURN
  183. 8500 IF P1<=10000 THEN E6=0
  184. 8502 IF P1<=10000 THEN RETURN
  185. 8504 P1=P1-2000
  186. 8506 FOR X=1 TO 11
  187. 8508 IF P1>=E(X,1) AND P1<E(X,2) THEN Z=E(X,3)+((P1-E(X,5))*E(X,4))
  188. 8510 IF P1>=E(X,1) AND P1<E(X,2) THEN  8550
  189. 8520 NEXT X
  190. 8550 IF N=0 THEN 8560
  191. 8551 IF N>8 THEN N=8
  192. 8552 Z=Z-F(2,N)
  193. 8560 IF Z<=0 THEN E6=0
  194. 8562 IF Z<=0 THEN RETURN
  195. 8564 IF K$(3,15)="W" THEN E6=Z/52
  196. 8565 IF K$(3,15)="B" THEN E6=Z/26
  197. 8566 IF K$(3,15)="S" THEN E6=Z/24
  198. 8567 IF K$(3,15)="M" THEN E6=Z/12
  199. 8570 RETURN
  200. 9000 print #1,i;n(2,1),n(2,2),n$,n,r,h1,h2,h3,e0,e1,e2,f1,f2,f3,\
  201.           e3,e4,e5,e6,e7,e8,s1,s2,s3,m1,m2,m3
  202. 9015 N$=""
  203. 9020 NEXT I
  204. 9030 close 1
  205. 9040 close 2
  206. 10000 chain "master5"
  207. 15000    print clear$:print:print "CHECKING FILE LENGTH"
  208.     PRINT:PRINT "*** PLEASE WAIT ***"
  209.     open z5$ recl 512 as 1
  210.     z3=(size(z5$)*block.size)/512
  211.     for z2=1 to z3
  212.     read #1,z2;n(2,1),n(2,2)
  213.     if n(2,2)=0 then 15300
  214.     next z2
  215. 15300    z3=int(z3)-2
  216.     close 1
  217.     create z7$ as 1
  218.     print #1;z2,z3
  219.     close 1
  220.     GOTO 1500
  221. 20000 REM THIS PART CALCULATES TOTAL HOURS
  222. 20010 H4=T4+(T5*1.5)+(T6*2)+T7+T8+T9:REM H4=HOURS FOR CALCULATION PURPOSES
  223. 20020 H1=T4+T5+T6+T7+T8+T9
  224. 20030 IF K$(3,14)="S" THEN GOSUB 25000
  225. 20500 RETURN
  226. 25000 REM THIS PART SETS H4 FOR PAYROLL CALCULATIONS TO A VALUE
  227. 25010 REM DETERMINED BY THE PAYROLL PERIOD
  228. 25020 IF K$(3,15)="W" THEN H4=40
  229. 25030 IF K$(3,15)="B" THEN H4=80
  230. 25040 IF K$(3,15)="S" THEN H4=86.66667
  231. 25050 IF K$(3,15)="M" THEN H4=173.33333
  232. 25500 RETURN
  233. 30000 REM THIS CALCULATES ANNUALIZED PAY BASED ON LENGTH OF PAY PERIOD
  234. 30010 E0=(H4*R)+T2: REM - GROSS PAY FOR PAYROLL PERIOD
  235. 30020 IF K$(3,15)="W" THEN P1=E0*52
  236. 30030 IF K$(3,15)="B" THEN P1=E0*26
  237. 30040 IF K$(3,15)="S" THEN P1=E0*24
  238. 30050 IF K$(3,15)="M" THEN P1=E0*12
  239. 34995 RETURN
  240. 40000 print "Install payroll disk in drive B."
  241.       input "Type return to continue ";line temp$
  242.       initialize
  243.       goto 1460
  244.