          SUBROUTINE (TP.ID,GEN,YDATA,ERR.MSG)
** Version# 3 - 03/23/2006 - 11:14am - ANNEM - develop

*** Subroutine:  852.004.010.O
*-------------------------------------------------------------------------*
*** This subroutine will generate an ANSI X12 852 (Product Activity Report)
*** document in version 4010 to be sent to vendors.
*-------------------------------------------------------------------------*
*** TP.ID - Account # of the Vendor the 852 is to be created for   (IN)
*** GEN - Generation ID that the document is to be created with    (IN)
*** YDATA - Accumulated data to be put into the document and ANSI
***         X12 formatted document to be sent to vendor.           (IN/OUT)
*** ERR.MSG - Message of errors encountered in this subroutine     (OUT)
*-------------------------------------------------------------------------*
*** Common Variables
*-------------------------------------------------------------------------*
          GOSUB INIT.VARS
          IF ERR.MSG THEN RETURN

          GOSUB RPT.SETUP
          GOSUB ADD.HEADER
          GOSUB ADD.DETAIL
          GOSUB ADD.SUMMARY

          YDATA = XDATA

          PRINTER.OFF DOC.ID
          SEND.MESSAGE 'Phantom',USER.ID,TITLE:' is Complete'

          RETURN
*-------------------------------------------------------------------------*
INIT.VARS: *** Initialize variables
          ERR.MSG     = ''
          DOC.INFO    = '852~O'
          CTRL.852.ID = YDATA<5,1>

          UT.OPEN.FILE 'EDI.XMIT.ARCH',EXAFILE,ERR.MSG,YES
          IF ERR.MSG THEN
             EDI.NOTIFY.ADMIN 'Error Opening EDI.XMIT.ARCH for 852 build.'
             ERR.MSG = 'Error Opening EDI.XMIT.ARCH for 852 build.'
             RETURN
          END

          READ CTRL.PARMS FROM CTRLFILE,'EDI.852.CTRL' ELSE CTRL.PARMS = ''

          LOCATE CTRL.852.ID IN CTRL.PARMS<1> SETTING CTRL.POS THEN
             TYPE.852 = CTRL.PARMS<2,CTRL.POS>
             INCL.TAG = CTRL.PARMS<3,CTRL.POS>
             INCL.DIR = CTRL.PARMS<4,CTRL.POS>
          END ELSE
             ERR.MSG  = 'Unable to read control parameters for: '
             ERR.MSG :=  CTRL.852.ID
          END

          BR = YDATA<2,1>

          READV BR.ID FROM CTRBFILE,'EDI.BR.IDS~':BR,1 ELSE BR.ID = ''
          IF BR.ID = '' THEN
             ERR.MSG = 'Br EDI ID not defined for branch #: ':BR:'.'
             RETURN
          END

          READV BR.ENT FROM TERRFILE,BR,4  ELSE BR.ENT = ''
          READ  BR.REC FROM CUSFILE,BR.ENT ELSE BR.REC = ''
          BR.NAME = BR.REC<1>

          READV GS.ID FROM CUSFILE,TP.ID,15 ELSE
             ERR.MSG = 'Unable to locate trading partner ID'
             RETURN
          END

          *** Read Trading Partner Information
          EDI.ALT.FILE.CREATE ISA1,ISA2,GS.ID,DOC.INFO,IS.ALT

          BEGIN CASE
          CASE ISA2<3>;     TPNAME = ISA2<3>
          CASE ISA1<3>;     TPNAME = ISA1<3>
          CASE OTHERWISE;   TPNAME = '** TP Not Found **'
          END CASE

          LOCATE DOC.INFO IN ISA2<22> SETTING POS THEN
             ADDL.DATA = ISA2<26,POS>      ;* Get Additional Data
             MSG.UID   = ADDL.DATA<1,1,3>  ;* User To be Messaged
             HOLD.UID  = MSG.UID           ;* User Id for Hold file
          END ELSE
             ERR.MSG   = 'Unable to locate 852 Outbound document for '
             ERR.MSG  := TPNAME
          END

          HANDLE      = YDATA<6,1>
          RUN.DT      = YDATA<3,1>
          PREV.RUN.DT = YDATA<3,2>
          RDATE       = EDI.Y2K.CONV2(RUN.DT)

          XDATA = ''
          SEG   = ''

          RETURN
*-------------------------------------------------------------------------*
RPT.SETUP: *** All necessary setup for generating a report

          READV MSG.GRP.LST FROM INIFILE,HOLD.UID,30 ELSE MSG.GRP.LST = ''

          DRPT      = ''
          DRPT<4>   = HOLD.UID
          DRPT<27>  = 'HOLD'

          IF MSG.GRP.LST THEN DRPT<36> = MSG.GRP.LST

          HDG  = 'EDI 852 Product Activity Report - ':TPNAME:' for '
          HDG := OCONV(PREV.RUN.DT+1,'D4/'):' to ':OCONV(RUN.DT,'D4/')

          TITLE = HDG<1,1>

          HDG<1,3> = 'Branch:          ':BR.NAME
          HDG<1,4> = 'Report Handling: ':HANDLE
          HDG<1,5> = 'Include Directs: ':YN[INCL.DIR+1,1]
          HDG<1,6> = 'Include Tags:    ':YN[INCL.TAG+1,1]
          HDG<1,7> = 'Sales/Recd Qtys: '

          IF TYPE.852 = 'C' THEN
             HDG<1,7> := 'Current (since last 852)'
          END ELSE
             HDG<1,7> := 'YTD'
          END

          HDG<1,9>   = ' ' "L#44"
          HDG<1,10>  = 'Line..  Product....................... '
          HDG<1,10> := 'Stat '

          FOR ID = 3 TO 18
             IF CTRL.PARMS<ID+2,CTRL.POS> AND ID # 10 THEN
                GOSUB GET.ZA.QUAL
                HDG<1,9>  := ' ZA*':ZA.QUAL:'  '
                HDG<1,10> := ZA.DESC
                IF ID = 7 THEN
                   HDG<1,9>  := 'QTY*OC  '
                   HDG<1,10> := '.FREQ.. '
                END
             END
          NEXT ID

          *** Set the width of our report...
          WDTH        = LEN(HDG<1,10>)
          HDG1.LENGTH = LEN(HDG<1,1>)

          *** Tack on the Page Number to the first line of our Heading...
          HDG<1,1>   := SPACE(WDTH - HDG1.LENGTH - 12):'Page :^#####'

          *** Turn our Printer on and print our report...
          PRINTER.ON WDTH,TITLE,DOC.ID,HDG,RPT.DFLT=DRPT

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

          *** XQ Segment
          SEG.ID = 'XQ'

          BEGIN CASE
          CASE HANDLE[1,1] = 'P'
             SEG<1> = 'G'                  ;* Plan and Ship Orders
          CASE OTHERWISE
             SEG<1> = 'H'                  ;* Notification Only
          END CASE

          SEG<2> = RDATE
          EDI.ADD.SEG SEG.ID,SEG,XDATA

          *** N1 DB Segment
          SEG.ID = 'N1'
          SEG<1> = 'RL'
          SEG<2> = BR.NAME
          SEG<3> = '9'
          SEG<4> = FIELD(BR.ID,'~',2):BR "R%4"
          EDI.ADD.SEG SEG.ID,SEG,XDATA

          RETURN
*-------------------------------------------------------------------------*
ADD.DETAIL: *** Loop through line items and add detail segments
          LCT      = 0
          HASH.TOT = 0
          PN.CNT   = 0
          STAT.MSG = ''

          RCNT = DCOUNT(YDATA,AM)
          FOR LPCTR  = 7 TO RCNT
             BEGIN CASE
             CASE PN.CNT = 0
                STAT.MSG  = 'Building 852 - BR: ':BR:'... '
                STAT.MSG := LPCTR - 6 "R#5":' of ':RCNT - 6 "R#5"
                PH.STATUS STAT.MSG
             CASE PN.CNT = 20
                PN.CNT = 0
             END CASE
             PN.CNT += 1

             PN = YDATA<LPCTR,1>

             GET.ALL.PRD BR,PN,-1
             BASN    = PLNE(10)<1,2>
             LD(1)   = PN
             LD(38)  = PRD(86)
             LD(30)  = PRD(52)
             LD(31)  = PRD(53)
             LD(39)  = PRD(87)

             GET.BASE PN,BR,BASN,DATE(),BASE,PER,PRD(86),PRD(52),PRD(53),PRD(87)
             OE.CUS.PN.CMT.GET TP.ID,TP.ID,CUSS(66),PN,XREF
             PN.XREF = XREF<1>

             GOSUB ADD.ONE
          NEXT LPCTR

          RETURN
*-------------------------------------------------------------------------*
ADD.ONE: *** Loop through Control file printing Order Count
         *** Order Quantity, and Reorder Point.

          LCT += 1
          NEW.ITEM = YDATA<LPCTR,2>        ;* NEW.ITEM FLAG
          OQ       = YDATA<LPCTR,8>        ;* Order Quantity
          PO       = YDATA<LPCTR,9>        ;* Order Point
          STAT     = YDATA<LPCTR,10>       ;* Stock or Non-Stock flag
          OC       = YDATA<LPCTR,19>       ;* Number of Sales/Order Count
          UPC.NO   = YDATA<LPCTR,20,1>     ;* UPC #
          ITEM.NO  = YDATA<LPCTR,20,2>     ;* Item # (User Defined #1)
          CAT.NO   = YDATA<LPCTR,20,3>     ;* Vendor Catalog #
          EOQ      = YDATA<LPCTR,21>       ;* EOQ

          GOSUB LINE.ID
          FOR ID = 3 TO 18
             IF CTRL.PARMS<ID+2,CTRL.POS> THEN
                BEGIN CASE
                CASE ID = 7
                   GOSUB ADD.ZA.SEG
                   PRINT OC "R#7":' ':
                CASE ID = 8                ;* OQ Included in QA
                   PRINT OQ "R#7":' ':
                CASE ID = 9                ;* PO Included in QA
                   PRINT PO "R#7":' ':
                CASE ID = 10               ;* Status is not sent
                CASE OTHERWISE
                   GOSUB ADD.ZA.SEG
                END CASE
             END
          NEXT ID
          PRINT

          RETURN
*-------------------------------------------------------------------------*
LINE.ID: *** Add LIN - Line Identification

          SEG.ID = 'LIN'
          SEG<1> = LCT
          PN.CHK = CTRL.PARMS<22,CTRL.POS>
          PN.CT  = 0
          UPC.VC = NO

          IF PN.CHK = 1 OR PN.CHK = 4 OR PN.CHK = 5 OR PN.CHK = 7 THEN
             PN.CT += 2
             IF UPC.NO THEN
                IF LEN(UPC.NO) = 11 THEN
                   SEG<PN.CT> = 'UI'
                END ELSE
                   SEG<PN.CT> = 'UP'
                END
                SEG<PN.CT+1> = UPC.NO
             END ELSE
                IF CAT.NO THEN
                   SEG<PN.CT>   = 'VC'
                   SEG<PN.CT+1> = CAT.NO
                   UPC.VC       = YES
                END
             END
          END
          IF PN.CHK = 2 OR PN.CHK = 4 OR PN.CHK = 6 OR PN.CHK = 7 THEN
             PN.CT += 2
             IF ITEM.NO THEN
                SEG<PN.CT>   = 'IN'
                SEG<PN.CT+1> = ITEM.NO
             END
          END
          IF PN.CHK = 3 OR PN.CHK = 5 OR PN.CHK = 6 OR PN.CHK = 7 THEN
             PN.CT += 2
             IF NOT(UPC.VC) AND CAT.NO THEN
                SEG<PN.CT>   = 'VC'
                SEG<PN.CT+1> = CAT.NO
             END
          END
          EDI.ADD.SEG SEG.ID,SEG,XDATA

          PRD.IDS = UPC.NO:' ':ITEM.NO:' ':CAT.NO
          PRINT LCT "R#6":'  ':PRD.IDS "L#30":'   ':STAT:'  ':

          RETURN
*-------------------------------------------------------------------------*
ADD.ZA.SEG: *** Creates appropriate ZA segment

          GOSUB GET.ZA.QUAL

          SEG.ID = 'ZA'
          SEG<1> = ZA.QUAL

          ZA.QTY = YDATA<LPCTR,ID>+0

          *** For ZA.OQ, qty should be LP - OP
          IF ID = 8 THEN
             ZA.QTY -= YDATA<LPCTR,9>
          END

          SEG<2>    = ZA.QTY
          HASH.TOT += ZA.QTY
          SEG<3>    = 'EA'

          IF SEG<1> = 'QA' THEN
             IF NEW.ITEM = NO THEN
                SEG<4> = '171'
             END ELSE
                SEG<4> = '164'
             END
             SEG<5> = RDATE
             SEG<6> = 'ZZ'
             SEG<7> = '  ':PO "R%7":OQ "R%7"
             BEGIN CASE
                CASE STAT = 'A';  SEG<7> := 'P'
                CASE STAT = 'D';  SEG<7> := 'N'
                CASE STAT = 'I';  SEG<7> := 'D'
                CASE OTHERWISE;   SEG<7> := STAT
             END CASE
          END

          IF SEG<1> = 'QS' THEN
             SEG<6> = 'ZZ'
             SEG<7> = OC
          END

          EDI.ADD.SEG SEG.ID,SEG,XDATA
          PRINT ZA.QTY "R#7":' ':

          RETURN
*-------------------------------------------------------------------------*
GET.ZA.QUAL: *** Set ZA qualifier based on ID

          BEGIN CASE
          CASE ID = 3;      ZA.QUAL = 'QA';   ZA.DESC = '.AVAIL. '
          CASE ID = 4;      ZA.QUAL = 'QC';   ZA.DESC = '.CMTD.. '
          CASE ID = 5;      ZA.QUAL = 'QP';   ZA.DESC = '.ON PO. '
          CASE ID = 6;      ZA.QUAL = 'QR';   ZA.DESC = '.RECVD. '
          CASE ID = 7;      ZA.QUAL = 'QS';   ZA.DESC = '.SOLD.. '
          CASE ID = 8;      ZA.QUAL = 'QA';   ZA.DESC = 'ORD QTY '
          CASE ID = 9;      ZA.QUAL = 'QA';   ZA.DESC = '.LN PT. '
          CASE ID = 11;     ZA.QUAL = 'QL';   ZA.DESC = '..MIN.. '
          CASE ID = 12;     ZA.QUAL = 'QM';   ZA.DESC = '..MAX.. '
          CASE ID = 13;     ZA.QUAL = 'QD';   ZA.DESC = '.RSRVD. '
          CASE ID = 14;     ZA.QUAL = 'QO';   ZA.DESC = '.BKORD. '
          CASE ID = 15;     ZA.QUAL = 'QT';   ZA.DESC = '.ADJMT. '
          CASE ID = 16;     ZA.QUAL = 'DG';   ZA.DESC = '.DAMGD. '
          CASE ID = 17;     ZA.QUAL = 'QZ';   ZA.DESC = '.XFERD. '
          CASE ID = 18;     ZA.QUAL = 'QI';   ZA.DESC = '.TRANST '
          CASE OTHERWISE;   ZA.QUAL = '';     ZA.DESC = ' ' "L#8"
          END CASE

          RETURN
*-------------------------------------------------------------------------*
ADD.SUMMARY: *** Adds all summary level segments to the document.

          SEG.ID = 'CTT'
          SEG<1> = LCT
          SEG<2> = HASH.TOT
          EDI.ADD.SEG SEG.ID,SEG,XDATA

          RETURN
*-------------------------------------------------------------------------*
!ANNEM~03/23/06~11:14
