取消UD程序

2024-01-07 22:59:03

1 Introduction

The demo is that how to cancel UD in the QM module. The code is following.

2 Code

*&---------------------------------------------------------------------*
*& Report ZQMU003
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT zqmu003_test.
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'.
      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 = '检验批号 &'.
    REPLACE '&' WITH prueflos INTO g_msgv1.
    MESSAGE ID '00' TYPE 'S' NUMBER '368'
            WITH '过账成功 ' g_msgv1.

    "修改决策状态
    SUBMIT zqmu004 WITH prueflos   = prueflos
                           AND RETURN.
*   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.
  l_imkpf-budat = sy-datlo.
  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.
*&---------------------------------------------------------------------*
*& Report ZQMU004
*&---------------------------------------------------------------------*
*&
*&---------------------------------------------------------------------*
REPORT ZQMU004.
*$*$----------------------------------------------------------------$*$*
*$ Correction Inst.         0120024545 0000018827                     $*
*$--------------------------------------------------------------------$*
*$ Valid for       :                                                  $*
*$ Software Component   SAP_APPL   R/3 Standard                       $*
*$  Release 30A          w/o Support Packages                         $*
*$  Release 30B          w/o Support Packages                         $*
*$  Release 30C          To SAPKH30C14                                $*
*$  Release 30D          All Support Package Levels                   $*
*$  Release 30F          Fm SAPKH30F98                                $*
*$  Release 300          w/o Support Packages                         $*
*$--------------------------------------------------------------------$*
*$ Changes/Objects Not Contained in Standard SAP System               $*
*$*$----------------------------------------------------------------$*$*
*&--------------------------------------------------------------------*
*& Object          REPS ZQEVAC40
*& Object Header   PROG ZQEVAC40
*&--------------------------------------------------------------------*
*& This object has been generated from an advance correction         *
*& attached to a R/3 note.                                           *
*&--------------------------------------------------------------------*
*&---------------------------------------------------------------------*
*& Title: Taking back usage decision for single lots                   *
*&---------------------------------------------------------------------*

*----------------------------------------------------------------------*
*  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

文章来源:https://blog.csdn.net/beyond911/article/details/135429259
本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。