1  REM  ****  HP BASIC PROGRAM LIBRARY  ******************************
2  REM
3  REM        PAYREC:  CTC PAYROLL PROGRAM, PART 10 OF 34
4  REM
5  REM        36213  REV B  6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ***********************************
9  REM H$=(HU,EOF,CR,^,EOL)
10  DIM A$[30],B$[20],C$[10],D$[10],E$[22],H$[7]
11  DIM F[32]
50  C$="0123456789"
100  FILES E1,E2,EP1,EP2,ETRAN
200  READ E9,E7
210  DATA 2,17
220  N1=2*E9+1
300  IF  END #N1 THEN 350
310  FOR I=1 TO 200
325  READ #N1,I;E$,U6,T1,D$,T2,T3,T4,T5,T6,D1,T7
330  READ #N1;E$,U6,T1,D$,T2,T3,T4,T5,T6,D1,T7
335  NEXT I
340  PRINT "TRANSACTION FILE FULL--PLEASE EMPTY"
345  STOP 
350  IF  END #N1 THEN 360
352  T2=T3=T4=T5=T6=T7=0
355  GOTO 400
360  PRINT "ERROR--TRAN FILE AT EOF"
365  STOP 
400  PRINT H$[1,2]"ENTER TODAY'S DATE (MDDYY)";
410  INPUT D1
420  IF D1>9999 AND D1<10^6 THEN 435
425  PRINT "INVALID DATE"
430  GOTO 400
435  X=INT(D1/10^4)
440  IF X<1 OR X>12 THEN 425
445  X1=INT((D1-X*10^4)/100)
450  IF X1<1 OR X1>31 THEN 425
455  X2=D1-X*10^4-X1*100
540  T1=3
550  PRINT H$[1,2]"ACCUMULATED OR CURRENT PAY FILES (A/C)";
560  INPUT A$
565  IF A$="END" THEN 9999
570  IF A$[1,1]="A" THEN 600
590  T1=4
595  GOTO 5000
600  PRINT H$[1,2]"CLEAR QUARTERLY, YEARLY, OR BOTH;"
602  PRINT "INITIALIZE OR MODIFY TOTALS (Q/Y/B/I/M)";
610  INPUT D$
615  IF D$="END" THEN 9999
620  IF D$[1,1]#"Q" THEN 670
625  PRINT "CLEAR *ALL* QUARTER-TO-DATE TOTALS";
630  INPUT A$
640  IF A$#"YES" THEN 600
650  J1=13
655  J2=22
660  GOTO 3000
670  IF D$[1,1]#"Y" THEN 730
680  PRINT "CLEAR *ALL* YEAR-TO-DATE TOTALS";
690  INPUT A$
700  IF A$#"YES" THEN 600
710  J1=23
715  J2=32
720  GOTO 3000
730  IF D$[1,1]#"B" THEN 790
740  PRINT "CLEAR *BOTH* QUARTER AND YEAR-TO-DATE TOTALS";
750  INPUT A$
760  IF A$#"YES" THEN 600
770  J1=13
775  J2=32
780  GOTO 3000
790  IF D$[1,1]="M" THEN 1000
795  IF D$[1,1]="I" THEN 6000
800  PRINT '7'7'7'7"WHAT";
810  GOTO 610
1000  REM
1010  GOSUB 2300
1065  S=S1=0
1070  PRINT 
1080  PRINT TAB(25)"QTD";TAB(37)"YTD"
1090  PRINT 
1100  PRINT " 1) FICA:";
1125  I=13
1130  GOSUB 2000
1135  PRINT " 2) WITH HOLDING:";
1140  GOSUB 2000
1150  PRINT " 3) STATE TAX:";
1160  GOSUB 2000
1170  PRINT " 4) DISABILITY:";
1180  GOSUB 2000
1190  PRINT " 5) CITY TAX:";
1200  GOSUB 2000
1205  PRINT " 6) ADVANCE:";
1210  GOSUB 2000
1220  PRINT " 7) AUTO:";
1225  GOSUB 2000
1227  PRINT " 8) INSURANCE:";
1228  GOSUB 2000
1230  PRINT TAB(20)"---------   ---------"
1231  PRINT TAB(19);
1233  X9=S
1234  GOSUB 2070
1235  X9=S1
1236  GOSUB 2070
1238  PRINT 
1239  PRINT 
1240  F=F[21]-S
1241  F1=F[31]-S1
1242  PRINT " 9) GROSS:";
1243  GOSUB 2000
1244  PRINT "    NET=";TAB(19);
1245  X9=F
1247  GOSUB 2070
1248  X9=F1
1249  GOSUB 2070
1250  PRINT 
1251  PRINT "10) SICK PAY:";
1252  GOSUB 2000
1260  PRINT "11) NO CHANGE"
1262  PRINT 
1270  PRINT "MODIFY NO (Q/Y)";
1280  INPUT B$
1282  IF B$[1,2]="11" THEN 1000
1285  L=LEN(B$)
1286  IF L<2 OR L>3 THEN 1297
1287  A$=B$[1,L-1]
1290  GOSUB 4200
1295  IF  NOT B1 THEN 1330
1297  PRINT '7'7'7'7'7'7'7'7"INVALID DATA"H$[3,5];
1300  GOTO 1270
1330  IF Z<1 OR Z>10 THEN 1297
1332  T2=Z
1335  IF B$[L,L]#"Q" THEN 1350
1340  X0=12
1345  X1=19
1347  GOTO 1365
1350  IF B$[L,L]#"Y" THEN 1297
1355  X0=22
1360  X1=31
1365  D$[2,2]=B$[L,L]
1370  GOTO Z OF 1375,1390,1400,1410,1420,1430,1440,1450,1460,1470
1375  J1=17
1380  GOTO 1480
1390  J1=16
1395  GOTO 1480
1400  J1=15
1405  GOTO 1480
1410  J1=14
1415  GOTO 1480
1420  J1=13
1425  GOTO 1480
1430  J1=12
1435  GOTO 1480
1440  J1=11
1445  GOTO 1480
1450  J1=10
1455  GOTO 1480
1460  J1=6
1465  GOTO 1480
1470  J1=4
1480  GOSUB 2100
1482  L0=2
1485  GOSUB 2200
1490  IF B1 THEN 1297
1495  T3=F[T2+X0]
1500  T5=F[T2+X0]=X
1510  MAT  PRINT #(N+E9),R1;F
1520  GOSUB 9200
1530  GOTO 1270
2000  PRINT TAB(19);
2005  X9=F[I]
2010  GOSUB 2070
2020  X9=F[I+10]
2030  GOSUB 2070
2035  S=S+F[I]
2037  S1=S1+F[I+10]
2040  PRINT 
2050  I=I+1
2055  X$=" "
2060  RETURN 
2070  X$=" "
2071  Z$="$+#####."
2072  X8=X9*100
2073  Z[1]=INT(X8/100)
2074  GOSUB 9000
2075  X$="0"
2076  Z$="##  "
2077  Z[1]=X8-INT(X8/100)*100
2080  GOSUB 9000
2085  RETURN 
2100  FOR I=1 TO J1
2110  PRINT H$[4,4];
2120  NEXT I
2130  FOR I=1 TO X1
2135  PRINT H$[6,6];
2140  NEXT I
2145  INPUT B$
2150  FOR I=1 TO J1-1
2160  PRINT ""
2170  NEXT I
2180  RETURN 
2200  B1=0
2201  S6=1
2202  IF B$[1,1]#"-" THEN 2205
2203  S6=-1
2204  B$=B$[2]
2205  L=LEN(B$)
2210  IF L<L0+2 OR L>8 THEN 2280
2215  IF B$[L-L0,L-L0]#"." THEN 2280
2220  A$=B$[1,L-(L0+1)]
2225  GOSUB 4200
2230  IF B1 THEN 2270
2235  X=Z
2240  A$=B$[L-(L0-1)]
2245  GOSUB 4200
2250  IF B1 THEN 2270
2260  X=(X+Z*10^(-L0))*S6
2270  RETURN 
2280  B1=1
2290  RETURN 
2300  PRINT H$[1,2]"EMPLOYEE NUMBER";
2310  INPUT A$
2320  IF A$="END" THEN 9999
2330  GOSUB 4000
2340  IF B1 THEN 2300
2350  U6=Z
2360  GOSUB 4085
2370  IF B1 THEN 2300
2380  MAT  READ #(N+E9),R1;F
2390  RETURN 
3000  REM * CLEAR QTD, YTD, OR BOTH *
3005  PRINT "W A I T !"'13;
3010  FOR I1=E9+1 TO E9*2
3030  FOR I2=1 TO 200
3040  MAT  READ #I1,I2;F
3180  FOR J=J1 TO J2
3190  F[J]=0
3200  NEXT J
3210  MAT  PRINT #I1,I2;F
3215  NEXT I2
3220  NEXT I1
3230  E$=""
3240  U6=0
3250  GOSUB 9200
3260  END 
4000  REM *FIND LOGICAL LOCATION AND READ RECORD*
4002  GOSUB 4200
4005  IF  NOT B1 THEN 4015
4010  PRINT '7'7'7'7"INVALID DATA";H$[3,5];
4011  B1=1
4012  RETURN 
4015  IF Z<1001 THEN 4010
4020  R=Z-1000
4050  FOR I=1 TO E9
4055  IF R <= I*200 THEN 4080
4060  NEXT I
4065  PRINT "EMP#>";1000+E9*200;" FILE SPACE LIMIT";H$[3,5];
4070  B1=1
4075  RETURN 
4080  N=I
4081  R1=R-(I-1)*200
4082  RETURN 
4085  B1=0
4090  READ #N,R1;E$,E
4100  IF E#-1 THEN 4120
4110  PRINT '7'7'7'7"EMPLOYEE NUMBER NOT IN USE"
4115  B1=1
4117  RETURN 
4120  PRINT E$;
4130  INPUT A$
4140  IF A$[1,1]="N" THEN 4115
4150  RETURN 
4200  B1=Z=0
4210  FOR I1=1 TO LEN(A$)
4220  FOR I2=1 TO 10
4225  IF A$[I1,I1]=C$[I2,I2] THEN 4245
4230  NEXT I2
4240  B1=1
4242  RETURN 
4245  Z=Z*10+I2-1
4250  NEXT I1
4255  RETURN 
5000  PRINT H$[1,2]"CLEAR EMP HRS, CLEAR ACCRUED VAC. HRS,"
5001  PRINT "CLEAR ACCRUED SICK HRS, OR MOD CURRENT PAY (CE/CV/CS/M)";
5002  INPUT D$
5003  IF D$[1,2]#"CE" THEN 5010
5004  PRINT '7'7"CLEAR *ALL* EMPLOYEE HRS";
5005  INPUT A$
5006  IF A$[1,1]#"Y" THEN 5000
5007  J1=1
5008  J2=10
5009  GOTO 3000
5010  IF D$[1,2]#"CV" THEN 5016
5011  PRINT '7'7"CLEAR *ALL* ACCRUED VACATION HRS";
5012  INPUT A$
5013  IF A$[1,1]#"Y" THEN 5000
5014  J1=J2=11
5015  GOTO 3000
5016  IF D$[1,2]#"CS" THEN 5022
5017  PRINT '7'7"CLEAR *ALL* ACCRUED SICK HRS";
5018  INPUT A$
5019  IF A$[1,1]#"Y" THEN 5000
5020  J1=J2=12
5021  GOTO 3000
5022  IF D$[1,1]="M" THEN 5025
5023  PRINT '7'7"WHAT";
5024  GOTO 5002
5025  D$="CP"
5026  GOSUB 2300
5027  FOR I=1 TO 12
5028  GOTO I OF 5030,5040,5050,5060,5080,5090,5100,5110,5120,5130
5029  GOTO I-10 OF 5133,5135
5030  A$=" 1) REG HOURS:"
5035  GOTO 5160
5040  A$=" 2) O/T HOURS:"
5045  GOTO 5160
5050  A$=" 3) SICK HOURS:"
5055  GOTO 5160
5060  A$=" 4) VAC. HOURS:"
5065  GOTO 5160
5080  A$=" 5) REG EARNINGS: $"
5085  GOTO 5160
5090  A$=" 6) O.T. EARN: $"
5095  GOTO 5160
5100  A$=" 7) OTHER EARN: $"
5105  GOTO 5160
5110  A$=" 8) GROSS: $"
5115  GOTO 5160
5120  A$=" 9) F.I.C.A: $"
5125  GOTO 5160
5130  A$="10) FEDERAL: $"
5131  GOTO 5160
5133  A$="11) ACCRUED VAC. HRS:"
5134  GOTO 5160
5135  A$="12) ACCRUED SICK HRS:"
5160  PRINT A$;TAB(25);F[I]
5170  NEXT I
5175  PRINT "13) NO CHANGE"
5180  PRINT 
5185  PRINT "MODIFY#";
5190  INPUT A$
5195  GOSUB 4200
5200  IF Z>0 AND Z<13 THEN 5215
5202  IF Z=13 THEN 5026
5205  PRINT '7'7'7'7'7"INVALID DATA";H$[3,5];
5210  GOTO 5185
5215  T2=Z
5220  J1=16-Z
5225  X1=25
5230  GOSUB 2100
5232  L0=2
5233  IF T2<11 THEN 5240
5235  L0=3
5240  GOSUB 2200
5245  IF B1 THEN 5205
5250  T3=F[T2]
5252  T5=F[T2]=X
5280  MAT  PRINT #(N+E9),R1;F
5285  GOSUB 9200
5290  GOTO 5185
6000  GOSUB 2300
6010  J=13
6015  A$="F.I.C.A."
6020  GOSUB 6200
6025  A$="WITH HOLDING"
6030  GOSUB 6200
6035  FOR I=1 TO 6
6036  GOTO I OF 6037,6039,6041,6043,6045,6047
6037  A$="STATE TAX"
6038  GOTO 6048
6039  A$="DISABILITY"
6040  GOTO 6048
6041  A$="CITY TAX"
6042  GOTO 6048
6043  A$="ADVANCE"
6044  GOTO 6048
6045  A$="AUTO"
6046  GOTO 6048
6047  A$="INSURANCE"
6048  PRINT A$
6049  GOSUB 6210
6050  NEXT I
6052  A$="GROSS"
6053  GOSUB 6200
6055  A$="SICK PAY"
6060  GOSUB 6200
6075  PRINT 
6080  PRINT "IS THE ABOVE ALL RIGHT";
6085  INPUT A$
6090  IF A$[1,1]="N" THEN 6000
6095  MAT  PRINT #(N+E9),R1;F
6097  GOSUB 9200
6098  GOTO 6000
6200  PRINT A$
6210  PRINT TAB(3)"QTD=";
6215  INPUT B$
6217  L0=2
6220  GOSUB 2200
6225  IF  NOT B1 THEN 6237
6230  PRINT '7'7'7"INVALID DATA";H$[3,5];
6235  GOTO 6210
6237  F[J]=X
6240  PRINT TAB(3)"YTD=";
6245  INPUT B$
6247  L0=2
6250  GOSUB 2200
6255  IF  NOT B1 THEN 6270
6260  PRINT '7'7'7'7'7"INVALID DATA";H$[3,5];
6265  GOTO 6240
6270  F[J+10]=X
6275  J=J+1
6280  RETURN 
9000  REM
9003  LET Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9004  DIM Y$[10],Z$[72]
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 
9200  PRINT #N1;E$[1,22],U6,T1,D$[1,2],T2,T3,T4,T5,T6,D1,T7
9210  IF TYP(-N1)=3 THEN 340
9220  PRINT #N1; END 
9225  PRINT H$[3,5];
9230  RETURN 
9999  END 
