Listing of file='ACPA030B' on disk='vmedia/701-2654C.wvd.zip'
# Sector 138, program filename = 'ACPA030B'
0010 REM ACPA030B, RELEASE 2.2, (09/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0020 REM PROGRAM NAME = ACPA030B
0030 REM RELEASE NUMBER = 01
0040 REM DATE WRITTEN = 12/13/78
0050 REM REVISION DATE = 01/11/80 TM
0055 REM THIS PROGRAM WAS UPGRADED TO 2.2 BY ERRATA 1153
0060 REM **************************************************
0070 REM * THIS PROGRAM IS PART OF A GENERALIZED *
0080 REM * APPLICATION. COPYRIGHT WANG LABS INC. 1978 *
0090 REM **************************************************
0100 REM SYSTEM NAME = GBS/MVP ACCOUNTS PAYABLE SYSTEM
0110 REM MODULE NAME = A/P TRANSACTION ENTRY
0120 REM PROGRAM FUNCTION = ADD NEW ITEMS TO THE A/P OPEN ITEM FILE
0130 REM **************************************************
0159 REM
0170 DIM A7$11,A8$20,B6$1,B7$10
0171 REM
0172 DIM A8$(9)15,B8(8),B8$(5)Q6,B9$Q0,C6(10),C6$(10)Q6,C7$25,C9$1,K$(9)1
3110 RETURN
3990 REM
3996 REM *************************
3997 REM ! A/P TRANSACTION ENTRY !
3998 REM *************************
3999 REM
4000 SELECT @PARTS0$
4010 A8$(1)="INVOICE NO."
4020 A8$(2)="INVOICE DATE"
4030 A8$(3)="P.O. NO."
4040 A8$(4)="DUE DATE"
4050 A8$(5)="DATE PAID"
4060 A8$(6)="CHECK NO."
4070 A8$(7)="GROSS AMOUNT"
4080 A8$(8)="DISCOUNT %"
4090 A8$(9)="DISCOUNT AMOUNT"
4100 C9$=HEX(00)
4110 N1$()=ALL(FF)
4120 B$(1)="T"
4130 PACK(##)STR(B$(1),2)FROM S2
4140 DATA " ","z",8,2,"########","0","99999999",8,1,"########","0","9999999.99
",7.2,1,"#,###,###.##","0","99.99",2.2,1,"##.########"
4150 K=0
4160 MAT B8=ZER
4170 MAT C6=ZER
4180 D6=9
4190 C7=-1
4200 B8$(),D6$,D7$=ALL(20)
4210 C6$()=ALL(30)
4220 REM GET VENDOR
4230 PRINT AT(1,0,)
4240 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID (END=END OF BATCH)",2)
4250 IF Q6$="END"OR Q6$="end"OR Q6$=HEX(1F)THEN 7890
4255 GOSUB '96(4)
4260 B9$=Q6$
4300 REM FIND VENDOR
4310 GOSUB '232(1,0,B9$)
4320 GOSUB '91
4330 IF J0=7 OR J0=3 THEN 4240
4340 IF J0<>0 THEN 7840
4350 REM READ VENDOR FILE
4360 GOSUB '70(2)
4370 PRINT AT(4,0,80);" VENDOR - ";A$;" ";A1$
4380 REM GET TRANSACTION TYPE
4390 PRINT AT(6,22,0);"I - INVOICE"
4400 PRINT TAB(22);"C - CREDIT MEMO"
4410 PRINT TAB(22);"E - PAYMENT (INV NOT ON FILE)"
4420 PRINT TAB(22);"X - PAYMENT (INV ON FILE)"
4430 GOSUB '100("C,I,E,X","CcIiEeXxI ",1,1,"ENTER TRANS TYPE (RETURN = INV
OICE)",2)
4440 IF Q6$=HEX(1F) THEN GOSUB '31
4445 A6=Q9
4460 K$()=ALL(31)
4470 K$(7)="3"
4480 IF Q6$="I" THEN C9$=" "
: ELSE C9$=Q6$
4482 Q6$="CREDIT MEMO INVOICE E-PAYMENT X-PAYMENT"
4484 A7$=STR(Q6$,A6*12-11,11)
4485 Q6$=" 11"
4486 K$(5)=STR(Q6$,A6,1)
4488 Q6$=" 22"
4490 K$(6)=STR(Q6$,A6,1)
4492 Q6$=" 4 "
4494 K$(8)=STR(Q6$,A6,1)
4496 Q6$=" 333"
4498 K$(9)=STR(Q6$,A6,1)
4720 REM PRINT SCREEN
4730 PRINT AT(4,47,);"***";A7$;"***"
4740 PRINT HEX(0A)
4750 FOR I = 1 TO 4
4760 PRINT TAB(2);I;A8$(I);TAB(42);I+5;A8$(I+5)
4770 NEXT I
4780 IF A6=4 THEN Q6$=" "
: ELSE Q6$="TOTAL DIST"
4790 PRINT TAB(2);5;A8$(5);TAB(45);Q6$
4800 PRINT HEX(0A)
4810 Q6$="ACCOUNT NO. AMOUNT"
4820 IF A6<>4 THEN PRINT AT(12,13,);"* * * * * G / L D I S T R I B U T
I O N * * * * *";AT(13,4);Q6$;TAB(44);Q6$;AT(14,0);10
4830 REM -----------
4840 REM DATA ENTRY ROUTINE
4850 K=K+1
4860 IF K>9 THEN 6150
4870 IF K$(K)=" " AND D6$="1" THEN 6800
: ELSE IF K$(K)=" " THEN 4850
4880 RESTORE (VAL(K$(K))-48)*5-4
4890 REM SET UP PROMPT
4900 READ B6$,B7$,B6,B7,A8$
4902 IF K<>1 AND K<>3 THEN 4910
4903 B6=VAL(Q0$(6))
4904 A8$=ALL("#")
4905 STR(A8$,B6+1,20-B6)=ALL(20)
4910 IF K>5 THEN 4950
4920 Q6$=B8$(K)
4930 IF K=2 OR K=5 THEN IF Q6$=" " THEN Q6$=Q1$
4940 IF Q6$<>" " THEN B7=3
4950 PRINT AT(1,0,80);"ENTER ";A8$(K);
4960 IF K=2 OR K=5 THEN PRINT " (MM/DD/YY)";
4970 IF K=4 THEN PRINT " (MM/DD/YY) OR DUE DAYS (DD)";
4980 IF K=1 THEN PRINT " (-1 = RESTART)"
4990 GOSUB '100(B6$,B7$,INT(B6),(B6-INT(B6))*10," ",B7)
5000 IF Q6$=HEX(1F) THEN GOSUB '31
5010 IF Q6$="-1" THEN 4150
5020 ON K GOTO 5040,5420,5380,5420,5420,5750,5790,5870,5930
5030 REM INVOICE NO
5040 IF Q6$ = " " THEN 5720
5050 GOSUB '96(6)
5060 B8$(1)=Q6$
5090 REM VALIDATE INVOICE NO. FOR 'X' PAYMENTS
5100 IF A6<>4 THEN 5330
5110 REM C7$=B9$&B8$(1)
5115 C7$=STR(B9$,,VAL(Q0$(4)))&B8$(1)
5120 GOSUB '232(2,0,C7$)
5130 GOSUB '237(2,0)
5135 Q9=Q0+VAL(Q0$(6))
5140 IF STR(T7$,,Q9)<>STR(C7$,,Q9) THEN Q$="N"
5150 J$()="No invoice found"&STR(J$())
5160 J$(7)="Record busy"
5170 GOSUB '91
5180 IF J0 <> 0 THEN 4880
5190 GOSUB '71(4,Q)
5192 GOSUB '123(B3(Q))
: B8$(2)=U9$
: REM <=============> TEST OF INVOICE DATE
5200 IF C3$(Q)<> " " THEN 5130
5210 PRINT AT(5,0,80);"INVOICE AMOUNT IS ";
5220 A7=B(Q)
5230 A8=ROUND((B0(Q)*B(Q)/100,2)
5240 Q7$=ALL(00)
5250 PRINTUSING TO Q7$,"$##,###,###.##",A7;A8;
5260 Q6=POS(Q7$="$")
5270 Q7=POS(STR(Q7$,Q6+1)="$")
5280 Q6$=STR(Q7$,Q6,Q7-1)
5290 PRINT Q6$;", DISCOUNT IS ";
5300 Q6$=STR(Q7$,Q6+Q7,31-Q6-Q7)
5310 PRINT Q6$
5320 REM SCREEN DISPLAY - LEFT HAND COLUMN
5330 PRINT AT(5+K,2,36);K;TAB(4);A8$(K);TAB(18);
5340 PRINTUSING A8$,B8$(K)
5350 IF D6$="1" THEN 6820
5360 GOTO 4850
5370 REM P.O. NO
5380 GOSUB '96(6)
5390 B8$(K)=Q6$
5392 A8$=ALL("#")
5400 GOTO 5330
5410 REM CHECK DATE
5420 IF Q6$="hold" THEN Q6$="HOLD"
5430 IF Q6$="HOLD" THEN 5550
5440 U9$=Q6$
5450 IF K=4 AND POS(Q6$="/")=0 AND NUM(Q6$)=80 THEN CONVERT Q6$ TO Q9
: ELSE Q9=9E99
5460 IF Q9<>9E99 THEN IF INT(Q9/100)<>0 THEN 5720
: REM VALIDATE DUE DAYS
5470 IF Q9<>9E99 THEN GOSUB '123(B8(6)+Q9)
: REM ADD DUE DAYS
5480 GOSUB '121(U9$)
5490 IF Q6$="E" THEN 5720
5500 GOSUB '123(U9)
5510 B8$(K)=U9$
5520 IF K=4 AND A6<3 THEN 5590
5530 REM IF U9>Q1 THEN 5720
5540 GOTO 5590
5550 IF K<>4 OR A6<>2 THEN 5720
5560 B8$(K)=Q6$
5570 U9=99999
5580 GOTO 5640
5590 ON K-2 GOTO 5720,5640,5680
5600 REM INVOICE DATE
5610 B8(6)=U9
5620 GOTO 5330
5630 REM DUE DATE
5640 IF A6<3 AND U9<B8(6)THEN 5720
5650 B8(7)=U9
5660 GOTO 5330
5670 REM DATE PAID
5680 IF U9<B8(6) THEN 5720
5681 REM IF U9<B8(6) THEN 5720
5690 B8(8)=U9
5700 GOTO 5330
5710 REM INPUT ERROR
5720 PRINT AT(3,0,80);HEX(07);"Re-enter"
5730 GOTO 4880
5740 REM CHECK NO
5750 B8(1)=Q9
5760 J=6
5770 GOTO 6000
5780 REM GROSS AMOUNT
5790 IF Q9=0 THEN 5720
5800 IF A6=4 AND A7<Q9 THEN 5720
: REM FOR'X'PAYMENTS COMPARE TO INVOICE
5810 B8(2)=Q9
5820 J=7
5830 GOSUB 6040
5840 IF D6$="1" THEN 5890
5850 GOTO 4850
5860 REM DISC %
5870 IF Q9=0 THEN 4850
5880 B8(3)=Q9
5890 B8(4)=INT((B8(2)*B8(3)+.5))/100
5900 K=K+1
5910 GOTO 5970
5920 REM DISCOUNT AMOUNT
5930 IF Q9 >= B8(2) THEN 5720
5940 IF A6=4 AND A8<Q9 THEN 5720
: REM FOR'X'PAYMENTS COMPARE TO INVOICE
5950 B8(4)=Q9
5960 B8(3)=ROUND((B8(4)/B8(2)*100,8)
5970 J=8
5980 GOSUB 6040
5990 J=9
6000 GOSUB 6040
6010 IF D6$="1" THEN 6820
6020 GOTO 4850
6030 REM SCREEN DISPLAY - RIGHT HAND COLUMN
6040 IF K$(J)=" " THEN RETURN
6050 RESTORE (VAL(K$(J))-48)*5
6060 READ A8$
6070 Q9=POS(A8$=".")
6080 IF J = 8 AND ROUND((B8(3),2) = B8(3) THEN STR(A8$,Q9+3) = ALL(20)
6090 IF Q9<>0 THEN Q9=70-Q9
: ELSE Q9=60
6100 PRINT AT(J,42,38);J;A8$(J);TAB(Q9);
6110 IF J=6 AND B8(1)=0 THEN PRINT
: ELSE PRINTUSING A8$,B8(J-5)
6120 RETURN
6130 REM ---------------
6140 REM DISTRIBUTION TO GENERAL LEDGER
6150 IF A6 = 4 THEN 6820
6160 REM DOES VENDOR HAVE STANDARD DISTRIBUTION?
6170 IF POS(B1$() <> " ") = 0 THEN 6420
6180 GOSUB '100("Y,N","YyY Nn",1,1,"STANDARD DISTRIBUTION (Y OR N)",2)
6200 IF Q9=2 THEN 6420
6240 REM STANDARD DISTRIBUTION
6250 FOR I = 1 TO 6
6260 IF B1$(I)=" " THEN 6330
6270 C6$(K-9)=B1$(I)
6280 C6(K-9)=ROUND((A4(I)*B8(2)/100,2)
6290 B8(5)=B8(5)+C6(K-9)
6300 GOSUB 6720
6310 D6=K
6320 K=K+1
6330 NEXT I
6340 IF B8(5) = 0 THEN 6390
6350 C6(K-10)=C6(K-10)+(B8(2)-B8(5))
6360 B8(5)=B8(2)
6370 K=K-1
6380 GOSUB 6720
6390 GOSUB 6750
6400 IF B8(5) <> 0 THEN 6820
6410 REM INPUT FOR ACCOUNT & AMOUNT
6420 GOSUB '100("1",HEX(7F),VAL(Q0$(5)),0,"ENTER ACCOUNT # (OR END)",2)
6430 IF Q6$=HEX(1F) THEN GOSUB '31
6440 IF Q6$="END" OR Q6$="end"THEN 6820
6445 GOSUB '96(5)
6460 C6$(K-9)=Q6$
6470 REM VALIDATE ACCOUNT NO
6480 GOSUB '232(3,0,C6$(K-9))
6490 IF Q$<>" " THEN GOSUB '91
: ELSE J0=0
6500 IF J0=7 OR J0=3 THEN 6420
6510 IF J0<>0 THEN 7840
6520 GOSUB '75(6)
6530 IF O1$="2"AND O3$<>"M"THEN 6570
6540 PRINT AT(3,0,80);HEX(07);"Non-postable account, re-enter"
6550 C6$(K-9)=" "
6560 GOTO 6420
6570 GOSUB 6720
6580 REM GET AMOUNT
6590 GOSUB '100("0","9999999.99",7,2,"ENTER AMOUNT",1)
6600 IF Q6$=HEX(1F) THEN GOSUB '31
6610 C6(K-9)=Q9
6620 B8(5)=B8(5)+Q9
6630 GOSUB 6720
6640 GOSUB 6750
6650 REM CHECK CORRECTION SWITCH
6660 IF D6$="1" THEN 6820
6670 D6=K
6680 K=K+1
6690 IF K-9>10 THEN 6820
6700 GOTO 6420
6710 REM PRINT ACCOUNT NO AND AMOUNT
6720 IF K > 14 THEN PRINT AT(K-1,41,39);
: ELSE PRINT AT(K+4,1,39);
6730 PRINTUSING "## ######## $#,###,###.##",K,C6$(K-9),C6(K-9)
6740 RETURN
6750 PRINT AT(10,59);
6760 PRINTUSING "$#,###,###.##",B8(5)
6770 RETURN
6780 REM --------------
6790 REM INVALID INPUT
6800 PRINT AT(3,0,80);HEX(07);"Re-enter"
6810 REM CORRECTION ROUTINE
6820 GOSUB '100("-1","19",2,0,"ENTER ITEM NO. TO CORRECT (0=NONE, -1=VOID)
",1)
6830 IF Q6$=HEX(1F) THEN GOSUB '31
6840 ON Q9 + 2 GOTO 4150,6980
6850 D6$="1"
6860 K=Q9
6870 IF K<10 THEN 4870
6880 IF A6 = 4 THEN 6800
6890 IF K>D6+1 THEN 6800
6900 IF K=D6+1 THEN D6=K
6910 B8(5)=B8(5)-C6(K-9)
6920 C6$(K-9)=" "
6930 C6(K-9)=0
6940 GOSUB 6720
6950 GOSUB 6750
6960 GOTO 6420
6970 REM CHECK AMOUNT DISTRIBUTED
6980 D6$=" "
6990 IF A6 = 4 THEN B8(5)=B8(2)
7000 IF B8(5)=B8(2) THEN 7050
7010 PRINT AT(3,0,80);HEX(07);"Amount distributed out of balance. Differen
ce = ";
7020 PRINTUSING "#,###,###.##-",B8(2)-B8(5)
7030 GOTO 6820
7040 REM UPDATE VENDOR MASTER FILE
7050 IF A6 = 1 THEN MAT C6 = (-1)*C6
7060 IF A6 = 1 OR A6 = 4 THEN B8(5)=-B8(5)
7070 REM WRITE VENDOR MASTER - KFAM LOOKUP MUST BE PERFORMED AGAIN, SINCE WE D
IDN'T WANT TO PROTECT THE VENDOR RECORD DURING OPERATOR ENTRY OF TRANSACT
ION DATA
7080 IF J0=7THEN GOSUB '254
7090 IF Q6$=HEX(1F) THEN GOSUB '31
7100 GOSUB '232(1,1,B9$)
7110 GOSUB '91
7120 IF J0=7 THEN 7080
7130 IF J0<>0 THEN 7840
7140 GOSUB '70(2)
7150 IF A6 <> 4 THEN A=A+B8(5)
7160 IF A6 <> 3 THEN A2=A2+B8(5)
7170 IF A6 > 2 THEN A0 = B8(8)
7180 DBACKSPACE #2,1S
7190 GOSUB '60(2)
7200 GOSUB '238(1)
7210 D9(A6)=D9(A6)+ABS(B8(5))
7220 REM ADD TO TOTAL AMOUNT DISTRIBUTED
7230 IF A6 <> 4 THEN D8=D8+B8(5)
7240 REM UPDATE OPEN ITEM FILE
7250 C7$=STR(B9$,1,Q0)&B8$(1)
7260 C7=C7+1
7270 CONVERT C7 TO STR(C7$,Q0+VAL(Q0$(6))+1,2),(##)
7280 GOSUB '233(2,1,C7$,0)
7290 J$(4),J$(7)=" "
7300 GOSUB '91
7310 IF J0=4 OR J0=7 THEN 7260
7320 IF J0 <> 0 THEN 7840
7321 O$()=ALL(FF)
: IF Q=1 THEN DATA SAVE DC #4,O$()
: ELSE DSKIP #4,1S
7322 DBACKSPACE #4,1S
7330 C0$(Q)=B9$
7340 C1$(Q)=B8$(1)
7350 C2$(Q)=STR(C7$,Q0+VAL(Q0$(6))+1)
7360 C3$(Q)=C9$
7370 C4$(Q)=B8$(3)
7380 C5$(Q)=" "
7390 B(Q)=B8(2)
7400 B0(Q)=B8(3)
7410 B2(Q)=B8(1)
7420 B3(Q)=B8(6)
7430 B4(Q)=B8(7)
7440 B5(Q)=B8(8)
7450 B1(Q)=0
7460 GOSUB '61(4,Q)
7470 GOSUB '238(2)
7480 LIMITS T#4,Q6,Q7,Q8
7490 Q8=Q7-Q6
7500 Q7=MOD(VAL(STR(T$(2),4),2)+VAL(STR(T$(2),12)),65536)
7510 IF Q7/Q8>.8THEN PRINT AT(3,0,80);HEX(07);"A/P Open Item File is";ROUN
D((Q7/Q8*100,0);"% full"
7520 IF Q7/Q8>.95THEN D6$="F"
7530 REM UPDATE DISTRIBUTION FILE
7540 IF A6=4 THEN 7710
7550 H1$="AP"
7560 H =B8(6)
7570 H3$=A1$
7580 H4$=B9$
7590 H5$=B8$(1)
7600 FOR I=1 TO 10
7610 IF C6$(I)=" " THEN 7670
7620 IF C6(I)=0 THEN 7670
7630 H0$=C6$(I)
7640 H1 =C6(I)
7650 GOSUB '63(E8)
7660 IF I < 10 AND C6$(I+1)="00000000" THEN I=10
7670 NEXT I
7680 LIMITS T#E8,Q6,Q7,Q8
7690 IF (Q8-Q6+1)/(Q7-Q6-1)>.95THEN D6$="F"
7700 REM WRITE TO AUDIT FILE
7710 A9 = A9 + 1
7720 MAT REDIM N1$(3)80
7725 Q6$=HEX(A0)&STR(Q0$(4),,1)&HEX(A0155001A0)&STR(Q0$(6),,1)&HEX(5003500
350036004A00862056805)
7730 $PACK(F=Q6$)N1$(A9)FROMA$,A1$,A6,B8$(1),B8(6),B8(7),B8(8),B8(1),B8$(3
),B8(2),B8(3)
7740 MAT REDIM N1$(5)49
7750 IF A9<3AND D6$<>"F"THEN 4150
7760 GOSUB '48(10)
7770 N1$() = ALL(FF)
7780 A9 = 0
7790 IF Q9<.95AND D6$<>"F"THEN 4150
7800 PRINT AT(1,0,80);"Program will be terminated - Transaction Audit File
full"
7810 GOSUB '254
7815 Q6$=HEX(1F)
7820 GOTO 7890
7830 REM FILE ERROR
7840 PRINT AT(1,0,80);;HEX(07);"FILE ERROR - CORRECT & RESTART"
7850 Q6$="VENDOR MASTER CHART OF ACCOUNTSA/P OPEN ITEM"
7860 PRINT AT(3,17,63);STR(Q6$,T6*18-17,18)
7870 GOSUB '254
7880 REM END OF JOB
7890 DEFFN'31
7900 IF Q6$=HEX(1F) THEN D6$="X"
: ELSE D6$="A"
7910 PRINT AT(1,0,880)
7920 PRINT AT(3,0);"**Loading next module**"
7930 IF A9 <> 0 THEN GOSUB '48(10)
7934 Q6=VAL(Q0$(6))
7936 STR(M5$,8)="A"
7940 LOAD T M5$ 4000,
9000 REM *************************
9010 REM * VARIABLE DESCRIPTIONS *
9020 REM *************************
9030 REM A6 = TYPE OF TRANS 1=CR MEMO 2=INVOICE 3=E PAYMENT 4=X PAYMENT
9032 REM A7 = AMOUNT OF INVOICE RELATED TO AN 'X' PAYMENT
9040 REM A7$ = TRANS DESCRIPTION
9042 REM A8 = DISCOUNT AMOUNT OF INVOICE RELATED TO AN 'X' PAYMENT
9044 REM A8$ = PRINTUSING MASK
9050 REM A8$() = FIELD NAMES FOR DATA ENTRY, SCREEN DISPLAY
9055 REM A9 = RECORD COUNT FOR AUDIT FILE
9060 REM K = COUNTER FOR ITEM ENTERED
9070 REM B6$ = MIN VALUE FOR DATA ENTRY
9080 REM B7$ = MAX VALUE FOR DATA ENTRY
9090 REM B6 = INTEGER/DECIMAL FOR DATA ENTRY
9100 REM B7 = TYPE FOR DATA ENTRY
9110 REM B8() = SCREEN BUFFER FOR NUMERICS
9120 REM B8$() = SCREEN BUFFER FOR ALPHANUMERICS
9130 REM B9$ = VENDOR ID
9140 REM C6$() = SCREEN BUFFER FOR G/L ACCOUNT NO.
9150 REM C6() = SCREEN BUFFER FOR AMOUNTS DISTIBUTED
9160 REM C7 = SEQUENCE COUNTER FOR A/P OPEN ITEM KEY
9170 REM C7$ = KEY FOR OPEN ITEM FILE
9180 REM C9$ = TRANS TYPE
9190 REM D6 = LAST LINE ENTERED
9200 REM D6$ = CORRECTION SWITCH
9210 REM D8 = TOTAL AMOUNT DISTRIBUTED
9220 REM D9() = TOTALS FOR TRANS TYPE
9230 REM K$() = DATA RESTORE AND INPUT REQUIREMENTS
9240 REM $
9999 DEFFN'29"Q$= ";HEX(22);"ACPA030B";HEX(22);":SCRATCH T Q$:SAVE T$()Q$";HEX
(0D)