SAP QM——取消检验批UD判定

参考SAP Notes 74638的程序ZQEVAC40

效果：

代码：

************************************************************************
* Program Name      :
* Descriptions      :
* T-Code            :
* Updates Tables    :
* Input  Parameters :
* Output Parameters :
* Return Codes      :
* Special Logic     :
* Includes          :
************************************************************************
* Modification Log
************************************************************************
*   Date   Ver. Programmer   Descriptions
* -------- ---- ------------ -------------------------------------------
* 2020 6.25   xxx Create
*
************************************************************************
REPORT  ZQMRTEST.
***********************************************************************
* Tables Definitions
************************************************************************
*TABLES:.
************************************************************************
* Data Definitions
************************************************************************
CONSTANTS: g_flag TYPE c VALUE 'X'.

DATA: gs_qals LIKE qals,
      gs_qave LIKE qave.
************************************************************************
* Includes Module
************************************************************************

************************************************************************
* Selection Screen
************************************************************************
PARAMETERS: p_qplos LIKE qals-prueflos OBLIGATORY.

************************************************************************
* Initialization
************************************************************************
INITIALIZATION.

************************************************************************
* At Selection Screen
************************************************************************
AT SELECTION-SCREEN.
  PERFORM check_data.
************************************************************************
* At Selection Screen Output
************************************************************************
AT SELECTION-SCREEN OUTPUT.

************************************************************************
* Report Format
************************************************************************
TOP-OF-PAGE.

END-OF-PAGE.
************************************************************************
* Main Process
************************************************************************
START-OF-SELECTION.

  PERFORM ud_to_rel.

END-OF-SELECTION.

*&---------------------------------------------------------------------*
*&      Form  CHECK_DATA
*&---------------------------------------------------------------------*
FORM check_data.

  "检查是否存在检验批
  CALL FUNCTION 'QPSE_LOT_READ'
    EXPORTING
      i_prueflos = p_qplos
    IMPORTING
      e_qals     = gs_qals
    EXCEPTIONS
      no_lot     = 1
      OTHERS     = 2.
  IF sy-subrc NE 0.
    MESSAGE e102(qa) WITH p_qplos.
  ENDIF.

  "检验批枷锁
  CALL FUNCTION 'ENQUEUE_EQQALS1'
    EXPORTING
      prueflos       = p_qplos
    EXCEPTIONS
      foreign_lock   = 1
      system_failure = 2
      OTHERS         = 3.

  IF sy-subrc NE 0.
    MESSAGE e007(qa) WITH '有人' p_qplos.
  ENDIF.

  "UD状态检查
  CALL FUNCTION 'QAST_STATUS_CHECK'
    EXPORTING
      i_objnr          = gs_qals-objnr
      i_status         = 'I0218'
    EXCEPTIONS
      status_not_activ = 1
      OTHERS           = 2.

  IF sy-subrc NE 0.
    MESSAGE e102(qv) WITH p_qplos.
  ENDIF.

  "检验批UD资料
  CALL FUNCTION 'QEVA_UD_READ'
    EXPORTING
      I_PRUEFLOS     = p_qplos
    IMPORTING
      E_QAVE         = gs_qave
    EXCEPTIONS
      qave_not_found = 1
      OTHERS         = 2.

ENDFORM.                "CHECK_DATA

*&---------------------------------------------------------------------*
*&      Form  UD_TO_REL
*&---------------------------------------------------------------------*
FORM ud_to_rel.
  "REL核发状态生效
  PERFORM status_change USING 'I0002' g_flag.
  "STIC检验完成状态失效
  PERFORM status_change USING 'I0216' space.
  "ICCO已完成所有检验状态失效
  PERFORM status_change USING 'I0217' space.
  "UD已做出检验结果判定状态失效
  PERFORM status_change USING 'I0218' space.

  "值更改
  CLEAR: gs_qals-stat14,gs_qals-stat35.
  CLEAR: gs_qave-vauswahlmg,
       gs_qave-vwerks,
       gs_qave-versionam,
       gs_qave-vcodegrp,
       gs_qave-vcode,
       gs_qave-vbewertung,
       gs_qave-versioncd,
       gs_qave-vfolgeakti,
       gs_qave-qkennzahl.

  CALL FUNCTION 'QEVA_UD_UPDATE' IN UPDATE TASK
    EXPORTING
      qals_new       = gs_qals
      qave_new       = gs_qave.

  IF sy-subrc = 0.
    COMMIT WORK.
    MESSAGE '检验批已取消UD判定' TYPE 'S'.
  ELSE.
    ROLLBACK WORK.
    MESSAGE '检验批未做任何修改' TYPE 'E'.
  ENDIF.

ENDFORM.                "UD_TO_REL

*&---------------------------------------------------------------------*
*&      Form  STATUS_CHANGE
*&---------------------------------------------------------------------*
FORM status_change USING in_status in_flag.
  DATA: lt_status LIKE TABLE OF jstat,
        ls_status LIKE LINE OF lt_status.

  IF gs_qals-objnr IS INITIAL.
    MESSAGE e013(qv).
  ENDIF.
  ls_status-stat = in_status.

  IF in_flag IS INITIAL.
    ls_status-inact = g_flag.
  ENDIF.
  APPEND ls_status TO lt_status.CLEAR ls_status.

  CALL FUNCTION 'STATUS_CHANGE_INTERN'
    EXPORTING
      objnr               = gs_qals-objnr
    TABLES
      status              = lt_status
    EXCEPTIONS
      object_not_found    = 1
      status_inconsistent = 2
      status_not_allowed  = 3
      OTHERS              = 4.


ENDFORM.                "STATUS_CHANGE

QEVA0008