          SUBROUTINE (OID,GEN,XDATA,ERR.MSG)
** Version# 49.0002[5] - 02/03/2011 - 09:51pm - SMITJR - eclipse
*** V49.0002 Change - Custom Coding .. - 02/03/2011 - SMITJR - eclipse
** Copied from CBP 850.004.010.O Version# 49.0001 - 03/15/2010 - 06:39pm - SMITJR - eclipse
*** V49.0001 Change - Custom Coding CUSTOM - 03/15/2010 - SMITJR - eclipse

*** Subroutine:  850.004.010.O
*-------------------------------------------------------------------------*
*** This subroutine will generate an ANSI X12 850 (Purchase Order)
*** document in version 4010 to be sent to vendors.
*-------------------------------------------------------------------------*
*** OID - Order ID that the document is to be created with         (IN)
*** GEN - Generation ID that the document is to be created with    (IN)
*** XDATA - ANSI X12 document created from the order               (OUT)
*** ERR.MSG - Message of errors encountered in this subroutine     (OUT)
*-------------------------------------------------------------------------*

          GOSUB INIT.VARS
          IF ERR.MSG THEN RETURN

          GOSUB ADD.HEADER
          GOSUB ADD.DETAIL
          GOSUB ADD.SUMMARY

          RETURN
*-------------------------------------------------------------------------*
INIT.VARS: *** Initial reads and initializing variables

          BT.BR = LED(2)<1,GEN,1>
          ST.BR = LED(2)<1,GEN,2>

          * If no EDI ID is found, branch is not authorized for EDI
          * This ID might be overridden later when we read TP profile
          READV BT.BR.ID FROM CTRBFILE,'EDI.BR.IDS~':BT.BR,1 ELSE BT.BR.ID = ''
          READV ST.BR.ID FROM CTRBFILE,'EDI.BR.IDS~':ST.BR,1 ELSE ST.BR.ID = ''

          IF BT.BR.ID = '' THEN
             ERR.MSG = 'Br EDI ID not defined'
             RETURN
          END

          READV BT.ENT FROM TERRFILE,BT.BR,4 ELSE BT.ENT = ''
          READ BT.BR.REC FROM CUSFILE,BT.ENT ELSE BT.BR.REC = ''
          READV ST.ENT FROM TERRFILE,ST.BR,4 ELSE ST.ENT = ''
          READ ST.BR.REC FROM CUSFILE,ST.ENT ELSE ST.BR.REC = ''
          IF LED(6)<1,GEN> = 'D' THEN
             LOCATE LED(33)<1,GEN> IN LED(12)<1> SETTING YGEN ELSE YGEN=1
             READV ST.NAME FROM CUSFILE,LED(5)<1,GEN>,1 ELSE ST.NAME=''
             ST.ADDR1   = LED(78)<1,GEN,1>
             ST.ADDR2   = LED(78)<1,GEN,2>
             CITY.STATE = LED(78)<1,GEN,3>
             CITY.STATE = CONVERT(',',' ',CITY.STATE)
             CITY.STATE = TRIM(CITY.STATE)
             FLD.CNT    = DCOUNT(CITY.STATE,' ')
             ST.CITY    = FIELD(CITY.STATE,' ',1,FLD.CNT - 1)
             ST.ST      = FIELD(CITY.STATE,' ',FLD.CNT)
             ST.ZIP     = TRIM(CONVERT("-","",LED(75)<1,GEN>))
             BT.CN      = LED(1)<1,YGEN>
             ST.CN      = LED(5)<1,YGEN>
          END ELSE
             ST.NAME    = ST.BR.REC<1>
             ST.ADDR1   = ST.BR.REC<2,1>
             ST.ADDR2   = ST.BR.REC<2,2>
             ST.CITY    = ST.BR.REC<3>
             ST.ST      = TRIM(ST.BR.REC<4>)
             ST.ZIP     = CONVERT("-","",ST.BR.REC<5>)
             BT.CN      = LED(1)<1,GEN>
             ST.CN      = LED(5)<1,GEN>
          END

          OE.GET.QSIGN QSIGN,OID,GEN
          PO1.FLG  = ''
          XDATA    = ''
          SEG      = ''

          READV EDI.ID FROM CUSFILE,ST.CN,15 ELSE EDI.ID = ''
          IF NOT(EDI.ID) THEN
             READV EDI.ID FROM CUSFILE,BT.CN,15 ELSE EDI.ID = ''
          END
          EDI.ALT.FILE.CREATE ISA1,ISA2,EDI.ID,'850~O'
          LOCATE '850~O' IN ISA2<22> SETTING POS THEN
             NO.BP       = ISA2<26,POS,21>
             USE.QTY.UOM = ISA2<26,POS,23>
          END ELSE
             NO.BP       = ''
             USE.QTY.UOM = ''
          END

          USE.DUNS = ISA2<39,2>
          IF USE.DUNS THEN
             * Use the D&B number from the branch customer records
             IF BT.BR.REC<88> # '' THEN
                BT.BR.ID =  '1~':BT.BR.REC<88>
             END
             IF ST.BR.REC<88> # '' THEN
                ST.BR.ID =  '1~':ST.BR.REC<88>
             END
          END

          EDI.GET.N1.INFO BT.BR.ID,BT.QUAL,BT.ID
          EDI.GET.N1.INFO ST.BR.ID,ST.QUAL,ST.ID,ST.BR

          RETURN
*-------------------------------------------------------------------------*
ADD.HEADER: *** Adds all header level segments to the document.

*** BEG - Beginning Segment for Purchase Order
          IDATE  = EDI.Y2K.CONV2(DATE())
          SEG.ID = 'BEG'
          SEG<1> = '00'
          IF LED(6)<1,GEN> = 'D' THEN
             SEG<2> = 'DS'
          END ELSE
             SEG<2> = 'NE'
          END
          SEG<3> = OID
          SEG<4> = LED(65)<1,GEN>
          SEG<5> = IDATE
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** REF Segment - Customer PO number for Direct Orders
          IF LED(6)<1,GEN> = 'D' THEN               ;* Direct Order
             IF LED(13)<1,GEN> # '' THEN
                SEG.ID = 'REF'
                SEG<1> = 'CO'
                SEG<2> = LED(13)<1,GEN>             ;* Customer PO Number
                EDI.ADD.SEG SEG.ID,SEG,XDATA
             END
          END

*** REF Segment
          IF LED(6)<1,GEN> = 'D' THEN               ;* Direct Order
             MSG.GEN = YGEN
          END ELSE                                  ;* Non-Direct Order
             MSG.GEN = GEN
          END

          VEN.INST = ''
          VEN.INST = LED(74)<1,MSG.GEN>
          VEN.INST = CONVERT(SVM,' ',VEN.INST)
          VEN.INST = CONVERT(VM,' ',VEN.INST)
          VEN.INST = TRIM(VEN.INST)
          IF VEN.INST # '' THEN
             CNTR = INDEX(VEN.INST,'*CT',1)   ;* Look for Contract #
             IF CNTR THEN
                SEG.ID = 'REF'
                SEG<1> = 'CT'
                CNTR.INFO = TRIM(FIELD(VEN.INST[CNTR,LEN(VEN.INST)],' ',1))
                SEG<2> = CNTR.INFO[4,LEN(CNTR.INFO)]
                EDI.ADD.SEG SEG.ID,SEG,XDATA
                VEN.INST[CNTR,99999] = VEN.INST[CNTR+LEN(CNTR.INFO),99999]
             END
             QTE = INDEX(VEN.INST,'*PR',1)    ;* Look for Price Quote #
             IF QTE THEN
                SEG.ID = 'REF'
                SEG<1> = 'PR'
                QTE.INFO = TRIM(FIELD(VEN.INST[QTE,LEN(VEN.INST)],' ',1))
                SEG<2> = QTE.INFO[4,LEN(QTE.INFO)]
                EDI.ADD.SEG SEG.ID,SEG,XDATA
                VEN.INST[QTE,99999] = VEN.INST[QTE+LEN(QTE.INFO),99999]
             END
             QNO = INDEX(VEN.INST,'*Q1',1)    ;* Look for Quote #
             IF QNO THEN
                SEG.ID = 'REF'
                SEG<1> = 'Q1'
                QNO.INFO = TRIM(FIELD(VEN.INST[QNO,LEN(VEN.INST)],' ',1))
                SEG<2> = QNO.INFO[4,LEN(QNO.INFO)]
                EDI.ADD.SEG SEG.ID,SEG,XDATA
                VEN.INST[QNO,99999] = VEN.INST[QNO+LEN(QNO.INFO),99999]
             END
          END

*** PER Segment
          SEG.ID = 'PER'
          SEG<1> = 'BD'
          IF LED(6)<1,GEN> = 'D' THEN
             PER.GEN = YGEN
          END ELSE
             PER.GEN = GEN
          END
          SEG<2> = OCONV(LED(73)<1,PER.GEN>,'TINITIALS;X;3;3')
          IF BT.BR.REC<17,1> # '' THEN
             SEG<3> = 'TE'
             SEG<4> = BT.BR.REC<17,1>
          END
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** FOB Segment
          IF LED(69)<1,GEN,1> THEN
             SEG.ID = 'FOB'
             SEG<1> = 'PP'
             EDI.ADD.SEG SEG.ID,SEG,XDATA
          END
*** TD5 Segment
          SHP.VIA = ''
          IF LED(6)<1,GEN> = 'D' THEN
             SHP.VIA = LED(70)<1,YGEN>
          END ELSE
             SHP.VIA = LED(70)<1,GEN>
          END

          IF SHP.VIA THEN
             EDI.GET.SHP.VIA BT.CN,ST.CN,SHP.VIA,T.SHP.VIA,ROUTE.CODE
             IF ROUTE.CODE = '' THEN ROUTE.CODE = 'M'
             IF T.SHP.VIA  = '' THEN T.SHP.VIA  = SHP.VIA

             SEG.ID = 'TD5'
             SEG<4> = ROUTE.CODE
             SEG<5> = T.SHP.VIA
             EDI.ADD.SEG SEG.ID,SEG,XDATA
          END

*** MAN Segment
          SEG.ID = 'MAN'
          SEG<1> = 'PB'
          SEG<2> = OID
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** N9 Segment
          IF TRIM(VEN.INST) # '' THEN
             SEG.ID = 'N9'
             SEG<1> = 'L1'
             SEG<2> = 'TEXT'
             EDI.ADD.SEG SEG.ID,SEG,XDATA

*** MSG Segment
             FOLD.STRING VEN.INST,224,WRK,INST.CNT
             FOR INST.CTR = 1 TO INST.CNT
                SEG.ID = 'MSG'
                SEG<1> = WRK<1,INST.CTR>
                CONVERT VM  TO ' ' IN SEG<1>
                CONVERT SVM TO ' ' IN SEG<1>
                EDI.ADD.SEG SEG.ID,SEG,XDATA
             NEXT INST.CTR
          END

*** N1 BY Segment
          SEG.ID = 'N1'
          SEG<1> = 'BY'
          SEG<2> = BT.BR.REC<1>
          SEG<3> = BT.QUAL
          SEG<4> = BT.ID
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** N1 BT Segment
          SEG.ID = 'N1'
          SEG<1> = 'BT'
          SEG<2> = BT.BR.REC<1>
          SEG<3> = BT.QUAL
          SEG<4> = BT.ID
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** N1 ST Segment
          SEG.ID = 'N1'
          SEG<1> = 'ST'
          SEG<2> = ST.NAME
          IF LED(6)<1,GEN> # 'D' THEN
             SEG<3> = ST.QUAL
             SEG<4> = ST.ID
          END
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** N3 Segment
          SEG.ID = 'N3'
          SEG<1> = ST.ADDR1
          IF ST.ADDR2 THEN
             SEG<2> = ST.ADDR2
          END
          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** N4 Segment
          SEG.ID = 'N4'
          SEG<1> = ST.CITY
          SEG<2> = TRIM(ST.ST)
          SEG<3> = ST.ZIP
          EDI.ADD.SEG SEG.ID,SEG,XDATA

          RETURN
*-------------------------------------------------------------------------*
ADD.DETAIL: *** Loop through line items and add detail segments
          LCT    = 0
          LD.CNT = DCOUNT(LED(49),VM)
          FOR LD.CTR = 1 TO LD.CNT
             LDID = LED(49)<1,LD.CTR>
             LD.GET LDID

             IF NUM(LD(1)) THEN
                GET.ALL.PRD ST.BR,LD(1),QSIGN
             END

             SHP.QTY  = (SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)) * QSIGN
             PN       = ''
             DESC     = ''
             CMT      = ''
             PN.XREF  = ''
             QTY      = ''
             QTY.UMA  = ''
             QTY.UMQ  = ''
             UM.PRC   = ''
             PRC.UMA  = ''
             BEGIN CASE
                CASE SHP.QTY
                   PN      = LD(1)
                   DESC    = PRD(1)
                   CMT     = LD(3)
                   CONVERT VM TO ' ' IN CMT
                   CONVERT SVM TO ' ' IN CMT
                   QTY.UMA = LD(23)
                   IQ.TO.ALPHA PLNE(3),PRD(7),QTY.UMA,SHP.QTY,QTY,U1,Q2,U2
                   QTY.UMA = U1
                   IF Q2 THEN
                      QTY.UMA = U2
                      IQ.TO.ALPHA PLNE(3),PRD(7),QTY.UMA,SHP.QTY,QTY,U1,Q2,U2
                      QTY.UMA = U1
                      IF Q2 THEN
                         QTY     = SHP.QTY
                         QTY.UMA = 'ea'
                         QTY.UMQ = 1
                      END
                   END

                   QTY.UOM = EDI.QTY.UOM.CONV(QTY.UMA)

                   IF QTY.UOM = '' THEN
                      QTY     = SHP.QTY
                      QTY.UMA = 'ea'
                      QTY.UMQ = 1
                      QTY.UOM = 'EA'
                   END

                   LOCATE QTY.UMA IN PLNE(3)<1> SETTING POS THEN
                      QTY.UMQ = PRD(7)<1,POS>
                   END

                   * Determine which Unit unit of measure info to use.
                   USE.UMQ = ''
                   IF USE.QTY.UOM THEN
                      PRC.UOM = EDI.PRC.UOM.CONV(QTY.UMA)
                      USE.UMQ = QTY.UMQ
                   END ELSE
                      PRICE.PER.GET USE.UMQ,PRC.UMA
                      PRC.UOM = EDI.PRC.UOM.CONV(PRC.UMA)
                   END

                   * Determine the cost and price
                   USE.GEN = GEN
                   IF LED(6)<1,GEN> = 'D' THEN USE.GEN = YGEN
                   UM.CST  = OCONV(LD(10)<1,USE.GEN>*USE.UMQ,'MR9')
                   UM.PRC  = OCONV(LD(8)<1,USE.GEN>*USE.UMQ,'MR9')
                   UM.CST  = OCONV(ICONV(UM.CST,'MR2'),'MR2')
                   UM.PRC  = OCONV(ICONV(UM.PRC,'MR2'),'MR2')

                   OE.CUS.PN.CMT.GET BT.CN,ST.CN,CUSS(66),PN,XREF

                   PN.XREF = XREF<1>
                   UPC.NO  = PRD(63)<1,3>
                   ITEM.NO = PRD(63)<1,2>
                   CAT.NO  = PRD(24)<1,1>
                   GOSUB ADD.ONE
                   IF CMT THEN GOSUB ADD.CMT
                CASE LD(1) = 'C'
                   PN      = 'C'
                   QTY     = '0'
                   QTY.UMA = 'EA'
                   CMT     = LD(3)
                   CONVERT VM TO ' ' IN CMT
                   CONVERT SVM TO ' ' IN CMT
                   IF CMT THEN GOSUB ADD.CMT
             END CASE
          NEXT LD.CTR

          RETURN
*-------------------------------------------------------------------------*
ADD.ONE:  LCT += 1
          PO1.FLG = 1

*** PO1 Segment
          SEG.ID = 'PO1'
          SEG<1> = LDID "R%6"
          SEG<2> = QTY
          SEG<3> = QTY.UOM

          IF LED(6)<1,GEN> = 'D' THEN         ;* Direct PO
             SEG<4> = UM.CST
          END ELSE                            ;* Regular PO
             SEG<4> = UM.PRC
          END

          SEG<5> = PRC.UOM
          IF PN.XREF THEN
             SEG<6> = 'VC'
             SEG<7> = PN.XREF
          END
          IF UPC.NO THEN
             BEGIN CASE
                CASE LEN(UPC.NO) = 11;  SEG<8> = 'UI'
                CASE LEN(UPC.NO) = 12;  SEG<8> = 'UP'
                CASE LEN(UPC.NO) = 14;  SEG<8> = 'UK'
                CASE OTHERWISE;         SEG<8> = 'UP'
             END CASE
             SEG<9> = UPC.NO
          END
         * IF NOT(NO.BP) THEN
         *    SEG<10> = 'BP'
         *    SEG<11> = PN
         * END
         * IF ITEM.NO THEN
         *   SEG<12> = 'IN'
         *    SEG<13> = ITEM.NO
         * END

          IF CAT.NO THEN
             SEG<14> = 'VP'
             SEG<15> = CAT.NO
          END

          EDI.ADD.SEG SEG.ID,SEG,XDATA

*** PID Segment
          SEG.ID = 'PID'
          CONVERT VM TO ' ' IN DESC
          DESC     =TRIM(DESC)
          DESC.LEN = LEN(DESC)
          FOLD.STRING DESC,80,WRK,DESC.CNT
          FOR DESC.CTR = 1 TO DESC.CNT
             SEG<1> = 'F'
             SEG<5> = WRK<1,DESC.CTR>
             EDI.ADD.SEG SEG.ID,SEG,XDATA
          NEXT DESC.CTR

          RETURN
*-------------------------------------------------------------------------*
ADD.CMT: *** Add line item level comments

*** REF Segment
          IF PO1.FLG = 1 THEN        ;* Make sure PO1 segment exists
             CNTR = INDEX(CMT,'*CT',1)   ;* Look for Contract #
             IF CNTR THEN
                SEG.ID = 'REF'
                SEG<1> = 'CT'
                CNTR.INFO = TRIM(FIELD(CMT[CNTR,LEN(CMT)],' ',1))
                SEG<2> = CNTR.INFO[4,LEN(CNTR.INFO)]
                EDI.ADD.SEG SEG.ID,SEG,XDATA
                CMT[CNTR,99999] = CMT[CNTR+LEN(CNTR.INFO),99999]
             END

             QTE = INDEX(CMT,'*PR',1)    ;* Look for Price Quote #
             IF QTE THEN
                SEG.ID = 'REF'
                SEG<1> = 'PR'
                QTE.INFO = TRIM(FIELD(CMT[QTE,LEN(CMT)],' ',1))
                SEG<2> = QTE.INFO[4,LEN(QTE.INFO)]
                EDI.ADD.SEG SEG.ID,SEG,XDATA
                CMT[QTE,99999] = CMT[QTE+LEN(QTE.INFO),99999]
             END

             QNO = INDEX(CMT,'*Q1',1)    ;* Look for Quote #
             IF QNO THEN
                SEG.ID = 'REF'
                SEG<1> = 'Q1'
                QNO.INFO = TRIM(FIELD(CMT[QNO,LEN(CMT)],' ',1))
                SEG<2> = QNO.INFO[4,LEN(QNO.INFO)]
                EDI.ADD.SEG SEG.ID,SEG,XDATA
                CMT[QNO,99999] = CMT[QNO+LEN(QNO.INFO),99999]
             END

*** MSG Segment
             IF TRIM(CMT) # '' THEN
                SEG.ID  = 'MSG'
                FOLD.STRING CMT,224,WRK,CMT.CNT
                FOR CMT.CTR = 1 TO CMT.CNT
                   SEG<1> = WRK<1,CMT.CTR>
                   CONVERT VM  TO ' ' IN SEG<1>
                   CONVERT SVM TO ' ' IN SEG<1>
                   EDI.ADD.SEG SEG.ID,SEG,XDATA
                NEXT CMT.CTR
             END
          END

          RETURN
*-------------------------------------------------------------------------*
ADD.SUMMARY:  *** Adds all summary level segments to the document.
          SEG.ID = 'CTT'
          SEG<1> = LCT
          EDI.ADD.SEG SEG.ID,SEG,XDATA

          RETURN
!SMITJR~02/03/11~21:51
