1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        CKREG:  CTC PAYROLL PROGRAM, PART 16 OF 34
4  REM
5  REM        36213  REV B  6/73
6  REM
7  REM ****  CONTRIBUTED PROGRAM **************************************
10  DIM E$[22],A$[20]
11  DIM F[32],E[17],S[15],Q[6,6]
12  DIM T[14,9],L[14],I[16]
100  FILES E1,E2,EP1,EP2,E0,AJ
165  PRINT "ALL DEDUC";
170  INPUT A$
175  P6=0
180  IF A$[1,1]="Y" THEN 200
185  P6=1
200  READ E9,E7
205  N1=E9*2+1
210  DATA 2,17
290  P=0
300  PRINT "CK DATE";
305  I=1
310  GOSUB 8300
330  PRINT "PER ENDING";
340  I=4
345  GOSUB 8300
360  PRINT "FIRST CHECK#";
365  INPUT C9
370  MAT T=ZER
400  PRINT "STATE#";
410  INPUT G3
420  PRINT "PAGE#";
425  INPUT P
430  P=P-1
440  L5=2
1000  IF  END #N1 THEN 1170
1010  READ #N1;X5
1015  IF SGN(X5)#-1 THEN 1185
1017  G1=INT(ABS(X5)/100)
1018  GOTO L5 OF 1022,1019
1019  IF G3=-1 THEN 1021
1020  IF G3#G1 THEN 1025
1021  L5=1
1022  GOSUB 8000
1025  G2=ABS(X5)-G1*100
1030  READ #N1;X5
1035  IF SGN(X5)#-1 THEN 1055
1040  I1=1
1045  GOSUB 1100
1050  GOTO 1017
1055  IF X5>99 THEN 1080
1060  I1=2
1065  GOSUB 1100
1070  G2=X5
1071  IF L5=2 THEN 1030
1072  GOSUB 8000
1075  GOTO 1030
1080  U6=X5
1085  GOSUB 4000
1086  GOSUB 4085
1087  IF S9 THEN 1030
1088  GOSUB 3000
1089  IF F[8]=0 OR L5=2 THEN 1030
1090  C9=C9+1
1095  GOTO 1030
1100  REM
1104  A$="DEPARTMENT"
1105  I2=1
1110  GOSUB 5000
1120  GOTO I1 OF 1130,1165,1130
1130  I2=4
1135  A$="STATE"
1136  GOTO L5 OF 1137,1140
1137  GOSUB 8000
1140  GOSUB 5000
1145  GOTO I1 OF 1165,1165,1150
1150  I2=7
1155  A$="COMPANY"
1157  GOSUB 8000
1160  GOSUB 5000
1165  RETURN 
1170  GOTO L5 OF 1172,1195
1172  I1=3
1175  GOSUB 1100
1180  END 
1185  PRINT "ERR1"
1190  STOP 
1195  PRINT "ST# NOT ON ST/DPT FILE"
1197  STOP 
3000  GOTO L5 OF 3010,3100
3010  PRINT TAB(8);
3015  X$=" "
3017  Z$="#### "
3020  Z[1]=G2
3025  GOSUB 9000
3030  PRINT TAB(18);
3035  Z[1]=U6
3040  GOSUB 9000
3045  PRINT E$;TAB(56);
3050  Z$="###.##   "
3055  FOR I=1 TO 2
3060  Z[1]=F[I]
3065  GOSUB 9000
3070  NEXT I
3075  Z[1]=F[3]+F[4]
3080  GOSUB 9000
3087  GOSUB 6000
3090  P9=P9+1
3095  GOSUB 4400
3100  IF L7=0 THEN 3255
3105  FOR I1=1 TO L7
3110  IF  END #(N1+1) THEN 3800
3115  MAT  READ #(N1+1);I
3120  IF I[1]#U6 THEN 3115
3125  MAT L=ZER
3128  A$="A"
3130  IF I[13]=1 THEN 3140
3132  A$="K"
3140  FOR I=4 TO 14
3142  L[I]=I[I-2]
3145  NEXT I
3150  GOTO L5 OF 3155,3158
3155  GOSUB 3400
3158  GOSUB I[13] OF 3635,3670
3160  NEXT I1
3165  READ #(N1+1),1
3167  GOTO L5 OF 3170,3255
3170  GOSUB 3700
3255  MAT L=ZER
3256  IF F[8]#0 THEN 3259
3258  GOTO L5 OF 3330,3350
3259  FOR I=1 TO 6
3260  L[I]=F[I+4]
3265  NEXT I
3270  L[13]=L[4]-L[5]-L[6]
3282  FOR I=7 TO 12
3285  L[I]=E[I+4]
3290  L[13]=L[13]-L[I]
3295  NEXT I
3300  L[14]=C9
3310  A$="C"
3312  GOTO L5 OF 3315,3317
3315  GOSUB 3400
3317  GOSUB 3600
3320  GOSUB 3670
3322  GOTO L5 OF 3325,3350
3325  GOSUB 3700
3330  K=1
3335  GOSUB 9910
3340  P9=P9+1
3345  GOSUB 4400
3350  RETURN 
3400  PRINT A$"  ";
3405  Z$="+#####."
3415  FOR J1=1 TO 4
3416  IF L[J1]#0 THEN 3420
3417  K=10
3418  GOSUB 9950
3419  GOTO 3430
3420  X=L[J1]
3425  GOSUB 5300
3430  NEXT J1
3433  PRINT " ";
3435  IF L[6]#0 THEN 3440
3436  K=10
3437  GOSUB 9950
3438  GOTO 3450
3440  X=L[6]
3445  GOSUB 5300
3450  Z$="+####."
3451  IF L[5]#0 THEN 3455
3452  K=9
3453  GOSUB 9950
3454  GOTO 3465
3455  X=L[5]
3460  GOSUB 5300
3465  FOR J1=7 TO 12
3466  IF L[J1]#0 THEN 3470
3467  K=9
3468  GOSUB 9950
3469  GOTO 3480
3470  X=L[J1]
3475  GOSUB 5300
3480  NEXT J1
3485  Z$="+#####."
3486  IF L[13]#0 THEN 3490
3487  K=10
3488  GOSUB 9950
3489  GOTO 3505
3490  X=L[13]
3495  GOSUB 5300
3500  X$=" "
3505  Z$="#####"
3506  IF L[14]=0 THEN 3520
3510  Z[1]=L[14]
3515  GOSUB 9000
3520  GOSUB 6000
3525  P9=P9+1
3530  GOSUB 4400
3535  RETURN 
3600  F[21]=F[21]+L[4]
3605  F[31]=F[31]+L[4]
3610  FOR I=13 TO 20
3615  F[I]=F[I]+L[I-8]
3617  F[I+10]=F[I+10]+L[I-8]
3620  NEXT I
3630  RETURN 
3635  L[14]=1
3637  FOR I=1 TO 14
3640  FOR J=1 TO 7 STEP 3
3645  T[I,J]=T[I,J]+L[I]
3650  NEXT J
3655  NEXT I
3660  RETURN 
3670  L[14]=1
3673  FOR I=1 TO 14
3675  FOR J=2 TO 8 STEP 3
3680  X=T[I,J]+INT(L[I])
3685  X1=T[I,J+1]+(L[I]-INT(L[I]))*100
3690  GOSUB 4500
3695  T[I,J]=X
3696  T[I,J+1]=X1
3697  NEXT J
3698  NEXT I
3699  RETURN 
3700  MAT L=ZER
3705  L[13]=L[4]=F[31]
3710  FOR I=5 TO 12
3715  L[I]=F[I+18]
3720  L[13]=L[13]-L[I]
3725  NEXT I
3730  L[14]=0
3732  A$="Y"
3735  GOSUB 3400
3740  RETURN 
3800  PRINT "ERR2";
3805  GOSUB 6000
3810  GOTO 3165
4000  B1=0
4010  R=U6-1000
4025  FOR I=1 TO E9
4030  IF R <= I*200 THEN 4050
4035  NEXT I
4040  B1=1
4045  RETURN 
4050  N=I
4055  R1=R-(I-1)*200
4060  RETURN 
4085  B1=0
4090  READ #N,R1;E$
4095  FOR I=1 TO E7
4100  READ #N;E[I]
4103  NEXT I
4105  IF E[1]=-1 THEN 4175
4120  B1=1
4130  X=INT(E[4]/10^4)
4140  S9=INT((E[4]-X*10^4)/1000)
4150  L7=INT(E[17]/10)
4160  IF  NOT P6 THEN 4173
4165  E[14]=E[15]=E[16]=0
4173  MAT  READ #(N+E9),R1;F
4175  RETURN 
4400  IF P9<58 THEN 4450
4425  K=66-P9
4430  GOSUB 9910
4440  GOSUB 8000
4450  RETURN 
4500  IF X1>-100 THEN 4530
4515  X=X-1
4520  X1=X1+100
4530  IF X1>99 THEN 4560
4535  IF SGN(X)*SGN(X1) >= 0 THEN 4550
4540  X=X-SGN(X)
4545  X1=X1-100*SGN(X1)
4550  RETURN 
4560  X=X+INT(X1*.01)
4565  X1=(X1*.01-INT(X1*.01))*100
4567  IF X1-INT(X1)<.9 THEN 4580
4570  X1=INT(X1)+1
4580  RETURN 
5000  GOTO L5 OF 5002,5184
5002  IF P9<48 THEN 5010
5005  GOSUB 4425
5010  PRINT TAB(20);A$" TOTALS";TAB(45)"ADJUSTMENTS     CURRENT";
5011  K=1
5012  GOSUB 9900
5013  PRINT TAB(22)"COMMISSIONS";TAB(58);
5014  X=T[4,I2+1]
5015  X1=T[4,I2+2]
5016  FOR I=1 TO 3
5017  X=X-T[I,I2+1]
5018  X1=X1-T[I,I2+2]
5020  NEXT I
5022  GOSUB 4500
5023  Z$="+######."
5024  GOSUB 5320
5025  GOSUB 6000
5030  FOR J=1 TO 13
5035  GOTO J OF 5045,5050,5055,5060,5065,5070,5075,5080,5085,5090
5040  GOTO J-10 OF 5095,5100,5105
5045  A$="REGULAR"
5047  GOTO 5110
5050  A$="OVERTIME"
5053  GOTO 5110
5055  A$="OTHER"
5057  GOTO 5110
5060  A$="GROSS"
5063  GOTO 5110
5065  A$="F.I.C.A."
5067  GOTO 5110
5070  A$="FEDERAL"
5073  GOTO 5110
5075  A$="STATE"
5077  GOTO 5110
5080  A$="DISABILITY"
5083  GOTO 5110
5085  A$="CITY TAX"
5087  GOTO 5110
5090  A$="ADVANCE"
5093  GOTO 5110
5095  A$="AUTO"
5097  GOTO 5110
5100  A$="INSURANCE"
5103  GOTO 5110
5105  A$="NET PAY"
5110  PRINT TAB(22);A$;TAB(47);
5115  Z$="+#####."
5120  X=T[J,I2]
5125  GOSUB 5300
5127  PRINT " ";
5130  X=T[J,I2+1]
5135  X1=T[J,I2+2]
5136  GOSUB 4500
5137  Z$="+######."
5140  GOSUB 5320
5150  GOSUB 6000
5155  NEXT J
5160  PRINT TAB(22);"COUNT";TAB(53);
5162  Z$="###         "
5164  X$=" "
5166  Z[1]=T[14,I2]
5170  GOSUB 9000
5175  Z[1]=T[14,I2+1]
5180  GOSUB 9000
5183  GOSUB 6000
5184  FOR J=1 TO 14
5186  FOR J1=I2 TO I2+2
5188  T[J,J1]=0
5190  NEXT J1
5191  NEXT J
5192  GOTO L5 OF 5197,5199
5197  K=66-P9-17
5198  GOSUB 9910
5199  RETURN 
5300  S=SGN(X)
5310  X2=ABS(X)*100
5312  X=INT(X2/100)*S
5313  X1=X2-ABS(X)*100
5320  Z[1]=X
5321  X$=" "
5322  GOSUB 9000
5323  A$=Z$
5325  Z$="## "
5330  X$="0"
5335  Z[1]=X1
5340  GOSUB 9000
5345  Z$=A$
5350  RETURN 
6000  PRINT 
6010  RETURN 
8000  K=2
8010  GOSUB 9910
8012  P=P+1
8015  PRINT TAB(8)"STATE:";G1;TAB(28)"PAGE:";P;TAB(45);
8020  PRINT "P A Y R O L L  C H E C K  R E G I S T E R    ";
8025  PRINT "CHECK DATE: ";
8030  Z$="##/##/##"
8032  X$=" "
8035  FOR I=1 TO 3
8040  Z[I]=D[I]
8045  NEXT I
8050  GOSUB 9000
8055  PRINT "  PER ENDING: ";
8060  FOR I=1 TO 3
8065  Z[I]=D[I+3]
8070  NEXT I
8075  GOSUB 9000
8085  K=1
8090  GOSUB 9900
8092  GOSUB 8200
8095  PRINT TAB(9);"DEPT# EMPLOY# NAME";TAB(48);
8100  PRINT "HOURS: REGULAR     O.T.    OTHER";
8102  GOSUB 6000
8103  PRINT "P";
8105  GOSUB 8200
8110  PRINT "E"TAB(16);"E A R N I N G S";TAB(71)"D E D U C T I O N S";
8115  GOSUB 6000
8120  PRINT "R   *REGULAR      O.T.     OTHER     GROSS*  *FEDERAL ";
8125  PRINT "F.I.C.A.    STATE    DISAB     CITY      ADV     AUTO";
8130  PRINT "      INS*  NET PAY   CK#";
8131  GOSUB 6000
8132  GOSUB 8200
8135  K=2
8140  GOSUB 9910
8145  P9=12
8150  RETURN 
8200  PRINT TAB(3);
8220  FOR I=1 TO 129
8230  PRINT "-";
8235  NEXT I
8245  GOSUB 6000
8250  RETURN 
8300  INPUT D
8305  D[I]=INT(D/10^4)
8307  IF D[I]>0 AND D[I]<13 THEN 8330
8310  PRINT '7'7"WHAT";
8317  GOTO 8300
8330  D[I+1]=INT((D-D[I]*10^4)/100)
8335  IF D[I+1]<1 OR D[I+1]>31 THEN 8310
8340  D[I+2]=D-D[I]*10^4-D[I+1]*100
8345  IF D[I+2]<71 OR D[I+2]>99 THEN 8310
8350  RETURN 
9000  Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9004  DIM Y$[10],Z$[15]
9005  LET Y$="0123456789"
9006  LET Z0=Z9-1
9007  LET Z0=Z0+1
9008  IF Z0=LEN(Z$)+1 THEN 9059
9009  IF Z$[Z0,Z0]="#" THEN 9016
9010  IF Z$[Z0,Z0+1]=".#" THEN 9016
9011  IF Z$[Z0,Z0+1]="+#" THEN 9014
9012  PRINT Z$[Z0,Z0];
9013  GOTO 9007
9014  LET Z4=0
9015  GOTO 9007
9016  LET Z=100
9017  LET Z6=Z[Z2]
9018  LET Z9=Z0-1
9019  LET Z9=Z9+1
9020  IF Z$[Z9,Z9]="." THEN 9023
9021  IF Z$[Z9,Z9]="#" THEN 9019
9022  GOTO 9027
9023  IF Z5#1 THEN 9027
9024  LET Z5=0
9025  LET Z=Z9
9026  GOTO 9019
9027  IF Z#100 THEN 9029
9028  LET Z=Z9
9029  IF Z4=1 THEN 9034
9030  IF Z6 >= 0 THEN 9033
9031  PRINT "-";
9032  GOTO 9034
9033  PRINT " ";
9034  LET Z6=ABS(Z6)+10^(Z-Z9-1)
9035  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
9036  IF Z$[Z-Z1,Z-Z1]#"." THEN 9041
9037  PRINT ".";
9038  LET Z3=0
9039  LET Z7=2
9040  GOTO 9055
9041  LET Z8=INT(Z6/(10^(Z1+Z7-2)))
9042  IF Z6<10^(Z-Z0) THEN 9045
9043  PRINT "#";
9044  GOTO 9055
9045  LET Z6=Z6-Z8*10^(Z1+Z7-2)
9046  IF Y$[Z8+1,Z8+1]="0" THEN 9048
9047  LET Z3=0
9048  IF Z3=0 THEN 9054
9049  IF Z1#1 THEN 9052
9050  PRINT "0";
9051  GOTO 9055
9052  PRINT X$;
9053  GOTO 9055
9054  PRINT Y$[Z8+1,Z8+1];
9055  NEXT Z1
9056  LET Z3=Z4=Z5=Z7=1
9057  LET Z2=Z2+1
9058  GOTO 9006
9059  RETURN 
9900  GOSUB 6000
9910  FOR I=1 TO K
9915  PRINT "     ";
9920  GOSUB 6000
9930  NEXT I
9940  RETURN 
9950  FOR I=1 TO K
9960  PRINT " ";
9970  NEXT I
9980  RETURN 
9999  END 
