1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        APCHPT:   CTC ACCOUNTS PAYABLE
4  REM
5  REM        36638 REV  A   PART 6 OF 24   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  REM  H$=""
10  DIM L$[58],T$[58],A$[20],X$[1],Z$[20],Y$[10],H$[5]
11  DIM D[2],Q[4,8],T[3,2],C[450],U[6]
12  MAT C=ZER
13  MAT T=ZER
14  P9=0
20  Y$="0123456789"
100  FILES PN1,PN2,PN3,PC1,PC2,*S3
150  C8=3
200  PRINT H$[1,2]"DISPLAY, PRINT OR GRAND (D/P/G)";
210  INPUT A$
220  IF A$[1,1]="D" THEN 1000
225  IF A$[1,1]="P" THEN 2000
227  IF A$[1,1]="G" THEN 1300
230  GOSUB 4250
235  GOTO 200
1000  PRINT H$[1,2]"VENDOR#";
1005  INPUT U6
1007  IF U6=0 THEN 9999
1010  IF U6>0 AND U6 <= C8*400 THEN 1025
1015  GOSUB 4250
1020  GOTO 1000
1025  GOSUB 4500
1030  IF  NOT B1 THEN 1045
1035  PRINT '7'7"VENDOR# NOT IN USE"
1040  GOTO 1000
1045  PRINT T$;
1050  INPUT A$
1055  IF A$[1,1]#"Y" THEN 1000
1057  PRINT 
1058  FOR N0=4 TO 5
1060  FOR I1=1 TO 200
1065  MAT  READ #N0,I1;Q
1070  FOR I2=1 TO 4
1075  IF Q[I2,2]=0 THEN 1130
1080  IF Q[I2,2]#U6 THEN 1115
1082  GOSUB 3000
1085  PRINT Q[I2,1];TAB(10)"$";Q[I2,3];TAB(20);
1090  GOSUB 3600
1110  PRINT 
1115  NEXT I2
1120  NEXT I1
1125  NEXT N0
1130  PRINT 
1132  PRINT "ANY MORE VENDORS";
1135  INPUT A$
1140  IF A$[1,1]#"Y" THEN 9999
1145  GOTO 1000
1300  FOR N0=4 TO 5
1302  FOR I1=1 TO 200
1305  MAT  READ #N0,I1;Q
1310  FOR I2=1 TO 4
1315  IF Q[I2,2]=0 THEN 1360
1316  U6=Q[I2,2]
1317  L1=1
1318  GOSUB 4500
1320  X=Q[I2,3]*100
1325  X2=T[L1,1]+INT(X/100)
1330  X3=T[L1,2]+X-INT(X/100)*100
1335  GOSUB 3500
1340  T[L1,1]=X2
1342  T[L1,2]=X3
1345  NEXT I2
1350  NEXT I1
1355  NEXT N0
1360  PRINT 
1362  PRINT "CHECKS HELD TOTALS:"
1363  X2=X3=0
1365  FOR C0=1 TO 3
1370  GOSUB 3220
1372  X=T[C0,1]
1375  X1=T[C0,2]
1377  PRINT ":";TAB(20);
1380  GOSUB 3405
1382  X2=X2+T[C0,1]
1385  X3=X3+T[C0,2]
1387  GOSUB 3500
1395  NEXT C0
1405  PRINT "GRAND TOTAL:";TAB(20);
1410  X=X2
1415  X1=X3
1420  GOSUB 3405
1430  END 
2000  PRINT "(1) TOP OF FORM OR (2) ABDICK";
2010  INPUT P5
2015  PRINT "CURRENT DATE";
2020  INPUT X
2025  G1=INT(X/10^4)
2040  G2=INT((X-G1*10^4)/100)
2050  G3=X-G1*10^4-G2*100
2060  P=C=0
2065  MAT T=ZER
2070  PRINT "START WITH (1) SUPP. (2) Q-R (3) EMP";
2075  INPUT U8
2080  IF U8=1 OR U8=2 OR U8=3 THEN 2095
2085  GOSUB 4250
2090  GOTO 2070
2095  PRINT "BEG. VEND# (0=FIRST)";
2097  INPUT U9
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
2145  GOSUB 4500
2150  IF L1<U8 THEN 2170
2155  C=C+1
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
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  C0=INT(C[1]/10^4)
2312  GOSUB 3200
2315  FOR C1=1 TO C
2320  X0=INT(C[C1]/10^4)
2322  U6=C[C1]-X0*10^4
2325  IF X0=C0 THEN 2350
2330  F1=2
2332  PRINT "TOTAL";
2335  GOSUB 3100
2340  C0=X0
2345  GOSUB 3200
2350  Z$="####/"
2360  X$=" "
2365  Z[1]=U6
2367  PRINT TAB(15);
2370  GOSUB 9000
2375  GOSUB 4500
2380  PRINT T$;
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  F1=1
2432  PRINT TAB(15)"TOTAL";
2435  GOSUB 3100
2440  NEXT C1
2442  F1=2
2444  PRINT "TOTAL";
2446  GOSUB 3100
2450  F1=3
2455  PRINT "GRAND TOTAL";
2460  GOSUB 3100
2470  END 
2500  Z$="######"
2505  X$=" "
2510  Z[1]=Q[I2,1]
2515  PRINT TAB(51);
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  GOSUB 3405
2590  X2=T[1,1]+X
2595  X3=T[1,2]+X1
2597  GOSUB 3500
2600  T[1,1]=X2
2605  T[1,2]=X3
2630  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
3050  RETURN 
3100  X=T[F1,1]
3105  X1=T[F1,2]
3110  GOSUB 3400
3165  IF F1=3 THEN 3197
3170  X2=T[F1+1,1]+T[F1,1]
3175  X3=T[F1+1,2]+T[F1,2]
3180  GOSUB 3500
3185  T[F1+1,1]=X2
3190  T[F1+1,2]=X3
3195  T[F1,1]=T[F1,2]=0
3197  RETURN 
3200  K=1
3205  GOSUB 9910
3210  P9=P9+1
3215  GOSUB 3300
3220  GOTO C0 OF 3230,3250,3270
3230  PRINT "SUPPLIER";
3240  RETURN 
3250  PRINT "QUICK RELEASE";
3260  RETURN 
3270  PRINT "EMPLOYEE";
3280  RETURN 
3300  IF P9<60 THEN 3320
3310  GOSUB 8000
3320  RETURN 
3400  PRINT TAB(70)'16;TAB(42);
3405  Z$="$+########."
3410  X$=" "
3415  Z[1]=X
3420  GOSUB 9000
3425  Z$="##"
3430  X$="0"
3435  Z[1]=X1
3440  GOSUB 9000
3445  K=1
3450  GOSUB 9900
3455  P9=P9+2
3460  GOSUB 3300
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$=" "
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
3630  IF I=6 THEN 3675
3640  PRINT ",";
3645  NEXT I
3650  RETURN 
3675  PRINT " ";
3680  RETURN 
4250  PRINT '7'7"INVALID DATA";H$[3,5];
4260  B1=1
4270  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 
6010  FOR Z=1 TO 50
6015  PRINT '21;
6020  NEXT Z
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$="##/##/##"
8045  X$=" "
8050  Z[1]=G1
8055  Z[2]=G2
8060  Z[3]=G3
8062  PRINT "DATE: ";
8065  GOSUB 9000
8070  PRINT TAB(40)"A C C O U N T S  P A Y A B L E";TAB(71)'16;TAB(30);"PAGE: ";
8075  Z$="###"
8080  P=P+1
8085  Z[1]=P
8090  GOSUB 9000
8095  GOSUB 6000
8100  PRINT TAB(47)"CHECKS HELD FILE";
8115  K=2
8120  GOSUB 9900
8125  PRINT "TYPE";TAB(15)"VENDOR#/NAME";TAB(51)"CHECK#    INVOICE DATES";
8130  PRINT '16;TAB(30)"AMOUNT";
8135  K=2
8140  GOSUB 9900
8150  P9=11
8160  RETURN 
9000  REM
9003  LET Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9006  LET Z0=Z9-1
9007  LET Z0=Z0+1
9008  IF Z0=LEN(Z$)+1 THEN 9059
9009  IF Z$[Z0,Z0]="#" THEN 9016
9010  IF Z$[Z0,Z0+1]=".#" THEN 9016
9011  IF Z$[Z0,Z0+1]="+#" THEN 9014
9012  PRINT Z$[Z0,Z0];
9013  GOTO 9007
9014  LET Z4=0
9015  GOTO 9007
9016  LET Z=100
9017  LET Z6=Z[Z2]
9018  LET Z9=Z0-1
9019  LET Z9=Z9+1
9020  IF Z$[Z9,Z9]="." THEN 9023
9021  IF Z$[Z9,Z9]="#" THEN 9019
9022  GOTO 9027
9023  IF Z5#1 THEN 9027
9024  LET Z5=0
9025  LET Z=Z9
9026  GOTO 9019
9027  IF Z#100 THEN 9029
9028  LET Z=Z9
9029  IF Z4=1 THEN 9034
9030  IF Z6 >= 0 THEN 9033
9031  PRINT "-";
9032  GOTO 9034
9033  PRINT " ";
9034  LET Z6=ABS(Z6)+10^(Z-Z9-1)
9035  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
9036  IF Z$[Z-Z1,Z-Z1]#"." THEN 9041
9037  PRINT ".";
9038  LET Z3=0
9039  LET Z7=2
9040  GOTO 9055
9041  LET Z8=INT(Z6/(10^(Z1+Z7-2)))
9042  IF Z6<10^(Z-Z0) THEN 9045
9043  PRINT "#";
9044  GOTO 9055
9045  LET Z6=Z6-Z8*10^(Z1+Z7-2)
9046  IF Y$[Z8+1,Z8+1]="0" THEN 9048
9047  LET Z3=0
9048  IF Z3=0 THEN 9054
9049  IF Z1#1 THEN 9052
9050  PRINT "0";
9051  GOTO 9055
9052  PRINT X$;
9053  GOTO 9055
9054  PRINT Y$[Z8+1,Z8+1];
9055  NEXT Z1
9056  LET Z3=Z4=Z5=Z7=1
9057  LET Z2=Z2+1
9058  GOTO 9006
9059  RETURN 
9900  GOSUB 6000
9910  FOR I=1 TO K
9920  PRINT 
9940  NEXT I
9945  RETURN 
9999  END 
