1  REM  ****  HP BASIC PROGRAM LIBRARY  ******************************
2  REM
3  REM        ST/DPT:  CTC PAYROLL PROGRAM, PART 14 OF 34
4  REM
5  REM        36213  REV B  6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ***********************************
10  DIM E$[22],E[20],S[13],V[300]
11  DIM D$[5],H[50]
12  P8=0
100  FILES E1,E2,E0,ETRAN,EAUX
140  READ E9,E7
145  DATA 2,17
150  GOSUB 9300
155  T1=6
160  D$="S"
200  READ #(E9+3),1;A9,M9
220  PRINT "WHICH PRINTER: (1) ACCOUNTING (2) ABDICK";
225  INPUT P5
227  IF P5=1 OR P5=2 THEN 232
228  PRINT '7'7'7'7"WHAT";
230  GOTO 225
232  PRINT "ENTER TODAY'S DATE";
234  INPUT D1
236  IF D1<10^6 AND D1>9999 THEN 240
238  PRINT '7'7'7'7'7'7'7"INVALID DATE"
239  GOTO 232
240  X=INT(D1/10^4)
242  IF X<1 OR X>12 THEN 238
244  X1=INT((D1-X*10^4)/100)
246  IF X1<1 OR X1>31 THEN 238
250  X2=D1-X*10^4-X1*100
252  IF X2<72 THEN 238
260  GOSUB 2000
300  PRINT " ";
305  PRINT '18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18;
307  K=4
310  GOSUB 9910
315  PRINT "E M P L O Y E E  STATE/DEPT SORT -";X"/";X1"/";X2;
320  GOSUB 6000
330  GOSUB 8010
1000  FOR H0=1 TO H1
1002  G1=H[H0]
1005  K1=0
1010  FOR R=1 TO M9-1000
1020  GOSUB 4025
1030  GOSUB 4085
1035  IF  NOT B1 THEN 1065
1040  IF S[4]#G1 THEN 1065
1050  K1=K1+1
1060  V[K1]=S[2]*10^4+R+1000
1065  NEXT R
1066  IF K1=0 THEN 1165
1067  K=1
1068  GOSUB 9910
1069  P9=P9+1
1070  GOSUB 6130
1072  PRINT G1;
1075  FOR I1=2 TO K1
1080  FOR I2=I1 TO 2 STEP -1
1090  IF V[I2] >= V[I2-1] THEN 1115
1095  X=V[I2]
1100  V[I2]=V[I2-1]
1105  V[I2-1]=X
1110  NEXT I2
1115  NEXT I1
1120  G2=INT(V[1]/10^4)
1121  U6=V[1]-G2*10^4
1122  GOSUB 4000
1123  GOSUB 4085
1124  PRINT TAB(10);G2;TAB(20);U6;TAB(30);E$;
1125  GOSUB 6100
1126  PRINT #(E9+1);-(G1*100+G2),U6
1130  FOR L=2 TO K1
1135  G3=INT(V[L]/10^4)
1137  U6=V[L]-G3*10^4
1140  IF G2=G3 THEN 1150
1142  G2=G3
1145  PRINT #(E9+1);G2
1147  PRINT TAB(10);G2;
1150  PRINT #(E9+1);U6
1151  GOSUB 4000
1152  GOSUB 4085
1155  PRINT TAB(20);U6;TAB(30);E$;
1157  GOSUB 6100
1160  NEXT L
1165  NEXT H0
1170  PRINT #(E9+1); END 
1175  T2=T3=T4=T5=T6=T7=U6=0
1177  E$=""
1178  PRINT #(E9+2);E$[1,22],U6,T1,D$,T2,T3,T4,T5,T6,D1,T7, END 
1180  END 
2000  H1=0
2005  PRINT "STATE#";
2010  INPUT H2
2020  IF H2=-1 THEN 2095
2030  IF H2 >= 0 AND H2<51 THEN 2060
2040  PRINT '7'7"INVALID STATE#"
2050  GOTO 2005
2060  IF H1=0 THEN 2070
2065  IF H2<H[H1] THEN 2040
2070  H1=H1+1
2080  H[H1]=H2
2090  GOTO 2005
2095  RETURN 
4000  REM * READ E *
4005  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
4125  S[1]=INT(E[1]/10^4)
4130  S[2]=INT((E[1]-S[1]*10^4)/100)
4132  S[3]=E[1]-S[1]*10^4-S[2]*100
4134  S[4]=INT(E[2]/1000)
4136  X1=5
4140  FOR I=8 TO 13
4145  X=0
4147  X2=5
4150  FOR J=1 TO (I-8)
4153  X=X+S[J+7]*10^X2
4155  X2=X2-1
4160  NEXT J
4165  S[I]=INT((E[4]-X)/10^X1)
4170  X1=X1-1
4172  NEXT I
4175  RETURN 
6000  GOTO P5 OF 6010,6030
6010  PRINT '13;
6020  RETURN 
6030  PRINT 
6040  RETURN 
6100  K=1
6110  GOSUB 9900
6120  P9=P9+2
6130  IF P9<60 THEN 6200
6140  GOTO P5 OF 6170,6150
6150  K=66-P9
6160  GOSUB 9910
6170  GOSUB 8000
6200  RETURN 
8000  PRINT " "'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18;
8010  K=4
8020  GOSUB 9910
8030  PRINT "STATE"TAB(10);"DEPT"TAB(20);"EMP#"TAB(30);"EMPLOYEE NAME";
8040  K=2
8050  GOSUB 9900
8060  P9=7+P8
8070  P8=0
8080  RETURN 
9300  IF  END #(E9+2) THEN 9370
9310  FOR I=1 TO 200
9320  READ #(E9+2),I;E$,U6,T1,D$,T2,T3,T4,T5,T6,D1,T7
9330  READ #(E9+2);E$,U6,T1,D$,T2,T3,T4,T5,T6,D1,T7
9340  NEXT I
9350  PRINT "TRANSACTION FILE FULL--PLEASE EMPTY"
9355  STOP 
9370  IF  END #(E9+2) THEN 9380
9375  RETURN 
9380  PRINT "TRANS FILE AT EOF"
9385  STOP 
9900  GOSUB 6000
9910  FOR I=1 TO K
9920  PRINT "      ";
9930  GOSUB 6000
9940  NEXT I
9945  RETURN 
9999  END 
