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)