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:
<fv_header_guid> LIKE LINE OF lt_header_guid,
<fs_partner_wrk> 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 <fv_header_guid>.
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 <fs_partner_wrk>
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 = <fv_header_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 <fs_partner_wrk> 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.