Listing of file='ACPA010A' on disk='vmedia/701-2652C.wvd.zip'
# Sector 170, program filename = 'ACPA010A'
0010 REM ACPA010A, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 DIM A6$1,B6$1,C6$1,D6$8
: DIM K$1,K1$Q0,K2$Q0,K3$17
: DIM A6(6),A7(6)
: GOTO 4000
4000 SELECT @PARTS0$
4012 % ##,###,###.##-
4014 % ########
4020 K2$=ALL(FF)
: A6$="N"
: B6$="Y"
: P1=0
: K=9
: L=L0
: K1,K2,K3=0
: GOSUB '100("Y,N","NnYyY ",1,1,"PRINT REPORT (Y OR N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A6$=Q6$
: IF A6$="Y"THEN 4150
: $CLOSE#15
: GOTO 4230
4150 GOSUB '93(" ")
: IF I0$=" "THEN A6$="N"
: GOSUB '100("Y,N","NnYyY ",1,1,"SCREEN DISPLAY (Y OR N)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: B6$=Q6$
: IF B6$="N"AND A6$="N"THEN 5230
4230 PRINT AT(5,0,);TAB(16);"A = List all items"
: PRINT TAB(16);"B = List only items selected for payment"
: GOSUB '100("A,B","AaBb",1,1,"ENTER REPORT TYPE",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: C6$=Q6$
: PRINT AT(5,0,)
: GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE (A=ALL, R=RANGE, I=I
NDIVIDUAL)",2)
4320 IF Q6$=HEX(1F)THEN GOSUB '31
: K$=Q6$
: Q6$="ALL RANGE INDIVIDUAL"
: K3$=STR(Q6$,Q9*10-9,10)
: K3$=K3$&" OPTION"
: ON Q9GOTO ,4530,4440
: GOSUB '235(1,0)
: IF Q$="B"THEN 4000
: IF Q$>" "THEN 5320
: K1$=HEX(00)
: GOTO 4670
4440 K9=0
: GOSUB '34(HEX(08))
: IF Q6$="END"THEN 5230
: IF Q6$=" "THEN 4440
: K1$,K2$=Q6$
: GOTO 4613
4520 PRINT AT(3,0,80);"Starting ID must be lower than Ending ID.";HEX(07)
4530 MAT A6=ZER
: MAT A7=ZER
: K3=0
: K=9
: L=L0
: GOSUB '34("STARTING")
: IF Q6$="END"THEN 5230
: K1$=Q6$
4580 GOSUB '34("ENDING")
: K2$=ALL(FF)
: IF Q6$<>"END"THEN K2$=Q6$
: IF Q6$=" "THEN 4580
: IF K1$>K2$THEN 4520
4613 Q6$=STR(K1$)&ALL(00)
: GOSUB '232(1,0,Q6$)
: K1$=HEX(00)
: GOTO 4870
4620 K1$=STR(T7$,,Q0)
4670 GOSUB '71(2,Q)
: E=Q
: K9=1
: IF K1$>K2$THEN 4820
: IF C6$="B"AND C5$(Q)=" "THEN 4820
: INIT(20)C7$,C8$,C9$
: GOSUB '123(B5(E))
: IF Q6$<>"E"THEN C9$=U9$
: GOSUB '123(B3(E))
: IF Q6$<>"E"THEN C7$=U9$
: IF B4(E)=99999THEN U9$="HOLD"
: ELSE GOSUB '123(B4(E))
: IF Q6$<>"E"THEN C8$=U9$
: K3=K3+1
: K1=K1+1
: K2=K2+1
: Q9=POS(" CEPX"=C3$(E))
4747 IF Q9<1OR Q9>5THEN Q9=1
: Q6$="INV C/M EPAYPPAYXPAY"
: E6$=STR(Q6$,Q9*4-3,4)
: Q8=-1
: IF Q9=1THEN Q8=1
: Q7=B(E)
: IF B1(E)>0AND C6$="B"THEN Q7=B1(E)
: A6(Q9)=A6(Q9)+Q7*Q8
: A7(Q9)=A7(Q9)+ROUND((Q7*B0(E)/100,2)*Q8
: IF Q9=3THEN Q8=0
: A6=A6+Q7*Q8
: A7=A7+ROUND((Q7*B0(E)/100,2)*Q8
: SELECT PRINT 005(80)
4780 IF B6$="Y"THEN GOSUB 7080
: ELSE PRINT AT(5,0,80);"Processing record ID ";T7$
: IF A6$="Y"THEN GOSUB '90
: IF A6$="Y"THEN GOSUB 7290
: SELECT PRINT 005(80)
4820 IF K$="I"THEN 4870
: IF K1$=K2$AND K$="R"THEN 4850
: IF K1$>=K2$THEN 4950
4850 IF Q6$=HEX(1F)THEN GOSUB '31
4870 IF J0=7THEN GOSUB '92
: IF K1$=HEX(00)AND J0=0THEN K1$=STR(T7$,,Q0)
: GOSUB '237(1,0)
: IF STR(K1$,,Q0)<>STR(T1$,,Q0)AND K$="I"AND K9=0THEN 4440
: IF Q$="E"THEN 4923
: J$(1)=" "
: GOSUB '91
: IF J0=7THEN 4870
: IF J0>1THEN 5320
: IF J0=1THEN T7$=HEX(FF)
: IF STR(K1$,,Q0)=STR(T7$,,Q0)THEN 4670
: K1$=STR(T7$,,Q0)
: K=9
4923 IF B6$="Y"AND K2>0THEN PRINT AT(4,21,59);"** No more records for this ven
dor **"
: IF B6$="Y"AND T7$<>HEX(FF)THEN GOSUB '254
: IF B6$="Y"AND Q6$=HEX(1F)THEN GOSUB '31
: IF A6$="Y"AND K2>0THEN GOSUB 7450
: A6,A7,K2=0
: IF Q$="E"THEN 4950
: IF K$="I"THEN 4950
: GOTO 4670
4950 IF A6$="N"AND K$="R"THEN 4530
: IF A6$="N"OR K$<>"R"THEN 5100
: L=L+2
: GOSUB '90
: PRINT HEX(0A)
: IF K3>0THEN PRINT "NO. OF RECORDS PROCESSED = ";K3
: SELECT PRINT 005(80)
5100 IF A6$="N"THEN 5230
: SELECT PRINT <I0$>(132)
: PRINT HEX(0A)
: L=L+15
: GOSUB '90
: PRINT HEX(0A)
: PRINT TAB(12);"NO. OF RECORDS PROCESSED = ";
: PRINTUSING "###,###",K1
: PRINT HEX(0A)
: PRINT TAB(55);"TOTAL GROSS";TAB(71);"TOTAL DISC";TAB(89);"NET AMT"
: PRINT HEX(0A0A)
: Q8,Q9=0
: MAT REDIM M$(5)40
: M$(1)="INVOICES"
: M$(2)="CREDIT MEMOS"
5171 M$(3)="EXTERNAL PAYMENTS (ITEMS NOT ON FILE)"
: M$(4)="EXTERNAL PAYMENTS AFTER PAYMENT CYCLE"
: M$(5)="EXTERNAL PAYMENTS (ITEMS ON FILE)"
: FOR I=1TO 5
: PRINT TAB(37-LEN(M$(I)));M$(I);TAB(52);
: PRINTUSING 4012,A6(I);A7(I);A6(I)-A7(I)
: J=1
: IF I=3THEN J=0
: Q8=Q8+A6(I)*J
: Q9=Q9+A7(I)*J
: PRINT HEX(0A)
: NEXT I
5183 PRINT TAB(24);"REPORT TOTALS";TAB(52);
: PRINTUSING 4012,Q8;Q9;Q8-Q9
: L=60
: MAT A6=ZER
: MAT A7=ZER
: MAT REDIM M$(4)62
: PRINT HEX(0A)
: PRINT HEX(0C)
: IF K$="I"THEN 4440
5230 SELECT PRINT 005(80)
: PRINT AT(1,0,)
: GOSUB '100("M,R","MmRr",1,1,"KEY R TO RESTART, M FOR MENU",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="R"THEN 4000
5290 DEFFN'31
: LOAD TM$
5320 GOSUB '91
: GOSUB '254
: GOTO 5290
6020 DEFFN'90
: Q6$=" "
: KEYIN Q6$,6050,6050
6050 IF Q6$="P"THEN GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
: SELECT PRINT <I0$>(132)
: IF L<L0THEN RETURN
: P1=P1+1
: PRINT HEX(0C0A0E);TAB(3);N2$
: Q6$=" "
: IF C6$="B"THEN Q6$=" - PAYMENT SELECTION REPORT"
: PRINT K3$;TAB(50);"A/P OPEN ITEM FILE ";Q6$;TAB(110);Q1$;TAB(122);"PAGE";
P1
: PRINT HEX(0A)
6125 PRINT "VENDOR";TAB(10);"INVOICE #";TAB(23);"INV DATE";TAB(34);"P.O. NO.";
TAB(46);"GROSS AMOUNT";TAB(61);"DISC %";TAB(75);"PARTIAL PYMT";TAB(90);"C
HECK NO.";TAB(103);"DUE DATE";TAB(115);"TYPE";TAB(121);"DATE PAID"
: PRINT HEX(0A)
: L=4
: RETURN
6160 DEFFN'34(Q7$)
: SELECT PRINT 005(80)
: PRINT AT(1,0,80);"ENTER ";Q7$;" VENDOR ID (OR END)"
: GOSUB '238(1)
: GOSUB '100(" ",HEX(7F),Q0,0," ",2)
: IF Q6$="END"OR Q6$="end"THEN RETURN
: IF Q6$=HEX(1F)THEN GOSUB '31
: GOSUB '96(4)
: RETURN
7080 K=K+1
: IF K=10OR K1$=HEX(00)THEN 7088
: IF K<5THEN 7140
: GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
7088 K=0
: PRINT HEX(03);TAB(21);"OPEN ITEM INQUIRY/LIST"
: PRINT AT(4,0,0);"VENDOR ID ";C0$(E)
: PRINT "INVOICE #";TAB(11);"TYPE";TAB(17);"INV DATE";TAB(28);"P.O. NO.";TA
B(41);"DISC %";TAB(54);"GROSS AMT"
: PRINT TAB(17);"DUE DATE";TAB(27);"CHECK NO.";TAB(39);"DATE PAID";TAB(54);
"PART PYMT"
7140 PRINT AT(7+3*K,0,0)
: INIT(".")Q6$
: PRINT Q6$
: PRINT TAB(1);C1$(E);TAB(11);E6$;TAB(17);C7$;TAB(28);C4$(E);TAB(40);
: IF ROUND((B0(E),2)=B0(E)THEN Q6$="##.##"
: ELSE Q6$="##.######"
: PRINTUSING Q6$,B0(E);
: PRINT TAB(49);
: PRINTUSING 4012,B(E)
: PRINT TAB(17);C8$;TAB(28);
: PRINTUSING 4014,B2(E);
: PRINT TAB(40);C9$;TAB(49);
: PRINTUSING 4012,B1(E)
: RETURN
7290 GOSUB '90
: PRINT TAB(1);C0$(E);TAB(11);C1$(E);TAB(23);C7$;TAB(34);C4$(E);TAB(44);
: IF B(E)<>0THEN PRINTUSING 4012,B(E);
: PRINT TAB(62);
: IF ROUND((B0(E),2)=B0(E)THEN Q6$="##.##"
: ELSE Q6$="##.######"
: IF B0(E)<>0THEN PRINTUSING Q6$,B0(E);
: PRINT TAB(71);
: IF B1(E)<>0THEN PRINTUSING 4012,B1(E);
: PRINT TAB(90);
: IF B2(E)<>0THEN PRINTUSING 4014,B2(E);
: PRINT TAB(103);C8$;TAB(115);E6$;TAB(122);C9$
7400 SELECT PRINT 005(80)
: L=L+1
: RETURN
7450 L=L+3
: GOSUB '90
: IF L=4THEN L=7
: PRINT HEX(0A)
: PRINT TAB(22);"VENDOR TOTALS - GROSS";TAB(44);
: PRINTUSING 4012,A6;
: PRINT TAB(61);"NET AMOUNT";
: PRINTUSING 4012,A6-A7
: PRINT HEX(0A)
: RETURN
9992 DEFFN'29"Q$=";HEX(22);"ACPA010A";HEX(22);":SCRATCH T Q$:SAVE T$ ()Q$";HEX
(0D)
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
"GBS/MVP - PRINT/DISPLAY A/P OPEN ITEM FILE.";HEX(22);":SELECT#15<I0$>:$O
PEN#15:SELECTLIST<I0$>(80): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX
(7A):$CLOSE#15:SELECTLIST005(80)";HEX(0D)