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)