ZDN_BLOCK

*&---------------------------------------------------------------------*
*& Report  ZDN_BLOCK
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*

REPORT  zdn_block.

INCLUDE zbdcrecx1.

DATA: gs_vbak LIKE vbak,
      gs_likp LIKE likp,
      p_mode TYPE ctu_mode VALUE 'N',
      l_subrc LIKE sy-subrc,
      l_lifsk LIKE likp-lifsk,
      is_authority,
      is_success.

DATA: BEGIN OF gt_out OCCURS 0,
      msg TYPE c LENGTH 100,
      END OF gt_out.

SELECTION-SCREEN BEGIN OF BLOCK b1 WITH FRAME TITLE text-001 NO INTERVALS.
PARAMETERS: p_vbeln LIKE likp-vbeln.
SELECTION-SCREEN END OF BLOCK b1.

START-OF-SELECTION.
  PERFORM get_data.
  PERFORM process_data.
*  PERFORM display_data.
*&---------------------------------------------------------------------*
*&      Form  GET_DATA
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM get_data .
  SELECT SINGLE vbelv AS vbeln FROM vbfa
    INTO CORRESPONDING FIELDS OF gs_vbak
    WHERE vbtyp_n = 'J'
      AND vbtyp_v = 'C'
      AND vbeln   = p_vbeln.

  SELECT SINGLE vkbur vkgrp INTO CORRESPONDING FIELDS OF gs_vbak
    FROM vbak
    WHERE vbeln = gs_vbak-vbeln.

  SELECT SINGLE lifsk INTO CORRESPONDING FIELDS OF gs_likp
    FROM likp
    WHERE vbeln = p_vbeln.
ENDFORM.                    " GET_DATA
*&---------------------------------------------------------------------*
*&      Form  PROCESS_DATA
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM process_data .
  CLEAR is_authority.
  PERFORM check_authority_pmc CHANGING l_subrc.
  IF l_subrc EQ 0.
    IF gs_likp-lifsk EQ 'Z0'.
      l_lifsk = 'Z1'.
      is_authority = 'X'.
    ELSEIF gs_likp-lifsk EQ 'Z1'.
      l_lifsk = 'Z0'.
      is_authority = 'X'.
    ENDIF.
  ENDIF.
  PERFORM check_authority_pmt CHANGING l_subrc.
  IF l_subrc EQ 0.
    IF gs_likp-lifsk EQ 'Z1'.
      l_lifsk = ''.
      is_authority = 'X'.
    ELSEIF gs_likp-lifsk EQ ''.
      l_lifsk = 'Z1'.
      is_authority = 'X'.
    ENDIF.
  ENDIF.

  IF NOT is_authority IS INITIAL.
    PERFORM bdc_vl02n USING l_lifsk.
  ELSE.
    is_success = 'D'.
    export is_success to MEMORY id 'DN_STATUS'.
  ENDIF.

*  IF l_lifsk IS INITIAL.
*    CONCATENATE 'You can not change the delivery block for DN' p_vbeln
*      INTO gt_out-msg.
*    APPEND gt_out.
*  ENDIF.

ENDFORM.                    " PROCESS_DATA
*&---------------------------------------------------------------------*
*&      Form  BDC_VL02N
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_0082   text
*----------------------------------------------------------------------*
FORM bdc_vl02n  USING p_lifsk TYPE likp-lifsk.
  PERFORM bdc_dynpro      USING 'SAPMV50A' '4004'.
  PERFORM bdc_field       USING 'BDC_CURSOR'
                                'LIKP-VBELN'.
  PERFORM bdc_field       USING 'BDC_OKCODE'
                                '/00'.
  PERFORM bdc_field       USING 'LIKP-VBELN'
                                p_vbeln.
  PERFORM bdc_dynpro      USING 'SAPMV50A' '1000'.
  PERFORM bdc_field       USING 'BDC_OKCODE'
                                '=HADM_T'.
  PERFORM bdc_dynpro      USING 'SAPMV50A' '2000'.
  PERFORM bdc_field       USING 'BDC_OKCODE'
                                '=SICH_T'.
  PERFORM bdc_field       USING 'BDC_CURSOR'
                                'LIKP-LIFSK'.
  PERFORM bdc_field       USING 'LIKP-LIFSK'
                                p_lifsk.
  CALL TRANSACTION 'VL02N'
    USING bdcdata
    MODE p_mode
    UPDATE 'S'
    MESSAGES INTO messtab.
  READ TABLE messtab WITH KEY msgtyp = 'E'.
  IF sy-subrc EQ 0.
*    CONCATENATE 'Change the delivery block for DN' p_vbeln
*      'to' p_lifsk 'failure' INTO gt_out-msg SEPARATED BY space.
*    APPEND gt_out.
    is_success = 'N'.
  ELSE.
    READ TABLE messtab WITH KEY msgid = '00'
                                msgnr = '347'.
    IF sy-subrc eq 0.
      is_success = 'B'.
    ELSE.
      is_success = 'Y'.
      EXPORT p_lifsk TO MEMORY id 'BLOCK_FIELD'.
    ENDIF.
  ENDIF.
  EXPORT is_success TO MEMORY id 'DN_STATUS'.
  REFRESH bdcdata.
ENDFORM.                                                    " BDC_VL02N
*&---------------------------------------------------------------------*
*&      Form  DISPLAY_DATA
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM display_data .
  LOOP AT gt_out.
    WRITE:/ gt_out-msg.
  ENDLOOP.
ENDFORM.                    " DISPLAY_DATA
*&---------------------------------------------------------------------*
*&      Form  CHECK_AUTHORITY_PMT
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_L_SUBRC  text
*----------------------------------------------------------------------*
FORM check_authority_pmt  CHANGING p_subrc TYPE sy-subrc.
  AUTHORITY-CHECK OBJECT 'ZDNAPP01'
               ID 'ACTVT'  FIELD '02'
               ID 'VKBUR' FIELD gs_vbak-vkbur
               ID 'VKGRP' FIELD gs_vbak-vkgrp.
  p_subrc = sy-subrc.
ENDFORM.                    " CHECK_AUTHORITY_PMT
*&---------------------------------------------------------------------*
*&      Form  CHECK_AUTHORITY_PMC
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_L_SUBRC  text
*----------------------------------------------------------------------*
FORM check_authority_pmc  CHANGING p_subrc TYPE sy-subrc.
  AUTHORITY-CHECK OBJECT 'ZDNAPP01'
                   ID 'ACTVT'  FIELD '01'
                   ID 'VKBUR' FIELD gs_vbak-vkbur
                   ID 'VKGRP' FIELD gs_vbak-vkgrp.
  p_subrc = sy-subrc.
ENDFORM.                    " CHECK_AUTHORITY_PMC