          SUBROUTINE (PASSER)
** Version# 14.0002[16] - 04/14/2016 - 03:39pm - TSMITH - eclipse
*** V14.0002 Change - Custom Coding . - 04/14/2016 - TSMITH - eclipse
** Copied from BP POE.PRINT.BATCH Version# 14 - 04/07/2005 - 06:23pm - DONS - develop

*** Subroutine: POE.PRINT.BATCH
*-------------------------------------------------------------------------*
*** Batch Print Purchase Orders allows you to print purchase orders (POs)
*** in a batch mode. Specify the branch, territory (or ALL for all
*** branches) and press Enter. The system looks for all of the valid open
*** POs with the status of
***    O - Open Purchase Orders
***    Y - Direct Shipment Purchase Orders
***    R - Purchase Order Receivers
***    V - Advance Ship Purchase Orders
*** The user can then select one or more of these groups and run a preview
*** report or print the orders.
*-------------------------------------------------------------------------*
*** Passed variables: None
*-------------------------------------------------------------------------*
*** COMMON variables: None
*-------------------------------------------------------------------------*

          WINDOW ,,,,9,'POE.PRINT.BATCH'

          SEL     = ''
          IDLIST  = ''

          GOSUB DISPLAY

          MENU.LOAD  2,8,7,1,'P'
          MENU.LOAD 12,8,5,2,'R'

          TERR.OK = YES
IN.BR:    INP.BR 14,1,10,BR,NAME,BRCHS,TERR.OK
          IF F12 THEN GOTO FINISH

          GOSUB SELECTEM

          LINE = 1
IN.SEL:   INP A,3,LINE+2,1,T_' '
          BEGIN CASE
          CASE LASTKEY=32;      SEL<LINE> = NO
          CASE A#'';            SEL<LINE> = YES
          END CASE
          IF SEL<LINE> THEN TMP = '*' ELSE TMP = ' '
          PRINT @(3,LINE+2):TMP
          BEGIN CASE
          CASE F12;         GOTO FINISH
          CASE MOVE = 2;    IF LINE>1 THEN LINE += -1
          CASE MOVE = 4 OR MOVE=5;    IF LINE<4 THEN LINE += 1
          END CASE


          GOTO IN.SEL
*-------------------------------------------------------------------------*
DISPLAY:  FOR J=1 TO 4
          IF SEL<J> THEN TMP = '*' ELSE TMP = ' '
          PRINT @(3,J+2):TMP                   "L#1"
          PRINT @(30,J+2):DCOUNT(IDLIST<J>,VM)  "R#5"
          NEXT J
          RETURN
*-------------------------------------------------------------------------*
SUBS:     ON OPTION GOTO PREVIEW, PRINT.IT
*-------------------------------------------------------------------------*
SELECTEM: WINDOW ,,25,3
          PRINT @(0,1):BLINK$:'Selecting .....':NORM$

          EX = 'SELECT LEDGER WITH ORDER_STATUS="O" AND SHIP_VIA_ID="UPS NEXT DAY" OR SHIP_VIA_ID="UPS 2ND DAY AIR"'


          EXECUTE EX CAPTURING MSG RTNLIST ID.LIST

          LOOP
             READNEXT ID FROM ID.LIST ELSE EXIT

             OID = ID
             GID = 1
             OE.LOCK.LED OID,LOCK.MSG,YES
             IF LOCK.MSG THEN CONTINUE
             LOCATE GID IN LED(12)<1> SETTING GEN THEN
                LOCATE LED(2)<1,GEN,1> IN BRCHS<1> SETTING POS THEN
                   GOSUB ADD.ITM
                END
             END

             OE.UNLOCK.LED OID
          REPEAT

          WINDOW.CLOSE

          GOSUB DISPLAY

          RETURN
*-------------------------------------------------------------------------*
ADD.ITM:  STAT = LED(6)<1,GEN>
          MODE = OID[1,1]
          NEXT.DAY = TRANS("LEDGER.GPS",ID,14,'X')
          BEGIN CASE
          CASE NEXT.DAY=1; RETURN
          CASE STAT = 'O' AND MODE = 'P';  SEL.NO = 1
          CASE STAT = 'Y' AND MODE = 'S';  SEL.NO = 2
          CASE STAT = 'R' AND MODE = 'P';  SEL.NO = 3
          CASE STAT = 'V' AND MODE = 'P';  SEL.NO = 4
          CASE OTHERWISE;   RETURN
          END CASE

          LOCATE ID IN IDLIST<SEL.NO> BY 'AL' SETTING POS ELSE
             IDLIST  = INSERT(IDLIST,SEL.NO,POS;ID)
             END

          RETURN
*-------------------------------------------------------------------------*
PREVIEW:  WINDOW ,,60,3,3
          PRINT @(0,1):BLINK$:'Compiling Report .... Please Wait....':NORM$

          HDR = 'Purchase Orders Preview'
          TITLE = 'Purchase Orders Preview'
          PRINTER.ON 132,TITLE,DOC.ID,HDR

          CT = 0
          FOR DOCN=1 TO 4
          IF SEL<DOCN> THEN
             IDS   = IDLIST<DOCN>
             ID.CT = DCOUNT(IDS,VM)
             FOR IDN=1 TO ID.CT
             ID     = IDS<1,IDN>
             OID    = ID
             GID    = 1
             MATREAD LED FROM LEDFILE,OID THEN
                LOCATE GID IN LED(12)<1> SETTING GEN THEN
                   ORN  = OID
                   INVN = LED(8)<1,GEN>
                   IF INVN THEN ORN = ORN:'.':LED(8)<1,GEN>"R%3"
                   GOSUB CHECK.ASL
                   IF ASL.ERR THEN
                      PRINT '*** ASL Hold - ':ORN
                   END ELSE
                      BT.CN = LED(5)<1,GEN>
                      READV NAME FROM CUSFILE,BT.CN,1 ELSE NAME = ''
                      CT += 1
                      SHP.DT = LED(9)<1,GEN>
                      PRINT CT"R#3":') ':ORN"L#14":
                      PRINT OCONV(SHP.DT,'D2/')"L#10":
                      PRINT NAME"L#30":
                      PRINT LED(6)<1,GEN,1>"L#5":LED(73)<1,GEN>"L#15"
                   END
                END
             END
             NEXT IDN
             END
          NEXT DOCN

          PRINTER.OFF DOC.ID,'HOLD'

          WINDOW.CLOSE

          VIEW.PRINT DOC.ID
          SPOOLER.DELETE DOC.ID

          RETURN
*-------------------------------------------------------------------------*
PRINT.IT: *
          ABORT.PRT   = NO
          CHECK.ALIGN = YES
          FOR DOCN = 1 TO 4
          IF SEL<DOCN> THEN
             GOSUB PRINT.DOCN
             END
          NEXT DOCN
          RETURN TO FINISH
*-------------------------------------------------------------------------*
PRINT.DOCN:*
          IDS    = IDLIST<DOCN>
          ID.CNT = DCOUNT(IDS,VM)
          FOR ID.NO = 1 TO ID.CNT UNTIL ABORT.PRT
          ID  = IDS<1,ID.NO>
          OID = ID
          MATREAD LED FROM LEDFILE,OID THEN
             GID = 1+0
             LOCATE GID IN LED(12)<1> SETTING GEN THEN
                IF OID[1,1] = 'S' THEN GOSUB CHECK.CREDIT.LIMIT
                IF ASL.ERR THEN CONTINUE
                GOSUB CHECK.ASL
                IF ASL.ERR THEN CONTINUE
                POE.PRINT.RECVR OID,GEN
                IF CHECK.ALIGN THEN GOSUB VERIFY.ALIGN
                IF NOT(ABORT.PRT) THEN
                   OE.UPD.PRINT.STAT OID,GEN,'N'
                   END
                END
             END

          UT.OPEN.FILE "LEDGER.GPS",LEDGFILE,ERR.MSG
          NDA = 1
          WRITEV NDA ON LEDGFILE,OID,14
          NEXT ID.NO

          RETURN
*-------------------------------------------------------------------------*
VERIFY.ALIGN:   *
          WINDOW ,,60,4,3

          PRINT @(0,1):'Verify Form Alignment : '
          PRINT @(10,2):'(<R>eprint, <C>ontinue, <N>ext, <A>bort) : '

IN.ALIGN: PRINT @(24,1):' '
IN$$1:    INP ANS,24,1,1,'MCU'
          BEGIN CASE
          CASE ANS = 'R'
POE.PRINT.RECVR OID,GEN
             GOTO IN.ALIGN
          CASE ANS = 'C'
             CHECK.ALIGN = NO
          CASE ANS = 'N'
             NULL
          CASE ANS = 'A'
             ABORT.PRT = YES
          CASE OTHERWISE
             PRINT BELL:
             GOTO IN.ALIGN
          END CASE

          WINDOW.CLOSE
          RETURN
*-------------------------------------------------------------------------*
CHECK.ASL:*** See if this order should be on a hold...
          ASL.ERR = NO
          IF LED(6)<1,GEN> = 'X' THEN RETURN

          CTRL.ID = 'VALID.VENDOR.ASL.TYPES'
          READ ASL.LIST FROM CTRLFILE,CTRL.ID ELSE ASL.LIST = ''
          IF ASL.LIST = '' THEN RETURN

          HAS.HOLD = NO
          *** Check to see if this vendor has an automatic hold.
          BF.ENT = LED(1)<1,GEN>
          SF.ENT = LED(5)<1,GEN>
          READV BF.TYPE FROM CUSFILE,BF.ENT,176 ELSE BF.TYPE = ''
          IF BF.TYPE THEN
             LOCATE BF.TYPE IN ASL.LIST<1> SETTING APOS THEN
                ASL.ERR = ASL.LIST<2,APOS>
                IF ASL.ERR THEN RETURN
             END
          END

          IF OID[1,1] = 'S' THEN GOSUB CHECK.DIR ELSE GOSUB CHECK.PO
          IF HAS.HOLD THEN ASL.ERR = YES

          RETURN
*-------------------------------------------------------------------------*
CHECK.CREDIT.LIMIT:   ***See if customer has exceeded credit limit

          ASL.ERR  = NO
          HAS.HOLD = NO
          LOCATE LED(33)<1,GEN> IN LED(12)<1> SETTING DGEN ELSE DGEN = 1

          OE.GET.QSIGN QSIGN,OID,GEN
          *** Get the ShipTo branch for this order Gen...
          BR = LED(2)<1,GEN,1>
          *** Load Customer for the S/O Gen of our direct...
          GET.CUS BR,LED(1)<1,DGEN>,LED(5)<1,DGEN>,QSIGN;*
          SOE.CREDIT.CHECK LED(5)<1,DGEN>,NO.OE,COD,PRT.MSG,NO.SHIP,,,OID,DGEN
          SOE.CALC.CASH OID, DGEN, AMT.DUE,,,,DIR.COD.DUE
          IF NO.OE OR NO.SHIP OR PRT.MSG OR (COD AND (AMT.DUE > 0 OR DIR.COD.DUE > 0)) THEN
             PRMPT  = 'Release a Direct P/O (Cust Credit Limit)'
             PRMPT := ' for Customer ':OCONV(LED(5)<1,DGEN>,'TENTITY;X;1;1'): ', Order ':OID
             SOE.CHECK.CREDIT.RELEASE OID,GEN,PRMPT,YES,PRT.OK,,2
             IF NOT(PRT.OK) THEN HAS.HOLD = YES
          END
          IF HAS.HOLD THEN ASL.ERR = YES

          RETURN
*-------------------------------------------------------------------------*
CHECK.DIR:*** See if there is a reason to hold a PO on a direct.
          LOCATE LED(33)<1,GEN> IN LED(12)<1> SETTING DGEN ELSE DGEN = 1

          BT.ENT = LED(1)<1,DGEN>
          ST.ENT = LED(5)<1,DGEN>

          READV BLIST FROM CUSFILE,BT.ENT,176 ELSE BLIST = ''
          LOCATE BF.ENT IN BLIST<1> SETTING BPOS THEN
             HAS.HOLD = YES
          END ELSE IF BT.ENT # ST.ENT THEN
             READV SLIST FROM CUSFILE,ST.ENT,176 ELSE SLIST = ''
             LOCATE BF.ENT IN SLIST<1> SETTING SPOS THEN
                HAS.HOLD = YES
             END
          END

          RETURN
*-------------------------------------------------------------------------*
CHECK.PO: *** See if there is a reason to hold a tagged PO.
          LDIDS = LED(49)
          IF LED(48)<1,GEN> THEN LDIDS = RAISE(LED(48)<1,GEN>)

          LD.CT = DCOUNT(LDIDS,VM)
          FOR LL = 1 TO LD.CT UNTIL HAS.HOLD
             LDID = LDIDS<1,LL>
             LD.GET LDID

             SQ = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)
             IF SQ+0=0 THEN CONTINUE

             LLL.CT = DCOUNT(LD(7)<1,GEN>,SVM)
             FOR LLL = 1 TO LLL.CT UNTIL HAS.HOLD
                TAG = FIELD(LD(7)<1,GEN,LLL>,'^',2)
                TOID = FIELD(TAG,'.',1)
                TLDID = FIELD(TAG,'.',2)
                IF TOID # '' AND TLDID # '' THEN GOSUB CHECK.TAG
             NEXT LLL
          NEXT LL

          RETURN
*-------------------------------------------------------------------------*
CHECK.TAG:*** Check the associated tagged order for ASL conflicts with the
          *** current PayTo.

          READ TLED FROM LEDFILE,TOID ELSE RETURN

          LD.ATTB = 149+TLDID

          GX.CT = DCOUNT(TLED<9>,VM)
          FOR GX = 1 TO GX.CT UNTIL HAS.HOLD
             SQ = SUM(TLED<LD.ATTB,5,GX>) + SUM(TLED<LD.ATTB,6,GX>)
             IF SQ+0#0 THEN
                S.ENT = TLED<5,GX>
                B.ENT = TLED<1,GX>
                READV TCUSS FROM CUSFILE,S.ENT,176 ELSE TCUSS = ''
                LOCATE LED(1)<1,GEN> IN TCUSS<1> SETTING LDPOS THEN
                   HAS.HOLD = YES
                   CONTINUE
                END ELSE IF B.ENT # S.ENT THEN
                   READV TCUS FROM CUSFILE,B.ENT,176 ELSE TCUS = ''
                   LOCATE LED(1)<1,GEN> IN TCUS<1> SETTING LDPOS THEN
                      HAS.HOLD = YES
                      CONTINUE
                   END
                END
             END
          NEXT GX

          RETURN
*-------------------------------------------------------------------------*
FINISH:   WINDOW.CLOSE
          RETURN
!TSMITH~04/14/16~15:39
