SAP SD TRANSPORTE FM
From SapWiki
Ejemplo crear gastos de transporte al Crear/Imprimir
PROGRAM zsd_crea_gastos_transp.
*TABLES nast.
TYPE-POOLS v54a0.
DATA: g_protocol LIKE sprot_u OCCURS 0 WITH HEADER LINE.
PARAMETERS p_tknum TYPE vttk-tknum.
INCLUDE rlb_invoice_data_declare.
*DATA: retcode LIKE sy-subrc. "Returncode
*DATA: xscreen(1) TYPE c. "Output on printer or screen
*PERFORM processing.
INCLUDE rlb_print_forms.
*&---------------------------------------------------------------------*
*& Form entry
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->RETURN_CODE text
* -->US_SCREEN text
*----------------------------------------------------------------------*
FORM entry USING return_code us_screen.
CLEAR retcode.
xscreen = us_screen.
PERFORM processing.
IF retcode NE 0.
return_code = 1.
ELSE.
return_code = 0.
ENDIF.
ENDFORM. "entry
*----------------------------------------------------------------------*
* INCLUDE FM06PE02 *
*----------------------------------------------------------------------*
FORM processing.
DATA lt_return TYPE TABLE OF bapiret2.
DATA: l_druvo LIKE t166k-druvo,
l_nast LIKE nast,
l_from_memory.
DATA l_tknum TYPE vttk-tknum.
DATA l_subrc TYPE sy-subrc.
DATA l_dummy(200).
**********************************************************************
*
**********************************************************************
IF p_tknum IS INITIAL.
MOVE nast-objky(10) TO l_tknum.
ELSE.
l_tknum = p_tknum.
ENDIF.
CLEAR g_protocol[].
DATA f_s(1).
* CALL FUNCTION 'DEQUEUE_EVVTTKE'
* EXPORTING
* mandt = sy-mandt
* tknum = l_tknum.
PERFORM crea_gastos_transp USING l_tknum CHANGING l_subrc.
return. """""""""""""""""""""""""""""""""""""
IF l_subrc <> 0.
retcode = l_subrc.
MESSAGE e000(0k) WITH 'Error al Crear Doc.Gastos Transp.' INTO l_dummy.
PERFORM protocol_update.
LOOP AT g_protocol WHERE severity = 'E' OR severity = 'A'.
MESSAGE ID g_protocol-ag TYPE g_protocol-severity NUMBER g_protocol-msgnr
WITH g_protocol-var1 g_protocol-var2 g_protocol-var3 g_protocol-var4 INTO l_dummy.
PERFORM protocol_update.
ENDLOOP.
ELSE.
LOOP AT g_protocol WHERE ag = 'VY' AND msgnr = '212' AND severity = 'S'.
MESSAGE ID g_protocol-ag TYPE g_protocol-severity NUMBER g_protocol-msgnr
WITH g_protocol-var1 g_protocol-var2 g_protocol-var3 g_protocol-var4 INTO l_dummy.
PERFORM protocol_update.
ENDLOOP.
retcode = 0.
ENDIF.
CALL FUNCTION 'ENQUEUE_EVVTTKE'
EXPORTING
tknum = l_tknum
EXCEPTIONS
foreign_lock = 2
system_failure = 3.
ENDFORM. "entry_neu
*&---------------------------------------------------------------------*
*& Form crea_gastos_transp
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_TKNUM text
* -->P_SUBRC text
*----------------------------------------------------------------------*
FORM crea_gastos_transp USING p_tknum CHANGING p_subrc.
* ver report RV56TRSL
CONSTANTS: vbtyp_transport VALUE '8'. " Transport
DATA: object_range TYPE zsd_tt_v54a0_ref,
object_range_locked TYPE zsd_tt_v54a0_ref.
DATA pacsz LIKE rv54a-pacsz VALUE 1.
DATA ls_object_range LIKE LINE OF object_range.
REFRESH object_range.
ls_object_range-vbtyp = vbtyp_transport.
ls_object_range-rebel = p_tknum.
APPEND ls_object_range TO object_range.
* SET UPDATE TASK LOCAL.
* Create shipment cost documents
CALL FUNCTION 'Z_SD_SCDS_CREATE_2'
IN BACKGROUND TASK
AS SEPARATE UNIT
DESTINATION 'NONE'
EXPORTING
i_opt_package_size = pacsz
I_nast = NAST
IMPORTING
e_refobj_range_locked = object_range_locked[]
TABLES
t_protocol = g_protocol[]
CHANGING
c_refobj_range = object_range[]
EXCEPTIONS
OTHERS = 0.
LOOP AT g_protocol WHERE severity = 'A' OR severity = 'E'.
ENDLOOP.
IF sy-subrc = 0.
p_subrc = 1.
ELSE.
p_subrc = 0.
ENDIF.
* CALL FUNCTION 'RFC_CONNECTION_CLOSE'
* EXPORTING
* destination = 'NONE'
* EXCEPTIONS
* OTHERS = 0.
ENDFORM. "crea_gastos_transp
*Messages
*----------------------------------------------------------
*
* Message class: 0K
*000 & & & &
FUNCTION z_sd_scds_create_2.
*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(I_OPT_PACKAGE_SIZE) LIKE RV54A-PACSZ DEFAULT '1'
*" VALUE(I_OPT_LOG_SAVE) TYPE BOOLE_D DEFAULT 'X'
*" VALUE(I_OPT_COMMIT) TYPE BOOLE_D DEFAULT 'X'
*" VALUE(I_FKART) TYPE FKART_T DEFAULT ' '
*" VALUE(I_PRSDT) TYPE PRSDT_K OPTIONAL
*" VALUE(I_BUDAT) TYPE BUDAT_K OPTIONAL
*" VALUE(I_NAST) TYPE NAST
*" EXPORTING
*" VALUE(E_REFOBJ_RANGE_LOCKED) TYPE ZSD_TT_V54A0_REF
*" TABLES
*" T_PROTOCOL STRUCTURE SPROT_U
*" CHANGING
*" VALUE(C_REFOBJ_RANGE) TYPE ZSD_TT_V54A0_REF
*"----------------------------------------------------------------------
DATA l_refobj_range_locked TYPE v54a0_ref_tab WITH HEADER LINE.
DATA l_refobj_range TYPE v54a0_ref_tab WITH HEADER LINE.
DATA l_tcode LIKE sy-tcode.
DATA l_dummy(200).
DATA l_tknum TYPE vttk-tknum.
l_refobj_range[] = c_refobj_range[] .
nast = i_nast.
nast-vstat = '1'. "procesado correctamente
nast-datvr = sy-datlo.
nast-uhrvr = sy-timlo.
l_tcode = sy-tcode.
sy-tcode = 'VT10'.
READ TABLE l_refobj_range INDEX 1.
l_tknum = l_refobj_range-rebel.
CALL FUNCTION 'DEQUEUE_EVVTTKE'
EXPORTING
mandt = sy-mandt
tknum = l_tknum.
* Create shipment cost documents
CALL FUNCTION 'SD_SCDS_CREATE'
EXPORTING
i_opt_package_size = i_opt_package_size
IMPORTING
e_refobj_range_locked = l_refobj_range_locked[]
CHANGING
c_refobj_range = l_refobj_range[]
EXCEPTIONS
OTHERS = 0.
e_refobj_range_locked[] = l_refobj_range_locked[] .
c_refobj_range[] = l_refobj_range[] .
sy-tcode = l_tcode.
DATA: g_protocol LIKE sprot_u OCCURS 0 WITH HEADER LINE.
CALL FUNCTION 'SD_SHIPMENT_PROTOCOL_GET'
TABLES
c_protocol = g_protocol
EXCEPTIONS
OTHERS = 0.
t_protocol[] = g_protocol[].
CALL FUNCTION 'NAST_PROTOCOL_INITIALIZE'.
sy-msgid = 'VN'.
sy-msgno = '056'.
sy-msgty = 'I'.
sy-msgv1 = 'ZSD_CREA_GASTOS_TRANSP'.
sy-msgv2 = 'ENTRY'.
CALL FUNCTION 'NAST_PROTOCOL_UPDATE'
EXPORTING
msg_arbgb = sy-msgid
msg_nr = sy-msgno
msg_ty = sy-msgty
msg_v1 = sy-msgv1
msg_v2 = sy-msgv2
EXCEPTIONS
OTHERS = 0.
LOOP AT g_protocol WHERE severity = 'E' OR severity = 'A'.
MESSAGE ID g_protocol-ag TYPE g_protocol-severity NUMBER g_protocol-msgnr
WITH g_protocol-var1 g_protocol-var2 g_protocol-var3 g_protocol-var4 INTO l_dummy.
PERFORM protocol_update.
ENDLOOP.
IF sy-subrc = 0.
nast-vstat = '2'. "procesado con errores
ENDIF.
LOOP AT g_protocol WHERE ag = 'VY' AND msgnr = '212' AND severity = 'S'.
MESSAGE ID g_protocol-ag TYPE g_protocol-severity NUMBER g_protocol-msgnr
WITH g_protocol-var1 g_protocol-var2 g_protocol-var3 g_protocol-var4 INTO l_dummy.
PERFORM protocol_update.
ENDLOOP.
PERFORM protocol_store USING nast-kappl
nast-kschl
CHANGING nast-cmfpnr.
PERFORM nast_update.
CALL FUNCTION 'ENQUEUE_EVVTTKE'
EXPORTING
tknum = l_tknum.
ENDFUNCTION.
*&---------------------------------------------------------------------*
*& Form PROTOCOL_UPDATE
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM protocol_update.
CALL FUNCTION 'NAST_PROTOCOL_UPDATE'
EXPORTING
msg_arbgb = syst-msgid
msg_nr = syst-msgno
msg_ty = syst-msgty
msg_v1 = syst-msgv1
msg_v2 = syst-msgv2
msg_v3 = syst-msgv3
msg_v4 = syst-msgv4
EXCEPTIONS
OTHERS = 1.
ENDFORM. "PROTOCOL_UPDATE
*&---------------------------------------------------------------------*
*& Form PROTOCOL_STORE
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->VALUE(PI_KAPPL) text
* -->VALUE(PI_KSCHL) text
* -->P_CMFPNR text
*----------------------------------------------------------------------*
FORM protocol_store USING value(pi_kappl) LIKE nast-kappl
value(pi_kschl) LIKE nast-kschl
CHANGING p_cmfpnr LIKE nast-cmfpnr.
DATA: l_nast_cmfpnr LIKE nast-cmfpnr.
* store protocol entries for this message type?
CALL FUNCTION 'NAST_PROTOCOL_STORE'
IMPORTING
msg_cmfpnr = l_nast_cmfpnr
EXCEPTIONS
no_protocol_update = 01.
IF sy-subrc EQ 0.
p_cmfpnr = l_nast_cmfpnr.
ENDIF.
ENDFORM. "PROTOCOL_STORE
*&---------------------------------------------------------------------*
*& Form NAST_UPDATE
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM nast_update .
UPDATE nast.
IF sy-subrc NE 0.
INSERT nast.
IF sy-subrc NE 0.
ENDIF.
ENDIF.
ENDFORM. " NAST_UPDATE
