前言： 在項目上遇到的需求，在QA16中增加取消UD按鈕，實作UD沖銷功能，在網上查閱了一些，找到一些資料，在此記錄下。
用到的增強點：
CMOD:QEVA0008 用途決議：客戶功能代碼(例如取消 UD)
用到的NOTE:
-74638
-175842
參考連結：SAP QM取消UD方法
增強步驟：
CMOD建立項目ZMM002
1.1添加邏輯代碼
"增加取消UD的處理
DATA lv_line TYPE bsvx-sttxt.
CLEAR lv_line.
CALL FUNCTION 'STATUS_TEXT_EDIT'
EXPORTING
client = sy-mandt
objnr = i_qals-objnr
only_active = 'X'
spras = sy-langu
IMPORTING
line = lv_line
EXCEPTIONS
object_not_found = 1
OTHERS = 2.
IF lv_line CS 'UD'.
SUBMIT zqevac40 WITH prueflos = i_qals-prueflos AND RETURN.
WAIT UP TO '1' SECONDS.
ENDIF.
SUBMIT zrqevac50 WITH prueflos = i_qals-prueflos AND RETURN.
1.2添加取消UD按鈕
1.3配置事務
事務碼：OMJJ
激活項目，增強完成
2.附程式
2.1 ZQEVAC40
*&---------------------------------------------------------------------*
*& Report ZQEVAC40
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT ZQEVAC40.
TABLES sscrfields.
TABLES qals.
TABLES qave.
CONSTANTS:
c_rc_0 LIKE sy-subrc VALUE 0,
c_rc_4 LIKE sy-subrc VALUE 4,
c_rc_20 LIKE sy-subrc VALUE 20,
c_kreuz LIKE qm00-qkz VALUE 'X'.
SELECTION-SCREEN SKIP 2.
PARAMETERS prueflos LIKE qals-prueflos MATCHCODE OBJECT qals MEMORY ID qls .
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK SEARCH WITH FRAME.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN PUSHBUTTON 3(20) TEXT-s01
USER-COMMAND sear.
SELECTION-SCREEN PUSHBUTTON 40(20) TEXT-s02 USER-COMMAND show.
SELECTION-SCREEN END OF LINE.
SELECTION-SCREEN END OF BLOCK SEARCH.
AT SELECTION-SCREEN.
IF sscrfields-ucomm EQ 'SEAR'
OR prueflos IS INITIAL.
CALL FUNCTION 'QELA_START_SELECTION_OF_LOTS'
EXPORTING
i_selid = ' '
i_stat_aenderung = 'X'
i_stat_ero = 'X'
i_stat_frei = 'X'
i_stat_ve = ' '
IMPORTING
e_prueflos = prueflos
EXCEPTIONS
no_entry = 1
no_selected = 2
OTHERS = 3.
IF sy-subrc <> 0.
MESSAGE e042(znhmm01).
ENDIF.
ENDIF.
IF sscrfields-ucomm EQ 'SHOW'.
CALL FUNCTION 'QSS1_LOT_SHOW'
EXPORTING
i_prueflos = prueflos.
ENDIF.
CHECK sscrfields-ucomm EQ 'ONLI'.
* ab hier mu? Prüflosnummer gefüllt sein.
IF prueflos IS INITIAL.
MESSAGE e164(qa).
ENDIF.
* Lesen Los
CALL FUNCTION 'ENQUEUE_EQQALS1'
EXPORTING
prueflos = prueflos.
CALL FUNCTION 'QPSE_LOT_READ'
EXPORTING
i_prueflos = prueflos
IMPORTING
e_qals = qals
EXCEPTIONS
no_lot = 1.
IF NOT sy-subrc IS INITIAL.
MESSAGE e102(qa) WITH SPACE.
ENDIF.
*-----------------
* Prüfen Status
CALL FUNCTION 'QAST_STATUS_CHECK'
EXPORTING
i_objnr = qals-objnr
i_status = 'I0218' "Status VE getroffen
EXCEPTIONS
status_not_activ = 1.
IF NOT sy-subrc IS INITIAL.
MESSAGE e102(qv) WITH qals-prueflos.
ENDIF.
CALL FUNCTION 'QEVA_UD_READ'
EXPORTING
i_prueflos = qals-prueflos
IMPORTING
e_qave = qave.
START-OF-SELECTION.
PERFORM qals_aendern.
******************************************
******************************
FORM qals_aendern.
PERFORM status_fix_setzen USING 'I0002' c_kreuz.
PERFORM status_fix_setzen USING 'I0216' space.
PERFORM status_fix_setzen USING 'I0217' space.
PERFORM status_fix_setzen USING 'I0218' space.
CLEAR: qals-stat14.
CLEAR: qals-stat35.
CLEAR: qave-vauswahlmg,
qave-vwerks,
qave-versionam,
qave-vcodegrp,
qave-vcode,
qave-vbewertung,
qave-versioncd,
qave-vfolgeakti,
qave-qkennzahl.
*--... verbuchen
CALL FUNCTION 'QEVA_UD_UPDATE' IN UPDATE
TASK
EXPORTING
qals_new = qals
qave_new = qave.
COMMIT WORK.
MESSAGE s101(qa) WITH qals-prueflos.
ENDFORM.
* Setzen eines Status aufgrund von Voreinstellungen wie QMAT etc. *
* --> STATUS Status der gesetzt werden soll
* --> AKTIV Status wird aktiviert sonst deaktiviert
FORM status_fix_setzen USING
VALUE(status) LIKE tj02-istat
VALUE(aktiv) LIKE c_kreuz.
* lokale Tabelle fuer Statusfortschreibung
DATA: BEGIN OF l_stattab OCCURS 0.
INCLUDE STRUCTURE jstat.
DATA END OF l_stattab.
* Falls Objektnr. nicht gefüllt. --> Fehlermeldung !!!
IF qals-objnr EQ space.
MESSAGE e013(qv).
* Fehlende Objektnr.: Problem fü
ENDIF.
MOVE status TO l_stattab-stat.
IF aktiv EQ space.
MOVE c_kreuz TO l_stattab-inact.
ENDIF.
APPEND l_stattab.
CALL FUNCTION 'STATUS_CHANGE_INTERN'
EXPORTING
check_only = space
objnr = qals-objnr
TABLES
status = l_stattab.
ENDFORM. " STATUS_FIX_SETZEN
2.2 ZRQEVAC50
*&---------------------------------------------------------------------*
*& Report ZRQEVAC50
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT ZRQEVAC50.
"***********************************************************************
"* Report is provided by Modification Note 175842 *
"* *
"* CAUTION: Please be aware that this is a Modification! *
"* Please refer to note 170183. *
"***********************************************************************
TYPES:
t_mkpf_tab LIKE mkpf OCCURS 0,
t_mseg_tab LIKE mseg OCCURS 0.
PARAMETERS:
prueflos LIKE qals-prueflos OBLIGATORY MEMORY ID qls.
DATA:
g_msgv1 LIKE sy-msgv1,
g_qals LIKE qals,
g_qals_leiste LIKE qals,
g_qamb_tab TYPE qambtab,
g_qamb_vb_tab TYPE qambtab,
g_mkpf_tab TYPE t_mkpf_tab,
g_mseg_tab TYPE t_mseg_tab,
g_subrc LIKE sy-subrc.
START-OF-SELECTION.
PERFORM enqueue_qals USING prueflos
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_qals USING prueflos
g_qals
g_qals_leiste
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID 'QA' TYPE 'S' NUMBER '102'
WITH prueflos.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM check_lot USING g_qals
g_subrc.
IF NOT g_subrc IS INITIAL.
CASE g_subrc.
WHEN 256.
g_msgv1 = 'Lot & does not refer to a material doc'. "#EC NOTEXT
WHEN 128.
g_msgv1 = 'Material & is serialized'. "#EC NOTEXT
REPLACE '&' WITH g_qals-matnr INTO g_msgv1.
WHEN 64.
g_msgv1 = 'Lot & is not stock relevant'. "#EC NOTEXT
WHEN 32.
g_msgv1 = 'Lot &: No stock transferred'. "#EC NOTEXT
WHEN 16.
g_msgv1 = 'Lot & is cancelled'. "#EC NOTEXT
WHEN 8.
g_msgv1 = 'Lot & is archived'. "#EC NOTEXT
WHEN 4.
g_msgv1 = 'Lot & is blocked'. "#EC NOTEXT
WHEN 2.
g_msgv1 = 'Lot & is HU managed'. "#EC NOTEXT
ENDCASE.
REPLACE '&' WITH prueflos INTO g_msgv1.
MESSAGE ID '00' TYPE 'S' NUMBER '208'
WITH g_msgv1.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_qamb USING g_qals
g_qamb_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
WITH prueflos.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_mkpf USING g_qamb_tab
g_mkpf_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM check_mkpf USING g_mkpf_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
WITH prueflos.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM read_mseg USING g_mkpf_tab
g_mseg_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM check_mseg USING g_mseg_tab
g_qamb_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
WITH prueflos.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM create_goods_movement USING g_qals
g_mseg_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID 'QA' TYPE 'S' NUMBER '068'
WITH prueflos.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
PERFORM post_goods_movement.
PERFORM post_data USING g_qals
g_qals_leiste
g_qamb_tab
g_qamb_vb_tab
g_subrc.
IF NOT g_subrc IS INITIAL.
MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ELSE.
COMMIT WORK AND WAIT.
g_msgv1 = 'inspection lot &'. "#EC NOTEXT
REPLACE '&' WITH prueflos INTO g_msgv1.
MESSAGE ID '00' TYPE 'S' NUMBER '368'
WITH 'Stock posting reversed for ' g_msgv1. "#EC NOTEXT
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
*----------------------------------------------------------------------*
* Form ENQUEUE_QALS *
*----------------------------------------------------------------------*
* Los sperren *
*----------------------------------------------------------------------*
FORM enqueue_qals USING p_prueflos LIKE qals-prueflos
p_subrc LIKE sy-subrc.
CLEAR: p_subrc.
CALL FUNCTION 'ENQUEUE_EQQALS1'
EXPORTING
prueflos = p_prueflos
EXCEPTIONS
foreign_lock = 1
system_failure = 2
OTHERS = 3.
p_subrc = sy-subrc.
ENDFORM. " ENQUEUE_QALS
*----------------------------------------------------------------------*
* Form READ_QALS *
*----------------------------------------------------------------------*
* Prüflos lesen *
*----------------------------------------------------------------------*
FORM read_qals USING p_prueflos LIKE qals-prueflos
p_qals LIKE qals
p_qals_leiste LIKE qals
p_subrc LIKE sy-subrc.
CLEAR: p_subrc.
CALL FUNCTION 'QPSE_LOT_READ'
EXPORTING
i_prueflos = p_prueflos
i_reset_lot = 'X'
IMPORTING
e_qals = p_qals
EXCEPTIONS
no_lot = 1.
p_subrc = sy-subrc.
IF p_subrc IS INITIAL.
p_qals_leiste = p_qals.
ELSE.
CLEAR: p_qals,
p_qals_leiste.
ENDIF.
ENDFORM. " READ_QALS
*----------------------------------------------------------------------*
* Form CHECK_LOT *
*----------------------------------------------------------------------*
* Prüflos prüfen *
*----------------------------------------------------------------------*
FORM check_lot USING p_qals LIKE qals
p_subrc LIKE sy-subrc.
DATA:
l_stat LIKE jstat,
l_stat_tab LIKE jstat OCCURS 0 WITH HEADER LINE.
p_subrc = 256.
*/No reference to material document
IF p_qals-zeile IS INITIAL.
EXIT.
ELSE.
p_subrc = 128.
ENDIF.
*/Serialized Material
IF NOT p_qals-sernp IS INITIAL.
EXIT.
ELSE.
p_subrc = 64.
ENDIF.
*/BERF
CALL FUNCTION 'STATUS_CHECK'
EXPORTING
objnr = p_qals-objnr
status = 'I0203'
EXCEPTIONS
status_not_active = 2.
IF NOT sy-subrc IS INITIAL.
EXIT.
ELSE.
p_subrc = 32.
ENDIF.
*/BTEI & BEND
CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
l_stat-stat = 'I0219'. APPEND l_stat TO l_stat_tab. "BTEI
l_stat-stat = 'I0220'. APPEND l_stat TO l_stat_tab. "BEND
CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
EXPORTING
objnr = p_qals-objnr
TABLES
status_check = l_stat_tab.
IF l_stat_tab[] IS INITIAL.
EXIT.
ELSE.
p_subrc = 16.
ENDIF.
*/LSTO & LSTV
CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
l_stat-stat = 'I0224'. APPEND l_stat TO l_stat_tab. "LSTO
l_stat-stat = 'I0232'. APPEND l_stat TO l_stat_tab. "LSTV
CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
EXPORTING
objnr = p_qals-objnr
TABLES
status_check = l_stat_tab.
IF NOT l_stat_tab[] IS INITIAL.
EXIT.
ELSE.
p_subrc = 8.
ENDIF.
*/ARSP & ARCH & REO1 & REO2 & REO3
CLEAR l_stat. CLEAR l_stat_tab. REFRESH l_stat_tab.
l_stat-stat = 'I0225'. APPEND l_stat TO l_stat_tab. "ARSP
l_stat-stat = 'I0226'. APPEND l_stat TO l_stat_tab. "ARCH
l_stat-stat = 'I0227'. APPEND l_stat TO l_stat_tab. "REO3
l_stat-stat = 'I0228'. APPEND l_stat TO l_stat_tab. "REO2
l_stat-stat = 'I0229'. APPEND l_stat TO l_stat_tab. "REO1
CALL FUNCTION 'STATUS_OBJECT_CHECK_MULTI'
EXPORTING
objnr = p_qals-objnr
TABLES
status_check = l_stat_tab.
IF NOT l_stat_tab[] IS INITIAL.
EXIT.
ELSE.
p_subrc = 4.
ENDIF.
*/SPER
CALL FUNCTION 'STATUS_CHECK'
EXPORTING
objnr = p_qals-objnr
status = 'I0043'
EXCEPTIONS
status_not_active = 2.
IF sy-subrc IS INITIAL.
EXIT.
ELSE.
p_subrc = 2.
ENDIF.
*/HUM
CALL FUNCTION 'STATUS_CHECK'
EXPORTING
objnr = p_qals-objnr
status = 'I0443'
EXCEPTIONS
status_not_active = 2.
IF sy-subrc IS INITIAL.
EXIT.
ELSE.
p_subrc = 0.
ENDIF.
ENDFORM. " CHECK_LOT
*----------------------------------------------------------------------*
* Form READ_QAMB *
*----------------------------------------------------------------------*
* QAMBs lesen *
*----------------------------------------------------------------------*
FORM read_qamb USING p_qals LIKE qals
p_qamb_tab TYPE qambtab
p_subrc LIKE sy-subrc.
CLEAR: p_subrc.
SELECT * FROM qamb INTO TABLE p_qamb_tab
WHERE prueflos = p_qals-prueflos
AND typ = '3'.
p_subrc = sy-subrc.
ENDFORM. " READ_QAMB
*----------------------------------------------------------------------*
* Form READ_MKPF *
*----------------------------------------------------------------------*
* Read material document header *
*----------------------------------------------------------------------*
FORM read_mkpf USING p_qamb_tab TYPE qambtab
p_mkpf_tab TYPE t_mkpf_tab
p_subrc LIKE sy-subrc.
DATA:
BEGIN OF l_mkpf_key_tab OCCURS 0,
mblnr LIKE mkpf-mblnr,
mjahr LIKE mkpf-mjahr,
END OF l_mkpf_key_tab.
DATA:
l_qamb LIKE qamb,
l_mkpf LIKE mkpf,
l_trtyp LIKE t158-trtyp VALUE 'A',
l_vgart LIKE t158-vgart VALUE 'WQ',
l_xexit LIKE qm00-qkz.
p_subrc = 4.
LOOP AT p_qamb_tab INTO l_qamb.
l_mkpf_key_tab-mblnr = l_qamb-mblnr.
l_mkpf_key_tab-mjahr = l_qamb-mjahr.
COLLECT l_mkpf_key_tab.
ENDLOOP.
LOOP AT l_mkpf_key_tab.
CALL FUNCTION 'ENQUEUE_EMMKPF'
EXPORTING
mblnr = l_mkpf_key_tab-mblnr
mjahr = l_mkpf_key_tab-mjahr
EXCEPTIONS
foreign_lock = 1
system_failure = 2
OTHERS = 3.
IF NOT sy-subrc IS INITIAL.
l_xexit = 'X'.
EXIT.
ENDIF.
CLEAR: l_mkpf.
CALL FUNCTION 'MB_READ_MATERIAL_HEADER'
EXPORTING
mblnr = l_mkpf_key_tab-mblnr
mjahr = l_mkpf_key_tab-mjahr
trtyp = l_trtyp
vgart = l_vgart
IMPORTING
kopf = l_mkpf
EXCEPTIONS
error_message = 1.
IF NOT sy-subrc IS INITIAL.
l_xexit = 'X'.
EXIT.
ELSE.
APPEND l_mkpf TO p_mkpf_tab.
ENDIF.
ENDLOOP.
IF NOT l_xexit IS INITIAL.
EXIT.
ELSE.
p_subrc = 0.
ENDIF.
ENDFORM. " READ_MKPF
*----------------------------------------------------------------------*
* Form READ_MSEG *
*----------------------------------------------------------------------*
* MSEGs lesen *
*----------------------------------------------------------------------*
FORM read_mseg USING p_mkpf_tab TYPE t_mkpf_tab
p_mseg_tab TYPE t_mseg_tab
p_subrc LIKE sy-subrc.
DATA:
l_mkpf LIKE mkpf,
l_mseg_tab LIKE mseg OCCURS 0 WITH HEADER LINE,
l_trtyp LIKE t158-trtyp VALUE 'A',
l_xexit LIKE qm00-qkz.
p_subrc = 4.
LOOP AT p_mkpf_tab INTO l_mkpf.
CLEAR: l_mseg_tab. REFRESH: l_mseg_tab.
CALL FUNCTION 'MB_READ_MATERIAL_POSITION'
EXPORTING
mblnr = l_mkpf-mblnr
mjahr = l_mkpf-mjahr
trtyp = l_trtyp
*/ ZEILB = P_ZEILE
*/ ZEILE = P_ZEILE
TABLES
seqtab = l_mseg_tab
EXCEPTIONS
error_message = 1.
IF NOT sy-subrc IS INITIAL.
l_xexit = 'X'.
EXIT.
ELSE.
APPEND LINES OF l_mseg_tab TO p_mseg_tab.
ENDIF.
ENDLOOP.
IF NOT l_xexit IS INITIAL.
EXIT.
ELSE.
*/ XAuto-Zeilen und Chargenzustands?nderung werden gel?scht
DELETE p_mseg_tab WHERE xauto NE space
OR bwart EQ '341'
OR bwart EQ '342'.
p_subrc = 0.
ENDIF.
ENDFORM. " READ_MSEG
*----------------------------------------------------------------------*
* Form CREATE_GOODS_MOVEMENT *
*----------------------------------------------------------------------*
* Warenbewegung anlegen *
*----------------------------------------------------------------------*
FORM create_goods_movement USING p_qals LIKE qals
p_mseg_tab TYPE t_mseg_tab
p_subrc LIKE sy-subrc.
DATA:
l_lmengezub LIKE qals-lmengezub,
l_lmengegeb LIKE qals-lmengezub,
l_mbqss LIKE mbqss,
l_imkpf LIKE imkpf,
l_imseg LIKE imseg,
l_imseg_tab LIKE imseg OCCURS 1,
l_emkpf LIKE emkpf,
l_emseg LIKE emseg,
l_emseg_tab LIKE emseg OCCURS 1,
l_mseg LIKE mseg,
l_mseg_tab LIKE mseg OCCURS 1,
l_tcode LIKE sy-tcode VALUE 'QA11',
l_tabix LIKE sy-tabix VALUE 1,
l_xstbw LIKE t156-xstbw.
CLEAR: p_subrc.
*/QAMB initialisieren
CALL FUNCTION 'QAMB_REFRESH_DATA'.
*/Kopf füllen
l_imkpf-bldat = sy-datlo.
l_imkpf-budat = sy-datlo.
l_imkpf-bktxt = 'Cancellation of QM UD postings'. "#EC NOTEXT
*/Ursprüngliche zu buchende Menge merken + inkrementieren
l_lmengezub = p_qals-lmengezub.
l_lmengegeb = p_qals-lmenge01
+ p_qals-lmenge02
+ p_qals-lmenge03
+ p_qals-lmenge04
+ p_qals-lmenge05
+ p_qals-lmenge06
+ p_qals-lmenge07
+ p_qals-lmenge08
+ p_qals-lmenge09.
*/Zeilen aufbauen
l_mseg_tab[] = p_mseg_tab[].
LOOP AT l_mseg_tab INTO l_mseg.
MOVE-CORRESPONDING l_mseg TO l_mbqss.
MOVE-CORRESPONDING l_mbqss TO l_imseg.
*/ Referenzbeleg übergeben, falls Bestellnummer gefüllt
IF NOT l_mseg-ebeln IS INITIAL.
MOVE: l_mseg-lfbnr TO l_imseg-lfbnr,
l_mseg-lfbja TO l_imseg-lfbja,
l_mseg-lfpos TO l_imseg-lfpos.
ENDIF.
MOVE l_mseg-kdauf TO l_imseg-kdauf.
MOVE l_mseg-kdpos TO l_imseg-kdpos.
MOVE l_mseg-ps_psp_pnr TO l_imseg-ps_psp_pnr.
*/ Umlagerungsfelder setzen
MOVE:
l_mseg-ummat TO l_imseg-ummat,
l_mseg-umwrk TO l_imseg-umwrk,
l_mseg-umlgo TO l_imseg-umlgo,
l_mseg-umcha TO l_imseg-umcha.
*/ Storno-Beleg setzen
MOVE: l_mseg-mjahr TO l_imseg-sjahr,
l_mseg-mblnr TO l_imseg-smbln,
l_mseg-zeile TO l_imseg-smblp.
*/ Falsch gefüllte Felder initialisieren
CLEAR: l_imseg-mblnr,
l_imseg-menge,
l_imseg-meins.
*/ Bewegungsart lesen
SELECT SINGLE xstbw FROM t156 INTO l_xstbw
WHERE bwart = l_imseg-bwart.
IF NOT sy-subrc IS INITIAL.
p_subrc = 4.
EXIT.
ENDIF.
*/ Werk/Lagerort füllen
IF p_qals-stat11 IS INITIAL.
IF l_xstbw IS INITIAL.
MOVE p_qals-lagortvorg TO l_imseg-lgort.
ELSE.
MOVE p_qals-lagortvorg TO l_imseg-umlgo.
ENDIF.
ENDIF.
IF l_xstbw IS INITIAL.
MOVE p_qals-werkvorg TO l_imseg-werks.
ELSE.
MOVE p_qals-werkvorg TO l_imseg-umwrk.
ENDIF.
*/ Zus?tzliche Felder
MOVE p_qals-mengeneinh TO l_imseg-erfme.
"MOVE P_GRUND TO L_IMSEG-GRUND.
"MOVE P_ELIKZ TO L_IMSEG-ELIKZ.
*/ Kennzeichen Storno-Buchung setzen
MOVE 'X' TO l_imseg-xstob.
MOVE p_qals-prueflos TO l_imseg-qplos.
APPEND l_imseg TO l_imseg_tab.
IF p_qals-stat11 IS INITIAL.
ADD l_imseg-erfmg TO l_lmengezub.
SUBTRACT l_imseg-erfmg FROM l_lmengegeb.
ELSE.
IF l_imseg-kzbew EQ space
AND l_imseg-werks NE space
AND l_imseg-lgort NE space
AND l_imseg-umwrk NE space
AND l_imseg-umlgo NE space
AND l_imseg-werks EQ l_imseg-umwrk
AND l_imseg-umlgo EQ l_imseg-umlgo.
*/ Dummy Buchung bei WE-Sperrbestand & Stichprobe
ELSE.
ADD l_imseg-erfmg TO l_lmengezub.
SUBTRACT l_imseg-erfmg FROM l_lmengegeb.
ENDIF.
ENDIF.
ENDLOOP.
IF NOT p_qals-stat11 IS INITIAL.
*/ Bei WE-Sperrbestand und Stichprobenbuchung Zeilen tauschen
DO.
READ TABLE l_imseg_tab INDEX sy-INDEX INTO l_imseg.
IF sy-subrc IS INITIAL
AND l_imseg-kzbew EQ space
AND l_imseg-werks NE space
AND l_imseg-lgort NE space
AND l_imseg-umwrk NE space
AND l_imseg-umlgo NE space
AND l_imseg-werks EQ l_imseg-umwrk
AND l_imseg-umlgo EQ l_imseg-umlgo.
IF sy-tabix NE l_tabix.
DELETE l_imseg_tab INDEX sy-tabix.
INSERT l_imseg INTO l_imseg_tab INDEX l_tabix.
l_tabix = l_tabix + 1.
ELSE.
l_tabix = l_tabix + 1.
CONTINUE.
ENDIF.
ELSEIF sy-subrc IS INITIAL.
CONTINUE.
ELSE.
EXIT. "from do
ENDIF.
ENDDO.
ENDIF.
*/QM deaktivieren
CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
EXPORTING
aktiv = space.
*/Buchen
CALL FUNCTION 'MB_CREATE_GOODS_MOVEMENT'
EXPORTING
imkpf = l_imkpf
xallp = 'X'
xallr = 'X'
ctcod = l_tcode
xqmcl = ' '
IMPORTING
emkpf = l_emkpf
TABLES
imseg = l_imseg_tab
emseg = l_emseg_tab.
*/QM wieder aktivieren
CALL FUNCTION 'QAAT_QM_ACTIVE_INACTIVE'
EXPORTING
aktiv = 'X'.
*/Buchung auswerten
IF l_emkpf-subrc GT 1.
IF l_emkpf-msgid NE space.
*/ Fehler auf Kopfebene
MESSAGE ID l_emkpf-msgid TYPE 'S'
NUMBER l_emkpf-msgno
WITH l_emkpf-msgv1 l_emkpf-msgv2
l_emkpf-msgv3 l_emkpf-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ELSE.
*/ Fehler auf Zeilenebene (Ausgabe des ersten Fehlers)
LOOP AT l_emseg_tab INTO l_emseg.
IF l_emseg-msgid NE space.
MESSAGE ID l_emseg-msgid TYPE 'S'
NUMBER l_emseg-msgno
WITH l_emseg-msgv1 l_emseg-msgv2
l_emseg-msgv3 l_emseg-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
ENDLOOP.
ENDIF.
ENDIF.
LOOP AT l_emseg_tab INTO l_emseg.
CALL FUNCTION 'QAMB_COLLECT_RECORD'
EXPORTING
lotnumber = p_qals-prueflos
docyear = l_emkpf-mjahr
docnumber = l_emkpf-mblnr
docposition = l_emseg-mblpo
TYPE = '7'.
ENDLOOP.
*/Sonderkorrektur für Frei-An-Frei & WE-Sperr-An-We-Sperr
IF NOT p_qals-stat11 IS INITIAL.
IF p_qals-lmenge04 EQ l_lmengegeb.
ADD p_qals-lmenge04 TO l_lmengezub.
SUBTRACT p_qals-lmenge04 FROM l_lmengegeb.
ENDIF.
ELSEIF p_qals-insmk IS INITIAL.
IF p_qals-lmenge01 GE l_lmengegeb
AND NOT p_qals-lmenge01 IS INITIAL.
ADD l_lmengegeb TO l_lmengezub.
SUBTRACT l_lmengegeb FROM l_lmengegeb.
ENDIF.
ENDIF.
CLEAR: p_qals-stat34,
p_qals-matnrneu,
p_qals-chargneu,
p_qals-lmenge01,
p_qals-lmenge02,
p_qals-lmenge03,
p_qals-lmenge04,
p_qals-lmenge05,
p_qals-lmenge06,
p_qals-lmenge07,
p_qals-lmenge08,
p_qals-lmenge09.
p_qals-lmengezub = l_lmengezub.
IF NOT l_lmengegeb IS INITIAL.
p_subrc = 4.
ENDIF.
ENDFORM. " CREATE_GOODS_MOVEMENT
*----------------------------------------------------------------------*
* Form POST_GOODS_MOVEMENT *
*----------------------------------------------------------------------*
* Warenbewegung buchen *
*----------------------------------------------------------------------*
FORM post_goods_movement.
CALL FUNCTION 'MB_POST_GOODS_MOVEMENT'.
ENDFORM. " POST_GOODS_MOVEMENT
*----------------------------------------------------------------------*
* Form POST_DATA *
*----------------------------------------------------------------------*
* QM-Daten verbuchen *
*----------------------------------------------------------------------*
FORM post_data USING p_qals LIKE qals
p_qals_leiste LIKE qals
p_qamb_tab TYPE qambtab
p_qamb_vb_tab TYPE qambtab
p_subrc LIKE sy-subrc.
DATA:
l_stat LIKE jstat,
l_stat_tab LIKE jstat OCCURS 0,
l_qamb LIKE qamb,
l_updkz LIKE qalsvb-upsl VALUE 'U'.
*/QAMBs umsetzen (7 = VE-Buchung storniert)
LOOP AT p_qamb_tab INTO l_qamb.
l_qamb-typ = '7'.
APPEND l_qamb TO p_qamb_vb_tab.
ENDLOOP.
*/BERF & BTEI zurücknehmen
CLEAR l_stat. CLEAR l_stat_tab.
l_stat-inact = 'X'.
l_stat-stat = 'I0219'. APPEND l_stat TO l_stat_tab. "BTEI
l_stat-stat = 'I0220'. APPEND l_stat TO l_stat_tab. "BEND
CALL FUNCTION 'STATUS_CHANGE_INTERN'
EXPORTING
objnr = p_qals-objnr
TABLES
status = l_stat_tab
EXCEPTIONS
error_message = 1.
IF sy-subrc <> 0.
MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
SUBMIT (sy-repid) VIA SELECTION-SCREEN.
ENDIF.
*/Prüflos aktualisieren
CALL FUNCTION 'QPL1_UPDATE_MEMORY'
EXPORTING
i_qals = p_qals
i_updkz = l_updkz.
CALL FUNCTION 'QPL1_INSPECTION_LOTS_POSTING'
EXPORTING
i_mode = '1'.
CALL FUNCTION 'STATUS_UPDATE_ON_COMMIT'.
*/QAMB initialisieren
CALL FUNCTION 'QAMB_REFRESH_DATA'.
PERFORM update_qamb ON COMMIT.
p_subrc = 0.
ENDFORM. " POST_DATA
*----------------------------------------------------------------------*
* Form UPDATE_QAMB *
*----------------------------------------------------------------------*
* Update auf QAMB *
*----------------------------------------------------------------------*
FORM update_qamb.
CALL FUNCTION 'QEVA_QAMB_CANCEL' IN UPDATE TASK
EXPORTING
t_qamb_tab = g_qamb_vb_tab.
ENDFORM. " UPDATE_QAMB
*----------------------------------------------------------------------*
* Form CHECK_MSEG *
*----------------------------------------------------------------------*
* MSEGs prüfen *
*----------------------------------------------------------------------*
FORM check_mseg USING p_mseg_tab TYPE t_mseg_tab
p_qamb_tab TYPE qambtab
p_subrc LIKE sy-subrc.
DATA:
l_mseg_stor_tab LIKE mseg OCCURS 0 WITH HEADER LINE.
CLEAR: p_subrc.
IF p_mseg_tab[] IS NOT INITIAL.
*/Zeilen bereits storniert?
SELECT mblnr mjahr zeile smbln sjahr smblp
FROM mseg INTO CORRESPONDING FIELDS OF TABLE l_mseg_stor_tab
FOR ALL ENTRIES IN p_mseg_tab
WHERE smbln EQ p_mseg_tab-mblnr
AND sjahr EQ p_mseg_tab-mjahr
AND smblp EQ p_mseg_tab-zeile.
ENDIF.
IF sy-subrc IS INITIAL.
LOOP AT l_mseg_stor_tab.
DELETE p_mseg_tab WHERE mblnr = l_mseg_stor_tab-smbln
AND mjahr = l_mseg_stor_tab-sjahr
AND zeile = l_mseg_stor_tab-smblp.
DELETE p_qamb_tab WHERE mblnr = l_mseg_stor_tab-smbln
AND mjahr = l_mseg_stor_tab-sjahr
AND zeile = l_mseg_stor_tab-smblp.
ENDLOOP.
IF p_mseg_tab[] IS INITIAL.
p_subrc = 4.
EXIT.
ENDIF.
ENDIF.
ENDFORM. " CHECK_MSEG
*----------------------------------------------------------------------*
* Form CHECK_MKPF *
*----------------------------------------------------------------------*
* Materialbelege prüfen (Wurde durch VE-Buchung Prüfllos erzeugt?*
*----------------------------------------------------------------------*
FORM check_mkpf USING p_mkpf_tab TYPE t_mkpf_tab
p_subrc LIKE sy-subrc.
DATA:
l_mkpf_tab TYPE t_mkpf_tab.
CLEAR: p_subrc.
IF p_mkpf_tab[] IS NOT INITIAL.
SELECT mblnr FROM qamb INTO CORRESPONDING FIELDS OF TABLE l_mkpf_tab
FOR ALL ENTRIES IN p_mkpf_tab
WHERE mblnr EQ p_mkpf_tab-mblnr
AND mjahr EQ p_mkpf_tab-mjahr
AND typ = '1'.
ENDIF.
IF sy-subrc IS INITIAL.
p_subrc = 4.
ENDIF.
ENDFORM. " CHECK_MKPF
覺得部落客的文章對你有幫助的，動動滑鼠一鍵三連，激勵部落客寫出更多精彩文章！