270 lines
7.5 KiB
Plaintext
Executable File
270 lines
7.5 KiB
Plaintext
Executable File
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
|
|
*
|