*@----------------------------------------------------------------------
*@ Program id : ZVRMPACK
*@ Program Desc : R & M Packing List
*@ Copy and modification of SAP delivery note program
*@ RVADDN01
*@ Transaction Code -
*@ Input files : ID - none
*@ Output files : ID - none
*@
*@ Tables Updated: Table -
*@
*@
*@ Author : CFieulle
*@ Date : 19990909
*@ Requested by: Buddy Corbett
*@----------------------------------------------------------------------
*@ Algorithm:
*@
*@----------------------------------------------------------------------
** Change History:
** Correction Mod by Date Description
** LABK916876 CFieulle 1999-10-12 Eliminate rounding errors which
** caused the packing slip total to
** be slightly different from the
** invoiced total. Instead of taking
** item price after markup/tax and
** then multiplying by qty delivered,
** get item price before markup/tax,
** multiply by delivered qty, then
** add markup/tax.
**
** LABK916904 CFieulle 1999-10-13 Get correct SO line item from
** pricing table
** 2. Overwrite VBDKL address fields
** only (for ship-to).
**
** LABK917000 CFieulle 1999-10-20 For text macro use READ_TEXT_INLINE
** instead of READ_TEXT. READ_TEXT
** totally deleted.
**
** LABK917228 CFieulle 1999-11-04 Country of origin for 3rd party
** items are not entered in matl
** master, so a text field has been
** created for this. Retrieve 3 pty
** ctry of origin from this field.
** Layoutset changed accordingly.
**
** LABK918260 CFieulle 2000-02-01 1. Collect item lines so that
** items of same material are cumu-
** lated and backorder qty correctly
** represented. If the same material
** is entered on more than one line
** item, only display the first line
** number, but with the cumulated
** value of all line items with that
** material number.
** 2. Make sure correct corresponding
** S.O. line items are selected.
** LABK918334 CFieulle 2000-02-04 For rejected S.O. items, display
** value as 0. Still print item line.
**----------------------Post 46B Upgrade-------------------------------
**
** LABK925186 CFieulle 2000-04-06 46B Upgrade.
** For Ship-To address, use central
** address mgmgt table ADRC instead
** of SADR for new invoices.
**
** LABK925722 CFieulle 2000-06-02 46B Upgrade
** Put back calls to subroutines
** that were overwritten by other
** upgrade modifications.
**
** LABK925734 CFieulle 2000-06-05 46B Upgrade
** Re LABK925722, more reapplication
** of overwritten code and address
** (adrc) selection.
**
** LABK925914 CFieulle 2000-06-21 46B Upgrade
** Total price is derived from the
** pricing or condition values. In
** 30F, it was derived from the sales
** order pricing because there was no
** pricing functionality for
** deliveries. In 46B this delivery
** pricing (or condition) functionality
** exists and has been made functional.
** In addition, the new SAP printing
** program, (of which this is a copy)
** uses the delivery condition number
** to get pricing, instead of the sales
** order condition number (30F).
** Okay, after all this explanation,
** the action here is to add some
** logic to get the pricing using the
** sales order condition number if no
** delivery condition number exists.
** This is to make sure that pricing
** will be obtained for documents
** created before the new delivery
** condition functionality was
** activated.
** LABK925959 CFieulle 2000-06-23 46B Upgrade
** Re: LABK925914 above. Need to
** modify the pricing selection from
** TKOMV to use the del item number
** if pricing is from delivery as
** opposed to using the s.o. item no
** if pricing is taken from s.o.
** LABK926386 CFieulle 2000-07-26 $ Total not matching with pro-
** forma invoice total. Fix.
** LABK926398 CFieulle 2000-07-27 Re LABK926386 above. Modified the
** logic.
** LABK926407 CFieulle 2000-07-27 We found a situation where the
** a delivery with conditions had
** pricing different to that of the
** proforma. It seems that when
** pricing is copied from the sales
** order, the header price is the
** moving average price copied from
** the material master. We found
** OSS Note#154529 which explained
** this and said basically, that we
** really shouldn't use the delivery
** pricing to get the total value.
** ****** THEREFORE PREVIOUS LABK'S:
** ****** LABK925914; LABK925959; LABK926386;
** ****** LABK926398; ALL HAVE TO BE UNDONE.
** With this current labk number, I
** have restored v.0017 LABK925081
** i.e. the last previous change.
** One change added: replace delivery
** condition number in function
** 'RV_PRICE_PRINT_ITEM' (new in 46B)
** with sales order condition number.
** LABK928968 CFieulle 2000-12-07 Get shipto party and address
** in order to get telephone no.
** LABK930933 CFieulle 2001-10-02 Increase decimal places of %markup
** variable so that rounding doesn't occur when calculating
** the total.
**
** LABK931706 Becky Wang 2002-01-28
** Use the Country of Origin from the Delivery Notes. If
** could not find the value, then use the value set in the
** material Master, Same logic for HS Code
**
** Display all of the line items even the material is the
** same.
**
** fff FLAU
** - combine line items with same material # and description
*----------------------------------------------------------------------*
* Print of a delivery note by SAPscript *
*----------------------------------------------------------------------*
REPORT rvaddn01 LINE-COUNT 100 message-id zz.
TABLES: vbco3, "Communicationarea for view
vbdkl, "Headerview
vbdpl, "Itemview
komser, "Communicationarea Serialnumbers
conf_out, "Configuration data
tvko, "Sales organization
tvst, "Shipping points
t001g, "Company codes dependend texts
rdgprint, "Dangerous goods All of Data
rdgtxtprt, "undepend. Texts
komk, "Communicationarea for conditions
komp, "Communicationarea for conditions
komvd. "Communicationarea for conditions
INCLUDE rvadtabl.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
tables: vbak, "Sales Document: Header Data
vbap, "Sales Document: Item Data
vbpa, "Sales Document: Partner
lfa1, "Vendor master
kna1, "Customer master
likp, "SD Document: Delivery Header Dat
makt, "Material Descriptions
marc, "Material Master
t005t, "Country Names
tsp03, "Spool: Printer declaration
usr01, "User master record (run-time)
usr03, "User address data
sadr, "Addresses
zinvoice01. "Bridge between abap for invoices
tables: vbadr. "Address work area
tables: vbfa. "Document flow "LABK918260
tables: adrc. "Central Addr Mgmt "LABK925186
include zsmaster. "Master Macro Module
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DATA: retcode LIKE sy-subrc. "Returncode
DATA: xscreen(1) TYPE c. "Output on printer or screen
DATA: BEGIN OF tvbdpl OCCURS 0. "Internal table for items
INCLUDE STRUCTURE vbdpl.
DATA: END OF tvbdpl.
DATA: BEGIN OF tkomv OCCURS 50.
INCLUDE STRUCTURE komv.
DATA: END OF tkomv.
DATA: BEGIN OF tkomvd OCCURS 50.
INCLUDE STRUCTURE komvd.
DATA: END OF tkomvd.
DATA: BEGIN OF tkomcon OCCURS 50. "... for configuration data
INCLUDE STRUCTURE conf_out.
DATA: END OF tkomcon.
DATA: BEGIN OF tkomser OCCURS 5.
INCLUDE STRUCTURE riserls.
DATA: END OF tkomser.
DATA: BEGIN OF tkomser_print OCCURS 5.
INCLUDE STRUCTURE komser.
DATA: END OF tkomser_print.
DATA: BEGIN OF tkombat OCCURS 50. " configuration data for batches
INCLUDE STRUCTURE conf_out.
DATA: END OF tkombat.
DATA: address_selection LIKE addr1_sel. "MOS
DATA: pr_kappl(01) TYPE c VALUE 'V'. "Application for pricing
DATA: print_mwskz.
DATA: price(1) TYPE c. "price switch
DATA: BEGIN OF rdgprint_tab OCCURS 0.
INCLUDE STRUCTURE rdgprint.
DATA: END OF rdgprint_tab.
DATA: i_undep_txt LIKE rdgtxtprt OCCURS 0 WITH HEADER LINE,"undepend Tex
l_spras_txt LIKE rdgtxtprt OCCURS 0 WITH HEADER LINE,"undepend Tex
i_idname_text LIKE rdgtxtprt OCCURS 0 WITH HEADER LINE.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
data: begin of i_tvbdpl occurs 0, "LABK918260
vbeln like vbdpl-vbeln, "LABK918260
matnr like vbdpl-matnr, "LABK918260
lfimg like vbdpl-lfimg, "LABK918260
vrkme like vbdpl-vrkme, "LABK918260
vbeln_vauf like vbdpl-vbeln_vauf, "LABK918260
* start LABK931706
*fff becky add
arktx like vbdpl-arktx,
* POSNR like vbdpl-POSNR,
*fend
* end LABK931706
end of i_tvbdpl. "LABK918260
data: g_name like thead-tdname,
i_line like tline occurs 10 with header line,
i_inline like tline occurs 10 with header line.
define m_zvrmpack_get_text.
refresh i_line. clear i_line.
refresh i_inline. clear i_inline.
g_name = &1.
call function 'READ_TEXT_INLINE'
exporting
id = &2
inline_count = 1
language = 'E'
name = g_name
object = &3
tables
inlines = i_inline
lines = i_line
exceptions
id = 1
language = 2
name = 3
not_found = 4
object = 5
reference_check = 6
others = 7.
&4 = i_inline-tdline.
end-of-definition.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*-----------------------------------------------------------------------
*
*-----------------------------------------------------------------------
FORM entry USING return_code us_screen.
CLEAR retcode.
CLEAR price.
xscreen = us_screen.
PERFORM processing USING us_screen.
IF retcode NE 0.
return_code = 1.
ELSE.
return_code = 0.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM ENTRY_PRICE *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> RETURN_CODE *
* --> US_SCREEN *
*---------------------------------------------------------------------*
FORM entry_price USING return_code us_screen.
CLEAR retcode.
price = 'X'.
xscreen = us_screen.
PERFORM processing USING us_screen.
IF retcode NE 0.
return_code = 1.
ELSE.
return_code = 0.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM PROCESSING *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> PROC_SCREEN *
*---------------------------------------------------------------------*
FORM processing USING proc_screen.
PERFORM get_data.
CHECK retcode = 0.
PERFORM form_open USING proc_screen vbdkl-land1.
CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* PERFORM check_repeat.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
PERFORM header_data_print.
CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* PERFORM header_text_print.
* CHECK retcode = 0.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
PERFORM item_print.
CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* PERFORM end_print.
* CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
PERFORM form_close.
CHECK retcode = 0.
ENDFORM.
***********************************************************************
* S U B R O U T I N E S *
***********************************************************************
*---------------------------------------------------------------------*
* FORM CHECK_REPEAT *
*---------------------------------------------------------------------*
* A text is printed, if it is a repeat print for the document. *
*---------------------------------------------------------------------*
FORM check_repeat.
SELECT * INTO *nast FROM nast WHERE kappl = nast-kappl
AND objky = nast-objky
AND kschl = nast-kschl
AND spras = nast-spras
AND parnr = nast-parnr
AND parvw = nast-parvw
AND nacha BETWEEN '1' AND '4'.
CHECK *nast-vstat = '1'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'REPEAT'
window = 'REPEAT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
EXIT.
ENDSELECT.
ENDFORM.
*---------------------------------------------------------------------*
* FORM END_PRINT *
*---------------------------------------------------------------------*
* *
*---------------------------------------------------------------------*
FORM end_print.
IF price = 'X'.
PERFORM get_header_prices.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'PROTECT'.
PERFORM header_price_print.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'END_VALUES'
EXCEPTIONS
OTHERS = 1.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'ENDPROTECT'.
ENDIF.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'SUPPLEMENT_TEXT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
* print standard texts for dangerous goods
PERFORM dg_print_undep_text.
ENDFORM.
*---------------------------------------------------------------------*
* FORM FORM_CLOSE *
*---------------------------------------------------------------------*
* End of printing the form *
*---------------------------------------------------------------------*
FORM form_close.
mac_close_form. "...Ende Formulardruck
IF sy-subrc NE 0.
retcode = 1.
PERFORM protocol_update.
ENDIF.
SET COUNTRY space.
ENDFORM.
*---------------------------------------------------------------------*
* FORM FORM_OPEN *
*---------------------------------------------------------------------*
* Start of printing the form *
*---------------------------------------------------------------------*
* --> US_SCREEN Output on screen *
* ' ' = printer *
* 'X' = screen *
* --> US_COUNTRY County for telecommunication and SET COUNTRY *
*---------------------------------------------------------------------*
FORM form_open USING us_screen us_country.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* Logic to recognise 'DFLT' designated printer
if nast-ldest = 'DFLT'. " Use the user default printer.
select single * from usr01 where bname = sy-uname.
select single * from tsp03 where padest = usr01-spld.
if sy-subrc = 0.
nast-ldest = usr01-spld.
else.
message e001 with 'Unable to find user default printer.'.
endif.
endif.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
INCLUDE rvadopfo.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_DATA *
*---------------------------------------------------------------------*
* General provision of data for the form *
*---------------------------------------------------------------------*
FORM get_data.
vbco3-spras = nast-spras.
vbco3-vbeln = nast-objky.
vbco3-kunde = nast-parnr.
vbco3-parvw = nast-parvw.
CALL FUNCTION 'RV_DELIVERY_PRINT_VIEW'
EXPORTING
comwa = vbco3
IMPORTING
kopf = vbdkl
TABLES
pos = tvbdpl.
* fill address key --> necessary for emails
addr_key-addrnumber = vbdkl-adrnr.
addr_key-persnumber = vbdkl-adrnp.
addr_key-addr_type = vbdkl-address_type.
* Data selection for dangerous goods
PERFORM dg_data_select USING vbdkl.
PERFORM sender.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_HEADER_PRICES *
*---------------------------------------------------------------------*
* In this routine the price data for the header is fetched from *
* the database. *
*---------------------------------------------------------------------*
FORM get_header_prices.
CALL FUNCTION 'RV_PRICE_PRINT_HEAD'
EXPORTING
comm_head_i = komk
language = nast-spras
IMPORTING
comm_head_e = komk
comm_mwskz = print_mwskz
TABLES
tkomv = tkomv
tkomvd = tkomvd.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_ITEM_CHARACTERISTICS *
*---------------------------------------------------------------------*
* In this routine the configuration data item is fetched from *
* the database. *
*---------------------------------------------------------------------*
FORM get_item_characteristics.
DATA da_t_cabn LIKE cabn OCCURS 10 WITH HEADER LINE.
DATA: BEGIN OF da_key,
mandt LIKE cabn-mandt,
atinn LIKE cabn-atinn,
END OF da_key.
REFRESH tkomcon.
CHECK NOT vbdpl-cuobj IS INITIAL.
CALL FUNCTION 'VC_I_GET_CONFIGURATION'
EXPORTING
instance = vbdpl-cuobj
language = nast-spras
TABLES
configuration = tkomcon
EXCEPTIONS
OTHERS = 4.
RANGES : da_in_cabn FOR da_t_cabn-atinn.
CLEAR da_in_cabn. REFRESH da_in_cabn.
LOOP AT tkomcon.
da_in_cabn-option = 'EQ'.
da_in_cabn-sign = 'I'.
da_in_cabn-low = tkomcon-atinn.
APPEND da_in_cabn.
ENDLOOP.
CLEAR da_t_cabn. REFRESH da_t_cabn.
CALL FUNCTION 'CLSE_SELECT_CABN'
TABLES
in_cabn = da_in_cabn
t_cabn = da_t_cabn
EXCEPTIONS
no_entry_found = 1
OTHERS = 2.
* Preisfindungsmerkmale / Merkmale auf VCSD_UPDATE herausnehmen
SORT da_t_cabn.
LOOP AT tkomcon.
da_key-mandt = sy-mandt.
da_key-atinn = tkomcon-atinn.
READ TABLE da_t_cabn WITH KEY da_key BINARY SEARCH.
IF sy-subrc <> 0 OR
( ( da_t_cabn-attab = 'SDCOM' AND
da_t_cabn-atfel = 'VKOND' ) OR
( da_t_cabn-attab = 'VCSD_UPDATE' ) ) .
DELETE tkomcon.
ENDIF.
ENDLOOP.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_ITEM_CHARACTERISTICS_BATCH *
*---------------------------------------------------------------------*
* In this routine the configuration data for batches is fetched *
* from the database *
*---------------------------------------------------------------------*
FORM get_item_characteristics_batch.
REFRESH tkombat.
CHECK NOT vbdpl-charg IS INITIAL.
CALL FUNCTION 'VB_BATCH_VALUES_FOR_OUTPUT'
EXPORTING
material = vbdpl-matnr
plant = vbdpl-werks
batch = vbdpl-charg
language = nast-spras
TABLES
classification = tkombat
EXCEPTIONS
OTHERS = 4.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_ITEM_PRICES *
*---------------------------------------------------------------------*
* In this routine the price data for the item is fetched from *
* the database. *
*---------------------------------------------------------------------*
FORM get_item_prices.
CLEAR: komp,
tkomv.
*<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
* IF komk-knumv NE vbdkl-knump.
* CLEAR komk.
* komk-mandt = sy-mandt.
* komk-kalsm = vbdkl-kalsp.
* komk-kappl = pr_kappl.
* komk-waerk = vbdkl-waerk.
* komk-knumv = vbdkl-knump.
* komk-vbtyp = vbdkl-vbtyp.
* ENDIF.
* komp-kposn = vbdpl-posnr.
*<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
*<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
IF KOMK-KNUMV NE VBAK-KNUMV.
CLEAR KOMK.
KOMK-MANDT = SY-MANDT.
KOMK-KALSM = VBAK-KALSM.
KOMK-KAPPL = PR_KAPPL.
KOMK-WAERK = VBAK-WAERK.
KOMK-KNUMV = VBAK-KNUMV.
KOMK-VBTYP = VBAK-VBTYP.
ENDIF.
KOMP-KPOSN = VBAP-POSNR.
*<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
CALL FUNCTION 'RV_PRICE_PRINT_ITEM'
EXPORTING
comm_head_i = komk
comm_item_i = komp
language = nast-spras
IMPORTING
comm_head_e = komk
comm_item_e = komp
TABLES
tkomv = tkomv
tkomvd = tkomvd.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_SERIAL_NO *
*---------------------------------------------------------------------*
* In this routine the serialnumbers are fetched from the *
* database. *
*---------------------------------------------------------------------*
FORM get_serial_no.
REFRESH tkomser.
REFRESH tkomser_print.
CHECK vbdpl-anzsn > 0.
* Read the Serialnumbers of a Position.
CALL FUNCTION 'SERIAL_LS_PRINT'
EXPORTING
vbeln = vbdkl-vbeln
posnr = vbdpl-posnr
TABLES
iserls = tkomser.
* Process the stringtable for Printing.
CALL FUNCTION 'PROCESS_SERIALS_FOR_PRINT'
EXPORTING
i_boundary_left = '(_'
i_boundary_right = '_)'
i_sep_char_strings = ',_'
i_sep_char_interval = '_-_'
i_use_interval = 'X'
i_boundary_method = 'C'
i_line_length = 50
i_no_zero = 'X'
i_alphabet = sy-abcde
i_digits = '0123456789'
i_special_chars = '-'
i_with_second_digit = ' '
TABLES
serials = tkomser
serials_print = tkomser_print
EXCEPTIONS
boundary_missing = 01
interval_separation_missing = 02
length_to_small = 03
internal_error = 04
wrong_method = 05
wrong_serial = 06
two_equal_serials = 07
serial_with_wrong_char = 08
serial_separation_missing = 09.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form HEADER_DATA_PRINT
*&---------------------------------------------------------------------*
* Printing of the header data like terms, weights *
*----------------------------------------------------------------------*
FORM header_data_print.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'HEADER_DATA'
* EXCEPTIONS
* element = 1
* window = 2.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
PERFORM GET_SALES_ORDER_DATA. "LABK925722
PERFORM GET_SHIPTO_PARTY. "LABK925722
PERFORM GET_CARRIER. "LABK925722
PERFORM GET_HEADER_TEXTS. "LABK925722
ENDFORM. " HEADER_DATA_PRINT
*---------------------------------------------------------------------*
* FORM HEADER_PRICE_PRINT *
*---------------------------------------------------------------------*
* Printout of the header prices *
*---------------------------------------------------------------------*
FORM header_price_print.
LOOP AT tkomvd.
AT FIRST.
IF komk-supos NE 0.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_SUM'
EXCEPTIONS
element = 1
window = 2.
ELSE.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'UNDER_LINE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDAT.
komvd = tkomvd.
IF print_mwskz = space.
CLEAR komvd-mwskz.
ENDIF.
IF komvd-koaid = 'D'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TAX_LINE'
EXCEPTIONS
element = 1
window = 2.
ELSE.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'SUM_LINE'
EXCEPTIONS
element = 1
window = 2.
ENDIF.
ENDLOOP.
DESCRIBE TABLE tkomvd LINES sy-tfill.
IF sy-tfill = 0.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'UNDER_LINE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM HEADER_TEXT_PRINT *
*---------------------------------------------------------------------*
* Printout of the headertexts *
*---------------------------------------------------------------------*
FORM header_text_print.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'HEADER_TEXT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM ITEM_PRINT *
*---------------------------------------------------------------------*
* Printout of the items *
*---------------------------------------------------------------------*
FORM item_print.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
data: l_w_item_price like tkomvd-kbetr,
l_w_shipped_price like tkomvd-kbetr, "LABK916876
* l_w_perc_markup like tkomvd-kbetr. "LABK916876
l_w_perc_markup type p decimals 3. "LABK930933
data: l_sum_order_qty like vbap-kwmeng, "LABK918260
l_prev_del_qty like vbdpl-lfimg. "LABK918260
* Start LABK931706
Data: l_wa_eipo like eipo,
l_wa_likp like likp.
* End LABK931706
* CALL FUNCTION 'WRITE_FORM' "First header
* EXPORTING element = 'ITEM_HEADER'
* EXCEPTIONS OTHERS = 1.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
* CALL FUNCTION 'WRITE_FORM' "Activate header
* EXPORTING element = 'ITEM_HEADER'
* type = 'TOP'
* EXCEPTIONS OTHERS = 1.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
mac_write_form_main 'ITEM_HEADER'. "First header
if sy-subrc ne 0.
perform protocol_update.
endif.
mac_write_element_top 'ITEM_HEADER'. "Activate header
if sy-subrc ne 0.
perform protocol_update.
endif.
* LOOP AT tvbdpl.
* vbdpl = tvbdpl.
* IF vbdpl-uecha IS INITIAL.
* CALL FUNCTION 'CONTROL_FORM'
* EXPORTING
* command = 'PROTECT'.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'ITEM_LINE'.
* CALL FUNCTION 'CONTROL_FORM'
* EXPORTING
* command = 'ENDPROTECT'.
** Seitenumbruch, wenn Positionstexte nicht auf eine Seite passen.
* CALL FUNCTION 'CONTROL_FORM'
* EXPORTING
* command = 'PROTECT'.
* PERFORM item_text_print.
* PERFORM dg_print_data_get.
* PERFORM dg_data_print.
* IF price = 'X'.
* PERFORM get_item_prices.
* PERFORM item_price_print.
* ENDIF.
* PERFORM get_serial_no.
* PERFORM item_serial_no_print.
* PERFORM get_item_characteristics.
* PERFORM item_characteristics_print.
* PERFORM get_item_characteristics_batch.
* PERFORM item_characteristics_batch.
* IF vbdpl-vbeln_vauf NE space AND
* vbdpl-vbeln_vauf NE vbdkl-vbeln_vauf.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'ITEM_REFERENCE'
* EXCEPTIONS
* element = 1
* window = 2.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
* ENDIF.
* IF vbdpl-qmnum NE space AND
* vbdpl-qmnum NE vbdkl-qmnum.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'ITEM_QNUMBER'
* EXCEPTIONS
* element = 1
* window = 2.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
* ENDIF.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'ITEM_PURCHASE_DATA'
* EXCEPTIONS
* element = 1
* window = 2.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
* CALL FUNCTION 'CONTROL_FORM'
* EXPORTING
* command = 'ENDPROTECT'.
* ELSE.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'ITEM_LINE_BATCH'.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
* PERFORM get_serial_no.
* PERFORM item_serial_no_print.
* PERFORM get_item_characteristics_batch.
* PERFORM item_characteristics_batch.
* ENDIF.
* ENDLOOP.
*
* CALL FUNCTION 'WRITE_FORM' "Deactivate Header
* EXPORTING element = 'ITEM_HEADER'
* function = 'DELETE'
* type = 'TOP'
* EXCEPTIONS OTHERS = 1.
* IF sy-subrc NE 0.
* PERFORM protocol_update.
* ENDIF.
loop at tvbdpl.
vbdpl = tvbdpl.
clear: l_w_item_price,
l_w_shipped_price, "LABK916876
l_w_perc_markup. "LABK916876
* Get order quantity
select single * from vbap where vbeln = vbdpl-vbeln_vauf
and posnr = vbdpl-posnr_vauf "LABK918260
and matnr = vbdpl-matnr.
* Rejected item will not be billed, therefore do not "LABK918334
* include in overall price. "LABK918334
if not vbap-abgru is initial. "LABK918334
move-corresponding vbdpl to i_tvbdpl. "LABK918334
collect i_tvbdpl. "LABK918334
clear i_tvbdpl. "LABK918334
continue. "LABK918334
endif. "LABK918334
* Get Item prices from sales order
perform get_item_prices.
** If there is no tax markup, there'll only be gross price in this table
** If there is tax, there'll also be net value.
* READ TABLE TKOMVD WITH KEY STUNR = '201'.
* IF SY-SUBRC = 0.
* LOOP AT TKOMVD WHERE STUNR = '400'. "Net value for item
* ADD TKOMVD-KBETR TO L_W_ITEM_PRICE.
* ENDLOOP.
* ELSE.
* LOOP AT TKOMVD WHERE STUNR = '100'. "Gross price
* ADD TKOMVD-KBETR TO L_W_ITEM_PRICE.
* ENDLOOP.
* ENDIF.
* Pricing can be done in three ways: "LABK916876
* Price (1) ZINC (2) ZDBP (3) PB00 "LABK916876
* + Markup + ZOHM + - + Z3RD "LABK916876
* + 12% Tax + ZTXM + ZTXM + ZTXM "LABK916876
* So get the price then and multiply by qty delivered, then "LABK916876
* add the appropriate % markup/tax. "LABK916876
* These can only be obtained in the TKOMV table "LABK916876
* loop at tkomv where kposn = vbdpl-posnr "LABK916876
loop at tkomv where kposn = vbap-posnr "LABK916904
and ( kschl = 'ZINC' or "LABK916876
kschl = 'ZDBP' or "LABK916876
kschl = 'PB00' ) "LABK916876
and kwert ne 0 "LABK916876
and kinak ne 'Y'. "LABK916876
* Value of each item
l_w_item_price = tkomv-kwert / vbap-kwmeng. "LABK916876
* Price of shipped items = value of each item * qty shipped "LABK916876
l_w_shipped_price = l_w_item_price * vbdpl-lfimg. "LABK916876
case tkomv-kschl. "LABK916876
when 'ZINC'. "LABK916876
* read table tkomv with key kposn = vbdpl-posnr "LABK916876
read table tkomv with key kposn = vbap-posnr "LABK918260
kschl = 'ZOHM'. "LABK916876
if sy-subrc = 0. "LABK916876
divide tkomv-kbetr by 10. "LABK916876
l_w_perc_markup = tkomv-kbetr / 100. "LABK916876
l_w_shipped_price = l_w_shipped_price + "LABK916876
( l_w_shipped_price * "LABK916876
l_w_perc_markup ). "LABK916876
endif. "LABK916876
* read table tkomv with key kposn = vbdpl-posnr "LABK916876
read table tkomv with key kposn = vbap-posnr "LABK918260
kschl = 'ZTXM'. "LABK916876
if sy-subrc = 0. "LABK916876
divide tkomv-kbetr by 10. "LABK916876
l_w_perc_markup = tkomv-kbetr / 100. "LABK916876
l_w_shipped_price = l_w_shipped_price + "LABK916876
( l_w_shipped_price * "LABK916876
l_w_perc_markup ). "LABK916876
endif. "LABK916876
exit. "LABK916876
when 'ZDBP'. "LABK916876
* read table tkomv with key kposn = vbdpl-posnr "LABK916876
read table tkomv with key kposn = vbap-posnr "LABK918260
kschl = 'ZTXM'. "LABK916876
if sy-subrc = 0. "LABK916876
divide tkomv-kbetr by 10. "LABK916876
l_w_perc_markup = tkomv-kbetr / 100. "LABK916876
l_w_shipped_price = l_w_shipped_price + "LABK916876
( l_w_shipped_price * "LABK916876
l_w_perc_markup ). "LABK916876
endif. "LABK916876
exit. "LABK916876
when 'PB00'. "LABK916876
* read table tkomv with key kposn = vbdpl-posnr "LABK916876
read table tkomv with key kposn = vbap-posnr "LABK918260
kschl = 'Z3RD'. "LABK916876
if sy-subrc = 0. "LABK916876
divide tkomv-kbetr by 10. "LABK916876
l_w_perc_markup = tkomv-kbetr / 100. "LABK916876
l_w_shipped_price = l_w_shipped_price + "LABK916876
( l_w_shipped_price * "LABK916876
l_w_perc_markup ). "LABK916876
endif. "LABK916876
* read table tkomv with key kposn = vbdpl-posnr "LABK916876
read table tkomv with key kposn = vbap-posnr "LABK918260
kschl = 'ZTXM'. "LABK916876
if sy-subrc = 0. "LABK916876
divide tkomv-kbetr by 10. "LABK916876
l_w_perc_markup = tkomv-kbetr / 100. "LABK916876
l_w_shipped_price = l_w_shipped_price + "LABK916876
( l_w_shipped_price * "LABK916876
l_w_perc_markup ). "LABK916876
endif. "LABK916876
exit. "LABK916876
endcase. "LABK916876
endloop. "LABK916876
** Price of shipped items = value of each item * qty shipped
* L_W_ITEM_PRICE = L_W_ITEM_PRICE * VBDPL-LFIMG.
* Start adding to total
add l_w_shipped_price to zinvoice01-book_val.
* Collect total delivered qty for each material "LABK918260
move-corresponding vbdpl to i_tvbdpl. "LABK918260
collect i_tvbdpl. "LABK918260
clear i_tvbdpl. "LABK918260
endloop. "LABK918260
** Calculate Back Order
* ZINVOICE01-QUANTITY = VBAP-KWMENG - VBDPL-LFIMG.
* Get additional item data "LABK918260
clear vbdpl. "LABK918260
sort tvbdpl by posnr. "LABK918260
loop at i_tvbdpl. "LABK918260
clear: zinvoice01-hdisc_desc, "LABK918260
zinvoice01-descline1. "LABK918260
clear l_sum_order_qty. "LABK918260
clear l_prev_del_qty. "LABK918260
move-corresponding i_tvbdpl to vbdpl. "LABK918260
** Start of LABK931706
** If material occurs more than once, we want only the "LABK918260
** first item number. "LABK918260
*fff becky delete
* read table tvbdpl with key matnr = vbdpl-matnr. "LABK918260
* vbdpl-posnr = tvbdpl-posnr. "LABK918260
* vbdpl-arktx = tvbdpl-arktx. "LABK918260
*ffadd
read table tvbdpl with key matnr = vbdpl-matnr
arktx = vbdpl-arktx.
vbdpl-posnr = tvbdpl-posnr.
*ffadd<-
*fend
** End of LABK931706
vbdpl-werks = tvbdpl-werks. "LABK918260
vbdpl-tdname = tvbdpl-tdname. "LABK918260
* Calculate back order = sum of s.o. qty - (total qty "LABK918260
* delivered on this del note + sum qty on previous "LABK918260
* del notes. "LABK918260
select * from vbap where vbeln = vbdpl-vbeln_vauf "LABK918260
and arktx = vbdpl-arktx "fff
and matnr = vbdpl-matnr. "LABK918260
if vbap-abgru is initial. "LABK918334
add vbap-kwmeng to l_sum_order_qty. "LABK918260
else. "LABK918334
add 0 to l_sum_order_qty. "LABK918334
endif. "LABK918334
select * from vbfa where vbelv = vbap-vbeln "LABK918260
and posnv = vbap-posnr "LABK918260
and vbeln ne vbdpl-vbeln "LABK918260
and vbtyp_n = 'J' "LABK918260
and vbtyp_v = 'C' "LABK918260
and erdat le vbdkl-erdat. "LABK918260
add vbfa-rfmng to l_prev_del_qty. "LABK918260
endselect. "LABK918260
endselect. "LABK918260
zinvoice01-quantity = l_sum_order_qty - "LABK918260
( vbdpl-lfimg + l_prev_del_qty ). "LABK918260
* Get Country of Origin
select single * from marc where matnr = vbdpl-matnr
and werks = vbdpl-werks.
* IF MARC-HERKL = ' '.
* MARC-HERKL = 'CA'.
* ENDIF.
**** Start of LABK931706
* if sy-subrc = 0.
* select single * from t005t where spras = 'E'
* and land1 = marc-herkl.
* endif.
if sy-subrc = 0.
clear: l_wa_eipo, l_wa_likp.
select single * from likp into l_wa_likp
where vbeln = vbdpl-vbeln.
if sy-subrc = 0.
select single * from eipo into l_wa_eipo
where exnum = l_wa_likp-exnum
and expos = vbdpl-posnr.
if sy-subrc = 0 and ( not l_wa_eipo-herkl is initial ).
select single * from t005t where spras = 'E'
and land1 = l_wa_eipo-herkl.
else.
select single * from t005t where spras = 'E'
and land1 = marc-herkl.
endif.
else.
select single * from t005t where spras = 'E'
and land1 = marc-herkl.
endif.
* Get HS Code for freight 3rd party material
if vbap-pstyv = 'ZYAS' and vbap-matnr <> '000000000000300006'.
if not l_wa_eipo-stawn is initial.
marc-stawn = l_wa_eipo-stawn.
endif.
endif.
endif.
**** End of LABK931706
* Get US material description
clear makt.
select single * from makt where matnr = vbdpl-matnr
and spras = 'Z'.
select single * from vbap where "LABK918260
vbeln = vbdpl-vbeln_vauf "LABK918260
and posnr = vbdpl-posnr "LABK918260
and matnr = vbdpl-matnr. "LABK918260
* Start LABK931706
** Get HS Code for freight 3rd party material
* if vbap-pstyv = 'ZYAS' and vbap-matnr <> '000000000000300006'.
* m_zvrmpack_get_text vbdpl-tdname '9004' 'VBBP'
* zinvoice01-hdisc_desc.
* Also get country of origin for 3rd party material "LABK917228
* m_zvrmpack_get_text vbdpl-tdname '9005' 'VBBP' "LABK917228
* zinvoice01-descline1. "LABK917228
* endif.
* End LABK931706
* Put in order quantity for printing purposes
move l_sum_order_qty to vbap-kwmeng.
mac_control_form 'PROTECT'.
mac_write_form_main 'ITEM_LINE'.
* PERFORM GET_SERIAL_NO.
* PERFORM ITEM_SERIAL_NO_PRINT.
* PERFORM GET_ITEM_CHARACTERISTICS.
* PERFORM ITEM_CHARACTERISTICS_PRINT.
* PERFORM GET_ITEM_CHARACTERISTICS_BATCH.
* PERFORM ITEM_CHARACTERISTICS_BATCH.
if sy-subrc ne 0.
perform protocol_update.
endif.
mac_control_form 'ENDPROTECT'.
if sy-subrc ne 0.
perform protocol_update.
endif.
endloop.
mac_delete_top_element 'ITEM_HEADER'. "Deactivate Header
if sy-subrc ne 0.
perform protocol_update.
endif.
mac_write_form_main 'UNDERLINE'.
if sy-subrc ne 0.
perform protocol_update.
endif.
* Footer
* Get full name of shipper
select single * from likp where vbeln = vbdkl-vbeln.
select single * from usr03 where bname = likp-ernam.
mac_write_form_main 'FOOTER'.
if sy-subrc ne 0.
perform protocol_update.
endif.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ENDFORM.
*---------------------------------------------------------------------*
* FORM ITEM_CHARACERISTICS_BATCH *
*---------------------------------------------------------------------*
* Printout of the item characteristics for batches *
*---------------------------------------------------------------------*
FORM item_characteristics_batch.
LOOP AT tkombat.
conf_out = tkombat.
IF sy-tabix = 1.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_CONFIGURATION_BATCH_HEADER'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ELSE.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_CONFIGURATION_BATCH'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDLOOP.
ENDFORM.
*---------------------------------------------------------------------*
* FORM ITEM_CHARACERISTICS_PRINT *
*---------------------------------------------------------------------*
* Printout of the item characteristics -> configuration *
*---------------------------------------------------------------------*
FORM item_characteristics_print.
LOOP AT tkomcon.
conf_out = tkomcon.
IF sy-tabix = 1.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_CONFIGURATION_HEADER'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ELSE.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_CONFIGURATION'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDLOOP.
ENDFORM.
*---------------------------------------------------------------------*
* FORM ITEM_PRICE_PRINT *
*---------------------------------------------------------------------*
* Printout of the item prices *
*---------------------------------------------------------------------*
FORM item_price_print.
LOOP AT tkomvd.
komvd = tkomvd.
IF print_mwskz = space.
CLEAR komvd-mwskz.
ENDIF.
IF sy-tabix = 1.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_PRICE_QUANTITY'
EXCEPTIONS
element = 1
window = 2.
ELSE.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_PRICE_TEXT'
EXCEPTIONS
element = 1
window = 2.
ENDIF.
ENDLOOP.
ENDFORM.
*---------------------------------------------------------------------*
* FORM ITEM_SERIAL_NO_PRINT *
*---------------------------------------------------------------------*
* Printout of the item serialnumbers *
*---------------------------------------------------------------------*
FORM item_serial_no_print.
LOOP AT tkomser_print.
komser = tkomser_print.
IF sy-tabix = 1.
* Output of the Headerline
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_SERIAL_NO_HEADER'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ELSE.
* Output of the following printlines
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_SERIAL_NO'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
AT LAST.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'NEW-LINE'.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDAT.
ENDLOOP.
ENDFORM.
*---------------------------------------------------------------------*
* FORM PROTOCOL_UPDATE *
*---------------------------------------------------------------------*
* The messages are collected for the processing protocol. *
*---------------------------------------------------------------------*
FORM protocol_update.
CHECK xscreen = space.
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.
*---------------------------------------------------------------------*
* FORM SENDER *
*---------------------------------------------------------------------*
* This routine determines the address of the sender *
*---------------------------------------------------------------------*
FORM sender.
SELECT SINGLE * FROM tvko WHERE vkorg = vbdkl-vkorg.
IF sy-subrc NE 0.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'W'.
syst-msgv1 = 'TVKO'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ELSE. "LABK925734
SELECT SINGLE * FROM SADR WHERE ADRNR = TVKO-ADRNR "LABK925734
AND NATIO = SPACE. "LABK925734
IF SY-SUBRC = 0. "LABK925734
VBDKL-SLAND = SADR-LAND1. "LABK925734
* Sales organisation header address "LABK925734
MOVE-CORRESPONDING SADR TO VBADR. "LABK925734
CLEAR SADR. "LABK925734
ELSE. "LABK925734
SELECT SINGLE * FROM ADRC WHERE "LABK925734
ADDRNUMBER = TVKO-ADRNR AND "LABK925734
NATION = SPACE. "LABK925734
IF SY-SUBRC = 0. "LABK925734
VBDKL-SLAND = ADRC-COUNTRY. "LABK925734
MOVE: ADRC-TITLE TO VBADR-ANRED, "LABK925734
ADRC-NAME2 TO VBADR-NAME2, "LABK925734
ADRC-NAME3 TO VBADR-NAME3, "LABK925734
ADRC-NAME4 TO VBADR-NAME4, "LABK925734
ADRC-STREET TO VBADR-STRAS, "LABK925734
ADRC-POST_CODE1 TO VBADR-PSTLZ, "LABK925734
ADRC-PO_BOX TO VBADR-PFACH, "LABK925734
ADRC-POST_CODE2 TO VBADR-PSTL2, "LABK925734
ADRC-PO_BOX_LOC TO VBADR-PFORT, "LABK925734
ADRC-REGION TO VBADR-REGIO, "LABK925734
ADRC-CITY1 TO VBADR-ORT01, "LABK925734
ADRC-CITY2 TO VBADR-ORT02, "LABK925734
ADRC-COUNTRY TO VBADR-LAND1. "LABK925734
CLEAR ADRC. "LABK925734
ELSE. "LABK925734
SYST-MSGID = 'VN'. "LABK925734
SYST-MSGNO = '203'. "LABK925734
SYST-MSGTY = 'E'. "LABK925734
SYST-MSGV1 = 'ADRC'. "LABK925734
SYST-MSGV2 = SYST-SUBRC. "LABK925734
PERFORM PROTOCOL_UPDATE. "LABK925734
ENDIF. "LABK925734
ENDIF. "LABK925734
ENDIF.
SELECT SINGLE * FROM tvst WHERE vstel = vbdkl-vstel.
IF sy-subrc NE 0.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'W'.
syst-msgv1 = 'TVST'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
SELECT SINGLE * FROM t001g WHERE bukrs = vbdkl-bukrs
AND programm = 'RVADDN01'
AND txtid = space.
IF sy-subrc NE 0.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'W'.
syst-msgv1 = 'T001G'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form DG_DATA_SELECT
*&---------------------------------------------------------------------*
* Get data for dangerous goods positions
*----------------------------------------------------------------------*
FORM dg_data_select USING i_vbdkl LIKE vbdkl.
TABLES: vbuk.
DATA: dg_flag VALUE ' '.
************************************************************************
* Check of transportation organization status delivery
************************************************************************
* select single * from vbuk where vbeln = i_vbdkl-vbeln.
*-----------------------------------------------------------------------
* First case: Dangerous goods data only when not relevant to transport
*-----------------------------------------------------------------------
* check vbuk-trsta eq ' '.
*-----------------------------------------------------------------------
* Second case: Dangerous goods data when not relevant to transport
* with status 'not processed'.
* Attention: In this case dangerous goods data may have changed
* in a transport document if the selection date
* has been changed
*-----------------------------------------------------------------------
* check vbuk-trsta eq ' '
* or vbuk-trsta eq 'A'.
************************************************************************
LOOP AT tvbdpl.
IF tvbdpl-idgpa EQ 'X'.
dg_flag = 'X'.
EXIT.
ENDIF.
ENDLOOP.
*---Data select for dangerous goods
IF dg_flag EQ 'X'.
CALL FUNCTION 'HAZMAT_PRI_DATA_GET'
EXPORTING
e_vbdkl = i_vbdkl
i_nspras = nast-spras
TABLES
e_rdgprint_tab = rdgprint_tab
e_tvbdpl = tvbdpl
e_spras_txt = l_spras_txt
EXCEPTIONS
get_data_error = 1
OTHERS = 2.
* set retcode
IF sy-subrc = 1.
retcode = 1.
ELSE.
retcode = 0.
ENDIF.
ENDIF.
ENDFORM. " DG_DATA_SELECT
*&---------------------------------------------------------------------*
*& Form DG_PRINT_DATA_GET
*&---------------------------------------------------------------------*
* Prepares Data in printstructure
*----------------------------------------------------------------------*
FORM dg_print_data_get.
DATA lin TYPE i.
CHECK NOT tvbdpl-idgpa IS INITIAL.
DESCRIBE TABLE rdgprint_tab LINES lin.
CHECK lin GT 0.
*......................................................................
* GET PRINT CONDITIONS * GET TEXT-IDS FOR DEPENDENT TEXT
*......................................................................
CALL FUNCTION 'HAZMAT_GET_COND_TEXT_KEY'
EXPORTING
i_sprache = nast-spras
i_matnr = tvbdpl-matnr
i_vbdkl = vbdkl
TABLES
i_rdgprint_tab = rdgprint_tab
i_idname_text = i_idname_text
i_undep_text = i_undep_txt
i_spras_txt = l_spras_txt
* i_tdgc3_tab = i_tdgc3_tab
i_tvbdpl = tvbdpl
EXCEPTIONS
OTHERS = 1.
ENDFORM. " DG_DATA_GET
*&---------------------------------------------------------------------*
*& Form DG_DATA_PRINT
*&---------------------------------------------------------------------*
* Print Data to layout
*----------------------------------------------------------------------*
FORM dg_data_print.
DATA: lin TYPE i,
first_mat LIKE tvbdpl-matnr,
sec_mat LIKE tvbdpl-matnr.
first_mat = 0.
CHECK NOT tvbdpl-idgpa IS INITIAL.
DESCRIBE TABLE rdgprint_tab LINES lin.
CHECK lin GT 0.
CLEAR l_spras_txt.
* print position data
LOOP AT rdgprint_tab WHERE matnr = tvbdpl-matnr.
MOVE-CORRESPONDING rdgprint_tab TO rdgprint.
sec_mat = first_mat.
first_mat = tvbdpl-matnr.
IF first_mat NE sec_mat.
CALL FUNCTION 'WRITE_FORM' " Header Text
EXPORTING
element = 'ITEM_LINE_DG_HEADER'
EXCEPTIONS
OTHERS = 1.
ENDIF.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_DG'
EXCEPTIONS
OTHERS = 1.
* print dependent position text
LOOP AT i_idname_text WHERE mot = rdgprint_tab-mot
AND rvlid = rdgprint_tab-rvlid
AND matnr = rdgprint_tab-matnr.
READ TABLE l_spras_txt WITH KEY mot = i_idname_text-mot
rvlid = i_idname_text-rvlid.
IF rdgprint_tab-sprsls = l_spras_txt-tdspras.
rdgtxtprt-tdspras = l_spras_txt-tdspras.
ENDIF.
rdgprint-txname = i_idname_text-tdname.
rdgprint-iddep = i_idname_text-tdid.
CLEAR rdgtxtprt-tdname.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_DG_TEXT'
EXCEPTIONS
OTHERS = 1.
CLEAR rdgprint-txname.
CLEAR rdgprint-iddep.
CLEAR rdgtxtprt-tdspras.
ENDLOOP.
* print undependent position text
LOOP AT i_undep_txt. " where mot = rdgprint_tab-mot
" and rvlid = rdgprint_tab-rvlid.
READ TABLE l_spras_txt WITH KEY mot = i_undep_txt-mot
rvlid = i_undep_txt-rvlid.
rdgtxtprt-tdname = i_undep_txt-tdname.
rdgtxtprt-tdspras = i_undep_txt-tdspras.
CLEAR: rdgprint-txname,
rdgprint-iddep .
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_DG_TEXT'
EXCEPTIONS
OTHERS = 1.
ENDLOOP.
ENDLOOP.
ENDFORM. " DG_DATA_PRINT
*&---------------------------------------------------------------------*
*& Form DG_PRINT_UNDEP_TEXT
*&---------------------------------------------------------------------*
FORM dg_print_undep_text.
* get undepend Texts
CALL FUNCTION 'HAZMAT_GET_DG_UNDEP_TEXT'
EXPORTING
i_vbdkl = vbdkl
TABLES
i_rdgprint_tab = rdgprint_tab
i_tvbdpl = tvbdpl
i_idname_text = i_idname_text.
LOOP AT i_idname_text.
rdgtxtprt-tdname = i_idname_text-tdname.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'DG_STANDARD_TEXT'
EXCEPTIONS
OTHERS = 1.
ENDLOOP.
ENDFORM. " DG_PRINT_UNDEP_TEXT
*&---------------------------------------------------------------------*
*& Form ITEM_TEXT_PRINT
*&---------------------------------------------------------------------*
FORM item_text_print.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_TEXT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. " ITEM_TEXT_PRINT
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
*&---------------------------------------------------------------------*
*& Form GET_SALES_ORDER_DATA
*&---------------------------------------------------------------------*
form get_sales_order_data.
select single * from vbak where vbeln = vbdkl-vbeln_vauf.
endform. " GET_SALES_ORDER_DATA
*&---------------------------------------------------------------------*
*& Form GET_SHIPTO_PARTY
*&---------------------------------------------------------------------*
form get_shipto_party.
clear vbdkl-telf1_vko. "LABK928968
select single * from vbpa where "Sales Document Partner
parvw = 'WE' and
posnr = '000000' and
vbeln = vbdkl-vbeln.
* Need KNA1 for EIN/VAT number, so get it whether shipto is altered
* or not.
select single * from kna1 where
kunnr = vbpa-kunnr.
if vbpa-adrnr ne ' '.
* Shipto party information has been altered.
select single * from sadr where
adrnr = vbpa-adrnr and
natio = ' '.
* Only want vbdkl address components overwritten "LABK916904
if sy-subrc = 0. "LABK925186
* move-corresponding sadr to vbdkl.
move: sadr-anred to vbdkl-anred, "LABK916904
sadr-name1 to vbdkl-name1, "LABK916904
sadr-name2 to vbdkl-name2, "LABK916904
sadr-name3 to vbdkl-name3, "LABK916904
sadr-name4 to vbdkl-name4, "LABK916904
sadr-stras to vbdkl-stras, "LABK916904
sadr-pfach to vbdkl-pfach, "LABK916904
sadr-pstl2 to vbdkl-pstl2, "LABK916904
sadr-pfort to vbdkl-pfort, "LABK916904
sadr-pstlz to vbdkl-pstlz, "LABK916904
sadr-regio to vbdkl-regio, "LABK916904
sadr-ort01 to vbdkl-ort01, "LABK916904
sadr-ort02 to vbdkl-ort02, "LABK916904
sadr-land1 to vbdkl-land1. "LABK916904
move sadr-telfx to vbdkl-telf1_vst.
move sadr-telf1 to vbdkl-telf1_vko. "LABK928968
clear sadr.
else. "LABK925186
select single * from adrc where "LABK925186
addrnumber = vbpa-adrnr and "LABK925186
date_from le sy-datum and "LABK925186
nation = ' '. "LABK925186
if sy-subrc = 0. "LABK925186
move: adrc-name1 to vbdkl-name1, "LABK925186
adrc-name2 to vbdkl-name2, "LABK925186
adrc-name3 to vbdkl-name3, "LABK925186
adrc-name4 to vbdkl-name4, "LABK925186
adrc-street to vbdkl-stras, "LABK925186
adrc-po_box to vbdkl-pfach, "LABK925186
adrc-post_code2 to vbdkl-pstl2, "LABK925186
adrc-po_box_loc to vbdkl-pfort, "LABK925186
adrc-post_code1 to vbdkl-pstlz, "LABK925186
adrc-region to vbdkl-regio, "LABK925186
adrc-city1 to vbdkl-ort01, "LABK925186
adrc-city2 to vbdkl-ort02, "LABK925186
adrc-country to vbdkl-land1, "LABK925186
adrc-fax_number to vbdkl-telf1_vst, "LABK925186
adrc-tel_number to vbdkl-telf1_vko. "LABK928968
clear adrc. "LABK925186
endif. "LABK925186
endif. "LABK925186
else.
* If Shipto party not altered.
* Only want vbdkl address components overwritten "LABK916904
* move-corresponding kna1 to vbdkl.
move: kna1-anred to vbdkl-anred, "LABK916904
kna1-name1 to vbdkl-name1, "LABK916904
kna1-name2 to vbdkl-name2, "LABK916904
kna1-name3 to vbdkl-name3, "LABK916904
kna1-name4 to vbdkl-name4, "LABK916904
kna1-stras to vbdkl-stras, "LABK916904
kna1-pfach to vbdkl-pfach, "LABK916904
kna1-pstl2 to vbdkl-pstl2, "LABK916904
kna1-pfort to vbdkl-pfort, "LABK916904
kna1-pstlz to vbdkl-pstlz, "LABK916904
kna1-regio to vbdkl-regio, "LABK916904
kna1-ort01 to vbdkl-ort01, "LABK916904
kna1-ort02 to vbdkl-ort02, "LABK916904
kna1-land1 to vbdkl-land1, "LABK916904
kna1-land1 to vbdkl-telf1_vko. "LABK928968
endif.
*<< Start Insert LABK928968 >>
if vbdkl-telf1_vko is initial.
move vbak-telf1 to vbdkl-telf1_vko.
endif.
*<< End Insert LABK928968 >>
endform. " GET_SHIPTO_PARTY
*&---------------------------------------------------------------------*
*& Form GET_HEADER_TEXTS
*&---------------------------------------------------------------------*
form get_header_texts.
* Customer Field Rep
mac_get_so_header_text vbdkl-vbeln '0031' zinvoice01-comment1.
* Waybill Number
mac_get_so_header_text vbdkl-vbeln '3010' zinvoice01-comment2.
* Number of pieces
mac_get_so_header_text vbdkl-vbeln '3011' zinvoice01-comment3.
* Total Weight
mac_get_so_header_text vbdkl-vbeln '3012' zinvoice01-comment4.
* Dimensions
mac_get_so_header_text vbdkl-vbeln '3013' zinvoice01-comment5.
endform. " GET_HEADER_TEXTS
*&---------------------------------------------------------------------*
*& Form GET_CARRIER
*&---------------------------------------------------------------------*
form get_carrier.
select single * from vbpa where vbeln = vbdkl-vbeln
and posnr = '000000'
and parvw = 'SP'.
check sy-subrc = 0.
select single * from lfa1 where lifnr = vbpa-lifnr.
endform. " GET_CARRIER
**&---------------------------------------------------------------------
*
**& Form GET_ITEM_PRICES
**&---------------------------------------------------------------------
*
*form get_item_prices.
*
* clear: komp,
* tkomv.
*
* if komk-knumv ne vbak-knumv.
* clear komk.
* komk-mandt = sy-mandt.
* komk-kalsm = vbak-kalsm.
* komk-kappl = pr_kappl.
* komk-waerk = vbak-waerk.
* komk-knumv = vbak-knumv.
* komk-vbtyp = vbak-vbtyp.
* endif.
* komp-kposn = vbap-posnr.
*
* call function 'RV_PRICE_PRINT_ITEM'
* exporting
* comm_head_i = komk
* comm_item_i = komp
* language = nast-spras
* importing
* comm_head_e = komk
* comm_item_e = komp
* tables
* tkomv = tkomv
* tkomvd = tkomvd.
*
*
*endform. " GET_ITEM_PRICES
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<