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

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

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

增强步骤：

1.CMOD创建项目ZMM002

1.1添加逻辑代码

检验批冲销取消UD增强 - 图1
检验批冲销取消UD增强 - 图2
检验批冲销取消UD增强 - 图3
检验批冲销取消UD增强 - 图4
检验批冲销取消UD增强 - 图5

  1. DATA  lv_line TYPE bsvx-sttxt.
  2. CLEAR lv_line.
  4. CALL FUNCTION 'STATUS_TEXT_EDIT'
  5.   EXPORTING
  6.     client           = sy-mandt
  7.     objnr            = i_qals-objnr
  8.     only_active      = 'X'
  9.     spras            = sy-langu
  10.   IMPORTING
  11.     line             = lv_line
  12.   EXCEPTIONS
  13.     object_not_found = 1
  14.     OTHERS           = 2.
  16. IF lv_line CS 'UD'.
  17.   SUBMIT zqevac40 WITH prueflos = i_qals-prueflos AND RETURN.
  18.   WAIT UP TO '1' SECONDS.
  19. ENDIF.
  21. SUBMIT zrqevac50 WITH prueflos = i_qals-prueflos AND RETURN.

1.2添加取消UD按钮

检验批冲销取消UD增强 - 图6
检验批冲销取消UD增强 - 图7

1.3配置事务

事务码：OMJJ

检验批冲销取消UD增强 - 图8
检验批冲销取消UD增强 - 图9
检验批冲销取消UD增强 - 图10

激活项目，增强完成

2.附程序

2.1 ZQEVAC40

  1. *&---------------------------------------------------------------------*
  2. *& Report ZQEVAC40
  3. *&---------------------------------------------------------------------*
  4. *&
  5. *&---------------------------------------------------------------------*
  6. REPORT ZQEVAC40.
  8. TABLES sscrfields.
  9. TABLES qals.
  10. TABLES qave.
  12. CONSTANTS:
  13. c_rc_0  LIKE sy-subrc           VALUE 0,
  14. c_rc_4  LIKE sy-subrc           VALUE 4,
  15. c_rc_20 LIKE sy-subrc           VALUE 20,
  16. c_kreuz LIKE qm00-qkz           VALUE 'X'.
  19. SELECTION-SCREEN SKIP 2.
  20. PARAMETERS prueflos  LIKE qals-prueflos MATCHCODE OBJECT qals    MEMORY ID qls .
  21. SELECTION-SCREEN SKIP 1.
  22. SELECTION-SCREEN BEGIN OF BLOCK SEARCH WITH FRAME.
  23.   SELECTION-SCREEN BEGIN OF LINE.
  24.     SELECTION-SCREEN PUSHBUTTON 3(20) TEXT-s01
  25.     USER-COMMAND sear.
  26.     SELECTION-SCREEN PUSHBUTTON 40(20) TEXT-s02 USER-COMMAND show.
  27.   SELECTION-SCREEN END OF LINE.
  28. SELECTION-SCREEN END OF BLOCK SEARCH.
  31. AT SELECTION-SCREEN.
  33. IF sscrfields-ucomm EQ 'SEAR'
  34. OR prueflos IS INITIAL.
  36.   CALL FUNCTION 'QELA_START_SELECTION_OF_LOTS'
  37.   EXPORTING
  38.     i_selid          = ' '
  39.     i_stat_aenderung = 'X'
  40.     i_stat_ero       = 'X'
  41.     i_stat_frei      = 'X'
  42.     i_stat_ve        = ' '
  43.   IMPORTING
  44.     e_prueflos       = prueflos
  45.   EXCEPTIONS
  46.     no_entry         = 1
  47.     no_selected      = 2
  48.     OTHERS           = 3.
  49.   IF sy-subrc <> 0.
  51.     MESSAGE e042(znhmm01).
  53.   ENDIF.
  54. ENDIF.
  57. IF sscrfields-ucomm EQ 'SHOW'.
  58.   CALL FUNCTION 'QSS1_LOT_SHOW'
  59.   EXPORTING
  60.     i_prueflos = prueflos.
  61. ENDIF.
  63. CHECK sscrfields-ucomm EQ 'ONLI'.
  65. * ab hier mu? Prüflosnummer gefüllt sein.
  66. IF prueflos IS INITIAL.
  67.   MESSAGE e164(qa).
  68. ENDIF.
  70. * Lesen Los
  71. CALL FUNCTION 'ENQUEUE_EQQALS1'
  72. EXPORTING
  73.   prueflos = prueflos.
  75. CALL FUNCTION 'QPSE_LOT_READ'
  76. EXPORTING
  77.   i_prueflos = prueflos
  78. IMPORTING
  79.   e_qals     = qals
  80. EXCEPTIONS
  81.   no_lot     = 1.
  83. IF NOT sy-subrc IS INITIAL.
  84.   MESSAGE e102(qa) WITH SPACE.
  85. ENDIF.
  87. *-----------------
  88. * Prüfen Status
  89. CALL FUNCTION 'QAST_STATUS_CHECK'
  90. EXPORTING
  91.   i_objnr          = qals-objnr
  92.   i_status         = 'I0218' "Status VE getroffen
  93. EXCEPTIONS
  94.   status_not_activ = 1.
  96. IF NOT sy-subrc IS INITIAL.
  97.   MESSAGE e102(qv) WITH qals-prueflos.
  98. ENDIF.
  100. CALL FUNCTION 'QEVA_UD_READ'
  101. EXPORTING
  102.   i_prueflos = qals-prueflos
  103. IMPORTING
  104.   e_qave     = qave.
  106. START-OF-SELECTION.
  107. PERFORM qals_aendern.
  109. ******************************************
  110. ******************************
  112. FORM qals_aendern.
  113.   PERFORM status_fix_setzen USING 'I0002' c_kreuz.
  115.   PERFORM status_fix_setzen USING 'I0216' space.
  117.   PERFORM status_fix_setzen USING 'I0217' space.
  119.   PERFORM status_fix_setzen USING 'I0218' space.
  121.   CLEAR: qals-stat14.
  122.   CLEAR: qals-stat35.
  123.   CLEAR: qave-vauswahlmg,
  124.   qave-vwerks,
  125.   qave-versionam,
  126.   qave-vcodegrp,
  127.   qave-vcode,
  128.   qave-vbewertung,
  129.   qave-versioncd,
  130.   qave-vfolgeakti,
  131.   qave-qkennzahl.
  133. *--... verbuchen
  134.   CALL FUNCTION 'QEVA_UD_UPDATE' IN UPDATE
  135.   TASK
  136.   EXPORTING
  137.     qals_new = qals
  138.     qave_new = qave.
  140.   COMMIT WORK.
  141.   MESSAGE s101(qa) WITH qals-prueflos.
  142. ENDFORM.
  145. *   Setzen eines Status aufgrund von Voreinstellungen wie QMAT etc.    *
  146. *  -->  STATUS    Status der gesetzt werden soll
  147. *  -->  AKTIV     Status wird aktiviert sonst deaktiviert
  149. FORM status_fix_setzen USING
  150.       VALUE(status) LIKE tj02-istat
  151.       VALUE(aktiv) LIKE c_kreuz.
  153. * lokale Tabelle fuer Statusfortschreibung
  154.   DATA: BEGIN OF l_stattab OCCURS 0.
  155.     INCLUDE STRUCTURE jstat.
  156.   DATA  END OF l_stattab.
  158. * Falls Objektnr. nicht gefüllt. --> Fehlermeldung !!!
  159.   IF qals-objnr EQ space.
  160.     MESSAGE e013(qv).
  161. *   Fehlende Objektnr.: Problem fü
  162.   ENDIF.
  164.   MOVE status TO l_stattab-stat.
  166.   IF aktiv EQ space.
  167.     MOVE c_kreuz TO l_stattab-inact.
  168.   ENDIF.
  170.   APPEND l_stattab.
  172.   CALL FUNCTION 'STATUS_CHANGE_INTERN'
  173.   EXPORTING
  174.     check_only = space
  175.     objnr      = qals-objnr
  176.   TABLES
  177.     status     = l_stattab.
  179. ENDFORM.                               " STATUS_FIX_SETZEN

2.2 ZRQEVAC50

  1. *&---------------------------------------------------------------------*
  2. *& Report ZRQEVAC50
  3. *&---------------------------------------------------------------------*
  4. *&
  5. *&---------------------------------------------------------------------*
  6. REPORT ZRQEVAC50.
  8. "***********************************************************************
  9. "* Report is provided by Modification Note 175842                      *
  10. "*                                                                     *
  11. "*  CAUTION: Please be aware that this is a Modification!              *
  12. "*  Please refer to note 170183.                                       *
  13. "***********************************************************************
  14. TYPES:
  15. t_mkpf_tab LIKE mkpf  OCCURS 0,
  16. t_mseg_tab LIKE mseg  OCCURS 0.
  17. PARAMETERS:
  18. prueflos LIKE qals-prueflos OBLIGATORY MEMORY ID qls.
  19. DATA:
  20.       g_msgv1       LIKE sy-msgv1,
  21.       g_qals        LIKE qals,
  22.       g_qals_leiste LIKE qals,
  23.       g_qamb_tab    TYPE qambtab,
  24.       g_qamb_vb_tab TYPE qambtab,
  25.       g_mkpf_tab    TYPE t_mkpf_tab,
  26.       g_mseg_tab    TYPE t_mseg_tab,
  27.       g_subrc       LIKE sy-subrc.
  29. START-OF-SELECTION.
  31. PERFORM enqueue_qals USING prueflos
  32.       g_subrc.
  33. IF NOT g_subrc IS INITIAL.
  34.   MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  35.   WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  36.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  37. ENDIF.
  38. PERFORM read_qals USING prueflos
  39.       g_qals
  40.       g_qals_leiste
  41.       g_subrc.
  42. IF NOT g_subrc IS INITIAL.
  43.   MESSAGE ID 'QA' TYPE 'S' NUMBER '102'
  44.   WITH prueflos.
  45.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  46. ENDIF.
  47. PERFORM check_lot USING g_qals
  48.       g_subrc.
  49. IF NOT g_subrc IS INITIAL.
  50.   CASE g_subrc.
  51.   WHEN 256.
  52.     g_msgv1 = 'Lot & does not refer to a material doc'. "#EC NOTEXT
  53.   WHEN 128.
  54.     g_msgv1 = 'Material & is serialized'.               "#EC NOTEXT
  55.     REPLACE '&' WITH g_qals-matnr INTO g_msgv1.
  56.   WHEN  64.
  57.     g_msgv1 = 'Lot & is not stock relevant'.            "#EC NOTEXT
  58.   WHEN  32.
  59.     g_msgv1 = 'Lot &: No stock transferred'.            "#EC NOTEXT
  60.   WHEN  16.
  61.     g_msgv1 = 'Lot & is cancelled'.                     "#EC NOTEXT
  62.   WHEN   8.
  63.     g_msgv1 = 'Lot & is archived'.                      "#EC NOTEXT
  64.   WHEN   4.
  65.     g_msgv1 = 'Lot & is blocked'.                       "#EC NOTEXT
  66.   WHEN   2.
  67.     g_msgv1 = 'Lot & is HU managed'.                    "#EC NOTEXT
  68.   ENDCASE.
  69.   REPLACE '&' WITH prueflos INTO g_msgv1.
  70.   MESSAGE ID '00' TYPE 'S' NUMBER '208'
  71.   WITH g_msgv1.
  72.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  73. ENDIF.
  74. PERFORM read_qamb USING g_qals
  75.       g_qamb_tab
  76.       g_subrc.
  77. IF NOT g_subrc IS INITIAL.
  78.   MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  79.   WITH prueflos.
  80.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  81. ENDIF.
  82. PERFORM read_mkpf USING g_qamb_tab
  83.       g_mkpf_tab
  84.       g_subrc.
  85. IF NOT g_subrc IS INITIAL.
  86.   MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  87.   WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  88.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  89. ENDIF.
  90. PERFORM check_mkpf USING g_mkpf_tab
  91.       g_subrc.
  92. IF NOT g_subrc IS INITIAL.
  93.   MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  94.   WITH prueflos.
  95.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  96. ENDIF.
  97. PERFORM read_mseg USING g_mkpf_tab
  98.       g_mseg_tab
  99.       g_subrc.
  100. IF NOT g_subrc IS INITIAL.
  101.   MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  102.   WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  103.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  104. ENDIF.
  105. PERFORM check_mseg USING g_mseg_tab
  106.       g_qamb_tab
  107.       g_subrc.
  108. IF NOT g_subrc IS INITIAL.
  109.   MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  110.   WITH prueflos.
  111.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  112. ENDIF.
  113. PERFORM create_goods_movement USING g_qals
  114.       g_mseg_tab
  115.       g_subrc.
  116. IF NOT g_subrc IS INITIAL.
  117.   MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
  118.   WITH prueflos.
  119.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  120. ENDIF.
  121. PERFORM post_goods_movement.
  122. PERFORM post_data USING g_qals
  123.       g_qals_leiste
  124.       g_qamb_tab
  125.       g_qamb_vb_tab
  126.       g_subrc.
  127. IF NOT g_subrc IS INITIAL.
  128.   MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  129.   WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  130.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  131. ELSE.
  132.   COMMIT WORK AND WAIT.
  133.   g_msgv1 = 'inspection lot &'.                           "#EC NOTEXT
  134.   REPLACE '&' WITH prueflos INTO g_msgv1.
  135.   MESSAGE ID '00' TYPE 'S' NUMBER '368'
  136.   WITH 'Stock posting reversed for ' g_msgv1.     "#EC NOTEXT
  137.   SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  138. ENDIF.
  139. *----------------------------------------------------------------------*
  140. *       Form  ENQUEUE_QALS                                             *
  141. *----------------------------------------------------------------------*
  142. *       Los sperren                                                    *
  143. *----------------------------------------------------------------------*
  144. FORM enqueue_qals USING p_prueflos LIKE qals-prueflos
  145.       p_subrc    LIKE sy-subrc.
  146.   CLEAR: p_subrc.
  147.   CALL FUNCTION 'ENQUEUE_EQQALS1'
  148.   EXPORTING
  149.     prueflos       = p_prueflos
  150.   EXCEPTIONS
  151.     foreign_lock   = 1
  152.     system_failure = 2
  153.     OTHERS         = 3.
  154.   p_subrc = sy-subrc.
  155. ENDFORM.                               " ENQUEUE_QALS
  156. *----------------------------------------------------------------------*
  157. *       Form  READ_QALS                                                *
  158. *----------------------------------------------------------------------*
  159. *       Prüflos lesen                                                  *
  160. *----------------------------------------------------------------------*
  161. FORM read_qals USING p_prueflos    LIKE qals-prueflos
  162.       p_qals        LIKE qals
  163.       p_qals_leiste LIKE qals
  164.       p_subrc       LIKE sy-subrc.
  165.   CLEAR: p_subrc.
  166.   CALL FUNCTION 'QPSE_LOT_READ'
  167.   EXPORTING
  168.     i_prueflos  = p_prueflos
  169.     i_reset_lot = 'X'
  170.   IMPORTING
  171.     e_qals      = p_qals
  172.   EXCEPTIONS
  173.     no_lot      = 1.
  174.   p_subrc = sy-subrc.
  175.   IF p_subrc IS INITIAL.
  176.     p_qals_leiste = p_qals.
  177.   ELSE.
  178.     CLEAR: p_qals,
  179.     p_qals_leiste.
  180.   ENDIF.
  181. ENDFORM.                               " READ_QALS
  182. *----------------------------------------------------------------------*
  183. *       Form  CHECK_LOT                                                *
  184. *----------------------------------------------------------------------*
  185. *       Prüflos prüfen                                                 *
  186. *----------------------------------------------------------------------*
  187. FORM check_lot USING p_qals  LIKE qals
  188.       p_subrc LIKE sy-subrc.
  189.   DATA:
  190.         l_stat     LIKE jstat,
  191.         l_stat_tab LIKE jstat OCCURS 0 WITH HEADER LINE.
  192.   p_subrc = 256.
  193. */No reference to material document
  194.   IF p_qals-zeile IS INITIAL.
  195.     EXIT.
  196.   ELSE.
  197.     p_subrc = 128.
  198.   ENDIF.
  199. */Serialized Material
  200.   IF NOT p_qals-sernp IS INITIAL.
  201.     EXIT.
  202.   ELSE.
  203.     p_subrc = 64.
  204.   ENDIF.
  205. */BERF
  206.   CALL FUNCTION 'STATUS_CHECK'
  207.   EXPORTING
  208.     objnr             = p_qals-objnr
  209.     status            = 'I0203'
  210.   EXCEPTIONS
  211.     status_not_active = 2.
  212.   IF NOT sy-subrc IS INITIAL.
  213.     EXIT.
  214.   ELSE.
  215.     p_subrc = 32.
  216.   ENDIF.
  217. */BTEI & BEND
  218.   CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
  219.   l_stat-stat = 'I0219'. APPEND l_stat TO l_stat_tab. "BTEI
  220.   l_stat-stat = 'I0220'. APPEND l_stat TO l_stat_tab. "BEND
  221.   CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
  222.   EXPORTING
  223.     objnr        = p_qals-objnr
  224.   TABLES
  225.     status_check = l_stat_tab.
  226.   IF l_stat_tab[] IS INITIAL.
  227.     EXIT.
  228.   ELSE.
  229.     p_subrc = 16.
  230.   ENDIF.
  231. */LSTO & LSTV
  232.   CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
  233.   l_stat-stat = 'I0224'. APPEND l_stat TO l_stat_tab. "LSTO
  234.   l_stat-stat = 'I0232'. APPEND l_stat TO l_stat_tab. "LSTV
  235.   CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
  236.   EXPORTING
  237.     objnr        = p_qals-objnr
  238.   TABLES
  239.     status_check = l_stat_tab.
  240.   IF NOT l_stat_tab[] IS INITIAL.
  241.     EXIT.
  242.   ELSE.
  243.     p_subrc = 8.
  244.   ENDIF.
  245. */ARSP & ARCH & REO1 & REO2 & REO3
  246.   CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
  247.   l_stat-stat = 'I0225'. APPEND l_stat TO l_stat_tab. "ARSP
  248.   l_stat-stat = 'I0226'. APPEND l_stat TO l_stat_tab. "ARCH
  249.   l_stat-stat = 'I0227'. APPEND l_stat TO l_stat_tab. "REO3
  250.   l_stat-stat = 'I0228'. APPEND l_stat TO l_stat_tab. "REO2
  251.   l_stat-stat = 'I0229'. APPEND l_stat TO l_stat_tab. "REO1
  252.   CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
  253.   EXPORTING
  254.     objnr        = p_qals-objnr
  255.   TABLES
  256.     status_check = l_stat_tab.
  257.   IF NOT l_stat_tab[] IS INITIAL.
  258.     EXIT.
  259.   ELSE.
  260.     p_subrc = 4.
  261.   ENDIF.
  262. */SPER
  263.   CALL FUNCTION 'STATUS_CHECK'
  264.   EXPORTING
  265.     objnr             = p_qals-objnr
  266.     status            = 'I0043'
  267.   EXCEPTIONS
  268.     status_not_active = 2.
  269.   IF sy-subrc IS INITIAL.
  270.     EXIT.
  271.   ELSE.
  272.     p_subrc = 2.
  273.   ENDIF.
  274. */HUM
  275.   CALL FUNCTION 'STATUS_CHECK'
  276.   EXPORTING
  277.     objnr             = p_qals-objnr
  278.     status            = 'I0443'
  279.   EXCEPTIONS
  280.     status_not_active = 2.
  281.   IF sy-subrc IS INITIAL.
  282.     EXIT.
  283.   ELSE.
  284.     p_subrc = 0.
  285.   ENDIF.
  286. ENDFORM.                               " CHECK_LOT
  287. *----------------------------------------------------------------------*
  288. *       Form  READ_QAMB                                                *
  289. *----------------------------------------------------------------------*
  290. *       QAMBs lesen                                                    *
  291. *----------------------------------------------------------------------*
  292. FORM read_qamb USING p_qals     LIKE qals
  293.       p_qamb_tab TYPE qambtab
  294.       p_subrc    LIKE sy-subrc.
  295.   CLEAR: p_subrc.
  296.   SELECT * FROM qamb INTO TABLE p_qamb_tab
  297.   WHERE prueflos =  p_qals-prueflos
  298.   AND typ   = '3'.
  299.   p_subrc = sy-subrc.
  300. ENDFORM.                               " READ_QAMB
  301. *----------------------------------------------------------------------*
  302. *       Form  READ_MKPF                                                *
  303. *----------------------------------------------------------------------*
  304. *       Read material document header                                  *
  305. *----------------------------------------------------------------------*
  306. FORM read_mkpf USING p_qamb_tab TYPE qambtab
  307.       p_mkpf_tab TYPE t_mkpf_tab
  308.       p_subrc    LIKE sy-subrc.
  309.   DATA:
  310.   BEGIN OF l_mkpf_key_tab OCCURS 0,
  311.     mblnr LIKE mkpf-mblnr,
  312.     mjahr LIKE mkpf-mjahr,
  313.   END   OF l_mkpf_key_tab.
  314.   DATA:
  315.         l_qamb  LIKE qamb,
  316.         l_mkpf  LIKE mkpf,
  317.         l_trtyp LIKE t158-trtyp VALUE 'A',
  318.         l_vgart LIKE t158-vgart VALUE 'WQ',
  319.         l_xexit LIKE qm00-qkz.
  320.   p_subrc = 4.
  321.   LOOP AT p_qamb_tab INTO l_qamb.
  322.     l_mkpf_key_tab-mblnr = l_qamb-mblnr.
  323.     l_mkpf_key_tab-mjahr = l_qamb-mjahr.
  324.     COLLECT l_mkpf_key_tab.
  325.   ENDLOOP.
  326.   LOOP AT l_mkpf_key_tab.
  327.     CALL FUNCTION 'ENQUEUE_EMMKPF'
  328.     EXPORTING
  329.       mblnr          = l_mkpf_key_tab-mblnr
  330.       mjahr          = l_mkpf_key_tab-mjahr
  331.     EXCEPTIONS
  332.       foreign_lock   = 1
  333.       system_failure = 2
  334.       OTHERS         = 3.
  335.     IF NOT sy-subrc IS INITIAL.
  336.       l_xexit = 'X'.
  337.       EXIT.
  338.     ENDIF.
  339.     CLEAR: l_mkpf.
  340.     CALL FUNCTION 'MB_READ_MATERIAL_HEADER'
  341.     EXPORTING
  342.       mblnr         = l_mkpf_key_tab-mblnr
  343.       mjahr         = l_mkpf_key_tab-mjahr
  344.       trtyp         = l_trtyp
  345.       vgart         = l_vgart
  346.     IMPORTING
  347.       kopf          = l_mkpf
  348.     EXCEPTIONS
  349.       error_message = 1.
  350.     IF NOT sy-subrc IS INITIAL.
  351.       l_xexit = 'X'.
  352.       EXIT.
  353.     ELSE.
  354.       APPEND l_mkpf TO p_mkpf_tab.
  355.     ENDIF.
  356.   ENDLOOP.
  357.   IF NOT l_xexit IS INITIAL.
  358.     EXIT.
  359.   ELSE.
  360.     p_subrc = 0.
  361.   ENDIF.
  362. ENDFORM.                               " READ_MKPF
  363. *----------------------------------------------------------------------*
  364. *       Form  READ_MSEG                                                *
  365. *----------------------------------------------------------------------*
  366. *       MSEGs lesen                                                    *
  367. *----------------------------------------------------------------------*
  368. FORM read_mseg USING p_mkpf_tab TYPE t_mkpf_tab
  369.       p_mseg_tab TYPE t_mseg_tab
  370.       p_subrc    LIKE sy-subrc.
  371.   DATA:
  372.         l_mkpf     LIKE mkpf,
  373.         l_mseg_tab LIKE mseg OCCURS 0 WITH HEADER LINE,
  374.         l_trtyp    LIKE t158-trtyp VALUE 'A',
  375.         l_xexit    LIKE qm00-qkz.
  376.   p_subrc = 4.
  377.   LOOP AT p_mkpf_tab INTO l_mkpf.
  378.     CLEAR: l_mseg_tab. REFRESH: l_mseg_tab.
  379.     CALL FUNCTION 'MB_READ_MATERIAL_POSITION'
  380.     EXPORTING
  381.       mblnr         = l_mkpf-mblnr
  382.       mjahr         = l_mkpf-mjahr
  383.       trtyp         = l_trtyp
  384. */            ZEILB  = P_ZEILE
  385. */            ZEILE  = P_ZEILE
  386.     TABLES
  387.       seqtab        = l_mseg_tab
  388.     EXCEPTIONS
  389.       error_message = 1.
  390.     IF NOT sy-subrc IS INITIAL.
  391.       l_xexit = 'X'.
  392.       EXIT.
  393.     ELSE.
  394.       APPEND LINES OF l_mseg_tab TO p_mseg_tab.
  395.     ENDIF.
  396.   ENDLOOP.
  397.   IF NOT l_xexit IS INITIAL.
  398.     EXIT.
  399.   ELSE.
  400. */  XAuto-Zeilen und Chargenzustands?nderung werden gel?scht
  401.     DELETE p_mseg_tab WHERE xauto NE space
  402.     OR bwart EQ '341'
  403.     OR bwart EQ '342'.
  404.     p_subrc = 0.
  405.   ENDIF.
  406. ENDFORM.                               " READ_MSEG
  407. *----------------------------------------------------------------------*
  408. *       Form  CREATE_GOODS_MOVEMENT                                    *
  409. *----------------------------------------------------------------------*
  410. *       Warenbewegung anlegen                                          *
  411. *----------------------------------------------------------------------*
  412. FORM create_goods_movement USING p_qals     LIKE qals
  413.       p_mseg_tab TYPE t_mseg_tab
  414.       p_subrc    LIKE sy-subrc.
  415.   DATA:
  416.         l_lmengezub LIKE qals-lmengezub,
  417.         l_lmengegeb LIKE qals-lmengezub,
  418.         l_mbqss     LIKE mbqss,
  419.         l_imkpf     LIKE imkpf,
  420.         l_imseg     LIKE imseg,
  421.         l_imseg_tab LIKE imseg OCCURS 1,
  422.         l_emkpf     LIKE emkpf,
  423.         l_emseg     LIKE emseg,
  424.         l_emseg_tab LIKE emseg OCCURS 1,
  425.         l_mseg      LIKE mseg,
  426.         l_mseg_tab  LIKE mseg  OCCURS 1,
  427.         l_tcode     LIKE sy-tcode VALUE 'QA11',
  428.         l_tabix     LIKE sy-tabix VALUE 1,
  429.         l_xstbw     LIKE t156-xstbw.
  430.   CLEAR: p_subrc.
  431. */QAMB initialisieren
  432.   CALL FUNCTION 'QAMB_REFRESH_DATA'.
  433. */Kopf füllen
  434.   l_imkpf-bldat = sy-datlo.
  435.   l_imkpf-budat = sy-datlo.
  436.   l_imkpf-bktxt = 'Cancellation of QM UD postings'.         "#EC NOTEXT
  437. */Ursprüngliche zu buchende Menge merken + inkrementieren
  438.   l_lmengezub = p_qals-lmengezub.
  439.   l_lmengegeb =   p_qals-lmenge01
  440.   + p_qals-lmenge02
  441.   + p_qals-lmenge03
  442.   + p_qals-lmenge04
  443.   + p_qals-lmenge05
  444.   + p_qals-lmenge06
  445.   + p_qals-lmenge07
  446.   + p_qals-lmenge08
  447.   + p_qals-lmenge09.
  448. */Zeilen aufbauen
  449.   l_mseg_tab[] = p_mseg_tab[].
  450.   LOOP AT l_mseg_tab INTO l_mseg.
  451.     MOVE-CORRESPONDING l_mseg  TO l_mbqss.
  452.     MOVE-CORRESPONDING l_mbqss TO l_imseg.
  453. */  Referenzbeleg übergeben, falls Bestellnummer gefüllt
  454.     IF NOT l_mseg-ebeln IS INITIAL.
  455.       MOVE: l_mseg-lfbnr TO l_imseg-lfbnr,
  456.       l_mseg-lfbja TO l_imseg-lfbja,
  457.       l_mseg-lfpos TO l_imseg-lfpos.
  458.     ENDIF.
  459.     MOVE l_mseg-kdauf          TO l_imseg-kdauf.
  460.     MOVE l_mseg-kdpos          TO l_imseg-kdpos.
  461.     MOVE l_mseg-ps_psp_pnr     TO l_imseg-ps_psp_pnr.
  462. */  Umlagerungsfelder setzen
  463.     MOVE:
  464.     l_mseg-ummat  TO l_imseg-ummat,
  465.     l_mseg-umwrk  TO l_imseg-umwrk,
  466.     l_mseg-umlgo  TO l_imseg-umlgo,
  467.     l_mseg-umcha  TO l_imseg-umcha.
  468. */  Storno-Beleg setzen
  469.     MOVE: l_mseg-mjahr  TO l_imseg-sjahr,
  470.     l_mseg-mblnr  TO l_imseg-smbln,
  471.     l_mseg-zeile  TO l_imseg-smblp.
  472. */  Falsch gefüllte Felder initialisieren
  473.     CLEAR: l_imseg-mblnr,
  474.     l_imseg-menge,
  475.     l_imseg-meins.
  476. */  Bewegungsart lesen
  477.     SELECT SINGLE xstbw FROM t156 INTO l_xstbw
  478.     WHERE bwart = l_imseg-bwart.
  479.     IF NOT sy-subrc IS INITIAL.
  480.       p_subrc = 4.
  481.       EXIT.
  482.     ENDIF.
  483. */  Werk/Lagerort füllen
  484.     IF p_qals-stat11 IS INITIAL.
  485.       IF l_xstbw IS INITIAL.
  486.         MOVE p_qals-lagortvorg TO l_imseg-lgort.
  487.       ELSE.
  488.         MOVE p_qals-lagortvorg TO l_imseg-umlgo.
  489.       ENDIF.
  490.     ENDIF.
  491.     IF l_xstbw IS INITIAL.
  492.       MOVE p_qals-werkvorg TO l_imseg-werks.
  493.     ELSE.
  494.       MOVE p_qals-werkvorg TO l_imseg-umwrk.
  495.     ENDIF.
  496. */  Zus?tzliche Felder
  497.     MOVE p_qals-mengeneinh TO l_imseg-erfme.
  498.     "MOVE P_GRUND           TO L_IMSEG-GRUND.
  499.     "MOVE P_ELIKZ           TO L_IMSEG-ELIKZ.
  500. */  Kennzeichen Storno-Buchung setzen
  501.     MOVE 'X'               TO l_imseg-xstob.
  502.       MOVE p_qals-prueflos   TO l_imseg-qplos.
  503.       APPEND l_imseg TO l_imseg_tab.
  504.       IF p_qals-stat11 IS INITIAL.
  505.         ADD      l_imseg-erfmg TO   l_lmengezub.
  506.         SUBTRACT l_imseg-erfmg FROM l_lmengegeb.
  507.       ELSE.
  508.         IF     l_imseg-kzbew EQ space
  509.         AND l_imseg-werks NE space
  510.         AND l_imseg-lgort NE space
  511.         AND l_imseg-umwrk NE space
  512.         AND l_imseg-umlgo NE space
  513.         AND l_imseg-werks EQ l_imseg-umwrk
  514.         AND l_imseg-umlgo EQ l_imseg-umlgo.
  515. */      Dummy Buchung bei WE-Sperrbestand & Stichprobe
  516.         ELSE.
  517.           ADD      l_imseg-erfmg TO   l_lmengezub.
  518.           SUBTRACT l_imseg-erfmg FROM l_lmengegeb.
  519.         ENDIF.
  520.       ENDIF.
  521.     ENDLOOP.
  522.     IF NOT p_qals-stat11 IS INITIAL.
  523. */  Bei WE-Sperrbestand und Stichprobenbuchung Zeilen tauschen
  524.       DO.
  525.         READ TABLE l_imseg_tab INDEX sy-INDEX INTO l_imseg.
  526.         IF     sy-subrc      IS INITIAL
  527.         AND l_imseg-kzbew EQ space
  528.         AND l_imseg-werks NE space
  529.         AND l_imseg-lgort NE space
  530.         AND l_imseg-umwrk NE space
  531.         AND l_imseg-umlgo NE space
  532.         AND l_imseg-werks EQ l_imseg-umwrk
  533.         AND l_imseg-umlgo EQ l_imseg-umlgo.
  534.           IF sy-tabix NE l_tabix.
  535.             DELETE l_imseg_tab INDEX sy-tabix.
  536.             INSERT l_imseg     INTO  l_imseg_tab INDEX l_tabix.
  537.             l_tabix = l_tabix + 1.
  538.           ELSE.
  539.             l_tabix = l_tabix + 1.
  540.             CONTINUE.
  541.           ENDIF.
  542.       ELSEIF sy-subrc IS INITIAL.
  543.           CONTINUE.
  544.         ELSE.
  545.           EXIT.                          "from do
  546.         ENDIF.
  547.       ENDDO.
  548.     ENDIF.
  549. */QM deaktivieren
  550.     CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
  551.     EXPORTING
  552.       aktiv = space.
  553. */Buchen
  554.     CALL FUNCTION 'MB_CREATE_GOODS_MOVEMENT'
  555.     EXPORTING
  556.       imkpf = l_imkpf
  557.       xallp = 'X'
  558.       xallr = 'X'
  559.       ctcod = l_tcode
  560.       xqmcl = ' '
  561.     IMPORTING
  562.       emkpf = l_emkpf
  563.     TABLES
  564.       imseg = l_imseg_tab
  565.       emseg = l_emseg_tab.
  566. */QM wieder aktivieren
  567.     CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
  568.     EXPORTING
  569.       aktiv = 'X'.
  570. */Buchung auswerten
  571.     IF l_emkpf-subrc GT 1.
  572.       IF l_emkpf-msgid NE space.
  573. */    Fehler auf Kopfebene
  574.         MESSAGE ID l_emkpf-msgid TYPE 'S'
  575.         NUMBER l_emkpf-msgno
  576.         WITH l_emkpf-msgv1 l_emkpf-msgv2
  577.         l_emkpf-msgv3 l_emkpf-msgv4.
  578.         SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  579.       ELSE.
  580. */    Fehler auf Zeilenebene (Ausgabe des ersten Fehlers)
  581.         LOOP AT l_emseg_tab INTO l_emseg.
  582.           IF l_emseg-msgid NE space.
  583.             MESSAGE ID l_emseg-msgid TYPE 'S'
  584.             NUMBER l_emseg-msgno
  585.             WITH l_emseg-msgv1 l_emseg-msgv2
  586.             l_emseg-msgv3 l_emseg-msgv4.
  587.             SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  588.           ENDIF.
  589.         ENDLOOP.
  590.       ENDIF.
  591.     ENDIF.
  592.     LOOP AT l_emseg_tab INTO l_emseg.
  593.       CALL FUNCTION 'QAMB_COLLECT_RECORD'
  594.       EXPORTING
  595.         lotnumber   = p_qals-prueflos
  596.         docyear     = l_emkpf-mjahr
  597.         docnumber   = l_emkpf-mblnr
  598.         docposition = l_emseg-mblpo
  599.         TYPE        = '7'.
  600.     ENDLOOP.
  601. */Sonderkorrektur für Frei-An-Frei & WE-Sperr-An-We-Sperr
  602.     IF NOT p_qals-stat11 IS INITIAL.
  603.       IF p_qals-lmenge04 EQ l_lmengegeb.
  604.         ADD      p_qals-lmenge04 TO   l_lmengezub.
  605.         SUBTRACT p_qals-lmenge04 FROM l_lmengegeb.
  606.       ENDIF.
  607.   ELSEIF p_qals-insmk IS INITIAL.
  608.       IF         p_qals-lmenge01 GE l_lmengegeb
  609.       AND NOT p_qals-lmenge01 IS INITIAL.
  610.         ADD      l_lmengegeb     TO   l_lmengezub.
  611.         SUBTRACT l_lmengegeb     FROM l_lmengegeb.
  612.       ENDIF.
  613.     ENDIF.
  614.     CLEAR: p_qals-stat34,
  615.     p_qals-matnrneu,
  616.     p_qals-chargneu,
  617.     p_qals-lmenge01,
  618.     p_qals-lmenge02,
  619.     p_qals-lmenge03,
  620.     p_qals-lmenge04,
  621.     p_qals-lmenge05,
  622.     p_qals-lmenge06,
  623.     p_qals-lmenge07,
  624.     p_qals-lmenge08,
  625.     p_qals-lmenge09.
  626.     p_qals-lmengezub = l_lmengezub.
  627.     IF NOT l_lmengegeb IS INITIAL.
  628.       p_subrc = 4.
  629.     ENDIF.
  630.   ENDFORM.                               " CREATE_GOODS_MOVEMENT
  631. *----------------------------------------------------------------------*
  632. *       Form  POST_GOODS_MOVEMENT                                      *
  633. *----------------------------------------------------------------------*
  634. *       Warenbewegung buchen                                           *
  635. *----------------------------------------------------------------------*
  636.   FORM post_goods_movement.
  637.     CALL FUNCTION 'MB_POST_GOODS_MOVEMENT'.
  638.   ENDFORM.                               " POST_GOODS_MOVEMENT
  639. *----------------------------------------------------------------------*
  640. *       Form  POST_DATA                                                *
  641. *----------------------------------------------------------------------*
  642. *       QM-Daten verbuchen                                             *
  643. *----------------------------------------------------------------------*
  644.   FORM post_data USING p_qals        LIKE qals
  645.         p_qals_leiste LIKE qals
  646.         p_qamb_tab    TYPE qambtab
  647.         p_qamb_vb_tab TYPE qambtab
  648.         p_subrc       LIKE sy-subrc.
  649.     DATA:
  650.           l_stat     LIKE jstat,
  651.           l_stat_tab LIKE jstat OCCURS 0,
  652.           l_qamb     LIKE qamb,
  653.           l_updkz    LIKE qalsvb-upsl VALUE 'U'.
  654. */QAMBs umsetzen (7 = VE-Buchung storniert)
  655.     LOOP AT p_qamb_tab INTO l_qamb.
  656.       l_qamb-typ = '7'.
  657.       APPEND l_qamb TO p_qamb_vb_tab.
  658.     ENDLOOP.
  659. */BERF & BTEI zurücknehmen
  660.     CLEAR l_stat. CLEAR l_stat_tab.
  661.     l_stat-inact = 'X'.
  662.     l_stat-stat = 'I0219'. APPEND l_stat TO l_stat_tab. "BTEI
  663.     l_stat-stat = 'I0220'. APPEND l_stat TO l_stat_tab. "BEND
  664.     CALL FUNCTION 'STATUS_CHANGE_INTERN'
  665.     EXPORTING
  666.       objnr         = p_qals-objnr
  667.     TABLES
  668.       status        = l_stat_tab
  669.     EXCEPTIONS
  670.       error_message = 1.
  671.     IF sy-subrc <> 0.
  672.       MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
  673.       WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  674.       SUBMIT (sy-repid) VIA SELECTION-SCREEN.
  675.     ENDIF.
  676. */Prüflos aktualisieren
  677.     CALL FUNCTION 'QPL1_UPDATE_MEMORY'
  678.     EXPORTING
  679.       i_qals  = p_qals
  680.       i_updkz = l_updkz.
  681.     CALL FUNCTION 'QPL1_INSPECTION_LOTS_POSTING'
  682.     EXPORTING
  683.       i_mode = '1'.
  684.     CALL FUNCTION 'STATUS_UPDATE_ON_COMMIT'.
  685. */QAMB initialisieren
  686.     CALL FUNCTION 'QAMB_REFRESH_DATA'.
  687.     PERFORM update_qamb ON COMMIT.
  688.     p_subrc = 0.
  689.   ENDFORM.                               " POST_DATA
  690. *----------------------------------------------------------------------*
  691. *       Form  UPDATE_QAMB                                              *
  692. *----------------------------------------------------------------------*
  693. *       Update auf QAMB                                                *
  694. *----------------------------------------------------------------------*
  695.   FORM update_qamb.
  696.     CALL FUNCTION 'QEVA_QAMB_CANCEL' IN UPDATE TASK
  697.     EXPORTING
  698.       t_qamb_tab = g_qamb_vb_tab.
  699.   ENDFORM.                               " UPDATE_QAMB
  700. *----------------------------------------------------------------------*
  701. *       Form  CHECK_MSEG                                               *
  702. *----------------------------------------------------------------------*
  703. *       MSEGs prüfen                                                   *
  704. *----------------------------------------------------------------------*
  705.   FORM check_mseg USING p_mseg_tab TYPE t_mseg_tab
  706.         p_qamb_tab TYPE qambtab
  707.         p_subrc    LIKE sy-subrc.
  708.     DATA:
  709.           l_mseg_stor_tab LIKE mseg OCCURS 0 WITH HEADER LINE.
  710.     CLEAR: p_subrc.
  711.     IF p_mseg_tab[] IS NOT INITIAL.
  713. */Zeilen bereits storniert?
  714.       SELECT mblnr mjahr zeile smbln sjahr smblp
  715.       FROM mseg INTO CORRESPONDING FIELDS OF TABLE l_mseg_stor_tab
  716.       FOR ALL ENTRIES IN p_mseg_tab
  717.       WHERE smbln EQ p_mseg_tab-mblnr
  718.       AND sjahr EQ p_mseg_tab-mjahr
  719.       AND smblp EQ p_mseg_tab-zeile.
  720.     ENDIF.
  721.     IF sy-subrc IS INITIAL.
  722.       LOOP AT l_mseg_stor_tab.
  723.         DELETE p_mseg_tab WHERE     mblnr = l_mseg_stor_tab-smbln
  724.         AND mjahr = l_mseg_stor_tab-sjahr
  725.         AND zeile = l_mseg_stor_tab-smblp.
  726.         DELETE p_qamb_tab WHERE     mblnr = l_mseg_stor_tab-smbln
  727.         AND mjahr = l_mseg_stor_tab-sjahr
  728.         AND zeile = l_mseg_stor_tab-smblp.
  729.       ENDLOOP.
  730.       IF p_mseg_tab[] IS INITIAL.
  731.         p_subrc = 4.
  732.         EXIT.
  733.       ENDIF.
  734.     ENDIF.
  735.   ENDFORM.                               " CHECK_MSEG
  736. *----------------------------------------------------------------------*
  737. *       Form  CHECK_MKPF                                               *
  738. *----------------------------------------------------------------------*
  739. *       Materialbelege prüfen (Wurde durch VE-Buchung Prüfllos erzeugt?*
  740. *----------------------------------------------------------------------*
  741.   FORM check_mkpf USING p_mkpf_tab TYPE t_mkpf_tab
  742.         p_subrc    LIKE sy-subrc.
  743.     DATA:
  744.           l_mkpf_tab TYPE t_mkpf_tab.
  745.     CLEAR: p_subrc.
  746.     IF p_mkpf_tab[] IS NOT INITIAL.
  747.       SELECT mblnr FROM qamb INTO CORRESPONDING FIELDS OF TABLE l_mkpf_tab
  748.       FOR ALL ENTRIES IN p_mkpf_tab
  749.       WHERE mblnr EQ p_mkpf_tab-mblnr
  750.       AND mjahr EQ p_mkpf_tab-mjahr
  751.       AND typ   = '1'.
  752.     ENDIF.
  753.     IF sy-subrc IS INITIAL.
  754.       p_subrc = 4.
  755.     ENDIF.
  756.   ENDFORM.                               " CHECK_MKPF