Listing of file='ACPA050A' on disk='vmedia/701-2652C.wvd.zip'
# Sector 350, program filename = 'ACPA050A'
0010 REM ACPA050A, RELEASE 1-0, (01/31/79) THIS PROGRAM IS A COPYRIGHT PRODU
CT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBIT
ED
0170 DIM A6$1,A9$12,K9$30,N9$Q0
: GOTO 4000
4000 SELECT @PARTS0$
: A6$="X"
: GOSUB '66(5,0,1)
: A6$=F5$(2)
4240 PRINT AT(4,0,);AT(5,21);"0 = RETURN TO MENU"
: PRINT TAB(21);"1 = FILE BY DUE DATE"
: PRINT TAB(21);"2 = VENDOR BY DUE DATE"
: PRINT TAB(21);"3 = VENDOR BY INVOICE NO."
: GOSUB '100("0","3",1,0,"ENTER OPTION DESIRED",1)
: IF Q6$=HEX(1F)THEN Q9=0
: O9=Q9
: PRINT AT(4,0,)
: ON Q9+1GOTO 6620,4360,4690,4690
4360 GOSUB '235(2,0)
: PRINT AT(4,0,80);"PROCESSING VENDOR ID. ";HEX(06)
: GOTO 4400
4390 GOSUB '237(2,0)
4400 N9$=STR(T7$,,Q0)
: J$(1)=" "
: GOSUB '91
: IF J0=1AND O9=2THEN 4690
: IF J0=1THEN 4240
: ELSE IF J0>1THEN 5130
4450 GOSUB '71(4,Q)
: A6=Q
: IF STR(K9$,,Q0)=STR(N9$,,Q0)THEN 4600
: IF O9=2THEN 4690
: GOSUB '232(1,0,N9$)
: A6$=" "
: Q6$="VENDOR MASTER FILE"
: IF Q$<>" "THEN 6560
: GOSUB '70(2)
: PRINT AT(4,23,Q0);N9$
4600 IF B4$>" "OR B4(A6)>M(3)THEN IF POS(" CP"=C3$(A6))<>0THEN C5$(A6)=" "
: ELSE C5$(A6)="1"
: DBACKSPACE #4,1S
: GOSUB '61(4,A6)
: A6$="1"
: GOTO 4390
4690 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID. (OR END)",2)
: IF Q6$="END"OR Q6$="end"OR Q6$=HEX(1F)THEN 4240
: GOSUB '96(4)
: N9$,K9$=Q6$
: GOSUB '232(1,0,N9$)
: GOSUB '91
: IF J0<>0THEN 4690
: GOSUB '70(2)
: PRINT AT(4,0,80);"VENDOR ID. ";N9$
: IF O9=3THEN 4960
: GOSUB '232(2,0,K9$)
: GOSUB '237(2,0)
: J$(1)=" "
: GOSUB '91
: IF J0<>0THEN 4690
4910 IF STR(T7$,,Q0)=N9$THEN 4450
: PRINT AT(3,0,80);HEX(07);"INVOICE NOT FOUND"
: GOTO 4690
4960 PRINT AT(5,0,)
4970 GOSUB '100(" ",HEX(7F),VAL(Q0$(6)),0,"ENTER INVOICE NO. (OR END)",2)
: IF Q6$="END"OR Q6$="end"OR Q6$=HEX(1F)THEN 6010
: GOSUB '96(6)
: STR(K9$,Q0+1)=Q6$
: PRINT AT(4,0,)
: GOSUB '232(2,0,K9$)
: GOSUB '237(2,0)
: J$(1),J$(3)="INVOICE NOT FOUND"
: GOSUB '91
: IF J0<>0THEN 4970
: Q9=Q0+VAL(Q0$(6))
: IF STR(K9$,1,Q9)=STR(T7$,1,Q9)THEN 5190
5130 Q7$="SEQUENCE ERROR IN OPEN ITEM FILE"
: IF STR(T7$,1,Q9)<STR(K9$,1,Q9)THEN 6560
: PRINT AT(3,0,80);HEX(07);"INVOICE NOT FOUND"
: GOTO 4970
5190 GOSUB '71(4,Q)
: A6=Q
: A7=T6
: Q9=POS(" CEPX"=C3$(A6))
: IF Q9=0THEN 5130
: Q6$="INVOICE CREDIT MEMO EXTERNAL PAYMENT"
: IF Q9>3THEN Q9=3
: Q6$=STR(Q6$,Q9*16-15,16)
: PRINT AT(4,20,60);"INVOICE NO. - ";C1$(A6);" *** ";Q6$;" ***"
5290 PRINTUSING " P.O. NUMBER ######## CHECK NO ########",C4$(A6)
,B2(A6)
: PRINTUSING " GROSS AMOUNT #,###,###.## DISC % ",B(A6);
: IF ROUND((B0(A6),2)=B0(A6)THEN Q6$="##.##"
: ELSE Q6$="##.########"
: PRINTUSING Q6$,B0(A6)
: GOSUB '123(B3(A6))
: IF Q6$="E"THEN U9$,Q6$=" "
5350 PRINTUSING " DISC AMOUNT #,###,###.## INV DATE ########",ROUND((
B(A6)*B0(A6)/100,2),U9$
: IF B4(A6)<>99999THEN GOSUB '123(B4(A6))
: ELSE U9$="HOLD"
: IF Q6$="E"THEN U9$,Q6$=" "
: PRINTUSING " NET AMOUNT #,###,###.## DUE DATE ########",B(A6)-R
OUND((B(A6)*B0(A6)/100,2),U9$
: GOSUB '123(B5(A6))
5400 IF Q6$="E"THEN U9$,Q6$=" "
: PRINTUSING " PART PYMT AMT #,###,###.## DATE PAID ########",B1(A6),
U9$
: GOSUB '237(2,0)
: A8=Q
: A9=T6
: J$(1)=" "
: GOSUB '91
: Q9=Q0+VAL(Q0$(6))
: IF J0=0AND STR(T7$,1,Q9)=STR(K9$,1,Q9)THEN J9=1
: ELSE J9=0
: IF J9=1THEN PRINT AT(10,0,80);"*** MORE INVOICES FOLLOW ***"
: ELSE PRINT AT(10,0,80)
5500 C5$(A6)=" "
: IF C3$(A6)=" "THEN 5600
: GOSUB '100("Y,N","Y YyNn",1,1,"DO YOU WISH TO SELECT THIS TRANSACTION FOR
PAYMENT (Y OR N)",2)
: IF Q6$="Y"THEN GOTO 5870
: ELSE GOTO 5890
5600 GOSUB '100("Y,N","Y YyNn",1,1,"IS THIS INVOICE TO BE PAID (Y OR N)",2)
: IF Q6$="Y"THEN 5670
: ELSE GOTO 5890
5670 GOSUB '100("Y,N","Y YyNn",1,1,"DO YOU WISH TO CHANGE THE PARTIAL PAYMENT
AMOUNT (Y OR N)",2)
: IF Q6$="Y"THEN 5730
: ELSE GOTO 5870
5730 GOSUB '100("0","9999999.99",7,2,"ENTER PARTIAL PAYMENT AMOUNT",1)
: IF Q9<B(A6)THEN 5770
: PRINT AT(3,0,80);HEX(07);"Partial payment amount must be less than gross
amount"
: GOTO 5730
5770 B1(A6)=Q9
: PRINT AT(9,0,0)
: PRINTUSING " PART PYMT AMT #,###,###.##",B1(A6)
: GOSUB '100("Y,N","Y YyNn",1,1,"IS ENTRY OK (Y OR N)",2)
: IF Q6$="Y"THEN 5870
: ELSE GOTO 5600
5870 C5$(A6)="1"
5890 A6$=" "
: DBACKSPACE #4,BEG
: DSKIP #4,A7S
: GOSUB '61(4,A6)
: IF J9=0THEN 4970
: DBACKSPACE #4,BEG
: DSKIP #4,A9S
: Q=A8
: T6=A9
: GOTO 5190
6010 GOSUB '100("Y,N","Y YyNn",1,1,"ACCEPT THIS VENDOR'S ENTRIES (Y OR N)",2)
: D8,D9=0
: IF Q6$="N"OR Q6$=HEX(1F)THEN 6370
: GOSUB '232(2,0,N9$)
6090 GOSUB '237(2,0)
: J$(1)=" "
: GOSUB '91
: IF J0>1THEN 5130
: IF J0=1OR STR(T7$,,Q0)<>N9$THEN 6230
: GOSUB '71(4,Q)
: Q6$=C3$(Q)
: IF C5$(Q)<>"1"THEN 6090
: IF Q6$=" "THEN Q9=1
: ELSE Q9=-1
: IF B1(Q)<>0THEN Q6=B1(Q)
: ELSE Q6=B(Q)
: D9=D9+Q6*Q9*SGN(POS(" CPX"=Q6$))
: D8=D8+ROUND((B0(Q)*Q6/100,2)*Q9*SGN(POS(" PX"=Q6$))
: GOTO 6090
6230 Q6$=" "
: IF D9-D8<0THEN Q6$="CREDIT BALANCE FOR ITEMS SELECTED"
: IF D9-D8>A2THEN Q6$="VENDOR ENTRIES SELECTED EXCEED VENDOR BALANCE."
: IF B4$="1"THEN B4$="2"
: IF Q6$=" "THEN 6500
: IF B4$="2"THEN B4$="1"
: PRINT AT(3,0,80);HEX(07);Q6$
6300 GOSUB '100("V,A","VvAa",1,1,"ENTER V = VOID, OR A = ADDITIONAL ENTRIES",2
)
: IF Q6$="A"THEN 4970
6370 GOSUB '232(2,0,N9$)
6380 GOSUB '237(2,0)
: J$(1)=" "
: GOSUB '91
: IF J0>1THEN 5130
: IF J0=1OR STR(T7$,,Q0)<>N9$THEN 6500
: GOSUB '71(4,Q)
: DBACKSPACE #4,1S
: C5$(Q)=" "
: GOSUB '61(4,Q)
: PRINT AT(4,20,60);"INVOICE NO. - ";C1$(Q);" WILL NOT BE PAID"
: GOTO 6380
6500 DBACKSPACE #2,1S
: A6$="1"
: GOSUB '60(2)
: GOTO 4690
6560 GOSUB '91
: PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED - ";Q7$;AT(3,16);"- ";Q6$
: GOSUB '254
6620 DEFFN'31
: IF A6$="X"THEN 6740
: $OPEN #5
: GOSUB '66(5,0,1)
: F5$(2)=A6$
: GOSUB '66(5,0,0)
: $CLOSE#5
6740 LOAD TM$
9999 DEFFN'29"Q$= ";HEX(22);"ACPA050A";HEX(22);":SCRATCH T Q$:SAVE T$()Q$";HEX
(0D)