          SUBROUTINE (INIT.OID,GEN,PRT.ON,SHP.STATS,PRT.OPT,PRT.TGS,CMTD,LSTATS)
** Version# 3 - 12/28/2009 - 12:08pm - BABS - main

*** Subroutine - POE.PRINT.RECVR.DEFAULT
*-------------------------------------------------------------------------*
*** This routine prints a Purchase Order Receiver Report, which is used as
*** a working receiving document when a shipment arrives at the receiving
*** dock. The report helps the warehouse person receiving material from a
*** purchase order to take the appropriate action. If there are open sales
*** orders waiting for the receipt of this purchase order, then there may
*** be no need to put the material on the shelf.
***
*** The reason we have this version versus the Eclipse Forms version
*** (POE.PRINT.RECVR.ECL.FORMS) is due to the fact that the P/O Receiver
*** is a report that has a specific form type (PURCH.RECVR). When a header
*** is specified (HDR) in PRINTER.ON on a FORM is screws up the results.
*** However, we HAVE to have the HDR for Eclipse Forms to work, so there
*** are two routines. Sorry for the duplicate code!!!
*-------------------------------------------------------------------------*
*** INIT.OID   - Purchase Order Id                                    [IN]
*** GEN        - Generation                                           [IN]
*** PRT.ON     - Null
*** SHP.STATS  - Order Status                                         [IN]
*** PRT.OPT    - All, NonStock Only, Stock Only                       [IN]
*** PRT.TGS    - Show tagged quantities  :  Only this Order,
***              All Orders                                           [IN]
*** CMTD       - All or Order Quantity (Committed)                    [IN]
*** LSTATS     - Location statuses (value marked list)                (IN)
***              Current statuses are:
***              Primary, Secondary, Floating, Remnant, *Blank*
***              Constant default is Primary.
*-------------------------------------------------------------------------*
*** COMMON Variables Used: LED, LD, PRD, PRD.BR, PLNE
*-------------------------------------------------------------------------*
          * Need to read in LED before the po recvr dflts can be correctly
          * read in for Solar calls.

          * Host allows for printing of open POs, if we don't strip off
          * the .0001 of open POs then Solar will fail.
          OID       = FIELD(INIT.OID,'.',1)
          MATREAD LED FROM LEDFILE,OID ELSE GOTO FINISH

          * Check to see if there are printing defaults defined
          * for this branch in the CONTROL.BR file. These are set
          * via the P/O receiver F6-R-V.
          STK.BR = LED(2)<1,GEN,2>
          DFLTS.ID = 'PO.RECVR.DFLTS~':STK.BR
          READ DFLTS FROM CTRBFILE,DFLTS.ID THEN
             DFLT.SHP.STATS = DFLTS<1>
             DFLT.PRT.OPT   = DFLTS<2>
             DFLT.CMTD      = DFLTS<3>
             DFLT.PRT.TGS   = DFLTS<4>
             DFLT.LSTATS    = DFLTS<5>
          END ELSE
             DFLT.SHP.STATS = ''                 ;* Null = ALL
             DFLT.PRT.OPT   = 'ALL'              ;* Stock and Nonstock
             DFLT.CMTD      = NO                 ;* All
             DFLT.PRT.TGS   = NO                 ;* Only for this order
             DFLT.LSTATS    = 'Primary'
          END

          * If report is called without specific settings, the defaults
          * will be used.
          IF SHP.STATS = '' THEN SHP.STATS = DFLT.SHP.STATS
          IF PRT.OPT   = '' THEN PRT.OPT   = DFLT.PRT.OPT
          IF CMTD      = '' THEN CMTD      = DFLT.CMTD
          IF PRT.TGS   = '' THEN PRT.TGS   = DFLT.PRT.TGS
          IF LSTATS    = '' THEN LSTATS    = DFLT.LSTATS


          * Strips the first letter from the Location type to read just
          * the first letter.  (works better with FORMS.LOCATIONS.GET)
          LOC.STAT = DCOUNT(LSTATS,VM)
          FOR LCNT = 1 TO LOC.STAT
             IF LSTATS<1,LCNT> # "*Blank*" THEN
                LSTATS<1,LCNT> = LSTATS<1,LCNT>[1,1]
             END
          NEXT LCNT

          IF LSTATS LCNT > 1 THEN
             ADDL.LOCS = YES
          END ELSE
             ADDL.LOCS = NO
          END

          IF NOT(PHANTOM.PROC) AND NOT(PRT.ON) AND NOT(JAVA.PROC$) THEN
             OPEN.WINDOW = YES
          END ELSE
             OPEN.WINDOW = NO
          END
          SERIAL        = NO
          PG.LGTH       = 60

          IF OPEN.WINDOW THEN
             WINDOW 15,8,50,5
             PRINT @(0,1):'Printing .... ':OID
          END

          CONVERT ',' TO VM IN SHP.STATS

          QSIGN  = 1
          BR     = LED(2)<1,GEN,1>

          BT.CN  = LED(1)<1,GEN>
          ST.CN  = LED(5)<1,GEN>

          GET.CUS BR,BT.CN,ST.CN,QSIGN

          BEGIN CASE
          CASE OID[1,1] = 'T';   LDIDS = LED(48)<1,1>
          CASE LED(8)<1,GEN> = ''
             LDIDS = LED(49)
             CONVERT VM TO SVM IN LDIDS
          CASE OTHERWISE
             LDIDS = LED(48)<1,GEN>
          END CASE

          GOSUB INIT

          IF NOT(PRT.ON) THEN
             PRINTER.ON "PURCH.RECVR"
          END

          GOSUB HEADER

          LDID.CT = DCOUNT(LDIDS,SVM)
          FOR LD.NO = 1 TO LDID.CT
             LDID   = LDIDS<1,1,LD.NO>
             GOSUB PRT.LINE
          NEXT LD.NO

          GOSUB FOOTER

          IF SERIAL THEN
             POE.SERIAL.WKSHT INIT.OID,GEN
          END

          IF NOT(PRT.ON) THEN
            PRINTER.OFF
          END

          GOTO FINISH
*-------------------------------------------------------------------------*
INIT:     *** Initialize variables.
          PAGE       = 0
          IN.FOOTER  = NO
          PG.LGTH    = 60

          INVN   = LED(8)<1,GEN>
          IF INVN='' THEN
             ORD.ID = OID
          END ELSE
             ORD.ID = OID:'.':INVN"R%3"
          END

          RETURN
*-------------------------------------------------------------------------*
HEADER:   *** Set up and print our header

          PAGE     = PAGE + 1
          LINE.CT  = PG.LGTH

          IF PRT.OPT[1,1] = 'A' THEN OPT.MSG='' ELSE OPT.MSG="   ":PRT.OPT
          FRT.ALLOW = LED(69)<1,GEN,1>
          IF NUM(FRT.ALLOW) THEN
             * Backward compatable with old flag Yes/No Allowed
             IF FRT.ALLOW+0 = 0 THEN
                FRT.ALLOW = 'Prepaid'
             END ELSE
                FRT.ALLOW = 'Allowed'
             END
          END

          PRINT

          IF ORD.ID[1,1]='T' THEN
             PRINT SPACE(25):'*** T r a n s f e r   R e c e i v e r ***':
             WRK = 'Xfr'
          END ELSE
             PRINT SPACE(30):'*** P / O   R e c e i v e r ***':
             WRK = 'P/O'
          END

          * nothing should be over 80 chars wide
          PRINT OPT.MSG
          PRINT WRK:' #  : ':ORD.ID"L#14":SPACE(47):'Page : ':PAGE"L#3"
          PRINT
          PRINT 'Vendor : ':CUSS(1)"L#54":'Branch :   ':STK.BR"L#4"
          PRINT

          HDR.LNE  = 'Writer : ':LED(73)<1,GEN> "L#10":SPACE(1)
          HDR.LNE := 'Receiver : ':STR('_',15):SPACE(4)
          HDR.LNE := 'Recv Date : ':STR('_',10)
          PRINT HDR.LNE

          PRINT 'Printed By : ':SECURITY<3>
          PRINT 'Freight: ':FRT.ALLOW
          PRINT

          IF ORD.ID[1,1]='T' THEN
             COL.HDG  = 'Location' "L#12 "
             COL.HDG := 'S '
             COL.HDG := 'Xfer Qty' "L#9 "
             COL.HDG := 'Ship Qty' "L#9 "
             COL.HDG := 'Description / Committed Orders' "L#38 "
             COL.HDG := 'Recvd' "L#6"
             PRINT COL.HDG

             COL.SEP  = STR('-',12)
             COL.SEP := SPACE(1):STR('-',1)
             COL.SEP := SPACE(1):STR('-',9)
             COL.SEP := SPACE(1):STR('-',9)
             COL.SEP := SPACE(1):STR('-',38)
             COL.SEP := SPACE(1):STR('-',6)
             PRINT COL.SEP
          END ELSE
             COL.HDG  = 'Location' "L#12 "
             COL.HDG := 'Ord Qty'  "L#9 "
             COL.HDG := 'Ship Qty' "L#9 "
             COL.HDG := 'Description / Committed Orders' "L#38 "
             COL.HDG := 'Recvd' "L#6"
             PRINT COL.HDG

             COL.SEP  = STR('-',12)
             COL.SEP := SPACE(1):STR('-',9)
             COL.SEP := SPACE(1):STR('-',9)
             COL.SEP := SPACE(1):STR('-',38)
             COL.SEP := SPACE(1):STR('-',6)
             PRINT COL.SEP
          END

          LINE.CT -= 11

          RETURN
*-------------------------------------------------------------------------*
FOOTER:   *** If in footer, form feed and start over with header.

          IN.FOOTER = YES

          PRINT CHAR(12):

          LINE.CT = 0

          RETURN
*-------------------------------------------------------------------------*
PRT.LINE: *** Set up line printing.

          LD.GET LDID

          PN = LD(1)
          IF NOT(NUM(PN)) THEN RETURN

          GET.ALL.PRD BR,PN,QSIGN,GROUP

          STAT = PRD(3)

          IF PRD.BR(25)='I' OR PRD.BR(25)='A' OR PRD.BR(25)='D' THEN
             SERIAL = YES
          END

          BEGIN CASE
          CASE STAT = 1;   STAT = 'S'
          CASE STAT = 2;   STAT = 'N'
          CASE STAT = 3;   STAT = 'M'
          CASE STAT = 4;   STAT = 'D'
          CASE STAT = 5;   STAT = 'R'
          CASE STAT = 6;   STAT = 'C'
          END CASE
          BEGIN CASE
          CASE PRT.OPT[1,1]='S' AND STAT # 'S'; GOTO SKIPPRT
          CASE PRT.OPT[1,1]='N' AND STAT = 'S'; GOTO SKIPPRT
          END CASE

          OE.DESC.GET DESC,'','POE Printing'
          IF LD(36)<1,GEN,1> # '' THEN DESC<1,-1> = LD(36)<1,GEN,1>

          * Kits
          IF LD(31)#'' AND PRD(86)<1,2> = '1' THEN
             KCMPS = LD(31)
             KQTYS = LD(30)
             GET.KIT.COMPS KCMPS,KQTYS,35,DESC
          END
          HDESC = DESC

          * Get our qty, location, commitment, and tag printing info.

          PRDD.BR.GET STK.BR,PN
          TQTY     = SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)

          IF TQTY  = 0 THEN RETURN
          TQTYS    = ADDS(LD(5)<1,GEN>,LD(6)<1,GEN>)
          TQ.CNT   = DCOUNT(TQTYS,SVM)
          FOR TQ = 1 TO TQ.CNT
             TQNT        = TQTYS<1,1,TQ>
             SHP.TYP.LOC = LD(7)<1,GEN,TQ>
             TAG         = FIELD(SHP.TYP.LOC,'^',2)

             FORMS.LOCATIONS.GET GEN,1,LSTATS,LOC.LIST,TQ

             LOCA     = FIELD(LOC.LIST<1,1>,'~',2)
             LOC.STAT = FIELD(LOC.LIST<1,1>,'~',3)
             IF TAG # '' THEN LOCA = FIELD(TAG,".",1)

             GOSUB PRT.PO
             IF DESC # HDESC THEN DESC = HDESC
          NEXT TQ



          * Print All tag Qtys first
          TYP.LOCS = LD(7)<1,GEN>
          LOC.CT   = DCOUNT(TYP.LOCS,SVM)

          FOR LOC  = 1 TO LOC.CT
             TYPE  = FIELD(TYP.LOCS<1,1,LOC>,'~',1)
             IF TYPE = 'T' THEN
                TAG     = TYP.LOCS<1,1,LOC>
                ORN     = FIELD(TAG,'^',2)
                OID     = FIELD(ORN,'.',1)
                LDID    = FIELD(ORN,'.',2)+0
                GID     = ''
                TYPE    = ''
                TORN    = ''
                CTAG    = '-T'
                SHP.QTY = LD(6)<1,GEN,LOC>
                SBR     = STK.BR

                GOSUB PRT.QTY

                TQTY   -= SHP.QTY
             END
          NEXT LOC

          * Print Stock committments until P/O Qty is used up
          GOSUB SET.PRIS

          * If the control record to exclude all sales orders
          * outside the plenty date is set to yes, then prioritize
          * our orders by ship date and first in first out.
          GOSUB GET.PRI

          ID.CT = DCOUNT(IDS,AM)
          FOR J = 1 TO ID.CT
             IF TQTY <= 0 AND CMTD THEN EXIT
             SHP.QTY  = -QTYS<J>+0
             ID       = IDS<J>
             SBR      = SBRS<J>

             * Make sure to setup a correct branch.
             IF SBR   = '' THEN SBR = WHSE

             * Only show Tagged Orders on the P/O recvr...
             IF SBR # STK.BR AND WRK = 'Xfr' THEN GOTO NEXTJ

             IF SHP.QTY > 0 AND FIELD(ID,'~',6) # 'D' THEN
                OID   = FIELD(ID,'~',3)
                GID   = FIELD(ID,'~',5)
                TYPE  = FIELD(ID,'~',6)
                TORN  = FIELD(ID,'~',7)
                LDID  = ''
                CTAG  = ''

                * Don't print the tagged qtys if they ask not to.
                IF TYPE = 'T' AND NOT(PRT.TGS) THEN CONTINUE

                GOSUB PRT.QTY
                TQTY -= SHP.QTY
             END
NEXTJ:    NEXT J

          GOSUB PRT.XFER

SKIPPRT:  GOSUB SUBT.ONE
          PRINT

          RETURN
*-------------------------------------------------------------------------*
SET.PRIS: *** Set the priorities correclty for a mom branch
          GET.PCGID PCGID,PRD(18),PRD(12)
          OE.GET.PRIS IDS,QTYS,SBRS,WHSE,PN,STK.BR,PCGID

          RETURN
*-------------------------------------------------------------------------*
PRT.XFER: *** If printing a tranfer receiver, print branch info.
          ITEM.XFER.GET INFO,PN,STK.BR
          CT = DCOUNT(INFO<1>,VM)

          FOR J = 1 TO CT
             IF INFO<2,J> THEN
                GOSUB SUBT.ONE
                LINE  = SPACE(24):'** Branch Transfer to BR# : '
                LINE := INFO<1,J>           "L#5 "
                LINE := '- Qty :':INFO<2,J> "L#7"
                PRINT LINE
             END
          NEXT J

          RETURN
*-------------------------------------------------------------------------*
PRT.PO:   *** Print the line detail of the receiver.

          GOSUB SUBT.ONE

          IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),TQNT,Q1,U1,Q2,U2,QO.ALPHA

          IF ORD.ID[1,1]='T' THEN
             LINE  = LOCA           "L#12 "
             LINE := LOC.STAT       "L#1 "
             LINE := TRIM(QO.ALPHA) "L#9 "
             LINE := SPACE(10)
             LINE := DESC<1,1>      "L#38 "
             LINE := STAT           "L#6"
             PRINT LINE
          END ELSE
             LINE  = LOCA           "L#12 "
             LINE := TRIM(QO.ALPHA) "L#9 "
             LINE := SPACE(10)
             LINE := DESC<1,1>      "L#37 "
             LINE := STAT           "L#1"
             PRINT LINE
          END

          LOC.LIST = DELETE(LOC.LIST,1,1)
          DESC     = DELETE(DESC,1,1)

          GOSUB PRT.XDESC

          RETURN
*-------------------------------------------------------------------------*
PRT.QTY:  *** Get quantity and commitment information.

          READV LED5  FROM LEDFILE,OID,5               ELSE LED5  = ''
          READV LED6  FROM LEDFILE,OID,6               ELSE LED6  = ''
          READV LED9  FROM LEDFILE,OID,9               ELSE LED9  = ''

          IF NOT(LDID) THEN
             READV LED12 FROM LEDFILE,OID,12           ELSE LED12 = ''
             LOCATE GID IN LED12<1> SETTING OGN ELSE OGN = 1
             LDID = FIELD(ID,'~',4)
          END ELSE
             READV LED8 FROM LEDFILE,OID,8             ELSE LED8  = ''
             LD.READV LD7, OID, LDID, 7
             GCT = DCOUNT(LED6,VM)
             FOR OGN = 1 TO GCT
                IF NOT(LED8<1,OGN>) AND INDEX(LD7<1,OGN>,'T~',1) THEN EXIT
             NEXT OGN
          END

          READV CNAME FROM CUSFILE,LED5<1,OGN>,1       ELSE CNAME = ''

          IF SHP.STATS # '' THEN
             LOCATE LED6<1,OGN> IN SHP.STATS<1> SETTING POS ELSE RETURN
          END

          * Pull the UoM that was used on the order for our product...
          LD.READV LD23,OID,LDID,23
          IQ.TO.ALPHA PLNE(3),PRD(7),LD23,SHP.QTY,,,,,QO.ALPHA

          GOSUB SUBT.ONE
          LINE  = SPACE(35)
          LINE := TRIM(QO.ALPHA)           "L#9 "
          LINE := OID                      "L#13 "
          LINE := OCONV(LED9<1,OGN>,'D2/') "L#11"
          PRINT LINE

          GOSUB SUBT.ONE
          LINE  = SPACE(38)
          LINE := CTAG                     "L#3 "
          LINE := LED6<1,OGN>              "L#3 "
          LINE := CNAME                    "L#25"
          PRINT LINE

          IF TYPE = 'T' THEN
             GOSUB SUBT.ONE

             LINE  = SPACE(11):'** Above is Tagged to : '
             LINE := FIELD(TORN,'^',2) "L#8"
             LINE := ' **'
             PRINT LINE

          END ELSE IF SBR # STK.BR THEN
             GOSUB SUBT.ONE

             LINE  = SPACE(11):'** Branch Transfer to BR# : ':SBR "L#5 "
             LINE := 'Order : ':OID
             PRINT LINE
          END

          RETURN
*-------------------------------------------------------------------------*
PRT.XDESC: ***If extra location or description printing needed, do it now.

          DESC.CT = DCOUNT(DESC,VM)
          LOCA.CT = DCOUNT(LOC.LIST,VM)

          * Which has more to print....locations or description?
          BEGIN CASE
          CASE LOCA.CT > DESC.CT
             DLN.DESC = LOCA.CT
          CASE OTHERWISE
             DLN.DESC = DESC.CT
          END CASE

          * Print extra location and description lines.
          FOR DLN = 1 TO DLN.DESC
             GOSUB SUBT.ONE
             LOCA    = FIELD(LOC.LIST<1,DLN>,'~',2)
             LOC.STAT = FIELD(LOC.LIST<1,DLN>,'~',3)
             PRINT LOCA "L#12":SPACE(1):LOC.STAT "L#1":
             PRINT LOCA SPACE(19):DESC<1,DLN> "L#35"
          NEXT DLN

          RETURN
*-------------------------------------------------------------------------*
SUBT.ONE: *** Subtract another line from the total line count, if less than
          *** 5 lines left, go to the footer printing, form feed and start
          *** over.

          IF LINE.CT < 7 THEN
             GOSUB FOOTER
             GOSUB HEADER
          END
          LINE.CT -= 1

          RETURN
*-------------------------------------------------------------------------*
GET.PRI: *** Determine whether the committed orders fall within the
         *** plenty date range or not.  Then place in order based on the
         *** order date.

          * Initialize the variables.
          PY.IDS   = ''
          PY.QTYS  = ''
          PY.BRS   = ''
          IDS.TMP  = IDS
          QTYS.TMP = QTYS
          SBRS.TMP  = SBRS
          IDS      = ''
          QTYS     = ''
          SBRS     = ''

          PLENTY.DATE = DATE.NEXT.REC(PN,BR)


          * Loop through all of the ids and put them in order of priority.
          MORE.DATA = (IDS.TMP # '')
          LOOP UNTIL NOT(MORE.DATA)

             REMOVE ID   FROM IDS.TMP  SETTING MORE.DATA
             REMOVE QTY  FROM QTYS.TMP SETTING X
             REMOVE SBR  FROM SBRS.TMP SETTING Y
             IF SBR = '' THEN SBR = WHSE

             IF QTY < 0 THEN
                SHP.DT   = FIELD(ID,'~',2)+0
                ORD.STAT = FIELD(ID,'~',9)
                THIS.OID = FIELD(ID,'~',3)

                * Check the order stat and adjust to the correct dt
                STAT.OK = ORD.STAT#'W' AND ORD.STAT#'S' AND ORD.STAT#'D'

                * Only want to exclude the Plenty Date if the Product is
                * not a Delete Status Product
                READV PRD.STAT FROM PRDFILE,PN,3 ELSE PRD.STAT = ""
                IF PRD.STAT # "4" THEN
                   IF EXC.FUT.SOE$ THEN STAT.OK = NO
                END

                BEGIN CASE
                CASE THIS.OID[1,1]='S' AND STAT.OK
                   IF SBR # BR AND BR # WHSE THEN
                      SHP.DT = PLENTY.DATE
                   END ELSE
                      SHP.DT = DATE()
                   END
                CASE THIS.OID[1,1]='S' AND NOT(STAT.OK) AND ORD.STAT#'D'
                   SHP.DT = SHP.DT
                   IF SBR # BR AND BR # WHSE THEN
                      IF SHP.DT < PLENTY.DATE THEN SHP.DT = PLENTY.DATE
                   END
                CASE QTY < 0 AND SBR # BR AND BR # WHSE
                   IF SHP.DT < PLENTY.DATE THEN SHP.DT = PLENTY.DATE
                END CASE

                IF SHP.DT >= PLENTY.DATE THEN
                   PY.IDS<-1>  = ID
                   PY.QTYS<-1> = QTY
                   PY.BRS<-1>  = SBR
                END ELSE
                   IDS<-1>  = ID
                   QTYS<-1> = QTY
                   SBRS<-1> = SBR
                END
             END
          REPEAT

          * Add in the later ids. (Past the plenty date)
          IF PY.IDS # '' THEN
             IDS<-1>  = PY.IDS
             QTYS<-1> = PY.QTYS
             SBRS<-1> = PY.BRS
          END

          RETURN
*-------------------------------------------------------------------------*
FINISH:   ***  If not Phantom or printing, close the window.

          IF OPEN.WINDOW THEN
             WINDOW.CLOSE
          END

          RETURN
*-------------------------------------------------------------------------*
!BABS~12/28/09~12:08
