Listing of file='ACPA040A' on disk='vmedia/701-2654C.wvd.zip'
# Sector 197, program filename = 'ACPA040A' 0010 REM ACPA040A, RELEASE 1-0, (01/31/79) THIS PROGRAM IS A COPYRIGHT PRODU CT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBIT ED 0020 REM PROGRAM NAME = ACPA040A 0030 REM RELEASE NUMBER = 01 0040 REM REVISION NUMBER = 00 0050 REM DATE WRITTEN = 1/09/79 0060 REM ************************************************** 0070 REM * THIS PROGRAM IS PART OF A GENERALIZED * 0080 REM * APPLICATION. COPYRIGHT WANG LABS INC. 1979 * 0090 REM ************************************************** 0110 REM SYSTEM NAME = GBS/MVP ACCOUNTS/PAYABLE SYSTEM 0120 REM MODULE NAME = PRINT CASH REQUIREMENTS 0130 REM PROGRAM FUNCTION = TO UPDATE NO PAY FLAG IN THE VENDOR MASTER FILE 0140 REM ************************************************** 0159 REM 0160 REM 0170 DIM A6$4,A7$6,A9$12,B6$5 0172 DIM B6(4),C6(4) 0198 GOTO 4000 3990 REM 3996 REM *********************** 3997 REM ! A/P OPEN ITEM PRINT ! 3998 REM *********************** 3999 REM 4000 SELECT @PARTS0$ 4010 A9$="####,###.##-" 4090 REM TEST PRINTER, OPEN MASTER FILES 4100 GOSUB '93(" ") 4110 IF I0$=" " THEN 5900 4230 REM ------------------- 4240 REM ACCEPT DUE DATE TO BE USED 4250 GOSUB '100(" ",HEX(7F),8,0,"ENTER DUE DATE (MM/DD/YY)",2) 4260 IF Q6$=HEX(1F) THEN GOSUB '31 4270 GOSUB '121(Q6$) 4280 IF Q6$<>"E"THEN 4310 4290 PRINT AT(3,0,80);"Invalid date, re-enter";HEX(07) 4300 GOTO 4250 4310 GOSUB '123(U9) 4320 D6=U9 4330 D6$=U9$ 4340 REM ---------------- 4350 REM OPTIONS AVAILABLE FOR PRINTED REPORT 4360 PRINT AT(4,23);"OPTIONS AVAILABLE ===>" 4370 PRINT TAB(25);"1) LIST ALL" 4380 PRINT TAB(25);"2) LIST ONLY ITEMS DUE" 4390 PRINT TAB(25);"3) LIST ONLY TOTALS" 4400 GOSUB '100("1","3",1,0,"ENTER OPTION DESIRED",1) 4410 IF Q6$=HEX(1F) THEN GOSUB '31 4420 N7 = Q9 4430 PRINT AT(4,0,) 4440 REM INITALIZE PAGE-EJECT CONSTANTS 4450 P1=0 4460 L=L0+5 4470 REM READ FIRST OPEN ITEM RECORD 4480 GOSUB '235(2,0) 4490 Q6$="A/P OPEN ITEM FILE" 4500 IF Q$<>" " THEN 5980 4510 A6=Q 4520 GOSUB '71(4,A6) 4530 DBACKSPACE #4,1S 4540 C5$(A6) = " " 4550 GOSUB '61(4,A6) 4555 PRINT AT(5,0,80);"Processing Vendor ID.";HEX(06) 4560 REM READ VENDOR M/F RECORD 4570 B6$ = C0$(A6) 4580 SELECT PRINT 005(80) 4590 PRINT AT(5,0,80);"Processing Vendor ID. ";B6$ 4600 GOSUB '232(1,0,B6$) 4610 Q6$ = B6$ & " - VENDOR MASTER FILE" 4620 IF Q$ <> " "THEN 5980 4630 GOSUB '70(2) 4640 A7,N9,D7,D8,K,E6=0 4650 MAT B6 = ZER 4660 GOTO 4800 4670 REM ------------------ 4680 REM READ NEXT OPEN ITEM RECORD 4690 GOSUB '237(2,0) 4700 IF Q$="E" THEN 5340 4710 IF Q$<>" " THEN 5980 4720 A6=Q 4730 GOSUB '71(4,A6) 4740 DBACKSPACE #4,1S 4750 C5$(A6) = " " 4760 GOSUB '61(4,A6) 4770 REM CHECK FOR VENDOR BREAK 4780 IF B6$ <> C0$(A6) THEN 5340 4790 REM ACCUMULATE TOTALS 4800 IF C3$(A6)<>" "THEN B(A6)=-B(A6) 4810 N6 = B(A6)-ROUND((B(A6)*B0(A6)/100,2) 4820 IF C3$(A6) <> "E" THEN N9 = N9 + N6 : ELSE E8 = E8 + N6 4830 IF C3$(A6) <> "E" THEN A7 = A7 + B(A6) : ELSE GOTO 4690 4840 IF N7 = 2 AND B4(A6) > D6 THEN 4690 4850 IF B1(A6) <> 0 THEN D7=B1(A6)-ROUND((B1(A6)*B0(A6)/100,2) : ELSE D7=N6 4860 F7 = F7 + ROUND((B(A6)*B0(A6)/100,2) 4870 F6 = F6 + B(A6) 4880 REM ----------------------------- 4890 REM PRINT VENDOR HEADING LINE IF NECESSARY (PRIOR TO FIRST DETAIL LINE) 4900 IF N7 = 3 THEN 5090 4910 GOSUB '123(B3(A6)) 4920 IF K1=1THEN 4990 4930 K1=1 4940 L=L+3 4950 GOSUB '90 4960 PRINT 4970 PRINT TAB(6);"VENDOR";TAB(15);A$;TAB(23);A1$ 4980 PRINT 4990 L=L+1 5000 GOSUB '90 5010 REM ** PRINT A/P OPEN ITEM PRINT LINE AND ACCUMULATE NET ** 5020 PRINT C1$(A6);TAB(11);U9$;TAB(20); 5030 PRINTUSING A9$,B(A6);ROUND((B0(A6)*B(A6)/100,2);N6; 5040 Q6$,U9$="**HOLD**" 5050 IF B4(A6)<>99999THEN GOSUB '123(B4(A6)) 5060 IF Q6$="E" THEN U9$="NO DATE" 5070 REM CALCULATE NO. OF MONTHS BETWEEN DUE DATE AND PAYMENT DATE 5080 PRINT TAB(57);U9$; 5090 Q7 = INT(365.25*(INT(B4(A6)/1E3)-1)) + MOD(B4(A6),1E3) 5100 Q6 = INT(365.25*(INT(D6/1E3)-1)) + MOD(D6,1E3) 5110 IF Q7 > Q6 THEN Q9 = INT((Q7-Q6+59)/30) : ELSE Q9 = 1 5120 Q9 = MIN(Q9,4) 5130 REM ACCUMULATE TOTALS 5140 B6(Q9) = B6(Q9) + N6 5150 IF Q9=1 THEN Q6=N6 : ELSE Q6=D7 5160 C6(Q9) = C6(Q9) + Q6 5170 REM SET ITEM SWITCH TO INDICATE SELECTION OF ITEMS 5180 IF Q9 = 1 THEN K = 1 5190 IF Q9 = 1 THEN E6 = E6 + D7 5200 IF Q9 = 1 AND N7 = 3 THEN D8 = D8 + D7 5210 IF N7 = 3 THEN 4690 5220 PRINT TAB(54+Q9*12); 5230 PRINTUSING A9$,N6; 5240 REM IF THERE IS A PARTIAL PAYMENT; PRINT THE AMOUNT IN THE CASH RQMNT COL UMN 5250 IF B1(A6)=0 OR B4(A6) > D6 THEN 5290 5260 PRINT TAB(114); 5270 PRINTUSING A9$,D7; 5280 PRINT TAB(126);"PART"; 5290 PRINT 5300 B1(A6)=0 5310 GOTO 4690 5320 REM ---------- 5330 REM VENDOR BREAK 5340 IF N7=3 THEN 5520 5350 IF K1 = 0 THEN 5520 5360 REM NO PAY IF THERE ARE SOME ITEMS DUE AND THE BALANCE IS ZERO OR CREDIT 5370 K1=0 5380 A6$,A7$=" " 5390 IF E6<0 OR E6>N9 OR A7<B6(1) THEN A7$ = "NO PAY" : ELSE D8=E6 5400 IF E6=0 AND K=1 THEN A6$="0.00" 5410 L=L+2 5420 GOSUB '90 5430 PRINT 5440 PRINT TAB(21);"BALANCE DUE"; 5450 PRINT TAB(66); 5460 PRINTUSING A9$,B6(1);B6(2);B6(3);B6(4); 5470 IF D8<>0THEN PRINTUSING A9$,D8; 5480 IF D8<>0THEN PRINT "*";A7$ : ELSE PRINT TAB(121);A6$;TAB(126);A7$ 5490 D9=D9+D8 5500 D8=0 5510 REM CHECK OPEN ITEM BALANCE AGAINST VENDOR FILE BALANCE 5520 IF A7 = A2 THEN 5620 5530 L = L + 2 5540 GOSUB '90 5550 PRINT 5560 PRINT TAB(5);A$;" ";A1$;" BALANCE CORRECTED FROM "; 5570 PRINTUSING A9$,A2; 5580 PRINT " TO "; 5590 PRINTUSING A9$,A7 5600 A2 = A7 5610 REM UPDATE THE NO PAY FLAG IN THE VENDOR M/F 5620 IF N7 = 3 AND D8 > 0 AND D8 <= A2 THEN D9 = D9 + D8 5630 IF E6<0 OR E6>N9 OR A2<B6(1) THEN B4$ = "1" : ELSE B4$=" " 5640 DBACKSPACE #2,1S 5650 GOSUB '60(2) 5670 IF Q$ <> "E" THEN 4570 5680 REM --------------- 5690 REM PRINT TOTALS, CLOSE FILES, RETURN TO MENU 5700 L=L+4 5710 GOSUB '90 5720 PRINT HEX(0A0A0A0A) 5730 PRINT TAB(1);"REPORT TOTALS";TAB(20); 5740 PRINTUSING A9$,F6;F7;F6-F7; 5750 PRINT TAB(66); 5760 PRINTUSING A9$,C6(1);C6(2);C6(3);C6(4);D9 5770 L=L+1 5780 GOSUB '90 5790 PRINT TAB(1);"EXTERNAL PAYMENTS FOR ITEMS NOT ON FILE";TAB(66); 5800 PRINTUSING A9$,E8 5810 PRINT HEX(0C) 5820 SELECT PRINT 005(80) 5840 $OPEN #5 5850 GOSUB '66(5,0,1) 5860 M(3)=D6 5870 F5$(2)=" " 5880 GOSUB '66(5,0,0) 5900 DEFFN'31 5960 LOAD T M$ 5970 REM TERMINATE FOR KFAM ERROR 5980 GOSUB '91 5990 PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED";AT(3,17);"- ";Q6$ 6000 GOSUB '254 6010 GOTO 5900 7000 REM *************** 7010 REM * SUBROUTINES * 7020 REM *************** 7030 REM PAGE EJECT 7040 DEFFN'90 7050 Q6$=" " 7060 REM OPERATOR INTERRUPT CHECK 7070 KEYIN Q6$,7080,7080 7080 IF Q6$="P" THEN GOSUB '254 7085 IF Q6$=HEX(1F) THEN GOSUB '31 7090 REM LINE COUNT CHECK 7100 SELECT PRINT <I0$>(132) 7110 IF L<L0 THEN RETURN 7120 REM PRINT PAGE HEADINGS 7130 P1=P1+1 7140 PRINT HEX(0C0A0D0E);TAB(3);N2$ : REM PRINT COMPANY NAME 7150 IF N7=2 THEN Q9=44 : ELSE Q9=53 7160 Q6$="DETAIL CURRENT DUETOTALS" 7165 Q7$=STR(Q6$,N7*11-10,11) 7170 PRINT TAB(Q9);"CASH REQUIREMENTS ";Q7$;" REPORT";TAB(98);"REPORT DATE ";Q1$;TAB(122);"PAGE";P1 7180 PRINT TAB(101);"DUE DATE ";D6$ 7190 PRINT 7200 PRINT " INVOICE";TAB(12);"INVOICE";TAB(26);"GROSS";TAB(39);"DISC";TAB (52);"NET";TAB(62);"DUE";TAB(119);"CASH" 7210 PRINT TAB(5);"NO";TAB(14);"DATE";TAB(28);"AMT";TAB(40);"AMT";TAB(52); "AMT";TAB(61);"DATE";TAB(70);"CURRENT";TAB(83);"1 - 30";TAB(94);"31 - 60" ;TAB(106);"OVER 60";TAB(119);"RQMT";TAB(125);"REMARKS" 7220 PRINT 7230 L=8 7240 RETURN 9000 REM ************* 9010 REM * VARIABLES * 9020 REM ************* 9030 REM A6 = RECORD NUMBER WITHIN SECTOR, A/P OPEN ITEM FILE 9040 REM A7 = OPEN ITEM BALANCE FOR VENDOR (CALCULATED FROM OPEN ITEMS) 9050 REM A6$ = CASH REQUEST FIELD 9060 REM A7$ = REMARKS FIELD 9070 REM B6$ = PREVIOUS VENDOR ID 9080 REM B6() = TOTAL BALANCE FOR VENDOR - AGED 9090 REM C6() = TOTAL A/P LIABILITIES - AGED 9100 REM D6 = DUE DATE 9110 REM D6$ = GREGORIAN REPORT DATE 9120 REM D7 = CURRENT DUE AMOUNT - THIS TRANSACTION 9130 REM D8 = SUM OF CURRENT DUE AMOUNTS (WHEN N7=3) 9140 REM D9 = REPORT TOTAL - SUM OF ALL TOTALS 9150 REM E6 = CASH REQUIREMENT 9160 REM E8 = EXTERNAL TRANSACTIONS TOTAL - VENDOR 9170 REM E9 = EXTERNAL TRANSACTIONS TOTAL - REPORT 9180 REM F6 = TOTAL GROSS AMOUNT 9190 REM F7 = TOTAL DISCOUNT AMOUNT 9200 REM K = ITEM SWITCH ( K = 1 IF THERE ARE ANY ITEMS DUE) 9210 REM K1 = INDICATOR THAT A DETAIL LINE HAS BEEN WRITTEN (K1=1) 9220 REM L = LINE COUNT 9230 REM N6 = NET AMOUNT - THIS TRANSACTION 9240 REM N7 = OPTION SELECTED 9250 REM N9 = TOTAL NET FOR VENDOR 9260 REM $ 9999 DEFFN'29"Q$= ";HEX(22);"ACPA040A";HEX(22);":SCRATCH T Q$:SAVE T$()Q$";HEX (0D)