SAP QM 检验批可用库存回转为待检验库存


*&---------------------------------------------------------------------*
*& Report  ZRQEVAC50 可用庫存轉待檢庫存
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*

*{   REPLACE        DEVK977808
*\REPORT  RQEVAC50.
report ZRQEVAC50 message-id QA.

types:
  T_MKPF_TAB like MKPF  occurs 0,
  T_MSEG_TAB like MSEG  occurs 0.

parameters:
  PRUEFLOS like QALS-PRUEFLOS obligatory memory id QLS,
  P_BUDAT  like MKPF-BUDAT default SY-DATUM.


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.
    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 = P_BUDAT.
* 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.


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

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

*}   REPLACE

posted @ 2020-07-31 10:57  年轻的小菜鸟  阅读(615)  评论(0)  编辑  收藏  举报