1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        APDIST:   CTC ACCOUNTS PAYABLE
4  REM
5  REM        36638 REV  A   PART 12 OF 24   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
8  REM  H$=""
10  DIM Y$[10],H$[5],X$[1],I$[10],Z$[20]
11  DIM P[29],S[9,2],T[2,2],U[300,2]
100  FILES PI1,*S3
110  C9=1
120  Y$="0123456789"
121  PRINT "USE INPUT FILE:  PI1 OR PI2";
122  INPUT I$
123  IF I$="PI1" THEN 127
124  IF I$="PI2" THEN 127
125  PRINT '7'7'7"WHAT";
126  GOTO 122
127  ASSIGN I$,1,W5
130  MAT T=ZER
140  MAT S=ZER
150  P=J4=0
160  PRINT H$[1,2]"(1) TOP OF FORM OR (2) ABDICK";
165  INPUT P5
200  PRINT "CURRENT DATE";
205  INPUT X
210  D1=INT(X/10^4)
215  IF D1>0 AND D1<13 THEN 230
220  PRINT '7'7"INVALID DATE";H$[3,5];
225  GOTO 200
230  D2=INT((X-D1*10^4)/100)
235  IF D2<1 OR D2>31 THEN 220
240  D3=X-D1*10^4-D2*100
245  IF D3<72 OR D3>99 THEN 220
300  PRINT "READING"
305  FOR N=1 TO C9
310  FOR R=1 TO 200
315  GOSUB 4100
317  IF B1 OR P[28]=0 THEN 390
330  FOR J1=1 TO 9
335  IF S[J1,1]=0 AND S[J1,2]=0 THEN 380
337  PRINT #2;S[J1,1],S[J1,2],P[28],P[J1+18], END 
340  FOR J2=1 TO J4
345  IF S[J1,1]=U[J2,1] AND S[J1,2]=U[J2,2] THEN 380
350  NEXT J2
360  J4=J4+1
365  IF J4 <= 300 THEN 370
366  PRINT '7'7"# OF DIFF ACCT#S IS >300"
367  STOP 
370  U[J4,1]=S[J1,1]
372  U[J4,2]=S[J1,2]
380  NEXT J1
390  NEXT R
395  NEXT N
400  PRINT "SORTING"
405  FOR J1=2 TO J4
410  FOR J2=J1 TO 2 STEP -1
415  IF U[J2,1]>U[J2-1,1] THEN 460
420  IF U[J2,1]<U[J2-1,1] THEN 430
425  IF U[J2,2] >= U[J2-1,2] THEN 460
430  FOR I=1 TO 2
435  X=U[J2,I]
440  U[J2,I]=U[J2-1,I]
445  U[J2-1,I]=X
450  NEXT I
455  NEXT J2
460  NEXT J1
500  P9=66
510  GOSUB 8000
1000  FOR J1=1 TO J4
1005  I1=1
1007  READ #2,1
1010  IF  END #2 THEN 1100
1015  READ #2;S[I1,1],S[I1,2],P[28],P[I1+18]
1020  IF S[I1,1]#U[J1,1] OR S[I1,2]#U[J1,2] THEN 1015
1025  GOSUB 2000
1030  GOTO 1015
1100  I=1
1105  GOSUB 1300
1107  I=2
1110  X=T[1,1]
1112  X1=T[1,2]
1115  GOSUB 2200
1117  T[1,1]=T[1,2]=0
1120  NEXT J1
1130  I=2
1140  GOSUB 1310
1150  END 
1300  PRINT TAB(48)"TOTAL";
1305  GOTO 1315
1310  PRINT TAB(48)"GRAND TOTAL";
1315  X=T[I,1]
1320  X1=T[I,2]
1330  GOSUB 1400
1340  K=1
1350  GOSUB 9910
1360  P9=P9+1
1370  IF P9<60 THEN 1390
1380  GOSUB 8000
1390  RETURN 
1400  PRINT TAB(70)"     ";
1405  Z$="$-"
1407  IF SGN(X)<0 OR SGN(X1)<0 THEN 1410
1408  Z$="$ "
1410  Z$[3]="######."
1420  X$=" "
1430  Z[1]=X
1440  GOSUB 9000
1450  Z$="##"
1460  X$="0"
1470  Z[1]=X1
1475  GOSUB 9000
1480  K=1
1485  GOSUB 9900
1490  P9=P9+2
1495  IF P9<60 THEN 1500
1497  GOSUB 8000
1500  RETURN 
2000  PRINT TAB(48);
2010  X$=" "
2015  IF S[I1,1]#0 THEN 2030
2020  PRINT "      ";
2025  GOTO 2050
2030  Z$="######"
2035  Z[1]=S[I1,1]
2040  GOSUB 9000
2045  X$="0"
2050  Z$="####"
2055  Z[1]=S[I1,2]
2060  GOSUB 9000
2065  PRINT TAB(64);
2070  Z$="######     "
2075  X$=" "
2080  Z[1]=P[28]
2085  GOSUB 9000
2090  X0=P[I1+18]*100
2095  X=INT(ABS(X0)/100)
2100  X1=(ABS(X0)-X*100)*SGN(X0)
2105  X=X*SGN(X0)
2110  GOSUB 1410
2120  I=1
2130  GOSUB 2200
2140  RETURN 
2200  X2=T[I,1]+X
2205  X3=T[I,2]+X1
2210  GOSUB 3500
2215  T[I,1]=X2
2220  T[I,2]=X3
2230  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 
4100  B1=1
4102  READ #N,R;I$
4103  MAT  READ #N;P
4104  IF P[1]=0 THEN 4180
4105  B1=0
4106  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  RETURN 
6000  PRINT 
6005  FOR L0=1 TO 50
6010  PRINT '18;
6020  NEXT L0
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[1]=D1
8045  Z[2]=D2
8050  Z[3]=D3
8055  PRINT TAB(28)"DATE: ";
8060  Z$="##/##/##"
8062  X$=" "
8065  GOSUB 9000
8070  PRINT TAB(51)"A C C O U N T S  P A Y A B L E";'16;TAB(13)"PAGE: ";
8075  Z$="###"
8080  P=P+1
8085  Z[1]=P
8090  GOSUB 9000
8095  GOSUB 6000
8100  PRINT TAB(56)"ACCOUNT DISTRIBUTION";
8115  K=2
8120  GOSUB 9900
8125  PRINT TAB(48)"ACCOUNT#";TAB(66)"REF#         AMOUNT";
8140  K=2
8145  GOSUB 9900
8150  P9=11
8160  RETURN 
9000  REM
9040  V=Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
9050  DIM V$[72]
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
9915  PRINT 
9930  NEXT I
9940  RETURN 
9999  END 
