=>Reference
- 使用前提
- 参考Note
- UD冲销程序 ZQEVAC40 74638 - Results recording after usage decision
- 移动冲销程序 ZRQEVAC50 175842 - Inspection lot: Reversal of goods movements from usage decision
-
主程序
*----------------------------------------------------------------------* * 参照类型定义 *----------------------------------------------------------------------* 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
*&---------------------------------------------------------------------* *& 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
*&---------------------------------------------------------------------* *& 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