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