*@----------------------------------------------------------------------
*@ Program id    : ZVRMPACK
*@ Program Desc  : R & M Packing List
*@                 Copy and modification of SAP delivery note program
*@                 RVADDN01
*@ Transaction Code -
*@ Input files   : ID - none
*@ Output files  : ID - none
*@
*@ Tables Updated: Table -
*@
*@
*@ Author      : CFieulle
*@ Date        : 19990909
*@ Requested by: Buddy Corbett
*@----------------------------------------------------------------------
*@ Algorithm:
*@
*@----------------------------------------------------------------------
** Change History:
** Correction  Mod by   Date        Description
** LABK916876  CFieulle 1999-10-12  Eliminate rounding errors which
**                                  caused the packing slip total to
**                                  be slightly different from the
**                                  invoiced total.  Instead of taking
**                                  item price after markup/tax and
**                                  then multiplying by qty delivered,
**                                  get item price before markup/tax,
**                                  multiply by delivered qty, then
**                                  add markup/tax.
**
** LABK916904  CFieulle 1999-10-13  Get correct SO line item from
**                                  pricing table
**                                  2. Overwrite VBDKL address fields
**                                  only (for ship-to).
**
** LABK917000  CFieulle 1999-10-20  For text macro use READ_TEXT_INLINE
**                                  instead of READ_TEXT.  READ_TEXT
**                                  totally deleted.
**
** LABK917228  CFieulle 1999-11-04  Country of origin for 3rd party
**                                  items are not entered in matl
**                                  master, so a text field has been
**                                  created for this. Retrieve 3 pty
**                                  ctry of origin from this field.
**                                  Layoutset changed accordingly.
**
** LABK918260 CFieulle 2000-02-01   1. Collect item lines so that
**                                  items of same material are cumu-
**                                  lated and backorder qty correctly
**                                  represented. If the same material
**                                  is entered on more than one line
**                                  item, only display the first line
**                                  number, but with the cumulated
**                                  value of all line items with that
**                                  material number.
**                                  2. Make sure correct corresponding
**                                  S.O. line items are selected.
** LABK918334 CFieulle 2000-02-04   For rejected S.O. items, display
**                                  value as 0. Still print item line.
**----------------------Post 46B Upgrade-------------------------------
**
** LABK925186 CFieulle 2000-04-06   46B Upgrade.
**                                  For Ship-To address, use central
**                                  address mgmgt table ADRC instead
**                                  of SADR for new invoices.
**
** LABK925722 CFieulle 2000-06-02   46B Upgrade
**                                  Put back calls to subroutines
**                                  that were overwritten by other
**                                  upgrade modifications.
**
** LABK925734 CFieulle 2000-06-05   46B Upgrade
**                                  Re LABK925722, more reapplication
**                                  of overwritten code and address
**                                  (adrc) selection.
**
** LABK925914 CFieulle 2000-06-21   46B Upgrade
**                                  Total price is derived from the
**                                  pricing or condition values. In
**                                  30F, it was derived from the sales
**                                  order pricing because there was no
**                                  pricing functionality for
**                                  deliveries.  In 46B this delivery
**                                  pricing (or condition) functionality
**                                  exists and has been made functional.
**                                  In addition, the new SAP printing
**                                  program, (of which this is a copy)
**                                  uses the delivery condition number
**                                  to get pricing, instead of the sales
**                                  order condition number (30F).
**                                  Okay, after all this explanation,
**                                  the action here is to add some
**                                  logic to get the pricing using the
**                                  sales order condition number if no
**                                  delivery condition number exists.
**                                  This is to make sure that pricing
**                                  will be obtained for documents
**                                  created before the new delivery
**                                  condition functionality was
**                                  activated.
** LABK925959 CFieulle 2000-06-23   46B Upgrade
**                                  Re: LABK925914 above. Need to
**                                  modify the pricing selection from
**                                  TKOMV to use the del item number
**                                  if pricing is from delivery as
**                                  opposed to using the s.o. item no
**                                  if pricing is taken from s.o.
** LABK926386 CFieulle 2000-07-26   $ Total not matching with pro-
**                                  forma invoice total.  Fix.
** LABK926398 CFieulle 2000-07-27   Re LABK926386 above. Modified the
**                                  logic.
** LABK926407 CFieulle 2000-07-27   We found a situation where the
**                                  a delivery with conditions had
**                                  pricing different to that of the
**                                  proforma.  It seems that when
**                                  pricing is copied from the sales
**                                  order, the header price is the
**                                  moving average price copied from
**                                  the material master.  We found
**                                  OSS Note#154529 which explained
**                                  this and said basically, that we
**                                  really shouldn't use the delivery
**                                  pricing to get the total value.
**                ******            THEREFORE PREVIOUS LABK'S:
**                ******            LABK925914; LABK925959; LABK926386;
**                ******            LABK926398; ALL HAVE TO BE UNDONE.
**                                  With this current labk number, I
**                                  have restored v.0017 LABK925081
**                                  i.e. the last previous change.
**                                  One change added: replace delivery
**                                  condition number in function
**                                  'RV_PRICE_PRINT_ITEM' (new in 46B)
**                                  with sales order condition number.
** LABK928968  CFieulle 2000-12-07  Get shipto party and address
**                                  in order to get telephone no.
** LABK930933  CFieulle 2001-10-02  Increase decimal places of %markup
**             variable so that rounding doesn't occur when calculating
**             the total.
**
** LABK931706  Becky Wang 2002-01-28
**             Use the Country of Origin from the Delivery Notes. If
**             could not find the value, then use the value set in the
**             material Master, Same logic for HS Code
**
**             Display all of the line items even the material is the
**             same.
**
** fff        FLAU
**            - combine line items with same material # and description
*----------------------------------------------------------------------*
*              Print of a delivery note by SAPscript                   *
*----------------------------------------------------------------------*
REPORT rvaddn01 LINE-COUNT 100 message-id zz.

TABLES: vbco3,                         "Communicationarea for view
        vbdkl,                         "Headerview
        vbdpl,                         "Itemview
        komser,                        "Communicationarea Serialnumbers
        conf_out,                      "Configuration data
        tvko,                          "Sales organization
        tvst,                          "Shipping points
        t001g,                         "Company codes dependend texts
        rdgprint,                      "Dangerous goods All of Data
        rdgtxtprt,                     "undepend. Texts
        komk,                          "Communicationarea for conditions
        komp,                          "Communicationarea for conditions
        komvd.                         "Communicationarea for conditions
INCLUDE rvadtabl.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
tables: vbak,                          "Sales Document: Header Data
        vbap,                          "Sales Document: Item Data
        vbpa,                          "Sales Document: Partner
        lfa1,                          "Vendor master
        kna1,                          "Customer master
        likp,                          "SD Document: Delivery Header Dat
        makt,                          "Material Descriptions
        marc,                          "Material Master
        t005t,                         "Country Names
        tsp03,                         "Spool: Printer declaration
        usr01,                         "User master record (run-time)
        usr03,                         "User address data
        sadr,                          "Addresses
        zinvoice01.                    "Bridge between abap for invoices

tables: vbadr.                         "Address work area

tables: vbfa.                          "Document flow       "LABK918260

tables: adrc.                          "Central Addr Mgmt   "LABK925186

include zsmaster.                      "Master Macro Module
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

DATA: retcode   LIKE sy-subrc.         "Returncode
DATA: xscreen(1) TYPE c.               "Output on printer or screen

DATA: BEGIN OF tvbdpl OCCURS 0.        "Internal table for items
        INCLUDE STRUCTURE vbdpl.
DATA: END OF tvbdpl.

DATA: BEGIN OF tkomv OCCURS 50.
        INCLUDE STRUCTURE komv.
DATA: END OF tkomv.

DATA: BEGIN OF tkomvd OCCURS 50.
        INCLUDE STRUCTURE komvd.
DATA: END OF tkomvd.

DATA: BEGIN OF tkomcon OCCURS 50.      "...  for configuration data
        INCLUDE STRUCTURE conf_out.
DATA: END OF tkomcon.

DATA: BEGIN OF tkomser OCCURS 5.
        INCLUDE STRUCTURE riserls.
DATA: END   OF tkomser.

DATA: BEGIN OF tkomser_print OCCURS 5.
        INCLUDE STRUCTURE komser.
DATA: END   OF tkomser_print.

DATA: BEGIN OF tkombat OCCURS 50.      " configuration data for batches
        INCLUDE STRUCTURE conf_out.
DATA: END   OF tkombat.

DATA:  address_selection LIKE addr1_sel.                    "MOS

DATA: pr_kappl(01)   TYPE c VALUE 'V'. "Application for pricing
DATA: print_mwskz.

DATA: price(1) TYPE c.                 "price switch

DATA: BEGIN OF rdgprint_tab OCCURS 0.
        INCLUDE STRUCTURE rdgprint.
DATA: END   OF rdgprint_tab.

DATA: i_undep_txt LIKE rdgtxtprt OCCURS 0 WITH HEADER LINE,"undepend Tex
      l_spras_txt LIKE rdgtxtprt OCCURS 0 WITH HEADER LINE,"undepend Tex
      i_idname_text LIKE rdgtxtprt OCCURS 0 WITH HEADER LINE.

*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
data: begin of i_tvbdpl occurs 0,                           "LABK918260
        vbeln like vbdpl-vbeln,                             "LABK918260
        matnr like vbdpl-matnr,                             "LABK918260
        lfimg like vbdpl-lfimg,                             "LABK918260
        vrkme like vbdpl-vrkme,                             "LABK918260
        vbeln_vauf like vbdpl-vbeln_vauf,                   "LABK918260
*       start LABK931706
*fff becky add
        arktx like vbdpl-arktx,
*        POSNR like vbdpl-POSNR,
*fend
*       end LABK931706
      end of i_tvbdpl.                                      "LABK918260


data: g_name like thead-tdname,
      i_line   like tline occurs 10 with header line,
      i_inline like tline occurs 10 with header line.

define m_zvrmpack_get_text.

  refresh i_line.  clear i_line.
  refresh i_inline. clear i_inline.
  g_name = &1.

  call function 'READ_TEXT_INLINE'
       exporting
            id              = &2
            inline_count    = 1
            language        = 'E'
            name            = g_name
            object          = &3
       tables
            inlines         = i_inline
            lines           = i_line
       exceptions
            id              = 1
            language        = 2
            name            = 3
            not_found       = 4
            object          = 5
            reference_check = 6
            others          = 7.

    &4 = i_inline-tdline.

end-of-definition.

*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*-----------------------------------------------------------------------
*
*-----------------------------------------------------------------------

FORM entry USING return_code us_screen.

  CLEAR retcode.
  CLEAR price.
  xscreen = us_screen.
  PERFORM processing USING us_screen.
  IF retcode NE 0.
    return_code = 1.
  ELSE.
    return_code = 0.
  ENDIF.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM ENTRY_PRICE                                              *
*---------------------------------------------------------------------*
*       ........                                                      *
*---------------------------------------------------------------------*
*  -->  RETURN_CODE                                                   *
*  -->  US_SCREEN                                                     *
*---------------------------------------------------------------------*
FORM entry_price USING return_code us_screen.

  CLEAR retcode.
  price = 'X'.
  xscreen = us_screen.
  PERFORM processing USING us_screen.
  IF retcode NE 0.
    return_code = 1.
  ELSE.
    return_code = 0.
  ENDIF.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM PROCESSING                                               *
*---------------------------------------------------------------------*
*       ........                                                      *
*---------------------------------------------------------------------*
*  -->  PROC_SCREEN                                                   *
*---------------------------------------------------------------------*
FORM processing USING proc_screen.

  PERFORM get_data.
  CHECK retcode = 0.
  PERFORM form_open USING proc_screen vbdkl-land1.
  CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
*  PERFORM check_repeat.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  PERFORM header_data_print.
  CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
*  PERFORM header_text_print.
*  CHECK retcode = 0.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  PERFORM item_print.
  CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
*  PERFORM end_print.
*  CHECK retcode = 0.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  PERFORM form_close.
  CHECK retcode = 0.

ENDFORM.

***********************************************************************
*       S U B R O U T I N E S                                         *
***********************************************************************

*---------------------------------------------------------------------*
*       FORM CHECK_REPEAT                                             *
*---------------------------------------------------------------------*
*       A text is printed, if it is a repeat print for the document.  *
*---------------------------------------------------------------------*

FORM check_repeat.

  SELECT * INTO *nast FROM nast WHERE kappl = nast-kappl
                                AND   objky = nast-objky
                                AND   kschl = nast-kschl
                                AND   spras = nast-spras
                                AND   parnr = nast-parnr
                                AND   parvw = nast-parvw
                                AND   nacha BETWEEN '1' AND '4'.
    CHECK *nast-vstat = '1'.
    CALL FUNCTION 'WRITE_FORM'
         EXPORTING
              element = 'REPEAT'
              window  = 'REPEAT'
         EXCEPTIONS
              element = 1
              window  = 2.
    IF sy-subrc NE 0.
      PERFORM protocol_update.
    ENDIF.
    EXIT.
  ENDSELECT.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM END_PRINT                                                *
*---------------------------------------------------------------------*
*                                                                     *
*---------------------------------------------------------------------*

FORM end_print.

  IF price = 'X'.
    PERFORM get_header_prices.
    CALL FUNCTION 'CONTROL_FORM'
         EXPORTING
              command = 'PROTECT'.
    PERFORM header_price_print.
    CALL FUNCTION 'WRITE_FORM'
         EXPORTING
              element = 'END_VALUES'
         EXCEPTIONS
              OTHERS  = 1.
    CALL FUNCTION 'CONTROL_FORM'
         EXPORTING
              command = 'ENDPROTECT'.
  ENDIF.

  CALL FUNCTION 'WRITE_FORM'
       EXPORTING
            element = 'SUPPLEMENT_TEXT'
       EXCEPTIONS
            element = 1
            window  = 2.
  IF sy-subrc NE 0.
    PERFORM protocol_update.
  ENDIF.

* print standard texts for dangerous goods
  PERFORM dg_print_undep_text.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM FORM_CLOSE                                               *
*---------------------------------------------------------------------*
*       End of printing the form                                      *
*---------------------------------------------------------------------*

FORM form_close.

  mac_close_form.                      "...Ende Formulardruck
  IF sy-subrc NE 0.
    retcode = 1.
    PERFORM protocol_update.
  ENDIF.
  SET COUNTRY space.

ENDFORM.


*---------------------------------------------------------------------*
*       FORM FORM_OPEN                                                *
*---------------------------------------------------------------------*
*       Start of printing the form                                    *
*---------------------------------------------------------------------*
*  -->  US_SCREEN  Output on screen                                   *
*                  ' ' = printer                                      *
*                  'X' = screen                                       *
*  -->  US_COUNTRY County for telecommunication and SET COUNTRY       *
*---------------------------------------------------------------------*

FORM form_open USING us_screen us_country.

*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* Logic to recognise 'DFLT' designated printer
  if nast-ldest = 'DFLT'.    " Use the user default printer.
    select single * from usr01 where bname = sy-uname.
    select single * from tsp03 where padest = usr01-spld.
    if sy-subrc = 0.
      nast-ldest = usr01-spld.
    else.
      message e001 with 'Unable to find user default printer.'.
    endif.
  endif.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

  INCLUDE rvadopfo.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM GET_DATA                                                 *
*---------------------------------------------------------------------*
*       General provision of data for the form                        *
*---------------------------------------------------------------------*

FORM get_data.

  vbco3-spras = nast-spras.
  vbco3-vbeln = nast-objky.
  vbco3-kunde = nast-parnr.
  vbco3-parvw = nast-parvw.

  CALL FUNCTION 'RV_DELIVERY_PRINT_VIEW'
       EXPORTING
            comwa = vbco3
       IMPORTING
            kopf  = vbdkl
       TABLES
            pos   = tvbdpl.

* fill address key --> necessary for emails
  addr_key-addrnumber = vbdkl-adrnr.
  addr_key-persnumber = vbdkl-adrnp.
  addr_key-addr_type  = vbdkl-address_type.

* Data selection for dangerous goods
  PERFORM dg_data_select USING vbdkl.
  PERFORM sender.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM GET_HEADER_PRICES                                        *
*---------------------------------------------------------------------*
*       In this routine the price data for the header is fetched from *
*       the database.                                                 *
*---------------------------------------------------------------------*

FORM get_header_prices.

  CALL FUNCTION 'RV_PRICE_PRINT_HEAD'
       EXPORTING
            comm_head_i = komk
            language    = nast-spras
       IMPORTING
            comm_head_e = komk
            comm_mwskz  = print_mwskz
       TABLES
            tkomv       = tkomv
            tkomvd      = tkomvd.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM GET_ITEM_CHARACTERISTICS                                 *
*---------------------------------------------------------------------*
*       In this routine the configuration data item is fetched from   *
*       the database.                                                 *
*---------------------------------------------------------------------*

FORM get_item_characteristics.

  DATA da_t_cabn LIKE cabn OCCURS 10 WITH HEADER LINE.
  DATA: BEGIN OF da_key,
          mandt LIKE cabn-mandt,
          atinn LIKE cabn-atinn,
        END   OF da_key.

  REFRESH tkomcon.
  CHECK NOT vbdpl-cuobj IS INITIAL.

  CALL FUNCTION 'VC_I_GET_CONFIGURATION'
       EXPORTING
            instance      = vbdpl-cuobj
            language      = nast-spras
       TABLES
            configuration = tkomcon
       EXCEPTIONS
            OTHERS        = 4.

  RANGES : da_in_cabn FOR da_t_cabn-atinn.
  CLEAR da_in_cabn. REFRESH da_in_cabn.
  LOOP AT tkomcon.
    da_in_cabn-option = 'EQ'.
    da_in_cabn-sign   = 'I'.
    da_in_cabn-low    = tkomcon-atinn.
    APPEND da_in_cabn.
  ENDLOOP.

  CLEAR da_t_cabn. REFRESH da_t_cabn.
  CALL FUNCTION 'CLSE_SELECT_CABN'
       TABLES
            in_cabn        = da_in_cabn
            t_cabn         = da_t_cabn
       EXCEPTIONS
            no_entry_found = 1
            OTHERS         = 2.

* Preisfindungsmerkmale / Merkmale auf VCSD_UPDATE herausnehmen
  SORT da_t_cabn.
  LOOP AT tkomcon.
    da_key-mandt = sy-mandt.
    da_key-atinn = tkomcon-atinn.
    READ TABLE da_t_cabn WITH KEY da_key BINARY SEARCH.
    IF sy-subrc <> 0 OR
         ( ( da_t_cabn-attab = 'SDCOM' AND
            da_t_cabn-atfel = 'VKOND'       ) OR
          ( da_t_cabn-attab = 'VCSD_UPDATE' ) ) .
      DELETE tkomcon.
    ENDIF.
  ENDLOOP.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM GET_ITEM_CHARACTERISTICS_BATCH                           *
*---------------------------------------------------------------------*
*       In this routine the configuration data for batches is fetched *
*       from the database                                             *
*---------------------------------------------------------------------*

FORM get_item_characteristics_batch.

  REFRESH tkombat.
  CHECK NOT vbdpl-charg IS INITIAL.

  CALL FUNCTION 'VB_BATCH_VALUES_FOR_OUTPUT'
       EXPORTING
            material       = vbdpl-matnr
            plant          = vbdpl-werks
            batch          = vbdpl-charg
            language       = nast-spras
       TABLES
            classification = tkombat
       EXCEPTIONS
            OTHERS         = 4.

  IF sy-subrc NE 0.
    PERFORM protocol_update.
  ENDIF.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM GET_ITEM_PRICES                                          *
*---------------------------------------------------------------------*
*       In this routine the price data for the item is fetched from   *
*       the database.                                                 *
*---------------------------------------------------------------------*

FORM get_item_prices.

  CLEAR: komp,
         tkomv.

*<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
*  IF komk-knumv NE vbdkl-knump.
*    CLEAR komk.
*    komk-mandt = sy-mandt.
*    komk-kalsm = vbdkl-kalsp.
*    komk-kappl = pr_kappl.
*    komk-waerk = vbdkl-waerk.
*    komk-knumv = vbdkl-knump.
*    komk-vbtyp = vbdkl-vbtyp.
*  ENDIF.
*  komp-kposn = vbdpl-posnr.
*<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>

*<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>
  IF KOMK-KNUMV NE VBAK-KNUMV.
    CLEAR KOMK.
    KOMK-MANDT = SY-MANDT.
    KOMK-KALSM = VBAK-KALSM.
    KOMK-KAPPL = PR_KAPPL.
    KOMK-WAERK = VBAK-WAERK.
    KOMK-KNUMV = VBAK-KNUMV.
    KOMK-VBTYP = VBAK-VBTYP.
  ENDIF.
  KOMP-KPOSN = VBAP-POSNR.
*<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>

  CALL FUNCTION 'RV_PRICE_PRINT_ITEM'
       EXPORTING
            comm_head_i = komk
            comm_item_i = komp
            language    = nast-spras
       IMPORTING
            comm_head_e = komk
            comm_item_e = komp
       TABLES
            tkomv       = tkomv
            tkomvd      = tkomvd.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM GET_SERIAL_NO                                            *
*---------------------------------------------------------------------*
*       In this routine the serialnumbers are fetched from the        *
*       database.                                                     *
*---------------------------------------------------------------------*

FORM get_serial_no.

  REFRESH tkomser.
  REFRESH tkomser_print.
  CHECK vbdpl-anzsn > 0.
* Read the Serialnumbers of a Position.
  CALL FUNCTION 'SERIAL_LS_PRINT'
       EXPORTING
            vbeln  = vbdkl-vbeln
            posnr  = vbdpl-posnr
       TABLES
            iserls = tkomser.

* Process the stringtable for Printing.
  CALL FUNCTION 'PROCESS_SERIALS_FOR_PRINT'
       EXPORTING
            i_boundary_left             = '(_'
            i_boundary_right            = '_)'
            i_sep_char_strings          = ',_'
            i_sep_char_interval         = '_-_'
            i_use_interval              = 'X'
            i_boundary_method           = 'C'
            i_line_length               = 50
            i_no_zero                   = 'X'
            i_alphabet                  = sy-abcde
            i_digits                    = '0123456789'
            i_special_chars             = '-'
            i_with_second_digit         = ' '
       TABLES
            serials                     = tkomser
            serials_print               = tkomser_print
       EXCEPTIONS
            boundary_missing            = 01
            interval_separation_missing = 02
            length_to_small             = 03
            internal_error              = 04
            wrong_method                = 05
            wrong_serial                = 06
            two_equal_serials           = 07
            serial_with_wrong_char      = 08
            serial_separation_missing   = 09.

  IF sy-subrc NE 0.
    PERFORM protocol_update.
  ENDIF.

ENDFORM.

*&---------------------------------------------------------------------*
*&      Form  HEADER_DATA_PRINT
*&---------------------------------------------------------------------*
*       Printing of the header data like terms, weights                *
*----------------------------------------------------------------------*

FORM header_data_print.

*  CALL FUNCTION 'WRITE_FORM'
*       EXPORTING
*            element = 'HEADER_DATA'
*       EXCEPTIONS
*            element = 1
*            window  = 2.
*  IF sy-subrc NE 0.
*    PERFORM protocol_update.
*  ENDIF.

  PERFORM GET_SALES_ORDER_DATA.                            "LABK925722
  PERFORM GET_SHIPTO_PARTY.                                "LABK925722
  PERFORM GET_CARRIER.                                     "LABK925722
  PERFORM GET_HEADER_TEXTS.                                "LABK925722

ENDFORM.                               " HEADER_DATA_PRINT

*---------------------------------------------------------------------*
*       FORM HEADER_PRICE_PRINT                                       *
*---------------------------------------------------------------------*
*       Printout of the header prices                                 *
*---------------------------------------------------------------------*

FORM header_price_print.

  LOOP AT tkomvd.

    AT FIRST.
      IF komk-supos NE 0.
        CALL FUNCTION 'WRITE_FORM'
             EXPORTING
                  element = 'ITEM_SUM'
             EXCEPTIONS
                  element = 1
                  window  = 2.
      ELSE.
        CALL FUNCTION 'WRITE_FORM'
             EXPORTING
                  element = 'UNDER_LINE'
             EXCEPTIONS
                  element = 1
                  window  = 2.
        IF sy-subrc NE 0.
          PERFORM protocol_update.
        ENDIF.
      ENDIF.
    ENDAT.

    komvd = tkomvd.
    IF print_mwskz = space.
      CLEAR komvd-mwskz.
    ENDIF.

    IF komvd-koaid = 'D'.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'TAX_LINE'
           EXCEPTIONS
                element = 1
                window  = 2.
    ELSE.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'SUM_LINE'
           EXCEPTIONS
                element = 1
                window  = 2.
    ENDIF.
  ENDLOOP.
  DESCRIBE TABLE tkomvd LINES sy-tfill.
  IF sy-tfill = 0.
    CALL FUNCTION 'WRITE_FORM'
         EXPORTING
              element = 'UNDER_LINE'
         EXCEPTIONS
              element = 1
              window  = 2.
    IF sy-subrc NE 0.
      PERFORM protocol_update.
    ENDIF.
  ENDIF.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM HEADER_TEXT_PRINT                                        *
*---------------------------------------------------------------------*
*       Printout of the headertexts                                   *
*---------------------------------------------------------------------*

FORM header_text_print.

  CALL FUNCTION 'WRITE_FORM'
       EXPORTING
            element = 'HEADER_TEXT'
       EXCEPTIONS
            element = 1
            window  = 2.
  IF sy-subrc NE 0.
    PERFORM protocol_update.
  ENDIF.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM ITEM_PRINT                                               *
*---------------------------------------------------------------------*
*       Printout of the items                                         *
*---------------------------------------------------------------------*

FORM item_print.

*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  data: l_w_item_price    like tkomvd-kbetr,
        l_w_shipped_price like tkomvd-kbetr,                "LABK916876
*        l_w_perc_markup   like tkomvd-kbetr.                "LABK916876
        l_w_perc_markup   type p decimals 3.                "LABK930933

  data: l_sum_order_qty like vbap-kwmeng,                   "LABK918260
        l_prev_del_qty  like vbdpl-lfimg.                   "LABK918260

* Start LABK931706
  Data: l_wa_eipo like eipo,
        l_wa_likp like likp.

* End LABK931706

*  CALL FUNCTION 'WRITE_FORM'           "First header
*       EXPORTING  element = 'ITEM_HEADER'
*       EXCEPTIONS OTHERS  = 1.
*  IF sy-subrc NE 0.
*    PERFORM protocol_update.
*  ENDIF.
*  CALL FUNCTION  'WRITE_FORM'          "Activate header
*       EXPORTING  element = 'ITEM_HEADER'
*                  type    = 'TOP'
*       EXCEPTIONS OTHERS  = 1.
*  IF sy-subrc NE 0.
*    PERFORM protocol_update.
*  ENDIF.
  mac_write_form_main 'ITEM_HEADER'.   "First header
  if sy-subrc ne 0.
    perform protocol_update.
  endif.

  mac_write_element_top 'ITEM_HEADER'.    "Activate header
  if sy-subrc ne 0.
    perform protocol_update.
  endif.


*  LOOP AT tvbdpl.
*    vbdpl = tvbdpl.
*    IF vbdpl-uecha IS INITIAL.
*      CALL FUNCTION 'CONTROL_FORM'
*           EXPORTING
*                command = 'PROTECT'.
*      CALL FUNCTION 'WRITE_FORM'
*           EXPORTING
*                element = 'ITEM_LINE'.
*      CALL FUNCTION 'CONTROL_FORM'
*           EXPORTING
*                command = 'ENDPROTECT'.
** Seitenumbruch, wenn Positionstexte nicht auf eine Seite passen.
*      CALL FUNCTION 'CONTROL_FORM'
*           EXPORTING
*                command = 'PROTECT'.
*      PERFORM item_text_print.
*      PERFORM dg_print_data_get.
*      PERFORM dg_data_print.
*      IF price = 'X'.
*        PERFORM get_item_prices.
*        PERFORM item_price_print.
*      ENDIF.
*      PERFORM get_serial_no.
*      PERFORM item_serial_no_print.
*      PERFORM get_item_characteristics.
*      PERFORM item_characteristics_print.
*      PERFORM get_item_characteristics_batch.
*      PERFORM item_characteristics_batch.
*      IF vbdpl-vbeln_vauf NE space AND
*         vbdpl-vbeln_vauf NE vbdkl-vbeln_vauf.
*        CALL FUNCTION 'WRITE_FORM'
*             EXPORTING
*                  element = 'ITEM_REFERENCE'
*             EXCEPTIONS
*                  element = 1
*                  window  = 2.
*        IF sy-subrc NE 0.
*          PERFORM protocol_update.
*        ENDIF.
*      ENDIF.
*      IF vbdpl-qmnum NE space AND
*         vbdpl-qmnum NE vbdkl-qmnum.
*        CALL FUNCTION 'WRITE_FORM'
*             EXPORTING
*                  element = 'ITEM_QNUMBER'
*             EXCEPTIONS
*                  element = 1
*                  window  = 2.
*        IF sy-subrc NE 0.
*          PERFORM protocol_update.
*        ENDIF.
*      ENDIF.
*      CALL FUNCTION 'WRITE_FORM'
*           EXPORTING
*                element = 'ITEM_PURCHASE_DATA'
*           EXCEPTIONS
*                element = 1
*                window  = 2.
*      IF sy-subrc NE 0.
*        PERFORM protocol_update.
*      ENDIF.
*      CALL FUNCTION 'CONTROL_FORM'
*           EXPORTING
*                command = 'ENDPROTECT'.
*    ELSE.
*      CALL FUNCTION 'WRITE_FORM'
*           EXPORTING
*                element = 'ITEM_LINE_BATCH'.
*      IF sy-subrc NE 0.
*        PERFORM protocol_update.
*      ENDIF.
*      PERFORM get_serial_no.
*      PERFORM item_serial_no_print.
*      PERFORM get_item_characteristics_batch.
*      PERFORM item_characteristics_batch.
*    ENDIF.
*  ENDLOOP.
*
*  CALL FUNCTION  'WRITE_FORM'          "Deactivate Header
*       EXPORTING  element  = 'ITEM_HEADER'
*                  function = 'DELETE'
*                  type     = 'TOP'
*       EXCEPTIONS OTHERS   = 1.
*  IF sy-subrc NE 0.
*    PERFORM protocol_update.
*  ENDIF.

  loop at tvbdpl.
    vbdpl = tvbdpl.

    clear: l_w_item_price,
           l_w_shipped_price,                               "LABK916876
           l_w_perc_markup.                                 "LABK916876

* Get order quantity
    select single * from vbap where vbeln = vbdpl-vbeln_vauf
                                and posnr = vbdpl-posnr_vauf "LABK918260
                                and matnr = vbdpl-matnr.

* Rejected item will not be billed, therefore do not         "LABK918334
* include in overall price.                                  "LABK918334
    if not vbap-abgru is initial.                            "LABK918334
      move-corresponding vbdpl to i_tvbdpl.                  "LABK918334
      collect i_tvbdpl.                                      "LABK918334
      clear i_tvbdpl.                                        "LABK918334
      continue.                                              "LABK918334
    endif.                                                   "LABK918334

* Get Item prices from sales order
    perform get_item_prices.
** If there is no tax markup, there'll only be gross price in this table
** If there is tax, there'll also be net value.
*    READ TABLE TKOMVD WITH KEY STUNR = '201'.
*    IF SY-SUBRC = 0.
*      LOOP AT TKOMVD WHERE STUNR = '400'.        "Net value for item
*        ADD TKOMVD-KBETR TO L_W_ITEM_PRICE.
*      ENDLOOP.
*    ELSE.
*      LOOP AT TKOMVD WHERE STUNR = '100'.        "Gross price
*        ADD TKOMVD-KBETR TO L_W_ITEM_PRICE.
*      ENDLOOP.
*    ENDIF.

* Pricing can be done in three ways:                        "LABK916876
*   Price      (1)   ZINC     (2)   ZDBP      (3)   PB00    "LABK916876
* + Markup         + ZOHM         + -             + Z3RD    "LABK916876
* + 12% Tax        + ZTXM         + ZTXM          + ZTXM    "LABK916876
* So get the price then and multiply by qty delivered, then "LABK916876
* add the appropriate % markup/tax.                         "LABK916876
* These can only be obtained in the TKOMV table             "LABK916876
*   loop at tkomv where kposn = vbdpl-posnr                 "LABK916876
    loop at tkomv where kposn = vbap-posnr                  "LABK916904
                  and ( kschl = 'ZINC' or                   "LABK916876
                        kschl = 'ZDBP' or                   "LABK916876
                        kschl = 'PB00' )                    "LABK916876
                  and   kwert ne 0                          "LABK916876
                  and   kinak ne 'Y'.                       "LABK916876
* Value of each item
      l_w_item_price = tkomv-kwert / vbap-kwmeng.           "LABK916876
* Price of shipped items = value of each item * qty shipped "LABK916876
      l_w_shipped_price = l_w_item_price * vbdpl-lfimg.     "LABK916876
      case tkomv-kschl.                                     "LABK916876
        when 'ZINC'.                                        "LABK916876
*         read table tkomv with key kposn = vbdpl-posnr     "LABK916876
          read table tkomv with key kposn = vbap-posnr      "LABK918260
                                    kschl = 'ZOHM'.         "LABK916876
          if sy-subrc = 0.                                  "LABK916876
            divide tkomv-kbetr by 10.                       "LABK916876
            l_w_perc_markup = tkomv-kbetr / 100.            "LABK916876
            l_w_shipped_price =   l_w_shipped_price +       "LABK916876
                                ( l_w_shipped_price *       "LABK916876
                                  l_w_perc_markup ).        "LABK916876
          endif.                                            "LABK916876
*         read table tkomv with key kposn = vbdpl-posnr     "LABK916876
          read table tkomv with key kposn = vbap-posnr      "LABK918260
                                    kschl = 'ZTXM'.         "LABK916876
          if sy-subrc = 0.                                  "LABK916876
            divide tkomv-kbetr by 10.                       "LABK916876
            l_w_perc_markup = tkomv-kbetr / 100.            "LABK916876
            l_w_shipped_price =   l_w_shipped_price +       "LABK916876
                                ( l_w_shipped_price *       "LABK916876
                                  l_w_perc_markup ).        "LABK916876
          endif.                                            "LABK916876
          exit.                                             "LABK916876
        when 'ZDBP'.                                        "LABK916876
*         read table tkomv with key kposn = vbdpl-posnr     "LABK916876
          read table tkomv with key kposn = vbap-posnr      "LABK918260
                                    kschl = 'ZTXM'.         "LABK916876
          if sy-subrc = 0.                                  "LABK916876
            divide tkomv-kbetr by 10.                       "LABK916876
            l_w_perc_markup = tkomv-kbetr / 100.            "LABK916876
            l_w_shipped_price =   l_w_shipped_price +       "LABK916876
                                ( l_w_shipped_price *       "LABK916876
                                  l_w_perc_markup ).        "LABK916876
          endif.                                            "LABK916876
          exit.                                             "LABK916876
        when 'PB00'.                                        "LABK916876
*         read table tkomv with key kposn = vbdpl-posnr     "LABK916876
          read table tkomv with key kposn = vbap-posnr      "LABK918260
                                    kschl = 'Z3RD'.         "LABK916876
          if sy-subrc = 0.                                  "LABK916876
            divide tkomv-kbetr by 10.                       "LABK916876
            l_w_perc_markup = tkomv-kbetr / 100.            "LABK916876
            l_w_shipped_price =   l_w_shipped_price +       "LABK916876
                                ( l_w_shipped_price *       "LABK916876
                                  l_w_perc_markup ).        "LABK916876
          endif.                                            "LABK916876
*         read table tkomv with key kposn = vbdpl-posnr     "LABK916876
          read table tkomv with key kposn = vbap-posnr      "LABK918260
                                    kschl = 'ZTXM'.         "LABK916876
          if sy-subrc = 0.                                  "LABK916876
            divide tkomv-kbetr by 10.                       "LABK916876
            l_w_perc_markup = tkomv-kbetr / 100.            "LABK916876
            l_w_shipped_price =   l_w_shipped_price +       "LABK916876
                                ( l_w_shipped_price *       "LABK916876
                                  l_w_perc_markup ).        "LABK916876
          endif.                                            "LABK916876
          exit.                                             "LABK916876
      endcase.                                              "LABK916876
    endloop.                                                "LABK916876

** Price of shipped items = value of each item * qty shipped
*    L_W_ITEM_PRICE = L_W_ITEM_PRICE * VBDPL-LFIMG.

* Start adding to total
    add l_w_shipped_price to zinvoice01-book_val.

* Collect total delivered qty for each material            "LABK918260
    move-corresponding vbdpl to i_tvbdpl.                  "LABK918260
    collect i_tvbdpl.                                      "LABK918260
    clear i_tvbdpl.                                        "LABK918260
  endloop.                                                 "LABK918260

** Calculate Back Order
*    ZINVOICE01-QUANTITY = VBAP-KWMENG - VBDPL-LFIMG.

* Get additional item data                                 "LABK918260
  clear vbdpl.                                             "LABK918260

  sort tvbdpl by posnr.                                    "LABK918260

  loop at i_tvbdpl.                                        "LABK918260

    clear: zinvoice01-hdisc_desc,                          "LABK918260
           zinvoice01-descline1.                           "LABK918260

    clear l_sum_order_qty.                                 "LABK918260
    clear l_prev_del_qty.                                  "LABK918260

    move-corresponding i_tvbdpl to vbdpl.                  "LABK918260

** Start of LABK931706
** If material occurs more than once, we want only the      "LABK918260
** first item number.                                       "LABK918260
*fff becky delete
*    read table tvbdpl with key matnr = vbdpl-matnr.        "LABK918260
*    vbdpl-posnr =  tvbdpl-posnr.                           "LABK918260
*    vbdpl-arktx =  tvbdpl-arktx.                           "LABK918260
*ffadd
    read table tvbdpl with key matnr = vbdpl-matnr
                               arktx = vbdpl-arktx.
    vbdpl-posnr =  tvbdpl-posnr.
*ffadd<-
*fend
** End of LABK931706

    vbdpl-werks =  tvbdpl-werks.                           "LABK918260
    vbdpl-tdname = tvbdpl-tdname.                          "LABK918260


* Calculate back order = sum of s.o. qty - (total qty      "LABK918260
* delivered on this del note + sum qty on previous         "LABK918260
* del notes.                                               "LABK918260
    select * from vbap where vbeln = vbdpl-vbeln_vauf      "LABK918260
                         and arktx = vbdpl-arktx          "fff
                         and matnr = vbdpl-matnr.           "LABK918260

      if vbap-abgru is initial.                            "LABK918334
        add vbap-kwmeng to l_sum_order_qty.                "LABK918260
      else.                                                "LABK918334
        add 0 to l_sum_order_qty.                          "LABK918334
      endif.                                               "LABK918334
      select * from vbfa where vbelv = vbap-vbeln          "LABK918260
                           and posnv = vbap-posnr          "LABK918260
                           and vbeln ne vbdpl-vbeln        "LABK918260
                           and vbtyp_n = 'J'               "LABK918260
                           and vbtyp_v = 'C'               "LABK918260
                           and erdat le vbdkl-erdat.       "LABK918260
        add vbfa-rfmng to l_prev_del_qty.                  "LABK918260
      endselect.                                           "LABK918260
    endselect.                                             "LABK918260
    zinvoice01-quantity = l_sum_order_qty -                "LABK918260
         ( vbdpl-lfimg + l_prev_del_qty ).                 "LABK918260

* Get Country of Origin
    select single * from marc where matnr = vbdpl-matnr
                                and werks = vbdpl-werks.
*    IF MARC-HERKL = ' '.
*      MARC-HERKL = 'CA'.
*    ENDIF.

**** Start of LABK931706
*    if sy-subrc = 0.
*      select single * from t005t where spras = 'E'
*                                   and land1 = marc-herkl.
*    endif.

     if sy-subrc = 0.
       clear: l_wa_eipo, l_wa_likp.
       select single * from likp into l_wa_likp
         where vbeln = vbdpl-vbeln.
       if sy-subrc = 0.
         select single * from eipo into l_wa_eipo
           where exnum = l_wa_likp-exnum
           and expos = vbdpl-posnr.
         if sy-subrc = 0 and ( not l_wa_eipo-herkl is initial ).
           select single * from t005t where spras = 'E'
                                   and land1 = l_wa_eipo-herkl.
         else.
           select single * from t005t where spras = 'E'
                                   and land1 = marc-herkl.
         endif.
       else.
         select single * from t005t where spras = 'E'
                                   and land1 = marc-herkl.
       endif.

*   Get HS Code for freight 3rd party material
       if vbap-pstyv = 'ZYAS' and vbap-matnr <> '000000000000300006'.
         if not l_wa_eipo-stawn is initial.
           marc-stawn = l_wa_eipo-stawn.
         endif.
       endif.

     endif.

**** End of LABK931706

* Get US material description
    clear makt.
    select single * from makt where matnr = vbdpl-matnr
                                and spras = 'Z'.

    select single * from vbap where                         "LABK918260
                         vbeln = vbdpl-vbeln_vauf           "LABK918260
                     and posnr = vbdpl-posnr                "LABK918260
                     and matnr = vbdpl-matnr.               "LABK918260
* Start LABK931706
** Get HS Code for freight 3rd party material
*    if vbap-pstyv = 'ZYAS' and vbap-matnr <> '000000000000300006'.
*      m_zvrmpack_get_text vbdpl-tdname '9004' 'VBBP'
*                                       zinvoice01-hdisc_desc.

* Also get country of origin for 3rd party material        "LABK917228
*      m_zvrmpack_get_text vbdpl-tdname '9005' 'VBBP'       "LABK917228
*                               zinvoice01-descline1.       "LABK917228
*    endif.
* End LABK931706

* Put in order quantity for printing purposes
    move l_sum_order_qty to vbap-kwmeng.

    mac_control_form 'PROTECT'.
    mac_write_form_main 'ITEM_LINE'.
*   PERFORM GET_SERIAL_NO.
*   PERFORM ITEM_SERIAL_NO_PRINT.
*   PERFORM GET_ITEM_CHARACTERISTICS.
*   PERFORM ITEM_CHARACTERISTICS_PRINT.
*   PERFORM GET_ITEM_CHARACTERISTICS_BATCH.
*   PERFORM ITEM_CHARACTERISTICS_BATCH.
    if sy-subrc ne 0.
      perform protocol_update.
    endif.

    mac_control_form 'ENDPROTECT'.
    if sy-subrc ne 0.
      perform protocol_update.
    endif.

  endloop.

  mac_delete_top_element 'ITEM_HEADER'.    "Deactivate Header
  if sy-subrc ne 0.
    perform protocol_update.
  endif.

  mac_write_form_main 'UNDERLINE'.
  if sy-subrc ne 0.
    perform protocol_update.
  endif.

* Footer
* Get full name of shipper
  select single * from likp where vbeln = vbdkl-vbeln.
  select single * from usr03 where bname = likp-ernam.

  mac_write_form_main 'FOOTER'.
  if sy-subrc ne 0.
    perform protocol_update.
  endif.

*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


ENDFORM.

*---------------------------------------------------------------------*
*       FORM ITEM_CHARACERISTICS_BATCH                                *
*---------------------------------------------------------------------*
*       Printout of the item characteristics for batches              *
*---------------------------------------------------------------------*

FORM item_characteristics_batch.

  LOOP AT tkombat.
    conf_out = tkombat.
    IF sy-tabix = 1.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_CONFIGURATION_BATCH_HEADER'
           EXCEPTIONS
                OTHERS  = 1.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ELSE.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_CONFIGURATION_BATCH'
           EXCEPTIONS
                OTHERS  = 1.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ENDIF.
  ENDLOOP.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM ITEM_CHARACERISTICS_PRINT                                *
*---------------------------------------------------------------------*
*       Printout of the item characteristics -> configuration         *
*---------------------------------------------------------------------*

FORM item_characteristics_print.

  LOOP AT tkomcon.
    conf_out = tkomcon.
    IF sy-tabix = 1.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_CONFIGURATION_HEADER'
           EXCEPTIONS
                OTHERS  = 1.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ELSE.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_CONFIGURATION'
           EXCEPTIONS
                OTHERS  = 1.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ENDIF.
  ENDLOOP.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM ITEM_PRICE_PRINT                                         *
*---------------------------------------------------------------------*
*       Printout of the item prices                                   *
*---------------------------------------------------------------------*

FORM item_price_print.

  LOOP AT tkomvd.
    komvd = tkomvd.
    IF print_mwskz = space.
      CLEAR komvd-mwskz.
    ENDIF.
    IF sy-tabix = 1.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_PRICE_QUANTITY'
           EXCEPTIONS
                element = 1
                window  = 2.
    ELSE.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_PRICE_TEXT'
           EXCEPTIONS
                element = 1
                window  = 2.
    ENDIF.
  ENDLOOP.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM ITEM_SERIAL_NO_PRINT                                     *
*---------------------------------------------------------------------*
*       Printout of the item serialnumbers                            *
*---------------------------------------------------------------------*

FORM item_serial_no_print.

  LOOP AT tkomser_print.
    komser = tkomser_print.
    IF sy-tabix = 1.
*     Output of the Headerline
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_SERIAL_NO_HEADER'
           EXCEPTIONS
                element = 1
                window  = 2.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ELSE.
*     Output of the following printlines
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_SERIAL_NO'
           EXCEPTIONS
                element = 1
                window  = 2.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ENDIF.
    AT LAST.
      CALL FUNCTION 'CONTROL_FORM'
           EXPORTING
                command = 'NEW-LINE'.
      IF sy-subrc NE 0.
        PERFORM protocol_update.
      ENDIF.
    ENDAT.
  ENDLOOP.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM PROTOCOL_UPDATE                                          *
*---------------------------------------------------------------------*
*       The messages are collected for the processing protocol.       *
*---------------------------------------------------------------------*

FORM protocol_update.

  CHECK xscreen = space.
  CALL FUNCTION 'NAST_PROTOCOL_UPDATE'
       EXPORTING
            msg_arbgb = syst-msgid
            msg_nr    = syst-msgno
            msg_ty    = syst-msgty
            msg_v1    = syst-msgv1
            msg_v2    = syst-msgv2
            msg_v3    = syst-msgv3
            msg_v4    = syst-msgv4
       EXCEPTIONS
            OTHERS    = 1.

ENDFORM.

*---------------------------------------------------------------------*
*       FORM SENDER                                                   *
*---------------------------------------------------------------------*
*       This routine determines the address of the sender             *
*---------------------------------------------------------------------*

FORM sender.

  SELECT SINGLE * FROM tvko  WHERE vkorg = vbdkl-vkorg.
  IF sy-subrc NE 0.
    syst-msgid = 'VN'.
    syst-msgno = '203'.
    syst-msgty = 'W'.
    syst-msgv1 = 'TVKO'.
    syst-msgv2 = syst-subrc.
    PERFORM protocol_update.
  ELSE.                                                     "LABK925734
    SELECT SINGLE * FROM SADR WHERE ADRNR = TVKO-ADRNR      "LABK925734
                              AND   NATIO = SPACE.          "LABK925734
    IF SY-SUBRC = 0.                                        "LABK925734
      VBDKL-SLAND = SADR-LAND1.                             "LABK925734
* Sales organisation header address                         "LABK925734
      MOVE-CORRESPONDING SADR TO VBADR.                     "LABK925734
      CLEAR SADR.                                           "LABK925734
    ELSE.                                                   "LABK925734
       SELECT SINGLE * FROM ADRC WHERE                      "LABK925734
              ADDRNUMBER = TVKO-ADRNR AND                   "LABK925734
              NATION     = SPACE.                           "LABK925734
       IF SY-SUBRC = 0.                                     "LABK925734
         VBDKL-SLAND = ADRC-COUNTRY.                        "LABK925734
         MOVE: ADRC-TITLE TO VBADR-ANRED,                   "LABK925734
               ADRC-NAME2 TO VBADR-NAME2,                   "LABK925734
               ADRC-NAME3 TO VBADR-NAME3,                   "LABK925734
               ADRC-NAME4 TO VBADR-NAME4,                   "LABK925734
               ADRC-STREET TO VBADR-STRAS,                  "LABK925734
               ADRC-POST_CODE1 TO VBADR-PSTLZ,              "LABK925734
               ADRC-PO_BOX     TO VBADR-PFACH,              "LABK925734
               ADRC-POST_CODE2 TO VBADR-PSTL2,              "LABK925734
               ADRC-PO_BOX_LOC TO VBADR-PFORT,              "LABK925734
               ADRC-REGION     TO VBADR-REGIO,              "LABK925734
               ADRC-CITY1      TO VBADR-ORT01,              "LABK925734
               ADRC-CITY2      TO VBADR-ORT02,              "LABK925734
               ADRC-COUNTRY    TO VBADR-LAND1.              "LABK925734
         CLEAR ADRC.                                        "LABK925734
       ELSE.                                                "LABK925734
         SYST-MSGID = 'VN'.                                 "LABK925734
         SYST-MSGNO = '203'.                                "LABK925734
         SYST-MSGTY = 'E'.                                  "LABK925734
         SYST-MSGV1 = 'ADRC'.                               "LABK925734
         SYST-MSGV2 = SYST-SUBRC.                           "LABK925734
         PERFORM PROTOCOL_UPDATE.                           "LABK925734
       ENDIF.                                               "LABK925734
    ENDIF.                                                  "LABK925734
  ENDIF.

  SELECT SINGLE * FROM tvst  WHERE vstel = vbdkl-vstel.
  IF sy-subrc NE 0.
    syst-msgid = 'VN'.
    syst-msgno = '203'.
    syst-msgty = 'W'.
    syst-msgv1 = 'TVST'.
    syst-msgv2 = syst-subrc.
    PERFORM protocol_update.
  ENDIF.
  SELECT SINGLE * FROM t001g WHERE bukrs    = vbdkl-bukrs
                             AND   programm = 'RVADDN01'
                             AND   txtid    = space.
  IF sy-subrc NE 0.
    syst-msgid = 'VN'.
    syst-msgno = '203'.
    syst-msgty = 'W'.
    syst-msgv1 = 'T001G'.
    syst-msgv2 = syst-subrc.
    PERFORM protocol_update.
  ENDIF.

ENDFORM.
*&---------------------------------------------------------------------*
*&      Form  DG_DATA_SELECT
*&---------------------------------------------------------------------*
*           Get data for dangerous goods positions
*----------------------------------------------------------------------*

FORM dg_data_select USING i_vbdkl LIKE vbdkl.
  TABLES: vbuk.
  DATA: dg_flag VALUE ' '.

************************************************************************
* Check of transportation organization status delivery
************************************************************************

* select single * from vbuk where vbeln = i_vbdkl-vbeln.
*-----------------------------------------------------------------------
* First case: Dangerous goods data only when not relevant to transport
*-----------------------------------------------------------------------
* check vbuk-trsta eq ' '.
*-----------------------------------------------------------------------
* Second case: Dangerous goods data when not relevant to transport
*              with status 'not processed'.
* Attention: In this case dangerous goods data may have changed
*            in a transport document if the selection date
*            has been changed
*-----------------------------------------------------------------------
* check vbuk-trsta eq ' '
* or   vbuk-trsta eq 'A'.
************************************************************************

  LOOP AT tvbdpl.
    IF tvbdpl-idgpa EQ 'X'.
      dg_flag = 'X'.
      EXIT.
    ENDIF.
  ENDLOOP.
*---Data select for dangerous goods
  IF dg_flag EQ 'X'.
    CALL FUNCTION 'HAZMAT_PRI_DATA_GET'
         EXPORTING
              e_vbdkl        = i_vbdkl
              i_nspras       = nast-spras
         TABLES
              e_rdgprint_tab = rdgprint_tab
              e_tvbdpl       = tvbdpl
              e_spras_txt    = l_spras_txt
         EXCEPTIONS
              get_data_error = 1
              OTHERS         = 2.

* set retcode
    IF sy-subrc = 1.
      retcode = 1.
    ELSE.
      retcode = 0.
    ENDIF.
  ENDIF.
ENDFORM.                               " DG_DATA_SELECT
*&---------------------------------------------------------------------*
*&      Form  DG_PRINT_DATA_GET
*&---------------------------------------------------------------------*
*       Prepares Data in printstructure
*----------------------------------------------------------------------*

FORM dg_print_data_get.
  DATA lin TYPE i.
  CHECK NOT tvbdpl-idgpa IS INITIAL.
  DESCRIBE TABLE rdgprint_tab LINES lin.
  CHECK lin GT 0.

*......................................................................
* GET PRINT CONDITIONS  * GET TEXT-IDS FOR DEPENDENT TEXT
*......................................................................
  CALL FUNCTION 'HAZMAT_GET_COND_TEXT_KEY'
       EXPORTING
            i_sprache      = nast-spras
            i_matnr        = tvbdpl-matnr
            i_vbdkl        = vbdkl
       TABLES
            i_rdgprint_tab = rdgprint_tab
            i_idname_text  = i_idname_text
            i_undep_text   = i_undep_txt
            i_spras_txt    = l_spras_txt
*         i_tdgc3_tab    = i_tdgc3_tab
            i_tvbdpl       = tvbdpl
       EXCEPTIONS
             OTHERS       = 1.

ENDFORM.                               " DG_DATA_GET
*&---------------------------------------------------------------------*
*&      Form  DG_DATA_PRINT
*&---------------------------------------------------------------------*
*       Print Data to layout
*----------------------------------------------------------------------*

FORM dg_data_print.
  DATA: lin TYPE i,
        first_mat LIKE tvbdpl-matnr,
        sec_mat LIKE tvbdpl-matnr.

  first_mat = 0.

  CHECK NOT tvbdpl-idgpa IS INITIAL.
  DESCRIBE TABLE rdgprint_tab LINES lin.
  CHECK lin GT 0.
  CLEAR l_spras_txt.

* print position data
  LOOP AT rdgprint_tab WHERE matnr = tvbdpl-matnr.

    MOVE-CORRESPONDING rdgprint_tab TO rdgprint.
    sec_mat = first_mat.
    first_mat = tvbdpl-matnr.
    IF first_mat NE sec_mat.
      CALL FUNCTION 'WRITE_FORM'       " Header Text
           EXPORTING
                element = 'ITEM_LINE_DG_HEADER'
           EXCEPTIONS
                OTHERS  = 1.
    ENDIF.

    CALL FUNCTION 'WRITE_FORM'
         EXPORTING
              element = 'ITEM_LINE_DG'
         EXCEPTIONS
              OTHERS  = 1.

* print dependent position text
    LOOP AT i_idname_text WHERE mot = rdgprint_tab-mot
                          AND rvlid = rdgprint_tab-rvlid
                          AND matnr = rdgprint_tab-matnr.
      READ TABLE l_spras_txt WITH KEY mot = i_idname_text-mot
                                    rvlid = i_idname_text-rvlid.
      IF rdgprint_tab-sprsls = l_spras_txt-tdspras.
        rdgtxtprt-tdspras = l_spras_txt-tdspras.
      ENDIF.
      rdgprint-txname = i_idname_text-tdname.
      rdgprint-iddep = i_idname_text-tdid.
      CLEAR rdgtxtprt-tdname.
      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_DG_TEXT'
           EXCEPTIONS
                OTHERS  = 1.
      CLEAR rdgprint-txname.
      CLEAR rdgprint-iddep.
      CLEAR rdgtxtprt-tdspras.
    ENDLOOP.

* print undependent position text
    LOOP AT i_undep_txt.               " where mot = rdgprint_tab-mot
      "    and rvlid = rdgprint_tab-rvlid.
      READ TABLE l_spras_txt WITH KEY mot = i_undep_txt-mot
                                  rvlid = i_undep_txt-rvlid.
      rdgtxtprt-tdname = i_undep_txt-tdname.
      rdgtxtprt-tdspras = i_undep_txt-tdspras.

      CLEAR:  rdgprint-txname,
              rdgprint-iddep .

      CALL FUNCTION 'WRITE_FORM'
           EXPORTING
                element = 'ITEM_LINE_DG_TEXT'
           EXCEPTIONS
                OTHERS  = 1.
    ENDLOOP.
  ENDLOOP.
ENDFORM.                               " DG_DATA_PRINT

*&---------------------------------------------------------------------*
*&      Form  DG_PRINT_UNDEP_TEXT
*&---------------------------------------------------------------------*
FORM dg_print_undep_text.
* get undepend Texts

  CALL FUNCTION 'HAZMAT_GET_DG_UNDEP_TEXT'
       EXPORTING
            i_vbdkl        = vbdkl
       TABLES
            i_rdgprint_tab = rdgprint_tab
            i_tvbdpl       = tvbdpl
            i_idname_text  = i_idname_text.

  LOOP AT  i_idname_text.
    rdgtxtprt-tdname = i_idname_text-tdname.

    CALL FUNCTION 'WRITE_FORM'
         EXPORTING
              element = 'DG_STANDARD_TEXT'
         EXCEPTIONS
              OTHERS  = 1.
  ENDLOOP.
ENDFORM.                               " DG_PRINT_UNDEP_TEXT
*&---------------------------------------------------------------------*
*&      Form  ITEM_TEXT_PRINT
*&---------------------------------------------------------------------*
FORM item_text_print.

  CALL FUNCTION 'WRITE_FORM'
       EXPORTING
            element = 'ITEM_TEXT'
       EXCEPTIONS
            element = 1
            window  = 2.
  IF sy-subrc NE 0.
    PERFORM protocol_update.
  ENDIF.

ENDFORM.                               " ITEM_TEXT_PRINT

*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
*&---------------------------------------------------------------------*
*&      Form  GET_SALES_ORDER_DATA
*&---------------------------------------------------------------------*
form get_sales_order_data.

  select single * from vbak where vbeln = vbdkl-vbeln_vauf.

endform.                    " GET_SALES_ORDER_DATA

*&---------------------------------------------------------------------*
*&      Form  GET_SHIPTO_PARTY
*&---------------------------------------------------------------------*
form get_shipto_party.

  clear vbdkl-telf1_vko.                                   "LABK928968

  select single * from vbpa where       "Sales Document Partner
           parvw = 'WE' and
           posnr = '000000' and
           vbeln = vbdkl-vbeln.

* Need KNA1 for EIN/VAT number, so get it whether shipto is altered
* or not.
  select single * from kna1 where
            kunnr = vbpa-kunnr.

  if vbpa-adrnr ne ' '.
* Shipto party information has been altered.
    select single * from sadr where
             adrnr = vbpa-adrnr and
             natio = ' '.
* Only want vbdkl address components overwritten            "LABK916904
    if sy-subrc = 0.                                        "LABK925186
*   move-corresponding sadr to vbdkl.
      move: sadr-anred to vbdkl-anred,                      "LABK916904
            sadr-name1 to vbdkl-name1,                      "LABK916904
            sadr-name2 to vbdkl-name2,                      "LABK916904
            sadr-name3 to vbdkl-name3,                      "LABK916904
            sadr-name4 to vbdkl-name4,                      "LABK916904
            sadr-stras to vbdkl-stras,                      "LABK916904
            sadr-pfach to vbdkl-pfach,                      "LABK916904
            sadr-pstl2 to vbdkl-pstl2,                      "LABK916904
            sadr-pfort to vbdkl-pfort,                      "LABK916904
            sadr-pstlz to vbdkl-pstlz,                      "LABK916904
            sadr-regio to vbdkl-regio,                      "LABK916904
            sadr-ort01 to vbdkl-ort01,                      "LABK916904
            sadr-ort02 to vbdkl-ort02,                      "LABK916904
            sadr-land1 to vbdkl-land1.                      "LABK916904

      move sadr-telfx to vbdkl-telf1_vst.
      move sadr-telf1 to vbdkl-telf1_vko.                   "LABK928968
      clear sadr.
    else.                                                   "LABK925186
      select single * from adrc where                       "LABK925186
        addrnumber  = vbpa-adrnr  and                       "LABK925186
        date_from  le sy-datum    and                       "LABK925186
        nation      = ' '.                                  "LABK925186
      if sy-subrc = 0.                                      "LABK925186
        move: adrc-name1      to vbdkl-name1,               "LABK925186
              adrc-name2      to vbdkl-name2,               "LABK925186
              adrc-name3      to vbdkl-name3,               "LABK925186
              adrc-name4      to vbdkl-name4,               "LABK925186
              adrc-street     to vbdkl-stras,               "LABK925186
              adrc-po_box     to vbdkl-pfach,               "LABK925186
              adrc-post_code2 to vbdkl-pstl2,               "LABK925186
              adrc-po_box_loc to vbdkl-pfort,               "LABK925186
              adrc-post_code1 to vbdkl-pstlz,               "LABK925186
              adrc-region     to vbdkl-regio,               "LABK925186
              adrc-city1      to vbdkl-ort01,               "LABK925186
              adrc-city2      to vbdkl-ort02,               "LABK925186
              adrc-country    to vbdkl-land1,               "LABK925186
              adrc-fax_number to vbdkl-telf1_vst,           "LABK925186
              adrc-tel_number to vbdkl-telf1_vko.           "LABK928968
        clear adrc.                                         "LABK925186
      endif.                                                "LABK925186
    endif.                                                  "LABK925186
  else.
* If Shipto party not altered.
* Only want vbdkl address components overwritten            "LABK916904
*   move-corresponding kna1 to vbdkl.
    move: kna1-anred to vbdkl-anred,                        "LABK916904
          kna1-name1 to vbdkl-name1,                        "LABK916904
          kna1-name2 to vbdkl-name2,                        "LABK916904
          kna1-name3 to vbdkl-name3,                        "LABK916904
          kna1-name4 to vbdkl-name4,                        "LABK916904
          kna1-stras to vbdkl-stras,                        "LABK916904
          kna1-pfach to vbdkl-pfach,                        "LABK916904
          kna1-pstl2 to vbdkl-pstl2,                        "LABK916904
          kna1-pfort to vbdkl-pfort,                        "LABK916904
          kna1-pstlz to vbdkl-pstlz,                        "LABK916904
          kna1-regio to vbdkl-regio,                        "LABK916904
          kna1-ort01 to vbdkl-ort01,                        "LABK916904
          kna1-ort02 to vbdkl-ort02,                        "LABK916904
          kna1-land1 to vbdkl-land1,                        "LABK916904
          kna1-land1 to vbdkl-telf1_vko.                    "LABK928968
  endif.

*<< Start Insert LABK928968 >>
  if vbdkl-telf1_vko is initial.
    move vbak-telf1 to vbdkl-telf1_vko.
  endif.
*<< End Insert LABK928968 >>

endform.                    " GET_SHIPTO_PARTY

*&---------------------------------------------------------------------*
*&      Form  GET_HEADER_TEXTS
*&---------------------------------------------------------------------*
form get_header_texts.

* Customer Field Rep
  mac_get_so_header_text vbdkl-vbeln '0031' zinvoice01-comment1.

* Waybill Number
  mac_get_so_header_text vbdkl-vbeln '3010' zinvoice01-comment2.

* Number of pieces
  mac_get_so_header_text vbdkl-vbeln '3011' zinvoice01-comment3.

* Total Weight
  mac_get_so_header_text vbdkl-vbeln '3012' zinvoice01-comment4.

* Dimensions
  mac_get_so_header_text vbdkl-vbeln '3013' zinvoice01-comment5.


endform.                    " GET_HEADER_TEXTS

*&---------------------------------------------------------------------*
*&      Form  GET_CARRIER
*&---------------------------------------------------------------------*
form get_carrier.

  select single * from vbpa where vbeln = vbdkl-vbeln
                              and posnr = '000000'
                              and parvw = 'SP'.
  check sy-subrc = 0.
  select single * from lfa1 where lifnr = vbpa-lifnr.

endform.                    " GET_CARRIER

**&---------------------------------------------------------------------
*
**&      Form  GET_ITEM_PRICES
**&---------------------------------------------------------------------
*
*form get_item_prices.
*
*  clear: komp,
*         tkomv.
*
*  if komk-knumv ne vbak-knumv.
*    clear komk.
*    komk-mandt = sy-mandt.
*    komk-kalsm = vbak-kalsm.
*    komk-kappl = pr_kappl.
*    komk-waerk = vbak-waerk.
*    komk-knumv = vbak-knumv.
*    komk-vbtyp = vbak-vbtyp.
*  endif.
*  komp-kposn = vbap-posnr.
*
*  call function 'RV_PRICE_PRINT_ITEM'
*       exporting
*            comm_head_i = komk
*            comm_item_i = komp
*            language    = nast-spras
*       importing
*            comm_head_e = komk
*            comm_item_e = komp
*       tables
*            tkomv       = tkomv
*            tkomvd      = tkomvd.
*
*
*endform.                    " GET_ITEM_PRICES
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<












Make your own free website on Tripod.com