SUBROUTINE CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG)
*--------------------------------------------------------------------
*PGM NAME:      CMSD.PICKING.BUILD.WORKFILE
*PURPOSE:       GENERIC OUTPUT SUBROUTINE FOR REL8 PICKING SLIPS & LABELS.
*AUTHOR:        AL SURLES
*CREATED:       06-14-94
*UPDATES:
*
* ABS  07-24-95 : Modified pgm to multivalued PML$SHIP.MODE .           
*                 value1=DESCRIPTION ; value2=CODE
*
*--------------------------------------------------------------------
$INCLUDE GEN.COMMON
$INCLUDE PM
$INCLUDE CMSD.IVD
$INCLUDE INV
$INCLUDE PM.LABELS
*
100 *---define variables and build output arrays
PML.REC=''
PK.FLAG=0 ; SPECIAL.SHIP.FLAG=0
PML.REC<PML$PARTNER>=IREC<IVD$PARTNER,1>
TODAY=OCONV(DATE(),'D2/')
ORDER=IREC<IVD$PARTNER,2>
PML.REC<PML$BATCH.DT>=IREC<IVD$DATE.ORDERED>
PML.REC<PML$PO.NUMBER>=IREC<IVD$INFORMATION,1>
PML.REC<PML$PRINT.DT>=ICONV(TODAY,"D") ; RUN.NUMBER=OCONV(CURRENT.RUN,"G1*1")
PML.KEY=ORDER:"*":RUN.NUMBER
PML.REC<PML$EVENT>=IREC<IVD$EVENT>
*
XX=1
IF IREC<IVD$SOLD.TO.NAME>#'' THEN
  PML.REC<XX>=IREC<IVD$SOLD.TO.NAME>
  XX=XX+1
  IF IREC<IVD$SOLD.TO.ATTN1>#'' THEN
    PML.REC<XX>=IREC<IVD$SOLD.TO.ATTN1>
    XX=XX+1
  END
  IF IREC<IVD$SOLD.TO.ATTN2>#'' THEN
    PML.REC<XX>=IREC<IVD$SOLD.TO.ATTN2>
    XX=XX+1
  END
  IF IREC<IVD$SOLD.TO.STREET> # '' THEN
    PML.REC<XX>=IREC<IVD$SOLD.TO.STREET>
    XX=XX+1
  END
  IF IREC<IVD$SOLD.TO.ZIP>='00000' THEN IREC<IVD$SOLD.TO.ZIP>=''
  CITY=TRIM(IREC<IVD$SOLD.TO.CITY>)
  STATE=TRIM(IREC<IVD$SOLD.TO.STATE>)
  ZIP=TRIM(IREC<IVD$SOLD.TO.ZIP>)
  PML.REC<XX>=CITY:" ":STATE:"  ":ZIP
  PML.REC<PML$ZIP>=TRIM(IREC<IVD$SOLD.TO.ZIP>)
END ELSE
  READ PM.REC FROM PM,IREC<IVD$PARTNER,1> ELSE PM.REC=''
  XX=1
  PML.REC<XX>=TRIM(PM.REC<PM$FNAME>:" ":PM.REC<PM$LNAME>)
  XX=XX+1
  IF PM.REC<PM$ADDR3>#'' THEN
    IF PM.REC<PM$ADDR1>#'' THEN
      PML.REC<XX>=TRIM(PM.REC<PM$ADDR1>)
      XX=XX+1
    END
    IF PM.REC<PM$ADDR2>#'' THEN
      PML.REC<XX>=TRIM(PM.REC<PM$ADDR2>)
      XX=XX+1
    END
    IF PM.REC<PM$ADDR3>#'' THEN
      PML.REC<XX>=TRIM(PM.REC<PM$ADDR3>)
      XX=XX+1
    END
  END ELSE;  * IF THERE IS AN ADDRESS 3 - TWH added lines 82 - 95
   IF PM.REC<PM$ADDR2>#'' THEN
     PML.REC<XX>=TRIM(PM.REC<PM$ADDR2>)
     XX=XX+1
   END
   IF PM.REC<PM$ADDR1>#'' THEN
     PML.REC<XX>=TRIM(PM.REC<PM$ADDR1>)
     XX=XX+1
   END
   CITY=TRIM(PM.REC<PM$CITY>)
   STATE=TRIM(PM.REC<PM$STATE>)
   IF PM.REC<PM$ZIP>="00000" THEN PM.REC<PM$ZIP>=''
   ZIP=TRIM(PM.REC<PM$ZIP>)
   PML.REC<XX>=CITY:" ":STATE:" ":ZIP
   XX=XX+1
   PML.REC<PML$ZIP>=TRIM(PM.REC<PM$ZIP>)
 END
END
*
IF IREC<IVD$SHIP.TO.NAME>#'' THEN
  XX=34
  IF IREC<IVD$SHIP.TO.NAME>#'' THEN
    PML.REC<XX>=IREC<IVD$SHIP.TO.NAME>
    XX=XX+1
  END
  IF IREC<IVD$SHIP.TO.ATTN1> # '' THEN
    PML.REC<XX>=IREC<IVD$SHIP.TO.ATTN1>
    XX=XX+1
  END
  IF IREC<IVD$SHIP.TO.ATTN2> # '' THEN
    PML.REC<XX>=IREC<IVD$SHIP.TO.ATTN2>
    XX=XX+1
  END
  IF IREC<IVD$SHIP.TO.STREET> # '' THEN
    PML.REC<XX>=IREC<IVD$SHIP.TO.STREET>
    XX=XX+1
  END
  IF IREC<IVD$SHIP.TO.ZIP>='00000' THEN IREC<IVD$SHIP.TO.ZIP>=''
  CITY=TRIM(IREC<IVD$SHIP.TO.CITY>)
  STATE=TRIM(IREC<IVD$SHIP.TO.STATE>)
  ZIP=TRIM(IREC<IVD$SHIP.TO.ZIP>)
  PML.REC<XX>=CITY:" ":STATE:" ":ZIP
  XX=XX+1
  PML.REC<PML$ZIP>=ZIP
END
*
IF PML.REC<PML$ZIP> LT "00001" OR PML.REC<PML$ZIP> GT "99999" THEN
  SPECIAL.SHIP.FLAG=1
  PML.REC<PML$SORT.GROUP>="G0"
END
*
READ CODE FROM GEN.KEYS,"PAYMENT.TERMS" THEN
  LOCATE(IREC<IVD$TERMS>,CODE,1;WH) THEN
    PML.REC<PML$TERMS>=CODE<2,WH>
  END ELSE
    PML.REC<PML$TERMS>='UNKNOWN'
  END
END
*
READ CODE FROM GEN.KEYS,"SHIP.MODES" THEN
  LOCATE(IREC<IVD$SHIP.MODE>,CODE,1;WH) THEN
    PML.REC<PML$SHIP.MODE>=CODE<2,WH>:VM:IREC<IVD$SHIP.MODE>
    IF CODE<3,WH>="10" THEN
      SPECIAL.SHIP.FLAG=1
      PML.REC<PML$SORT.GROUP>="G0"
    END
  END ELSE
    PML.REC<PML$SHIP.MODE>='UNKNOWN'
  END
END
*
200 *
TOTAL.ORDER=0
NEW.TOTAL.ORDER=0
BALANCE=IREC<IVD$BALANCE>
NEW.TOTAL.ORDER=IREC<IVD$NET.ORDER.AMOUNT>-IREC<IVD$TOTAL.PAID>
LOCATE("FUND",MISC.ARRAY,1;WH) THEN
  OPEN 'FUND.FILE' TO FUND.FILE ELSE ABORT
END
*
MCT=DCOUNT(MISC.ARRAY,VM)
FOR M=1 TO MCT
  MAMOUNT=MISC.ARRAY<3,M>
  TOTAL.ORDER=TOTAL.ORDER+MAMOUNT
NEXT M
*
MCT=DCOUNT(BO.ARRAY,VM)
FOR M=1 TO MCT
  MAMOUNT=BO.ARRAY<3,M>
  TOTAL.ORDER=TOTAL.ORDER-MAMOUNT
NEXT M
*
ICT=DCOUNT(REL.ARRAY<1>,VM)
FOR I=1 TO ICT
  TOTAL.ORDER=TOTAL.ORDER+REL.ARRAY<3,I>-REL.ARRAY<4,I>+REL.ARRAY<5,I>
NEXT I
*------*
IF TOTAL.ORDER > BALANCE THEN TOTAL.ORDER = BALANCE
IF TOTAL.ORDER < 0 THEN TOTAL.ORDER=0
*PML.REC<PML$BALANCE>=TOTAL.ORDER
*------*
IF NEW.TOTAL.ORDER > BALANCE THEN NEW.TOTAL.ORDER = BALANCE
IF NEW.TOTAL.ORDER < 0 THEN NEW.TOTAL.ORDER=0
*PML.REC<PML$TEST.AMOUNT>=NEW.TOTAL.ORDER
IF IREC<IVD$TERMS>='CC' THEN
  IF NEW.TOTAL.ORDER > 0 THEN
    PML.REC<PML$BALANCE>=0
    PML.REC<PML$CC.BO.FLAG>='Y'
  END ELSE
    PML.REC<PML$BALANCE>=0
  END
END ELSE
  PML.REC<PML$BALANCE>=NEW.TOTAL.ORDER
END
*------*
*
SALES.TAX=0
TT=DCOUNT(REL.ARRAY<1>,VM)
FOR I=1 TO TT
  PML.REC<PML$REL.ITEM,I>=REL.ARRAY<1,I>
  PML.REC<PML$REL.QTY,I>=REL.ARRAY<2,I>
  READ INV.REC FROM INVENTORY,PML.REC<PML$REL.ITEM,I> ELSE INV.REC=''
  DESC=TRIM(INV.REC<INV$DESCRIPTION>)
  PK.ANS=TRIM(INV.REC<INV$ASSEMBLED>)
  PML.REC<PML$REL.DESC,I>=DESC
  PML.REC<PML$REL.AMOUNT,I>=REL.ARRAY<3,I>-REL.ARRAY<4,I>
  SALES.TAX=SALES.TAX+REL.ARRAY<5,I>
  IF PK.ANS="Y" THEN
    IF NOT(SPECIAL.SHIP.FLAG) THEN
      PML.REC<PML$SORT.GROUP>="G3"
      FOR CQ=1 TO TT
        IF REL.ARRAY<2,CQ> GT 1 THEN
          PML.REC<PML$SORT.GROUP>="G4"
          CQ=999
        END
      NEXT CQ
    END
    PK.FLAG=1 ; PK.ARRAY=''
    CI.CNT=DCOUNT(INV.REC<INV$COMPONENT.ITEMS>,VM)
    FOR CI=1 TO CI.CNT
      CI.KEY=INV.REC<INV$COMPONENT.ITEMS,CI>
      CI.QTY=INV.REC<INV$COMPONENT.QTY,CI>
      LOCATE(CI.KEY,PK.ARRAY,1;CI.FND;'AL') THEN NULL
      READV CI.DESC FROM INVENTORY,CI.KEY,INV$DESCRIPTION ELSE CI.DESC=''
      CI.DESC=TRIM(CI.DESC)
      PK.ARRAY=INSERT(PK.ARRAY,1,CI.FND;CI.KEY)
      PML.REC=INSERT(PML.REC,PML$PK.QTY,I,CI.FND;CI.QTY)
      PML.REC=INSERT(PML.REC,PML$PK.ITEM,I,CI.FND;CI.KEY)
      PML.REC=INSERT(PML.REC,PML$PK.DESC,I,CI.FND;CI.DESC)
    NEXT CI
  END
NEXT I
*
PML.REC<PML$SALES.TAX>=SALES.TAX
*
IF SPECIAL.SHIP.FLAG OR PK.FLAG THEN GO 250
*
BEGIN CASE
  CASE TT=1
    PML.REC<PML$SORT.GROUP>="G1"
    IF PML.REC<PML$REL.QTY> GT 1 THEN PML.REC<PML$SORT.GROUP>="G2"
  CASE 1
    PML.REC<PML$SORT.GROUP>="G3"
    FOR CQ=1 TO TT
      IF PML.REC<PML$REL.QTY,CQ> GT 1 THEN
        PML.REC<PML$SORT.GROUP>="G4"
        CQ=999
      END
    NEXT CQ
END CASE
*
250 *
*
PML.REC<PML$MISC1>=MISC.ARRAY<1>
PML.REC<PML$MISC2>=MISC.ARRAY<2>
PML.REC<PML$MISC3>=MISC.ARRAY<3>
PML.REC<PML$MISC4>=MISC.ARRAY<4>
PML.REC<PML$MISC5>=MISC.ARRAY<5>
*
BCT=DCOUNT(BO.ARRAY,VM)
FOR B=1 TO BCT
  IF BO.ARRAY<1,B>='' AND BO.ARRAY<2,B>='' ELSE
    PML.REC<PML$BO.ITEM,B>=BO.ARRAY<1,B>
    PML.REC<PML$BO.QTY,B>=BO.ARRAY<2,B>
    READV DESC FROM INVENTORY,PML.REC<PML$BO.ITEM,B>,INV$DESCRIPTION ELSE DESC=''
    PML.REC<PML$BO.DESC,B>=TRIM(DESC)
    IF IREC<IVD$TERMS>='CC' THEN PML.REC<PML$CC.BO.FLAG>='Y' ;* MTC 0595
  END
NEXT B
*
OCT=DCOUNT(IREC<IVD$COMMENTS>,VM)
FOR O=1 TO OCT
  PML.REC<PML$COMMENTS,O>=IREC<IVD$COMMENTS,O>
NEXT O
*
IF PML.REC # "" THEN  WRITE PML.REC ON PM.LABELS,PML.KEY
*
RETURN
*