记录ABAP开发的日常——检验批冲销取消UD增强

前言： 在项目上遇到的需求，在QA16中增加取消UD按钮，实现UD冲销功能，在网上查阅了一些，找到一些资料，在此记录下。

用到的增强点：
CMOD:QEVA0008 用途决议：客户功能代码(例如取消 UD)
用到的NOTE:
-74638
-175842

参考链接：SAP QM取消UD方法

增强步骤：

CMOD创建项目ZMM002

1.1添加逻辑代码

"增加取消UD的处理
DATA  lv_line TYPE bsvx-sttxt.
CLEAR lv_line.

CALL FUNCTION 'STATUS_TEXT_EDIT'
  EXPORTING
    client           = sy-mandt
    objnr            = i_qals-objnr
    only_active      = 'X'
    spras            = sy-langu
  IMPORTING
    line             = lv_line
  EXCEPTIONS
    object_not_found = 1
    OTHERS           = 2.

IF lv_line CS 'UD'.
  SUBMIT zqevac40 WITH prueflos = i_qals-prueflos AND RETURN.
  WAIT UP TO '1' SECONDS.
ENDIF.

SUBMIT zrqevac50 WITH prueflos = i_qals-prueflos AND RETURN.

1.2添加取消UD按钮

1.3配置事务

事务码：OMJJ

激活项目，增强完成

2.附程序

2.1 ZQEVAC40

*&---------------------------------------------------------------------*
*& Report ZQEVAC40
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT ZQEVAC40.


TABLES sscrfields.
TABLES qals.
TABLES qave.


CONSTANTS:
c_rc_0  LIKE sy-subrc           VALUE 0,
c_rc_4  LIKE sy-subrc           VALUE 4,
c_rc_20 LIKE sy-subrc           VALUE 20,
c_kreuz LIKE qm00-qkz           VALUE 'X'.


SELECTION-SCREEN SKIP 2.
PARAMETERS prueflos  LIKE qals-prueflos MATCHCODE OBJECT qals    MEMORY ID qls .
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK SEARCH WITH FRAME.
  SELECTION-SCREEN BEGIN OF LINE.
    SELECTION-SCREEN PUSHBUTTON 3(20) TEXT-s01
    USER-COMMAND sear.
    SELECTION-SCREEN PUSHBUTTON 40(20) TEXT-s02 USER-COMMAND show.
  SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK SEARCH.


AT SELECTION-SCREEN.

IF sscrfields-ucomm EQ 'SEAR'
OR prueflos IS INITIAL.

  CALL FUNCTION 'QELA_START_SELECTION_OF_LOTS'
  EXPORTING
    i_selid          = ' '
    i_stat_aenderung = 'X'
    i_stat_ero       = 'X'
    i_stat_frei      = 'X'
    i_stat_ve        = ' '
  IMPORTING
    e_prueflos       = prueflos
  EXCEPTIONS
    no_entry         = 1
    no_selected      = 2
    OTHERS           = 3.
  IF sy-subrc <> 0.

    MESSAGE e042(znhmm01).

  ENDIF.
ENDIF.


IF sscrfields-ucomm EQ 'SHOW'.
  CALL FUNCTION 'QSS1_LOT_SHOW'
  EXPORTING
    i_prueflos = prueflos.
ENDIF.

CHECK sscrfields-ucomm EQ 'ONLI'.

* ab hier mu? Prüflosnummer gefüllt sein.
IF prueflos IS INITIAL.
  MESSAGE e164(qa).
ENDIF.

* Lesen Los
CALL FUNCTION 'ENQUEUE_EQQALS1'
EXPORTING
  prueflos = prueflos.

CALL FUNCTION 'QPSE_LOT_READ'
EXPORTING
  i_prueflos = prueflos
IMPORTING
  e_qals     = qals
EXCEPTIONS
  no_lot     = 1.

IF NOT sy-subrc IS INITIAL.
  MESSAGE e102(qa) WITH SPACE.
ENDIF.

*-----------------
* Prüfen Status
CALL FUNCTION 'QAST_STATUS_CHECK'
EXPORTING
  i_objnr          = qals-objnr
  i_status         = 'I0218' "Status VE getroffen
EXCEPTIONS
  status_not_activ = 1.

IF NOT sy-subrc IS INITIAL.
  MESSAGE e102(qv) WITH qals-prueflos.
ENDIF.

CALL FUNCTION 'QEVA_UD_READ'
EXPORTING
  i_prueflos = qals-prueflos
IMPORTING
  e_qave     = qave.

START-OF-SELECTION.
PERFORM qals_aendern.

******************************************
******************************

FORM qals_aendern.
  PERFORM status_fix_setzen USING 'I0002' c_kreuz.

  PERFORM status_fix_setzen USING 'I0216' space.

  PERFORM status_fix_setzen USING 'I0217' space.

  PERFORM status_fix_setzen USING 'I0218' space.

  CLEAR: qals-stat14.
  CLEAR: qals-stat35.
  CLEAR: qave-vauswahlmg,
  qave-vwerks,
  qave-versionam,
  qave-vcodegrp,
  qave-vcode,
  qave-vbewertung,
  qave-versioncd,
  qave-vfolgeakti,
  qave-qkennzahl.

*--... verbuchen
  CALL FUNCTION 'QEVA_UD_UPDATE' IN UPDATE
  TASK
  EXPORTING
    qals_new = qals
    qave_new = qave.

  COMMIT WORK.
  MESSAGE s101(qa) WITH qals-prueflos.
ENDFORM.


*   Setzen eines Status aufgrund von Voreinstellungen wie QMAT etc.    *
*  -->  STATUS    Status der gesetzt werden soll
*  -->  AKTIV     Status wird aktiviert sonst deaktiviert

FORM status_fix_setzen USING
      VALUE(status) LIKE tj02-istat
      VALUE(aktiv) LIKE c_kreuz.

* lokale Tabelle fuer Statusfortschreibung
  DATA: BEGIN OF l_stattab OCCURS 0.
    INCLUDE STRUCTURE jstat.
  DATA  END OF l_stattab.

* Falls Objektnr. nicht gefüllt. --> Fehlermeldung !!!
  IF qals-objnr EQ space.
    MESSAGE e013(qv).
*   Fehlende Objektnr.: Problem fü
  ENDIF.

  MOVE status TO l_stattab-stat.

  IF aktiv EQ space.
    MOVE c_kreuz TO l_stattab-inact.
  ENDIF.

  APPEND l_stattab.

  CALL FUNCTION 'STATUS_CHANGE_INTERN'
  EXPORTING
    check_only = space
    objnr      = qals-objnr
  TABLES
    status     = l_stattab.

ENDFORM.                               " STATUS_FIX_SETZEN

2.2 ZRQEVAC50

*&---------------------------------------------------------------------*
*& Report ZRQEVAC50
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT ZRQEVAC50.

"***********************************************************************
"* Report is provided by Modification Note 175842                      *
"*                                                                     *
"*  CAUTION: Please be aware that this is a Modification!              *
"*  Please refer to note 170183.                                       *
"***********************************************************************
TYPES:
t_mkpf_tab LIKE mkpf  OCCURS 0,
t_mseg_tab LIKE mseg  OCCURS 0.
PARAMETERS:
prueflos LIKE qals-prueflos OBLIGATORY MEMORY ID qls.
DATA:
      g_msgv1       LIKE sy-msgv1,
      g_qals        LIKE qals,
      g_qals_leiste LIKE qals,
      g_qamb_tab    TYPE qambtab,
      g_qamb_vb_tab TYPE qambtab,
      g_mkpf_tab    TYPE t_mkpf_tab,
      g_mseg_tab    TYPE t_mseg_tab,
      g_subrc       LIKE sy-subrc.

START-OF-SELECTION.

PERFORM enqueue_qals USING prueflos
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_qals USING prueflos
      g_qals
      g_qals_leiste
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID 'QA' TYPE 'S' NUMBER '102'
  WITH prueflos.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM check_lot USING g_qals
      g_subrc.
IF NOT g_subrc IS INITIAL.
  CASE g_subrc.
  WHEN 256.
    g_msgv1 = 'Lot & does not refer to a material doc'. "#EC NOTEXT
  WHEN 128.
    g_msgv1 = 'Material & is serialized'.               "#EC NOTEXT
    REPLACE '&' WITH g_qals-matnr INTO g_msgv1.
  WHEN  64.
    g_msgv1 = 'Lot & is not stock relevant'.            "#EC NOTEXT
  WHEN  32.
    g_msgv1 = 'Lot &: No stock transferred'.            "#EC NOTEXT
  WHEN  16.
    g_msgv1 = 'Lot & is cancelled'.                     "#EC NOTEXT
  WHEN   8.
    g_msgv1 = 'Lot & is archived'.                      "#EC NOTEXT
  WHEN   4.
    g_msgv1 = 'Lot & is blocked'.                       "#EC NOTEXT
  WHEN   2.
    g_msgv1 = 'Lot & is HU managed'.                    "#EC NOTEXT
  ENDCASE.
  REPLACE '&' WITH prueflos INTO g_msgv1.
  MESSAGE ID '00' TYPE 'S' NUMBER '208'
  WITH g_msgv1.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_qamb USING g_qals
      g_qamb_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  WITH prueflos.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_mkpf USING g_qamb_tab
      g_mkpf_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM check_mkpf USING g_mkpf_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  WITH prueflos.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_mseg USING g_mkpf_tab
      g_mseg_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM check_mseg USING g_mseg_tab
      g_qamb_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  WITH prueflos.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM create_goods_movement USING g_qals
      g_mseg_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  WITH prueflos.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM post_goods_movement.
PERFORM post_data USING g_qals
      g_qals_leiste
      g_qamb_tab
      g_qamb_vb_tab
      g_subrc.
IF NOT g_subrc IS INITIAL.
  MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ELSE.
  COMMIT WORK AND WAIT.
  g_msgv1 = 'inspection lot &'.                           "#EC NOTEXT
  REPLACE '&' WITH prueflos INTO g_msgv1.
  MESSAGE ID '00' TYPE 'S' NUMBER '368'
  WITH 'Stock posting reversed for ' g_msgv1.     "#EC NOTEXT
  SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
*----------------------------------------------------------------------*
*       Form  ENQUEUE_QALS                                             *
*----------------------------------------------------------------------*
*       Los sperren                                                    *
*----------------------------------------------------------------------*
FORM enqueue_qals USING p_prueflos LIKE qals-prueflos
      p_subrc    LIKE sy-subrc.
  CLEAR: p_subrc.
  CALL FUNCTION 'ENQUEUE_EQQALS1'
  EXPORTING
    prueflos       = p_prueflos
  EXCEPTIONS
    foreign_lock   = 1
    system_failure = 2
    OTHERS         = 3.
  p_subrc = sy-subrc.
ENDFORM.                               " ENQUEUE_QALS
*----------------------------------------------------------------------*
*       Form  READ_QALS                                                *
*----------------------------------------------------------------------*
*       Prüflos lesen                                                  *
*----------------------------------------------------------------------*
FORM read_qals USING p_prueflos    LIKE qals-prueflos
      p_qals        LIKE qals
      p_qals_leiste LIKE qals
      p_subrc       LIKE sy-subrc.
  CLEAR: p_subrc.
  CALL FUNCTION 'QPSE_LOT_READ'
  EXPORTING
    i_prueflos  = p_prueflos
    i_reset_lot = 'X'
  IMPORTING
    e_qals      = p_qals
  EXCEPTIONS
    no_lot      = 1.
  p_subrc = sy-subrc.
  IF p_subrc IS INITIAL.
    p_qals_leiste = p_qals.
  ELSE.
    CLEAR: p_qals,
    p_qals_leiste.
  ENDIF.
ENDFORM.                               " READ_QALS
*----------------------------------------------------------------------*
*       Form  CHECK_LOT                                                *
*----------------------------------------------------------------------*
*       Prüflos prüfen                                                 *
*----------------------------------------------------------------------*
FORM check_lot USING p_qals  LIKE qals
      p_subrc LIKE sy-subrc.
  DATA:
        l_stat     LIKE jstat,
        l_stat_tab LIKE jstat OCCURS 0 WITH HEADER LINE.
  p_subrc = 256.
*/No reference to material document
  IF p_qals-zeile IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 128.
  ENDIF.
*/Serialized Material
  IF NOT p_qals-sernp IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 64.
  ENDIF.
*/BERF
  CALL FUNCTION 'STATUS_CHECK'
  EXPORTING
    objnr             = p_qals-objnr
    status            = 'I0203'
  EXCEPTIONS
    status_not_active = 2.
  IF NOT sy-subrc IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 32.
  ENDIF.
*/BTEI & BEND
  CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
  l_stat-stat = 'I0219'. APPEND l_stat TO l_stat_tab. "BTEI
  l_stat-stat = 'I0220'. APPEND l_stat TO l_stat_tab. "BEND
  CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
  EXPORTING
    objnr        = p_qals-objnr
  TABLES
    status_check = l_stat_tab.
  IF l_stat_tab[] IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 16.
  ENDIF.
*/LSTO & LSTV
  CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
  l_stat-stat = 'I0224'. APPEND l_stat TO l_stat_tab. "LSTO
  l_stat-stat = 'I0232'. APPEND l_stat TO l_stat_tab. "LSTV
  CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
  EXPORTING
    objnr        = p_qals-objnr
  TABLES
    status_check = l_stat_tab.
  IF NOT l_stat_tab[] IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 8.
  ENDIF.
*/ARSP & ARCH & REO1 & REO2 & REO3
  CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
  l_stat-stat = 'I0225'. APPEND l_stat TO l_stat_tab. "ARSP
  l_stat-stat = 'I0226'. APPEND l_stat TO l_stat_tab. "ARCH
  l_stat-stat = 'I0227'. APPEND l_stat TO l_stat_tab. "REO3
  l_stat-stat = 'I0228'. APPEND l_stat TO l_stat_tab. "REO2
  l_stat-stat = 'I0229'. APPEND l_stat TO l_stat_tab. "REO1
  CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
  EXPORTING
    objnr        = p_qals-objnr
  TABLES
    status_check = l_stat_tab.
  IF NOT l_stat_tab[] IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 4.
  ENDIF.
*/SPER
  CALL FUNCTION 'STATUS_CHECK'
  EXPORTING
    objnr             = p_qals-objnr
    status            = 'I0043'
  EXCEPTIONS
    status_not_active = 2.
  IF sy-subrc IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 2.
  ENDIF.
*/HUM
  CALL FUNCTION 'STATUS_CHECK'
  EXPORTING
    objnr             = p_qals-objnr
    status            = 'I0443'
  EXCEPTIONS
    status_not_active = 2.
  IF sy-subrc IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 0.
  ENDIF.
ENDFORM.                               " CHECK_LOT
*----------------------------------------------------------------------*
*       Form  READ_QAMB                                                *
*----------------------------------------------------------------------*
*       QAMBs lesen                                                    *
*----------------------------------------------------------------------*
FORM read_qamb USING p_qals     LIKE qals
      p_qamb_tab TYPE qambtab
      p_subrc    LIKE sy-subrc.
  CLEAR: p_subrc.
  SELECT * FROM qamb INTO TABLE p_qamb_tab
  WHERE prueflos =  p_qals-prueflos
  AND typ   = '3'.
  p_subrc = sy-subrc.
ENDFORM.                               " READ_QAMB
*----------------------------------------------------------------------*
*       Form  READ_MKPF                                                *
*----------------------------------------------------------------------*
*       Read material document header                                  *
*----------------------------------------------------------------------*
FORM read_mkpf USING p_qamb_tab TYPE qambtab
      p_mkpf_tab TYPE t_mkpf_tab
      p_subrc    LIKE sy-subrc.
  DATA:
  BEGIN OF l_mkpf_key_tab OCCURS 0,
    mblnr LIKE mkpf-mblnr,
    mjahr LIKE mkpf-mjahr,
  END   OF l_mkpf_key_tab.
  DATA:
        l_qamb  LIKE qamb,
        l_mkpf  LIKE mkpf,
        l_trtyp LIKE t158-trtyp VALUE 'A',
        l_vgart LIKE t158-vgart VALUE 'WQ',
        l_xexit LIKE qm00-qkz.
  p_subrc = 4.
  LOOP AT p_qamb_tab INTO l_qamb.
    l_mkpf_key_tab-mblnr = l_qamb-mblnr.
    l_mkpf_key_tab-mjahr = l_qamb-mjahr.
    COLLECT l_mkpf_key_tab.
  ENDLOOP.
  LOOP AT l_mkpf_key_tab.
    CALL FUNCTION 'ENQUEUE_EMMKPF'
    EXPORTING
      mblnr          = l_mkpf_key_tab-mblnr
      mjahr          = l_mkpf_key_tab-mjahr
    EXCEPTIONS
      foreign_lock   = 1
      system_failure = 2
      OTHERS         = 3.
    IF NOT sy-subrc IS INITIAL.
      l_xexit = 'X'.
      EXIT.
    ENDIF.
    CLEAR: l_mkpf.
    CALL FUNCTION 'MB_READ_MATERIAL_HEADER'
    EXPORTING
      mblnr         = l_mkpf_key_tab-mblnr
      mjahr         = l_mkpf_key_tab-mjahr
      trtyp         = l_trtyp
      vgart         = l_vgart
    IMPORTING
      kopf          = l_mkpf
    EXCEPTIONS
      error_message = 1.
    IF NOT sy-subrc IS INITIAL.
      l_xexit = 'X'.
      EXIT.
    ELSE.
      APPEND l_mkpf TO p_mkpf_tab.
    ENDIF.
  ENDLOOP.
  IF NOT l_xexit IS INITIAL.
    EXIT.
  ELSE.
    p_subrc = 0.
  ENDIF.
ENDFORM.                               " READ_MKPF
*----------------------------------------------------------------------*
*       Form  READ_MSEG                                                *
*----------------------------------------------------------------------*
*       MSEGs lesen                                                    *
*----------------------------------------------------------------------*
FORM read_mseg USING p_mkpf_tab TYPE t_mkpf_tab
      p_mseg_tab TYPE t_mseg_tab
      p_subrc    LIKE sy-subrc.
  DATA:
        l_mkpf     LIKE mkpf,
        l_mseg_tab LIKE mseg OCCURS 0 WITH HEADER LINE,
        l_trtyp    LIKE t158-trtyp VALUE 'A',
        l_xexit    LIKE qm00-qkz.
  p_subrc = 4.
  LOOP AT p_mkpf_tab INTO l_mkpf.
    CLEAR: l_mseg_tab. REFRESH: l_mseg_tab.
    CALL FUNCTION 'MB_READ_MATERIAL_POSITION'
    EXPORTING
      mblnr         = l_mkpf-mblnr
      mjahr         = l_mkpf-mjahr
      trtyp         = l_trtyp
*/            ZEILB  = P_ZEILE
*/            ZEILE  = P_ZEILE
    TABLES
      seqtab        = l_mseg_tab
    EXCEPTIONS
      error_message = 1.
    IF NOT sy-subrc IS INITIAL.
      l_xexit = 'X'.
      EXIT.
    ELSE.
      APPEND LINES OF l_mseg_tab TO p_mseg_tab.
    ENDIF.
  ENDLOOP.
  IF NOT l_xexit IS INITIAL.
    EXIT.
  ELSE.
*/  XAuto-Zeilen und Chargenzustands?nderung werden gel?scht
    DELETE p_mseg_tab WHERE xauto NE space
    OR bwart EQ '341'
    OR bwart EQ '342'.
    p_subrc = 0.
  ENDIF.
ENDFORM.                               " READ_MSEG
*----------------------------------------------------------------------*
*       Form  CREATE_GOODS_MOVEMENT                                    *
*----------------------------------------------------------------------*
*       Warenbewegung anlegen                                          *
*----------------------------------------------------------------------*
FORM create_goods_movement USING p_qals     LIKE qals
      p_mseg_tab TYPE t_mseg_tab
      p_subrc    LIKE sy-subrc.
  DATA:
        l_lmengezub LIKE qals-lmengezub,
        l_lmengegeb LIKE qals-lmengezub,
        l_mbqss     LIKE mbqss,
        l_imkpf     LIKE imkpf,
        l_imseg     LIKE imseg,
        l_imseg_tab LIKE imseg OCCURS 1,
        l_emkpf     LIKE emkpf,
        l_emseg     LIKE emseg,
        l_emseg_tab LIKE emseg OCCURS 1,
        l_mseg      LIKE mseg,
        l_mseg_tab  LIKE mseg  OCCURS 1,
        l_tcode     LIKE sy-tcode VALUE 'QA11',
        l_tabix     LIKE sy-tabix VALUE 1,
        l_xstbw     LIKE t156-xstbw.
  CLEAR: p_subrc.
*/QAMB initialisieren
  CALL FUNCTION 'QAMB_REFRESH_DATA'.
*/Kopf füllen
  l_imkpf-bldat = sy-datlo.
  l_imkpf-budat = sy-datlo.
  l_imkpf-bktxt = 'Cancellation of QM UD postings'.         "#EC NOTEXT
*/Ursprüngliche zu buchende Menge merken + inkrementieren
  l_lmengezub = p_qals-lmengezub.
  l_lmengegeb =   p_qals-lmenge01
  + p_qals-lmenge02
  + p_qals-lmenge03
  + p_qals-lmenge04
  + p_qals-lmenge05
  + p_qals-lmenge06
  + p_qals-lmenge07
  + p_qals-lmenge08
  + p_qals-lmenge09.
*/Zeilen aufbauen
  l_mseg_tab[] = p_mseg_tab[].
  LOOP AT l_mseg_tab INTO l_mseg.
    MOVE-CORRESPONDING l_mseg  TO l_mbqss.
    MOVE-CORRESPONDING l_mbqss TO l_imseg.
*/  Referenzbeleg übergeben, falls Bestellnummer gefüllt
    IF NOT l_mseg-ebeln IS INITIAL.
      MOVE: l_mseg-lfbnr TO l_imseg-lfbnr,
      l_mseg-lfbja TO l_imseg-lfbja,
      l_mseg-lfpos TO l_imseg-lfpos.
    ENDIF.
    MOVE l_mseg-kdauf          TO l_imseg-kdauf.
    MOVE l_mseg-kdpos          TO l_imseg-kdpos.
    MOVE l_mseg-ps_psp_pnr     TO l_imseg-ps_psp_pnr.
*/  Umlagerungsfelder setzen
    MOVE:
    l_mseg-ummat  TO l_imseg-ummat,
    l_mseg-umwrk  TO l_imseg-umwrk,
    l_mseg-umlgo  TO l_imseg-umlgo,
    l_mseg-umcha  TO l_imseg-umcha.
*/  Storno-Beleg setzen
    MOVE: l_mseg-mjahr  TO l_imseg-sjahr,
    l_mseg-mblnr  TO l_imseg-smbln,
    l_mseg-zeile  TO l_imseg-smblp.
*/  Falsch gefüllte Felder initialisieren
    CLEAR: l_imseg-mblnr,
    l_imseg-menge,
    l_imseg-meins.
*/  Bewegungsart lesen
    SELECT SINGLE xstbw FROM t156 INTO l_xstbw
    WHERE bwart = l_imseg-bwart.
    IF NOT sy-subrc IS INITIAL.
      p_subrc = 4.
      EXIT.
    ENDIF.
*/  Werk/Lagerort füllen
    IF p_qals-stat11 IS INITIAL.
      IF l_xstbw IS INITIAL.
        MOVE p_qals-lagortvorg TO l_imseg-lgort.
      ELSE.
        MOVE p_qals-lagortvorg TO l_imseg-umlgo.
      ENDIF.
    ENDIF.
    IF l_xstbw IS INITIAL.
      MOVE p_qals-werkvorg TO l_imseg-werks.
    ELSE.
      MOVE p_qals-werkvorg TO l_imseg-umwrk.
    ENDIF.
*/  Zus?tzliche Felder
    MOVE p_qals-mengeneinh TO l_imseg-erfme.
    "MOVE P_GRUND           TO L_IMSEG-GRUND.
    "MOVE P_ELIKZ           TO L_IMSEG-ELIKZ.
*/  Kennzeichen Storno-Buchung setzen
    MOVE 'X'               TO l_imseg-xstob.
      MOVE p_qals-prueflos   TO l_imseg-qplos.
      APPEND l_imseg TO l_imseg_tab.
      IF p_qals-stat11 IS INITIAL.
        ADD      l_imseg-erfmg TO   l_lmengezub.
        SUBTRACT l_imseg-erfmg FROM l_lmengegeb.
      ELSE.
        IF     l_imseg-kzbew EQ space
        AND l_imseg-werks NE space
        AND l_imseg-lgort NE space
        AND l_imseg-umwrk NE space
        AND l_imseg-umlgo NE space
        AND l_imseg-werks EQ l_imseg-umwrk
        AND l_imseg-umlgo EQ l_imseg-umlgo.
*/      Dummy Buchung bei WE-Sperrbestand & Stichprobe
        ELSE.
          ADD      l_imseg-erfmg TO   l_lmengezub.
          SUBTRACT l_imseg-erfmg FROM l_lmengegeb.
        ENDIF.
      ENDIF.
    ENDLOOP.
    IF NOT p_qals-stat11 IS INITIAL.
*/  Bei WE-Sperrbestand und Stichprobenbuchung Zeilen tauschen
      DO.
        READ TABLE l_imseg_tab INDEX sy-INDEX INTO l_imseg.
        IF     sy-subrc      IS INITIAL
        AND l_imseg-kzbew EQ space
        AND l_imseg-werks NE space
        AND l_imseg-lgort NE space
        AND l_imseg-umwrk NE space
        AND l_imseg-umlgo NE space
        AND l_imseg-werks EQ l_imseg-umwrk
        AND l_imseg-umlgo EQ l_imseg-umlgo.
          IF sy-tabix NE l_tabix.
            DELETE l_imseg_tab INDEX sy-tabix.
            INSERT l_imseg     INTO  l_imseg_tab INDEX l_tabix.
            l_tabix = l_tabix + 1.
          ELSE.
            l_tabix = l_tabix + 1.
            CONTINUE.
          ENDIF.
      ELSEIF sy-subrc IS INITIAL.
          CONTINUE.
        ELSE.
          EXIT.                          "from do
        ENDIF.
      ENDDO.
    ENDIF.
*/QM deaktivieren
    CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
    EXPORTING
      aktiv = space.
*/Buchen
    CALL FUNCTION 'MB_CREATE_GOODS_MOVEMENT'
    EXPORTING
      imkpf = l_imkpf
      xallp = 'X'
      xallr = 'X'
      ctcod = l_tcode
      xqmcl = ' '
    IMPORTING
      emkpf = l_emkpf
    TABLES
      imseg = l_imseg_tab
      emseg = l_emseg_tab.
*/QM wieder aktivieren
    CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
    EXPORTING
      aktiv = 'X'.
*/Buchung auswerten
    IF l_emkpf-subrc GT 1.
      IF l_emkpf-msgid NE space.
*/    Fehler auf Kopfebene
        MESSAGE ID l_emkpf-msgid TYPE 'S'
        NUMBER l_emkpf-msgno
        WITH l_emkpf-msgv1 l_emkpf-msgv2
        l_emkpf-msgv3 l_emkpf-msgv4.
        SUBMIT (sy-repid) VIA SELECTION-SCREEN.
      ELSE.
*/    Fehler auf Zeilenebene (Ausgabe des ersten Fehlers)
        LOOP AT l_emseg_tab INTO l_emseg.
          IF l_emseg-msgid NE space.
            MESSAGE ID l_emseg-msgid TYPE 'S'
            NUMBER l_emseg-msgno
            WITH l_emseg-msgv1 l_emseg-msgv2
            l_emseg-msgv3 l_emseg-msgv4.
            SUBMIT (sy-repid) VIA SELECTION-SCREEN.
          ENDIF.
        ENDLOOP.
      ENDIF.
    ENDIF.
    LOOP AT l_emseg_tab INTO l_emseg.
      CALL FUNCTION 'QAMB_COLLECT_RECORD'
      EXPORTING
        lotnumber   = p_qals-prueflos
        docyear     = l_emkpf-mjahr
        docnumber   = l_emkpf-mblnr
        docposition = l_emseg-mblpo
        TYPE        = '7'.
    ENDLOOP.
*/Sonderkorrektur für Frei-An-Frei & WE-Sperr-An-We-Sperr
    IF NOT p_qals-stat11 IS INITIAL.
      IF p_qals-lmenge04 EQ l_lmengegeb.
        ADD      p_qals-lmenge04 TO   l_lmengezub.
        SUBTRACT p_qals-lmenge04 FROM l_lmengegeb.
      ENDIF.
  ELSEIF p_qals-insmk IS INITIAL.
      IF         p_qals-lmenge01 GE l_lmengegeb
      AND NOT p_qals-lmenge01 IS INITIAL.
        ADD      l_lmengegeb     TO   l_lmengezub.
        SUBTRACT l_lmengegeb     FROM l_lmengegeb.
      ENDIF.
    ENDIF.
    CLEAR: p_qals-stat34,
    p_qals-matnrneu,
    p_qals-chargneu,
    p_qals-lmenge01,
    p_qals-lmenge02,
    p_qals-lmenge03,
    p_qals-lmenge04,
    p_qals-lmenge05,
    p_qals-lmenge06,
    p_qals-lmenge07,
    p_qals-lmenge08,
    p_qals-lmenge09.
    p_qals-lmengezub = l_lmengezub.
    IF NOT l_lmengegeb IS INITIAL.
      p_subrc = 4.
    ENDIF.
  ENDFORM.                               " CREATE_GOODS_MOVEMENT
*----------------------------------------------------------------------*
*       Form  POST_GOODS_MOVEMENT                                      *
*----------------------------------------------------------------------*
*       Warenbewegung buchen                                           *
*----------------------------------------------------------------------*
  FORM post_goods_movement.
    CALL FUNCTION 'MB_POST_GOODS_MOVEMENT'.
  ENDFORM.                               " POST_GOODS_MOVEMENT
*----------------------------------------------------------------------*
*       Form  POST_DATA                                                *
*----------------------------------------------------------------------*
*       QM-Daten verbuchen                                             *
*----------------------------------------------------------------------*
  FORM post_data USING p_qals        LIKE qals
        p_qals_leiste LIKE qals
        p_qamb_tab    TYPE qambtab
        p_qamb_vb_tab TYPE qambtab
        p_subrc       LIKE sy-subrc.
    DATA:
          l_stat     LIKE jstat,
          l_stat_tab LIKE jstat OCCURS 0,
          l_qamb     LIKE qamb,
          l_updkz    LIKE qalsvb-upsl VALUE 'U'.
*/QAMBs umsetzen (7 = VE-Buchung storniert)
    LOOP AT p_qamb_tab INTO l_qamb.
      l_qamb-typ = '7'.
      APPEND l_qamb TO p_qamb_vb_tab.
    ENDLOOP.
*/BERF & BTEI zurücknehmen
    CLEAR l_stat. CLEAR l_stat_tab.
    l_stat-inact = 'X'.
    l_stat-stat = 'I0219'. APPEND l_stat TO l_stat_tab. "BTEI
    l_stat-stat = 'I0220'. APPEND l_stat TO l_stat_tab. "BEND
    CALL FUNCTION 'STATUS_CHANGE_INTERN'
    EXPORTING
      objnr         = p_qals-objnr
    TABLES
      status        = l_stat_tab
    EXCEPTIONS
      error_message = 1.
    IF sy-subrc <> 0.
      MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
      WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
      SUBMIT (sy-repid) VIA SELECTION-SCREEN.
    ENDIF.
*/Prüflos aktualisieren
    CALL FUNCTION 'QPL1_UPDATE_MEMORY'
    EXPORTING
      i_qals  = p_qals
      i_updkz = l_updkz.
    CALL FUNCTION 'QPL1_INSPECTION_LOTS_POSTING'
    EXPORTING
      i_mode = '1'.
    CALL FUNCTION 'STATUS_UPDATE_ON_COMMIT'.
*/QAMB initialisieren
    CALL FUNCTION 'QAMB_REFRESH_DATA'.
    PERFORM update_qamb ON COMMIT.
    p_subrc = 0.
  ENDFORM.                               " POST_DATA
*----------------------------------------------------------------------*
*       Form  UPDATE_QAMB                                              *
*----------------------------------------------------------------------*
*       Update auf QAMB                                                *
*----------------------------------------------------------------------*
  FORM update_qamb.
    CALL FUNCTION 'QEVA_QAMB_CANCEL' IN UPDATE TASK
    EXPORTING
      t_qamb_tab = g_qamb_vb_tab.
  ENDFORM.                               " UPDATE_QAMB
*----------------------------------------------------------------------*
*       Form  CHECK_MSEG                                               *
*----------------------------------------------------------------------*
*       MSEGs prüfen                                                   *
*----------------------------------------------------------------------*
  FORM check_mseg USING p_mseg_tab TYPE t_mseg_tab
        p_qamb_tab TYPE qambtab
        p_subrc    LIKE sy-subrc.
    DATA:
          l_mseg_stor_tab LIKE mseg OCCURS 0 WITH HEADER LINE.
    CLEAR: p_subrc.
    IF p_mseg_tab[] IS NOT INITIAL.

*/Zeilen bereits storniert?
      SELECT mblnr mjahr zeile smbln sjahr smblp
      FROM mseg INTO CORRESPONDING FIELDS OF TABLE l_mseg_stor_tab
      FOR ALL ENTRIES IN p_mseg_tab
      WHERE smbln EQ p_mseg_tab-mblnr
      AND sjahr EQ p_mseg_tab-mjahr
      AND smblp EQ p_mseg_tab-zeile.
    ENDIF.
    IF sy-subrc IS INITIAL.
      LOOP AT l_mseg_stor_tab.
        DELETE p_mseg_tab WHERE     mblnr = l_mseg_stor_tab-smbln
        AND mjahr = l_mseg_stor_tab-sjahr
        AND zeile = l_mseg_stor_tab-smblp.
        DELETE p_qamb_tab WHERE     mblnr = l_mseg_stor_tab-smbln
        AND mjahr = l_mseg_stor_tab-sjahr
        AND zeile = l_mseg_stor_tab-smblp.
      ENDLOOP.
      IF p_mseg_tab[] IS INITIAL.
        p_subrc = 4.
        EXIT.
      ENDIF.
    ENDIF.
  ENDFORM.                               " CHECK_MSEG
*----------------------------------------------------------------------*
*       Form  CHECK_MKPF                                               *
*----------------------------------------------------------------------*
*       Materialbelege prüfen (Wurde durch VE-Buchung Prüfllos erzeugt?*
*----------------------------------------------------------------------*
  FORM check_mkpf USING p_mkpf_tab TYPE t_mkpf_tab
        p_subrc    LIKE sy-subrc.
    DATA:
          l_mkpf_tab TYPE t_mkpf_tab.
    CLEAR: p_subrc.
    IF p_mkpf_tab[] IS NOT INITIAL.
      SELECT mblnr FROM qamb INTO CORRESPONDING FIELDS OF TABLE l_mkpf_tab
      FOR ALL ENTRIES IN p_mkpf_tab
      WHERE mblnr EQ p_mkpf_tab-mblnr
      AND mjahr EQ p_mkpf_tab-mjahr
      AND typ   = '1'.
    ENDIF.
    IF sy-subrc IS INITIAL.
      p_subrc = 4.
    ENDIF.
  ENDFORM.                               " CHECK_MKPF