1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        PAYPER:  CTC PAYROLL PROGRAM, PART 8 OF 34
4  REM
5  REM        36213  REV B  6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  H$=""
9  REM H$=(HU,EOF,CR,^,EOL)
10  DIM E$[30],B$[15],X$[20],A$[15],C$[10]
11  DIM F[32],I[16],E[20]
13  DIM H$[7],D$[10]
50  C$="0123456789"
100  FILES E1,E2,EP1,EP2,ETRAN,AJ
200  READ E9,E7
210  DATA 2,17
220  N1=E9*2+1
300  GOSUB 9100
310  T1=2
330  IF  END #N1 THEN 9230
340  IF  END #(N1+1) THEN 9300
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*1^4-X1*100
1000  PRINT "REGULAR PAYROLL, COMMISSIONS, OR ADJUSTMENTS (R/C/A)";
1005  INPUT D$
1007  PRINT H$[1,2];
1010  IF D$[1,1]="R" THEN 1100
1020  IF D$[1,1]="C" THEN 2000
1025  IF D$[1,1]="A" THEN 2000
1030  PRINT '7'7'7"WHAT";
1040  GOTO 1005
1100  GOSUB 5000
1102  GOSUB 3000
1105  T2=T3=T4=T5=T6=T7=R=O=S=V=M=0
1110  PRINT "HOURS";H$[5,5];
1115  INPUT B$
1120  IF B$="END" THEN 1260
1130  L=LEN(B$)
1132  IF L>4 THEN 1135
1133  GOSUB 2520
1134  GOTO 1110
1135  X$=B$[L,L]
1140  B$=B$[1,L-1]
1142  K=7
1145  GOSUB 2500
1150  IF B1 THEN 1110
1155  IF X$#"R" THEN 1170
1160  T2=R=X
1165  GOTO 1110
1170  IF X$#"O" THEN 1185
1175  T3=O=X
1180  GOTO 1110
1185  IF X$#"S" THEN 1200
1190  T4=S=X
1195  GOTO 1110
1200  IF X$#"V" THEN 1220
1205  T5=V=X
1210  GOTO 1110
1220  REM
1250  PRINT '7'7'7'7"INVALID HOURS CODE";H$[3,5];
1255  GOTO 1110
1260  REM
1265  MAT  READ #(E9+N),R1;F
1270  F[1]=R+F[1]
1275  F[2]=O+F[2]
1280  F[3]=S+F[3]
1285  F[4]=V+F[4]
1290  MAT  PRINT #(N+E9),R1;F
1292  PRINT 
1293  GOSUB 9200
1295  GOTO 1102
2000  T2=T3=T4=T5=T6=T7=0
2002  GOSUB 5060
2010  MAT I=ZER
2012  I[13]=1
2013  IF D$[1,1]="A" THEN 2015
2014  I[13]=2
2015  GOSUB 3000
2020  I[1]=U6
2025  FOR I3=2 TO 12
2027  GOTO I[13] OF 2030,2033
2030  GOTO I3-1 OF 2050,2060,2070,2080,2090,2095,2100,2105,2108,2111,2114
2033  GOTO I3-1 OF 2035,2140,2140,2600,2090,2095,2100,2106,2109,2140,2114
2035  REM
2040  X$="COMMISSION AMOUNT"
2045  GOTO 2120
2050  X$="GROSS"
2055  GOTO 2120
2060  REM
2062  X$="F.I.C.A."
2065  GOTO 2120
2070  REM
2072  X$="FEDERAL"
2075  GOTO 2120
2080  X$="STATE"
2085  GOTO 2120
2090  REM
2091  X$="DISABILITY"
2092  GOTO 2120
2095  X$="CITY TAX"
2097  GOTO 2120
2100  X$="ADVANCE"
2103  GOTO 2120
2105  REM
2106  X$="AUTO"
2107  GOTO 2120
2108  REM
2109  X$="INSURANCE"
2110  GOTO 2120
2111  REM
2112  X$="NET PAY"
2113  GOTO 2120
2114  X$="CHECK#"
2120  PRINT X$;
2121  INPUT B$
2122  IF I3=12 THEN 2132
2123  K=9
2125  GOSUB 2500
2130  IF B1 THEN 2120
2131  GOTO 2139
2132  A$=B$
2133  GOSUB 4200
2134  IF  NOT B1 THEN 2137
2135  GOSUB 2520
2136  GOTO 2120
2137  X=Z
2139  I[I3]=X
2140  NEXT I3
2185  PRINT "IS THE ABOVE ALL RIGHT";
2190  INPUT A$
2195  IF A$[1,1]="N" THEN 2220
2200  E[17]=(L7+1)*10+L8
2205  GOSUB 2400
2210  MAT  PRINT #(N1+1);I
2212  PRINT #(N1+1); END 
2215  GOSUB 9200
2220  PRINT 
2225  GOTO 2010
2400  PRINT #N,R1;E$
2410  FOR I=1 TO E7
2415  PRINT #N;E[I]
2420  NEXT I
2430  RETURN 
2500  B1=0
2501  S2=1
2502  IF B$[1,1]#"-" THEN 2510
2504  S2=-1
2506  B$=B$[2]
2510  L=LEN(B$)
2515  IF L>3 AND L<K THEN 2540
2520  PRINT '7'7'7'7"INVALID DATA";H$[3,5];
2530  B1=1
2535  RETURN 
2540  IF B$[L-2,L-2]#"." THEN 2520
2545  A$=B$[1,L-3]
2550  GOSUB 4200
2555  IF B1 THEN 2520
2557  X=Z
2560  A$=B$[L-1]
2565  GOSUB 4200
2570  IF B1 THEN 2520
2575  X=(X+Z*.01)*S2
2580  RETURN 
2600  PRINT "STANDARD OR NEW DEDUCTIONS (S/N)";
2605  INPUT A$
2610  IF A$[1,1]="N" THEN 2080
2615  FOR I=5 TO 10
2620  I[I]=E[I+6]
2625  NEXT I
2630  GOTO 2185
3000  PRINT "EMPLOYEE NUMBER";
3010  INPUT A$
3020  IF A$="END" THEN 9999
3030  GOSUB 4000
3040  IF B1 THEN 3000
3050  GOSUB 4085
3060  IF B1 THEN 3100
3070  PRINT '7'7'7'7"EMPLOYEE# NOT IN USE";H$[3,5];
3080  GOTO 3000
3100  PRINT E$;
3110  INPUT X$
3120  IF X$[1,1]="Y" THEN 3150
3130  PRINT H$[3,4];H$[4,5];
3140  GOTO 3000
3150  RETURN 
4000  REM *FIND LOGICAL LOCATION AND READ RECORD*
4002  GOSUB 4200
4005  IF  NOT B1 THEN 4015
4010  PRINT '7'7'7'7'7"INVALID DATA";H$[3,5];
4011  B1=1
4012  RETURN 
4015  IF Z<1001 THEN 4010
4017  U6=Z
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
4087  READ #N,R1;E$
4090  FOR I=1 TO E7
4095  READ #N;E[I]
4100  NEXT I
4130  IF E[1]=-1 THEN 4155
4140  L7=INT(E[17]/10)
4145  L8=E[17]-L7*10
4150  B1=1
4155  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 '7'7'7'7'7'7'7'7'7"DO YOU NEED TO CLEAR *ALL* PREVIOUS EMPLOYEE HOURS FIRST";
5005  INPUT A$
5010  IF A$[1,1]#"Y" THEN 5050
5015  PRINT "RUN PROGRAM--PAYREC TO CLEAR EMPLOYEE HOURS"
5020  STOP 
5050  RETURN 
5060  PRINT '7'7'7'7'7'7'7'7"DO YOU NEED TO CLEAR THE COMMISSION/ADJUSTMENT FILE FIRST";
5065  INPUT A$
5070  IF A$="NO" THEN 5090
5075  PRINT "RUN PROGRAM--CLRAJ TO CLEAR THE COMMISSION/ADJUSTMENT FILE"
5080  STOP 
5090  RETURN 
9100  IF  END #N1 THEN 9170
9110  FOR I=1 TO 200
9120  READ #N1,I;E$,U6,T1,D$,T2,T3,T4,T5,T6,D1,T7
9130  READ #N1;E$,U6,T1,D$,T2,T3,T4,T5,T6,D1,T7
9140  NEXT I
9150  GOTO 9250
9170  IF  END #(N1+1) THEN 9190
9175  FOR I=1 TO 200
9180  MAT  READ #(N1+1),I;I
9185  MAT  READ #(N1+1);I
9187  NEXT I
9188  GOTO 9300
9190  RETURN 
9200  PRINT #N1;E$[1,22],U6,T1,D$[1,1],T2,T3,T4,T5,T6,D1,T7
9210  IF TYP(-(N1))=3 THEN 9250
9215  PRINT #N1; END 
9220  RETURN 
9230  PRINT "PROG ERROR*T-FILE AT EOF"
9240  STOP 
9250  PRINT "TRANSACTION FILE FULL--PLEASE EMPTY"
9260  STOP 
9300  PRINT '7'7'7'7"ADJUSTMENT-COMMISSION FILE FULL"
9999  END 
