1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        APAGV:   CTC ACCOUNTS PAYABLE
4  REM
5  REM        36638 REV  A   PART 22 OF 24   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  REM  H$=""
10  DIM A$[20],H$[5],L$[58],T$[58]
11  DIM Q[4,8],C[600],D[2]
12  DIM V[3],W[15]
100  FILES PN1,PN2,PN3,PC1,PC2,*S3,*S4
160  C8=3
170  C=0
200  C6=600
400  PRINT H$[1,2];H$[2,2]"(1) TOP OF FORM (2) ABDICK";
405  INPUT P5
410  PRINT "CURRENT DATE";
415  INPUT X
420  G1=INT(X/10^4)
425  G2=INT((X-G1*10^4)/100)
430  G3=X-G1*10^4-G2*100
445  PRINT "BEGINNING VENDOR# (0=FIRST)";
450  INPUT U9
455  IF U9 >= 0 AND U9 <= C8*400 THEN 500
460  PRINT '7'7"INVALID VENDOR#";H$[3,5];
465  GOTO 445
500  PRINT "START WITH (1) SUPP (2) Q-R (3) EMP";
505  INPUT U8
510  IF U8=1 OR U8=2 OR U8=3 THEN 600
515  PRINT '7'7"WHAT";
520  GOTO 505
600  PRINT #7;P5,G1,G2,G3,U9,U8, END 
2000  REM
2100  FOR N0=4 TO 5
2105  FOR I1=1 TO 200
2110  MAT  READ #N0,I1;Q
2115  FOR I2=1 TO 4
2120  IF Q[I2,2]=0 THEN 2175
2122  IF Q[I2,2]<U9 THEN 2170
2125  U6=Q[I2,2]
2130  FOR I=1 TO C
2135  IF U6=C[I]-INT(C[I]/10^4)*10^4 THEN 2165
2140  NEXT I
2142  GOSUB 4500
2143  IF L1<U8 THEN 2170
2145  C=C+1
2150  IF C <= C6 THEN 2160
2152  PRINT '7'7"CK HELD FILE HAS >";C6;"VENDORS ON FILE";N0,I1,I2
2155  STOP 
2160  C[C]=L1*10^4+U6
2165  PRINT #6;Q[I2,2],N0*10^4+I1*10+I2, END 
2170  NEXT I2
2172  NEXT I1
2173  NEXT N0
2175  PRINT "TOT # VENDORS=";C
2176  PRINT #7;C, END 
2177  FOR I1=2 TO C
2180  FOR I2=I1 TO 2 STEP -1
2185  IF C[I2] >= C[I2-1] THEN 2210
2190  X=C[I2]
2195  C[I2]=C[I2-1]
2200  C[I2-1]=X
2205  NEXT I2
2210  NEXT I1
2220  FOR I1=1 TO C
2230  PRINT #7;C[I1], END 
2240  NEXT I1
2250  CHAIN "APAGVP",300
4500  B1=0
4505  X=U6
4510  FOR N=1 TO C8
4515  IF X<401 THEN 4550
4520  X=X-400
4525  NEXT N
4530  PRINT '7'7"ERR1"
4535  STOP 
4550  R=INT(X/2)
4555  R1=2
4560  IF R*2=X THEN 4575
4565  R=R+1
4567  R1=1
4575  READ #N,R;L$,D[1],T$,D[2]
4580  IF D[R1]#-1 THEN 4600
4585  B1=1
4590  RETURN 
4600  REM
4650  L1=INT(ABS(D[R1])/10^5)
4660  RETURN 
9999  END 
