on 01-10-2007 6:06 PM
Hi All,
Can any body sends me the print program for smart forms to my mail address praveenkkm@gmail.com please.
I am using SCM Contract form.
Thanks,
Praveen
Hi,
Here is a print program presntly i am working
*----------------------------------------------------------------------*
* Print of an invoice by SAPscript *
*----------------------------------------------------------------------*
REPORT zvpinvs1 LINE-COUNT 100 MESSAGE-ID vn.
TABLES: komk, "Communicationarea for conditions
komp, "Communicationarea for conditions
komvd, "Communicationarea for conditions
vbco3, "Communicationarea for view
vbdkr, "Headerview
vbdpr, "Itemview
vbdre, "ESRview
conf_out, "Configuration data
sadr, "Addresses
tvko, "Sales organisation
adrs, "Communicationarea for Address
t005,
t001,
t001g, "Company adress
** Begin of Added to Invoice by Andersen Consulting*********************
vbak, "Sales Document: Header Data - For Ordered By & Tel. No.
vbpa, "Sales Document: Partner
vbrp, "Billing: Item Data
kna1, "General Data in Customer Master
likp, "SD Delivery Header Data
tvrot, "Route texts
knvk, "Customer Master Contact Partner
vbfa, "Sales Document Flow
vbap, "Sales Document: Item Data
zheadfi, "FI Communication Table
komser, "Serial Numbers for Print
tf111,
t685a, "Conditions: Types: Additional Pr
riserls,
* Begin of changes. D11K903205
ekko, "Purchasing Document Header
* End of changes. D11K903205
* Begin of Add. Valerie Toh. 15/12/1998
zvfreight,
vbrk,
* End of Add. Valerie Toh. 15/12/1998
* Begin of Add. Valerie Toh. 16/12/1998
stxh,
* End of Add. Valerie Toh. 16/12/1998
* Begin of Add. Valerie Toh. 21/12/1998
ekpo,
zmstore,
* End of Add. Valerie Toh. 21/12/1998
*{ INSERT D91K998930 3
TVST, "Organizational Unit: Shipping Points
*} INSERT
lips, "z001fh
zicp1. "D11K961658
****End of Andersen Consulting added to Invoice*************************
**Added for Ticket 3886 to pull the country of origin from the material
**master to be printed on the proforma for Canada
TABLES: marc. "Material Master: C Segment
**Added for Ticket 5822 to pull in the proforma header text from the
**order instead of the invoice.
TABLES: zsitem, "Communication table for document
zshead.
INCLUDE rvadtabl.
* Begin of changes. D11K903205
* Constants.
CONSTANTS: internal LIKE likp-lfart VALUE 'NLCC', "Billing doc type
sp_inst LIKE thead-tdid VALUE 'F01', "Special inst
c_ekko LIKE thead-tdobject VALUE 'EKKO', "Purch object
usd LIKE kna1-uwaer VALUE 'USD', "USD symbol
yen LIKE kna1-uwaer VALUE 'JPY', "YEN symbol
pounds LIKE kna1-uwaer VALUE 'GBP', "British pound
iso_code LIKE tcp00-cpcodepage VALUE '1100'."Code page
*** Added by Ramesh
DATA: gs_bukrs_adrc LIKE addr1_val,
v_bukrs_adrnr TYPE adrnr.
DATA: TOTAL TYPE NETWR_FP, " LIKE ZHEADFI-ZMENGE6,
TOTAL1(17),
HEIGHT(3),
LEN TYPE P DECIMALS 1 VALUE '0.6',
HIGH TYPE P DECIMALS 1.
DATA: FLAG.
DATA: UNIT_PRICE TYPE NETWR_FP.
data: dat type i.
data: da(5).
*** End of Ramesh
* Data Declarations.
DATA: po_number LIKE thead-tdname, "Text ID/name
a_charno LIKE tcp02-cpcharno, "Character no
a_codeid LIKE tcp00-cpcodepage, "Code page
a_out4 TYPE c, "ID output
a_coladjust TYPE i, "Adjustment
a_note TYPE i, "Note
trick_i TYPE i, "Temp hold
l_outused TYPE i, "Temp hold field
l_rc(5), "Temp hold field
l_errmsg(50). "Error message
* End of changes. D11K903205
* Begin of insert - ALAGARJ1 - 04/21/2005 - D81K911876
DATA: v_sg31_commcode(20) TYPE c,
v_werks LIKE marc-werks,
v_stawn LIKE marc-stawn,
v_sg31_commcode_desc LIKE t604t-text1.
CONSTANTS:
c_sg LIKE t604t-land1 VALUE 'SG', "country of origin
c_dec TYPE c VALUE '.',
c_sg31(4) TYPE c VALUE 'SG31'.
* End of insert - ALAGARJ1 - 04/21/2005 - D81K911876
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DATA: retcode LIKE sy-subrc. "Returncode
DATA: repeat(1) TYPE c.
DATA: xscreen(1) TYPE c. "Output on printer or screen
DATA: xvbeln LIKE vbrk-vbeln.
DATA: xposnr LIKE vbrl-posnr.
DATA: BEGIN OF tvbdpr OCCURS 100. "Internal table for items
INCLUDE STRUCTURE vbdpr.
DATA: END OF tvbdpr.
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 *tkomvd OCCURS 50.
INCLUDE STRUCTURE komvd.
DATA: END OF *tkomvd.
DATA: BEGIN OF hkomv OCCURS 50.
INCLUDE STRUCTURE komv.
DATA: END OF hkomv.
DATA: BEGIN OF hkomvd OCCURS 50.
INCLUDE STRUCTURE komvd.
DATA: END OF hkomvd.
DATA: BEGIN OF tkomcon OCCURS 50.
INCLUDE STRUCTURE conf_out.
DATA: END OF tkomcon.
****Begin of Andersen Consulting added to Invoice***********************
DATA: hposnn LIKE vbfa-posnn. "Holding variable for delivery
* "line item number
DATA: BEGIN OF tkomser OCCURS 5. "Internal table for serial number
INCLUDE STRUCTURE riserls. "A15K901434
DATA: END OF tkomser. "A15K901434
DATA: BEGIN OF tkomser_print OCCURS 5. "Internal table for formatted
INCLUDE STRUCTURE komser. "serial number
DATA: END OF tkomser_print. "A15K901434
**Added for new condition types by Andersen Consulting** D10K903006
DATA: zdiscamount LIKE zheadfi-zpayacc."To hold the actual amount disc.
DATA: zholddiscper LIKE komv-kbetr. "To hold current disc %.
**Change for ticket 2255 to allow unit price to have 3 decimals.
DATA: zzunitprice(15) TYPE p DECIMALS 3, "To hold unit price
zzquantity(9) TYPE n, "To hold shipped quantity
zzholdnetp(15) TYPE p DECIMALS 2, "To hold the netp price
zspectre TYPE c, "To hold if spectre or not.
**Added for intercompany**
zintercompany TYPE c, "To hold if intercompany
zspecamount LIKE zheadfi-zpayacc,"To hold spectre amount.
zzfinalprice(15) TYPE p DECIMALS 2, "To hold ext. price
zcount TYPE i VALUE '0'. "To hold number of line items
****End of Andersen Consulting added to Invoice*************************
* Begin of changes. D11K903205
* Temporary table to hold KNA1 data for intercompany ship-to info.
DATA: BEGIN OF interco_kna1 OCCURS 1.
INCLUDE STRUCTURE kna1.
DATA: END OF interco_kna1.
* Temporary table that holds special instructions texts.
DATA: BEGIN OF tlines OCCURS 1.
INCLUDE STRUCTURE tline.
DATA: END OF tlines.
* Begin of Add. Valerie Toh. 16/12/1998
DATA: BEGIN OF hline OCCURS 100.
INCLUDE STRUCTURE tline.
DATA: END OF hline.
* End of Add. Valerie Toh. 16/12/1998
* Temporary table that holds currency field symbol info.
DATA: BEGIN OF trick_f,
trick_x1 TYPE x,
trick_x2 TYPE x.
DATA: END OF trick_f.
* End of changes. D11K903205
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DATA: pr_kappl(01) TYPE c VALUE 'V'. "Application for pricing
DATA: print_mwskz. "Mehrwertsteuer-Kz drucken
* Begin of changes by Rajasekhar - D81K912848
DATA: g_vbeln_vauf TYPE vbeln_vauf.
* End of changes by Rajasekhar - D81K912848
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* license of tax exemption for italy
TABLES: konh, tlic.
* begin changes for upgrade from 30f to 31h dloucks "Z1XDSL
*****************************************************************"Z1XDSL
* Definition of variables for calling customer subroutines dynami"Z1XDSL
*****************************************************************"Z1XDSL
"Z1XDSL
DATA : header_userexit LIKE tnapr-ronam, "Z1XDSL
item_userexit LIKE tnapr-ronam, "Z1XDSL
header_print_userexit LIKE tnapr-ronam, "Z1XDSL
item_print_userexit LIKE tnapr-ronam, "Z1XDSL
get_data_userexit LIKE tnapr-ronam. "Z1XDSL
"Z1XDSL
*****************************************************************"Z1XDSL
* Specific data of ENTRY_CH "Z1XDSL
*****************************************************************"Z1XDSL
"Z1XDSL
DATA print_local_curr_ch. "Z1XDSL
DATA: komvdk_ch LIKE komvd OCCURS 10 WITH HEADER LINE. "Z1XDSL
DATA: komvdp_ch LIKE komvd OCCURS 10 WITH HEADER LINE. "Z1XDSL
"Z1XDSL
* end changes for upgrade from 30f to 31h dloucks "Z1XDSL
* Convert value of unit price and total price to TWD. "D11K976032
DATA : temp_zmenge6 LIKE bapicurr-bapicurr.
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-011504
DATA: temp LIKE addr1_sel,
adrc LIKE addr1_val,
vbdkr_waerk LIKE vbdkr-waerk.
*4.7 Upgrade End of Change TIWARIV1-D91K995965-011504
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* Begin of Add. Valerie Toh. 05111998
DATA: ex_rate LIKE vbrp-kursk,
fgst_amt LIKE konv-kwert,
gst_amt LIKE vbrp-netwr.
DATA: tex_rate(15),tgst_amt(15).
DATA: ex_rtdt LIKE vbrk-fkdat,
curr_cd LIKE konv-waers,
item_no LIKE vbdpr-posnr,
ztotal TYPE p DECIMALS 2,
mwst_flag(1) TYPE c,
zstp_flag(1) TYPE c, "Z1MV
* End of Add. Valerie Toh. 05111998
* Begin of Add. Valerie Toh. 15121998
w_inco1 LIKE knvv-inco1,
w_inco2 LIKE knvv-inco2,
* End of Add. Valerie Toh. 15121998
*Begin of Add. Valerie. 16121998
w_tax_flag(1) TYPE c,
w_tdline LIKE tline-tdline,
w_tdname LIKE stxh-tdname,
* End of Add. Valerie Toh. 16121998
* Begin of Add. Valerie Toh. 21/12/1998
zhead_ship_std(70) TYPE c.
* End of Add. Valerie Toh. 21/12/1998
DATA:w_herkl LIKE marc-herkl, "z001fh
w_werks LIKE lips-werks. "z001fh
DATA: w_kunde LIKE vbpa-kunnr, "D11k961350
w_print_curr_sign(1). "D11k961350
*{ INSERT D91K998912 1
*
TYPES: SLLR3_OBJECT_SELECT_S LIKE /SAPSLL/API6800_OBJ_SEL_R3_S.
data: w_select type SLLR3_OBJECT_SELECT_S.
w_select-sel_legcon = 'X'.
w_select-sel_lclic = 'X'.
w_select-sel_lgreg = 'X'.
w_select-sel_licty = 'X'.
w_select-sel_congr = 'X'.
w_select-sel_ctsnum = 'X'.
*-------
TYPES: BEGIN OF SLLR3_DOC_NO_S,
OBJTP LIKE /SAPSLL/API6800_OBJ_DOC_R3_S-OBJTP,
VBELN LIKE VBAK-VBELN,
POSNR LIKE VBAP-POSNR,
AUART LIKE VBAK-AUART,
VBTYP LIKE VBAK-VBTYP,
EBELN LIKE EKKO-EBELN,
EBELP LIKE EKPO-EBELP,
BSART LIKE EKKO-BSART,
BSTYP LIKE EKKO-BSTYP,
END OF SLLR3_DOC_NO_S,
SLLR3_DOC_NO_T TYPE SLLR3_DOC_NO_S OCCURS 0.
Data: LT_OBJ_DOC TYPE sllr3_doc_no_t.
*
*------- Ergebnisse: Belege: CTSNUM
TYPES: SLLR3_DOC_CTSNUM_S LIKE /SAPSLL/API6800_OBJ_CTSNUMR3_S,
SLLR3_DOC_CTSNUM_T TYPE SLLR3_DOC_CTSNUM_S OCCURS 0.
Data: LT_HTS TYPE SLLR3_DOC_CTSNUM_T.
Data: LT_ECCN TYPE SLLR3_DOC_CTSNUM_T.
*------- Ergebnisse: Belege: LCLIC
TYPES: SLLR3_DOC_LCLIC_S LIKE /SAPSLL/API6800_OBJ_LCLIC_R3_S,
SLLR3_DOC_LCLIC_T TYPE SLLR3_DOC_LCLIC_S OCCURS 0.
Data: LT_LICTY TYPE SLLR3_DOC_LCLIC_T.
* internal structres
Data: wa_lt_obj_doc type SLLR3_DOC_NO_S,
wa_HTS TYPE SLLR3_DOC_CTSNUM_S,
wa_ECCN TYPE SLLR3_DOC_CTSNUM_S,
wa_LICTY TYPE SLLR3_DOC_LCLIC_S,
wa_REFNO type CHAR40,
wa_land1 like vbdpr-land1_we.
Data: w_no_hts TYPE c value ' '.
* begin of D11K967899
data: W_ALNUM LIKE MAEX-ALNUM, " Export Control Class
W_EMBGR LIKE MAEX-EMBGR, " Export Grouping
W_HSCODE LIKE ZSTAWN-STAWN, " Commodity Code for dest. country
W_PSTAWN LIKE MARC-STAWN, "for decimal parsed commodity code US
W_DSTAWN LIKE MARC-STAWN, "for decimal parsed commodity code dest
W_HSCTXT LIKE T604T-TEXT1, " Commodity Code description
W_CCTEXT(60) TYPE C, " Commodity code description
W_BOM_HEADER TYPE C, " BOM Header flag
W_INT, " Intermediate Consignee flag
* W_TDNAME LIKE THEAD-TDNAME,
C TYPE I,
W_KOMSER LIKE KOMSER-SNRLN.
* end of D11K967899
*} INSERT
DATA v_z6_kunnr like vbpa-kunnr. "D81K922065
*&--------------------------------------------------------------------*
*& Form ENTRY
*&--------------------------------------------------------------------*
* text
*---------------------------------------------------------------------*
* -->RETURN_CODEtext
* -->US_SCREEN text
*---------------------------------------------------------------------*
FORM entry USING return_code us_screen.
CLEAR retcode.
xscreen = us_screen.
PERFORM processing USING us_screen.
CASE retcode.
WHEN 0.
return_code = 0.
WHEN 3.
return_code = 3.
WHEN OTHERS.
return_code = 1.
ENDCASE.
* BEGIN OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
* CALL FUNCTION 'Z_REPORT_LOG' .
* END OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
ENDFORM. "ENTRY
*---------------------------------------------------------------------*
* FORM ENTRY_ESR *
*---------------------------------------------------------------------*
* *
*---------------------------------------------------------------------*
* *
*---------------------------------------------------------------------*
FORM entry_esr USING return_code us_screen.
CLEAR retcode.
xscreen = us_screen.
PERFORM processing_esr USING us_screen.
CASE retcode.
WHEN 0.
return_code = 0.
WHEN 3.
return_code = 3.
WHEN OTHERS.
return_code = 1.
ENDCASE.
* BEGIN OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
* CALL FUNCTION 'Z_REPORT_LOG' .
* END OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
ENDFORM. "ENTRY_ESR
*---------------------------------------------------------------------*
* FORM ENTRY_ITALY *
*---------------------------------------------------------------------*
* Italian specific entry routine *
*---------------------------------------------------------------------*
* *
*---------------------------------------------------------------------*
FORM entry_italy USING return_code us_screen.
CLEAR retcode.
xscreen = us_screen.
PERFORM processing_italy USING us_screen.
CASE retcode.
WHEN 0.
return_code = 0.
WHEN 3.
return_code = 3.
WHEN OTHERS.
return_code = 1.
ENDCASE.
* BEGIN OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
* CALL FUNCTION 'Z_REPORT_LOG' .
* END OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
ENDFORM. "ENTRY_ITALY
* begin changes for upgrade from 30f to 31h dloucks "Z1XDSL
"Z1XDSL
*****************************************************************"Z1XDSL
* "Z1XDSL
* Standard Routine ENTRY_CH "Z1XDSL
* "Z1XDSL
*****************************************************************"Z1XDSL
"Z1XDSL
*---------------------------------------------------------------------*
* FORM ENTRY_CH *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> RETURN_CODE *
* --> US_SCREEN *
*---------------------------------------------------------------------*
FORM entry_ch USING return_code us_screen. "Z1XDSL
CLEAR retcode. "Z1XDSL
xscreen = us_screen. "Z1XDSL
header_userexit = 'HEADER_CH'. "Z1XDSL
item_userexit = 'ITEM_CH'. "Z1XDSL
header_print_userexit = 'HEADER_PRINT_CH'. "Z1XDSL
item_print_userexit = 'ITEM_PRINT_CH'. "Z1XDSL
PERFORM processing USING us_screen. "Z1XDSL
CASE retcode. "Z1XDSL
WHEN 0. "Z1XDSL
return_code = 0. "Z1XDSL
WHEN 3. "Z1XDSL
return_code = 3. "Z1XDSL
WHEN OTHERS. "Z1XDSL
return_code = 1. "Z1XDSL
ENDCASE. "Z1XDSL
* BEGIN OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
* CALL FUNCTION 'Z_REPORT_LOG' .
* END OF CHANGE BY TIWARIV1 D81K900292 05 Feb 04 4.7 UPGRADE *
ENDFORM. "Z1XDSL
* end changes for upgrade from 30f to 31h dloucks "Z1XDSL
*---------------------------------------------------------------------*
* FORM PROCESSING *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> PROC_SCREEN *
*---------------------------------------------------------------------*
FORM processing USING proc_screen.
PERFORM get_data.
* perform get_data_fi.
* begin changes for upgrade from 30f to 31h dloucks "Z1XDSL
* "Z1XDSL
* IF VBDKR-UVALL NE SPACE OR VBDKR-UVALS NE SPACE OR "Z1XDSL
* VBDKR-UVPRS NE SPACE. "Z1XDSL
* IF PROC_SCREEN = SPACE. "Z1XDSL
* RETCODE = 3. "Z1XDSL
* IF VBDKR-UVALL NE SPACE OR VBDKR-UVALS NE SPACE. "Z1XDSL
* SYST-MSGNO = '201'. "Z1XDSL
* SYST-MSGID = 'VN'. "Z1XDSL
* SYST-MSGTY = 'I'. "Z1XDSL
* PERFORM PROTOCOL_UPDATE. "Z1XDSL
* ENDIF. "Z1XDSL
* IF VBDKR-UVPRS NE SPACE. "Z1XDSL
* SYST-MSGNO = '200'. "Z1XDSL
* SYST-MSGID = 'VN'. "Z1XDSL
* SYST-MSGTY = 'I'. "Z1XDSL
* PERFORM PROTOCOL_UPDATE. "Z1XDSL
* ENDIF. "Z1XDSL
* ELSE. "Z1XDSL
* IF VBDKR-UVALL NE SPACE OR VBDKR-UVALS NE SPACE. "Z1XDSL
* MESSAGE I201. "Z1XDSL
* ENDIF. "Z1XDSL
* IF VBDKR-UVPRS NE SPACE. "Z1XDSL
* MESSAGE I200. "Z1XDSL
* ENDIF. "Z1XDSL
* ENDIF. "Z1XDSL
* ENDIF. "Z1XDSL
* end changes for upgrade from 30f to 31h dloucks "Z1XDSL
CHECK retcode = 0.
PERFORM form_open USING proc_screen vbdkr-land1.
CHECK retcode = 0.
DO.
IF TVBDPR[] IS INITIAL.
EXIT.
ENDIF.
IF FLAG = 'X'.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'NEW-PAGE FIRST'.
ENDIF.
IF FLAG IS INITIAL.
FLAG = 'X'.
ENDIF.
PERFORM form_title_print.
CHECK retcode = 0.
PERFORM header_consgnee.
CHECK retcode = 0.
PERFORM reference_number.
CHECK retcode = 0.
PERFORM tax_text_print.
CHECK retcode = 0.
PERFORM header_data_print.
CHECK retcode = 0.
PERFORM header_text_print.
CHECK retcode = 0.
* Begin of Add. Valerie Toh. 04111998
CLEAR: item_no, ztotal.
* End of Add. Valerie Toh. 04111998
PERFORM item_print.
CHECK retcode = 0.
PERFORM end_print.
CHECK retcode = 0.
ENDDO.
PERFORM form_close.
CHECK retcode = 0.
ENDFORM. "PROCESSING
*---------------------------------------------------------------------*
* FORM PROCESSING_ESR *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> PROC_SCREEN *
*---------------------------------------------------------------------*
FORM processing_esr USING proc_screen.
PERFORM get_data.
PERFORM get_data_esr.
CHECK retcode = 0.
PERFORM form_open USING proc_screen vbdkr-land1.
CHECK retcode = 0.
PERFORM start_form.
CHECK retcode = 0.
PERFORM header_consgnee.
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. "PROCESSING_ESR
*---------------------------------------------------------------------*
* FORM PROCESSING_ITALY *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> PROC_SCREEN *
*---------------------------------------------------------------------*
FORM processing_italy USING proc_screen.
PERFORM get_data.
PERFORM get_data_italy USING proc_screen.
* begin changes for upgrade from 30f to 31h dloucks "Z1XDSL
* "Z1XDSL
* IF VBDKR-UVALL NE SPACE OR VBDKR-UVALS NE SPACE OR "Z1XDSL
* VBDKR-UVPRS NE SPACE. "Z1XDSL
* IF PROC_SCREEN = SPACE. "Z1XDSL
* RETCODE = 3. "Z1XDSL
* IF VBDKR-UVALL NE SPACE OR VBDKR-UVALS NE SPACE. "Z1XDSL
* SYST-MSGNO = '201'. "Z1XDSL
* SYST-MSGID = 'VN'. "Z1XDSL
* SYST-MSGTY = 'I'. "Z1XDSL
* PERFORM PROTOCOL_UPDATE. "Z1XDSL
* ENDIF. "Z1XDSL
* IF VBDKR-UVPRS NE SPACE. "Z1XDSL
* SYST-MSGNO = '200'. "Z1XDSL
* SYST-MSGID = 'VN'. "Z1XDSL
* SYST-MSGTY = 'I'. "Z1XDSL
* PERFORM PROTOCOL_UPDATE. "Z1XDSL
* ENDIF. "Z1XDSL
* ELSE. "Z1XDSL
* IF VBDKR-UVALL NE SPACE OR VBDKR-UVALS NE SPACE. "Z1XDSL
* MESSAGE I201. "Z1XDSL
* ENDIF. "Z1XDSL
* IF VBDKR-UVPRS NE SPACE. "Z1XDSL
* MESSAGE I200. "Z1XDSL
* ENDIF. "Z1XDSL
* ENDIF. "Z1XDSL
* ENDIF. "Z1XDSL
* end changes for upgrade from 30f to 31h dloucks "Z1XDSL
CHECK retcode = 0.
PERFORM form_open USING proc_screen vbdkr-land1.
CHECK retcode = 0.
PERFORM form_title_print.
CHECK retcode = 0.
PERFORM header_consgnee.
CHECK retcode = 0.
PERFORM reference_number.
CHECK retcode = 0.
PERFORM tax_text_print.
CHECK retcode = 0.
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. "PROCESSING_ITALY
***********************************************************************
* S U B R O U T I N E S *
***********************************************************************
*---------------------------------------------------------------------*
* FORM AMOUNT_FOR_CASH_DISCOUNT *
*---------------------------------------------------------------------*
* This routine prints the amount qualifying for cash discount. *
*---------------------------------------------------------------------*
FORM amount_for_cash_discount.
CHECK vbdkr-skfbk NE 0.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'AMOUNT_QUALIFYING_FOR_CASH_DISCOUNT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "AMOUNT_FOR_CASH_DISCOUNT
*---------------------------------------------------------------------*
* FORM PAYMENT_SPLIT *
*---------------------------------------------------------------------*
* This routine prints the payment split *
*---------------------------------------------------------------------*
FORM payment_split.
DATA: h_skfbt LIKE acccr-skfbt.
DATA: h_fkdat LIKE vbrk-fkdat.
DATA: h_fkwrt LIKE acccr-wrbtr.
* DATA: BEGIN OF PAYMENT_SPLIT OCCURS 3,
* LINE(80),
* END OF PAYMENT_SPLIT.
DATA : BEGIN OF payment_split OCCURS 3.
INCLUDE STRUCTURE vtopis.
DATA : END OF payment_split.
CHECK vbdkr-zterm NE space.
h_skfbt = vbdkr-skfbk.
h_fkwrt = komk-fkwrt.
h_fkdat = vbdkr-fkdat.
IF vbdkr-valdt NE 0.
h_fkdat = vbdkr-valdt.
ENDIF.
IF vbdkr-valtg NE 0.
h_fkdat = vbdkr-fkdat + vbdkr-valtg.
ENDIF.
CALL FUNCTION 'SD_PRINT_TERMS_OF_PAYMENT_SPLI'
EXPORTING
bldat = vbdkr-fkdat
budat = h_fkdat
cpudt = vbdkr-erdat
language = vbco3-spras
terms_of_payment = vbdkr-zterm
wert = h_fkwrt "Warenwert + Tax
waerk = vbdkr-waerk
fkdat = vbdkr-fkdat
skfbt = h_skfbt
* IMPORTING
* BASELINE_DATE =
TABLES
top_text_split = payment_split
EXCEPTIONS
terms_of_payment_not_in_t052 = 01
terms_of_payment_not_in_t052s = 02.
LOOP AT payment_split.
AT FIRST.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'PROTECT'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TERMS_OF_PAYMENT_SPLIT_HEADER'
* 4.7 Upgrade Begin of Change TIWARIV1-D91K995965 -012204
EXCEPTIONS
element = 1
window = 2.
* 4.7 Upgrade End of Change TIWARIV1-D91K995965 -012204
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDAT.
vbdkr-text = payment_split-line.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TERMS_OF_PAYMENT_SPLIT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
AT LAST.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'ENDPROTECT'.
ENDAT.
ENDLOOP.
ENDFORM. "PAYMENT_SPLIT
*---------------------------------------------------------------------*
* FORM CHECK_REPEAT *
*---------------------------------------------------------------------*
* A text is printed, if it is a repeat print for the document. *
*---------------------------------------------------------------------*
FORM check_repeat.
CLEAR 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'.
repeat = 'X'.
EXIT.
ENDSELECT.
ENDFORM. "CHECK_REPEAT
*---------------------------------------------------------------------*
* FORM DIFFERENT_CONSIGNEE *
*---------------------------------------------------------------------*
* If the consignee in the item is different to the header con- *
* signee, it is printed by this routine. *
*---------------------------------------------------------------------*
FORM different_consignee.
CHECK vbdkr-name1_we NE vbdpr-name1_we
OR vbdkr-name2_we NE vbdpr-name2_we
OR vbdkr-name3_we NE vbdpr-name3_we
OR vbdkr-name4_we NE vbdpr-name4_we.
CHECK vbdpr-name1_we NE space
OR vbdpr-name2_we NE space
OR vbdpr-name3_we NE space
OR vbdpr-name4_we NE space.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_CONSIGNEE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "DIFFERENT_CONSIGNEE
*---------------------------------------------------------------------*
* FORM DIFFERENT_DELIVERY_NO *
*---------------------------------------------------------------------*
* If the delivery number is different to number in the header, *
* it is printed by this routine. *
*---------------------------------------------------------------------*
FORM different_delivery_no.
CHECK vbdkr-vbtyp CA 'MUN'.
CHECK vbdpr-vbeln_vl NE vbdpr-vbeln_vauf.
CHECK vbdkr-vbeln_vl NE vbdpr-vbeln_vl.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_DELIVERY_NO'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "DIFFERENT_DELIVERY_NO
*---------------------------------------------------------------------*
* FORM DIFFERENT_ORDER_NO *
*---------------------------------------------------------------------*
* If the order number is different to number in the header, *
* it is printed by this routine. *
*---------------------------------------------------------------------*
FORM different_order_no.
CHECK vbdkr-vbtyp CA 'MUN'.
CHECK vbdkr-vbeln_vauf NE vbdpr-vbeln_vauf.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_ORDER_NO'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "DIFFERENT_ORDER_NO
*---------------------------------------------------------------------*
* FORM DIFFERENT_EXTERN_NO *
*---------------------------------------------------------------------*
* If the extern number is different to number in the header, *
* it is printed by this routine. *
*---------------------------------------------------------------------*
FORM different_extern_no.
CHECK vbdkr-vbtyp CA 'MUN'.
CHECK vbdkr-vbeln_vauf EQ space.
CHECK vbdkr-vbeln_vl EQ space.
CHECK vbdpr-vbeln_vauf EQ space.
CHECK vbdpr-vbeln_vl EQ space.
CHECK vbdkr-vgbel NE vbdpr-vgbel.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_EXTERN_NO'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "DIFFERENT_EXTERN_NO
*---------------------------------------------------------------------*
* FORM DIFFERENT_PURCHASE_ORDER_NO *
*---------------------------------------------------------------------*
* If the purchase order number is different to number in the *
* header, it is printed by this routine. *
*---------------------------------------------------------------------*
FORM different_purchase_order_no.
CHECK vbdkr-vbtyp CA 'MUN'.
CHECK vbdkr-bstnk NE vbdpr-bstnk
OR vbdkr-bstdk NE vbdpr-bstdk.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_PURCHASE_ORDER_NO'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "DIFFERENT_PURCHASE_ORDER_NO
*---------------------------------------------------------------------*
* FORM END_PRINT *
*---------------------------------------------------------------------*
* *
*---------------------------------------------------------------------*
FORM end_print.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'PROTECT'.
PERFORM header_price_print.
* Begin of changes. Valerie Toh 05111998
PERFORM exchange_rate_prn.
* End of changes. Valerie Toh 05111998
* Code added by Veeran for Drop Shipment for Singapore.
* FH D11K930984
* IF ZSTP_FLAG NE 'X' AND ZHEADFI-ZFLAG1 NE 'X'. "Z1MV
* ZHEADFI-ZTOTAMOUNT = ZHEADFI-ZTOTAMOUNT + ZHEADFI-ZTOTTAX +
* ZTOTAL. "Z1MV
* ENDIF. "Z1MV
* FH D11K930984 end change
CLEAR w_tax_flag.
IF zheadfi-ztottax <> 0.
w_tax_flag = 'Y'.
ENDIF.
MOVE vbdkr-vbeln_vauf TO zsitem-matnr_text.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'HEADER_TEXT2'
EXCEPTIONS
element = 1
window = 2.
CLEAR zheadfi-zflag1.
CLEAR zsitem-matnr_text.
IF zheadfi-zflag2 = 'X'.
zheadfi-zwrbtr = zheadfi-zwrbtr + zheadfi-zfreight.
ENDIF.
IF a_out4 >< ' '.
MOVE a_out4 TO komvd-drukz.
ENDIF.
IF w_print_curr_sign = 'N'. "D11k961350
CLEAR komvd-drukz. "D11k961350
ENDIF. " W_PRINT_CURR_SIGN = 'N'. "D11k961350
*
*zheadfi-ztotamount = zheadfi-ztotamount / 100. "D11K976031 Madhu Vanam
*
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'END_VALUES'
* window = 'Z012'.
PERFORM amount_for_cash_discount.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'ENDPROTECT'.
PERFORM payment_split.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'SUPPLEMENT_TEXT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "END_PRINT
*---------------------------------------------------------------------*
* FORM FORM_CLOSE *
*---------------------------------------------------------------------*
* End of printing the form *
*---------------------------------------------------------------------*
FORM form_close.
REFRESH : TVBDPR.
CLEAR: TVBDPR, VBDPR.
CALL FUNCTION 'CLOSE_FORM'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
retcode = sy-subrc.
PERFORM protocol_update.
ENDIF.
SET COUNTRY space.
***ADDED BY SIR 1245 FOR PERFORMA INVOICE D10K903006***
CLEAR: zheadfi-zflag2,
zheadfi-zwrbtr,
zheadfi-ztotamount.
**END OF D10K903006**
ENDFORM. "FORM_CLOSE
*---------------------------------------------------------------------*
* 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.
INCLUDE rvadopfo.
ENDFORM. "FORM_OPEN
*---------------------------------------------------------------------*
* FORM FORM_TITLE_PRINT *
*---------------------------------------------------------------------*
* Printing of the form title depending of the field VBTYP *
*---------------------------------------------------------------------*
FORM form_title_print.
CASE vbdkr-vbtyp.
WHEN 'M'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_M'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
WHEN 'N'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_N'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
WHEN 'O'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_O'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
WHEN 'P'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_P'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
WHEN 'S'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_S'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
WHEN 'U'.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_U'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
WHEN OTHERS.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TITLE_M'
window = 'TITLE'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDCASE.
IF repeat NE space.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'REPEAT'
window = 'REPEAT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDFORM. "FORM_TITLE_PRINT
*---------------------------------------------------------------------*
* FORM GET_DATA *
*---------------------------------------------------------------------*
* General provision of data for the form *
*---------------------------------------------------------------------*
FORM get_data.
CALL FUNCTION 'RV_PRICE_PRINT_REFRESH'
TABLES
tkomv = tkomv.
CLEAR komk.
CLEAR komp.
IF nast-objky+10(6) NE space.
vbco3-vbeln = nast-objky+16(10).
ELSE.
vbco3-vbeln = nast-objky.
ENDIF.
vbco3-mandt = sy-mandt.
vbco3-spras = nast-spras.
vbco3-kunde = nast-parnr.
vbco3-parvw = nast-parvw.
CALL FUNCTION 'RV_BILLING_PRINT_VIEW'
EXPORTING
comwa = vbco3
IMPORTING
kopf = vbdkr
TABLES
pos = tvbdpr
EXCEPTIONS
terms_of_payment_not_in_t052 = 1
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-130104-others doesnot
*exist
* OTHERS = 4
*4.7 Upgrade End of Change TIWARIV1-D91K995965-130104
error_message = 5.
IF NOT sy-subrc IS INITIAL.
IF sy-subrc = 1.
syst-msgty = 'I'.
PERFORM protocol_update.
ENDIF.
ENDIF.
* Begin of changes by Rajasekhar - D81K912848
IF tvbdpr[] IS NOT INITIAL.
READ TABLE tvbdpr INDEX 1.
g_vbeln_vauf = tvbdpr-vbeln_vauf.
ENDIF.
* End of changes by Rajasekhar - D81K912848
* Begin of changes. Valerie Toh 05111998
CLEAR: ex_rtdt, curr_cd, fgst_amt.
ex_rtdt = sy-datum.
curr_cd = vbdkr-waerk.
* End of changes. Valerie Toh 05111998
* Begin of Add. Valerie Toh. 15/12/1998
CLEAR: w_inco1, w_inco2.
READ TABLE tvbdpr INDEX 1.
IF sy-subrc = 0.
SELECT SINGLE * FROM vbrk WHERE vbeln = vbdkr-vbeln.
IF sy-subrc = 0.
SELECT SINGLE * FROM vbrp WHERE vbeln = vbrk-vbeln
AND posnr = tvbdpr-posnr.
IF sy-subrc = 0.
SELECT SINGLE * FROM zvfreight WHERE spras = sy-langu
AND vkorg = vbrk-vkorg
AND vtweg = vbrk-vtweg
AND spart = vbrp-spart
AND werks = vbrp-werks
AND land1 = vbrk-land1.
IF sy-subrc = 0.
w_inco1 = zvfreight-inco1.
w_inco2 = zvfreight-inco2.
ENDIF.
ENDIF.
ENDIF.
* Begin of Add. Valerie Toh. 21/12/1998
CLEAR zhead_ship_std.
SELECT SINGLE * FROM ekko WHERE ebeln = vbdkr-vbeln_vauf.
IF sy-subrc = 0.
CLEAR ekpo. ""D11K961658
SELECT SINGLE * FROM ekpo WHERE ebeln = ekko-ebeln
AND ebelp = tvbdpr-posnr_vauf.
IF sy-subrc = 0.
SELECT SINGLE * FROM zmstore WHERE spras = sy-langu
AND bukrs = ekko-bukrs
AND ekorg = ekko-ekorg
AND werks = ekpo-werks
AND lgort = ekpo-lgort.
IF sy-subrc = 0.
zhead_ship_std = zmstore-address_we.
ENDIF.
ENDIF.
ENDIF.
* Begin of Add. Valerie Toh. 21/12/1998
ENDIF.
* End of Add. Valerie Toh. 15/12/1998
PERFORM sender.
PERFORM check_repeat.
PERFORM get_header_prices.
* Calling customer subroutine dynamically for additional data "Z1XDSL
* transfer "Z1XDSL
IF NOT get_data_userexit IS INITIAL. "Z1XDSL
PERFORM (get_data_userexit) IN PROGRAM rvadin01 IF FOUND."Z1XDSL
ENDIF. "Z1XDSL
*** Added by Ramesh
*Perform for fetching company address.
DATA L_BUKRS TYPE BUKRS.
CLEAR:
v_bukrs_adrnr,
gs_bukrs_adrc.
SELECT SINGLE bukrs INTO L_bukrs
FROM tvko
WHERE vkorg = 'CN40'. ""vbdkr-vkorg.
IF sy-subrc = 0.
SELECT SINGLE adrnr INTO v_bukrs_adrnr FROM t001
WHERE bukrs = L_bukrs.
ENDIF.
IF sy-subrc = 0.
SELECT SINGLE * INTO CORRESPONDING FIELDS OF GS_bukrs_adrc
FROM adrc
WHERE addrnumber = v_bukrs_adrnr
AND nation = ' '.
ENDIF.
*** End of Ramesh
ENDFORM. "GET_DATA
*---------------------------------------------------------------------*
* FORM GET_ITEM_CHARACTERISTICS *
*---------------------------------------------------------------------*
* In this routine the configuration data item is fetched from *
* the database. *
*---------------------------------------------------------------------*
FORM get_item_characteristics.
REFRESH tkomcon.
CHECK NOT vbdpr-cuobj IS INITIAL.
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965 -012204 added
*VC_I_GET_CONFIGURATION
* CALL FUNCTION 'CUD0_GET_CONFIGURATION'
* EXPORTING
* INSTANCE = VBDPR-CUOBJ
* LANGUAGE = NAST-SPRAS
* TABLES
* CONFIGURATION = TKOMCON
* EXCEPTIONS
* OTHERS = 4.
CALL FUNCTION 'VC_I_GET_CONFIGURATION'
EXPORTING
instance = vbdpr-cuobj
* BUSINESS_OBJECT =
language = nast-spras
* PRINT_SALES = ' '
* PRINT_PURCHASE = ' '
* PRINT_ENGINEERING = ' '
* IDOC_MODE = ' '
* ANW_SICHT = ' '
* EXCL_IND = ' '
* IV_INVALID_POSSIBLE = ' '
* IV_MAX_MASSPROCESSING = 0
* IV_EXPLICIT_ORGAREA = ' '
TABLES
configuration = tkomcon
* CONFIGURATION_IDOC =
EXCEPTIONS
* INSTANCE_NOT_FOUND = 1
* INTERNAL_ERROR = 2
* NO_CLASS_ALLOCATION = 3
* INSTANCE_NOT_VALID = 4
OTHERS = 4
.
IF sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
ENDIF.
ENDFORM. "GET_ITEM_CHARACTERISTICS
*4.7 Upgrade End of Change TIWARIV1-D91K995965 -012204
*---------------------------------------------------------------------*
* 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 vbdkr-knumv.
CLEAR komk.
komk-mandt = sy-mandt.
komk-kalsm = vbdkr-kalsm.
komk-fkart = vbdkr-fkart.
komk-kappl = pr_kappl.
IF vbdkr-kappl NE space.
komk-kappl = vbdkr-kappl.
ENDIF.
komk-waerk = vbdkr-waerk.
komk-knumv = vbdkr-knumv.
komk-vbtyp = vbdkr-vbtyp.
ENDIF.
komp-kposn = vbdpr-posnr.
* begin changes by DLoucks for 3.1I Upgrade. SAPscript Z31IDSL
komk-bukrs = vbdkr-bukrs. "Z31IDSL
* end changes by DLoucks for 3.1I Upgrade. SAPscript Z31IDSL
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.
* "Z1XDSL
* Calling customer subroutine dynamically for additional data "Z1XDSL
* transfer "Z1XDSL
IF NOT get_data_userexit IS INITIAL. "Z1XDSL
PERFORM (get_data_userexit) IN PROGRAM rvadin01 IF FOUND."Z1XDSL
ENDIF. "Z1XDSL
ENDFORM. "GET_ITEM_PRICES
*---------------------------------------------------------------------*
* FORM GET_HEADER_PRICES *
*---------------------------------------------------------------------*
* In this routine the price data for the header is fetched from *
* the database. *
*---------------------------------------------------------------------*
FORM get_header_prices.
IF komk-knumv NE vbdkr-knumv.
CLEAR komk.
komk-mandt = sy-mandt.
komk-kalsm = vbdkr-kalsm.
komk-fkart = vbdkr-fkart.
komk-kappl = pr_kappl.
IF vbdkr-kappl NE space.
komk-kappl = vbdkr-kappl.
ENDIF.
komk-waerk = vbdkr-waerk.
komk-knumv = vbdkr-knumv.
komk-vbtyp = vbdkr-vbtyp.
komk-knuma = vbdkr-knuma.
* begin changes by DLoucks for 3.1I Upgrade. SAPscript Z31IDSL
komk-bukrs = vbdkr-bukrs. "Z31IDSL
* end changes by DLoucks for 3.1I Upgrade. SAPscript Z31IDSL
ENDIF.
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 = hkomvd.
* "Z1XDSL
* Calling customer subroutine dynamically for additional data "Z1XDSL
* transfer "Z1XDSL
IF NOT get_data_userexit IS INITIAL. "Z1XDSL
PERFORM (get_data_userexit) IN PROGRAM rvadin01 IF FOUND."Z1XDSL
ENDIF. "Z1XDSL
ENDFORM. "GET_HEADER_PRICES
*---------------------------------------------------------------------*
* FORM HEADER_PRICE_PRINT *
*---------------------------------------------------------------------*
* Printout of the header prices *
*---------------------------------------------------------------------*
FORM header_price_print.
LOOP AT hkomvd.
AT FIRST.
IF komk-supos NE 0.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_SUM'.
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 = hkomvd.
IF print_mwskz = space.
CLEAR komvd-mwskz.
ENDIF.
* IF komvd-koaid = 'D'.
* fgst_amt = komvd-kwert.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'TAX_LINE'.
* ELSE.
* CALL FUNCTION 'WRITE_FORM'
* EXPORTING
* element = 'SUM_LINE'.
* ENDIF.
ENDLOOP.
DESCRIBE TABLE hkomvd 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.
* "Z1XDSL
* Calling customer subroutine dynamically for additional data "Z1XDSL
* transfer "Z1XDSL
IF NOT get_data_userexit IS INITIAL. "Z1XDSL
PERFORM (get_data_userexit) IN PROGRAM rvadin01 IF FOUND."Z1XDSL
ENDIF. "Z1XDSL
ENDFORM. "HEADER_PRICE_PRINT
*---------------------------------------------------------------------*
* 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. "HEADER_TEXT_PRINT
*---------------------------------------------------------------------*
* 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. "ITEM_CHARACTERISTICS_PRINT
*---------------------------------------------------------------------*
* FORM ITEM_PRINT *
*---------------------------------------------------------------------*
* Printout of the items *
*---------------------------------------------------------------------*
FORM item_print.
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.
* Added by P. Ohl for Proforma Invoice 5/5/97 "D10K900951
SET COUNTRY 'US'.
* Get the Invoice and Shipment Dates
SELECT fbuda erdat FROM vbrp UP TO 1 ROWS
INTO (vbrp-fbuda, vbrp-erdat)
WHERE vbeln EQ vbdkr-vbeln.
ENDSELECT.
WRITE vbrp-fbuda TO tf111-txt1.
WRITE vbrp-erdat TO tf111-txt2.
* End of added by P. Ohl for Proforma Invoice 5/5/97 "D10K900951
CALL FUNCTION 'WRITE_FORM' "First header
EXPORTING element = 'Z010A'
EXCEPTIONS OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
*********
** Added by Ramesh
SORT TVBDPR BY WERKS.
*********
DATA: XYZ.
CLEAR TOTAL.
LOOP AT tvbdpr.
IF XYZ = 'X'.
ON CHANGE OF tvbdpr-WERKS.
EXIT.
ENDON.
ENDIF.
IF XYZ IS INITIAL.
XYZ = 'X'.
ENDIF.
HIGH = HIGH + LEN.
MOVE: HIGH TO HEIGHT.
*HEIGHT = HEIGHT + LEN.
* Added the check statement to eliminate the FREIGHT being printed on
* the Proforma. Veeran 09/06/00.
* CHECK TVBDPR-MATNR NA 'FREIGHT_*'. "Z1MV "D11K931047 delete
CHECK tvbdpr-matnr(7) NE 'FREIGHT'. "D11K931047
vbdpr = tvbdpr.
* Begin of insert - ALAGARJ1 - 04/21/2005 D81K911876
PERFORM get_commodity_code.
* End of insert - ALAGARJ1 - 04/21/2005 D81K911876
* Begin of Add. Valerie Toh. 16/12/1998
CLEAR: w_tdline, w_tdname. "VT16/12/1998
CONCATENATE vbdkr-vbeln vbdpr-posnr INTO w_tdname. "VT16/12/1998
SELECT SINGLE * FROM stxh WHERE tdobject = 'VBBP' "VT16/12/1998
AND tdname = w_tdname "VT16/12/1998
AND tdid = '0001' "VT16/12/1998
AND tdspras = sy-langu. "VT16/12/1998
IF sy-subrc = 0. "VT16/12/1998
CALL FUNCTION 'READ_TEXT' "VT16/12/1998
EXPORTING "VT16/12/1998
client = sy-mandt "VT16/12/1998
id = stxh-tdid "VT16/12/1998
language = stxh-tdspras "VT16/12/1998
name = stxh-tdname "VT16/12/1998
object = stxh-tdobject "VT16/12/1998
TABLES "VT16/12/1998
lines = hline "VT16/12/1998
EXCEPTIONS "VT16/12/1998
id = 1 "VT16/12/1998
language = 2 "VT16/12/1998
name = 3 "VT16/12/1998
not_found = 4 "VT16/12/1998
object = 5 "VT16/12/1998
reference_check = 6 "VT16/12/1998
wrong_access_to_archive = 7 "VT16/12/1998
OTHERS = 8. "VT16/12/1998
READ TABLE hline INDEX 1.
MOVE hline-tdline TO w_tdline.
ENDIF. "SY-SUBRC = 0 SELECT FROM STXH
* END of Add. Valerie Toh. 16/12/1998
CLEAR w_print_curr_sign. "D11K961350
PERFORM get_partner. "A15K901434
* Begin of changes. D11K903205
* Depending on the currency key in the SD document, use the appropriate
* currency symbol on the invoice printout.
**************************** NOTE !!! **********************************
* PLEASE NOTE, ONLY USD, JPY AND GBP CURRENCIES ARE ACCOUNTED FOR. IF
* PROCESSING WITH OTHER CURRENCIES IS TAKING PLACE, PLEASE ADD THE
* NEW CURRENCY!!!
IF likp-lfart = internal. "Type NLCC
po_number = vbdkr-vbeln_vauf. "PO number
SELECT SINGLE waers INTO ekko-waers FROM ekko WHERE ebeln =
vbdkr-vbeln_vauf.
vbdkr-waerk = ekko-waers. "D11K904183
CASE ekko-waers. "Document currency
WHEN usd.
a_charno = 36.
PERFORM currency_field_conversion.
WHEN yen.
a_charno = 165.
PERFORM currency_field_conversion.
WHEN pounds.
a_charno = 163.
PERFORM currency_field_conversion.
WHEN OTHERS.
* A_CHARNO = 36. "D11K961350
* PERFORM CURRENCY_FIELD_CONVERSION. "D11K961350
w_print_curr_sign = 'N'. "D11K961350
CLEAR komvd-drukz. "D11K961350
ENDCASE.
ELSE.
CASE vbak-waerk. "Document currency
WHEN usd.
a_charno = 36.
PERFORM currency_field_conversion.
WHEN yen.
a_charno = 165.
PERFORM currency_field_conversion.
WHEN pounds.
a_charno = 163.
PERFORM currency_field_conversion.
WHEN OTHERS.
* A_CHARNO = 36. "D11K961350
* PERFORM CURRENCY_FIELD_CONVERSION. "D11K961350
w_print_curr_sign = 'N'. "D11K961350
CLEAR komvd-drukz. "D11K961350
ENDCASE.
ENDIF.
CLEAR zheadfi-ztax.
CLEAR zheadfi-zdisc.
CLEAR zheadfi-zdeliver.
CLEAR zheadfi-zbo.
CLEAR zheadfi-zpayacc.
CLEAR zheadfi-ztotal. "Added for condition type changes
CLEAR zheadfi-znewprice.
CLEAR zheadfi-zprice.
CLEAR zheadfi-zflag.
CLEAR zspectre.
CLEAR zintercompany.
CLEAR zzholdnetp.
CLEAR zholddiscper.
CLEAR zdiscamount.
CLEAR zzunitprice.
CLEAR zzquantity.
CLEAR zzfinalprice.
CLEAR mwst_flag.
CLEAR zstp_flag. "Z1MV
LOOP AT tkomv WHERE kposn = tvbdpr-posnr. "Z1FH
* Start of comment - D81K922065 for ADC P2
* CLEAR zstp_flag. "D11K931341
* End of comment - D81K922065 for ADC P2
* IF TKOMV-KPOSN = TVBDPR-POSNR. "A15K901434
IF tkomv-kschl EQ 'NETP'
OR tkomv-kschl EQ 'PR00'. "VT30101998
SELECT SINGLE netwr FROM vbrp INTO zzholdnetp
WHERE vbeln = vbdkr-vbeln "Invoice number
AND posnr = vbdpr-posnr. "Invoice line item number
ELSEIF tkomv-kschl(4) EQ 'MWST' AND vbdkr-bukrs = 'SG30'. "VT
zheadfi-ztax = tkomv-kbetr. "VT
zheadfi-ztottax = zheadfi-ztottax + tkomv-kwert. "VT
mwst_flag = 'X'. "VT 08121998
ELSEIF tkomv-kschl EQ 'ZINV'.
zspecamount = tkomv-kbetr.
zspectre = 'X'.
*Changed for intercompany*
ELSEIF tkomv-kschl EQ 'ZEDL' AND ( vbdkr-kalsm = 'ZICT1'
OR vbdkr-kalsm = 'ZITCO' ).
MOVE tkomv-kbetr TO zheadfi-zdisc.
zintercompany = 'X'.
ELSEIF tkomv-kschl = 'ZSTP'.
* if tkomv-kbetr <> 0. "Z1MV
zzholdnetp = tkomv-kbetr.
zheadfi-zpayacc = tkomv-kwert.
zheadfi-zflag = 'X'.
zstp_flag = 'X'. "Z1MV
* IF MWST_FLAG = 'X'. "D11K931341
* ZHEADFI-ZTOTTAX = ZHEADFI-ZTOTTAX + "D11K931341
* ( ZHEADFI-ZTAX * TKOMV-KBETR )."D11K9313
* ENDIF. "MWST_FLAG = 'X'. "D11K931341
* EXIT. "Z1FH
* endif.
ENDIF. "TKOMV-KSCHL EQ 'NETP'
IF ( tkomv-kschl NE 'NETP' ) AND ( tkomv-kschl NE 'VPRS' )
AND ( tkomv-kschl NE 'ZSTP' ) AND ( tkomv-kschl NE 'ZD01' )
AND ( tkomv-kschl NE 'ZD03' ) AND ( tkomv-kschl NE 'PR00' ).
IF tkomv-kschl EQ 'ZD00' OR tkomv-kschl EQ 'ZD02'.
zheadfi-zwrbtr17 = zheadfi-zwrbtr17 + tkomv-kwert.
zheadfi-zfreight = zheadfi-zfreight + tkomv-kwert.
zcount = zcount + 1. "sir 1239**
zheadfi-zflag1 = 'X'. "D10K903006
ELSE.
IF ( vbdkr-kalsm = 'ZICT1' OR vbdkr-kalsm = 'ZITCO' ) OR
( ( vbdkr-kalsm EQ 'ZICT1' OR vbdkr-kalsm EQ 'ZITCO' )
AND tkomv-kschl NE 'ZICR'
AND tkomv-kschl NE 'ZEDL' AND tkomv-kschl NE 'ZCAN').
SELECT SINGLE koaid FROM t685a INTO (t685a-koaid)
WHERE kschl = tkomv-kschl
AND kappl = 'V'.
IF sy-subrc EQ 0.
IF t685a-koaid = 'B'.
zheadfi-zpayacc = zheadfi-zpayacc + tkomv-kbetr.
ENDIF. "T685A-KOAID = 'B'.
ENDIF. "SY-SUBRC EQ 0. SELECT SINGLE KOAID FROM T685A
ENDIF. "( VBDKR-KALSM = 'ZICT1' OR VBDKR-KALSM = 'ZITCO' ) O
ENDIF. "TKOMV-KSCHL EQ 'ZD00' OR TKOMV-KSCHL EQ 'ZD02'.
ENDIF. "( TKOMV-KSCHL NE 'NETP' ) AND ( TKOMV-KSCHL NE 'VPRS' )
IF vbdpr-fkimg NE 0.
zheadfi-zprice = vbdkr-netwr * 1000 / vbdpr-fkimg."D10K900967
ELSE.
zheadfi-zprice = 0.
ENDIF.
zheadfi-zextprice = vbdkr-netwr. "D10K900967
ENDLOOP. " AT TKOMV.
IF zstp_flag = 'X'.
CLEAR zheadfi-zwrbtr.
* clear zheadfi-ztotamount.
MOVE zheadfi-zpayacc TO zzunitprice.
MOVE zheadfi-zpayacc TO zheadfi-zmenge6.
IF vbdpr-fkimg NE 0. "D11K931163
zheadfi-zmenge6 = zheadfi-zmenge6 / vbdpr-fkimg. "Z1MV
ENDIF. " VBDPR-FKIMG NE 0. "D11K931163
* Deleted D11K976811 Madhu Vanam
** Madhu Vanam D11K976032
*CALL FUNCTION 'BAPI_CURRENCY_CONV_TO_EXTERNAL'
* EXPORTING
* CURRENCY = VBDKR-WAERK
* AMOUNT_INTERNAL = ZHEADFI-ZMENGE6
* IMPORTING
* AMOUNT_EXTERNAL = TEMP_ZMENGE6
* EXCEPTIONS
* OTHERS = 1.
*MOVE TEMP_ZMENGE6 TO ZHEADFI-ZMENGE6.
** End of changes D11K976032
* Deleted D11K976811 Madhu Vanam
MOVE vbdpr-fkimg TO zzquantity.
zzfinalprice = zzunitprice * zzquantity.
MOVE zzfinalprice TO zheadfi-ztotal.
ztotal = ztotal + zheadfi-ztotal.
zheadfi-ztotal = zheadfi-zpayacc. "Z1MV
* Deleted D11K976811 Madhu Vanam
** Madhu Vanam D11K976032
*CALL FUNCTION 'BAPI_CURRENCY_CONV_TO_EXTERNAL'
* EXPORTING
* CURRENCY = VBDKR-WAERK
* AMOUNT_INTERNAL = ZHEADFI-ZTOTAL
* IMPORTING
* AMOUNT_EXTERNAL = TEMP_ZMENGE6
* EXCEPTIONS
* OTHERS = 1.
*MOVE TEMP_ZMENGE6 TO ZHEADFI-ZTOTAL.
*** End of changes D11K976032
* Deleted D11K976811 Madhu Vanam
zheadfi-ztotamount = zheadfi-ztotamount + zheadfi-ztotal."Z1MV
zheadfi-zwrbtr = zheadfi-zwrbtr + zheadfi-ztotal.
ELSE.
MOVE tvbdpr-fkimg TO zzquantity.
MOVE tvbdpr-kzwi3 TO zheadfi-zpayacc.
MOVE zheadfi-zpayacc TO zheadfi-zmenge6.
IF tvbdpr-fkimg NE 0.
zheadfi-zmenge6 = zheadfi-zmenge6 / tvbdpr-fkimg.
ENDIF. " VBDPR-FKIMG NE 0.
* Deleted D11K976811 Madhu Vanam
** Madhu Vanam D11K976032
*CALL FUNCTION 'BAPI_CURRENCY_CONV_TO_EXTERNAL'
* EXPORTING
* CURRENCY = VBDKR-WAERK
* AMOUNT_INTERNAL = ZHEADFI-ZMENGE6
* IMPORTING
* AMOUNT_EXTERNAL = TEMP_ZMENGE6
* EXCEPTIONS
* OTHERS = 1.
*MOVE TEMP_ZMENGE6 TO ZHEADFI-ZMENGE6.
*MOVE ZHEADFI-ZMENGE6 TO ZZUNITPRICE.
** End of changes D11K976032
* Deleted D11K976811 Madhu Vanam
MOVE tvbdpr-fkimg TO zzquantity.
zzfinalprice = zzunitprice * zzquantity.
MOVE zzfinalprice TO zheadfi-ztotal.
ztotal = ztotal + zheadfi-ztotal.
zheadfi-ztotal = zheadfi-zpayacc.
* Deleted D11K976811 Madhu Vanam
*** Madhu Vanam D11K976032
*CALL FUNCTION 'BAPI_CURRENCY_CONV_TO_EXTERNAL'
* EXPORTING
* CURRENCY = VBDKR-WAERK
* AMOUNT_INTERNAL = ZHEADFI-ZTOTAL
* IMPORTING
* AMOUNT_EXTERNAL = TEMP_ZMENGE6
* EXCEPTIONS
* OTHERS = 1.
*MOVE TEMP_ZMENGE6 TO ZHEADFI-ZTOTAL.
** End of changes D11K976032
* Deleted D11K976811 Madhu Vanam
zheadfi-ztotamount = zheadfi-ztotamount + zheadfi-ztotal.
ENDIF.
CLEAR zspecamount.
CLEAR zzunitprice.
CLEAR zzquantity.
CLEAR zzfinalprice.
CLEAR zheadfi-zflag.
SELECT SINGLE vbelv posnv fpltr FROM vbfa "SR01
INTO (vbfa-vbelv, vbfa-posnv, vbfa-fpltr) "SR01
WHERE vbelv = vbdpr-vgbel "SR01
AND posnv = vbdpr-vgpos "SR01
AND vbeln = vbdkr-vbeln "SR01
AND posnn = vbdpr-posnr "SR01
AND vbtyp_n = 'M' "SR01
AND vbtyp_v = 'G'. "SR01
*Pull off delivery item number to be used to get the serial number.
SELECT posnn FROM vbfa INTO hposnn UP TO 1 ROWS "A15K901434
WHERE vbelv = vbdkr-vbeln_vauf "A15K901434
AND posnv = vbdpr-posnr "A15K901434
AND vbeln = vbdpr-vbeln_vl "A15K901434
AND vbtyp_n = 'J'. "A15K901434
ENDSELECT.
* Calculate the total number of items delivered. "A15K901434
SELECT * FROM vbfa "Sales Document Flow "A15K901434
WHERE vbelv = vbdkr-vbeln_vauf "A15K901434
AND posnv = vbdpr-posnr "A15K901434
AND vbtyp_n = 'M'. "A15K901434
ENDSELECT. "A15K901434
PERFORM get_item_prices.
PERFORM get_item_characteristics.
**Code added by AC for Ticket 1858 to not print line items from BOM
SELECT SINGLE pstyv FROM vbap INTO (vbap-pstyv)
WHERE vbeln = vbdkr-vbeln_vauf
* and posnr = vbdpr-posnr.
AND posnr = vbdpr-posnr_vauf. "Ticket # 19951
IF ( vbap-pstyv NE 'ZPCK' AND vbap-pstyv NE 'ZICP'
AND vbap-pstyv NE 'ZRRK' ).
**ticket 3886 to pull country of origin for proformas going to Canada
* CLEAR ZHEADFI-ZREGION. "z001fh
* if vbak-vkorg = 'US20' and vbdpr-land1_we = 'CA'.
* IF VBDPR-LAND1_WE = 'CA'. "Changed by K. Brady z001fh
* SELECT SINGLE HERKL FROM MARC INTO ZHEADFI-ZREGION "z001fh
* WHERE MATNR = VBDPR-MATNR "z001fh
* AND WERKS = 'US21'. "z001fh
* IF ZHEADFI-ZREGION IS INITIAL. "z001fh
* MOVE 'US' TO ZHEADFI-ZREGION. "z001fh
* ENDIF. "z001fh
* ENDIF. "z001fh
*{ INSERT D91K998912 1
*
*********************************** GTS End D91K997989
*} INSERT
PERFORM get_marc. ""z001fh
*{ INSERT D91K998912 2
**
******************************* GTS Begin D91K997989
* "clear values from R/3
clear: w_pstawn, w_alnum, w_embgr.
* "clear tables and structures
CLEAR: wa_lt_obj_doc, wa_HTS, wa_ECCN, wa_LICTY.
REFRESH: LT_OBJ_DOC, LT_ECCN, LT_HTS, LT_LICTY.
**** build document sales order
*** wa_lt_obj_doc-vbeln = VBDKR-VBELN_VAUF.
*** wa_lt_obj_doc-posnr = VBDPR-POSNR_VAUF.
* build document delivery
wa_lt_obj_doc-vbeln = VBDPR-VBELN_VL.
wa_lt_obj_doc-posnr = VBDPR-POSNR_VL.
append wa_lt_obj_doc to LT_OBJ_DOC.
* call GTS RFC
** CALL FUNCTION 'Z_R3_DATA_GET_GTS'
** EXPORTING
** IV_LANGUAGE = sy-langu
** IS_OBJECT_SELECT = w_select
** CHANGING
** CT_DOCUMENT_NUMBER = LT_OBJ_DOC
** HTS = LT_HTS
** ECCN = LT_ECCN
** LICENCE_TYPE = LT_LICTY
** EXCEPTIONS
** ERROR_ALE_SETUP = 1
** COMM_SYST_FAILURE = 2
** NO_DATA_SELECTED = 3
** OTHERS = 4.
*
* Get HS code for departure country not cntry of origin
*
wa_refno = VBDPR-MATNR.
** wa_land1 = W_HERKL.
wa_land1 = TVST-ALAND.
CALL FUNCTION 'Z_R3_DATA_GET_GTS_HTS_VIA_MATR'
EXPORTING
IV_LAND1 = wa_land1
IV_REFNO = wa_refno
CHANGING
HTS = LT_HTS
EXCEPTIONS
ERROR_ALE_SETUP = 1
COMM_SYST_FAILURE = 2
NO_DATA_SELECTED = 3
OTHERS = 4.
IF SY-SUBRC = 0.
* Replace data from GTS
* w_pstawn = HTS
if LT_HTS[] is initial.
w_no_hts = 'X'. "if empty table flag message
else.
loop at LT_HTS into wa_HTS.
w_pstawn = wa_HTS-CCNGN.
w_cctext = wa_HTS-TEXT1.
if wa_HTS-CCNGN is initial.
"if blank value flag message
w_no_hts = 'X'.
endif.
endloop.
endif.
*** w_alnum = ECCN
** loop at LT_ECCN into wa_ECCN.
** w_alnum = wa_ECCN-CCNGN.
** endloop.
*** w_embgr = Licence type
** loop at LT_LICTY into wa_LICTY.
** w_embgr = wa_LICTY-LICTY.
** endloop.
*
ENDIF.
*********************************** GTS End D91K997989
*} INSERT
**End of ticket 3886 to pull the country of origin
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'PROTECT'.
*-- begin changes by DLoucks on Sep 20/99 for D11K922038
IF vbdkr-waerk = 'JPY'.
zheadfi-zmenge6 = zheadfi-zmenge6 * 100.
zheadfi-ztotal = zheadfi-ztotal * 100.
ENDIF.
IF w_print_curr_sign = 'N'. "D11k961350
CLEAR komvd-drukz. "D11k961350
ENDIF. " W_PRINT_CURR_SIGN = 'N'. "D11k961350
*-- end changes by DLoucks on Sep 20/99 for D11K922038
IF vbdpr-matnr >< 'S203'. "Ticket# 020261
* Begin of Add. Valerie Toh. 04111998
item_no = item_no + 1.
* End of Add. Valerie Toh. 04111998
* Madhu Vanam D11K976811
IF vbdkr-waerk = 'TWD'.
CALL FUNCTION 'BAPI_CURRENCY_CONV_TO_EXTERNAL'
EXPORTING
currency = vbdkr-waerk
amount_internal = zheadfi-ztotal
IMPORTING
amount_external = temp_zmenge6
EXCEPTIONS
OTHERS = 1.
MOVE temp_zmenge6 TO zheadfi-ztotal.
CALL FUNCTION 'BAPI_CURRENCY_CONV_TO_EXTERNAL'
EXPORTING
currency = vbdkr-waerk
amount_internal = zheadfi-zmenge6
IMPORTING
amount_external = temp_zmenge6
EXCEPTIONS
OTHERS = 1.
MOVE temp_zmenge6 TO zheadfi-zmenge6.
ENDIF.
* Madhu Vanam D11K976811
** this line for Unit proce
da = VBDPR-FKIMG.
dat = da.
UNIT_PRICE = VBDPR-NETWR / DAT.
** End of line for Unit proce
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE'.
ENDIF. "Ticket# 020261
IF tvbdpr-charg NE space.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_LINE_BATCH'
EXCEPTIONS
OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDIF.
PERFORM item_characteristics_print.
* perform item_serial_no_print. "Case# 17610 on hold
* refer to ticket 19951 & 1858 not to print components in Proforma.
CALL FUNCTION 'CONTROL_FORM'
EXPORTING
command = 'ENDPROTECT'.
ENDIF.
**End of code added by Andersen Consulting for Ticket 1858
PERFORM item_text_print.
PERFORM different_consignee.
PERFORM different_order_no.
PERFORM different_delivery_no.
PERFORM different_extern_no.
PERFORM different_purchase_order_no.
PERFORM different_reference_no.
*UNIT_PRICE = VBDPR-NETWR / VBDPR-FKIMG.
*TOTAL = TOTAL + ZHEADFI-ZMENGE6.
TOTAL = TOTAL + UNIT_PRICE.
MOVE: TOTAL TO TOTAL1.
CONDENSE TOTAL1 NO-GAPS.
DELETE TVBDPR.
ENDLOOP. " AT TVBDPR
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.
*** Added by Ramesh
CALL FUNCTION 'WRITE_FORM' "Deactivate Header
EXPORTING element = 'SUB_TOTAL'
window = 'MAIN'
* function = ''
* type = 'TOP'
EXCEPTIONS OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
*** Added by Ramesh
CALL FUNCTION 'WRITE_FORM' "Deactivate Header
EXPORTING element = 'FOOTER_TEXT'
window = 'MAIN'
* function = ''
* type = 'TOP'
EXCEPTIONS OTHERS = 1.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
CLEAR: TOTAL,TOTAL1,HIGH,HEIGHT,DAT,DA,UNIT_PRICE.
ENDFORM. "ITEM_PRINT.
*---------------------------------------------------------------------*
* FORM ITEM_TEXT_PRINT *
*---------------------------------------------------------------------*
* Printout of the item texts *
*---------------------------------------------------------------------*
FORM item_text_print.
vbdpr-tdname+0(10) = vbdpr-vbeln_vauf.
vbdpr-tdname+10(6) = vbdpr-posnr_vauf.
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 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. "PROTOCOL_UPDATE
*---------------------------------------------------------------------*
* FORM REFERENCE_NUMBER *
*---------------------------------------------------------------------*
* Printing of the reference numbers *
*---------------------------------------------------------------------*
FORM reference_number.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'REFERENCE_NUMBER'
window = 'REFNUMB'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. "REFERENCE_NUMBER
*---------------------------------------------------------------------*
* FORM SENDER *
*---------------------------------------------------------------------*
* This routine determines the address of the sender (Table VKO) *
*---------------------------------------------------------------------*
FORM sender.
SELECT SINGLE * FROM tvko WHERE vkorg = vbdkr-vkorg.
IF sy-subrc NE 0.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'TVKO'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
EXIT.
ENDIF.
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-010704
* SELECT SINGLE * FROM SADR WHERE ADRNR = TVKO-ADRNR
* AND NATIO = SPACE.
CLEAR : temp,
adrc,
sadr.
MOVE:
tvko-adrnr TO temp-addrnumber,
space TO temp-nation.
CALL FUNCTION 'ADDR_GET'
EXPORTING
address_selection = temp
* ADDRESS_GROUP =
* READ_SADR_ONLY = ' '
* READ_TEXTS = ' '
IMPORTING
address_value = adrc
* ADDRESS_ADDITIONAL_INFO =
* RETURNCODE =
* ADDRESS_TEXT =
sadr = sadr
* TABLES
* ADDRESS_GROUPS =
* ERROR_TABLE =
* VERSIONS =
EXCEPTIONS
parameter_error = 1
address_not_exist = 2
version_not_exist = 3
internal_error = 4
OTHERS = 5.
.
IF sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'SADR'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
vbdkr-sland = sadr-land1.
* IF SY-SUBRC NE 0.
* SYST-MSGID = 'VN'.
* SYST-MSGNO = '203'.
* SYST-MSGTY = 'E'.
* SYST-MSGV1 = 'SADR'.
* SYST-MSGV2 = SYST-SUBRC.
* PERFORM PROTOCOL_UPDATE.
* ENDIF.
*4.7 Upgrade End of Change TIWARIV1-D91K995965-010704
* Interne Verrechnung: Adresse des Buchungskreises lesen
IF vbdkr-vbtyp CA '56'.
CLEAR t001g.
SELECT SINGLE * FROM t001g WHERE bukrs = vbdkr-bukrs
AND programm EQ sy-repid
AND txtid EQ 'SD'.
ENDIF.
ENDFORM. "SENDER
*&---------------------------------------------------------------------*
*& Form HEADER_CONSGNEE
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
FORM header_consgnee.
IF vbdkr-name1 NE vbdkr-name1_we OR
vbdkr-name2 NE vbdkr-name2_we OR
vbdkr-name3 NE vbdkr-name3_we OR
vbdkr-name4 NE vbdkr-name4_we .
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'HEADER_CONSGNEE'
window = 'CONSGNEE'
EXCEPTIONS
element = 1
window = 2.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'HEADER_CONSGNEE'
window = 'INFO1'
EXCEPTIONS
element = 1
window = 2.
ENDIF.
ENDFORM. " HEADER_CONSGNEE
*&---------------------------------------------------------------------*
*& Form DIFFERENT_REFERENCE_NO
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
FORM different_reference_no.
CHECK vbdkr-vbtyp CA 'OP'.
CHECK vbdkr-vbeln_vg2 NE vbdpr-vbeln_vg2.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'ITEM_REFERENCE_NO'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. " DIFFERENT_REFERENCE_NO
*&---------------------------------------------------------------------*
*& Form HEADER_DATA_PRINT
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
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.
ENDFORM. " HEADER_DATA_PRINT
*&---------------------------------------------------------------------*
*& Form GET_DATA_ESR
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM get_data_esr.
CALL FUNCTION 'SD_ESR_GET_DATA'
EXPORTING
vbdkr_bukrs = vbdkr-bukrs
vbdkr_vkorg = vbdkr-vkorg
komk_fkwrt = komk-fkwrt
vbdkr_vbeln = vbdkr-vbeln
vbdkr_kunrg = vbdkr-kunrg
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-012804- VBDKR_WAERK IS
*mandatory
vbdkr_waerk = vbdkr_waerk
*4.7 Upgrade End of Change TIWARIV1-D91K995965-012804
CHANGING
ivbdre = vbdre
EXCEPTIONS
t049e_no_entry = 1
t001_no_entry = 2
bnka_no_entry = 3
sadr_no_entry = 4
fkwrt_not_valid = 5
esr_digits_to_check_not_valid = 6
esr_check_method_not_valid = 7
OTHERS = 8.
IF sy-subrc NE 0.
retcode = sy-subrc.
PERFORM protocol_update.
ENDIF.
ENDFORM. " GET_DATA_ESR
*----------------------------------------------------------------------*
* Form GET_DATA_ITALY
*----------------------------------------------------------------------*
* *
FORM get_data_italy USING proc_screen.
CLEAR konh.
CLEAR tlic.
LOOP AT tkomv WHERE koaid = 'D'
AND kntyp ='+'.
SELECT SINGLE * FROM konh WHERE knumh = tkomv-knumh.
IF sy-subrc EQ 0.
IF NOT konh-licno IS INITIAL AND NOT konh-licdt IS INITIAL.
SELECT SINGLE * FROM tlic WHERE licno = konh-licno.
IF sy-subrc EQ 0.
IF NOT tlic-prnum_nr IS INITIAL AND
NOT tlic-prnum_dt IS INITIAL.
MOVE:
konh-licno TO vbdkr-licno,
konh-licdt TO vbdkr-licdt.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
IF vbdkr-licno IS INITIAL OR
vbdkr-licdt IS INITIAL OR
tlic-prnum_nr IS INITIAL OR
tlic-prnum_dt IS INITIAL.
IF proc_screen = space.
retcode = 3.
syst-msgno = '205'.
syst-msgid = 'VN'.
syst-msgty = 'I'.
PERFORM protocol_update.
ELSE.
MESSAGE i205.
ENDIF.
ENDIF.
EXIT.
ENDLOOP.
ENDFORM. " get_data_italy
*&---------------------------------------------------------------------*
*& Form START_FORM
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
FORM start_form.
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-010804- added(8)
DATA : startseite(8) TYPE c VALUE 'FIRSTBSR'.
*4.7 Upgrade End of Change TIWARIV1-D91K995965-010804
DATA : sprache LIKE sy-langu.
IF vbdre-verfa = '04' OR vbdre-verfa = '08'.
CALL FUNCTION 'START_FORM'
EXPORTING
* ARCHIVE_INDEX = ' '
* FORM = ' '
* LANGUAGE = ' '
startpage = startseite
* PROGRAM = ' '
IMPORTING
language = sprache
EXCEPTIONS
form = 1
format = 2
unended = 3
unopened = 4
unused = 5
OTHERS = 6.
IF sy-subrc NE 0.
retcode = sy-subrc.
PERFORM protocol_update.
ENDIF.
ENDIF.
ENDFORM. " START_OPEN
*&---------------------------------------------------------------------*
*& Form TAX_TEXT_PRINT
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
FORM tax_text_print.
CALL FUNCTION 'WRITE_FORM'
EXPORTING
element = 'TAX_TEXT'
EXCEPTIONS
element = 1
window = 2.
IF sy-subrc NE 0.
PERFORM protocol_update.
ENDIF.
ENDFORM. " TAX_TEXT_PRINT
**************************************************************** "Z1XDSL
* SUBROUTINES OF ENTRY_CH "Z1XDSL
**************************************************************** "Z1XDSL
"Z1XDSL
*---------------------------------------------------------------------*
* FORM HEADER_CH *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM header_ch. "Z1XDSL
CLEAR print_local_curr_ch. "Z1XDSL
* Hauswährung <> Belegwährung ? "Z1XDSL
SELECT SINGLE * FROM t001 WHERE bukrs EQ vbdkr-bukrs. "Z1XDSL
CHECK sy-subrc = 0. "Z1XDSL
CHECK t001-waers <> vbdkr-waerk. "Z1XDSL
MOVE 'X' TO print_local_curr_ch. "Z1XDSL
REFRESH komvdk_ch. "Z1XDSL
LOOP AT hkomvd WHERE koaid = 'D'. "Z1XDSL
CLEAR komvdk_ch. "Z1XDSL
CALL FUNCTION 'CONVERT_TO_LOCAL_CURRENCY' "Z1XDSL
"Z1XDSL
"Z1XDSL
EXPORTING "Z1XDSL
date = vbdkr-fkdat "Z1XDSL
foreign_amount = hkomvd-kwert "Z1XDSL
foreign_currency = vbdkr-waerk "Z1XDSL
local_currency = t001-waers "Z1XDSL
rate = vbdkr-kurrf "Z1XDSL
IMPORTING "Z1XDSL
local_amount = komvdk_ch-kwert "Z1XDSL
EXCEPTIONS "Z1XDSL
no_rate_found = 1 "Z1XDSL
overflow = 2 "Z1XDSL
no_factors_found = 3 "Z1XDSL
no_spread_found = 4 "Z1XDSL
OTHERS = 5. "Z1XDSL
CHECK sy-subrc = 0. "Z1XDSL
MOVE: t001-waers TO komvdk_ch-awein, "Z1XDSL
t001-waers TO komvdk_ch-awei1, "Z1XDSL
hkomvd-vtext TO komvdk_ch-vtext, "Z1XDSL
vbdkr-kurrf TO hkomvd-kkurs. "Z1XDSL
APPEND komvdk_ch. "Z1XDSL
ENDLOOP. "Z1XDSL
ENDFORM. "Z1XDSL
"Z1XDSL
*---------------------------------------------------------------------*
* FORM ITEM_CH *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM item_ch. "Z1XDSL
CHECK print_local_curr_ch EQ 'X'. "Z1XDSL
REFRESH komvdp_ch. "Z1XDSL
* Suche die Steuerkonditionen der Position "Z1XDSL
* und rechne Hauswährung aus. "Z1XDSL
LOOP AT tkomvd WHERE koaid = 'D'. "Z1XDSL
CLEAR komvdp_ch. "Z1XDSL
CALL FUNCTION 'CONVERT_TO_LOCAL_CURRENCY' "Z1XDSL
EXPORTING "Z1XDSL
date = vbdkr-fkdat "Z1XDSL
foreign_amount = tkomvd-kwert "Z1XDSL
foreign_currency = vbdkr-waerk "Z1XDSL
local_currency = t001-waers "Z1XDSL
rate = vbdkr-kurrf "Z1XDSL
IMPORTING "Z1XDSL
local_amount = komvdp_ch-kwert "Z1XDSL
EXCEPTIONS "Z1XDSL
no_rate_found = 1 "Z1XDSL
overflow = 2 "Z1XDSL
no_factors_found = 3 "Z1XDSL
no_spread_found = 4 "Z1XDSL
OTHERS = 5. "Z1XDSL
CHECK sy-subrc = 0. "Z1XDSL
MOVE: t001-waers TO komvdp_ch-awein, "Z1XDSL
t001-waers TO komvdp_ch-awei1, "Z1XDSL
tkomvd-vtext TO komvdp_ch-vtext, "Z1XDSL
vbdkr-kurrf TO komvdp_ch-kkurs. "Z1XDSL
APPEND komvdp_ch. "Z1XDSL
ENDLOOP. "Z1XDSL
ENDFORM. "Z1XDSL
"Z1XDSL
*---------------------------------------------------------------------*
* FORM ITEM_PRINT_CH *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM item_print_ch. "Z1XDSL
LOOP AT komvdp_ch. "Z1XDSL
komvd = komvdp_ch. "Z1XDSL
IF print_mwskz EQ space. "Z1XDSL
CLEAR komvd-mwskz. "Z1XDSL
"Z1XDSL
"Z1XDSL
ENDIF. "Z1XDSL
CALL FUNCTION 'WRITE_FORM' "Z1XDSL
EXPORTING "Z1XDSL
element = 'ITEM_LINE_TAX_HAUSWAEHRUNG'. "Z1XDSL
ENDLOOP. "Z1XDSL
ENDFORM. "Z1XDSL
"Z1XDSL
*---------------------------------------------------------------------*
* FORM HEADER_PRINT_CH *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
FORM header_print_ch. "Z1XDSL
LOOP AT komvdk_ch. "Z1XDSL
komvd = komvdk_ch. "Z1XDSL
IF print_mwskz = space. "Z1XDSL
CLEAR komvd-mwskz. "Z1XDSL
ENDIF. "Z1XDSL
CALL FUNCTION 'WRITE_FORM' "Z1XDSL
EXPORTING "Z1XDSL
element = 'SUM_LINE_TAX_HAUSWAEHRUNG'. "Z1XDSL
ENDLOOP. "Z1XDSL
ENDFORM. "Z1XDSL
"Z1XDSL
* end changes for upgrade from 30f to 31h dloucks "Z1XDSL
**Begin of Added to Invoice by Andersen Consulting**********************
*&---------------------------------------------------------------------*
*& Form GET_PARTNER *
*& Get Ship-To and Bill-To Partner Functions from VBPA *
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
FORM get_partner.
* Start of insert - D81K922065
* Get the Z6 Partner (Country of Ultimate desi.)
SELECT SINGLE kunnr INTO v_z6_kunnr FROM vbpa
WHERE vbeln = vbdkr-vbeln_vauf
AND posnr = '000000'
AND parvw = 'Z6'.
* End of insert - D81K922065
*Get Bill-To specific information from Sales Doc Header "D10K903006
* SELECT SINGLE * FROM vbpa WHERE vbeln = vbdkr-vbeln_vauf "D10K902123
* Get BILL-TO from Invoice "D81K922429
SELECT SINGLE * FROM vbpa WHERE vbeln = vbdkr-vbeln "D81K922429
AND posnr = '000000'
AND parvw = 'RE'.
IF vbpa-adrnr IS INITIAL. "D10K902123
SELECT SINGLE * FROM kna1 WHERE kunnr = vbpa-kunnr. "vbdkr-kunrg.
ELSE. "D10K902123
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-010804
* SELECT SINGLE NAME1 NAME2 NAME3 NAME4 "D10K902123
* PFACH PSTL2 PFORT STRAS ORT01 ORT02 "D10K902123
* REGIO PSTLZ LAND1 INTO "D10K902123
* (VBDKR-NAME1, VBDKR-NAME2, "D10K902123
* VBDKR-NAME3, VBDKR-NAME4, "D10K902123
* VBDKR-PFACH, VBDKR-PSTL2, "D10K902123
* VBDKR-PFORT, VBDKR-STRAS, "D10K902123
* VBDKR-ORT01, VBDKR-ORT02, "D10K902123
* VBDKR-REGIO, VBDKR-PSTLZ, "D10K902123
* VBDKR-LAND1) FROM SADR "D10K902123
* WHERE ADRNR EQ VBPA-ADRNR "D10K902123
* AND NATIO EQ ' '. "D10K902123
CLEAR : temp,
adrc,
sadr.
MOVE:
vbpa-adrnr TO temp-addrnumber,
space TO temp-nation.
CALL FUNCTION 'ADDR_GET'
EXPORTING
address_selection = temp
* ADDRESS_GROUP =
* READ_SADR_ONLY = ' '
* READ_TEXTS = ' '
IMPORTING
address_value = adrc
* ADDRESS_ADDITIONAL_INFO =
* RETURNCODE =
* ADDRESS_TEXT =
sadr = sadr
* TABLES
* ADDRESS_GROUPS =
* ERROR_TABLE =
* VERSIONS =
EXCEPTIONS
parameter_error = 1
address_not_exist = 2
version_not_exist = 3
internal_error = 4
OTHERS = 5
.
IF sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'SADR'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
* MOVE-CORRESPONDING SADR TO VBDKR.
MOVE: sadr-name1 TO vbdkr-name1,
sadr-name2 TO vbdkr-name2,
sadr-name3 TO vbdkr-name3,
sadr-name4 TO vbdkr-name4,
sadr-pfach TO vbdkr-pfach,
sadr-pstl2 TO vbdkr-pstl2,
sadr-pfort TO vbdkr-pfort,
sadr-stras TO vbdkr-stras,
sadr-ort01 TO vbdkr-ort01,
sadr-ort02 TO vbdkr-ort02,
sadr-regio TO vbdkr-regio,
sadr-pstlz TO vbdkr-pstlz,
sadr-land1 TO vbdkr-land1.
*4.7 Upgrade End of Change TIWARIV1-D91K995965-010804
ENDIF. "D10K902123
*Get Ship-To specific information from Sales Doc Header
SELECT SINGLE * FROM vbpa WHERE vbeln = vbdkr-vbeln_vauf "D10K902123
AND posnr = '00000000' "D10K902123
AND parvw = 'WE'. "D10K902123
IF vbpa-adrnr IS INITIAL. "D10K902123
SELECT SINGLE name1 name2 name3 name4
pfach pstl2 pfort stras ort01 ort02
regio pstlz land1 INTO
(vbdpr-name1_we, vbdpr-name2_we,
vbdpr-name3_we, vbdpr-name4_we,
vbdpr-pfach_we, vbdpr-pstl2_we,
vbdpr-pfort_we, vbdpr-stras_we,
vbdpr-ort01_we, vbdpr-ort02_we,
vbdpr-regio_we, vbdpr-pstlz_we,
vbdpr-land1_we) FROM kna1
WHERE kunnr EQ vbpa-kunnr. "D10K902123
ELSE. "D10K902123
*4.7 Upgrade Begin of Change TIWARIV1-D91K995965-010804
* SELECT SINGLE NAME1 NAME2 NAME3 NAME4 "D10K902123
* PFACH PSTL2 PFORT STRAS ORT01 ORT02 "D10K902123
* REGIO PSTLZ LAND1 INTO "D10K902123
* (VBDPR-NAME1_WE, VBDPR-NAME2_WE, "D10K902123
* VBDPR-NAME3_WE, VBDPR-NAME4_WE, "D10K902123
* VBDPR-PFACH_WE, VBDPR-PSTL2_WE, "D10K902123
* VBDPR-PFORT_WE, VBDPR-STRAS_WE, "D10K902123
* VBDPR-ORT01_WE, VBDPR-ORT02_WE, "D10K902123
* VBDPR-REGIO_WE, VBDPR-PSTLZ_WE, "D10K902123
* VBDPR-LAND1_WE) FROM SADR "D10K902123
* WHERE ADRNR EQ VBPA-ADRNR "D10K902123
* AND NATIO EQ ' '. "D10K902123
CLEAR : temp,
adrc,
sadr.
MOVE:
vbpa-adrnr TO temp-addrnumber,
space TO temp-nation.
CALL FUNCTION 'ADDR_GET'
EXPORTING
address_selection = temp
* ADDRESS_GROUP =
* READ_SADR_ONLY = ' '
* READ_TEXTS = ' '
IMPORTING
address_value = adrc
* ADDRESS_ADDITIONAL_INFO =
* RETURNCODE =
* ADDRESS_TEXT =
sadr = sadr
* TABLES
* ADDRESS_GROUPS =
* ERROR_TABLE =
* VERSIONS =
EXCEPTIONS
parameter_error = 1
address_not_exist = 2
version_not_exist = 3
internal_error = 4
OTHERS = 5
.
IF sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
syst-msgid = 'VN'.
syst-msgno = '203'.
syst-msgty = 'E'.
syst-msgv1 = 'SADR'.
syst-msgv2 = syst-subrc.
PERFORM protocol_update.
ENDIF.
* MOVE-CORRESPONDING SADR TO VBDPR.
MOVE: sadr-name1 TO vbdpr-name1_we,
sadr-name2 TO vbdpr-name2_we,
sadr-name3 TO vbdpr-name3_we,
sadr-name4 TO vbdpr-name4_we,
sadr-pfach TO vbdpr-pfach_we,
sadr-pstl2 TO vbdpr-pstl2_we,
sadr-pfort TO vbdpr-pfort_we,
sadr-stras TO vbdpr-stras_we,
sadr-ort01 TO vbdpr-ort01_we,
sadr-ort02 TO vbdpr-ort02_we,
sadr-regio TO vbdpr-regio_we,
sadr-pstlz TO vbdpr-pstlz_we,
sadr-land1 TO vbdpr-land1_we.
*4.7 Upgrade End of Change TIWARIV1-D91K995965-010804
ENDIF. "D10K902123
SELECT SINGLE * FROM vbak "Select for Created By
WHERE vbeln = vbdpr-vbeln_vauf.
SELECT SINGLE * FROM likp "A15K901434
WHERE vbeln = vbdpr-vbeln_vl. "A15K901434
*{ INSERT D91K998930 1
** get departure country
SELECT single ALAND INTO TVST-ALAND
from TVST where VSTEL = LIKP-VSTEL.
*} INSERT
CONCATENATE 'Z_PRIORITY_' likp-lprio INTO zshead-priority.
*Route Texts
SELECT SINGLE * FROM tvrot "A15K901434
WHERE spras = sy-langu "A15K901434
AND route = likp-route. "A15K901434
SELECT SINGLE * FROM likp "SD Delivery Header Data
WHERE vbeln = vbdpr-vbeln_vl.
IF likp-lfart = internal. "Bill type NLCC
* Move text 'Intercompany' to the Purchase Order No. field.
MOVE text-001 TO vbdkr-bstnk. "PO number at top of pg
SELECT SINGLE * FROM kna1 WHERE kunnr = vbdkr-kunag.
MOVE-CORRESPONDING kna1 TO interco_kna1.
* Move the following INTERCO_KNA1 fields to corresponding VBDKR fields
* for standard layout set printing.
MOVE: interco_kna1-name1 TO vbdpr-name1_we, "Name 1
interco_kna1-name2 TO vbdpr-name2_we, "Name 2
interco_kna1-name3 TO vbdpr-name3_we, "Name 3
interco_kna1-stras TO vbdpr-stras_we, "Street
interco_kna1-pfach TO vbdpr-pfach_we, "PO Box
interco_kna1-pstl2 TO vbdpr-pstl2_we, "PO Code
interco_kna1-pfort TO vbdpr-pfort_we, "PO City
interco_kna1-pstlz TO vbdpr-pstlz_we, "Postal code
interco_kna1-ort01 TO vbdpr-ort01_we, "City
interco_kna1-regio TO vbdpr-regio_we, "Region
interco_kna1-land1 TO vbdpr-land1_we. "Country
*Also change the bill-to information to key off VBDKR-KUNRE for Interco.
*PO's
SELECT SINGLE * FROM kna1 WHERE kunnr = vbdkr-kunre.
MOVE-CORRESPONDING kna1 TO interco_kna1.
* Move the following INTERCO_KNA1 fields to corresponding VBDKR fields
* for standard layout set printing. This data is for the Bill-to Cust
MOVE: interco_kna1-name1 TO vbdkr-name1, "Name 1
interco_kna1-name2 TO vbdkr-name2, "Name 2
interco_kna1-name3 TO vbdkr-name3, "Name 3
interco_kna1-stras TO vbdkr-stras, "Street
interco_kna1-pfach TO vbdkr-pfach, "PO Box
interco_kna1-pstl2 TO vbdkr-pstl2, "PO Code
interco_kna1-pfort TO vbdkr-pfort, "PO City
interco_kna1-pstlz TO vbdkr-pstlz, "Postal code
interco_kna1-ort01 TO vbdkr-ort01, "City
interco_kna1-regio TO vbdkr-regio, "Region
interco_kna1-land1 TO vbdkr-land1. "Country
ENDIF. "Billing type <> NLCC
PERFORM reassign_shipto_address. "D11K961658
*GoldstJL D11K903239 Jun.08.1998 End
ENDFORM. " GET_PARTNER "A15K901434
* D11K931342 remove serial number
* Remove Form GET_ITEM_SERIALS
*&---------------------------------------------------------------------*
*& Form CURRENCY_FIELD_CONVERSION Jun.04.1998 "D11K903205
*&---------------------------------------------------------------------*
* This form is called to create a currency field symbol for
* use in the END_VALUES element of the Z012 window.
*----------------------------------------------------------------------*
FORM currency_field_conversion.
CLEAR a_out4. "D11K961350
a_codeid = iso_code. "ISO SAP code page 1100
MOVE a_charno TO trick_i. "Character number
trick_f-trick_x1 = trick_i DIV 256.
trick_f-trick_x2 = trick_i MOD 256.
* Converts code number into code symbol. To see a list of codes, go to
* transaction SPAD and look at character set 1100 which is being used
* here. This functionality was taken from program RSPOCP02.
CALL 'C_CHAR_CODE_CONV'
ID 'INBUFF' FIELD trick_f
ID 'INCODE' FIELD '4000'
ID 'OUTBUFF' FIELD a_out4
ID 'OUTCODE' FIELD a_codeid
ID 'FAST' FIELD ' '
ID 'CSUBST' FIELD ' ' " never replace by '#'
ID 'OUTUSED' FIELD l_outused
ID 'RC' FIELD l_rc
ID 'ERRMSG' FIELD l_errmsg.
* If the symbol is found, move it to a temp field used for layout set
* printing.
IF sy-subrc = 0.
MOVE a_out4 TO komvd-drukz.
ENDIF.
ENDFORM. " CURRENCY_FIELD_CONVERSION
*&---------------------------------------------------------------------*
*& Form EXCHANGE_RATE_PRN
*&---------------------------------------------------------------------*
* Added by Valerie Toh / Siemens Business Service 05/11/1998
* for printing Exchange rate in SGD.
*----------------------------------------------------------------------*
FORM exchange_rate_prn.
* read Exchange Rate for the given Billing Date and USD to SGD
CALL FUNCTION 'READ_EXCHANGE_RATE'
EXPORTING
date = ex_rtdt
foreign_currency = curr_cd
local_currency = 'SGD'
type_of_rate = 'M'
IMPORTING
exchange_rate = ex_rate
EXCEPTIONS
no_rate_found = 1
no_factors_found = 2
no_spread_found = 3
OTHERS = 4.
gst_amt = fgst_amt * ex_rate.
tgst_amt = gst_amt.
tex_rate = ex_rate.
CONDENSE tgst_amt.
CONDENSE tex_rate.
IF curr_cd NE 'SGD'.
CALL FUNCTION 'TEXT_SYMBOL_SETVALUE'
EXPORTING
name = '&ex_rate&'
value = tex_rate
EXCEPTIONS
OTHERS = 1.
ELSE.
tgst_amt = '0.00'.
CALL FUNCTION 'TEXT_SYMBOL_SETVALUE'
EXPORTING
name = '&gst_amt&'
value = tgst_amt
EXCEPTIONS
OTHERS = 1.
ENDIF.
ENDFORM. " EXCHANGE_RATE_PRN
*&---------------------------------------------------------------------*
*& Form GET_MARC
*&---------------------------------------------------------------------*
* Get country of origin. If no value found, default to SG
*----------------------------------------------------------------------*
FORM get_marc.
CLEAR: w_herkl.
SELECT SINGLE werks INTO w_werks FROM lips
WHERE vbeln = tvbdpr-vbeln_vl
* AND POSNR = TVBDPR-POSNR.
AND posnr = tvbdpr-posnr_vl. " D81K912248
SELECT SINGLE herkl INTO (marc-herkl) "z001fh
FROM marc "z001fh
WHERE matnr = vbdpr-matnr "z001fh
AND werks = w_werks. "z001fh
"z001fh
IF sy-subrc = 0. "z001fh
w_herkl = marc-herkl. "z001fh
ENDIF. "z001fh
IF marc-herkl IS INITIAL. "z001fh
w_herkl = 'SG'. "z001fh
ENDIF. "z001fh
"z001fh
ENDFORM. " GET_MARC
* "D11K961658 add Form REASSIGN_SHIPTO_ADDRESS
* reassign ship to address for intercompany purchase orders
*&---------------------------------------------------------------------*
*& Form REASSIGN_SHIPTO_ADDRESS
*&---------------------------------------------------------------------*
* Look up ZICP1 table with PO plant and storage location *
* to retrieve ship to customer address *
*----------------------------------------------------------------------*
FORM reassign_shipto_address.
DATA: w_kunnr LIKE kna1-kunnr.
DATA: w_vbeln LIKE vbpa-vbeln.
CHECK NOT ekpo-werks IS INITIAL AND NOT ekpo-lgort IS INITIAL.
SELECT SINGLE kunnr INTO w_kunnr FROM zicp1
WHERE werks = ekpo-werks
AND lgort = ekpo-lgort.
SELECT SINGLE name1 name2 name3 name4
pfach pstl2 ort02
stras ort01 regio pstlz land1
FROM kna1
INTO (vbdpr-name1_we,
vbdpr-name2_we,
vbdpr-name3_we,
vbdpr-name4_we,
vbdpr-pfort_we, vbdpr-pstl2_we, vbdpr-ort02_we,
vbdpr-stras_we, vbdpr-ort01_we, vbdpr-regio_we,
vbdpr-pstlz_we, vbdpr-land1_we)
WHERE kunnr = w_kunnr.
ENDFORM. " REASSIGN_SHIPTO_ADDRESS.
*&---------------------------------------------------------------------*
*& Form get_commodity_code
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM get_commodity_code .
* Find the commodity code only for non-components and non-batced items
CHECK tvbdpr-uepos IS INITIAL.
SELECT SINGLE werks
FROM lips
INTO (v_werks)
WHERE posnr EQ tvbdpr-posnr_vl
AND vbeln EQ tvbdpr-vbeln_vl
AND matnr EQ tvbdpr-matnr.
* Check if the material belong to SG31
CHECK v_werks = c_sg31.
CLEAR v_sg31_commcode.
* Get the Commodity code
SELECT SINGLE stawn INTO (v_stawn)
FROM marc
WHERE matnr = vbdpr-matnr
AND werks = c_sg31.
IF v_stawn <> ' '.
CONCATENATE v_stawn+0(4) c_dec v_stawn+4(2) c_dec
v_stawn+6(4) INTO v_sg31_commcode.
ELSE.
v_sg31_commcode = ' '.
ENDIF.
* Added this line to clear the variable explicitly "D81K911962
CLEAR v_sg31_commcode_desc. "D81K911962
* Get Commodity Code description for US
SELECT SINGLE text1 FROM t604t INTO (v_sg31_commcode_desc)
WHERE spras = sy-langu
AND land1 = c_sg
AND stawn = v_stawn.
ENDFORM. " get_commodity_code
**********************************************************************
* Starting Scripts in FORMS
**********************************************************************
FORM DISP_CNT_TEXT TABLES IN_PAR STRUCTURE ITCSY
OUT_PAR STRUCTURE ITCSY.
DATA: TEXT TYPE LANDX.
DATA: LAND TYPE LAND1.
READ TABLE IN_PAR WITH KEY 'VBDPR-WERKS'.
CHECK SY-SUBRC = 0.
*LAND = IN_PAR-VALUE.
SELECT SINGLE LAND1 INTO LAND FROM T001W
WHERE WERKS = IN_PAR-VALUE.
SELECT SINGLE LANDX INTO TEXT FROM T005T
WHERE SPRAS = 'EN' AND
LAND1 = LAND.
READ TABLE OUT_PAR WITH KEY 'CNT_TEXT'.
CHECK SY-SUBRC = 0.
OUT_PAR-VALUE = TEXT.
MODIFY OUT_PAR INDEX SY-TABIX.
ENDFORM.
**********************************************************************
FORM SELL_ADDRESS TABLES IN_PAR STRUCTURE ITCSY
OUT_PAR STRUCTURE ITCSY.
DATA: LAND TYPE LAND1.
DATA: NAME1 TYPE AD_NAME1,
NAME2 TYPE AD_NAME2,
NAME3 TYPE AD_NAME3,
NAME4 TYPE AD_NAME4,
STREET1 TYPE AD_STREET,
POBOX1 TYPE AD_PSTCD1,
POBOX2 TYPE AD_PSTCD1,
POBOX3 TYPE AD_PSTCD1,
POSTCODE1 TYPE AD_POBX,
CITY1 TYPE AD_CITY1,
CITY2 TYPE AD_CITY1,
REGION1 TYPE REGIO,
COUNTRY1 TYPE AD_MC_CITY.
* FROMCOUNTRY TYPE
DATA: ADDRESS_NO TYPE ADRNR.
READ TABLE IN_PAR WITH KEY 'VBDPR-WERKS'.
CHECK SY-SUBRC = 0.
SELECT SINGLE ADRNR INTO ADDRESS_NO FROM T001W
WHERE WERKS = IN_PAR-VALUE.
SELECT SINGLE LAND1 INTO LAND FROM T001W
WHERE WERKS = IN_PAR-VALUE.
SELECT SINGLE LANDX INTO COUNTRY1 FROM T005T
WHERE SPRAS = 'EN' AND
LAND1 = LAND.
SELECT SINGLE NAME1
NAME2
NAME3
NAME4
CITY1
CITY2
POST_CODE1
POST_CODE2
POST_CODE3
PO_BOX
STREET
* MC_CITY1
REGION
INTO
(NAME1,
NAME2,
NAME3,
NAME4,
CITY1,
CITY2,
POBOX1,
POBOX2,
POBOX3 ,
POSTCODE1,
STREET1 ,
* COUNTRY,
REGION1)
FROM ADRC
WHERE ADDRNUMBER = ADDRESS_NO.
READ TABLE OUT_PAR WITH KEY 'NAME1'.
CHECK SY-SUBRC = 0.
OUT_PAR-VALUE = NAME1.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'NAME2'.
OUT_PAR-VALUE = NAME2.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'NAME3'.
OUT_PAR-VALUE = NAME3.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'NAME4'.
OUT_PAR-VALUE = NAME4.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'CITY1'.
OUT_PAR-VALUE = CITY1.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'CITY2'.
OUT_PAR-VALUE = CITY2.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'POBOX1'.
OUT_PAR-VALUE = POBOX1.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'POBOX2'.
OUT_PAR-VALUE = POBOX2.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'POBOX3'.
OUT_PAR-VALUE = POBOX3.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'POSTCODE'.
OUT_PAR-VALUE = POSTCODE1.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'STREET'.
OUT_PAR-VALUE = STREET1.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'COUNTRY'.
OUT_PAR-VALUE = COUNTRY1.
MODIFY OUT_PAR INDEX SY-TABIX.
READ TABLE OUT_PAR WITH KEY 'REGION'.
OUT_PAR-VALUE = REGION1.
MODIFY OUT_PAR INDEX SY-TABIX.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
You can got transaction "NACE" & got ur specific application and locate the output type. goto the details of it and you can find the program in processing routines foldes.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hi,
You will get SD and MM related forms in TNAPR table FI related forms will be there in T001F table
TTFXP -Selection list of print programs will also be used for finding print program
For finding the print program of a smartform,TNAPR is the table name.
Ex:
PGNAM:SAPFM06P
SFORM:LB_BIL_INVOICE
TNAPR table Processing programs for output
Useful for output types.
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
For standard print program u cna check
http://help.sap.com/bp_autov1470/Auto_DE/HTML/PreconfSmartForms_EN_DE.htm
U check ur mail for sample code.
Regards
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
Hi Praveen,
Please check table TNAPR and field PGNAM for print program available including the smart form name.
Also you can check transaction NACE and click on output types button.
Hope this will help.
Regards,
Ferry Lianto
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
User | Count |
---|---|
93 | |
10 | |
10 | |
9 | |
9 | |
7 | |
6 | |
5 | |
5 | |
4 |
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.