1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        APCHAG:   CTC ACCOUNTS PAYABLE
4  REM
5  REM        36638 REV  A   PART 20 OF 24   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  REM  H$=""
9  DIM B$[4],C$[4],D$[4]
10  DIM L$[58],T$[58],A$[20],X$[1],Z$[20],Y$[10],H$[5]
11  DIM D[2],Q[4,8],C[500],U[6],T[10,2],W[10]
12  Q5=0
13  MAT W=ZER
20  Y$="0123456789"
100  FILES PN1,PN2,PN3,PC1,PC2,*S3
150  C8=3
160  C6=500
170  P=C=W1=W2=0
180  MAT T=ZER
200  C6=600
210  DATA " DEC"," NOV"," OCT","SEPT"," AUG","JULY","JUNE"," MAY"
220  DATA " APR"," MAR"," FEB"," JAN"," DEC"," NOV"
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
435  FOR I=1 TO 13-G1
437  READ B$
440  NEXT I
442  READ C$,D$
445  PRINT "BEGINNING VENDOR# (0=FIRST)";
450  INPUT U9
455  IF U9 >= 0 AND U9 <= C8*400 THEN 2000
460  PRINT '7'7"INVALID VENDOR#";H$[3,5];
465  GOTO 445
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] THEN 2165
2140  NEXT I
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]=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
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
2300  P9=66
2305  GOSUB 8000
2310  A$="     "
2312  F1=1
2315  FOR C1=1 TO C
2350  Z$="####/"
2360  X$=" "
2365  Z[1]=U6=C[C1]
2370  GOSUB 9000
2375  GOSUB 4500
2380  PRINT T$
2381  P9=P9+1
2382  IF  END #6 THEN 2430
2385  READ #6,1
2390  READ #6;U7,X
2395  IF U7#U6 THEN 2390
2400  N0=INT(X/10^4)
2405  I1=INT((X-N0*10^4)/10)
2410  I2=X-N0*10^4-I1*10
2415  MAT  READ #N0,I1;Q
2417  GOSUB 3000
2420  GOSUB 2500
2425  GOTO 2390
2430  REM
2435  GOSUB 3100
2440  NEXT C1
2442  F1=6
2450  A$="GRAND"
2460  GOSUB 3100
2470  END 
2500  Z$="###### "
2505  X$=" "
2510  Z[1]=Q[I2,1]
2515  PRINT TAB(30);
2520  GOSUB 9000
2530  GOSUB 3600
2540  Q[I2,3]=Q[I2,3]*100
2575  X=INT(ABS(Q[I2,3])/100)
2580  X1=ABS(Q[I2,3])-X*100
2582  X=X*SGN(Q[I2,3])
2583  X1=X1*SGN(Q[I2,3])
2585  I=1
2590  GOSUB 2700
2592  W1=W1+1
2595  I=G1-U0
2597  IF I >= 0 AND I<3 THEN 2617
2600  IF I<0 THEN 2607
2602  I=3
2605  GOTO 2617
2607  IF I#-10 THEN 2610
2608  I=2
2609  GOTO 2617
2610  IF I#-11 THEN 2602
2612  I=1
2617  PRINT TAB(I*14);
2620  GOSUB 3400
2625  I=I+2
2630  GOSUB 2700
2635  W[I]=W[I]+Q5
2637  W[1]=W[1]+Q5
2640  K=1
2645  GOSUB 9900
2650  P9=P9+2
2655  GOSUB 3300
2660  FOR Z=1 TO 50
2662  PRINT '1;
2663  NEXT Z
2665  RETURN 
2700  X2=T[I,1]+X
2705  X3=T[I,2]+X1
2710  GOSUB 3500
2715  T[I,1]=X2
2720  T[I,2]=X3
2725  RETURN 
3000  J=1
3005  FOR I=4 TO 6 STEP 2
3010  U[J]=INT(Q[I2,I]/100)
3015  U[J+1]=Q[I2,I]-U[J]*100
3020  X=INT(Q[I2,I+1]/10^4)
3025  U[J+1]=U[J+1]*100+X
3030  U[J+2]=Q[I2,I+1]-X*10^4
3040  J=J+3
3045  NEXT I
3047  U0=INT(U[1]/100)
3050  RETURN 
3100  PRINT " ";A$;" TOT OF CK AMTS:";
3105  FOR J=F1 TO F1+4
3110  X=T[J,1]
3115  X1=T[J,2]
3120  IF J#2 AND J#7 THEN 3130
3125  PRINT TAB(55);A$;" TOT AGING AMTS:";
3130  PRINT " ";
3135  GOSUB 3400
3140  IF F1=6 THEN 3160
3145  I=J+5
3150  GOSUB 2700
3155  T[J,1]=T[J,2]=0
3160  NEXT J
3165  PRINT 
3170  PRINT TAB(6);A$;" INV COUNT:";
3175  Z$="         #####"
3180  X$=" "
3185  FOR J=F1 TO F1+4
3190  IF J#2 AND J#7 THEN 3200
3195  PRINT TAB(56);A$;" INVOICE COUNT:";
3200  REM
3205  Z[1]=W[J]
3210  GOSUB 9000
3215  IF F1=6 THEN 3230
3220  W[J+5]=W[J+5]+W[J]
3225  W[J]=0
3230  NEXT J
3231  PRINT 
3232  PRINT TAB(7);A$;" CK COUNT:";
3233  Z[1]=W1
3234  IF F1=1 THEN 3236
3235  Z[1]=W2
3236  GOSUB 9000
3237  W2=W2+W1
3238  W1=0
3240  K=3
3245  GOSUB 9900
3250  P9=P9+6
3260  GOSUB 3300
3270  RETURN 
3300  IF P9<58 THEN 3320
3310  GOSUB 8000
3320  RETURN 
3400  REM
3405  Z$="$+########."
3410  X$=" "
3415  Z[1]=X
3420  GOSUB 9000
3425  Z$="##"
3430  X$="0"
3435  Z[1]=X1
3440  GOSUB 9000
3465  RETURN 
3500  REM
3505  IF X3>-100 THEN 3520
3510  X2=X2-1
3515  X3=X3+100
3520  IF X3>99 THEN 3545
3525  IF SGN(X2)*SGN(X3) >= 0 THEN 3540
3530  X2=X2-SGN(X2)
3535  X3=X3-100*SGN(X3)
3540  RETURN 
3545  X2=X2+INT((X3*.01))
3550  X3=(X3*.01-INT(X3*.01))*100
3555  IF X3-INT(X3)<.9 THEN 3565
3560  X3=INT(X3)+1
3565  RETURN 
3600  Z$="##/##"
3605  X$=" "
3607  Q5=0
3610  FOR I=1 TO 6
3611  IF U[I]#0 THEN 3615
3612  PRINT "      ";
3613  GOTO 3645
3615  Z[1]=INT(U[I]/100)
3620  Z[2]=U[I]-Z[1]*100
3625  GOSUB 9000
3627  Q5=Q5+1
3630  IF I=6 THEN 3675
3640  PRINT ",";
3645  NEXT I
3647  PRINT "    ";'16;
3650  RETURN 
3675  PRINT "     ";'16;
3680  RETURN 
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
4582  T$=""
4585  B1=1
4590  RETURN 
4600  IF R1=2 THEN 4620
4610  T$=L$
4620  FOR I=1 TO LEN(T$)
4625  IF T$[I,I]='17 THEN 4640
4630  NEXT I
4640  T$=T$[1,I-1]
4650  L1=INT(ABS(D[R1])/10^5)
4660  RETURN 
6000  PRINT 
6030  RETURN 
8000  GOTO P5 OF 8010,8020
8010  PRINT '12;
8015  GOTO 8030
8020  K=66-P9
8025  GOSUB 9910
8030  K=4
8035  GOSUB 9910
8040  Z$="DATE: ##/##/##"
8045  X$=" "
8050  Z[1]=G1
8055  Z[2]=G2
8060  Z[3]=G3
8065  GOSUB 9000
8070  PRINT TAB(50)"A C C O U N T S  P A Y A B L E";'16;TAB(43)"PAGE: ";
8075  Z$="###"
8085  Z[1]=P=P+1
8090  GOSUB 9000
8095  GOSUB 6000
8100  PRINT TAB(53)"AGING OF CHECKS HELD FILE";
8115  K=2
8120  GOSUB 9900
8125  PRINT "VENDOR#/NAME";TAB(30)"CHECK# INVOICE DATES";TAB(70);'16;
8130  PRINT TAB(16);B$;TAB(30);C$;TAB(44);D$;"     ALL PRIOR";
8135  K=2
8140  GOSUB 9900
8150  P9=11
8160  RETURN 
9000  REM
9040  V=Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9050  DIM V$[20]
9070  Z0=Z9-1
9080  Z0=Z0+1
9090  IF Z0=LEN(Z$)+1 THEN 9650
9100  IF Z$[Z0,Z0]="#" THEN 9170
9110  IF Z$[Z0,Z0+1]=".#" THEN 9170
9120  IF Z$[Z0,Z0+1]="+#" THEN 9150
9130  V$[V,V]=Z$[Z0,Z0]
9131  V=V+1
9140  GOTO 9080
9150  Z4=0
9160  GOTO 9080
9170  Z=100
9180  Z6=Z[Z2]
9190  Z9=Z0-1
9200  Z9=Z9+1
9210  IF Z$[Z9,Z9]="." THEN 9240
9220  IF Z$[Z9,Z9]="#" THEN 9200
9230  GOTO 9280
9240  IF Z5#1 THEN 9280
9250  Z5=0
9260  Z=Z9
9270  GOTO 9200
9280  IF Z#100 THEN 9300
9290  Z=Z9
9300  IF Z4=1 THEN 9350
9310  IF Z6 >= 0 THEN 9340
9320  V$[V,V]="-"
9321  V=V+1
9330  GOTO 9350
9340  V$[V,V]=" "
9341  V=V+1
9350  IF Z=Z9 THEN 9380
9360  Z6=ABS(Z6)+5*10^(Z-Z9)
9370  GOTO 9390
9380  Z6=ABS(Z6)+.5
9390  Z7=10^(Z-Z0-1)
9400  Z4=10*Z7
9410  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
9420  IF Z1#0 THEN 9460
9430  V$[V,V]="."
9431  V=V+1
9440  Z3=0
9450  GOTO 9610
9460  Z8=INT(Z6/Z7)
9470  IF Z6<Z4 THEN 9500
9480  V$[V,V]="#"
9481  V=V+1
9490  GOTO 9600
9500  Z6=Z6-Z8*Z7
9510  IF Z8=0 THEN 9530
9520  Z3=0
9530  IF Z3=0 THEN 9590
9540  IF Z1#1 THEN 9570
9550  V$[V,V]="0"
9551  V=V+1
9560  GOTO 9600
9570  V$[V,V]=X$
9571  V=V+1
9580  GOTO 9600
9590  V$[V,V]=Y$[Z8+1,Z8+1]
9591  V=V+1
9600  Z7=Z7/10
9610  NEXT Z1
9620  Z3=Z4=Z5=Z7=1
9630  Z2=Z2+1
9640  GOTO 9070
9650  PRINT V$;
9660  V$=""
9670  RETURN 
9900  GOSUB 6000
9910  FOR I=1 TO K
9920  PRINT 
9940  NEXT I
9945  RETURN 
9999  END 
