ZCMM01-17

最新推荐文章于 2025-09-23 09:05:35 发布

转载最新推荐文章于 2025-09-23 09:05:35 发布 · 101 阅读

*------------------------------------------------------
*       FORM. GET_ORDER_COMPONENTS
*
*------------------------------------------------------
*       ........
*
*--------------------------------------------------------
FORM. GET_ORDER_COMPONENTS.
* DATA: BEGIN OF resbtab OCCURS 0, mark by ariel at 100424
*        matnr LIKE resb-matnr,
*        werks LIKE resb-werks,
*        lgort LIKE resb-lgort,
*        charg LIKE resb-charg,
*        meins LIKE resb-meins,
*        erfmg LIKE resb-erfmg,
*        enmng LIKE resb-enmng,"Add for 'H' 20100424
*        rsnum LIKE resb-rsnum,
*        rspos LIKE resb-rspos,
*        shkzg LIKE resb-shkzg,"ariel20090730.add
*        alpgr LIKE zcm04-alpgr,"Yuan-Yuan 20091029 add
*        ewahr LIKE resb-ewahr,"Yuan-Yuan 20091030 add
*        zalpgr LIKE zcm04-zalpgr,"Ariel add 100412
* END OF resbtab.
*Yuan-Yuan 20091029 add.sn
DATA: L_STLNR LIKE RESB-STLNR.
DATA: L_ALPGR LIKE RESB-ALPGR.
DATA: P_ALPGR LIKE ZCM04-ALPGR.
DATA: L_VALUE LIKE ZMM048-VALUE.
* data: l_count type i.
*Yuan-Yuan 20091029 add.en
DATA: L_SOBSL LIKE MARC-SOBSL.
DATA: L_DISPO LIKE MARC-DISPO.
DATA: L_MRPGRP LIKE ZPCEMM002-GROUPCODE .
**LBG20080505.add.sn
DATA: C_MPQCNT TYPE C.
DATA: L_MPQCNT2 TYPE I.
DATA: L_MPQ TYPE I.
DATA: L_MPQCNT TYPE I.
DATA: L_QPA TYPE I.
DATA: L_DIFF LIKE RESB-ERFMG.
**lbg20080505.add.en
DATA: L_CHARG LIKE ZCM04-CHARG. "echo20090806.add
DATA: L_ECODE LIKE SY-SUBRC. "echo20090806.add
DATA: F_RESULT LIKE RESB-ERFMG.
DATA: I_RESULT TYPE I.
DATA: L_REQUIREQTY LIKE RESB-ERFMG.
DATA: L_CTRL(13) TYPE C.
DATA: DEL_FLAG."Yuan-Yuan add 20091026
CLEAR:L_STLNR,L_ALPGR,P_ALPGR,L_VALUE."Yuan-Yuan 20091029 add
*"Ariel add 100424.sn
CLEAR RESBTAB.
CLEAR RESBTAB[].
*"Ariel add 100424.en
CHECK NOT ZCM03-AUFNR IS INITIAL.
*Echo.add.100619.sn
IF ZCM03-DOCTYPE = 'K'.
    PERFORM. READ_WO.
    EXIT.
ENDIF.
*Echo.add.100619.en
SELECT SINGLE RSNUM GAMNG GMEIN FEVOR"Yuan-Yuan add 'fevor' 20091123
INTO CORRESPONDING FIELDS OF
AFKO
FROM AFKO WHERE AUFNR EQ ZCM03-AUFNR.

IF SY-SUBRC = 0 .
*      exit.
ELSE.
    SELECT SINGLE PLNUM GSMNG MEINS RSNUM
    INTO CORRESPONDING FIELDS OF PLAF
    FROM PLAF
    WHERE PLNUM = ZCM03-AUFNR+2(10) .
*      exit.
ENDIF.
CHECK SY-SUBRC EQ 0.

CASE ZCM03-DOCTYPE.
    WHEN '1' OR '2' OR '13' OR 'A' OR 'H'."Ariel20090730.add A
      IF AFKO-GAMNG IS INITIAL .
        WRITE PLAF-GSMNG TO MAXPRODUCTQTY UNIT PLAF-MEINS.
        CONDENSE MAXPRODUCTQTY NO-GAPS.
        CONCATENATE '( Order qty:' MAXPRODUCTQTY PLAF-MEINS ')'
        INTO MAXPRODUCTQTY SEPARATED BY SPACE.
      ELSE.
        WRITE AFKO-GAMNG TO MAXPRODUCTQTY UNIT AFKO-GMEIN.
        CONDENSE MAXPRODUCTQTY NO-GAPS.
        CONCATENATE '( Order qty:' MAXPRODUCTQTY AFKO-GMEIN ')'
        INTO MAXPRODUCTQTY SEPARATED BY SPACE.
      ENDIF.
      CALL SCREEN 4000 STARTING AT 18 7.
    WHEN '9'.
      CALL SCREEN 6000 STARTING AT 18 7.
ENDCASE.
IF ZCM03-DOCTYPE = 'H' AND
    ZCM03-ENMNG <> AFKO-GAMNG.
    MESSAGE E000 WITH 'Requirement Qty Error!'.
ENDIF.
IF ZCM03-DOCTYPE = '9'.
    PERFORM. EXPLORE_BOM.
    EXIT.
ENDIF.

IF G_SLOC = '1' OR G_SLOC = '' OR G_SLOC = 'A'.
*Yuan-Yuan add 20091026.sn
    DEL_FLAG = 'X'.
    LOOP AT IT_MATNR.
      IF NOT IT_MATNR-LOW IS INITIAL.
        DEL_FLAG = ''.
        EXIT.
      ENDIF.
    ENDLOOP.
    IF DEL_FLAG = 'X'.
      REFRESH IT_MATNR.
    ENDIF.
*Yuan-Yuan add 20091026.en
    IF AFKO-GAMNG IS INITIAL .
*Elven20070304 get all components without backflush/deleted ones
*add SHKZG and Doctype'A' for all sql select from RESB Ariel090730    .
      SELECT MATNR WERKS LGORT BDMNG ENMNG MEINS CHARG REVLV
      RSNUM RSPOS SHKZG ALPOS
      STLNR ALPGR EWAHR"Yuan-Yuan 20091029 add
      INTO CORRESPONDING FIELDS OF RESB
      FROM RESB WHERE RSNUM EQ PLAF-RSNUM
      AND PLNUM EQ PLAF-PLNUM
      AND RGEKZ NE 'X' AND XLOEK NE 'X'
      AND SCHGT NE 'X' AND DUMPS NE 'X'
      AND XWAOK EQ 'X'
*Yuan-Yuan add 20091026.sn
      AND MATNR IN IT_MATNR
      ORDER BY STLNR ALPGR.
*Yuan-Yuan add 20091026.en

        IF RESB-WERKS CS 'PD' AND RESB-BDMNG = 0.
          CONTINUE.
        ENDIF.
        IF ZCM03-DOCTYPE <> 'H'.
*kelly 20100420 modify .sn
          IF ( RESB-WERKS = 'PSK1' OR RESB-WERKS = 'PSC2' ).
            IF ZCM03-DOCTYPE <> '2'.
              IF RESB-BDMNG = 0 AND RESB-ALPOS <> 'X'.
                CONTINUE.
              ENDIF.
            ELSE.
              IF RESB-ENMNG = 0.
                CONTINUE.
              ENDIF.
            ENDIF.
          ELSE. "non npd plant
            IF RESB-BDMNG = 0 AND RESB-ALPOS <> 'X'.
              CONTINUE.
            ENDIF.
          ENDIF.
*kelly 20100420 modify .en
        ENDIF.