Report to add, change or delete Business Partners from/to/of Business Transactions

REPORT  ztemp_partner_change.

TABLES: bapibus20001_object_id.

SELECT-OPTIONS:
  s_objid FOR bapibus20001_object_id-object_id OBLIGATORY. "Object ID of Business Transaction

PARAMETERS:
  p_pfct TYPE comt_partner_wrk-partner_fct OBLIGATORY, "Partner Function to be changed.
  p_pnum TYPE but000-partner.                          "Partner Number (can be left empty to delete partner)

*-------------------------------------------------------------------------

INCLUDE crm_object_kinds_con.

DATA:
  lv_partner_guid        TYPE but000-partner_guid,
  lt_header_guid         TYPE crmt_object_guid_tab,
  lt_partner_wrk         TYPE crmt_partner_external_wrkt,
  lt_partner_com         TYPE comt_partner_comt,
  ls_partner_com         LIKE LINE OF lt_partner_com,
  lv_partner_handle      LIKE ls_partner_com-ref_partner_handle,
  lt_input_field         TYPE crmt_input_field_tab,
  ls_input_field         TYPE crmt_input_field,
  ls_partner_logical_key TYPE comt_partner_logic_partner_key,
  ls_input_field_name    TYPE crmt_input_field_names,
  lt_active_switch       TYPE crmt_active_switch_t,
  ls_active_switch       LIKE LINE OF lt_active_switch.

FIELD-SYMBOLS:
         LIKE LINE OF lt_header_guid,
         LIKE LINE OF lt_partner_wrk.

**Convert Partner Number to Partner GUID.
*IF p_pnum IS NOT INITIAL.
*
*  CALL FUNCTION 'BUPA_NUMBERS_READ'
*    EXPORTING
*      iv_partner              = p_pnum
*    IMPORTING
*      ev_partner_guid         = lv_partner_guid
*    EXCEPTIONS
*      no_partner_specified    = 1
*      no_valid_record_found   = 2
*      inconsistent_parameters = 3
*      OTHERS                  = 4.
*
*  IF sy-subrc <> 0.
*    MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
*            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
*    EXIT.
*  ENDIF.
*ELSE.
*  CLEAR lv_partner_guid.
*ENDIF.

*Select all business transactions according to selection criteria.
SELECT guid
  INTO TABLE lt_header_guid
  FROM crmd_orderadm_h
  WHERE object_id IN s_objid.

*Read partner data for all selected business transactions (if partners are already maintained).
CALL FUNCTION 'CRM_ORDER_READ'
  EXPORTING
    it_header_guid       = lt_header_guid
  IMPORTING
    et_partner           = lt_partner_wrk
*   ET_EXCEPTION         =
  EXCEPTIONS
    document_not_found   = 1
    error_occurred       = 2
    document_locked      = 3
    no_change_authority  = 4
    no_display_authority = 5
    no_change_allowed    = 6
    OTHERS               = 7.

IF sy-subrc <> 0.
  MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
          WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  EXIT.
ENDIF.

*Process every single business transaction.
LOOP AT lt_header_guid ASSIGNING .

  CLEAR ls_partner_com.

*Read corresponding partner (if already maintained). We assume that there can be only one per partner function.
  READ TABLE lt_partner_wrk
    ASSIGNING 
    WITH KEY ref_guid =  ref_partner_fct = p_pfct.

*Create a new entry to insert partner.
  IF sy-subrc <> 0.

    ls_partner_com-ref_guid           = .
    ls_partner_com-ref_kind           = gc_object_kind-orderadm_h. "Header
    ADD 1 TO lv_partner_handle.
    ls_partner_com-ref_partner_handle = lv_partner_handle.

*Take over all data from existing entry to change or delete partner.
  ELSE.

    MOVE-CORRESPONDING  TO ls_partner_com.

  ENDIF.

*Delete partner.
  IF p_pnum IS INITIAL.
    CLEAR:
      ls_partner_com-partner_fct,
      ls_partner_com-partner_no.

*Insert or change partner.
  ELSE.
    ls_partner_com-partner_fct        = p_pfct.
* ls_partner_com-partner_no         = lv_partner_guid.
* ls_partner_com-no_type            = '  '. "Value is a GUID
    ls_partner_com-partner_no         = p_pnum.
    ls_partner_com-no_type            = 'BP'. "Value is a Business Partner Number
    ls_partner_com-display_type       = 'BP'.
    ls_partner_com-kind_of_entry      = 'D'. "Origin: Interface

  ENDIF.

*Do some general data preparations.
  INSERT ls_partner_com INTO TABLE lt_partner_com.

*Build input_fields.
  MOVE-CORRESPONDING ls_partner_com TO ls_input_field.
  ls_input_field-objectname = 'PARTNER'.
  MOVE-CORRESPONDING ls_partner_com TO ls_partner_logical_key.
  ls_input_field-logical_key = ls_partner_logical_key.
  ls_input_field_name-fieldname = 'PARTNER_FCT'.
  INSERT ls_input_field_name INTO TABLE ls_input_field-field_names.
  ls_input_field_name-fieldname = 'PARTNER_NO'.
  INSERT ls_input_field_name INTO TABLE ls_input_field-field_names.
  ls_input_field_name-fieldname = 'DISPLAY_TYPE'.
  INSERT ls_input_field_name INTO TABLE ls_input_field-field_names.
  ls_input_field_name-fieldname = 'NO_TYPE'.
  INSERT ls_input_field_name INTO TABLE ls_input_field-field_names.
  ls_input_field_name-fieldname = 'KIND_OF_ENTRY'.
  INSERT ls_input_field_name INTO TABLE ls_input_field-field_names.
  INSERT ls_input_field INTO TABLE lt_input_field.

*Deactivate fieldcheck to change partners which are read-only.
  MOVE-CORRESPONDING ls_partner_com TO ls_active_switch.
  ls_active_switch-fieldcheck = abap_true.
  INSERT ls_active_switch INTO TABLE lt_active_switch.

ENDLOOP.

*Perform all changes.
CALL FUNCTION 'CRM_ORDER_MAINTAIN'
  EXPORTING
    it_partner                    = lt_partner_com
  it_active_switch              = lt_active_switch
* IMPORTING
*   ET_EXCEPTION                  =
  CHANGING
    ct_input_fields               = lt_input_field
  EXCEPTIONS
    error_occurred                = 1
    document_locked               = 2
    no_change_allowed             = 3
    no_authority                  = 4
    OTHERS                        = 5.

IF sy-subrc <> 0.
  MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
          WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  EXIT.
ENDIF.

*Perform transaction save.
CALL FUNCTION 'CRM_ORDER_SAVE'
  EXPORTING
    it_objects_to_save           = lt_header_guid[]
*   IV_UPDATE_TASK_LOCAL         = FALSE
   it_active_switch             = lt_active_switch
* IMPORTING
*   ET_SAVED_OBJECTS             =
*   ET_EXCEPTION                 =
*   ET_OBJECTS_NOT_SAVED         =
  EXCEPTIONS
    document_not_saved           = 1
    OTHERS                       = 2.

IF sy-subrc <> 0.
  MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
          WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.

*ROLLBACK.
  CALL FUNCTION 'BAPI_TRANSACTION_ROLLBACK'.

  EXIT.
ENDIF.

*COMMIT WORK AND WAIT.
CALL FUNCTION 'BAPI_TRANSACTION_COMMIT'
  EXPORTING
    wait = 'X'.

*Clear buffers.
CALL FUNCTION 'CRM_ORDER_INITIALIZE'
  EXPORTING
    it_guids_to_init = lt_header_guid[]
  EXCEPTIONS
    error_occurred   = 1
    OTHERS           = 2.