1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        APPERG:   CTC ACCOUNTS PAYABLE
4  REM
5  REM        36638 REV  A   PART 14 OF 24   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  REM  H$=""
10  DIM L$[58],M$[58],A$[20],X$[1],Z$[20],Y$[10]
11  DIM D[2],Q[8],H[32],J[6,6],U[6],V[100]
12  DIM H$[5]
13  DIM T$[58]
14  MAT Q=ZER
15  Q3=0
20  Y$="0123456789"
100  FILES PN1,PN2,PN3,PC1,PC2,*S3,*S4,PH1
110  C8=3
150  PRINT "(1) TOP OF FORM OR (2) ABDICK";
155  INPUT P5
160  PRINT "CURRENT DATE";
165  INPUT X
170  G1=INT(X/10^4)
175  G2=INT((X-G1*10^4)/100)
180  G3=X-G1*10^4-G2*100
200  PRINT H$[1,2]"A/P CHECK PURGE FROM CHECKS HELD FILE"
210  PRINT 
215  PRINT "REASON FOR PURGING CHECKS (1) VOID (2) RELEASED";
220  INPUT P6
225  IF P6=1 OR P6=2 THEN 240
230  GOSUB 4250
235  GOTO 215
240  P6=P6-1
300  V=P=0
310  MAT V=ZER
320  PRINT "ENTER CHECKS TO BE PURGED (0 ENDS INPUT LOOP)"
321  PRINT 
322  Z$="###. CK NO."
323  X$=" "
325  Z[1]=V+1
327  GOSUB 9000
330  INPUT X
335  IF X=0 THEN 385
340  IF X>0 AND X<10^5 THEN 355
345  GOSUB 4250
350  GOTO 327
355  V=V+1
360  V[V]=X
362  IF V<100 THEN 325
365  PRINT '7'7"LIMIT OF 100 CHECKS PURGED AT ONE TIME"
385  PRINT 
387  PRINT "ANY CORRECTIONS";
390  INPUT A$
395  IF A$[1,1]="N" THEN 500
400  PRINT "REF#";
405  INPUT X
407  IF X=0 THEN 500
410  IF X>0 AND X <= V THEN 425
415  GOSUB 4250
420  GOTO 400
425  PRINT "NEW VALUE";
430  INPUT V[X]
435  GOTO 400
500  PRINT "READY TO PURGE";
510  INPUT A$
515  IF A$[1,1]#"Y" THEN 387
520  FOR I=2 TO V
525  FOR I1=I TO 2 STEP -1
530  IF V[I1] >= V[I1-1] THEN 560
535  X=V[I1]
540  V[I1]=V[I1-1]
545  V[I1-1]=X
550  NEXT I1
560  NEXT I
948  IF Z3=0 THEN 9054
1000  P9=66
1005  GOSUB 8000
1010  V0=1
1015  N0=4
1020  N1=6
1025  IF  END #N0 THEN 1125
1035  MAT  READ #N0;Q
1040  IF Q[2]=0 THEN 1135
1045  IF Q[1]<V[V0] THEN 1110
1050  GOSUB 3000
1055  GOSUB 2500
1060  IF Q[1]=V[V0] THEN 1080
1065  PRINT TAB(19)"CHECK NOT ON CHECKS HELD FILE";
1070  GOSUB 2700
1075  V0=V0+1
1076  IF V0>V THEN 1310
1077  GOTO 1045
1080  GOSUB 2600
1085  IF L1=1 THEN 1095
1090  GOSUB 2000
1095  V0=V0+1
1100  IF V0>V THEN 1300
1105  GOTO 1035
1110  IF  END #N1 THEN 1200
1115  MAT  PRINT #N1;Q
1120  GOTO 1035
1125  N0=N0+1
1130  IF N0<6 THEN 1025
1135  FOR V0=V0 TO V
1140  GOSUB 2500
1145  PRINT TAB(19)"CHECK NOT ON CHECKS HELD FILE";
1150  GOSUB 2700
1155  NEXT V0
1160  MAT Q=ZER
1165  IF  END #N1 THEN 1180
1170  MAT  PRINT #N1;Q
1175  GOTO 1170
1180  N1=N1+1
1185  IF N1<8 THEN 1165
1190  PRINT TAB(19)"TOTAL AMT PURGED";TAB(50);'16;TAB(42);
1191  Q[3]=Q3
1192  GOSUB 2655
1193  GOSUB 9800
1195  END 
1200  N1=N1+1
1205  IF N1<8 THEN 1110
1210  PRINT '7'7"ERR1"
1215  STOP 
1300  IF  END #N0 THEN 1325
1305  MAT  READ #N0;Q
1307  IF Q[1]=0 THEN 1160
1310  IF  END #N1 THEN 1340
1315  MAT  PRINT #N1;Q
1320  GOTO 1300
1325  N0=N0+1
1330  IF N0<6 THEN 1300
1335  GOTO 1160
1340  N1=N1+1
1345  IF N1<8 THEN 1310
1350  PRINT '7'7'7"ERR2"
1360  STOP 
2000  FOR J1=1 TO 200
2010  MAT  READ #8,J1;H[32]
2015  IF H[1]=0 THEN 2030
2020  IF Q[2]=H[1] THEN 2040
2025  NEXT J1
2030  PRINT '7'7"PROG ERR";Q[2]
2035  STOP 
2040  GOSUB 2200
2042  I3=7
2045  FOR I=1 TO 6
2047  X=INT(H[I+1]/10)
2050  IF X=Q[1] THEN 2150
2055  IF X<0 THEN 2105
2056  IF X<Q[1] OR I3#7 THEN 2060
2057  I3=I
2060  NEXT I
2065  PRINT TAB(19)"CHECK";INT(H[2]/10);"DELETED FROM VENDOR";H[1];
2070  GOSUB 2700
2080  FOR I=2 TO 6
2085  H[I]=H[I+1]
2090  FOR J=1 TO 6
2095  J[I-1,J]=J[I,J]
2100  NEXT J
2102  NEXT I
2103  I3=6
2104  GOTO 2117
2105  IF I3#7 THEN 2110
2106  I3=I
2107  GOTO 2117
2110  FOR I=6 TO I3+1 STEP -1
2111  H[I+1]=H[I]
2112  FOR J=1 TO 6
2113  J[I,J]=J[I-1,J]
2114  NEXT J
2115  NEXT I
2117  H[I3+1]=Q[1]*10+P6
2120  FOR J=1 TO 6
2125  J[I3,J]=U[J]
2130  NEXT J
2135  GOSUB 2300
2140  MAT  PRINT #8,J1;H
2145  RETURN 
2150  PRINT TAB(19)"CHECK ALREADY ON VENDOR HISTORY FILE";
2155  GOSUB 2700
2160  RETURN 
2200  J=1
2205  FOR I=8 TO 31 STEP 4
2210  J2=1
2215  FOR J3=I TO I+3 STEP 2
2220  J[J,J2]=INT(H[J3]/100)
2225  J[J,J2+1]=H[J3]-J[J,J2]*100
2230  X=INT(H[J3+1]/10^4)
2235  J[J,J2+1]=J[J,J2+1]*100+X
2240  J[J,J2+2]=H[J3+1]-X*10^4
2245  J2=J2+3
2250  NEXT J3
2260  J=J+1
2265  NEXT I
2270  RETURN 
2300  J=1
2305  FOR I=8 TO 31 STEP 4
2310  J2=1
2315  FOR J3=I TO I+3 STEP 2
2320  X=INT(J[J,J2+1]/100)
2325  H[J3]=J[J,J2]*100+X
2330  H[J3+1]=(J[J,J2+1]-X*100)*10^4+J[J,J2+2]
2335  J2=J2+3
2340  NEXT J3
2345  J=J+1
2350  NEXT I
2360  RETURN 
2500  Z$="###.  ######  "
2505  X$=" "
2510  Z[1]=V0
2515  Z[2]=V[V0]
2520  GOSUB 9000
2530  RETURN 
2600  Z$="####/"
2605  U6=Z[1]=Q[2]
2610  GOSUB 9000
2615  GOSUB 4500
2620  PRINT T$;TAB(50);
2625  Z$="##/##, "
2630  FOR I=1 TO 6
2631  IF U[I]#0 THEN 2635
2632  PRINT "       ";
2633  GOTO 2650
2635  Z[1]=INT(U[I]/100)
2640  Z[2]=U[I]-Z[1]*100
2645  GOSUB 9000
2650  NEXT I
2655  Z$="$+######."
2656  X0=Q[3]*100
2657  X=INT(ABS(X0)/100)
2660  Z[1]=X*SGN(Q[3])
2665  GOSUB 9000
2670  Z$="##"
2675  X$="0"
2680  Z[1]=ABS(X0)-X*100
2685  GOSUB 9000
2687  Q3=Q3+Q[3]
2690  GOSUB 2700
2697  RETURN 
2700  K=1
2710  GOSUB 9900
2720  P9=P9+2
2730  IF P9<60 THEN 2745
2735  GOSUB 8000
2745  RETURN 
3000  J=1
3005  FOR I=4 TO 6 STEP 2
3010  U[J]=INT(Q[I]/100)
3015  U[J+1]=Q[I]-U[J]*100
3020  X=INT(Q[I+1]/10^4)
3025  U[J+1]=U[J+1]*100+X
3030  U[J+2]=Q[I+1]-X*10^4
3035  J=J+3
3040  NEXT I
3050  RETURN 
4250  PRINT '7'7"INVALID DATA";H$[3,5];
4255  B1=1
4260  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],M$,D[2]
4580  IF D[R1]#-1 THEN 4600
4582  T$=""
4585  B1=1
4590  RETURN 
4600  T$=L$
4605  IF R1=1 THEN 4620
4610  T$=M$
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=SGN(D[R1])
4660  RETURN 
6000  PRINT 
6030  RETURN 
8000  GOTO P5 OF 8010,8020
8010  PRINT '12'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18'18;
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  A$=" VOIDED "
8065  IF P6=0 THEN 8070
8066  A$=" RELEASED "
8070  PRINT "CHECKS";A$;"FROM CHECKS HELD FILE -- ";
8072  GOSUB 9000
8073  PRINT TAB(71)"PAGE: ";
8075  Z$="###"
8080  P=P+1
8085  Z[1]=P
8090  GOSUB 9000
8095  K=2
8100  GOSUB 9900
8110  P9=7
8120  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 
9800  FOR I=4 TO 7
9805  READ #I,1
9810  NEXT I
9820  FOR N=6 TO 7
9825  FOR R=1 TO 800
9830  MAT  READ #N;Q
9835  MAT  PRINT #(N-2);Q
9840  NEXT R
9850  NEXT N
9860  RETURN 
9900  GOSUB 6000
9910  FOR I=1 TO K
9920  PRINT 
9940  NEXT I
9945  RETURN 
9999  END 
