*@----------------------------------------------------------------------
*@ Program id : ZVADEK01
*@ Program Desc : R & M (Co 9010) Picking List
*@ Copy and modification of SAP picking list program
*@ RVADEK01
*@ Transaction Code -
*@ Input files : ID - none
*@ Output files : ID - none
*@
*@ Tables Updated: Table -
*@
*@
*@ Author : CFieulle
*@ Date : 19990728
*@ Requested by: Buddy Corbett
*@----------------------------------------------------------------------
*@ Algorithm:
*@
*@----------------------------------------------------------------------
** Change History:
** Correction Mod by Date Description
** LABK916992 CFieulle 1999-10-19 Ensure that item description is from
** sales order item descr.
** 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.
** LABK918670 CFieulle 2000-03-09 Re user default printer message:
** specify message type 'ZZ', so that
** message VN001 doesn't come up
** when there is a printer error.
** LABK925188 CFieulle 2000-04-06 46B Upgrade.
** 1. For sold-to address, use central
** address mgmt table ADRC instead
** of SADR for new picking lists.
** 2. Subroutine 'item_print', var
** 'e_mbdat': give value 8 spaces to
** correspond to the ref field size.
** (The original 1 space was causing a
** syntax warning.)
** LABK925720 CFieulle 2000-06-02 46B Upgrade
** Put back call to subroutines
** 'get_sold_to' and 'get_shipping_
** info' which were overwritten by
** other upgrade applications.
** LABK928655 CFieulle 2000-10-31 User-requested additions:
** Header: Purch Order No, person
** ordering. Item: HS Code.
** LABK929006 CFieulle 2000-12-07 Get shipto party and address
** in order to get telephone no.
**
** LABK931706 Becky Wang 2002-02-01
** Use the Country of Origin from the Delivery Notes. If
** could not find the value, then use the value set in the
** material Master
*----------------------------------------------------------------------*
* Print of pickinglist for one single delivery note *
*----------------------------------------------------------------------*
REPORT rvadek01 LINE-COUNT 100 MESSAGE-ID vn.
TABLES: vbco3, "Communicationarea for view
vblkk, "Headerview
vblkp, "Itemview
ltak, "Transportauftrag
adrs, "Communicationarea for Address
riserls, "Serialnumbers
komser, "Communicationarea Serialnumbers
tvst, tvstt, "Shipping point
vbkok, vbpok.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
TABLES: usr01, "User master
tsp03, "Spool: Printer
t005t, "Country Names
makt, "Material Descriptions
marc, "Material Master: C Segment
likp, "SD Document: Delivery Header Dat
thead, "SAPscript: Text Header
thead10, "SAPscript: Text Header
sadr, "Address Management
kna1, "Customer Master
zinvoice01, "Bridge between ABAP and Layout
lfa1, "Vendor Master
vbap, "S.O.Item Data "LABK916992
vbak. "S.O. Header "LABK928655
TABLES: adrc. "Centr Addr Mgmgt "LABK925188
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* Includes
INCLUDE rvadtabl.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
INCLUDE zsmaster. "Master Macro Module
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DATA: retcode LIKE sy-subrc, "Returncode
xvbeln LIKE likp-vbeln,
xkomau LIKE likp-vbeln,
xscreen(1) TYPE c. "Output on printer or screen
DATA: BEGIN OF tvblkp OCCURS 0. "Internal table for items
INCLUDE STRUCTURE vblkp.
DATA: END OF tvblkp.
DATA: BEGIN OF tsernr OCCURS 0. "Internal table for serialnumbers
INCLUDE STRUCTURE riserls.
DATA: END OF tsernr.
DATA: BEGIN OF tsernr_print OCCURS 0.
INCLUDE STRUCTURE komser.
DATA: END OF tsernr_print.
DATA: BEGIN OF tltap OCCURS 50. "TA-Positionen
INCLUDE STRUCTURE ltap.
INCLUDE STRUCTURE ltap1.
DATA: END OF tltap.
DATA: BEGIN OF svblkp.
INCLUDE STRUCTURE vblkp.
DATA: END OF svblkp.
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
INCLUDE vblpdata.
INCLUDE vbfadata.
INCLUDE vbukdata.
INCLUDE vbupdata.
INCLUDE vbbddata.
INCLUDE vbpadata.
INCLUDE sadrdata.
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*>LABK917228>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
** 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_zvrmpick_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.
** >> Start Insert LABK928655
* Get Delivery Note details (Purch order, sales order no. etc.)
define m_get_delivery_details.
tables: vbdkl, "Headerview
vbdpl. "Itemview
data: begin of tvbdpl occurs 0. "Internal table for items
include structure vbdpl.
data: end of tvbdpl.
clear vbco3.
vbco3-spras = nast-spras.
vbco3-vbeln = nast-objky.
call function 'RV_DELIVERY_PRINT_VIEW'
exporting
comwa = vbco3
importing
kopf = vbdkl
tables
pos = tvbdpl.
clear vbco3.
end-of-definition.
** >> End Insert LABK928655
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*---------------------------------------------------------------------*
* FORM ENTRY *
*---------------------------------------------------------------------*
* Steuerung des Drucks *
*---------------------------------------------------------------------*
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.
* Kommimengen an Lieferungen zurückgeben, aber nicht bei Druckansicht
IF xscreen = ' '.
PERFORM delivery_update.
ENDIF.
return_code = 0.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM PROCESSING *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> PROC_SCREEN *
*---------------------------------------------------------------------*
FORM processing USING proc_screen.
REFRESH: xlips,
xvbfa,
xvbuk,
xvbup,
yvbfa,
yvbuk,
yvbup.
PERFORM get_data.
CHECK retcode = 0.
PERFORM form_open USING proc_screen tvst-aland.
CHECK retcode = 0.
PERFORM formheader_print.
CHECK retcode = 0.
PERFORM get_sold_to. "LABK925720
CHECK retcode = 0. "LABK925720
PERFORM get_additional_header_info. "LABK928655
CHECK retcode = 0. "LABK928655
PERFORM get_shipping_info. "LABK925720
CHECK retcode = 0. "LABK925720
PERFORM item_print.
CHECK retcode = 0.
perform get_ship_to. "LABK929006
check retcode = 0. "LABK929006
PERFORM form_close.
CHECK retcode = 0.
ENDFORM.
***********************************************************************
* S U B R O U T I N E S *
***********************************************************************
*---------------------------------------------------------------------*
* FORM DELIVERY_UPDATE *
*---------------------------------------------------------------------*
* Ergänzen Lieferung um Kommissionierinformation *
*---------------------------------------------------------------------*
* Ergänzen der Lieferungen um Kommissionierinformation
FORM delivery_update.
DATA: BEGIN OF hvbpok OCCURS 10. "Lieferpositionen Kommiss.
INCLUDE STRUCTURE vbpok.
DATA: END OF hvbpok.
DATA: BEGIN OF sav_nast.
INCLUDE STRUCTURE nast.
DATA: END OF sav_nast.
* DATA: SYNC_FLAG TYPE C. "synchrone Verbuchung?
* Füllen Lieferkopfdaten für Kommi-Update
vbkok-vbeln_vl = xvbeln.
vbkok-vbeln = vblkk-komau.
* Füllen Positionsdaten zu Liefernr.
LOOP AT tvblkp.
hvbpok-vbeln_vl = tvblkp-vbeln.
hvbpok-posnr_vl = tvblkp-posnr.
hvbpok-posnn = tvblkp-posnr.
hvbpok-vbeln = vblkk-komau.
hvbpok-vbtyp_n = 'Q'.
hvbpok-pikmg = tvblkp-komng.
hvbpok-meins = tvblkp-meins.
hvbpok-ndifm = 0.
hvbpok-taqui = ' '.
hvbpok-charg = tvblkp-charg.
hvbpok-matnr = tvblkp-matnr.
hvbpok-brgew = tvblkp-brgew.
hvbpok-gewei = tvblkp-gewei.
hvbpok-volum = tvblkp-volum.
hvbpok-voleh = tvblkp-voleh.
hvbpok-orpos = 0.
APPEND hvbpok.
ENDLOOP.
* IF NAST-VSZTP <> 4.
* SYNC_FLAG = 'X'.
* ELSE.
* SYNC_FLAG = ' '.
* ENDIF.
sav_nast = nast.
CALL FUNCTION 'SD_DELIVERY_UPDATE_PICKING'
EXPORTING
no_messages_update = 'X' "P30K094097
nicht_sperren = 'X'
vbkok_wa = vbkok
TABLES
vbpok_tab = hvbpok.
nast = sav_nast.
* Freigabe an Datenbank
* COMMIT WORK.
ENDFORM.
*---------------------------------------------------------------------*
* FORM FORM_CLOSE *
*---------------------------------------------------------------------*
* End of printing the form *
*---------------------------------------------------------------------*
FORM form_close.
CALL FUNCTION 'CLOSE_FORM' "...Ende Formulardruck
EXCEPTIONS OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
retcode = 1.
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.'.
message e001(zz) with "LABK918670
'Unable to find user default printer.'. "LABK918670
endif.
endif.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
INCLUDE rvadopfo.
ENDFORM.
*---------------------------------------------------------------------*
* FORM FORMHEADER_PRINT *
*---------------------------------------------------------------------*
* Printing Formheader *
*---------------------------------------------------------------------*
FORM formheader_print.
PERFORM sender.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_DATA *
*---------------------------------------------------------------------*
* General provision of data for the form *
*---------------------------------------------------------------------*
FORM get_data.
DATA: vblkp_lines TYPE p.
* Beschaffen View
xvbeln = nast-objky.
CALL FUNCTION 'RV_DELIVERY_PICK_VIEW'
EXPORTING
vbeln = xvbeln
zweck = 'D'
spras = nast-spras
IMPORTING
vblkk_wa = vblkk
TABLES
vblkp_tab = tvblkp
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
* gibt es zu kommissionierende Positionen, ggf. sortieren
DESCRIBE TABLE tvblkp LINES vblkp_lines.
IF vblkp_lines GT 0.
* Nummernvergabe Kommissionierauftrag
CLEAR vblkk-komau.
CALL FUNCTION 'NUMBER_GET_NEXT'
EXPORTING
nr_range_nr = '01'
object = 'SD_PICKING'
IMPORTING
number = vblkk-komau
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
ENDIF.
IF vblkk-komau IS INITIAL.
vblkk-komau = sy-datum+2.
vblkk-komau+6(4) = sy-uzeit(4).
ENDIF.
PERFORM sort_pick_list.
retcode = 0.
ELSE.
retcode = 4.
syst-msgid = 'VN'.
syst-msgno = '202'.
syst-msgty = 'E'.
syst-msgv1 = vblkk-vbeln.
PERFORM protocol_update.
CHECK 1 = 2.
ENDIF.
* Lesen Versandstelle
IF vblkk-vstel EQ space.
CLEAR: tvst, tvstt.
ELSE.
SELECT SINGLE * FROM tvst WHERE vstel EQ vblkk-vstel.
IF sy-subrc NE 0.
CLEAR tvst.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'TVST'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
SELECT SINGLE * FROM tvstt WHERE spras EQ nast-spras
AND vstel EQ vblkk-vstel.
IF sy-subrc NE 0.
CLEAR tvstt.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'TVSTT'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM GET_SERIAL_NO *
*---------------------------------------------------------------------*
* In this routine the serialnumbers are fetched from the *
* database. *
*---------------------------------------------------------------------*
FORM get_serial_no.
REFRESH tsernr.
REFRESH tsernr_print.
CHECK vblkp-anzsn > 0.
* Read the Serialnumbers of a Position.
CALL FUNCTION 'SERIAL_LS_PRINT'
EXPORTING
vbeln = vblkp-vbeln
posnr = vblkp-posnr
TABLES
iserls = tsernr.
* 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 = tsernr
serials_print = tsernr_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 ITEM_PRINT *
*---------------------------------------------------------------------*
* Printout of the items *
*---------------------------------------------------------------------*
FORM item_print.
DATA: e_werks LIKE tvblkp-werks VALUE ' ',
e_lgort LIKE tvblkp-lgort VALUE ' ',
e_lgnum LIKE tvblkp-lgnum VALUE ' ',
*>LABK925188>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* e_mbdat LIKE tvblkp-mbdat VALUE ' '.
e_mbdat like tvblkp-mbdat value ' '.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* Start LABK931706
Data: l_wa_eipo like eipo,
l_wa_likp like likp.
* End LABK931706
CALL FUNCTION 'WRITE_FORM' "Activate header
EXPORTING element = 'ITEM_HEADER'
type = 'TOP'
EXCEPTIONS OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
LOOP AT tvblkp.
vblkp = tvblkp.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* Users don't want new page when there's a different storage location
* number or plant number etc., because everything is stored in the
* same location even thought with a different number
** neue Seite bei Wechsel Werk/Lagerort/Kommidatum/WM-Lager
* IF e_werks NE tvblkp-werks OR
* e_lgort NE tvblkp-lgort OR
* e_lgnum NE tvblkp-lgnum OR
* e_mbdat NE tvblkp-mbdat.
* IF sy-tabix > 1.
* MOVE svblkp TO vblkp.
* CALL FUNCTION 'CONTROL_FORM'
* EXPORTING
* command = 'NEW-PAGE'.
* MOVE tvblkp TO vblkp.
* ENDIF.
* e_werks = tvblkp-werks.
* e_lgort = tvblkp-lgort.
* e_lgnum = tvblkp-lgnum.
* e_mbdat = tvblkp-mbdat.
* ENDIF.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* Druck WM-Angaben falls vorhanden
IF tvblkp-lgpla NE space.
tvblkp-lgpbe = tvblkp-lgpla.
vblkp-lgpbe = tvblkp-lgpla.
ENDIF.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* Get Country of Origin
select single * from marc where matnr = vblkp-matnr
and werks = vblkp-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 = tvblkp-vbeln.
if sy-subrc = 0.
select single * from eipo into l_wa_eipo
where exnum = l_wa_likp-exnum
and expos = tvblkp-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.
endif.
**** End of LABK931706
* Get Country of Origin for 3rd party material "LABK917228
clear: vbap, vblkp-tdname, zinvoice01-descline1. "LABK917228
select single * from vbap where vbeln = vblkp-vgbel "LABK917228
and posnr = vblkp-vgpos. "LABK917228
if vbap-pstyv = 'ZYAS' and "LABK917228
vbap-matnr <> '000000000000300006'. "LABK917228
concatenate vblkp-vbeln vblkp-posnr "LABK917228
into vblkp-tdname. "LABK917228
m_zvrmpick_get_text vblkp-tdname '9005' 'VBBP' "LABK917228
zinvoice01-descline1. "LABK917228
* Get HS Code for freight 3rd party material "LABK928655
m_zvrmpick_get_text vblkp-tdname '9004' 'VBBP' "LABK928655
zinvoice01-hdisc_desc. "LABK928655
endif. "LABK917228
* Get US material description
clear makt.
select single * from makt where matnr = vblkp-matnr
and spras = 'Z'.
* Get 'Special Instructions' text from material master
clear thead-tdname.
select single * from likp where vbeln = vblkk-vbeln.
select single * from lips where vbeln = vblkp-vbeln
and posnr = vblkp-posnr.
concatenate vblkp-matnr likp-vkorg lips-vtweg
into thead-tdname.
* Get S.O. item text "LABK916992
clear: vbap, vblkp-arktx. "LABK916992
select single * from vbap where vbeln = vblkp-vgbel "LABK916992
and posnr = vblkp-vgpos. "LABK916992
if sy-subrc = 0. "LABK916992
move vbap-arktx to vblkp-arktx. "LABK916992
endif. "LABK916992
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* Druck der einzelnen Zeile
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE'.
IF NOT tvblkp-charg IS INITIAL.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'CHARGE'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
PERFORM get_serial_no.
PERFORM item_serial_no_print.
svblkp = tvblkp.
ENDLOOP.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* CALL FUNCTION 'WRITE_FORM' "Deactivate Header
* EXPORTING element = 'ITEM_HEADER'
* function = 'DELETE'
* type = 'TOP'
* EXCEPTIONS OTHERS = 1.
mac_delete_top_element 'ITEM_HEADER'. "Deactivate Header
if sy-subrc ne 0.
perform protocol_update.
endif.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM.
*---------------------------------------------------------------------*
* FORM ITEM_SERIAL_NO_PRINT *
*---------------------------------------------------------------------*
* Printout of the item serialnumbers *
*---------------------------------------------------------------------*
FORM item_serial_no_print.
LOOP AT tsernr_print.
komser = tsernr_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.
mac_write_form_main 'ITEM_LINE_SERIAL_NO_HEADER'.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
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.
mac_write_form_main 'ITEM_LINE_SERIAL_NO'.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
AT LAST.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* CALL FUNCTION 'CONTROL_FORM'
* EXPORTING
* command = 'NEW-LINE'.
mac_control_form '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 VBUR)*
*---------------------------------------------------------------------*
FORM sender.
ENDFORM.
INCLUDE mv50bfz1.
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
*&---------------------------------------------------------------------*
*& Form GET_SOLD_TO
*&---------------------------------------------------------------------*
form get_sold_to.
select single * from vbpa where "Sales Document Partner
parvw = 'AG' and
posnr = '000000' and
vbeln = vblkk-vbeln.
if vbpa-adrnr ne ' '.
* Sold to party information has been altered.
select single * from adrc where "LABK925188
addrnumber = vbpa-adrnr and "LABK925188
date_from le sy-datum and "LABK925188
nation = ' '. "LABK925188
if sy-subrc = 0. "LABK925188
move: adrc-name1 to vbadr-name1, "LABK925188
adrc-name2 to vbadr-name2, "LABK925188
adrc-name3 to vbadr-name3, "LABK925188
adrc-name4 to vbadr-name4, "LABK925188
adrc-street to vbadr-stras, "LABK925188
adrc-po_box to vbadr-pfach, "LABK925188
adrc-post_code2 to vbadr-pstl2, "LABK925188
adrc-po_box_loc to vbadr-pfort, "LABK925188
adrc-city1 to vbadr-ort01, "LABK925188
adrc-city2 to vbadr-ort02, "LABK925188
adrc-post_code1 to vbadr-pstlz, "LABK925188
adrc-country to vbadr-land1, "LABK925188
adrc-region to vbadr-regio. "LABK925188
clear adrc. "LABK925188
else. "LABK925188
select single * from sadr where
adrnr = vbpa-adrnr and
natio = ' '.
if sy-subrc = 0.
move-corresponding sadr to vbadr.
endif.
endif. "LABK925188
else.
* If Sold to party not altered.
select single * from kna1 where kunnr = vbpa-kunnr.
move-corresponding kna1 to vbadr.
endif.
endform. " GET_SOLD_TO
*&---------------------------------------------------------------------*
*& Form GET_SHIPPING_INFO
*&---------------------------------------------------------------------*
form get_shipping_info.
* Shipping instructions
move vblkk-vbeln to thead10-tdname.
* Carrier
select single * from vbpa where vbeln = vblkk-vbeln
and posnr = '000000'
and parvw = 'SP'.
check sy-subrc = 0.
select single * from lfa1 where lifnr = vbpa-lifnr.
endform. " GET_SHIPPING_INFO
* >> Start Insert LABK928655 >>
*&---------------------------------------------------------------------*
*& Form GET_ADDITIONAL_HEADER_INFO
*&---------------------------------------------------------------------*
FORM GET_ADDITIONAL_HEADER_INFO.
* Get delivery details (includes Order no. VBDKL-VBELN_VAUF )
m_get_delivery_details.
* Get Order details
select single * from vbak where vbeln = vbdkl-vbeln_vauf.
ENDFORM. " GET_ADDITIONAL_HEADER_INFO
* >> End Insert LABK928655 >>
*<< Start Insert LABK929006 >>
*&---------------------------------------------------------------------*
*& Form GET_SHIP_TO
*&---------------------------------------------------------------------*
FORM GET_SHIP_TO.
* Ship to address
select single * from vbpa where vbeln = vblkk-vbeln
and posnr = '000000'
and ( parvw = 'SH' or parvw = 'WE' ).
check sy-subrc = 0.
if vbpa-adrnr ne ' '.
select single * from adrc where
addrnumber = vbpa-adrnr and
nation = ' '.
if sy-subrc ne 0.
select single * from sadr where
adrnr = vbpa-adrnr and
natio = ' '.
endif.
endif.
clear zinvoice01-descline2.
if adrc-tel_number ne ' '.
move adrc-tel_number to zinvoice01-descline2.
elseif sadr-telf1 ne ' '.
move sadr-telf1 to zinvoice01-descline2.
else.
if vbak-telf1 ne ' '.
move vbak-telf1 to zinvoice01-descline2.
else.
select single * from kna1 where
kunnr = vbpa-kunnr.
if sy-subrc = 0.
move kna1-telf1 to zinvoice01-descline2.
endif.
endif.
endif.
ENDFORM. " GET_SHIP_TO
*<< End Insert LABK929006 >>
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<