SAP QA11 检验决策并过帐 BAPI

在对检验批做决策时可以使用BAPI:BAPI_INSPLOT_SETUSAGEDECISION。此BAPI 其实也可以过帐，但不能针对不同的类型过帐，比如有部分数量进入非限制库存，有部分数量进入冻结库存，有部分数量要退货等，只能是一次性对所有数量进行非限制库存过帐。

BAPI调用如下：

DATA ud_data LIKE bapi2045ud.
DATA:ud_return_data  LIKE  bapi2045ud_return,
     stock_data      LIKE  bapi2045d_il2,
     ls_return       LIKE  bapireturn1.

data re_subrc type sy-subrc.

data it_return like table of bapiret2 .

  ud_data-insplot = p_inslot.
  ud_data-ud_code = '2'.
  ud_data-ud_plant = '6000'.
  ud_data-ud_code_group = 'Z1'.
  ud_data-ud_selected_set = 'Z1'.
*  ud_data-ud_stock_posting = 'X'.  "是否进行过帐

  CALL FUNCTION 'BAPI_INSPLOT_SETUSAGEDECISION'
    EXPORTING
      number         = p_inslot
      ud_data        = ud_data
*     LANGUAGE       =
    IMPORTING
      ud_return_data = ud_return_data
      stock_data     = stock_data
      return         = ls_return
* TABLES
*     SYSTEM_STATUS  =
*     USER_STATUS    =

如果传入参数ud_data-ud_stock_posting = 'X' 要过帐时，当过帐遇到错误时，并不能知道具体是什么错误，BAPI 返回的是类似“过帐错误，需要手动过帐"的提示，所以用此BAPI 过帐完全不理想。

经过研究，过帐可以如下处理：(经测试过帐成功，库存处理成功，但是否还有其它隐藏问题，需要进一步验证)

  TABLES:qals.

  FIELD-SYMBOLS <f_rqeva> TYPE rqeva.
  FIELD-SYMBOLS <f_qals> TYPE qals.
  DATA ls_qals LIKE qals.
  data ls_zubmg like rqevb.

data :re_mblnr type mblnr,

re_mjahr type mjahr.

DATA:  g_prottab LIKE rqevp OCCURS 9.
DATA: c_rc00    LIKE sy-subrc         VALUE 0,
      c_rc01    LIKE sy-subrc         VALUE 1,
      c_rc02    LIKE c_rc00           VALUE 2,
      c_rc03    LIKE c_rc00           VALUE 3,
      c_rc04    LIKE c_rc00           VALUE 4,
      c_rc08    LIKE c_rc00           VALUE 8,
      c_rc10    LIKE c_rc00           VALUE 10,
      c_rc11    LIKE c_rc00           VALUE 11,
      c_rc12    LIKE c_rc00           VALUE 12,
      c_rc13    LIKE c_rc00           VALUE 13,
      c_rc14    LIKE c_rc00           VALUE 14,
      c_rc15    LIKE c_rc00           VALUE 15,
      c_rc18    LIKE c_rc00           VALUE 18,

      ci_0      TYPE i                VALUE 0,
      ci_1      TYPE i                VALUE 1,
      ci_2      TYPE i                VALUE 2,
      ci_3      TYPE i                VALUE 3,
      ci_4      TYPE i                VALUE 4,
      ci_5      TYPE i                VALUE 5,
      ci_6      TYPE i                VALUE 6,
      ci_7      TYPE i                VALUE 7,
      ci_8      TYPE i                VALUE 8,
      ci_9      TYPE i                VALUE 9,
      ci99      TYPE i                VALUE 99,
      c_kreuz   LIKE qm00-qkz         VALUE 'X',
      hk_wefert LIKE qals-herkunft       VALUE '04'.

DATA  g_qbefu_classif LIKE qbefu.                             "note 1724424

 if ls_return-type = 'E' or ls_return-type = 'A'.
     re_subrc = 4.
     MOVE-CORRESPONDING ls_return TO it_return.
     APPEND it_return.
     EXIT.

  endif.

* 以上BAPI 会调用QA11 事务码对应的主程序 SAPMQEVA, 接下来需要获取 程序 sapmqeva 中的全局变量
  ASSIGN ('(SAPMQEVA)RQEVA') TO <f_rqeva>.
  IF NOT <f_rqeva> IS ASSIGNED.
    re_subrc = 4.
    PERFORM append_message TABLES it_return USING 'E' 'Z001' '001' `ASSIGN ('(SAPMQEVA)RQEVA') TO <f_rqeva> 错误！`.
    EXIT.
  ENDIF.

  ASSIGN ('(SAPMQEVA)QALS') TO <f_qals>.
  IF  <f_qals> IS ASSIGNED.
     ls_qals = <f_qals>.
  ELSE.
    re_subrc = 4.
    PERFORM append_message TABLES it_return USING 'E' 'Z001' '001' `AASSIGN ('(SAPMQEVA)QALS') TO <f_qals> 错误！`.
    EXIT.
  ENDIF.
 

SELECT SINGLE *
    FROM qals
    WHERE prueflos = i_header-prueflos.

* 执行检验库存过帐
  PERFORM ud_goodsmvt_post TABLES it_return
                            USING i_header   "自定义结构，包含决策码等，如上图1
                                  is_goodsmvt   "自定义结构，包含工厂，各种需要过帐的数量如上图2
                                  ls_qals
                                  <f_rqeva>
                         CHANGING re_subrc re_mblnr re_mjahr.

if re_subrc = 0.

COMMIT WORK AND WAIT.

endif.
*--------------------------------------------------------------------*
* 执行检验库存过帐
FORM ud_goodsmvt_post TABLES it_return STRUCTURE bapiret2
                      USING i_header  STRUCTURE zmes_post_header
                            is_goodsmvt STRUCTURE zmes_post_item
                            is_qals     STRUCTURE qals
                            is_rqeva    STRUCTURE rqeva
                     CHANGING re_subrc re_mblnr re_mjahr.

  DATA lt_mseg LIKE STANDARD TABLE OF imseg WITH HEADER LINE.
  DATA et_mseg LIKE STANDARD TABLE OF emseg WITH HEADER LINE.
  DATA imkpf LIKE imkpf.
  DATA emkpf LIKE emkpf.
  DATA es_mkpf LIKE mkpf.

  DATA: BEGIN OF ls_gebmg.
      INCLUDE STRUCTURE rqevb.
  DATA: END OF ls_gebmg.
  DATA:  lt_prottab LIKE rqevp OCCURS 9 with header line.

  data is_zubmg type rqevb.
  MOVE-CORRESPONDING is_goodsmvt to is_zubmg.

  "过帐抬头数据
  IF i_header-budat IS INITIAL.
    imkpf-budat = sy-datum.
  ELSE.
    imkpf-budat = i_header-budat.
  ENDIF.
  imkpf-bktxt = i_header-bktxt.

  PERFORM get_tqss1 USING is_qals-werk.

  "各数量过帐的库存地点
  PERFORM move_qlgo USING is_rqeva is_goodsmvt.

  "参照 QA11 的包含程序 MQEVAF12 中的 form buche_bestaende 部分代码
  "根据 ls_zubmg 不同数量字段 确定 移动类型,物料凭证项目

"其实 MQEVAF12 中的 form buche_bestaende 中已有过帐代码 ，但是过帐中如果产生错误，错误信息被以下语句转移为

"过帐检验批 & 时出错，要求手动处理，外部调用程序不能获取具体是什么错误，只有在QA11前台才能知道。因此以下form 复制

" MQEVAF12 中的 form buche_bestaende  中的代码，去掉 过帐部分.

"      IF rqautoud-modus_ud CA 'ABDFG'.   "Dialog nicht möglich !

 "       MESSAGE e054 WITH qals-prueflos.
"      ENDIF.

    PERFORM buche_bestaende TABLES lt_mseg lt_prottab
                           USING is_qals
                                 is_zubmg
                                 tqss1-lgortrlage
                                 tqss1-kostlschr
                                 tqss1-kostlzerst
                                 is_rqeva
                                 9             "对应 is_zubmg 中 9 个字段
                       CHANGING
                                 ls_gebmg
                                 re_subrc.
  IF re_subrc <> 0.
    loop at lt_prottab.
       PERFORM store_message TABLES it_return
                              USING lt_prottab-msgty lt_prottab-msgid lt_prottab-msgno
                                    lt_prottab-msgv1 lt_prottab-msgv2 lt_prottab-msgv3 lt_prottab-msgv4 .
    ENDLOOP.
    EXIT.
  ENDIF.

  IF lt_mseg[] IS INITIAL.
    re_subrc = 4.
    PERFORM append_message TABLES it_return USING 'E' 'Z001' '001' '确定移动类型错误！'.
    EXIT.

  ENDIF.

  CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
    EXPORTING
      aktiv = space. "必须调用此function，否则会提示 不允许QM的凭证过帐

  CALL FUNCTION 'MB_CREATE_GOODS_MOVEMENT'
    EXPORTING
      imkpf   = imkpf
      xallp   = 'X'
      xallb   = 'X'
      xallr   = 'X'
      ctcod   = 'QA11'
    IMPORTING
      emkpf   = emkpf
      es_mkpf = es_mkpf
    TABLES
      emseg   = et_mseg
      imseg   = lt_mseg    .
  CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
    EXPORTING
      aktiv = 'X'.

  IF emkpf-subrc > 1.  "大于1 是错误
    re_subrc = 4.
    if emkpf-msgid is not INITIAL.
        MESSAGE ID emkpf-msgid TYPE 'E' NUMBER emkpf-msgno
           WITH emkpf-msgv1  emkpf-msgv2 emkpf-msgv3 emkpf-msgv4
           INTO it_return-message.
        it_return-type = 'E'.
        it_return-id = emkpf-msgid.
        it_return-number = emkpf-msgno.
        it_return-message_v1 = emkpf-msgv1.
        it_return-message_v2 = emkpf-msgv2.
        it_return-message_v3 = emkpf-msgv3.
        it_return-message_v4 = emkpf-msgv4.
        APPEND it_return.
    else.
       PERFORM append_message TABLES it_return USING 'E' 'Z001' '001' '检验批过帐错误!'.
    endif.
  ENDIF.

  LOOP AT et_mseg WHERE msgty = 'E' OR msgty = 'A'.
    re_subrc = 4.
    MESSAGE ID et_mseg-msgid TYPE 'I' NUMBER et_mseg-msgno
       WITH et_mseg-msgv1  et_mseg-msgv2 et_mseg-msgv3 et_mseg-msgv4
       INTO it_return-message.
    it_return-type = 'E'.
    it_return-id = et_mseg-msgid.
    it_return-number = et_mseg-msgno.
    it_return-message_v1 = et_mseg-msgv1.
    it_return-message_v2 = et_mseg-msgv2.
    it_return-message_v3 = et_mseg-msgv3.
    it_return-message_v4 = et_mseg-msgv4.
    APPEND it_return.

  ENDLOOP.
  IF re_subrc <> 0.
     EXIT.
  ENDIF.
  "汇总物料凭证到表 QAMB
  LOOP AT et_mseg.
    CALL FUNCTION 'QAMB_COLLECT_RECORD'
      EXPORTING
        lotnumber   = i_header-prueflos
        docyear     = es_mkpf-mjahr
        docnumber   = es_mkpf-mblnr
        docposition = et_mseg-mblpo
        type        = '3'.
  ENDLOOP.
  "过帐物料凭证
  DATA ps_emkpf LIKE emkpf.
  CALL FUNCTION 'MB_POST_GOODS_MOVEMENT'
    IMPORTING
      emkpf  = ps_emkpf
    EXCEPTIONS
      OTHERS = 9.
   IF ps_emkpf-subrc <> 0 or sy-subrc <> 0.
      re_subrc = 4.
      PERFORM append_message TABLES it_return USING 'E' 'Z001' '001' 'MB_POST_GOODS_MOVEMENT 过帐失败！'.
      exit.
   ENDIF.
  "更新检验批状态
  PERFORM inslot_status_change.
  IF sy-subrc <> 0.
    re_subrc = 4.
    PERFORM append_message TABLES it_return USING 'E' 'Z001' '001' '检验批状态更新失败！'.
    exit.
  ENDIF.

  re_mblnr = es_mkpf-mblnr.
  re_mjahr = es_mkpf-mjahr.

ENDFORM.
*--------------------------------------------------------------------*
FORM get_tqss1 USING i_werk.
  CLEAR tqss1.
  SELECT SINGLE *
    FROM  tqss1
    WHERE  werks = i_werk .

ENDFORM.
*--------------------------------------------------------------------*
FORM move_qlgo USING vs_rqeva STRUCTURE rqeva
                     vs_goodsmvt STRUCTURE zmes_post_item.
   IF vs_goodsmvt-qlgo_vm01 <> ''.
    vs_rqeva-qlgo_vm01 = vs_goodsmvt-qlgo_vm01.
  ENDIF.
  IF vs_goodsmvt-qlgo_vm03 <> ''.
    vs_rqeva-qlgo_vm03 = vs_goodsmvt-qlgo_vm03.
  ENDIF.
  IF vs_goodsmvt-qlgo_vm04 <> ''.
    vs_rqeva-qlgo_vm04 = vs_goodsmvt-qlgo_vm04.
  ENDIF.
  IF vs_goodsmvt-qlgo_vm06 <> ''.
    vs_rqeva-qlgo_vm06 = vs_goodsmvt-qlgo_vm06.
  ENDIF.
  IF vs_goodsmvt-qlgo_vm08 <> ''.
    vs_rqeva-qlgo_vm08 = vs_goodsmvt-qlgo_vm08.
  ENDIF.

endform.
*--------------------------------------------------------------------*
FORM buche_bestaende  TABLES l_imtab STRUCTURE imseg
                             p_prottab STRUCTURE rqevp
                      USING  VALUE(i_qals)  LIKE qals
                            VALUE(i_zubmg) LIKE rqevb
                            VALUE(i_lgo05) LIKE tqss1-lgortrlage
                            VALUE(i_kst02) LIKE qals-kostl
                            VALUE(i_kst03) LIKE qals-kostl
                            VALUE(p_rqeva) LIKE rqeva
                            VALUE(i_anz_mg_felder) TYPE i
                   CHANGING e_gebmg  LIKE rqevb
                            e_subrc  LIKE sy-subrc.

  DATA: BEGIN OF l_idx_tab OCCURS 0,
          index LIKE sy-index,
        END OF l_idx_tab,
        l_p_qbefutab_tfill   LIKE sy-tfill,
        l_lauf_menge         LIKE rqevb-vmenge01,
        l_lauf_meng1         LIKE rqevb-vmenge01,
        l_gebu_menge         LIKE rqevb-vmenge01,
        l_menge_char(20),              "Hilfsfeld für Message
        l_tabix              LIKE sy-tabix,
        l_qbefu_index        LIKE sy-index,
        l_qbefu_subrc        LIKE sy-subrc,
        l_prottab_wa         LIKE rqevp,
        l_qbefu              LIKE qbefu,
        l_imkpf              LIKE imkpf,
        l_emkpf              LIKE emkpf,
        l_imtab_wa           LIKE imseg,
        l_emtab_wa           LIKE emseg,
*        l_imtab                LIKE imseg OCCURS 9,
*        l_emtab                LIKE emseg OCCURS 9,
        l_prottab            LIKE rqevp OCCURS 9,
        l_index_emseg        LIKE sy-index,
        l_zimseg             LIKE imseg,
        l_zimsegtab          LIKE imseg OCCURS 1,
        l_zimsegtab_lines    LIKE sy-tfill,
        l_lgort              LIKE qbefu-lgort,
        l_lgtyp              LIKE qbefu-lgtyp_sp,
        l_lgpla              LIKE qbefu-lgpla_sp,
        l_lgpla_             LIKE lagp-lgpla,
        l_t156               LIKE t156,
        l_serial_vb_aktiv(1),
        l_t377               LIKE t377,
        l_qfserhd            LIKE qfserhd,
        l_zaehler_fuer_ta    LIKE sy-index .    "Autom. TA prüfen
  DATA: l_sub_ekpo TYPE ekpo.                                 "RZ1566120 "{ ENHO ADSUB_MQEVAF12 IS-AD-SUC AD_SUB }



  "{ Begin ENHO /SAPMP/PIECEBATCH_MQEVAF12 IS-MP-MM /SAPMP/SINGLE_UNIT_BATCH }
  DATA: lv_kzdch TYPE tcuch-kzdch,                          "1114076
        ls_mcha  TYPE mcha,
        ls_mch1  TYPE mch1.
  "{ End ENHO /SAPMP/PIECEBATCH_MQEVAF12 IS-MP-MM /SAPMP/SINGLE_UNIT_BATCH }

*----------------------------------------------------------------------*
* Initialisierung
  e_subrc = c_rc00.
*----------------------------------------------------------------------*
* Abarbeitung der Mengenfelder
  DO i_anz_mg_felder TIMES
     VARYING l_lauf_menge FROM i_zubmg-vmenge01
                          NEXT i_zubmg-vmenge02.
    CLEAR l_imtab_wa.
    MOVE sy-index TO l_idx_tab-index.
*
    CHECK NOT l_lauf_menge IS INITIAL.
*   it has to be checked, if stock-posting would be completed
    ADD l_lauf_menge TO l_gebu_menge.
*   Bewegungsart nachlesen, wenn Tabelleneintrag nicht vorhanden
    PERFORM hole_bwart(sapmqeva) USING    l_idx_tab-index
                                i_qals-insmk
                                i_qals-stat11
                                i_qals-herkunft
                       CHANGING l_imtab_wa-bwart.
    CHECK NOT l_imtab_wa-bwart IS INITIAL.
*   Ermittle Storno-Bewegungsarten
    PERFORM lese_t156(sapmqeva) USING l_imtab_wa-bwart
                   CHANGING l_t156.
    IF l_t156-kzgru = '+'.
*     Grund für Bewegungsart notwendig
      MOVE '0001' TO l_imtab_wa-grund.
    ENDIF.
*
*   Workarea füllen
    MOVE: i_qals-matnr           TO l_imtab_wa-matnr,
          i_qals-werkvorg        TO l_imtab_wa-werks,
          i_qals-lagortvorg      TO l_imtab_wa-lgort,
          i_qals-charg           TO l_imtab_wa-charg,
          i_qals-sobkz           TO l_imtab_wa-sobkz,
          i_qals-lifnr           TO l_imtab_wa-lifnr,
          l_lauf_menge           TO l_imtab_wa-erfmg,
          i_qals-mengeneinh      TO l_imtab_wa-erfme,
          i_qals-werkvorg        TO l_imtab_wa-umwrk,
          i_qals-kostl           TO l_imtab_wa-kostl,
          i_qals-aufnr           TO l_imtab_wa-aufnr,
          i_qals-aufps           TO l_imtab_wa-aufps,
          i_qals-anln1           TO l_imtab_wa-anln1,
          i_qals-anln2           TO l_imtab_wa-anln2,
          i_qals-ps_psp_pnr      TO l_imtab_wa-mat_pspnr,
          i_qals-nplnr           TO l_imtab_wa-nplnr,
          i_qals-aplzl           TO l_imtab_wa-aplzl,
          i_qals-kunnr           TO l_imtab_wa-kunnr,
          i_qals-kdauf           TO l_imtab_wa-mat_kdauf,
          i_qals-kdpos           TO l_imtab_wa-mat_kdpos,
          i_qals-imkey           TO l_imtab_wa-imkey,
*          i_qals-dabrz           to l_imtab_wa-dabrz,
          i_qals-kstrg           TO l_imtab_wa-kstrg,
          i_qals-paobjnr         TO l_imtab_wa-paobjnr,
          i_qals-prctr           TO l_imtab_wa-prctr,
          i_qals-gsber           TO l_imtab_wa-gsber,
          i_qals-prueflos        TO l_imtab_wa-qploa,
          i_qals-ebeln           TO l_imtab_wa-ebeln,
          i_qals-ebelp           TO l_imtab_wa-ebelp,
          i_qals-kont_pspnr      TO l_imtab_wa-ps_psp_pnr,
          i_qals-kont_kdauf      TO l_imtab_wa-kdauf,
          i_qals-kont_kdpos      TO l_imtab_wa-kdpos.


    "{ Begin ENHO ADSUB_MQEVAF12 IS-AD-SUC AD_SUB }
    IF l_imtab_wa-sobkz EQ cl_adsub_constants=>k AND        "RZ1566120
       l_imtab_wa-ebeln IS NOT INITIAL AND                  "RZ1566120
       l_imtab_wa-ebelp IS NOT INITIAL.                     "RZ1566120
*     Lieferantenkonsignation mit Bestellbezug
      CALL FUNCTION 'ME_EKPO_SINGLE_READ'                     "RZ1566120
        EXPORTING                                             "RZ1566120
          pi_ebeln         = l_imtab_wa-ebeln        "RZ1566120
          pi_ebelp         = l_imtab_wa-ebelp        "RZ1566120
*         PI_BYPASSING_BUFFER       =
*         PI_REFRESH_BUFFER         =
        IMPORTING                                             "RZ1566120
          po_ekpo          = l_sub_ekpo              "RZ1566120
        EXCEPTIONS                                               "2351165
          no_records_found = 1.                         "2351165

      IF l_sub_ekpo-disub_sobkz EQ cl_adsub_constants=>k AND "RZ1566120
         l_sub_ekpo-disub_owner IS NOT INITIAL.             "RZ1566120
*- Following lines commented out and new logic is inserted   v-GV1789742
**       Eigentuemer des (vorherigen) Beistellbestandes
*        l_imtab_wa-lifnr =  l_sub_ekpo-disub_owner.          "RZ1566120
*        IF l_imtab_wa-disub_owner IS INITIAL.                "GA1647143
*          l_imtab_wa-disub_owner = l_sub_ekpo-disub_owner.   "GA1647143
*        ENDIF.                                               "GA1647143
*- When PO and Subcon owner differs, fill disub_owner too
        IF l_imtab_wa-lifnr NE l_sub_ekpo-disub_owner.
          l_imtab_wa-disub_owner = l_sub_ekpo-disub_owner.
        ENDIF.
*- If Subcon owner is available the the stock is always there
*- this vendor number must be used during stock posting
        l_imtab_wa-lifnr       =  l_sub_ekpo-disub_owner.
*--                                                          ^-GV1789742
      ENDIF.                                                "RZ1566120
    ENDIF.                                                  "RZ1566120

*-- Liegt ein vorgangskontierter Netzplan zugrunde ?
    IF    NOT i_qals-aplzl IS INITIAL
      AND NOT i_qals-nplnr IS INITIAL.
*--   Richtige AUFPL muß ermittelt werden
      CALL FUNCTION 'READ_NETWORK_AUFPL_APLZL'
        EXPORTING
          nplnr = i_qals-nplnr
        IMPORTING
          aufpl = l_imtab_wa-aufpl.

    ELSEIF         i_qals-aplzl IS INITIAL
           AND NOT i_qals-nplnr IS INITIAL
           AND NOT i_qals-sobkz IS INITIAL.
*     Netzplan und -vorgang löschen, wenn Sonderbestand
      CLEAR: l_imtab_wa-nplnr,
             l_imtab_wa-aufpl.
    ENDIF.
*----------------------------------
*   Feldspezifische Abwicklungen
    CASE l_idx_tab-index.
*     an frei
      WHEN ci_1.
*       Falls kein Lagerortwechsel und freier Bestand -> keine MM-Buchg
        IF i_qals-insmk IS INITIAL AND i_qals-stat11 IS INITIAL
          AND p_rqeva-qlgo_vm01 EQ i_qals-lagortvorg.
          CONTINUE.
        ENDIF.
*       Zusätzl. Daten für Belegposition
        MOVE p_rqeva-sgtxt01 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund01 IS INITIAL.
          MOVE p_rqeva-grund01 TO l_imtab_wa-grund.
        ENDIF.
*
        IF i_qals-stat11 IS INITIAL.   "Umlagern im freien Bestand
          MOVE p_rqeva-qlgo_vm01 TO l_imtab_wa-umlgo.
        ELSE.                          "Aus WE-Sperr in freien Bestand
          MOVE p_rqeva-qlgo_vm01 TO l_imtab_wa-lgort.
        ENDIF.

        IF l_imtab_wa-umlgo NE l_imtab_wa-lgort.    "note 991978
*         Lagerortänderung -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.

        IF i_qals-stat11 IS INITIAL.   "kein WE-Sperrbestand
* note 1947580
          IF l_imtab_wa-umcha IS INITIAL
             AND NOT qals-sernp IS INITIAL.               "note 2315777
            l_imtab_wa-umcha = i_qals-charg.
          ENDIF.
          ADD 1 TO l_zaehler_fuer_ta.
        ELSE.
*         Buchung aus WE-Sperrbestand
          MOVE p_rqeva-ablad TO l_imtab_wa-ablad.
          MOVE p_rqeva-mhd_01 TO l_imtab_wa-mhdat.
*         Bestellung die im Prüflos steht (WE zur Bestellung)
          MOVE 'B' TO l_imtab_wa-kzbew.
          MOVE i_qals-ebeln TO l_imtab_wa-ebeln.
          MOVE i_qals-ebelp TO l_imtab_wa-ebelp.
*         Nachlesen Referenzbeleg aus MSEG -> wg. Lieferplan
          SELECT SINGLE lfbja lfbnr lfpos
              FROM mseg INTO CORRESPONDING FIELDS OF l_imtab_wa
                     WHERE mblnr EQ i_qals-mblnr
                       AND mjahr EQ i_qals-mjahr
                       AND zeile EQ i_qals-zeile.
          IF NOT sy-subrc IS INITIAL.
*           keine Feldübernahme, aber weiter, Fehler kommt aus MM ?
            CLEAR: l_imtab_wa-lfbja,
                   l_imtab_wa-lfbnr,
                   l_imtab_wa-lfpos.
          ENDIF.
        ENDIF.
*     Verschrottung
      WHEN ci_2.
*       Zusätzl. Daten für Belegposition
        MOVE p_rqeva-sgtxt02 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund02 IS INITIAL.
          MOVE p_rqeva-grund02 TO l_imtab_wa-grund.
        ENDIF.
        IF NOT p_rqeva-kostl02 IS INITIAL.
          MOVE p_rqeva-kostl02 TO l_imtab_wa-kostl.
          PERFORM geschbereich_holen USING p_rqeva-kostl02
                                  CHANGING l_imtab_wa-gsber.
        ENDIF.
*
        IF  l_imtab_wa-aufnr IS INITIAL
        AND l_imtab_wa-kostl IS INITIAL.
          PERFORM geschbereich_holen USING i_kst02
                                  CHANGING l_imtab_wa-gsber.
          MOVE i_kst02 TO l_imtab_wa-kostl.
        ENDIF.
        ADD 1 TO l_zaehler_fuer_ta.
*       WM-Beleginfo immer füllen
        MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
               i_qals-zeile TO l_imtab_wa-tbbpo,
               i_qals-mjahr TO l_imtab_wa-tbbjr.

*     Stichprobe
      WHEN ci_3.
*       Zusätzl. Daten für Belegposition
        MOVE p_rqeva-sgtxt03 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund03 IS INITIAL.
          MOVE p_rqeva-grund03 TO l_imtab_wa-grund.
        ENDIF.
        IF NOT p_rqeva-kostl03 IS INITIAL.
          MOVE p_rqeva-kostl03 TO l_imtab_wa-kostl.
          PERFORM geschbereich_holen USING p_rqeva-kostl03
                                  CHANGING l_imtab_wa-gsber.
        ENDIF.
*
        IF  l_imtab_wa-aufnr IS INITIAL
        AND l_imtab_wa-kostl IS INITIAL.
          PERFORM geschbereich_holen USING i_kst03
                                  CHANGING l_imtab_wa-gsber.
          MOVE i_kst03 TO l_imtab_wa-kostl.
        ENDIF.
*       WM informieren
        IF i_qals-lvs_stikz NE '3'.
*         bekannter Stichprobenlagerplatz -> Lagerortdaten füllen
          IF NOT i_qals-lgnum IS INITIAL
             AND NOT i_qals-lgtyp IS INITIAL
             AND NOT i_qals-lgpla IS INITIAL.
            SELECT SINGLE lgpla FROM lagp INTO l_lgpla_
              WHERE lgnum EQ i_qals-lgnum
                AND lgtyp EQ i_qals-lgtyp
                AND lgpla EQ i_qals-lgpla.
            IF sy-subrc EQ 0.                               " 1263243
              MOVE:  i_qals-lgtyp TO l_imtab_wa-lgtyp,
                     i_qals-lgpla TO l_imtab_wa-lgpla.
            ELSE.
              CLEAR: l_imtab_wa-lgtyp,
                     l_imtab_wa-lgpla.
            ENDIF.
          ENDIF.
        ENDIF.

        IF i_qals-lvs_stikz EQ '1'.
*         kein TB erzeugen
          MOVE c_kreuz TO l_imtab_wa-tbpkz.
        ELSE.
*         TB erzeugen   -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.
*     an gesperrt
      WHEN ci_4.
        MOVE p_rqeva-qlgo_vm04 TO l_imtab_wa-umlgo.
* note 1947580
        IF l_imtab_wa-umcha IS INITIAL
           AND NOT qals-sernp IS INITIAL.                  "note 2315777
          l_imtab_wa-umcha = i_qals-charg.
        ENDIF.
        ADD 1 TO l_zaehler_fuer_ta.
        IF l_imtab_wa-umlgo NE l_imtab_wa-lgort.
*         Lagerortänderung -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.
*-- Zusätzl. Daten für Belegposition
        MOVE p_rqeva-sgtxt04 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund04 IS INITIAL.
          MOVE p_rqeva-grund04 TO l_imtab_wa-grund.
        ENDIF.

*     Ruecklage in nicht-dispo-relevantes Lager
      WHEN ci_5.
        MOVE i_lgo05         TO l_imtab_wa-umlgo.
*       WM informieren,
        ADD 1 TO l_zaehler_fuer_ta. "nur wenn nicht über Lagerplatz!!!!
*       WM informieren falls Lagerortwechsel
        IF l_imtab_wa-umlgo NE l_imtab_wa-lgort.
          IF i_qals-lvs_stikz NE '3'.
*           bekannter Stichprobenlagerplatz -> Lagerortdaten füllen
            IF NOT i_qals-lgnum IS INITIAL
               AND NOT i_qals-lgtyp IS INITIAL
               AND NOT i_qals-lgpla IS INITIAL.
              SELECT SINGLE lgpla FROM lagp INTO l_lgpla_
                WHERE lgnum EQ i_qals-lgnum
                  AND lgtyp EQ i_qals-lgtyp
                  AND lgpla EQ i_qals-lgpla.
              IF sy-subrc EQ 0.                             " 1263243
                MOVE: i_qals-lgtyp TO l_imtab_wa-lgtyp,
                      i_qals-lgpla TO l_imtab_wa-lgpla.
              ELSE.
                CLEAR: l_imtab_wa-lgtyp,
                       l_imtab_wa-lgpla.
              ENDIF.
            ENDIF.
          ENDIF.

          IF i_qals-lvs_stikz EQ '1'.
*           kein TB erzeugen
            MOVE c_kreuz TO l_imtab_wa-tbpkz.
          ELSE.
*           TB erzeugen   -> Verweis auf Ursprungsbeleg
            MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                   i_qals-zeile TO l_imtab_wa-tbbpo,
                   i_qals-mjahr TO l_imtab_wa-tbbjr.
          ENDIF.
        ENDIF.
*-- Zusätzl. Daten für Belegposition
        MOVE p_rqeva-sgtxt05 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund05 IS INITIAL.
          MOVE p_rqeva-grund05 TO l_imtab_wa-grund.
        ENDIF.

*     Materialumbuchung incl. Charge
      WHEN ci_6.
        MOVE: p_rqeva-neu_mat    TO l_imtab_wa-ummat,
              p_rqeva-neu_charge TO l_imtab_wa-umcha,
              p_rqeva-qlgo_vm06  TO l_imtab_wa-umlgo.
        ADD 1 TO l_zaehler_fuer_ta.
        IF l_imtab_wa-umlgo NE l_imtab_wa-lgort.
*         WM Lagerortänderung -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.
*-- Zusätzl. Daten für Belegposition
        MOVE p_rqeva-sgtxt06 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund06 IS INITIAL.
          MOVE p_rqeva-grund06 TO l_imtab_wa-grund.
        ENDIF.
* note 2313810
        DATA : lv_bwtty    TYPE marc-bwtty,
               ls_t149     TYPE t149,
               lv_bwkey    TYPE t001w-bwkey,
               ls_mtcom    TYPE mtcom,
               lv_material TYPE mara-matnr,
               lin         TYPE i,
               lv_gui_on,
               zeile       LIKE mseg-zeile  VALUE '1'..
        DATA: BEGIN OF xbwtar OCCURS 5.
            INCLUDE STRUCTURE bwtar.
        DATA: END OF xbwtar.

        CALL FUNCTION 'RFC_IS_GUI_ON'
          IMPORTING
            on = lv_gui_on.

        IF l_imtab_wa-umcha IS NOT INITIAL
          AND ( (  l_imtab_wa-charg NE l_imtab_wa-umcha )
           OR ( l_imtab_wa-matnr NE l_imtab_wa-ummat AND l_imtab_wa-ummat IS NOT INITIAL ) )
          AND lv_gui_on = 'Y' AND sy-batch IS INITIAL AND sy-binpt IS INITIAL.
          SELECT SINGLE bwkey FROM t001w INTO lv_bwkey WHERE werks = l_imtab_wa-umwrk.
          IF  l_imtab_wa-ummat IS INITIAL.
            SELECT SINGLE bwtty FROM marc INTO lv_bwtty WHERE
            matnr = l_imtab_wa-matnr
            AND werks = l_imtab_wa-umwrk.
          ELSE.
            SELECT SINGLE bwtty FROM marc INTO lv_bwtty WHERE
            matnr = l_imtab_wa-ummat
            AND werks = l_imtab_wa-umwrk.
          ENDIF.
          IF NOT lv_bwtty IS INITIAL.                       " 2372082
            SELECT SINGLE * FROM t149 INTO ls_t149  WHERE
                bwkey EQ lv_bwkey       AND
                bwtty EQ lv_bwtty .
            IF NOT sy-subrc IS INITIAL.
              e_subrc = 4.
              p_prottab-msgty = 'E'.
              p_prottab-msgid = 'M7'.
              p_prottab-msgno = 001.
              p_prottab-msgv1 = 'T149'.
              p_prottab-msgv2 = lv_bwkey.
              p_prottab-msgv3 = lv_bwtty.
              APPEND p_prottab.
*              MESSAGE e001(m7) WITH 'T149' lv_bwkey lv_bwtty.
            ENDIF.
            IF ls_t149-kzbaa IS INITIAL.
              REFRESH xbwtar.
              IF l_imtab_wa-ummat IS INITIAL.
                lv_material = l_imtab_wa-matnr.
              ELSE.
                lv_material = l_imtab_wa-ummat.
              ENDIF.
              ls_mtcom-matnr = lv_material.
              ls_mtcom-bwkey = lv_bwkey.
              ls_mtcom-kenng = 'BWTAR'.
              CALL FUNCTION 'MATERIAL_READ'
                EXPORTING
                  schluessel = ls_mtcom
                TABLES
                  seqmat01   = xbwtar.
              DESCRIBE TABLE xbwtar LINES lin.
              IF lin = 0.
                e_subrc = 4.
                p_prottab-msgty = 'E'.
                p_prottab-msgid = 'M7'.
                p_prottab-msgno = 078.
                p_prottab-msgv1 = ls_mtcom-matnr.
                p_prottab-msgv2 = ls_mtcom-bwkey.
                APPEND p_prottab.

*                 MESSAGE e078(m7) WITH ls_mtcom-matnr ls_mtcom-bwkey.
              ENDIF.
              IF l_imtab_wa-umcha IS NOT INITIAL.
                LOOP AT xbwtar WHERE bwtar EQ l_imtab_wa-umcha.
                ENDLOOP.
                IF sy-subrc IS INITIAL.
                  l_imtab_wa-umbar = xbwtar-bwtar.
                ENDIF.
              ENDIF.
              IF l_imtab_wa-umbar IS INITIAL.
                IF lin > 1.
                  CALL FUNCTION 'MB_SELECT_VALUE_TYPE'
                    EXPORTING
                      hilfe  = 'HLPV'
                      ematnr = l_imtab_wa-ummat
                      echarg = l_imtab_wa-umcha
                      ezeile = zeile
                    IMPORTING
                      bindex = lin
                    TABLES
                      xbwtar = xbwtar.
                  CLEAR xbwtar.
                  READ TABLE xbwtar INDEX lin.
                  l_imtab_wa-umbar = xbwtar-bwtar.
                ELSE.
                  READ TABLE xbwtar INDEX 1.
                  l_imtab_wa-umbar = xbwtar-bwtar.
                ENDIF.
                IF l_imtab_wa-umbar IS INITIAL.
                  e_subrc = 4.
                  p_prottab-msgty = 'E'.
                  p_prottab-msgid = 'M7'.
                  p_prottab-msgno = 044.
                  p_prottab-msgv1 = ls_mtcom-matnr.
                  p_prottab-msgv2 = ls_mtcom-bwkey.
                  APPEND p_prottab.

*                  MESSAGE e044(m7) WITH ls_mtcom-matnr ls_mtcom-bwkey.
                ENDIF.
              ENDIF.
            ENDIF.
          ENDIF.
        ENDIF.

*     Zurück zum Lieferanten: Bestellung mit Positionsnr.
      WHEN ci_7.
        IF i_qals-herkunft EQ hk_wefert.
*      Rücklieferung zum Fertigungsauftrag braucht Kz. 'F' und INSMK
          MOVE 'F'             TO l_imtab_wa-kzbew.
          MOVE i_qals-aufnr    TO l_imtab_wa-aufnr.
        ELSE.
*       WE-Zeile braucht Kennz. 'B' und INSMK
          MOVE 'B'          TO l_imtab_wa-kzbew.
          IF NOT i_qals-ebeln IS INITIAL.
*         Bestellung die im Prüflos steht (WE zur Bestellung)
            MOVE i_qals-ebeln TO l_imtab_wa-ebeln.
            MOVE i_qals-ebelp TO l_imtab_wa-ebelp.
*           Nachlesen Referenzbeleg aus MSEG -> wg. Lieferplan
* note 1078331
            SELECT SINGLE lfbja lfbnr lfpos lgtyp lgpla FROM mseg
                     INTO CORRESPONDING FIELDS OF l_imtab_wa
                     WHERE mblnr EQ i_qals-mblnr
                       AND mjahr EQ i_qals-mjahr
                       AND zeile EQ i_qals-zeile.
            IF NOT sy-subrc IS INITIAL.
*             keine Feldübernahme, aber weiter, Fehler kommt aus MM ?
              CLEAR: l_imtab_wa-lfbja,
                     l_imtab_wa-lfbnr,
                     l_imtab_wa-lfpos.
            ENDIF.
          ELSE.
*         Bestellung wurde erst auf Popup zur Rücklieferung angegeben !
            MOVE p_rqeva-ebeln TO l_imtab_wa-ebeln.
            MOVE p_rqeva-ebelp TO l_imtab_wa-ebelp.
          ENDIF.
* Note 2040747
          IF l_imtab_wa-ebeln IS NOT INITIAL AND
             l_imtab_wa-ebelp IS NOT INITIAL AND
             i_qals-mjahr IS NOT INITIAL AND
             i_qals-mblnr IS NOT INITIAL AND
             i_qals-zeile IS NOT INITIAL.
*             select ETENS for non GR based IV to match the return delivery
*             correctly to the inbound delivery within MB_CREATE when
*             calling ME_READ_ITEMS_GOODS_RECEIPT
            SELECT SINGLE etens FROM ekbe INTO l_imtab_wa-etens
              WHERE ebeln  = l_imtab_wa-ebeln
                AND ebelp  = l_imtab_wa-ebelp
*                  AND ZEKKN  = '0'
                AND vgabe  = '1'
                AND gjahr  = i_qals-mjahr
                AND belnr  = i_qals-mblnr
                AND buzei  = i_qals-zeile
                AND lfbnr  = space. "not for GR based IV (WEBRE)
            IF sy-subrc <> 0.
*               not relevant
            ENDIF.
          ENDIF.

        ENDIF.
        MOVE i_qals-insmk    TO l_imtab_wa-insmk.
        IF NOT p_rqeva-grund IS INITIAL.
          MOVE p_rqeva-grund TO l_imtab_wa-grund.
        ENDIF.
        MOVE p_rqeva-sgtxt07 TO l_imtab_wa-sgtxt.
        IF i_qals-stat11 IS INITIAL.   "kein WE-Sperrbestand
          ADD 1 TO l_zaehler_fuer_ta.
*         WM -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.

*     User Buchung -> Exit aufrufen
      WHEN ci_8.
        MOVE p_rqeva-qlgo_vm08 TO l_imtab_wa-umlgo.
*       Positionstext und Bewegungsgrund übernehmen
*       => änderbar im Exit über l_qbefu
        MOVE p_rqeva-sgtxt08 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund08 IS INITIAL.
          MOVE p_rqeva-grund08 TO l_imtab_wa-grund.
        ENDIF.
        MOVE-CORRESPONDING l_imtab_wa TO l_qbefu.
*        CALL CUSTOMER-FUNCTION '001'
*          EXPORTING i_qals    = i_qals
*                    i_qave    = qave
*                    i_qbefu   = l_qbefu
*                    i_rqeva   = p_rqeva
*          IMPORTING e_qbefu   = l_qbefu
*          EXCEPTIONS error_message = 00
*                     OTHERS        = 00 .
        MOVE-CORRESPONDING l_qbefu TO g_qbefu_classif.           "note 1724424
        MOVE-CORRESPONDING l_qbefu TO l_imtab_wa.
        ADD 1 TO l_zaehler_fuer_ta.
*       Falls nicht erfolgreich wird L_QBEFU_TMP nicht verändert
        IF l_imtab_wa-umlgo NE l_imtab_wa-lgort.
*         Lagerortänderung -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.
*-- Zusätzl. Daten für Belegposition
        IF l_imtab_wa-sgtxt IS INITIAL.
          MOVE p_rqeva-sgtxt08 TO l_imtab_wa-sgtxt.
        ENDIF.
        IF l_imtab_wa-grund IS INITIAL
          AND NOT p_rqeva-grund08 IS INITIAL.
          MOVE p_rqeva-grund08 TO l_imtab_wa-grund.
        ENDIF.

*     User-Buchung spezial (Feld bisher nicht offen)
      WHEN ci_9.
*        move p_rqeva-qlgo_vm09 to l_imtab_wa-umlgo.
*       Positionstext und Bewegungsgrund übernehmen
*       => änderbar im Exit über l_qbefu
        MOVE p_rqeva-sgtxt09 TO l_imtab_wa-sgtxt.
        IF NOT p_rqeva-grund09 IS INITIAL.
          MOVE p_rqeva-grund09 TO l_imtab_wa-grund.
        ENDIF.
        MOVE-CORRESPONDING l_imtab_wa TO l_qbefu.
*        CALL CUSTOMER-FUNCTION '001'
*          EXPORTING i_qals    = i_qals
*                    i_qave    = qave
*                    i_qbefu   = l_qbefu
*                    i_rqeva   = p_rqeva
*          IMPORTING e_qbefu   = l_qbefu
*          EXCEPTIONS error_message = 00
*                     OTHERS        = 00 .
        MOVE-CORRESPONDING l_qbefu TO l_imtab_wa.
        ADD 1 TO l_zaehler_fuer_ta.
*         Falls nicht erfolgreich wird L_QBEFU_TMP nicht verändert
        IF l_imtab_wa-umlgo NE l_imtab_wa-lgort.
*         Lagerortänderung -> Verweis auf Ursprungsbeleg
          MOVE : i_qals-mblnr TO l_imtab_wa-tbbel,
                 i_qals-zeile TO l_imtab_wa-tbbpo,
                 i_qals-mjahr TO l_imtab_wa-tbbjr.
        ENDIF.
*-- Zusätzl. Daten für Belegposition
        IF l_imtab_wa-sgtxt IS INITIAL.
          MOVE p_rqeva-sgtxt09 TO l_imtab_wa-sgtxt.
        ENDIF.
        IF l_imtab_wa-grund IS INITIAL
          AND NOT p_rqeva-grund09 IS INITIAL.
          MOVE p_rqeva-grund09 TO l_imtab_wa-grund.

        ENDIF.

*     sonst
      WHEN OTHERS.
    ENDCASE.

*------------------
*   Daten die im User-Exit nicht geändert werden können !!!!!
    MOVE: i_qals-matnr           TO l_imtab_wa-matnr,
          i_qals-charg           TO l_imtab_wa-charg,
          i_qals-werkvorg        TO l_imtab_wa-werks,
*note 1305652     i_qals-werkvorg        to l_imtab_wa-umwrk,
          i_qals-sobkz           TO l_imtab_wa-sobkz,
          i_qals-prueflos        TO l_imtab_wa-qploa.

    IF l_idx_tab-index NE ci_8.                        "note 1305652
      MOVE : i_qals-werkvorg        TO l_imtab_wa-umwrk.
    ENDIF.

    IF i_qals-stat11 IS INITIAL.       " Nicht im WE-Sperrbestand Fall !
      MOVE i_qals-lagortvorg      TO l_imtab_wa-lgort.
    ENDIF.
*   Falls Ziellagerort noch nicht gefüllt -> füllen
    IF l_idx_tab-index NE ci_8.                        "note 1305652
      PERFORM fuelle_lagerort(sapmqeva) CHANGING l_imtab_wa-umlgo.
    ENDIF.
*   Bei Storno-BWA (siehe Kennzeichen) Lagerorte tauschen
    IF NOT l_t156-xstbw IS INITIAL.
*     MM-Lagerort
      l_lgort = l_imtab_wa-umlgo .
      l_imtab_wa-umlgo = l_imtab_wa-lgort.
      l_imtab_wa-lgort = l_lgort.
*     WM-Lagerort
      l_lgtyp = l_imtab_wa-umlgt.
      l_imtab_wa-umlgt = l_imtab_wa-lgtyp.
      l_imtab_wa-lgtyp = l_lgtyp.
      l_lgpla = l_imtab_wa-umlgp.
      l_imtab_wa-umlgp = l_imtab_wa-lgpla.
      l_imtab_wa-lgpla = l_lgpla.
*    Charge note 1947580
      DATA: l_charg TYPE charg_d.
      IF l_imtab_wa-umcha IS NOT INITIAL.
        l_charg = l_imtab_wa-umcha.
        l_imtab_wa-umcha = l_imtab_wa-charg.
        l_imtab_wa-charg = l_charg.
      ENDIF.
*
    ENDIF.
*-------------------
    IF l_idx_tab-index = ci_7.
*     clear UMWRK and UMLGO because of correction of requirement (FM
*     REQUIREMENTS_REDUCTION)
      CLEAR : l_imtab_wa-umwrk,
              l_imtab_wa-umlgo.
    ENDIF.
    IF l_idx_tab-index = ci_1.
*     clear UMWRK and UMLGO because of correction of requirement (FM
*     REQUIREMENTS_REDUCTION) in the case, that material is actually in
*     'GR blocked stock' and posting is done to 'unrestricted'
*     (l_idx_tab-index = 1)
      IF qals-stat11 EQ c_kreuz.
        CLEAR : l_imtab_wa-umwrk,
                l_imtab_wa-umlgo.
      ENDIF.
    ENDIF.
    IF l_idx_tab-index = ci_2.      "note 1267918
*     clear UMWRK and UMLGO in case of posting to scrap
      CLEAR : l_imtab_wa-umwrk,
              l_imtab_wa-umlgo.
    ENDIF.
    IF l_idx_tab-index = ci_3.      "note 1300969
*     clear UMWRK and UMLGO in case of posting to sample
      CLEAR : l_imtab_wa-umwrk,
              l_imtab_wa-umlgo.
    ENDIF.

*   Tabelleneintrag hinzufuegen
    APPEND l_imtab_wa TO l_imtab.
    APPEND l_idx_tab.
  ENDDO.

** check if stock-posting would be completed
*  IF l_gebu_menge GT ci_0
*    AND l_gebu_menge EQ g_zubuchmg_f.
**   check if status could be set
*    CALL FUNCTION 'QAST_PROCESS_ACTIVITY'
*      EXPORTING
*        i_check_only         = 'X'
*        i_dialog             = ' '
*        i_objnr              = qals-objnr
*        i_vorgang            = c_vorg_bb_beenden
*      EXCEPTIONS
*        not_allowed          = 1
*        activity_not_allowed = 2
*        OTHERS               = 3.
*    IF sy-subrc <> 0.
**     Fehler
*      CLEAR l_imtab_wa.
*      CLEAR l_idx_tab-index.
*      MOVE: sy-msgid               TO l_emtab_wa-msgid,
*            sy-msgty               TO l_emtab_wa-msgty,
*            sy-msgno               TO l_emtab_wa-msgno,
*            sy-msgv1               TO l_emtab_wa-msgv1,
*            sy-msgv2               TO l_emtab_wa-msgv2,
*            sy-msgv3               TO l_emtab_wa-msgv3,
*            sy-msgv4               TO l_emtab_wa-msgv4.
**     Zeitstempel fuer Protokoll
*      PERFORM get_time_stamp USING l_emkpf
*                             CHANGING g_time_stamp.
*      MOVE g_time_stamp TO l_prottab_wa.
*      APPEND l_prottab_wa TO p_prottab.
**     Fehlermeldung ausgeben
*      PERFORM buche_bestaende_protokoll TABLES p_prottab
*                                     USING  l_imtab_wa l_emtab_wa
*                                            l_idx_tab-index space.
*      MOVE c_rc08 TO e_subrc.
*      EXIT.
*    ENDIF.
*  ENDIF.


  "{ Begin ENHO /SAPMP/PIECEBATCH_MQEVAF12 IS-MP-MM /SAPMP/SINGLE_UNIT_BATCH }
  IF NOT i_zubmg-vmenge01 IS INITIAL.                       "1114076
*   Correct quantity for unrestricted use exists
    DESCRIBE TABLE l_imtab LINES sy-tfill.
    IF sy-tfill > 1.
      READ TABLE l_imtab INTO l_imtab_wa INDEX 1.
      IF sy-subrc = 0 AND NOT l_imtab_wa-charg IS INITIAL.
        CALL FUNCTION 'VB_BATCH_DEFINITION'
          IMPORTING
            kzdch = lv_kzdch.
        IF lv_kzdch = '0'.
          SELECT SINGLE * FROM mcha INTO ls_mcha
                 WHERE matnr = l_imtab_wa-matnr
                 AND   werks = l_imtab_wa-werks
                 AND   charg = l_imtab_wa-charg.
        ELSE.
          SELECT SINGLE * FROM mch1 INTO ls_mch1
                 WHERE matnr = l_imtab_wa-matnr
                 AND   charg = l_imtab_wa-charg.
        ENDIF.
        IF sy-subrc = 0 AND ( ls_mcha-xpcbt = 'X' OR ls_mch1-xpcbt = 'X' ).
*         Shift transfer posting to the end
          DELETE l_imtab INDEX 1.
          APPEND l_imtab_wa TO l_imtab.
*         Shift index item to the end
          READ TABLE l_idx_tab INDEX 1.
          DELETE l_idx_tab INDEX 1.
          APPEND l_idx_tab.
        ENDIF.
      ENDIF.
    ENDIF.
  ENDIF.

* Sonderverarbeitung bei WE-Sperrbestand an Stichprobe
  IF NOT i_qals-stat11 IS INITIAL.
    READ TABLE l_idx_tab WITH KEY index = ci_3.
    MOVE sy-tabix TO l_tabix.
*   Menge an Stichprobe muß zuerst an freigebucht werden
    IF sy-subrc IS INITIAL.
      READ TABLE l_imtab INTO l_imtab_wa INDEX sy-tabix.
*
      MOVE p_rqeva-qlgo_vm03 TO l_imtab_wa-umlgo.
      MOVE p_rqeva-qlgo_vm03 TO l_imtab_wa-lgort.
*     Lagerort in Originalzeile setzen
      MODIFY l_imtab FROM l_imtab_wa INDEX l_tabix.
*     Bestellung die im Prüflos steht (WE zur Bestellung)
      MOVE 'B' TO l_imtab_wa-kzbew.
      MOVE i_qals-ebeln TO l_imtab_wa-ebeln.
      MOVE i_qals-ebelp TO l_imtab_wa-ebelp.
*     Nachlesen Referenzbeleg aus MSEG -> wg. Lieferplan
      SELECT SINGLE lfbja lfbnr lfpos
              FROM mseg INTO CORRESPONDING FIELDS OF l_imtab_wa
                     WHERE mblnr EQ i_qals-mblnr
                       AND mjahr EQ i_qals-mjahr
                       AND zeile EQ i_qals-zeile.
      IF NOT sy-subrc IS INITIAL.
*       keine Feldübernahme, aber weiter, Fehler kommt aus MM ?
        CLEAR: l_imtab_wa-lfbja,
               l_imtab_wa-lfbnr,
               l_imtab_wa-lfpos.
      ENDIF.
*     Bewegungsart nachlesen, wenn Tabelleneintrag nicht vorhanden
      PERFORM hole_bwart(sapmqeva) USING    ci_1
                                            i_qals-insmk
                                            i_qals-stat11
                                            i_qals-herkunft
                                   CHANGING l_imtab_wa-bwart.
      MOVE ci99 TO l_idx_tab-index.    "Dummy Zeile in Belegfolge
      INSERT l_idx_tab INDEX l_tabix.
      INSERT l_imtab_wa INTO l_imtab INDEX l_tabix.
    ENDIF.
  ENDIF.

* Neue Übergabetabelle füllen
  LOOP AT l_imtab INTO l_imtab_wa.
*   Workarea initialisieren
*   Ist Chargenzustandsänderung erforderlich ?
    IF p_rqeva-kzchgzvakt    EQ c_kreuz.
      IF    i_qals-matnr         EQ l_imtab_wa-matnr
        AND i_qals-charg         EQ l_imtab_wa-charg.
*       Chargenzustandsverwaltung ist aktiv und
*       Material und Chargen entsprechen den Losdaten
*--------
*       Chargenzustand hat sich geändert
        IF p_rqeva-charg_zust EQ c_kreuz.
*         Neuer Zustand 'Nicht frei ' !
          MOVE '0' TO l_imtab_wa-qm_zustd.
        ELSE.
*         Neuer Zustand 'Frei' !
          MOVE '1' TO l_imtab_wa-qm_zustd.
        ENDIF.
      ENDIF.
*     Umbuchung an neue Charge -> Chargenzustand anpassen
      IF p_rqeva-neu_mat     EQ l_imtab_wa-ummat
         AND NOT l_imtab_wa-ummat IS INITIAL
         AND p_rqeva-neu_charge  EQ l_imtab_wa-umcha.
*       Chargenzustand anpassen
        IF    p_rqeva-neu_ul_z_n EQ c_kreuz
          AND p_rqeva-neu_ul_z_f EQ space.
*         Neuer Zustand 'Nicht frei ' !
          MOVE '0' TO l_imtab_wa-qm_umzst.
        ELSEIF p_rqeva-neu_ul_z_n EQ space
          AND  p_rqeva-neu_ul_z_f EQ c_kreuz.
*         Neuer Zustand 'Frei' !
          MOVE '1' TO l_imtab_wa-qm_umzst.
        ENDIF.
      ENDIF.
    ENDIF.
*-- Prüfung, ob maximal eine BWA die komplette WM-Menge entlastet !
    IF l_zaehler_fuer_ta GT 1 OR p_rqeva-zubuchmg_f NE 0.
      MOVE c_kreuz TO l_imtab_wa-tafkz.
    ELSE.
*-- Nur in diesem Fall ist automatische TA-Erzeugung möglich !
      CLEAR l_imtab_wa-tafkz.
    ENDIF.
    MODIFY l_imtab FROM l_imtab_wa.
  ENDLOOP.
*--Belegdatum
  MOVE p_rqeva-bldat   TO l_imkpf-bldat. "Vorschlag SY-DATLO
*--Buchungsdatum
  MOVE p_rqeva-budat   TO l_imkpf-budat. "Vorschlag SY_DATLO
*--Belegkopftext
  MOVE p_rqeva-bktxt   TO l_imkpf-bktxt.
*----------------------

  IF    p_rqeva-zus_alt_n  NE p_rqeva-charg_zust   "geänderter Zustand
    AND p_rqeva-kzchgzvakt EQ c_kreuz  "Chargenzustd.verw.aktiv
    AND  NOT i_qals-xchpf IS INITIAL . "Material Chargenpflichtig
*   Chargenzustand ändern
    CALL FUNCTION 'VB_CHANGE_BATCH_STATUS'
      EXPORTING
        matnr               = i_qals-matnr
        charg               = i_qals-charg
        werks               = i_qals-werkvorg
        zustd               = p_rqeva-charg_zust
        bypass_read         = c_kreuz
        bypass_lock         = space
        meins               = i_qals-mengeneinh
        bypass_post         = c_kreuz
        authority_check     = c_kreuz
      TABLES
        zimseg              = l_zimsegtab
      EXCEPTIONS
        no_status_to_change = 00.
*   Chargenbelege mit übergeben und Anzahl merken
    DESCRIBE TABLE l_zimsegtab LINES l_zimsegtab_lines.
    LOOP AT l_zimsegtab INTO l_zimseg.
      INSERT l_zimseg INTO l_imtab INDEX sy-tabix.
*   kein Verweis auf Mengenfeld, da Chargenzustandsänderung
      CLEAR l_idx_tab-index.
      INSERT l_idx_tab INDEX sy-tabix.
    ENDLOOP.
*    IF l_zimsegtab_lines IS INITIAL.
**     Chargenzustandsänderung ohne Bestandsbuchung, Protokollierung hier
**     Zeitstempel fuer Protokoll
*      PERFORM get_time_stamp USING l_emkpf
*                             CHANGING g_time_stamp.
*      MOVE: c_sternformat      TO g_tab_protocol2-tdformat.
*
*      MOVE: g_time_stamp       TO g_tab_protocol2-tdline.
*      APPEND g_tab_protocol2.
*
*      MOVE: text-b00           TO g_tab_protocol2-tdline.
*      SHIFT g_tab_protocol2-tdline BY 3 PLACES RIGHT.
*      APPEND g_tab_protocol2.
*    ENDIF.
  ENDIF.

  DESCRIBE TABLE l_imtab LINES sy-tfill.
  IF NOT sy-tfill IS INITIAL
    AND NOT qals-sernp IS INITIAL.
    PERFORM serialnr_zuordnen(sapmqeva) TABLES
                                           l_imtab
                                        USING
                                           l_imkpf
                                           e_subrc
                                           l_t156-xstbw.       " note 1972702
    IF e_subrc GE c_rc04.              "Fehlermeldung bereits gesendet!
      EXIT.                            "zurück auf Bestandsbild!
    ENDIF.
    MOVE c_kreuz TO l_serial_vb_aktiv.
  ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
FORM geschbereich_holen   USING VALUE(i_kostl)
                       CHANGING VALUE(i_gsber).

* Ermittlung nur falls Kostenrechnungskreis und Kostenstelle gesetzt
  CHECK NOT tqss1-kostrchkrs IS INITIAL
    AND NOT i_kostl          IS INITIAL.
* Kostenstelle für Buchung nachlesen.

  CALL FUNCTION 'RK_KOSTL_READ'
    EXPORTING
      datum              = sy-datum
      kokrs              = tqss1-kostrchkrs
      kostl              = i_kostl
    IMPORTING
      gsber              = i_gsber
    EXCEPTIONS
      error_message      = 04
      kostl_not_complete = 01
      kostl_not_found    = 02
      text_not_found     = 03.
* keine Fehler ausgeben Geschäftsbereich nicht setzen.
ENDFORM.
*--------------------------------------------------------------------*
FORM inslot_status_change.
  "修改状态：已过帐到库存
  DATA lt_stat LIKE STANDARD TABLE OF jstat WITH HEADER LINE.
*  lt_stat-stat = 'I0203'. APPEND lt_stat .
  lt_stat-stat = 'I0220'. APPEND lt_stat .
  CALL FUNCTION 'STATUS_CHANGE_INTERN'
    EXPORTING
      objnr         = qals-objnr
    TABLES
      status        = lt_stat
    EXCEPTIONS
      error_message = 1.

ENDFORM.
*--------------------------------------------------------------------*
FORM update_qals USING p_qals STRUCTURE qals
                       p_rqevb TYPE rqevb.

  data lv_smenge type qals-LMENGEZUB.
  data lv_lmengezub type qals-LMENGEZUB.
  data lv_stat34 type qals-stat34.

  lv_smenge = P_RQEVB-VMENGE01 +
              P_RQEVB-VMENGE02 +
              P_RQEVB-VMENGE03 +
              P_RQEVB-VMENGE04 +
              P_RQEVB-VMENGE05 +
              P_RQEVB-VMENGE06 +
              P_RQEVB-VMENGE07 +
              P_RQEVB-VMENGE08 +
              P_RQEVB-VMENGE09.
  lv_lmengezub = p_qals-lmengezub - lv_smenge.
  if lv_lmengezub <= 0.
     lv_stat34 = 'X'.    "库存记帐已完成
  endif.

  UPDATE qals SET lmengezub = lv_lmengezub       "仍需要过帐的数量
                  lmenge01 = p_rqevb-vmenge01    "到非限制库存
                  lmenge02 = p_rqevb-vmenge02
                  lmenge03 = p_rqevb-vmenge03
                  lmenge04 = p_rqevb-vmenge04   "到冻结库存
                  lmenge05 = p_rqevb-vmenge05
                  lmenge06 = p_rqevb-vmenge06
                  lmenge07 = p_rqevb-vmenge07
                  lmenge08 = p_rqevb-vmenge08
                  lmenge09 = p_rqevb-vmenge09
                  stat34   = lv_stat34
  WHERE prueflos = p_qals-prueflos.
ENDFORM.    

*--------------------------------------------------------------------*
FORM append_message TABLES it_return STRUCTURE bapiret2
                     USING i_type i_msgid i_number i_message.

  it_return-type = i_type.
  it_return-id = i_msgid.
  it_return-number = i_number.
  it_return-message = i_message.

  APPEND it_return.
ENDFORM.