image of READY prompt

Wang2200.org

Listing of file='ACPA050A' on disk='vmedia/701-2654C.wvd.zip'

# Sector 234, 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
0020 REM PROGRAM NAME      = ACPA050A
0030 REM RELEASE NUMBER    = 01
0040 REM REVISION NUMBER   = 00
0050 REM DATE WRITTEN      = 1/8/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      = PAYMENT SELECTION
0130 REM PROGRAM FUNCTION = THIS PROGRAM SELECTS ITEMS FOR PAYMENT
0140 REM **************************************************
0160 REM
0170     DIM A6$1,A9$12,K9$30,N9$Q0
0198     GOTO 4000
3990 REM
3996 REM *********************
3997 REM ! PAYMENT SELECTION !
3998 REM *********************
3999 REM
4000     SELECT @PART S0$
4010     A6$="X"
4180 REM READ DUE DATE FROM CONTROL FILE
4200     GOSUB '66(5,0,1)
4210     A6$=F5$(2)
4220 REM --------------
4230 REM DISPLAY SELECTION OPTIONS
4240     PRINT AT(4,0,);AT(5,21);"0 = RETURN TO MENU"
4250     PRINT TAB(21);"1 = FILE BY DUE DATE"
4260     PRINT TAB(21);"2 = VENDOR BY DUE DATE"
4270     PRINT TAB(21);"3 = VENDOR BY INVOICE NO."
4280     GOSUB '100("0","3",1,0,"ENTER OPTION DESIRED",1)
4290     IF Q6$=HEX(1F) THEN Q9=0
4300     O9 = Q9
4310     PRINT AT(4,0,)
4320     ON Q9+1 GOTO 6620,4360,4690,4690
4330 REM --------------------
4340 REM PROCESS OPEN ITEM FILE BY DUE DATE
4350 REM READ FIRST RECORD - OPEN ITEM FILE
4360     GOSUB '235(2,0)
4365     PRINT AT(4,0,80);"PROCESSING VENDOR ID. ";HEX(06)
4370     GOTO 4400
4380 REM READ NEXT RECORD - OPEN ITEM FILE
4390     GOSUB '237(2,0)
4400     N9$ = STR(T7$,,Q0)
4410     J$(1) = " "
4420     GOSUB '91
4430     IF J0 = 1 AND O9 = 2 THEN 4690
4440     IF J0 = 1 THEN 4240
   : ELSE IF J0 > 1 THEN 5130
4450     GOSUB '71(4,Q)
4460     A6 = Q
4470     IF STR(K9$,,Q0) = STR(N9$,,Q0) THEN 4600
4480     IF O9 = 2 THEN 4690
4490 REM READ VENDOR RECORD
4500     GOSUB '232(1,0,N9$)
4510 REM PERFORM KFAM RETURN CODE CHECK
4520     A6$ = " "
4530     Q6$="VENDOR MASTER FILE"
4540     IF Q$ <> " " THEN 6560
4550 REM -------------
4560 REM READ VENDOR RECORD
4570     GOSUB '70(2)
4580     PRINT AT(4,23,Q0);N9$
4590 REM SKIP INVOICES, PARTIAL PAYMENTS AND CREDIT MEMOS IF NOT ELIGIBLE
4600     IF B4$>" " OR B4(A6)>M(3) THEN IF POS(" CP"=C3$(A6))<>0 THEN C5$(A6)=
     " "
   : ELSE C5$(A6)="1"
4610 REM WRITE PAYMENT FLAG - OPEN ITEM FILE
4620     DBACKSPACE #4,1S
4630     GOSUB '61(4,A6)
4640 REM SET FLAG TO INDICATE ITEMS SELECTED
4650     A6$="1"
4660     GOTO 4390
4670 REM ------------------
4680 REM PROCESS VENDOR BY DUE DATE
4690     GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID. (OR END)",2)
4700     IF Q6$ = "END" OR Q6$ = "end" OR Q6$ = HEX(1F) THEN 4240
4710 REM BUILD VENDOR KEY, FINDOLD
4720     GOSUB '96(4)
4730     N9$,K9$=Q6$
4770     GOSUB '232(1,0,N9$)
4780     GOSUB '91
4790     IF J0 <> 0 THEN 4690
4800     GOSUB '70(2)
4810 REM CHECK IF OPTION SELECTED = 3
4820     PRINT AT(4,0,80);"VENDOR ID. ";N9$
4830     IF O9 = 3 THEN 4960
4840 REM READ RECORD - OPEN ITEM FILE
4850     GOSUB '232(2,0,K9$)
4860     GOSUB '237(2,0)
4870     J$(1) = " "
4880     GOSUB '91
4890     IF J0 <> 0 THEN 4690
4900 REM CHECK IF VENDOR FOUND = ENTERED
4910     IF STR(T7$,,Q0) = N9$ THEN 4450
4920     PRINT AT(3,0,80);HEX(07);"INVOICE NOT FOUND"
4930     GOTO 4690
4940 REM -----------------
4950 REM PROCESS VENDOR BY INVOICE NO.
4960     PRINT AT(5,0,)
4970     GOSUB '100(" ",HEX(7F),VAL(Q0$(6)),0,"ENTER INVOICE NO. (OR END)",2)
4980     IF Q6$ = "END" OR Q6$ = "end" OR Q6$ = HEX(1F) THEN 6010
4990     GOSUB '96(6)
5000     STR(K9$,Q0+1)=Q6$
5030     PRINT AT(4,0,)
5050 REM GET SELECTED RECORD - OPEN ITEM FILE
5060     GOSUB '232(2,0,K9$)
5070     GOSUB '237(2,0)
5080     J$(1),J$(3) = "INVOICE NOT FOUND"
5090     GOSUB '91
5100     IF J0 <> 0 THEN 4970
5110 REM CHECK KEY ENTERED AGAINST KEY FOUND
5115     Q9=Q0+VAL(Q0$(6))
5120     IF STR(K9$,1,Q9) = STR(T7$,1,Q9) THEN 5190
5130     Q7$ = "SEQUENCE ERROR IN OPEN ITEM FILE"
5140     IF STR(T7$,1,Q9) < STR(K9$,1,Q9) THEN 6560
5150     PRINT AT(3,0,80);HEX(07);"INVOICE NOT FOUND"
5160     GOTO 4970
5170 REM ----------------
5180 REM DISPLAY AND PROCESS RECORD READ
5190     GOSUB '71(4,Q)
5200     A6=Q
5210     A7=T6
5220     Q9=POS(" CEPX"=C3$(A6))
5230     IF Q9 = 0 THEN 5130
5240     Q6$ = "INVOICE         CREDIT MEMO     EXTERNAL PAYMENT"
5250     IF Q9 > 3 THEN Q9 = 3
5260     Q6$=STR(Q6$,Q9*16-15,16)
5270 REM DISPLAY TRANSACTION RECORD
5280     PRINT AT(4,20,60);"INVOICE NO. - ";C1$(A6);"    *** ";Q6$;" ***"
5290     PRINTUSING "   P.O. NUMBER     ########     CHECK NO    ########",C4$
     (A6),B2(A6)
5300     PRINTUSING "   GROSS AMOUNT  #,###,###.##   DISC %     ",B(A6);
5310     IF ROUND((B0(A6),2)=B0(A6) THEN Q6$="##.##"
   : ELSE Q6$="##.########"
5320     PRINTUSING Q6$,B0(A6)
5330     GOSUB '123(B3(A6))
5340     IF Q6$ = "E" THEN U9$,Q6$ = " "
5350     PRINTUSING "   DISC AMOUNT   #,###,###.##   INV DATE    ########",ROU
     ND((B(A6)*B0(A6)/100,2),U9$
5360     IF B4(A6)<>99999 THEN GOSUB '123(B4(A6))
   : ELSE U9$="HOLD"
5370     IF Q6$ = "E" THEN U9$,Q6$ = " "
5380     PRINTUSING "   NET AMOUNT    #,###,###.##   DUE DATE    ########",B(A
     6)-ROUND((B(A6)*B0(A6)/100,2),U9$
5390     GOSUB '123(B5(A6))
5400     IF Q6$ = "E" THEN U9$,Q6$ = " "
5410     PRINTUSING "   PART PYMT AMT #,###,###.##   DATE PAID   ########",B1(
     A6),U9$
5420 REM FINDNEXT - OPEN ITEM FILE
5430     GOSUB '237(2,0)
5440     A8 = Q
5450     A9 = T6
5460     J$(1) = " "
5470     GOSUB '91
5475     Q9=Q0+VAL(Q0$(6))
5480     IF J0 = 0 AND STR(T7$,1,Q9) = STR(K9$,1,Q9) THEN J9 = 1
   : ELSE J9=0
5490     IF J9 = 1 THEN PRINT AT(10,0,80);"*** MORE INVOICES FOLLOW ***"
   : ELSE PRINT AT(10,0,80)
5500     C5$(A6)=" "
5510     IF C3$(A6) = " " THEN 5600
5520 REM PROCESS PAYMENT OR CREDIT MEMO
5530     GOSUB '100("Y,N","Y YyNn",1,1,"DO YOU WISH TO SELECT THIS TRANSACTION
      FOR PAYMENT (Y OR N)",2)
5550     IF Q6$="Y" THEN GOTO 5870
   : ELSE GOTO 5890
5590 REM PROCESS INVOICE RECORD
5600     GOSUB '100("Y,N","Y YyNn",1,1,"IS THIS INVOICE TO BE PAID (Y OR N)",2
     )
5630     IF Q6$ = "Y" THEN 5670
   : ELSE GOTO 5890
5660 REM IS PARTIAL PAYMENT DESIRED ?
5670     GOSUB '100("Y,N","Y YyNn",1,1,"DO YOU WISH TO CHANGE THE PARTIAL PAYM
     ENT AMOUNT (Y OR N)",2)
5700     IF Q6$ = "Y" THEN 5730
   : ELSE GOTO 5870
5730     GOSUB '100("0","9999999.99",7,2,"ENTER PARTIAL PAYMENT AMOUNT",1)
5740     IF Q9 < B(A6) THEN 5770
5750     PRINT AT(3,0,80);HEX(07);"Partial payment amount must be less than gr
     oss amount"
5760     GOTO 5730
5770     B1(A6) = Q9
5780     PRINT AT(9,0,0)
5790     PRINTUSING "   PART PYMT AMT #,###,###.##",B1(A6)
5800     GOSUB '100("Y,N","Y YyNn",1,1,"IS ENTRY OK (Y OR N)",2)
5830     IF Q6$ = "Y" THEN 5870
   : ELSE GOTO 5600
5860 REM FLAG RECORD IN THE OPEN ITEM FILE
5870     C5$(A6) = "1"
5880 REM TURN CONTROL FILE FLAG OFF UNTIL VENDOR'S ENTRIES ARE O.K.
5890     A6$=" "
5900     DBACKSPACE #4,BEG
5910     DSKIP #4,A7S
5920     GOSUB '61(4,A6)
5930     IF J9 = 0 THEN 4970
5940 REM POSITION DISK TO READ INVOICE TO FOLLOW
5950     DBACKSPACE #4,BEG
5960     DSKIP #4,A9S
5970     Q = A8
5980     T6 = A9
5990     GOTO 5190
6000 REM END OF INDIVIDUAL VENDOR
6010     GOSUB '100("Y,N","Y YyNn",1,1,"ACCEPT THIS VENDOR'S ENTRIES (Y OR N)"
     ,2)
6020     D8,D9=0
6040     IF Q6$ = "N" OR Q6$ = HEX(1F) THEN 6370
6080     GOSUB '232(2,0,N9$)
6090     GOSUB '237(2,0)
6100     J$(1) = " "
6110     GOSUB '91
6120     IF J0 > 1 THEN 5130
6130     IF J0 = 1 OR STR(T7$,,Q0) <> N9$ THEN 6230
6140 REM ACCUMULATE TOTALS FOR ITEMS SELECTED
6150     GOSUB '71(4,Q)
6160     Q6$ = C3$(Q)
6170     IF C5$(Q) <> "1" THEN 6090
6180     IF Q6$ = " " THEN Q9 = 1
   : ELSE Q9 = - 1
6190     IF B1(Q) <> 0 THEN Q6 = B1(Q)
   : ELSE Q6 = B(Q)
6200     D9 = D9 + Q6*Q9*SGN(POS(" CPX" = Q6$))
6210     D8 = D8 + ROUND((B0(Q)*Q6/100,2)*Q9*SGN(POS(" PX" = Q6$))
6220     GOTO 6090
6230     Q6$ = " "
6240     IF D9 - D8 < 0 THEN Q6$="CREDIT BALANCE FOR ITEMS SELECTED"
6250     IF D9 - D8 > A2 THEN Q6$ = "VENDOR ENTRIES SELECTED EXCEED VENDOR BAL
     ANCE."
6260     IF B4$="1" THEN B4$="2"
   : REM THIS MEANS THAT INDIVIDUAL SELECTION WAS ABLE TO OVERRIDE THE 'NO PAY
     ' FLAG IN THE VENDOR RECORD
6270     IF Q6$ = " " THEN 6500
6280     IF B4$="2" THEN B4$="1"
   : REM SET 'NO PAY' FLAG BACK TO 'NO PAY'
6290     PRINT AT(3,0,80);HEX(07);Q6$
6300     GOSUB '100("V,A","VvAa",1,1,"ENTER V = VOID, OR A = ADDITIONAL ENTRIE
     S",2)
6320     IF Q6$ = "A" THEN 4970
6360 REM REWRITE PAYMENT FLAG TO 'NO PAY' FOR ALL VENDOR'S INVOICES
6370     GOSUB '232(2,0,N9$)
6380     GOSUB '237(2,0)
6390     J$(1) = " "
6400     GOSUB '91
6410     IF J0 > 1 THEN 5130
6420     IF J0 = 1 OR STR(T7$,,Q0) <> N9$ THEN 6500
6430     GOSUB '71(4,Q)
6440     DBACKSPACE #4,1S
6450     C5$(Q) = " "
6460     GOSUB '61(4,Q)
6470     PRINT AT(4,20,60);"INVOICE NO. - ";C1$(Q);" WILL NOT BE PAID"
6480     GOTO 6380
6490 REM PAY THIS VENDOR, ADD TO TOTALS
6500     DBACKSPACE #2,1S
6510     A6$="1"
6520     GOSUB '60(2)
6530     GOTO 4690
6540 REM ---------
6550 REM ERROR EXIT
6560     GOSUB '91
6570     PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED - ";Q7$;AT(3,16);"- ";Q6
     $
6580     GOSUB '254
6590 REM ----------------------
6600 REM CLOSE FILES AND RETURN TO MENU
6610 REM UPDATE CONTROL FILE
6620     DEFFN'31
6630     IF A6$="X" THEN 6740
6640     $OPEN #5
6650     GOSUB '66(5,0,1)
6660 REM SET PAYMENT SELECT FLAG
6670     F5$(2) = A6$
6680     GOSUB '66(5,0,0)
6700     $CLOSE#5
6740     LOAD T M$
9000 REM *************
9010 REM * VARIABLES *
9020 REM *************
9030 REM     A6  =  RECORD NO. WITHIN SECTOR - CURRENT INVOICE
9040 REM    A6$  =  PAYMENT SELECT FLAG ('X'MEANS DO NOT REWRITE FLAG)
9050 REM     A7  =  RELATIVE SECTOR NO. - CURRENT INVOICE
9060 REM     A8  =  RECORD NO. WITHIN SECTOR - INVOICE TO FOLLOW
9070 REM     A9  =  RELATIVE SECTOR NO. - INVOICE TO FOLLOW
9100 REM     D8  =  ACCUMULATE TOTAL DISCOUNT FOR VENDOR
9110 REM     D9  =  ACCUMULATE TOTAL GROSS FOR VENDOR
9140 REM     J9  =  FLAG INDICATING MORE INVOICES TO FOLLOW
9150 REM     O9  =  STORE OPTION SELECTED
9160 REM    K9$  =  OPEN ITEM FILE - KEY
9170 REM    N9$  =  VENDOR ID
9180 REM $
9999 DEFFN'29"Q$= ";HEX(22);"ACPA050A";HEX(22);":SCRATCH T Q$:SAVE T$()Q$";HEX
     (0D)