*@----------------------------------------------------------------------
*@ Program id : ZVUNIPAC
*@ Program Desc : Unichem Packing List
*@ Copy and modification of 9010 packing list program
*@ ZVRMPACK.
*@ Transaction Code -
*@ Input files : ID - none
*@ Output files : ID - none
*@
*@ Tables Updated: Table -
*@
*@
*@ Author : A. Kassam
*@ Date : May 05, 2000
*@ Requested by: Otik
*@----------------------------------------------------------------------
*@ Algorithm:
*@
*@----------------------------------------------------------------------
** Change History:
** Correction Mod by Date Description
** LABK929159 Cfieulle Jan 16, 2001 Change shipper to print the sales
** rep from the corresponding sales order.
**----------------------------------------------------------------------
** LABK931057 CFieulle Oct 19, 2001 Correct rounding error for total.
**----------------------------------------------------------------------
** LABK932548 CFieulle May 08, 2002
** Handling surcharge for ship-to's S1116470 and S1116470C:
** 1. No longer list freight as a line item.
** 2. Include freight charge in total.
**----------------------------------------------------------------------
** LABK932820 CFieulle June 05, 2002
** Contact name and telephone number: get from shipto. If
** none exists, use sales order p.o. contact name as
** previously.
**----------------------------------------------------------------------
** LABK934290 CFIEULLE January 17, 2003
** When items created in currency other than price book
** currency, the pricing retrieval function does not
** retrieve the correct unit price. In these cases we get
** the unit price by taking the net item price and
** dividing by the vbap quantity.
**----------------------------------------------------------------------
*----------------------------------------------------------------------*
* 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
sadr, "Addresses
conf_out, "Configuration data
tvko, "Sales organization
adrs. "Communicationarea for Address
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
zinvoice01. "Bridge between abap for invoices
tables: komk, "Communicationarea for conditions
komp. "Communicationarea for conditions
tables: vbadr. "Address work area
tables: vbfa. "Document flow "LABK918260
tables: pa0002. "HR:Personal Data "LABK929159
* Includes
include rvadtabl.
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 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: 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 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
end of i_tvbdpl. "LABK918260
data: pr_kappl(01) type c value 'V'. "Application for pricing
* Start insert LABK932548
data: g_shipto_num like kna1-kunnr.
constants: c_paramount1 like kna1-kunnr value 'S1116470',
c_paramount2 like kna1-kunnr value 'S1116470C'.
* End insert LABK932548
** Macro
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.
xscreen = us_screen.
perform processing using us_screen.
if retcode ne 0.
return_code = 1.
else.
return_code = 0.
endif.
endform.
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 item_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'.
mac_write_form 'REPEAT' 'REPEAT'.
if sy-subrc ne 0.
perform protocol_update.
endif.
exit.
endselect.
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.
perform sender.
endform.
*---------------------------------------------------------------------*
* FORM GET_ITEM_CHARACTERISTICS *
*---------------------------------------------------------------------*
* In this routine the configuration data item is fetched from *
* the database. *
*---------------------------------------------------------------------*
form get_item_characteristics.
refresh tkomcon.
check not vbdpl-cuobj is initial.
call function 'CUD0_GET_CONFIGURATION'
exporting
instance = vbdpl-cuobj
language = nast-spras
tables
configuration = tkomcon
exceptions
others = 4.
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_SERIAL_NO *
*---------------------------------------------------------------------*
* In this routine the serialnumbers are fetched from the *
* database. *
*---------------------------------------------------------------------*
form get_serial_no.
check vbdpl-anzsn > 0.
* Read the Serialnumbers of a Position.
refresh tkomser.
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.
perform get_sales_order_data.
perform get_shipto_party.
perform get_carrier.
perform get_header_texts.
endform. " HEADER_DATA_PRINT
*---------------------------------------------------------------------*
* 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_price like tkomvd-kbetr, "Unichem
l_amount like tkomvd-kbetr, "Unichem
l2_amount like l_amount. "Unichem
data: l_sum_order_qty like vbap-kwmeng, "LABK918260
l_prev_del_qty like vbdpl-lfimg. "LABK918260
data: l_kbetr type p decimals 5. "LABK931057
data: l_paramount_freight(1). "LABK932548
* {Start insert LABK934290
data: l_knumh like konp-knumh,
l_konwa like konp-konwa.
* End insert LABK934290}
mac_write_form_main 'ITEM_HEADER'. "First header
if sy-subrc ne 0.
perform protocol_update.
endif.
* MAC_WRITE_FORM_MAIN 'UNDERLINE'.
* 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.
clear: l_w_item_price,
l_w_shipped_price, "LABK916876
l_w_perc_markup. "LABK916876
* zinvoice01-hdisc_desc,
* zinvoice01-descline1. "LABK917228
* Get order quantity
select single * from vbap where vbeln = vbdpl-vbeln_vauf
* and posnr = vbdpl-posnr
and posnr = vbdpl-posnr_vauf "LABK918260
and matnr = vbdpl-matnr.
* and arktx = vbdpl-arktx.
* Rejected items 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.
*********************Start Processing for UNICHEM***********************
loop at tkomvd where stunr = '100'.
* {Start insert LABK934290
* If there is a discount and the currency is different from the book
* price currency, then we use the vbrp-netwr and quantity to get the
* unit price.
clear: l_knumh, l_konwa.
clear tkomv.
read table tkomv with key kposn = vbap-posnr
kschl = 'ZDBP'.
l_knumh = tkomv-knumh.
select single konwa from konp into l_konwa
where knumh = l_knumh.
if l_konwa <> vbdkl-waerk.
l_price = tkomvd-kwert / vbap-kwmeng.
else.
* End insert LABK934290}
l_price = tkomvd-kbetr.
* {Start insert LABK934290
endif.
* End insert LABK934290}
l_amount = vbdpl-lfimg * l_price.
endloop.
loop at tkomvd where kschl = 'ZDSC'.
if sy-subrc = 0.
* Start delete LABK931057
* divide tkomvd-kbetr by 1000.
* multiply tkomvd-kbetr by -1.
* l_amount = vbdpl-lfimg * l_price * ( 1 - tkomvd-kbetr ).
* End delete LABK931057
* Start insert LABK931057
l_kbetr = tkomvd-kbetr.
divide l_kbetr by 1000.
multiply l_kbetr by -1.
l_amount = vbdpl-lfimg * l_price * ( 1 - l_kbetr ).
* End insert LABK931057
endif.
endloop.
* Start insert LABK932548
* If shipto is Paramount, add freight to total.
clear l_paramount_freight.
if g_shipto_num = c_paramount1 or g_shipto_num = c_paramount2.
read table tkomv with key kposn = vbap-posnr
kschl = 'ZD01'. "freight
if sy-subrc = 0.
l_amount = tkomv-kbetr.
l_paramount_freight = 'X'.
endif.
endif.
* End insert LABK932548
add l_amount to l2_amount.
clear l_amount.
*********************end of processing for UNICHEM**********************
** 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' or
kschl = 'ZDSC' )
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 'ZDSC'.
read table tkomv with key kposn = vbap-posnr
kschl = 'ZDSC'.
divide tkomv-kbetr by 10.
subtract 100 from tkomv-kbetr.
l_w_shipped_price = l_w_shipped_price * tkomv-kbetr.
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
check l_paramount_freight is initial. "LABK932548
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
* If material occurs more than once, we want only the "LABK918260
* first item number. "LABK918260
read table tvbdpl with key matnr = vbdpl-matnr. "LABK918260
vbdpl-posnr = tvbdpl-posnr. "LABK918260
vbdpl-arktx = tvbdpl-arktx. "LABK918260
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 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.
if sy-subrc = 0.
select single * from t005t where spras = 'E'
and land1 = marc-herkl.
endif.
* 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
* 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.
* 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
* << Start delete LABK929159 >>
* SELECT SINGLE * FROM LIKP WHERE VBELN = VBDKL-VBELN.
* SELECT SINGLE * FROM USR03 WHERE BNAME = LIKP-ERNAM.
* << End delete LABK929159 >>
* << Start insert LABK929159 >>
* Shipper is now the sales rep from the sales order
clear pa0002.
select single * from vbpa where "Sales Document Partner
( parvw = 'VE' or
parvw = 'PE' ) and
posnr = '000000' and
vbeln = vbak-vbeln.
if sy-subrc = 0.
select single * from pa0002 where
pernr = vbpa-pernr.
endif.
* << End insert LABK929159 >>
* total amount.
clear zinvoice01-book_val.
zinvoice01-book_val = l2_amount.
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_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 (Table VKO )*
*---------------------------------------------------------------------*
form sender.
select single * from tvko where vkorg = vbdkl-vkorg.
if sy-subrc ne 0.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'TVKO'.
syst-msgv2 = syst-subrc.
perform protocol_update.
exit.
* ENDIF.
* SELECT SINGLE * FROM SADR WHERE ADRNR = TVKO-ADRNR
* AND NATIO = SPACE.
* VBDKL-SLAND = SADR-LAND1.
* IF SY-SUBRC NE 0.
* SYST-MSGID = 'VN'.
* SYST-MSGNO = '203'.
* SYST-MSGTY = 'E'.
* SYST-MSGV1 = 'SADR'.
* SYST-MSGV2 = SYST-SUBRC.
* PERFORM PROTOCOL_UPDATE.
* ENDIF.
*
** Sales organisation header address
* MOVE-CORRESPONDING SADR TO VBADR.
* CLEAR SADR.
else. "LABK925734
tables: adrc.
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.
endform.
*&---------------------------------------------------------------------*
*& Form GET_SALES_ORDER_DATA
*&---------------------------------------------------------------------*
form get_sales_order_data.
select single * from vbak where vbeln = vbdkl-vbeln_vauf.
* Start insert LABK932820
* "Ordered by" and "Attention Phone No" from shipto file
select single * from vbpa
where vbeln = vbak-vbeln
and posnr = '000000'
and ( parvw = 'WE' or parvw = 'SH').
if sy-subrc = 0 and not vbpa-adrnr is initial.
select single * from adrc
where addrnumber = vbpa-adrnr
and date_from <= vbak-vdatu
and nation = ' '.
if sy-subrc = 0.
if not adrc-name_co is initial.
vbak-bname = adrc-name_co.
endif.
if not adrc-tel_number is initial.
vbak-telf1 = adrc-tel_number.
endif.
endif.
endif.
* End insert LABK932820
endform. " GET_SALES_ORDER_DATA
*&---------------------------------------------------------------------*
*& Form GET_SHIPTO_PARTY
*&---------------------------------------------------------------------*
form get_shipto_party.
select single * from vbpa where "Sales Document Partner
parvw = 'WE' and
posnr = '000000' and
vbeln = vbdkl-vbeln.
* Start insert LABK932548
clear g_shipto_num.
g_shipto_num = vbpa-kunnr.
* End insert LABK932548
* 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.
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
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
endif.
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.
* Transporter or Shipped Via
mac_get_so_header_text vbdkl-vbeln '3014' zinvoice01-comment6.
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