image of READY prompt

Wang2200.org

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)