前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >SAP检验批次批量取消程序示例

SAP检验批次批量取消程序示例

作者头像
matinal
发布2023-10-13 18:59:05
2500
发布2023-10-13 18:59:05
举报
文章被收录于专栏:SAP TechnicalSAP Technical

=>Reference

主程序

代码语言:javascript
复制
	*----------------------------------------------------------------------*
	* 参照类型定义
	*----------------------------------------------------------------------*
	TYPES:
	
	  BEGIN OF typ_data,
	    box    TYPE c,
	    zjypc  TYPE qals-prueflos   , "检验批次
	    budat  TYPE qals-budat,       "过账日期
	    zart   TYPE qals-art        , "检验类型
	    matnr  TYPE qals-matnr      , "物料
	    maktx  TYPE makt-maktx      , "物料名称
	    charg  TYPE qals-charg      , "批次
	    werk   TYPE qals-werk       , "工厂
	    endat  TYPE qals-enstehdat  , "批次创建日期
	    lmeng  TYPE qals-losmenge   , "检验批数量
	    menge  TYPE qals-mengeneinh , "基本计量单位
	    pterm  TYPE qals-pastrterm  , "检验开始
	    pzeit  TYPE qals-paendzeit  , "检验结束
	    lgort  TYPE qals-lagortchrg , "库存地点
	    lifnr  TYPE qals-lifnr      , "供应商
	    ebeln  TYPE qals-ebeln      , "采购凭证
	    mblnr  TYPE qals-mblnr      , "物料凭证
	    aufnr  TYPE qals-aufnr      , "订单
	    kunnr  TYPE qals-kunnr      , "客户
	    kdauf  TYPE qals-kdauf      , "销售订单
	    stat35 TYPE qals-stat35,
	  END OF typ_data.
	
	TABLES:qals.
	
	*----------------------------------------------------------------------*
	* 全局变量定义
	*----------------------------------------------------------------------*
	DATA: gv_grid TYPE REF TO cl_gui_alv_grid.
	
	*----------------------------------------------------------------------*
	* 全局内表定义
	*----------------------------------------------------------------------*
	DATA:
	gt_data TYPE STANDARD TABLE OF typ_data.
	
	*----------------------------------------------------------------------*
	* ALV定义
	*----------------------------------------------------------------------*
	DATA:
	  gs_layout_lvc   TYPE lvc_s_layo,                             "显示布局参数
	  gt_fieldcat_lvc TYPE lvc_t_fcat WITH HEADER LINE,            "显示字段表
	  gs_fieldcat_lvc LIKE gt_fieldcat_lvc,                        "显示字段表结构
	  gv_repid        LIKE sy-repid.                               "程序名
	
	*----------------------------------------------------------------------*
	*SELECT-OPTIONS/选择屏幕
	*----------------------------------------------------------------------*
	SELECTION-SCREEN BEGIN OF BLOCK b1 WITH FRAME TITLE l_title1.
	SELECT-OPTIONS:
	              s_zjyp  FOR qals-prueflos,                                "检验批
	              s_zpcrq FOR qals-enstehdat,                               "批次创建日期
	              s_zjyks FOR qals-pastrterm,                               "检验开始
	              s_zjyjs FOR qals-paendterm,                               "检验结束
	              s_werk  FOR qals-werk,                                    "工厂
	              s_art   FOR qals-art,                                     "检验类型
	              s_matnr FOR qals-matnr,                                   "物料
	              s_charg FOR qals-charg,                                   "批次
	              s_lifnr FOR qals-lifnr,                                   "供应商
	              s_kunnr FOR qals-kunnr,                                   "客户
	              s_mblnr FOR qals-mblnr,                                   "物料凭证
	              s_kdauf FOR qals-kdauf.                                   "销售订单
	SELECTION-SCREEN END OF BLOCK b1.
	
	*----------------------------------------------------------------------*
	*INITIALIZATION
	*----------------------------------------------------------------------*
	INITIALIZATION.
	  l_title1 = '选择条件'.
	
	*----------------------------------------------------------------------*
	*START-OF-SELECTION/主处理
	*----------------------------------------------------------------------*
	START-OF-SELECTION.
	*主处理
	  PERFORM frm_main_proc.
	  PERFORM frm_display_data.
	
	*&---------------------------------------------------------------------*
	*& Form FRM_MAIN_PROC
	*&---------------------------------------------------------------------*
	FORM frm_main_proc .
	
	  SELECT  qals~prueflos AS zjypc
	          qals~art AS zart
	          qals~matnr
	          makt~maktx
	          qals~charg
	          qals~werk
	          qals~enstehdat AS endat
	          qals~losmenge AS lmeng
	          qals~mengeneinh AS menge
	          qals~pastrterm AS pterm
	          qals~paendzeit AS pzeit
	          qals~lagortchrg AS lgort
	          qals~lifnr
	          qals~ebeln
	          qals~mblnr
	          qals~aufnr
	          qals~kunnr
	          qals~kdauf
	          qals~stat35
	    INTO CORRESPONDING FIELDS OF TABLE gt_data
	    FROM qals
	   INNER JOIN makt
	      ON qals~matnr = makt~matnr
	   WHERE qals~prueflos  IN s_zjyp
	     AND qals~enstehdat IN s_zpcrq
	     AND qals~pastrterm IN s_zjyks
	     AND qals~paendterm IN s_zjyjs
	     AND qals~werk      IN s_werk
	     AND qals~art       IN s_art
	     AND qals~matnr     IN s_matnr
	     AND qals~charg     IN s_charg
	     AND qals~lifnr     IN s_lifnr
	     AND qals~kunnr     IN s_kunnr
	     AND qals~mblnr     IN s_mblnr
	     AND qals~kdauf     IN s_kdauf.
	
	ENDFORM.
	*&---------------------------------------------------------------------*
	*& Form FRM_DISPLAY_DATA
	*&---------------------------------------------------------------------*
	FORM frm_display_data .
	
	  CLEAR gt_fieldcat_lvc.
	  REFRESH gt_fieldcat_lvc.
	  PERFORM frm_fill_field USING:
	         'ZJYPC' '检验批次',
	         'BUDAT' '冲销日期',
	         'ZART ' '检验类型',
	         'MATNR' '物料',
	         'MAKTX' '物料名称',
	         'CHARG' '批次',
	         'WERK ' '工厂',
	         'ENDAT' '批次创建日期',
	         'LMENG' '检验批数量',
	         'MENGE' '基本计量单位',
	         'PTERM' '检验开始',
	         'PZEIT' '检验结束',
	         'LGORT' '库存地点',
	         'LIFNR' '供应商',
	         'EBELN' '采购凭证',
	         'MBLNR' '物料凭证',
	         'AUFNR' '订单',
	         'KUNNR' '客户',
	         'KDAUF' '销售订单'.
	
	
	  gs_layout_lvc-cwidth_opt = 'X'.                                       "宽度自动优化
	  gs_layout_lvc-zebra      = 'X'.
	  gs_layout_lvc-box_fname  = 'BOX'.                                     "定义选择行
	  gv_repid = sy-repid.                                                  "当前程序名
	
	  CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY_LVC'
	    EXPORTING
	      i_callback_program       = gv_repid
	      i_callback_pf_status_set = 'PF_STATUS_SET'
	      i_callback_user_command  = 'USER_COMMAND'
	      is_layout_lvc            = gs_layout_lvc
	      it_fieldcat_lvc          = gt_fieldcat_lvc[]
	      i_save                   = 'A'
	    TABLES
	      t_outtab                 = gt_data
	    EXCEPTIONS
	      program_error            = 1
	      OTHERS                   = 2.
	
	ENDFORM.
	*&---------------------------------------------------------------------*
	*& Form FRM_FILL_FIELD
	*&---------------------------------------------------------------------*
	FORM frm_fill_field  USING p1 p2.
	
	  CLEAR gs_fieldcat_lvc.
	  gs_fieldcat_lvc-fieldname     = p1.
	  gs_fieldcat_lvc-scrtext_m     = p2.
	
	  CASE p1.
	    WHEN 'MATNR'.
	      gs_fieldcat_lvc-no_zero = 'X'.
	    WHEN 'BUDAT'.
	      gs_fieldcat_lvc-edit      = 'X'.
	      gs_fieldcat_lvc-ref_table = 'QALS'.
	      gs_fieldcat_lvc-ref_field = 'BUDAT'.
	  ENDCASE.
	  APPEND gs_fieldcat_lvc TO gt_fieldcat_lvc.
	
	ENDFORM.
	*&---------------------------------------------------------------------*
	*& Form FRM_SET_STATUS
	*&---------------------------------------------------------------------*
	*& 界面按钮设置
	*&---------------------------------------------------------------------*
	FORM pf_status_set USING it_extab TYPE slis_t_extab.
	  SET PF-STATUS 'STANDARD_FULLSCREEN'.
	ENDFORM.
	*&---------------------------------------------------------------------*
	*& Form USER_COMMAND
	*&---------------------------------------------------------------------*
	*& 用户按钮控制
	*&---------------------------------------------------------------------*
	FORM user_command USING iw_ucomm    TYPE sy-ucomm
	                        is_selfield TYPE slis_selfield.
	
	  IF gv_grid IS INITIAL.
	    CALL FUNCTION 'GET_GLOBALS_FROM_SLVC_FULLSCR'
	      IMPORTING
	        e_grid = gv_grid.
	  ENDIF.
	
	  CALL METHOD gv_grid->check_changed_data.
	
	  CASE iw_ucomm.
	    WHEN 'ZUNDO_UD'.
	      PERFORM frm_cancel_ud.
	    WHEN 'ZUNDO_MIGO'.
	      PERFORM frm_cancel_mvtpost.
	  ENDCASE.
	
	  is_selfield-refresh    = 'X'.
	  is_selfield-col_stable = 'X'.
	  is_selfield-row_stable = 'X'.
	ENDFORM.
	*&---------------------------------------------------------------------*
	*& Form frm_cancel_UD
	*&---------------------------------------------------------------------*
	*& 取消UD
	*&---------------------------------------------------------------------*
	FORM frm_cancel_ud .
	
	  DATA: ls_data TYPE typ_data.
	
	  READ TABLE gt_data TRANSPORTING NO FIELDS WITH KEY box = 'X'.
	  IF sy-subrc <> 0.
	    MESSAGE '未选择数据!' TYPE 'S' DISPLAY LIKE 'E'.
	  ENDIF.
	
	  LOOP AT gt_data INTO ls_data WHERE box = 'X'.
	    IF ls_data-stat35 = 'X'.
	      SUBMIT zqevac40 WITH prueflos = ls_data-zjypc
	                      AND RETURN.
	    ENDIF.
	  ENDLOOP.
	
	ENDFORM.
	*&---------------------------------------------------------------------*
	*& Form frm_cancel_mvtpost
	*&---------------------------------------------------------------------*
	*& 移动冲销
	*&---------------------------------------------------------------------*
	FORM frm_cancel_mvtpost .
	
	  DATA: ls_data TYPE typ_data.
	
	  READ TABLE gt_data TRANSPORTING NO FIELDS WITH KEY box = 'X'.
	  IF sy-subrc <> 0.
	    MESSAGE '未选择数据!' TYPE 'S' DISPLAY LIKE 'E'.
	  ENDIF.
	
	  LOOP AT gt_data INTO ls_data WHERE box = 'X'.
	    SUBMIT zrqevac50 WITH prueflos = ls_data-zjypc
	                     WITH p_budat  = ls_data-budat
	                     AND RETURN.
	  ENDLOOP.
	
	ENDFORM.

附加程序:ZQEVAC40

代码语言:javascript
复制
*&---------------------------------------------------------------------*
*& Title: Taking back usage decision for single lots                   *
*&---------------------------------------------------------------------*
report zqevac40.
*----------------------------------------------------------------------*
*  Datendefinitionen
*----------------------------------------------------------------------*
* Tabellen
*----------------------------------------------------------------------*
tables sscrfields.
tables qals.
tables qave.
*----------------------------------------------------------------------*
* Konstanten
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'.
*
*----------------------------------------------------------------------*
* Eingabebildschirm
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.
  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).
  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.
* Vorgaben sind ok.   1. Material Umlagern und Los ändern
  perform qals_aendern.
************************************************************************
*----------------------------------------------------------------------*
*       FORM 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.
*----------------------------------------------------------------------*
*       Form  STATUS_FIX_SETZEN
*----------------------------------------------------------------------*
*   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

附加程序:ZRQEVAC50

代码语言:javascript
复制
*&---------------------------------------------------------------------*
*& Report ZRQEVAC50
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT ZRQEVAC50 MESSAGE-ID QA.
"***********************************************************************
"* 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.
*********************ADD BY JIEABAP1*******[S]**************************
PARAMETERS:P_BUDAT    LIKE QALS-BUDAT.
*********************ADD BY JIEABAP1*******[E]**************************
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'.
      WHEN 128.
        G_MSGV1 = 'Material & is serialized'.
        REPLACE '&' WITH G_QALS-MATNR INTO G_MSGV1.
      WHEN  64.
        G_MSGV1 = 'Lot & is not stock relevant'.
      WHEN  32.
        G_MSGV1 = 'Lot &: No stock transferred'.
      WHEN  16.
        G_MSGV1 = 'Lot & is cancelled'.
      WHEN   8.
        G_MSGV1 = 'Lot & is archived'.
      WHEN   4.
        G_MSGV1 = 'Lot & is blocked'.
      WHEN   2.
        G_MSGV1 = 'Lot & is HU managed'.
    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 &'.
    REPLACE '&' WITH PRUEFLOS INTO G_MSGV1.
    MESSAGE ID '00' TYPE 'S' NUMBER '368'
            WITH 'Stock posting reversed for ' G_MSGV1.

    SELECT * FROM ZTWMS_T004
    WHERE PRUEFLOS = @PRUEFLOS
    INTO TABLE @DATA(LT_PRUEFLOS).

    LOOP AT LT_PRUEFLOS INTO DATA(WA_PRUEFLOS).
      CLEAR WA_PRUEFLOS-LMENGE01.                   "JIEMM 2022.02.25 清空非限制
      WA_PRUEFLOS-ZSTATUS = '3'.                     "检验批被冲销 回到待检状态
      WA_PRUEFLOS-ZFLAG   = 'X'.
      MODIFY LT_PRUEFLOS FROM WA_PRUEFLOS.
    ENDLOOP.

    MODIFY ZTWMS_T004 FROM TABLE LT_PRUEFLOS.

*    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,
    L_VMENGE03_BWART LIKE MSEG-BWART.
  CLEAR: P_SUBRC.
*/QAMB initialisieren
  CALL FUNCTION 'QAMB_REFRESH_DATA'.
*/Kopf füllen
  L_IMKPF-BLDAT = SY-DATLO.

*********************ADD BY JIEABAP1*******[S]**************************
  IF P_BUDAT IS INITIAL.
    L_IMKPF-BUDAT = SY-DATLO.     "默认本地日期
  ELSE.
    L_IMKPF-BUDAT = P_BUDAT.      "按用户需求改为自定义日期
  ENDIF.
*********************ADD BY JIEABAP1*******[S]**************************

  L_IMKPF-BKTXT = 'Cancellation of QM UD postings'.
*/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.
  IF P_QALS-STAT11 IS NOT INITIAL AND P_QALS-LMENGE03 IS NOT INITIAL.
    DATA LS_TQ07M LIKE TQ07M.
    DATA: S_TQ07M_BUF LIKE TQ07M OCCURS 9.
    SELECT * FROM TQ07M INTO TABLE S_TQ07M_BUF
    WHERE FELDNAME LIKE 'VMENGE%' .
    SORT S_TQ07M_BUF BY FELDNAME ASCENDING
                        HERKUNFT ASCENDING.
    READ TABLE S_TQ07M_BUF INTO LS_TQ07M
                           WITH KEY FELDNAME = 'VMENGE03'
                                    HERKUNFT = ' ' BINARY SEARCH.
*   Binäre Suche mit Feld und Herkunft
    IF SY-SUBRC IS INITIAL.
      MOVE LS_TQ07M-BWARTWESP TO L_VMENGE03_BWART.
    ENDIF.
  ENDIF.
*/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 )
        OR
          (  L_IMSEG-KZBEW EQ SPACE
         AND L_IMSEG-BWART EQ L_VMENGE03_BWART
         AND L_IMSEG-WERKS NE SPACE
         AND L_IMSEG-LGORT NE SPACE
         AND L_IMSEG-UMLGO NE SPACE
         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 )
        OR
          ( SY-SUBRC      IS INITIAL AND
         L_IMSEG-KZBEW EQ SPACE
         AND L_IMSEG-BWART EQ L_VMENGE03_BWART
         AND L_IMSEG-WERKS NE SPACE
         AND L_IMSEG-LGORT NE SPACE
         AND L_IMSEG-UMLGO NE SPACE
         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.
*/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.
  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.
  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'.
  IF SY-SUBRC IS INITIAL.
    P_SUBRC = 4.
  ENDIF.
ENDFORM.                               " CHECK_MKPF
本文参与 腾讯云自媒体分享计划,分享自作者个人站点/博客。
原始发表:2023-10-11,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 作者个人站点/博客 前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体分享计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
目录
  • =>Reference
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档