|
Code:
- H DftActGrp(*No)
- H ActGrp(*New)
- H BndDir('*Libl/STARBND':'*Libl/QC2LE')
- H UsrPrf(*Owner)
- H Option(*NoSrcStmt:*NoDebugio)
- ‚*-------------------------------------------------------------------*
-
- FGPK510CD CF E WorkStn
- FLHLOAD02 IF E K Disk
- FLOLOAD08 IF E K Disk Rename(LO00RC:LO08RC)
- FLOLOAD00 IF E K Disk
- FLXLOAD00 IF E K Disk
- FPHPICK00 IF E K Disk
- FPDPICKZ1 IF E K Disk
- F** JA01 PDPICK10 IF E K Disk
- F*****CDCARTZ1 IF E K Disk
- FCDCARTZ1 UF E K Disk
- FILLOCN00 IF E K Disk
- FODOUTQ00 IF E K Disk
- FPKXAPICKP IF E K Disk
- FMBC6RES0 IF E K Disk
- | FMBCDRESM IF E K Disk Prefix(N_)
- | FMBDMCPS2 IF E K Disk
- FEDI850DTL IF E K Disk
- FPIPICK01 IF E K Disk
- FPOPCDIRL2 IF E K Disk
- | FPOPCDIRL3 IF E K Disk Rename(Pofcdir:PofcdirL3)
- FITM020PLM1IF E K Disk
- FGPK510WP IF E K Disk
- FGPK510CP O E Printer OflInd(*In99) UsrOpn
- F INFDS(OutputFDS)
- Famax70p IF E K Disk
- FPOLCDIR2 IF E K Disk Rename(Pofcdir:Pol2)
- F Prefix(l2_)
- FMBCDRES0 IF E K Disk Prefix(s0_)
- FMBBWCPS0 IF E K Disk
- FMBGGCPS5 IF E K Disk
- FUSUSER00 IF E K Disk Prefix(s0_)
- FPOLTOL99 IF E K Disk
- FIVLMSTRC IF E K Disk
- ‚*-------------------------------------------------------------------*
- ‚* Entry Parameters
- ‚*
- D*File Information Data Structure
- | D OutputFDS DS
- D CUR_LINE 367 368I 0 Current line num
- ‚*
- ‚* Work Variables
- ‚*
- D Wk_RtrnCode S 1A Inz
- D Wk_TotlOrdQ S 9S 0 Inz
- D Wk_TotlShpQ S 9S 0 Inz
- D Wk_NumbrStp S 2S 0 Inz
- D Wk_StopNmbr S 2S 0 Inz
- D Wk_ItemNmbr S 25A Inz
- D Wk_ItemStyl S 8A Inz
- D Wk_ItemSffx S 7A Inz
- D Wk_ItemDesc S 35A Inz
- D Wk_PickQnty S 7S 0 Inz
- D Wk_StopSeqn S 5S 0 Inz
- D Wk_PickLocn S 10A Inz
- D Wk_OrdrNmbr S 7A Inz
- D Wk_OrdrNmb1 S 7A Inz
- D Wk_WCMessage S 35A INZ('***** USE VINYL AIR BAGS ONLY *+
- D ****')
- D Wk_Zip S 11A Inz DB06 size 5A
- D I S 5S 0 Inz
- D II S 5S 0 Inz
- D JJ S 5S 0 Inz
- D kk S 5S 0 Inz
- D XX S 5S 0 Inz
- D ZZ S 5S 0 Inz
- D YY S 5S 0 Inz
- D Wk_Equip S 1a
- D Wk_Part S 1a
- ‚*
- D CPFMSGID S 7A Import('_EXCP_MSGID')
- ‚*
- ‚* Date Variables
- ‚*
- D Dt_CurrDate S D Inz(*Sys)
- D Dt_WorkDate S D Inz
- ‚*
- ‚* Arrays
- ‚*
- D Ar_Err S 80A Dim(05) CtData PerRcd(1)
- D**Ar_Cmd S 90A Dim(01) CtData PerRcd(1)
- D Ar_Cmd S 91A Dim(01) CtData PerRcd(1)
- ‚* DB04 - Changed the array size from 99 to 9999
- D Ar_SKL S 10A Dim(9999) Inz
- D Ar_Stp S 2A Dim(9999) Inz
- D Ar_PQt S 7S 0 Dim(9999) Inz
- D Ar_PKL S 5S 0 Dim(9999) Inz
- D**Ar_cdlin S 5S 0 Dim(9999) Inz
- D Ar_cdlin S 6S 0 Dim(9999) Inz
- D Ar_cdsku S 25A Dim(9999) Inz
- D Wk_mis2sku S 25A Inz
- ‚*
- d Ky_70p Ds LikeRec(amax70r:*key)
- ‚*
- D DS
- D SC_LOAD#01
- D SC_LOAD#02
- D SC_LOAD#03
- D SC_LOAD#04
- D SC_LOAD#05
- D SC_LOAD#06
- D SC_LOAD#07
- D SC_LOAD#08
- D SC_LOAD#09
- D SC_LOAD#10
- D Wk_LoadNmbr 1 100A
- D Ar_LD# 10A Dim(10) Overlay(Wk_LoadNmbr:1)
- ‚*
- ‚* Pointer Type Variables
- ‚*
- D Pt_Indicators S * Inz(%Addr(*In))
- ‚*
- ‚* Indicator Type Variables
- ‚*
- D Ds_Indicators DS Based(Pt_Indicators)
- D In_ExitPrgm 03 03N
- D In_AddtlPrm 10 10N
- D In_PrevPrgm 12 12N
- D In_ConfirmS 16 16N
- D In_MsgSubfl 27 27N
- D In_OverFlow 99 99N
- ‚*
- D In_FrstPage S N Inz
- D In_PgmError S N Inz
- D In_PrtShIns S N Inz
- D Wk_Done S N Inz
- | D DT3_ItemNbr S Like(DMG7TX)
- D Wk_POKEY S Like(X_POKEY)
- D S_PDMPKT S Like(PDMPKT)
- D Wk_HDPONO S Like(HDPONO)
- D Chk_Num_PONO S 7A
- D Wk_Num_Check S N Inz
- sp01 ‚* QCmdExc Parameters
- sp01 D Wk_Cmd S 2000 Inz
- sp01 D Wk_CmdLen S 15P 5 Inz
- sp01 D Pos S 2S 0 Inz
- sp01 D Quote S 1A Inz('''')
- ‚*
- ‚* Data Structures
- ‚*
- D SDS
- D Wk_PrgmName *PROC
- D Wk_UserName 254 263
- ‚*
- D Ds_LDLDAR00 E DS ExtName(LDLDAR00) DtaAra(*LDA)
- ‚*
- ‚* Prototypes Definition
- ‚*
- D Pr_DateToNumb PR 10I 0 ExtProc('atol')
- D * Value Options(*String)
- ‚*
- D Pr_AddnlParms PR ExtPgm('PTG0G8RP')
- D Pm_PrgmName 10A
- ‚*
- D Pr_AS400Cmmds PR 10I 0 ExtProc('system')
- D Pm_CmmdLeng * Value Options(*String)
- *
- * Delay job for a set number of seconds.
- NK08 d DlyJob PR ExtPgm('QCMDEXC')
- | d 512 Const
- | d 15P 5 Const
- NK08 D*
- ‚*******************************************************************
- DB01
- | D PCKORD_DS DS
- | D MajPick# Like(PhPCtl)
- | D Item# 16
- | D MinPick# Like(PhPCtl)
- | D CustOrd# 20
- | D ItemDs 35
- | D PickLine# 5 0
- | D Priority 20
- | D OrdQty 11 4
- | D ShpQty 11 4
- | D PckQty 11 4
- DB01 *
- DB04 ‚* DB04 - Changed the array size from 99 to 9999
- | D MajPick#_Ar S Like(PhPCtl) Dim(9999)
- | D Item#_Ar S Like(Item#) Dim(9999)
- | D MinPick#_Ar S Like(PhPCtl) Dim(9999)
- | D CustOrd#_Ar S Like(CustOrd#) Dim(9999)
- | D ItemDs_Ar S Like(ItemDs) Dim(9999)
- | D PickLine#_Ar S Like(PickLine#) Dim(9999)
- | D Priority_Ar S Like(Priority) Dim(9999)
- | D OrdQty_Ar S Like(OrdQty) Dim(9999)
- | D ShpQty_Ar S Like(ShpQty) Dim(9999)
- | D PckQty_Ar S Like(PckQty) Dim(9999)
- | D Count_Ar S 5 0
- DB04 D Index_Ar S 5 0
- DB01 D CustOrd#_Save S Like(CustOrd#)
- | D MinPick#_Save S Like(PhPCtl)
- | D RfPn_Flag S 1A Inz
- | D PickLine#_Var S 5 0
- | D Pick#_Var S Like(PhPCtl)
- | D CountShpq S 11 4
- | D BaseQty S 11 4
- DB01 ‚*
- DB04 ‚* DB04 - Changed the array size from 99 to 9999
- | D Ar_PkLQty S Like(ShpQtY) Dim(9999)
- DB04 D Ar_PkLItem# S Like(Item#) Dim(9999)
- DB01 ‚*
- |
- | D SKULOC_DS DS
- | D SkLPick# Like(PhPCtl)
- | D SkLItem# Like(Item#)
- | D SkLLine# Like(PdPkLn)
- | D SkLZone Like(PdZone)
- | D SkLAisl Like(PdAisl)
- | D SkLBay Like(PdBay)
- | D SkLLevl Like(PdLevl)
- | D SkLPosn Like(PdPosn)
- | D SkLTBPU Like(PdShQt)
- | D SkLPAKU Like(PdShQt)
- | ‚*
- DB04 ‚* DB04 - Changed the array size from 99 to 9999
- | D Ar_SkLPick# S Like(PhPCtl) Dim(9999)
- | D Ar_SkLItem# S Like(Item#) Dim(9999)
- | D Ar_SkLLine# S Like(PdPkLn) Dim(9999)
- | D Ar_SkLZone S Like(PdZone) Dim(9999)
- | D Ar_SkLAisl S Like(PdAisl) Dim(9999)
- | D Ar_SkLBay S Like(PdBay) Dim(9999)
- | D Ar_SkLLevl S Like(PdLevl) Dim(9999)
- | D Ar_SkLPosn S Like(PdPosn) Dim(9999)
- DB04 D Ar_SkLTBPU S Like(PdShQt) Dim(9999)
- ra01 D skuTotal0 S 5s 0 inz
- ra01 D moreThanOne S n inz(*off)
- *
- DB01 D*--------------------------------------------------
- | D* Procedure name: declareCursor
- | D* Purpose: Declare cursor
- | D* Returns:
- | D*--------------------------------------------------
- | D declareCursor PR
- | D declareCursor1 PR
- | D declareCursor2 PR
- | *
- | D*--------------------------------------------------
- | D* Procedure name: openCursor
- | D* Purpose: Open cursor
- | D* Returns:
- | D*--------------------------------------------------
- | D openCursor PR
- | D openCursor1 PR
- | D openCursor2 PR
- |
- | D*--------------------------------------------------
- | D* Procedure name: fetch
- | D* Purpose: fetch record from cursor
- | D* Returns:
- | D*--------------------------------------------------
- | D fetch PR
- | D fetch1 PR
- | D fetch2 PR
- | *
- | D*--------------------------------------------------
- | D* Procedure name: closeCursor
- | D* Purpose: Close cursor
- | D* Returns:
- | D*--------------------------------------------------
- | D closeCursor PR
- | D closeCursor1 PR
- | D closeCursor2 PR
- |
- DB01 *
- ‚*******************************************************************
- /Copy *Libl/QCPYSRC,Snd_MsgPgm
- /Copy *Libl/QCPYSRC,Rmv_MsgPgm
- ‚*-------------------------------------------------------------------*
- ‚* MAIN CODE LINE *
- ‚*-------------------------------------------------------------------*
- /Free
-
- // Override Printer File and Display Prompt Screen
-
- NK06 // ExSr Sr_OverrdPrtf;
- NK06 ExSr OvrPrtfile2;
-
- ExSr Sr_DsplPrompt;
-
- // Execute ShutDown Taks And Kill Program
-
- ExSr Sr_ExeShtDown;
-
- *InLr = *On;
- Return;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* ShutDown Taks Routine. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_ExeShtDown;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Display Prompt Screen *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_DsplPrompt;
-
- // Loop Till Exit Requested
-
- DoW Not In_ExitPrgm And Not In_PrevPrgm;
-
- // Display Message Subfile
-
- Write MSGCTL;
-
- // Display Prompt Screen
-
- Exfmt RCD001;
-
- // Remove Messages from Pgm Msg Queue and Kill Error Indicators
-
- Rmv_MsgPgm();
- Clear In_PgmError;
- For II = 1 by 1 to %Elem(Ar_LD#);
- *In(50 + II) = *Off;
- EndFor;
-
- // F3=Exit Program
-
- Select;
- When In_ExitPrgm;
- Leave;
-
- // F10=Additional Parameters
-
- When In_AddtlPrm;
- Out Ds_LDLDAR00;
- Pr_AddnlParms(Wk_PrgmName);
- In Ds_LDLDAR00;
- If LDWSID <> *Blanks;
- %SubSt(Ar_Cmd(01):43:10) = LDWSID;
- CallP(E) Pr_AS400Cmmds(Ar_Cmd(01));
- EndIf;
- Iter;
-
- // F12=Previous Pgm
-
- When In_PrevPrgm;
- Leave;
-
- // F16=Confirm
-
- When In_ConfirmS;
- ExSr Sr_EditPrompt;
- If Not In_PgmError;
- ExSr Sr_ProcessRqt;
- Snd_MsgPgm(Ar_Err(03));
- EndIf;
- Iter;
-
- // Check if Any User Selection
-
- Other;
- ExSr Sr_EditPrompt;
-
- EndSl;
-
- EndDo;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Validate Prompt Routine. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_EditPrompt;
-
- If SC_Packer <> *Blanks;
- | Chain(N) SC_Packer USUSER00;
- | if NOT %Found(USUSER00);
- | Snd_MsgPgm(Ar_Err(05));
- | In_PgmError = *On;
- | LeaveSr;
- | endif;
- EndIf;
-
- If In_ConfirmS And Wk_LoadNmbr = *Blanks;
- Snd_MsgPgm(Ar_Err(04));
- In_PgmError = *On;
- LeaveSr;
- EndIf;
-
- For II = 1 by 1 to %Elem(Ar_LD#);
- If Ar_LD#(II) <> *Blanks;
- NK04 Chain (SC_WHSECOD:Ar_LD#(II)) LHLOAD02;
- NK04 If Not %Found(LHLOAD02);
- Snd_MsgPgm(Ar_Err(01));
- In_PgmError = *On;
- *In(50 + II) = *On;
- EndIf;
- EndIf;
- EndFor;
-
- If Not In_PgmError = *On And Not In_ConfirmS And
- Wk_LoadNmbr <> *Blanks;
- Snd_MsgPgm(Ar_Err(02));
- EndIf;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Process Print Request. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_ProcessRqt;
-
- NK08 DlyJob('DLYJOB DLY(05)':14);
-
- For II = 1 by 1 to %Elem(Ar_LD#);
- If Ar_LD#(II) <> *Blanks;
- Open GPK510CP;
- ExSr Sr_PrtLoadDoc;
- Close GPK510CP;
- /End-Free
- sp01 C Eval Pos = %Scan('@' :sc_email)
- sp01 C SC_Email IFNE *Blanks
- sp01 C Pos ANDGT *Zeros
- sp01 C Eval Wk_Cmd = 'ESEND/ESNDMAIL RECIPIENT(' +
- sp01 C Quote + %Trim(sc_email) + Quote + ') +
- sp01 C SUBJECT(''LTL Ld Sum doc for Load '+
- sp01 C %Trim(LOADBRCD) +''') ' +
- sp01 C ' MSG(''See attached file'') +
- sp01 C ATTLIST((* *PDF *N GPK510CP *))'
- sp01 C*
- sp01 C Eval Wk_CmdLen = %len(%trim(Wk_Cmd))
- sp01 C Call 'QCMDEXC'
- sp01 C Parm Wk_Cmd
- sp01 C Parm Wk_CmdLen
- sp01 *
- sp01 C EndIf
- sp01 *
- /Free
- EndIf;
- EndFor;
-
- Clear Wk_LoadNmbr;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Print Trailer Load Summary Document. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_PrtLoadDoc;
-
- In_FrstPage = *On;
- Clear Wk_TotlOrdQ;
- Clear Wk_TotlShpQ;
-
- NK04 Chain (SC_WHSECOD:Ar_LD#(II)) LHLOAD02;
- ExSr Sr_GetNbroStp;
-
- RP_LOADNBR = Ar_LD#(II);
- LOADBRCD = Ar_LD#(II);
- RP_PGMNAME = Wk_PrgmName;
- RP_USERNAM = Wk_UserName;
- DB05 //RP_TRLRNBR = LHTRLN;
- DB05 //**DB06** RP_TRLRNBR = LHCARR;
- DB06 RP_TRLRNBR = %Trim(LHCARR) + ' ' + %Trim(LHTRLN);
- RP_NBRSTOP = Wk_NumbrStp;
-
- em02 // Check if load contains equipment and parts
- | RP_MESSAGE = *blanks;
- | If LdWhse = 'DLC';
- | Exsr CheckItemTypes;
- em02 Endif;
-
- Setll Ar_LD#(II) LOLOAD08;
- ReadE Ar_LD#(II) LOLOAD08;
- Wk_StopSeqn = LOSTSQ;
- Dow Not %EOF(LOLOAD08);
-
- NK14 SHMTBRCD = LOSHNO;
-
- Setll (LOLDNO:LOSHNO) LXLOAD00;
- ReadE (LOLDNO:LOSHNO) LXLOAD00;
-
- Dow Not %EOF(LXLOAD00);
-
- Chain LXPCTL PHPICK00;
- If %Found(PHPICK00);
- RP_STOPNBR = %Trim(%Char(LOSTSQ));
- RP_CUSTNBR = PHSOTO;
- RP_SHPTONM = PHSHNM;
- RP_SHPTNBR = PHSHTO;
- RP_SHPTOA1 = PHSHA1;
- // JA01 RP_CUSTPON = PHCUPO;
-
- Clear *In38;
- | RP_Packer = *Blanks;
- | if SC_Packer <> *Blanks And PhPstf = '40';
- | *In38 = *ON;
- | RP_Packer = 'Packer : ' + SC_Packer;
- endif;
-
- Clear *In30;
- If PHSHA2 = *Blanks;
- RP_SHPTOA2 = %Trim(PHSHCT) + ',' + %Trim(PHSHST) +
- ' ' + PHSHZP;
- Else;
- RP_SHPTOA2 = PHSHA2;
- RP_SHPTOA2 = %Trim(PHSHCT) + ',' + %Trim(PHSHST) +
- ' ' + PHSHZP;
- *In30 = *On;
- EndIf;
- DB06
- | Clear RP_WCMsg;
- | Clear *In37;
- DB06 If PHMIS1 <> 'SPH' And PHMIS1 <> 'SPF';
-
- Clear Wk_Zip;
- | Wk_Zip = PHSHZP;
- | Chain (PhSoto:PhMis6:Wk_Zip) GPK510WP;
- | If %Found(GPK510WP);
- | *In37 = *On;
- | RP_WCMsg = WkMsg;
- Else;
-
- Clear Wk_Zip;
- | Wk_Zip = %Subst(PHSHZP:1:5);
- | Chain (PhSoto:PhMis6:Wk_Zip) GPK510WP;
- | If %Found(GPK510WP);
- | *In37 = *On;
- | RP_WCMsg = WkMsg;
- Else;
-
- DB07 Clear Wk_Zip;
- | Wk_Zip = PHSHZP;
- | Chain (PhSoto:' ':Wk_Zip) GPK510WP;
- | If %Found(GPK510WP);
- | *In37 = *On;
- | //** RP_WCMsg = Wk_WCMessage;
- RP_WCMsg = WkMsg;
- | Else;
- |
- DB07 Clear Wk_Zip;
- DB06 Wk_Zip = %Subst(PHSHZP:1:5);
- | Chain (PhSoto:' ':Wk_Zip) GPK510WP;
- | If %Found(GPK510WP);
- | *In37 = *On;
- | //** RP_WCMsg = Wk_WCMessage;
- RP_WCMsg = WkMsg;
- DB06 EndIf;
- DB07 EndIf;
- EndIf;
- DB06 EndIf;
- EndIf;
-
- // ExSr Sr_PrtLoadDtl;
- ExSr Sr_PrtLoadDtlNew;
-
- NK05 Exsr Sr_PrtSpcInst; //Special Instruction
-
- EndIf;
-
- ReadE (LOLDNO:LOSHNO) LXLOAD00;
-
- EndDo;
-
- ReadE Ar_LD#(II) LOLOAD08;
- EndDo;
-
- If Wk_TotlOrdQ <> *Zeros;
- RP_TOTORDQ = Wk_TotlOrdQ;
- RP_TOTSHPQ = Wk_TotlShpQ;
- RP_TSTOPNB = %Trim(%Char(Wk_StopSeqn));
- Write TOT001;
- EndIf;
-
- Write END001;
-
- em03 If CUR_LINE > 55;
- | Clear In_FrstPage;
- | Clear In_OverFlow;
- | Write HDR001;
- | EndIf;
- |
- em03 Write END002;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Get Number Of Stops. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_PrtLoadDtl;
-
- If Wk_StopSeqn <> LOSTSQ;
- RP_TOTORDQ = Wk_TotlOrdQ;
- RP_TOTSHPQ = Wk_TotlShpQ;
- RP_TSTOPNB = %Trim(%Char(Wk_StopSeqn));
- Write TOT001;
- Wk_StopSeqn = LOSTSQ;
- In_FrstPage = *On;
- Clear Wk_TotlOrdQ;
- Clear Wk_TotlShpQ;
- EndIf;
-
- NK07 Clear S_PDMPKT;
-
- // JA01 Setll LXPCTL PDPICK10;
- // JA01 ReadE LXPCTL PDPICK10;
- JA01 Setll LXPCTL PDPICKZ1;
- JA01 ReadE LXPCTL PDPICKZ1;
-
- Wk_ItemNmbr = PDSTYL + PDSSFX;
- JA01 Wk_OrdrNmbr = %SubSt(PDMIS2:3:7);
- JA01 Wk_OrdrNmb1 = *Blanks;
- Wk_ItemDesc = PDSTYD;
- JA01 Clear XX;
- JA01 Clear Ar_PKL;
- ash02 Clear Ar_cdlin;
- ash04 Clear Ar_cdsku;
- NK07 S_PDMPKT = PDMPKT;
-
- // JA01 Dow Not %EOF(PDPICK10);
- JA01 Dow Not %EOF(PDPICKZ1);
-
- If Wk_ItemNmbr <> PDSTYL + PDSSFX Or
- JA01 Wk_OrdrNmbr <> %SubSt(PDMIS2:3:7);
- JA01
- JA01 If Wk_OrdrNmb1 <> Wk_OrdrNmbr;
- JA01 Wk_OrdrNmb1 = Wk_OrdrNmbr;
- JA01 ExSr Sr_BreakByPO#;
- JA01 EndIf;
- JA01
- JA01 Clear XX;
- JA01 Clear Ar_SkL;
- JA01 Clear Ar_PQt;
- JA01 Clear Wk_PickQnty;
- JA01
- JA01 For YY=1 to ZZ;
- JA01 ExSr Sr_GetSkuLocn;
- JA01 EndFor;
-
- ExSr Sr_WrtSkuDetl;
- Wk_ItemNmbr = PDSTYL + PDSSFX;
- Wk_OrdrNmbr = %SubSt(PDMIS2:3:7);
- Wk_ItemDesc = PDSTYD;
- JA01 Clear ZZ;
- JA01 Clear Ar_PKL;
- ash02 Clear Ar_cdlin;
- ash04 Clear Ar_cdsku;
-
- NK07 S_PDMPKT = PDMPKT;
- EndIf;
-
- JA01 ZZ += 1;
- JA01 Ar_PKL(ZZ) = PDPKLN;
- ash02 Ar_cdlin(ZZ) = PDnum1;
- ash04 Ar_cdsku(ZZ) = %trim(pdmis2)+%trim(PDstyl+pdssfx);
-
- RP_ORDRQTY += PDOPQT;
- RP_SHIPQTY += PDSHQT;
- ash01 Wk_TotlOrdQ += PDOPQT;
- ash01 // Wk_TotlOrdQ += PDOGQT;
- Wk_TotlShpQ += PDSHQT;
-
- // JA01 ReadE LXPCTL PDPICK10;
- JA01 ReadE LXPCTL PDPICKZ1;
-
- EndDo;
-
- If Wk_TotlOrdQ <> *Zeros;
- JA01 If Wk_OrdrNmb1 <> Wk_OrdrNmbr;
- JA01 Wk_OrdrNmb1 = Wk_OrdrNmbr;
- JA01 ExSr Sr_BreakByPO#;
- JA01 EndIf;
- JA01
- JA01 Clear XX;
- JA01 Clear Ar_SkL;
- JA01 Clear Ar_PQt;
- JA01 Clear Wk_PickQnty;
- JA01
- JA01 For YY=1 to ZZ;
- ExSr Sr_GetSkuLocn;
- JA01 EndFor;
- JA01
- JA01 Clear ZZ;
- JA01 Clear Ar_PKL;
- ash02 Clear Ar_cdlin;
- ash04 Clear Ar_cdsku;
-
- ExSr Sr_WrtSkuDetl;
- EndIf;
-
- EndSr;
-
- /End-Free
- JA01 ‚*-------------------------------------------------------------------*
- JA01 ‚* Break by PO Number. *
- JA01 ‚*-------------------------------------------------------------------*
- JA01 /Free
- JA01
- JA01 BegSr Sr_BreakByPO#;
- JA01
- JA01 If In_FrstPage Or In_OverFlow;
- JA01 Clear In_FrstPage;
- JA01 Clear In_OverFlow;
- JA01 Write HDR001;
- JA01 EndIf;
-
- NK01 Clear CUPO#;
- NK01 Clear ORDR#;
- NK03 Clear USRF1;
-
- If PHMSPK = '1'; //AS01
- JA01 //NK07 Chain (PDMPKT:Wk_OrdrNmbr) PKXAPICKP; //AS01
- NK07 Chain (S_PDMPKT:Wk_OrdrNmbr) PKXAPICKP; //AS01
- Else; //AS01
- JA01 Chain (LXPCTL:Wk_OrdrNmbr) PKXAPICKP;
- EndIf; //AS01
- ash06
- if CUPO# = ' ';
- select;
- when PHMSPK = '1';
- chain(n) (S_PDMPKT) Phpick00;
- other;
- chain(n) (LXPCTL) Phpick00;
- endsl;
- chain(n) (pdstyl+pdssfx) IVLMSTRC; //ash07
- CMNO08 = %int(%subst(phpctl:3:7));
- //ash07 chain(N) (CMNO08) POLTOL99;
- chain(N) (CMNO08:IVNO07) POLTOL99;
- if %found(POLTOL99);
- CUPO# = %char(PONO01);
- else; //ash07
- chain(N) (CMNO08) POLTOL99;
- //ash09 CUPO# = %char(PONO01);
- CUPO# = ' '; //ash09
- endif;
- endif;
- ash06
- JA01
- if usrf1 = *blanks;
-
- JA01 RP_POORDR# = 'Customer PO#: ' + %Trim(CUPO#) + ' / ' +
- JA01 'Ordr#: ' + ORDR#;
- else;
-
- NK03 RP_POORDR# = 'Starnet PO#: ' + %Trim(CUPO#) + ' / ' +
- | 'Customer PO#: ' + %Trim(USRF1) + ' / ' +
- | 'Ordr#: ' + ORDR#;
- endif;
- NK03
-
- JA01 Write DTL002;
- JA01
- JA01 EndSr;
- JA01
- JA01 /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Get Sku Pick Locations and Quantity. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_GetSkuLocn;
-
- Wk_ItemStyl = %SubSt(Wk_ItemNmbr:1:8);
- Wk_ItemSffx = %SubSt(Wk_ItemNmbr:9:7);
-
- // JA01 SetLL (PDPCTL:Wk_ItemStyl:Wk_ItemSffx) CDCARTZ1;
- // JA01 ReadE (PDPCTL:Wk_ItemStyl:Wk_ItemSffx) CDCARTZ1;
- JA01 SetLL (PDPCTL:Wk_ItemStyl:Wk_ItemSffx:Ar_PKL(YY)) CDCARTZ1;
- JA01 ReadE (PDPCTL:Wk_ItemStyl:Wk_ItemSffx:Ar_PKL(YY)) CDCARTZ1;
-
- DoW Not %EOF(CDCARTZ1);
-
- // Chain (LDWHSE:CDAREA:CDZONE:CDAISL
- // :CDBAY:CDLEVL:CDPOSN) ILLOCN00;
-
- Wk_PickLocn = %Trim(CDZONE) + %Trim(CDAISL) + %Trim(CDBAY) +
- %Trim(CDLEVL) + %Trim(CDPOSN);
-
- If Wk_PickLocn = *Blanks;
- Wk_PickLocn ='NO LOCTN';
- EndIf;
-
- If %LookUp(Wk_PickLocn:Ar_SkL) = *Zeros;
- XX += 1;
- Ar_SkL(XX) = Wk_PickLocn;
- EndIf;
-
- NK08 if PhPstf < '40';
- Ar_PQt(%LookUp(Wk_PickLocn:Ar_SkL)) += CDTBPU;
- NK08 else;
- | Ar_PQt(%LookUp(Wk_PickLocn:Ar_SkL)) += CDPAKU;
- NK08 endif;
-
- NK08 if PhPstf < '40';
- Wk_PickQnty += CDTBPU;
- NK08 else;
- | Wk_PickQnty += CDPAKU;
- NK08 endif;
-
- if PhPstf = '40' And SC_Packer <> *Blanks;
- | CDPAKR = SC_Packer;
- em01 if phmis1 = 'PRT' or phmis1 = 'PDC'; // em04
- em01 cdmis2 = %char(%date():*iso0) + ' ' + %char(%time():*iso0);
- em01 endif;
- | Update CD00RC;
- endif;
-
- // JA01 ReadE (PDPCTL:Wk_ItemStyl:Wk_ItemSffx) CDCARTZ1 ;
- JA01 ReadE (PDPCTL:Wk_ItemStyl:Wk_ItemSffx:Ar_PKL(YY)) CDCARTZ1;
-
- EndDo;
-
- If XX = *Zeros;
- Ar_SkL(01)='NO LOCTN';
- XX = 01;
- EndIf;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Write Sku Detail. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_WrtSkuDetl;
-
- If PHMSPK = '1'; //AS01
- //NK07 RP_PICKNBR = PDMPKT; //AS01
- NK07 RP_PICKNBR = S_PDMPKT; //AS01
- Else; //AS01
- RP_PICKNBR = PDPCTL;
- EndIf; //AS01
- RP_SHIPPTY = PDMIS1;
- RP_ITEMNBR = Wk_ItemNmbr;
- RP_SKUDESC = Wk_ItemDesc;
-
- For JJ = 1 to XX;
-
- If In_FrstPage Or In_OverFlow;
- Clear In_FrstPage;
- Clear In_OverFlow;
- Write HDR001;
- RPG01 // JA01 Write DTL002;
- EndIf;
-
- RP_SKULOCN = Ar_SkL(JJ);
- RP_PICKQTY = Ar_PQt(JJ);
-
- Write DTL001;
-
- Clear RP_PICKNBR;
- Clear RP_ITEMNBR;
- Clear RP_SKUDESC;
- Clear RP_ORDRQTY;
- Clear RP_SHIPQTY;
- Clear RP_SHIPPTY;
-
- EndFor;
-
- NK02 Exsr Substitute_SKU;
-
- Clear RP_PICKNBR;
- Clear RP_ITEMNBR;
- Clear RP_ORDRQTY;
- Clear RP_SHIPQTY;
-
-
- ra01 if XX > 1;
- ra01 RP_SKUTOTQ = wk_PickQnty;
- ra01 write SKUTOT;
- ra01 clear RP_SKUTOTQ;
- ra01 endIf;
-
- EndSr;
-
- /End-Free
- NK02 ‚*-------------------------------------------------------------------*
- | ‚* Get Substituted SKU (DB08 - This subroutine not in use but I am *
- | ‚* still changing to keep all routines in sync. *
- | ‚*-------------------------------------------------------------------*
- | /Free
- |
- | BegSr Substitute_SKU;
- |
- | DT3_Item = *Blanks; // printed on report
- | DT3_ItemNbr = *Blanks; // for data fetch
- | DT3_ItemNbr = Wk_ItemNmbr;
- |
- | C6AENB = %INT( %SUBST(PDMIS2:1:2) );
- | C6DCCD = '1' ;
- | C6CVNB = %SUBST(PDMIS2:3:7) ;
- |
- | Chain (C6AENB:C6DCCD:C6CVNB) MBC6RES0 ; // Order Header
- | IF %Found(MBC6RES0) ;
- |
- |
- | Chain (C6AENB:C6DCCD:C6CVNB:DT3_ItemNbr) MBCDRESM ; // Order d
- | if %found(MBCDRESM) And N_CDAALM <> *blanks;
- | DT3_Item = N_CDAALM;
- | endif;
- NK02
- DB08 ELSE ;
- | Chain (C6AENB:C6DCCD:C6CVNB) MBBWCPS0 ; // Order Header History
- | IF %Found(MBBWCPS0) ;
- | Chain (C6AENB:DT3_ItemNbr:C6DCCD:C6CVNB) MBGGCPS5 ; // Order d
- | if %found(MBGGCPS5) And GGABYG <> *blanks;
- | DT3_Item = GGABYG;
- | endif;
- DB08 ENDIF ;
- NK02
- | ENDIF ;
- |
- | if DT3_Item <> *Blanks;
- | Write DTL003;
- | endif;
- |
- | EndSr;
- |
- NK02 /End-Free
- **-------------------------------------------------------------------*
- ** Get Number Of Stops. *
- **-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_GetNbroStp;
-
- Clear Wk_NumbrStp;
- Clear Ar_Stp;
-
- Setll Ar_LD#(II) LOLOAD00;
- ReadE Ar_LD#(II) LOLOAD00;
- Dow Not %EOF(LOLOAD00);
- Wk_StopNmbr = LOSTSQ;
- If %LookUp(%EditC(Wk_StopNmbr:'X'):Ar_Stp) = *Zeros;
- Wk_NumbrStp += 1;
- Ar_Stp(Wk_NumbrStp) = %EditC(Wk_StopNmbr:'X');
- EndIf;
- ReadE AR_LD#(II) LOLOAD00;
- EndDo;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Override Printer File routine. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_OverrdPrtf;
-
- Chain (Wk_PrgmName:SC_WHSECOD:'*') ODOUTQ00;
- If %Found(ODOUTQ00) And ODOUTQ <> *Blanks;
- %SubSt(Ar_Cmd(01):43:10) = ODOUTQ;
- %SubSt(Ar_Cmd(01):62:03) = %EditC(ODCOPY:'X');
- CallP(E) Pr_AS400Cmmds(Ar_Cmd(01));
- EndIf;
-
- EndSr;
- NK05 //--------------------------------------------------------
- | // Special Instruction
- | //--------------------------------------------------------
- | BegSr Sr_PrtSpcInst;
- |
- | // Print Pick ticket special instruction
- | SetLL LXPCTL PIPICK01;
- | ReadE LXPCTL PIPICK01;
- | Dow Not %EOF(PIPICK01);
- | If PIITYP = 'PK' and PIIDES <> *Blanks;
- | if In_OverFlow;
- | Clear In_FrstPage;
- | Clear In_OverFlow;
- | Write HDR001;
- | endif;
- | Write HDR004; //Special Inst Header
- | Leave;
- | EndIf;
- | ReadE LXPCTL PIPICK01;
- | EndDo;
- |
- | SetLL LXPCTL PIPICK01;
- | ReadE LXPCTL PIPICK01;
- | Dow Not %EOF(PIPICK01);
- | If PIITYP = 'PK' and PIIDES <> *Blanks;
- | RP_SPCINST = %TRIM(PIIDES);
- | if In_OverFlow;
- | Clear In_FrstPage;
- | Clear In_OverFlow;
- | Write HDR001;
- | Write HDR004;
- | endif;
- | Write DTL004; //Special Inst Detail
- | EndIf;
- | ReadE LXPCTL PIPICK01;
- | EndDo;
- |
- NK05 EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Intialization Routine *
- ‚*-------------------------------------------------------------------*
- C *InzSr BegSr
- ‚* -----
- C In Ds_LDLDAR00
- *
- C Eval SC_WHSECOD = LDWHSE
- C Eval SC_COMPCOD = LDCO
- C Eval SC_DIVSCOD = LDDIV
- ‚*
- ‚* Set Program Name and Program Message Queue
- ‚*
- C Eval SC_PGMMSGQ = '*'
- C Eval SC_PGMNAME = Wk_PrgmName
- ‚*
- ‚* Set Display Message Subfile Indicator
- ‚*
- C Eval In_MsgSubfl = *On
- ‚* -----
- C EndSr
- NK06 **********************************************************************
- | * Subroutine OvrPrtfile2 - To override print files to diff OUTQs *
- | **********************************************************************
- | C OvrPrtfile2 BegSr
- | *
- | C MoveL LdWhse Ovpr_Whs
- | C MoveL *Blanks Ovpr_Apm
- | C MoveL 'GPK510CR' Ovpr_Prn
- | C ExSr Ovpr_Ovrpr
- | *
- | /Free
- | In Ds_LDLDAR00;
- | If %SubSt(LDPAR2:24:10) <> *Blanks;
- | %SubSt(Ar_Cmd(01):43:10) = %SubSt(LDPAR2:24:10);
- | %SubSt(Ar_Cmd(01):62:3) = %SubSt(LDPAR2:46:3);
- | CallP(E) Pr_AS400Cmmds(Ar_Cmd(01));
- | EndIf;
- | /End-Free
- | *
- NK06 C EndSr
- ‚*-------------------------------------------------------------------*
- ‚* Get Number Of Stops. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_PrtLoadDtlNew;
-
- If Wk_StopSeqn <> LOSTSQ;
- RP_TOTORDQ = Wk_TotlOrdQ;
- RP_TOTSHPQ = Wk_TotlShpQ;
- RP_TSTOPNB = %Trim(%Char(Wk_StopSeqn));
- Write TOT001;
- Wk_StopSeqn = LOSTSQ;
- In_FrstPage = *On;
- Clear Wk_TotlOrdQ;
- Clear Wk_TotlShpQ;
- EndIf;
-
- NK07 Clear S_PDMPKT;
-
- DB01
- | ExSr Create_MinPick#_CustOrd#_Ary;
- | ExSr Create_SKU_Locn_Ary;
- |
- | Clear XX;
- | Clear Ar_PkL;
- | Clear Ar_cdlin; //ash02
- | Clear Ar_cdsku; //ash04
- | Clear Ar_PkLItem#;
- | Clear Ar_PkLQty;
- | Setll LXPCTL PDPICKZ1;
- | ReadE LXPCTL PDPICKZ1;
- | Dow Not %EOF(PDPICKZ1);
- | XX += 1;
- | Ar_PkL(XX) = PDPKLN;
- | Ar_cdlin(XX) = PDnum1; //ash02
- | Ar_cdsku(XX) = %trim(pdmis2)+%trim(PDstyl+pdssfx);//ash04
- | Ar_PkLItem#(XX) = PDSTYL + PDSSFX;
- *in90 = *off;
- | Select;
- | When PhPSTF >= '20' and PhPSTF < '40'; // Printed
- | Ar_PkLQty(XX) = PDPIQT;
- | When PhPSTF >= '40' and PhPSTF < '90'; // Packed
- | Ar_PkLQty(XX) = PDPAKU;
- | When PhPSTF = '90'; // Invoiced
- | Ar_PkLQty(XX) = PDSHQT;
- *in90 = *on;
- | EndSl;
- | ReadE LXPCTL PDPICKZ1;
- | EndDo;
- |
- | // Major Pick# Routine (To get Minor Pick# & Cust. Ord#)
- | Clear CustOrd#_Save;
- | Clear MinPick#_Save;
- | Index_Ar = 1;
- | DoW Index_Ar <= Count_Ar;
- | If CustOrd#_Ar(Index_Ar) <> CustOrd#_Save Or
- | MinPick#_Ar(Index_Ar) <> MinPick#_Save;
- | CustOrd#_Save = CustOrd#_Ar(Index_Ar);
- | MinPick#_Save = MinPick#_Ar(Index_Ar);
- | Wk_OrdrNmbr = %SubSt(CustOrd#_Ar(Index_Ar):3:7);
- | ExSr Sr_BreakByPO#_Maj;
- | EndIf;
- |
- | Wk_ItemNmbr = Item#_Ar(Index_Ar);
- | Wk_OrdrNmb1 = *Blanks;
- | Wk_ItemDesc = ItemDS_Ar(Index_Ar);
- | ExSr Sr_PrtPickDtl;
- |
- | Index_Ar = Index_Ar + 1;
- |
- DB01 EndDo;
-
- EndSr;
-
- /End-Free
- DB01 ‚*-------------------------------------------------------------------*
- | ‚* Create Array of Minor Pick# and Customer Ord# for Major Pick# *
- | ‚*-------------------------------------------------------------------*
- | /Free
- | BegSr Create_MinPick#_CustOrd#_Ary;
- |
- | Clear MajPick#_Ar;
- | Clear Item#_Ar;
- | Clear MinPick#_Ar;
- | Clear CustOrd#_Ar;
- | Clear ItemDs_Ar;
- | Clear PickLine#_Ar;
- | Clear Priority_Ar;
- | Clear OrdQty_Ar;
- | Clear ShpQty_Ar;
- | Clear PckQty_Ar;
- |
- | If PhMsPk = '1' and PhRfPn = *Blanks;
- | RfPn_Flag = 'Y';
- | Else;
- | RfPn_Flag = 'N';
- | EndIf;
- |
- | If RfPn_Flag = 'Y';
- | // Declare Cursor @C1
- | declareCursor();
- | // Open Cursor
- | openCursor();
- | // Fetch record
- | fetch();
- | Else;
- | // Declare Cursor @X1
- | declareCursor1();
- | // Open Cursor
- | openCursor1();
- | // Fetch record
- | fetch1();
- | EndIf;
- |
- | Count_Ar = 0;
- |
- | DoW (SQLCOD = 0);
- | Count_Ar = Count_Ar + 1;
- | MajPick#_Ar(Count_Ar) = MajPick#;
- | Item#_Ar(Count_Ar) = Item#;
- | MinPick#_Ar(Count_Ar) = MinPick#;
- | CustOrd#_Ar(Count_Ar) = CustOrd#;
- | ItemDS_Ar(Count_Ar) = ItemDs;
- | PickLine#_Ar(Count_Ar) = PickLine#;
- | Priority_Ar(Count_Ar) = Priority;
- | OrdQty_Ar(Count_Ar) = OrdQty;
- | ShpQty_Ar(Count_Ar) = ShpQty;
- | PckQty_Ar(Count_Ar) = PckQty;
- | If RfPn_Flag = 'Y';
- | fetch();
- | Else;
- | fetch1();
- | EndIf;
- | EndDo;
- |
- | // Close Cursor
- | If RfPn_Flag = 'Y';
- | closeCursor();
- | Else;
- | closeCursor1();
- | EndIf;
- |
- // Fill in Pack & Ship quantities from Minor picktickets
- || for i = 1 to count_ar;
- || chain (minpick#_ar(i):custord#_ar(i):' ':' ':%subst(item#_ar(i):1:8):
- || %subst(item#_ar(i):9:8)) pdpickz1;
- || if %found (pdpickz1);
- || pckqty_ar(i) = pdpiqt;
- || shpqty_ar(i) = pdshqt;
- || endif;
- endfor;
- |
- | EndSr;
- | /End-Free
- DB01 ‚*-------------------------------------------------------------------*
- | ‚* Create Array of SKU Locations by Pick#/Item#/Line# *
- | ‚*-------------------------------------------------------------------*
- | /Free
- | BegSr Create_SKU_Locn_Ary;
- |
- | Clear Ar_SkLPick#;
- | Clear Ar_SkLItem#;
- | Clear Ar_SkLLine#;
- | Clear Ar_SkLZone;
- | Clear Ar_SkLAisl;
- | Clear Ar_SkLBay;
- | Clear Ar_SkLLevl;
- | Clear Ar_SkLPosn;
- | Clear Ar_SkLTBPU;
- |
- | // Declare Cursor @C1
- | declareCursor2();
- | // Open Cursor
- | openCursor2();
- | // Fetch record
- | fetch2();
- |
- | YY = 0;
- |
- | DoW (SQLCOD = 0);
- | YY = YY + 1;
- | Ar_SkLPick#(YY) = SkLPick#;
- | Ar_SkLItem#(YY) = SkLItem#;
- | Ar_SkLLine#(YY) = SkLLine#;
- | Ar_SkLZone(YY) = SkLZone;
- | Ar_SkLAisl(YY) = SkLAisl;
- | Ar_SkLBay(YY) = SkLBay;
- | Ar_SkLLevl(YY) = SkLLevl;
- | Ar_SkLPosn(YY) = SkLPosn;
- | Select;
- | When PhPSTF >= '20' and PhPSTF < '40'; // Printed
- | Ar_SklTBPU(YY) = SkLTBPU;
- | When PhPSTF >= '40' and PhPSTF < '99'; // Packed
- | if SkLPAKU > 0;
- | Ar_SkLTBPU(YY) = SkLPAKU;
- | else;
- | Ar_SkLTBPU(YY) = SkLTBPU;
- | endif;
- |
- | EndSl;
- | fetch2();
- | EndDo;
- |
- | // Close Cursor
- | closeCursor2();
- |
- if PhPstf = '40' And SC_Packer <> *Blanks;
- | SetLL PhPctl CDCARTZ1;
- | ReadE PhPctl CDCARTZ1;
- | DoW Not %EOF(CDCARTZ1);
- | CDPAKR = SC_Packer;
- em01 if phmis1 = 'PRT' or phmis1 = 'PDC'; // em04
- em01 cdmis2 = %char(%date():*iso0) + ' ' + %char(%time():*iso0);
- em01 endif;
- | Update CD00RC;
- | ReadE PhPctl CDCARTZ1;
- | EndDo;
- endif;
-
- | EndSr;
- DB01 /End-Free
- DB01 ‚*-------------------------------------------------------------------*
- JA01 ‚* Break by PO Number for Major Pick *
- JA01 ‚*-------------------------------------------------------------------*
- JA01 /Free
- JA01
- JA01 BegSr Sr_BreakByPO#_Maj;
- JA01
- JA01 If In_FrstPage Or In_OverFlow;
- JA01 Clear In_FrstPage;
- JA01 Clear In_OverFlow;
- JA01 Write HDR001;
- JA01 EndIf;
-
- NK01 Clear CUPO#;
- | Clear ORDR#;
- NK01 Clear USRF1;
-
- DB01 Chain (MinPick#_AR(Index_Ar):Wk_OrdrNmbr) PKXAPICKP;
- ash06
- if CUPO# = ' ';
- if xx > 0;
- chain(n) (Ar_PkLItem#(XX)) IVLMSTRC; //ash07
- else;
- ivno07 = 0;
- endif;
- chain(n) (MinPick#_AR(Index_Ar)) Phpick00;
- CMNO08 = %int(%subst(phpctl:3:7));
- //ash07 chain(N) (CMNO08) POLTOL99;
- chain(N) (CMNO08:IVNO07) POLTOL99; //ash07
- if %found(POLTOL99);
- CUPO# = %char(PONO01);
- else; //ash07
- chain(N) (CMNO08) POLTOL99;
- //ash09 CUPO# = %char(PONO01);
- CUPO# = ' '; //ash09
- endif;
- endif;
- ash06
- JA01
- if usrf1 = *blanks;
- JA01 RP_POORDR# = 'Customer PO#: ' + %Trim(CUPO#) + ' / ' +
- JA01 'Ordr#: ' + ORDR# +
- NK12 ' Shmt#: ' + LOSHNO ;
- else;
- RP_POORDR# = 'Starnet PO#: ' + %Trim(CUPO#) + '/ ' +
- | 'Customer PO#: ' + %Trim(USRF1) + '/ ' +
- | 'Ordr#: ' + ORDR# +
- ' Shmt#: ' + LOSHNO ;
- endif;
- DB01
- | // Clear RP_MinPck#;
- | If RfPn_Flag = 'Y';
- | // RP_MinPck# = 'Minor Pick#: ' + MinPick#_AR(Index_Ar);
- DB01 EndIf;
-
- JA01 Write DTL002;
- JA01
- JA01 EndSr;
- JA01
- JA01 /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Print Pick Detail. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_PrtPickDtl;
- JA01
- DB01 Clear ZZ;
- JA01 Clear XX;
- JA01 Clear Ar_SkL;
- JA01 Clear Ar_PQt;
- JA01 Clear Wk_PickQnty;
- JA01
- RS01 // ExSr Sr_WrtSkuDetl;
- RS01 ExSr Sr_WrtSkuDetlNew;
-
- EndSr;
-
- /End-Free
- ‚*-------------------------------------------------------------------*
- ‚* Write Sku Detail. *
- ‚*-------------------------------------------------------------------*
- /Free
-
- BegSr Sr_WrtSkuDetlNew;
-
- DB01 Clear Wk_PickLocn;
-
- RP_SHIPPTY = Priority_Ar(Index_Ar);
- RP_ITEMNBR = Wk_ItemNmbr;
- RP_SKUDESC = Wk_ItemDesc;
- RP_PICKNBR = MinPick#_AR(Index_Ar);
- DB05
- | *in35 = '0';
- | Ky_70p.am70trgr = phrout;
- | Ky_70p.am70item = RP_ITEMNBR;
- | chain %kds(Ky_70p:2) amax70p;
- | if %found(amax70p) and (am70prty >= 50);
- | *in35 = '1';
- DB05 endif;
- DB01
- | If RfPn_Flag = 'Y';
- | Pick#_Var = MajPick#_Ar(Index_Ar);
- | ZZ = %Lookup(Wk_ItemNmbr:Ar_PkLItem#);
- | If ZZ > 0;
- | PickLine#_Var = Ar_PkL(ZZ);
- | //ash11 If Ar_PklQty(ZZ) > OrdQty_Ar(Index_AR);
- If Ar_PklQty(ZZ) > PckQty_Ar(Index_AR);//ash11
- //ash11 BaseQty = OrdQty_Ar(Index_AR);
- | BaseQty = PckQty_Ar(Index_AR);//ash11
- | If PhPSTF = '90'; // Invoiced
- | RP_ShipQTY = BaseQty;
- | Wk_TotlShpQ += BaseQty;
- *in90 = *on;
- | EndIf;
- //ash11Ar_PklQty(ZZ) = Ar_PklQty(ZZ) - OrdQty_Ar(Index_AR);
- | Ar_PklQty(ZZ) = Ar_PklQty(ZZ) - PckQty_Ar(Index_AR);//ash11
- | Else;
- | BaseQty = Ar_PklQty(ZZ);
- | If PhPSTF = '90'; // Invoiced
- | RP_ShipQTY = BaseQty;
- | Wk_TotlShpQ += BaseQty;
- *in90 = *on;
- | EndIf;
- | Ar_PklQty(ZZ) = 0;
- | EndIf;
- | EndIf;
- | Else;
- | Pick#_Var = MinPick#_Ar(Index_Ar);
- | PickLine#_Var = PickLine#_Ar(Index_Ar);
- *in90 = *off;
- | Select;
- | When PhPSTF >= '20' and PhPSTF < '40'; // Printed
- | BaseQty = OrdQty_Ar(Index_AR);
- | When PhPSTF >= '40' and PhPSTF < '90'; // Packed
- | BaseQty = PckQty_Ar(Index_AR);
- | When PhPSTF = '90'; // Invoiced
- | BaseQty = ShpQty_Ar(Index_AR);
- | RP_ShipQTY = ShpQty_Ar(Index_AR);
- | Wk_TotlShpQ += ShpQty_Ar(Index_AR);
- *in90 = *on;
- | EndSl;
- | EndIf;
- |
- | CountShpQ = BaseQty;
- |
- | RP_ORDRQTY = OrdQty_Ar(Index_AR);
- | Wk_TotlOrdQ += OrdQty_Ar(Index_AR);
- |
- | ZZ = %Lookup(Wk_ItemNmbr:Ar_SkLItem#);
- | If ZZ = 0;
- | Wk_PickLocn ='NO LOCTN';
- | RP_SKULOCN = Wk_PickLocn;
- | Write DTL001;
- DB02
- | Exsr Substitute_SKUNew;
- DB02
- | Clear RP_PICKNBR;
- | Clear RP_ITEMNBR;
- | Clear RP_SKUDESC;
- | Clear RP_ORDRQTY;
- | Clear RP_SHIPQTY;
- | Clear RP_PICKQTY;
- | LeaveSr;
- DB01 EndIf;
- ra01 skuTotal0 = 0;
- ra01 RP_SKUTOTQ = 0;
- ra01 moreThanOne = *Off;
-
- DB01 For JJ = ZZ to YY;
-
- If In_FrstPage Or In_OverFlow;
- Clear In_FrstPage;
- Clear In_OverFlow;
- Write HDR001;
- EndIf;
-
- DB01 If Ar_SkLPick#(JJ) = Pick#_Var And
- | Ar_SkLItem#(JJ) = Wk_ItemNmbr;
- | If Ar_SkLLine#(JJ) = PickLine#_Var And
- | Ar_SkLtBPU(JJ) > 0;
- | If Ar_SkLTBPU(JJ) > CountShpQ;
- | Wk_PickLocn = %Trim(Ar_SkLZone(JJ)) +
- | %Trim(Ar_SkLAISL(JJ)) +
- | %Trim(Ar_SkLBAY(JJ)) +
- | %Trim(Ar_SkLLEVL(JJ)) +
- | %Trim(Ar_SkLPOSN(JJ));
- | RP_SKULOCN = Wk_PickLocn;
- | RP_PICKQTY = CountShpQ;
- | Ar_SkLTBPU(JJ) = Ar_SkLTBPU(JJ) - CountShpQ;
- | CountShpQ = 0;
- | Else;
- | Wk_PickLocn = %Trim(Ar_SkLZone(JJ)) +
- | %Trim(Ar_SkLAISL(JJ)) +
- | %Trim(Ar_SkLBAY(JJ)) +
- | %Trim(Ar_SkLLEVL(JJ)) +
- | %Trim(Ar_SkLPOSN(JJ));
- | RP_SKULOCN = Wk_PickLocn;
- | RP_PICKQTY = Ar_SkLTBPU(JJ);
- | CountShpQ = CountShpQ - Ar_SkLTBPU(JJ);
- | Ar_SkLTBPU(JJ) = 0;
- DB01 EndIf;
-
- ra01 skuTotal0 = RP_PICKQTY;
-
- Write DTL001;
- DB02
- | //DB08 Exsr Substitute_SKUNew;
- DB02
- ra01 //if SKU present in > one location
- ra01 if %lookUp(Wk_ItemNmbr:Ar_SkLItem#:JJ + 1) <> 0;
- ra01 RP_SKUTOTQ += skuTotal0;
- ra01 moreThanOne = *On;
- ra01 else;
- ra01 if moreThanOne;
- ra01 RP_SKUTOTQ += skuTotal0;
- ra01 write SKUTOT;
- ra01 RP_SKUTOTQ = 0;
- ra01 moreThanOne = *Off;
- ra01 endif;
- ra01 skuTotal0 = 0;
- ra01 endif;
- DB01
- | Clear RP_PICKNBR;
- | Clear RP_ITEMNBR;
- | Clear RP_SKUDESC;
- | Clear RP_ORDRQTY;
- | Clear RP_SHIPQTY;
- | Clear RP_PICKQTY;
- DB01 EndIf;
-
- DB01 Else;
- | Clear RP_PICKNBR;
- | Clear RP_ITEMNBR;
- | Clear RP_ORDRQTY;
- | Clear RP_SHIPQTY;
- | Clear RP_SHIPPTY;
- DB01 Clear RP_PICKQTY;
- DB08 Exsr Substitute_SKUNew;
- DB01 LeaveSr;
- | EndIf;
- |
- | //ash08 If CountShpQ = 0;
- ash08 If CountShpQ = 0 and (Ar_SkLLine#(JJ) = PickLine#_Var);
- | Clear RP_PICKNBR;
- | Clear RP_ITEMNBR;
- | Clear RP_ORDRQTY;
- | Clear RP_SHIPQTY;
- | Clear RP_SHIPPTY;
- DB01 Clear RP_PICKQTY;
- DB08 Exsr Substitute_SKUNew;
- DB01 LeaveSr;
- DB01 EndIf;
-
- EndFor;
- DB08 Exsr Substitute_SKUNew;
- EndSr;
-
- /End-Free
- DB02 ‚*-------------------------------------------------------------------*
- | ‚* Get Substituted SKU *
- | ‚*-------------------------------------------------------------------*
- | /Free
- |
- | BegSr Substitute_SKUNew;
- |
- | DT3_ITEM = *Blanks; // printed on report
- | DT3_ItemNbr = *Blanks; // for data fetch
- | DT3_ItemNbr = Wk_ItemNmbr;
- |
- DB02 //*DB03 C6AENB = %INT( %SUBST(PDMIS2:1:2) );
- DB03 C6AENB = %INT(%SubSt(Pick#:1:2));
- DB02 C6DCCD = '1' ;
- DB03 C6CVNB = Ordr#;
- DB02 //*DB03 C6CVNB = %SUBST(PDMIS2:3:7) ;
- |
- | Chain (C6AENB:C6DCCD:C6CVNB) MBC6RES0 ; // Order Header
- | IF %Found(MBC6RES0) ;
- |
- | Chain (C6AENB:C6DCCD:C6CVNB:DT3_ItemNbr) MBCDRESM; // Order d
- | if %found(MBCDRESM) And N_CDAALM <> *blanks;
- | DT3_ITEM = N_CDAALM;
- | endif;
- DB02
- DB08 ELSE ;
- | Chain (C6AENB:C6DCCD:C6CVNB) MBBWCPS0 ; // Order Header History
- | IF %Found(MBBWCPS0) ;
- | Chain (C6AENB:DT3_ItemNbr:C6DCCD:C6CVNB) MBGGCPS5 ; // Order d
- | if %found(MBGGCPS5) And GGABYG <> *blanks;
- | DT3_Item = GGABYG;
- | endif;
- DB08 ENDIF ;
- DB02
- | ENDIF ;
- |
- | if DT3_ITEM <> *Blanks;
- | Write DTL003;
- | endif;
- |
- | Clear DT3_ITEM ;
- |
- | EndSr;
- |
- DB02 /End-Free
- DB03 ‚*-------------------------------------------------------------------*
- | ‚* Mincron_Sub_Item *
- | ‚*-------------------------------------------------------------------*
- | /Free
- |
- | BegSr Mincron_Sub_Item;
- |
- | DT3_ItemNbr = *Blanks; // for data fetch
- | DT3_ItemNbr = Wk_ItemNmbr;
- |
- | SetLL DT3_ItemNbr ITM020PLM1; // Item substitution file
- | ReadE DT3_ItemNbr ITM020PLM1;
- | DoW NOT %EOF(ITM020PLM1);
- | If I020_RITM <> I020_BITM;
- | Chain (Wk_HdPoNo:I020_RITM) POPCDIRL3;
- | If %Found(POPCDIRL3);
- | DT3_ITEM = WfSKU;
- | LeaveSr;
- | Endif;
- | EndIf;
- | ReadE DT3_ItemNbr ITM020PLM1;
- | EndDo;
- |
- | EndSr;
- |
- DB03 /End-Free
- ash02‚*-------------------------------------------------------------------*
- | ‚* New_Mincron_Sub_Item *
- | ‚*-------------------------------------------------------------------*
- | /Free
- |
- | BegSr New_Mincron_Sub_Item;
- |
- | //ash02 Chain (C6AENB:C6DCCD:C6CVNB:DT3_ItemNbr) MBCDRESM;
- //ash04
- Wk_mis2sku = %editc(c6aenb:'X')+c6cvnb+DT3_ItemNbr;
- kk = %Lookup(Wk_mis2sku:Ar_cdsku);
- if kk > 0;
- | Chain (C6AENB:C6DCCD:C6CVNB:Ar_cdlin(kk)) MBCDRES0;
- | if %found(MBCDRES0);
- | Chain (Wk_HDPONO:s0_CDAAYJ) POLCDIR2;
- | //ash03 If %Found(POPCDIRL2); // Mincron Order
- | If %Found(POLCDIR2) and
- | s0_CDAITX <> l2_WfSKU ; // Mincron Order
- | DT3_ITEM = l2_WfSKU;
- | Endif;
- | endif;
- | endif;
- |
- | EndSr;
- |
- DB03 /End-Free
- DB03 *-------------------------------------------------------------------*
- | * Valida If Serial Number Entered is Numeric *
- | *-------------------------------------------------------------------*
- | C Sr_TestNumericBegSr
- | * -----
- | C TestN Chk_Num_Pono 30
- | C If Not *In30
- | C Eval Wk_Num_Check = *On
- | C EndIf
- | * -----
- DB03 C EndSr
- em02 **********************************************************************
- | * Subroutine CheckItemTypes *
- | **********************************************************************
- | /free
- | begsr CheckItemTypes;
- |
- | Wk_Equip = 'N';
- | Wk_Part = 'N';
- |
- | exec sql
- | declare csr1 cursor for
- | select phmis1 from phpick29 where phldno = :RP_LOADNBR
- | group by phmis1 order by phmis1;
- |
- | exec sql
- | open csr1;
- |
- | exec sql fetch csr1 into :phmis1;
- |
- | dow sqlstt = '00000';
- |
- em04 if phmis1 = 'PRT' or phmis1 = 'PDC';
- | Wk_Part = 'Y';
- | Endif;
- |
- em04 if phmis1 <> *blanks and phmis1 <> 'PRT' and phmis1 <> 'PDC';
- | Wk_Equip = 'Y';
- | Endif;
- |
- | exec sql fetch csr1 into :phmis1;
- | enddo;
- |
- | exec sql
- | close csr1;
- |
- | if Wk_Equip = 'Y' and Wk_Part = 'Y';
- | RP_MESSAGE = '(MERGE EQUIPMENT AND PARTS)';
- | endif;
- |
- | endsr;
- em02 /end-free
- ‚*-------------------------------------------------------------------*
- **********************************************************************
- NK06 C/COPY QCPYLESRC,CBCOVPR
- ‚*-------------------------------------------------------------------*
- DB01 *
- | P*--------------------------------------------------
- | P* Procedure name: declareCursor
- | P* Purpose: Declare cursor
- | P* Returns:
- | P*--------------------------------------------------
- | P declareCursor B
- | D declareCursor PI
- | C/Exec SQL
- | + Declare @C1 Cursor for
- | + Select PHRFPN, PDSTYL||PDSSFX, PHPCTL, PDMIS2, PDSTYD,
- | + PDPKLN, PDMIS1, Sum(PDPIQT), Sum(PDSHQT), Sum(PDPAKU)
- | + FROM PHPICK28 a, PDPICK00 b WHERE
- | + PHPCTL = PDPCTL and PHRFPN = :PHPCTL
- | + GROUP BY PHRFPN, PHPCTL, PDMIS2, PDSTYL||PDSSFX, PDSTYD,
- | + PDPKLN, PDMIS1
- | + ORDER BY PHRFPN, PDMIS2, PHPCTL, PDSTYL||PDSSFX
- | C/End-Exec
- | P declareCursor E
- | P*--------------------------------------------------
- | P* Procedure name: openCursor
- | P* Purpose: Open cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P OpenCursor B
- | D OpenCursor PI
- | *
- | C/Exec SQL
- | + Open @C1
- | C/End-Exec
- | P openCursor E
- | P*--------------------------------------------------
- | P* Procedure name: fetch
- | P* Purpose: fetch record from cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P fetch B
- | D fetch PI
- | *
- | C/Exec SQL
- | + Fetch @C1 into :PckOrd_DS
- | C/End-Exec
- | P fetch E
- | P*--------------------------------------------------
- | P* Procedure name: closeCursor
- | P* Purpose: Close cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P CloseCursor B
- | D CloseCursor PI
- | *
- | C/Exec SQL
- | + Close @C1
- | C/End-Exec
- | P closeCursor E
- DB01 *
- | P*--------------------------------------------------
- | P* Procedure name: declareCursor1
- | P* Purpose: Declare cursor
- | P* Returns:
- | P*--------------------------------------------------
- | P declareCursor1 B
- | D declareCursor1 PI
- | C/Exec SQL
- | + Declare @X1 Cursor for
- | + Select PHRFPN, PDSTYL||PDSSFX, PHPCTL, PDMIS2, PDSTYD,
- | + PDPKLN, PDMIS1, Sum(PDPIQT), Sum(PDSHQT), Sum(PDPAKU)
- | + FROM PHPICK28 a, PDPICK00 b WHERE
- | + PHPCTL = PDPCTL and PHPCTL = :PHPCTL
- | + GROUP BY PHRFPN, PHPCTL, PDMIS2, PDSTYL||PDSSFX, PDSTYD,
- | + PDPKLN, PDMIS1
- | + ORDER BY PHRFPN, PDMIS2, PHPCTL, PDSTYL||PDSSFX
- | C/End-Exec
- | P declareCursor1 E
- | P*--------------------------------------------------
- | P* Procedure name: openCursor1
- | P* Purpose: Open cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P OpenCursor1 B
- | D OpenCursor1 PI
- | *
- | C/Exec SQL
- | + Open @X1
- | C/End-Exec
- | P openCursor1 E
- | P*--------------------------------------------------
- | P* Procedure name: fetch1
- | P* Purpose: fetch record from cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P fetch1 B
- | D fetch1 PI
- | *
- | C/Exec SQL
- | + Fetch @X1 into :PckOrd_DS
- | C/End-Exec
- | P fetch1 E
- | P*--------------------------------------------------
- | P* Procedure name: closeCursor1
- | P* Purpose: Close cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P CloseCursor1 B
- | D CloseCursor1 PI
- | *
- | C/Exec SQL
- | + Close @X1
- | C/End-Exec
- | P closeCursor1 E
- DB01
- DB01 *
- | P*--------------------------------------------------
- | P* Procedure name: declareCursor2
- | P* Purpose: Declare cursor
- | P* Returns:
- | P*--------------------------------------------------
- | P declareCursor2 B
- | D declareCursor2 PI
- | C/Exec SQL
- | + Declare @S1 Cursor for
- | + Select CDPCTL, CDSTYL||CDSSFX, CDPKLN, CDZONE, CDAISL, CDBAY,
- | + CDLEVL, CDPOSN, Sum(CDTBPU), Sum(CDPAKU)
- | + FROM CDCART00 Where
- | + CDPCTL = :PHPCTL
- | + GROUP BY CDPCTL, CDSTYL||CDSSFX, CDPKLN, CDZONE, CDAISL,
- | + CDBAY, CDLEVL, CDPOSN
- | + ORDER BY CDPCTL, CDSTYL||CDSSFX, CDPKLN
- | C/End-Exec
- | P declareCursor2 E
- | P*--------------------------------------------------
- | P* Procedure name: openCursor2
- | P* Purpose: Open cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P OpenCursor2 B
- | D OpenCursor2 PI
- | *
- | C/Exec SQL
- | + Open @S1
- | C/End-Exec
- | P openCursor2 E
- | P*--------------------------------------------------
- | P* Procedure name: fetch2
- | P* Purpose: fetch record from cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P fetch2 B
- | D fetch2 PI
- | *
- | C/Exec SQL
- | + Fetch @S1 into :SkuLoc_DS
- | C/End-Exec
- | P fetch2 E
- | P*--------------------------------------------------
- | P* Procedure name: closeCursor2
- | P* Purpose: Close cursor
- | P* Returns:
- | P*--------------------------------------------------
- | *
- | P CloseCursor2 B
- | D CloseCursor2 PI
- | *
- | C/Exec SQL
- | + Close @S1
- | C/End-Exec
- | P closeCursor2 E
- DB01
- ‚*-------------------------------------------------------------------*
- ** Error Messages
- E - Load Number Not Found.
- I - Press F16 to Confirm.
- I - Trailer Load Summary Document Printed.
- I - No Load Entered. Please Enter Load(S).
- E - Invalid PKMS User entered
- ** AS400 Commands
- OVRPRTF FILE(GPK510CP) TOFILE(*FILE) OUTQ( ) COPIES( )
-
|
|