*@---------------------------------------------------------------------- *@ 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