1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        APCKAS:   CTC ACCOUNTS PAYABLE
4  REM
5  REM        36638 REV  A   PART 15 OF 24   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  REM  H$=""
10  DIM I$[10],H$[5]
11  DIM P[29],C[200],E[100,2],F[200,2],S[9,2]
12  P9=0
100  FILES PI1,*S3,S0
200  PRINT H$"ACCOUNTS PAYABLE AUTO CHECK ASSIGNMENT PROGRAM"
205  PRINT 
210  PRINT "USE INPUT FILE: PI1,PI2";
215  INPUT I$
220  IF I$="PI1" THEN 240
225  IF I$="PI2" THEN 240
230  PRINT '7'7'7"WHAT";
235  GOTO 215
240  ASSIGN I$,1,W5
245  PRINT "BEGINNING CHECK#";
250  INPUT C9
255  PRINT "(1) TOP OF FORM OR (2) ABDICK";
260  INPUT P5
265  PRINT "CURRENT DATE";
270  INPUT X
275  PRINT #3;I$,P5,X, END 
280  PRINT "READY (ALIGN PAPER)";
285  INPUT I$
300  C=R=F=0
302  FOR I1=1 TO 200
305  READ #1,I1;I$
310  IF I$="" THEN 350
315  MAT  READ #1;P
320  IF P[28] <= 0 THEN 325
321  F=F+1
322  F[F,1]=P[28]
323  F[F,2]=I1
324  GOTO 350
325  FOR I=1 TO C
330  IF C[I]=P[1] THEN 350
335  NEXT I
340  C=C+1
345  C[C]=P[1]
350  NEXT I1
400  FOR I=2 TO C
405  FOR J=I TO 2 STEP -1
410  IF C[J] >= C[J-1] THEN 435
415  X=C[J]
420  C[J]=C[J-1]
425  C[J-1]=X
430  NEXT J
435  NEXT I
440  PRINT C;"DIFFERENT AUTO VENDORS"
1000  FOR C1=1 TO C
1001  MAT E=ZER
1002  E=0
1003  PRINT C[C1]
1004  P9=P9+1
1005  FOR I1=1 TO 200
1010  READ #1,I1;I$
1015  IF I$="" THEN 1060
1020  MAT  READ #1;P
1025  IF P[1]#C[C1] THEN 1060
1030  E=E+1
1035  E[E,1]=I1
1040  GOSUB 3000
1050  E[E,2]=T*10^4+X0
1060  NEXT I1
1065  FOR I=2 TO E
1070  FOR J=I TO 2 STEP -1
1075  IF E[J,2] >= E[J-1,2] THEN 1110
1080  FOR J1=1 TO 2
1085  X=E[J,J1]
1090  E[J,J1]=E[J-1,J1]
1095  E[J-1,J1]=X
1100  NEXT J1
1105  NEXT J
1110  NEXT I
1120  T1=0
1122  T0=INT(E[1,2]/10^4)
1123  D=E[1,2]-T0*10^4
1125  FOR E1=1 TO E
1130  READ #1,E[E1,1];I$
1135  MAT  READ #1;P
1136  T=INT(E[E1,2]/10^4)
1137  D1=E[E1,2]-T*10^4
1140  IF T0#T THEN 1145
1142  IF D=D1 AND T1<6 THEN 1190
1145  T1=0
1147  T0=T
1150  C9=C9+1
1155  D=D1
1190  T1=T1+1
1200  P[28]=-C9
1205  R=R+1
1210  PRINT #2,R;I$
1215  MAT  PRINT #2;P
1220  NEXT E1
1222  C9=C9+1
1230  NEXT C1
1232  PRINT F;"HAND INVOICES"
1235  FOR I=1 TO F
1237  FOR J=I TO 2 STEP -1
1240  IF F[J,1] >= F[J-1,1] THEN 1260
1242  FOR J1=1 TO 2
1245  X=F[J,J1]
1247  F[J,J1]=F[J-1,J1]
1250  F[J-1,J1]=X
1252  NEXT J1
1255  NEXT J
1260  NEXT I
1265  FOR I=1 TO F
1267  READ #1,F[I,2];I$
1270  MAT  READ #1;P
1272  R=R+1
1275  PRINT #2,R;I$
1280  MAT  PRINT #2;P
1290  NEXT I
1300  MAT P=ZER
1305  I$=""
1310  FOR I=R+1 TO 200
1315  PRINT #2,I;I$
1320  MAT  PRINT #2;P
1325  NEXT I
1327  PRINT "COPYING - DO NOT BREAK"
1340  FOR I=1 TO 200
1345  READ #2,I;I$
1350  MAT  READ #2;P
1360  PRINT #1,I;I$
1370  MAT  PRINT #1;P
1380  NEXT I
1382  P9=P9+3
1385  PRINT #3;P9-INT(P9/66)*66
1390  CHAIN "APCKRG",50
1400  END 
3000  X=INT(P[2]/10^4)
3005  X1=INT((P[2]-X*10^4)/100)
3010  X0=(P[2]-X*10^4-X1*100)*100+X
4100  IF C[C1]#502 THEN 4205
4105  J=1
4107  FOR I=4 TO 18 STEP 5
4110  S[J,1]=P[I]
4115  S[J,2]=INT(P[I+1]/100)
4120  S[J+1,1]=P[I+1]-S[J,2]*100
4125  X=INT(P[I+2]/100)
4130  S[J+1,1]=S[J+1,1]*10^4+X
4135  S[J+1,2]=(P[I+2]-X*100)*100
4140  X=INT(P[I+3]/10^4)
4145  S[J+1,2]=S[J+1,2]+X
4150  S[J+2,1]=(P[I+3]-X*10^4)*100
4155  X=INT(P[I+4]/10^4)
4160  S[J+2,1]=S[J+2,1]+X
4165  S[J+2,2]=P[I+4]-X*10^4
4170  J=J+3
4175  NEXT I
4180  REM
4185  T=0
4190  FOR I=1 TO 9
4195  IF S[I,1]=9000 AND S[I,2]=9115 THEN 4220
4200  NEXT I
4205  T=1
4220  RETURN 
9999  END 
