function zfi_rfcfn_ruc.

*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(RUC) TYPE STCD1
*" EXPORTING
*" VALUE(RESULT) TYPE BAPIGSBOOL
*"----------------------------------------------------------------------
*&---------------------------------------------------------------------*
*& Desarrollador : Cesar Sanchez Saldaa IT & ERP Consulting *
*& Fecha : 26.06.2012 *
*& Id : CSS20120626 *
*& Ticket : *
*& Descripcin : - RFC para validar si ruc esta ya existe. *
*&---------------------------------------------------------------------*

select single lfa1~stcd1
into valor
from lfa1
where stcd1 = ruc.
if valor eq ''.
result = '1'.
else.
result = '0'.
endif.



endfunction.


function zfi_rfcfn_obtnrbancos.
*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(PAIS) TYPE BANKS
*" TABLES
*" BANCOS STRUCTURE ZBANKO
*"----------------------------------------------------------------------
*&---------------------------------------------------------------------*
*& Desarrollador : Cesar Sanchez Saldaa IT & ERP Consulting *
*& Fecha : 26.06.2012 *
*& Id : CSS20120626 *
*& Ticket : *
*& Descripcin : - RFC para para obtener el codigo y nombre de *
*& bancos`. *
*&---------------------------------------------------------------------*

if pais is initial.
select banks bankl banka into corresponding fields of table bancos from b
nka where loevm eq ' '.
else.
select banks bankl banka into corresponding fields of table bancos from bn
ka where banks = pais and loevm eq ' '.
endif.

endfunction.


function zfi_rfcfn_valruc.
*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(RUC) TYPE STCD1
*" VALUE(PAIS) TYPE LAND1_GP
*" VALUE(PERSFISICA) TYPE STKZN DEFAULT SPACE
*" VALUE(NIF2) TYPE STCD2 DEFAULT SPACE
*" VALUE(TIPNIF) TYPE J_1ATOID DEFAULT SPACE
*" VALUE(IVA) TYPE STKZU DEFAULT SPACE
*" VALUE(REGION) TYPE REGIO DEFAULT SPACE
*" EXPORTING
*" VALUE(RESULTADO) TYPE BAPIGSBOOL
*"----------------------------------------------------------------------
*&---------------------------------------------------------------------*
*& Desarrollador : Cesar Sanchez Saldaa IT & ERP Consulting *
*& Fecha : 28.06.2012 *
*& Id : CSS20120628 *
*& Ticket : *
*& Descripcin : - RFC para validar si ruc es correcto. *
*&---------------------------------------------------------------------*
check ruc ne space
or nif2 ne space.

* ------ Gltigen Landerschlssel eingegeben? --------------------------
select single * from t005 where land1 = pais.
if sy-subrc ne 0.
"MESSAGE e001 WITH PAIS RAISING not_valid.
result = 1.
endif.

* ------ Formalprfung von RUC ----------------------------------
if ruc ne space.
write 'Steuercode-1'(004) to fname.

call function 'FORMAT_CHECK'
exporting
i_checkrule = t005-prst1
i_checkfield = ruc
i_checklength = t005-lnst1
i_checkmask = ' '
i_fname = fname
exceptions
not_valid = 1.

if sy-subrc eq 1.
* MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
* WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4
* RAISING not_valid.
result = 1.
endif.

endif.

* ------ Formalprfung von NIF2 ----------------------------------
if nif2 ne space.
write 'Steuercode-2'(005) to fname.

call function 'FORMAT_CHECK'
exporting
i_checkrule = t005-prst2
i_checkfield = nif2
i_checklength = t005-lnst2
i_checkmask = ' '
i_fname = fname
exceptions
not_valid = 1.

if sy-subrc eq 1.
* MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
* WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4
* RAISING not_valid.
result = 1.
endif.

endif.

* ------ zustzliche Prfungen (falls Schalter gesetzt) ----------------
* CHECK t005-xprso NE space. " zustzliche Prfungen?
case t005-intca.
when 'BE'. " Belgien
perform check_taxcode_b using ruc nif2 iva.
when 'BG'. " Bulgaria
perform check_taxcode_bg using ruc
nif2
persfisica.
when 'BR'. " Brasilien
perform check_taxcode_bra using persfisica
ruc(14)
nif2.
when 'DK'. " Dnemark
perform check_taxcode_dk using nif2.
when 'ES'. " Spanien
perform check_taxcode_es using ruc.
when 'FR'. " Frankreich
perform check_taxcode_f using ruc.
when 'GR'. "Griechenland
perform check_taxcode_gr using nif2 persfisica.
when 'IT'. " Italien
perform check_taxcode_i using ruc nif2
region pais
persfisica.
when 'NO'. " Norwegen
perform check_taxcode_no using nif2.
when 'PT'. " Portugal
perform check_taxcode_p using ruc.
when 'AR'. " Argentinien
perform check_taxcode_ra using ruc
tipnif.
when 'SE'. " Schweden
perform check_taxcode_s using nif2.
when 'CL'. " Chile
perform check_taxcode_cl using ruc.
when 'PE'. " Peru
perform check_taxcode_pe using ruc persfisica.
when 'CO'. " Kolumbien
perform check_taxcode_co using ruc persfisica.
when 'MX'. " Mexiko
perform check_taxcode_mx using ruc persfisica.
when 'VE'. " Venezuela
perform check_taxcode_ve using ruc.
when 'HR'. " Kroatien
perform check_taxcode_hr using ruc nif2 persfisica.
when 'US'. " USA
perform check_taxcode_us using ruc nif2 persfisica.
when 'NL'. " Netherlands
perform check_taxcode_nl using ruc nif2.
when 'RS'. " SERBIA
perform check_taxcode_rs using ruc persfisica.

endcase.

if result eq 1.
resultado = 1.
else.
resultado = 0.
endif.
** Call BTE-Event 00003050 for PAIS specific check of STCD1-STCD4
* CALL FUNCTION 'OUTBOUND_CALL_00003050_E'
* EXPORTING
* i_intca = t005-intca
* PERSFISICA = PERSFISICA
* region = region
* IVA = IVA
* RUC = RUC
* NIF2 = NIF2
* TIPNIF = TIPNIF
* tax_code_3 = tax_code_3
* tax_code_4 = tax_code_4
* EXCEPTIONS
* not_valid = 1
* OTHERS = 2.
*
* IF sy-subrc <> 0.
* MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
* WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4
* RAISING not_valid.
* ENDIF.


endfunction.

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_HR *
* -------------------------------------------------------------------- *
* Prfung der Steuernummer Kroatien *
* -------------------------------------------------------------------- *
* RUC *
* PERSFISICA *
* -------------------------------------------------------------------- *
form check_taxcode_hr using
ruc like kna1_bf-stcd1
nif2 like kna1_bf-stcd2
persfisica like kna1_bf-stkzn.

data: l_length type i,
l_weights1(6) type c value '765432',
l_weights2(13) type c value '7654327654321',
l_weights3(7) type c value '8765432',
l_sum type i,
l_checkdigit type i,
l_taxcode1 like kna1_bf-stcd1,
l_taxcode2 like kna1_bf-stcd2.


l_length = strlen( ruc ).

* 'Company identification number' ist 7-stellig und das Flag 'Natrliche
* Person' ist ausgeschaltet
* 'Unique identification number of a citizen' ist 13-stellig und das
* Flag 'Natrliche Person' ist eingeschaltet
l_taxcode1 = ruc.
l_taxcode2 = nif2.

* 21/05/07
* Company Identification Number can also be of length 11 or 12
* in the format XXXXXXX-NNN or XXXXXXXX-NNN.
if l_length = 11.
if l_taxcode1+7(1) ne '-'.
* MESSAGE e129 RAISING not_valid.
result = 1.
else.
l_length = strlen( l_taxcode1(7) ).
endif.
elseif l_length = 12.
if l_taxcode1+8(1) ne '-'.
* MESSAGE e129 RAISING not_valid.
result = 1.
else.
l_length = strlen( l_taxcode1(8) ).
endif.
endif.

*01/03/04
*Changed because no check should happen, when stcd2 is filled and stcd1 is em
tpy.

if l_taxcode2 <> '' and l_taxcode1 = ''.
* don't check stcd1.
else.
if ( l_taxcode1(l_length) cn '1234567890').
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

case l_length.
when '7'. "// Company identification number
if persfisica is initial.
do 6 times.
l_sum = l_sum + ( l_taxcode1(1) * l_weights1(1) ).
shift l_taxcode1.
shift l_weights1.
enddo.
l_checkdigit = l_sum mod 11.
if l_checkdigit <> 0 and l_checkdigit <> 1. "note 647385
l_checkdigit = 11 - l_checkdigit.
else.
l_checkdigit = 0.
endif.
if l_checkdigit ne ruc+6(1). "// last digit
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

when '8'. "// Company identification number
if persfisica is initial.
do 7 times.
l_sum = l_sum + ( l_taxcode1(1) * l_weights3(1) ).
shift l_taxcode1.
shift l_weights3.
enddo.
l_checkdigit = l_sum mod 11.
if l_checkdigit <> 0 and l_checkdigit <> 1.
l_checkdigit = 11 - l_checkdigit.
else.
l_checkdigit = 0.
endif.
if l_checkdigit ne ruc+7(1). "// last digit
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.


when '13'. "// Unique identification number of citizen
if persfisica is initial.
* MESSAGE e129 RAISING not_valid.
result = 1.
else.
do 13 times.
l_sum = l_sum + ( l_taxcode1(1) * l_weights2(1) ).
shift l_taxcode1.
shift l_weights2.
enddo.
l_checkdigit = l_sum mod 11.
if l_checkdigit ne 0.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.

when others.
* MESSAGE e129 RAISING not_valid.
result = 1.
endcase.
endif.

endform. "check_taxcode_hr

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_GR *
* -------------------------------------------------------------------- *
* Prfung der Steuernummer Griechenland *
* -------------------------------------------------------------------- *
* NIF2 *
* -------------------------------------------------------------------- *
form check_taxcode_gr using
nif2 like kna1_bf-stcd2
persfisica like kna1_bf-stkzn.

data: check_number like kna1_bf-stcd2.
data: sum type i,
weight type i,
remainder type i,
check_digit type i.

* CHECK PERSFISICA IS INITIAL.

if nif2 <> space.
if nif2(9) cn '1234567890'.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.
check_number = nif2(8).

do 8 times.
weight = 2 ** ( 8 - sy-index + 1 ). "// 2^8, 2^7,...2^1
sum = sum + ( check_number(1) * weight ).
shift check_number.
enddo.

check_digit = nif2+8. "// Last digit
remainder = sum mod 11.
if remainder eq 10.
remainder = 0.
endif.

if check_digit ne remainder.
* MESSAGE e128 RAISING not_valid.
result = 1.
endif.
endif.

endform. "check_taxcode_gr

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_ALL_DIGITS *
* -------------------------------------------------------------------- *
* Alle Ziffern der Steuernummer 1 Frankreich (SIRET) prfen. *
* -------------------------------------------------------------------- *
* RUC *
* -------------------------------------------------------------------- *
form check_all_digits using
ruc like kna1_bf-stcd1.

data: cfield(2) type c,
refe1 type i,
refe2 type i,
refe3 type i,
savestcd1 like kna1_bf-stcd1.

if ruc cn '1234567890 '.
* MESSAGE e144 RAISING not_valid.
result = 1.
endif.
savestcd1 = ruc.
do 7 times.
refe1 = refe1 + savestcd1+13(1).
shift savestcd1 right.
refe3 = savestcd1+13(1).
refe3 = refe3 * 2.
if refe3 > 9.
cfield = refe3.
refe3 = cfield(1).
refe3 = refe3 + cfield+1(1).
endif.
refe2 = refe2 + refe3.
shift savestcd1 right.
enddo.
refe1 = refe2 + refe1.

*------- Vergleich auf Vielfaches von 10 -------------------------------
refe1 = refe1 mod 10.
if refe1 ne 0.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_all_digits

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_NINE_DIGITS *
* -------------------------------------------------------------------- *
* Den neunstelligen Teil der Steuernummer 1 Frankreich (SIREN) *
* prfen. *
* -------------------------------------------------------------------- *
* RUC
* -------------------------------------------------------------------- *
form check_nine_digits using
ruc like kna1_bf-stcd1.

data: cfield(2) type c,
refe1 type i,
refe2 type i,
refe3 type i,
savecode9(9) type c.

if ruc cn '1234567890 '.
* MESSAGE e144 RAISING not_valid.
result = 1.
endif.
savecode9 = ruc.
do 4 times.
refe1 = refe1 + savecode9+8(1).
shift savecode9 right.
refe3 = savecode9+8(1).
refe3 = refe3 * 2.
if refe3 > 9.
cfield = refe3.
refe3 = cfield(1).
refe3 = refe3 + cfield+1(1).
endif.
refe2 = refe2 + refe3.
shift savecode9 right.
enddo.
refe1 = refe2 + refe1 + savecode9+8(1).

*------- Vergleich auf Vielfaches von 10--------------------------------
refe1 = refe1 mod 10.
if refe1 ne 0.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_nine_digits

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_B *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 2 Belgien *
* -------------------------------------------------------------------- *
* NIF2 IVA. *
* -------------------------------------------------------------------- *
form check_taxcode_b using
ruc like kna1_bf-stcd1
nif2 like kna1_bf-stcd2
iva like kna1_bf-stkzu.

data: pfeld(11) type c, " zu prfende Daten
przif(2) type c, " Prfziffer
rest type i,
check_digit type i,
savestcd1 like kna1_bf-stcd1,
check_number like kna1_bf-stcd1,
savestcd2 like kna1_bf-stcd2, " Save-Feld
l_long_number type xfeld.


* Tax Code 1 ----------------------------------------------------------
if ruc ne space.
savestcd1 = ruc.
if savestcd1+1(9) cn '1234567890'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
if savestcd1(1) cn '01'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
check_number = savestcd1(8).
* ------ Ermittlung Prfziffer -----------------------------------------
rest = check_number mod 97.
check_digit = 97 - rest.
* ------ Prfziffer korrekt? -------------------------------------------
if check_digit <> savestcd1+8(2).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.

* Tax Code 2 -----------------------------------------------------------

if nif2 ne space.
savestcd2 = nif2.
if strlen( savestcd2 ) = 10. "new: tax no. with 10 digits
l_long_number = 'X'.
else.
l_long_number = space.
endif.

if l_long_number = space.
* CHECK savestcd2 CN '0 '.
check iva ne space.
if savestcd2(7) cn '0123456789 '.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.
else .
check iva ne space.
if savestcd2(8) cn '0123456789 '.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.
if savestcd2(1) cn '01'.
* MESSAGE e197 RAISING not_valid.
result = 1.
endif.

endif.
* ------ Prfziffer isolieren und Prffeld fllen ----------------------
if l_long_number = space.
pfeld = savestcd2(7).
przif = savestcd2+7(2).
check przif ne space.
pfeld = pfeld mod 97.
pfeld = 97 - pfeld.
condense pfeld no-gaps.
if pfeld < 10.
shift pfeld right.
pfeld(1) = '0'.
endif.
if pfeld = 0.
pfeld(2) = '97'.
endif.
else.
pfeld = savestcd2(8).
przif = savestcd2+8(2).
check przif ne space.
pfeld = pfeld mod 97.
pfeld = 97 - pfeld.
condense pfeld no-gaps.
if pfeld < 10.
shift pfeld right.
pfeld(1) = '0'.
endif.
if pfeld = 0.
pfeld(2) = '97'.
endif.
endif.
* ------ Vergleichen ---------------------------------------------------
if pfeld ne przif.
* MESSAGE e128 RAISING not_valid.
result = 1.
endif.
endif.
endform. "check_taxcode_b

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_COMPANIES *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 fr juristische Personen (Spanien) *
* -------------------------------------------------------------------- *
* RUC *
* -------------------------------------------------------------------- *
form check_taxcode_companies using
ruc like kna1_bf-stcd1.

data: check_char(1) type c, " TYPE C wegen TRANSLATE!
refe1 type i,
refe2 type i,
savecode like kna1_bf-stcd1,
savestcd1 like kna1_bf-stcd1,
umwandlung(20) type c value '1A2B3C4D5E6F7G8H9I0J'.

savestcd1 = ruc.
savecode = ruc.

* ------ Prfziffer bzw. Prfbuchstabe ermitteln -----------------------
shift savestcd1.
do 4 times.
refe2 = savestcd1(1) * 2.
if refe2 > 9.
refe2 = refe2 - 9.
endif.
refe1 = refe1 + refe2.
shift savestcd1 by 2 places.
enddo.
refe2 = savecode+2(1) + savecode+4(1) + savecode+6(1).
refe1 = refe1 + refe2.
refe2 = refe1 mod 10.
check_char = ( 20 - refe2 ) mod 10.

* ------ ggf. Ziffer in Buchstabe umwandeln ----------------------------
if savecode+8(1) co letters.
translate check_char using umwandlung.
endif.

* ------ Vergleichen mit Kontrollziffer bzw. -buchstabe (= 9. Stelle) --
if check_char ne savecode+8(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_companies

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_DK *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 2 Dnemark *
* -------------------------------------------------------------------- *
* NIF2 *
* IVA *
* -------------------------------------------------------------------- *
form check_taxcode_dk using
nif2 like kna1_bf-stcd2.

data: refe type i,
savestcd2 like kna1_bf-stcd2,
summe type i,
weights(8) type c value '2765432'.

check nif2 ne space.
savestcd2 = nif2.

*------- Ungltige Zeichen? --------------------------------------------
condense savestcd2 no-gaps.
if savestcd2(8) cn '0123456789'.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.

* ------ Prfziffer berechnen ------------------------------------------
do 7 times.
summe = summe + ( savestcd2(1) * weights(1) ).
shift savestcd2.
shift weights.
enddo.
refe = summe mod 11.
refe = 11 - refe.
if refe = 10
or refe = 11.
refe = 0.
endif.

* -- Vergleichen mit Kontrollziffer ( = 9. Stelle ) --------------------
if refe ne savestcd2(1).
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_dk

*eject
*-----------------------------------------------------------------------
* FORM CHECK_TAXCODE_ES
*-----------------------------------------------------------------------
* Prfung Steuernummer 1 Spanien
*-----------------------------------------------------------------------
* RUC
* IVA
*-----------------------------------------------------------------------
form check_taxcode_es using
ruc like kna1_bf-stcd1.

data: savestcd1 like kna1_bf-stcd1.

check ruc ne space.
savestcd1 = ruc.

* ------ Prfverfahren bestimmen und durchfhren -----------------------
* L = Buchstabe (letter), D = Ziffer (digit)

* LDDDDDDDL --> Prfung Steuernummer einer Behrde
* (1. Stelle = A, B, C, D ,E ,F ,G ,H ,P , Q, S)
* --> Sonderfall Steuernummer einer nat. Person
* (1. Stelle = K, L) --> keine Prfung oder
* --> Prfung Steuernummer einer auslndischen nat. Person
* (1. Stelle = X)
* LDDDDDDDD --> Prfung Steuernummer einer juristischen Person
* (L = A, B, C, D, E, F, G, H) oder
* --> Sonderfall Steuernummer einer auslndischen nat.
* Person (L = T) --> keine Prfung
* DDDDDDDDL --> Prfung Steuernummer einer natrlichen Person
* ----------------------------------------------------------------------
if savestcd1+1(7) cn '0123456789'.
fname = 'Steuercode-1'(004).
* MESSAGE e100 WITH fname '2' '8' RAISING not_valid.
result = 1.
endif.

* -- 1. Stelle Buchstabe -----------------------------------------------
if savestcd1(1) co letters.

* -- ... 9. Stelle Buchstabe -------------------------------------------
if savestcd1+8(1) co letters.
* if savestcd1(1) co 'ABCDEFGHPQS'." Behrde
* IF savestcd1(1) CO 'ABCDEFGHPQSN'.
if savestcd1(1) co 'ABCDEFGHJUVPQRSNW'.
* Steuernummer mit 'N' auch gltig
perform check_taxcode_companies using ruc.
elseif savestcd1(1) co 'XYZ' " auslndische natrliche Person
* fr auslndische natrliche Person lter als 18, die hat keine
* spanische Nationalitt
* Format: M - auslndische Person, 2 Ziffern fr Region, 5 Ziffern fr
* die Nummer, 1 Buchst. fr die Prfziffer
or savestcd1(1) = 'M'.
perform check_taxcode_foreigners using ruc.
elseif savestcd1(1) na 'KL'. " auch kein Sonderfall nat. Pers.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

* -- ... 9. Stelle Ziffer ----------------------------------------------
elseif savestcd1+8(1) co '0123456789'.
* IF savestcd1(1) CO 'ABCDEFGH'. " juristische Person
if savestcd1(1) co 'ABCDEFGHJUV'. " juristische Person
perform check_taxcode_companies using ruc.
elseif savestcd1(1) ne 'T'. " auch keine auslnd. nat. Person
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

* -- ... 9. Stelle weder Buchstabe noch Ziffer -------------------------
else.
fname = 'Steuercode-1'(004).
* MESSAGE e099 WITH fname RAISING not_valid.
result = 1.
endif.

* -- 1. Stelle Ziffer --------------------------------------------------
elseif savestcd1(1) co '0123456789'.

* -- ... 9. Stelle Buchstabe -------------------------------------------
if savestcd1+8(1) co letters.
perform check_taxcode_persons using ruc.

* -- ... 9. Stelle Ziffer ----------------------------------------------
elseif savestcd1+8(1) co '0123456789'.
fname = 'Steuercode-1'(004).
* MESSAGE e106 WITH fname '1' '9' RAISING not_valid.
result = 1.

* -- ... 9. Stelle weder Buchstabe noch Ziffer -------------------------
else.
fname = 'Steuercode-1'(004).
* MESSAGE e099 WITH fname RAISING not_valid.
result = 1.
endif.

* -- 1. Stelle weder Buchstabe noch Ziffer -----------------------------
else.
fname = 'Steuercode-1'(004).
* MESSAGE e099 WITH fname RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_es

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_F *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 Frankreich *
* -------------------------------------------------------------------- *
* RUC *
* IVA *
* -------------------------------------------------------------------- *
form check_taxcode_f using
ruc like kna1_bf-stcd1.

data: savestcd1 like kna1_bf-stcd1.

savestcd1 = ruc.

*------- Prfung auf Vollstndigkeit -----------------------------------
if savestcd1+9(5) = space.

call function 'READ_CUSTOMIZED_MESSAGE'
exporting
i_arbgb = 'AR'
i_dtype = 'W'
i_msgnr = '171'
importing
e_msgty = typ_mess.

if typ_mess = 'E'.
* MESSAGE e171 RAISING not_valid.
result = 1.
elseif typ_mess ne '-'.
* MESSAGE ID 'AR' TYPE typ_mess NUMBER '171' RAISING NOT_VALID.
result = 1.
endif.

perform check_nine_digits using ruc.
else.
perform check_nine_digits using ruc.
perform check_all_digits using ruc.
endif.

endform. "check_taxcode_f

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_FOREIGNERS *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 fr auslndische natrliche Personen, *
* wobei 1. Stelle der Steuernummer = 'X' (Spanien) *
* -------------------------------------------------------------------- *
* RUC *
* -------------------------------------------------------------------- *
form check_taxcode_foreigners using
ruc like kna1_bf-stcd1.

data: einer(1) type c,
refe type i,
savestcd1 like kna1_bf-stcd1,
umwandlung1(20) type c value '0D1T2R3W4A5G6M7Y8F9P',
umwandlung2(18) type c value 'TXRBWNAJGZMSYQFVPH',
umwandlung3(8) type c value 'DLTCRKWE',
zehner(1) type c.

savestcd1 = ruc.

if savestcd1(1) eq 'X' or savestcd1(1) eq 'M'.
refe = savestcd1+1(7).
elseif savestcd1(1) eq 'Y'.
savestcd1(1) = 1.
refe = savestcd1(8).
elseif savestcd1(1) eq 'Z'.
savestcd1(1) = 2.
refe = savestcd1(8).
endif.

* ------ Prfziffer berechnen ------------------------------------------
* refe = savestcd1+1(7).
refe = refe mod 23.
refe = refe + 1.
einer = refe mod 10. " Einerstelle bestimmen
zehner = ( refe - einer ) / 10. " Zehnerstelle bestimmen
translate einer using umwandlung1.
case zehner.
when '1'.
translate einer using umwandlung2.
when '2'.
translate einer using umwandlung3.
endcase.

* ------ Vergleichen mit Kontrollziffer ( = 9. Stelle ) ----------------
if einer ne savestcd1+8(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_foreigners

*eject
*----------------------------------------------------------------------
* FORM CHECK_TAXCODE_I
*----------------------------------------------------------------------
* Prfung Steuercodes Italien
*----------------------------------------------------------------------
* RUC NIF2
* REGION PAIS
* PERSFISICA.
*----------------------------------------------------------------------
form check_taxcode_i using
ruc like kna1_bf-stcd1
nif2 like kna1_bf-stcd2
region like kna1_bf-regio
pais like kna1_bf-land1
persfisica like kna1_bf-stkzn.

data: const_11 type i value 11,
savestcd1 like kna1_bf-stcd1,
savestcd2 like kna1_bf-stcd2,
save_strlen type i,
xwarn(1) type c, " Kennz.: Warnung?
const_16 type i value 16,
lv_company type boolean.

savestcd1 = ruc.
savestcd2 = nif2.

if persfisica is initial.
if savestcd1 ne space.

*------- Ggf. Lnge von Steuercode 1 prfen ----------------------------
* Wenn das Feld 'Natrliche Person' nicht angekreuzt ist, wird
* Steuercode 1 nach den Regeln von Steuercode 2 geprft. Die
* Eingabe im Feld Steuercode 1 kann aber im Formatcheck nicht
* auf exakte Lnge 11 und auf 'numerisch' geprft werden. Davon
* abweichende Eingaben mssen daher hier noch abgefangen werden.
save_strlen = strlen( savestcd1 ).
if save_strlen eq const_16.
lv_company = 'X'.
elseif save_strlen ne const_11
or save_strlen eq const_11 and savestcd1(11) cn '1234567890'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

*------- Ggf. Kennzeichen XWARN setzen ---------------------------------
* Handelt es sich nicht um eine nat. Person und sind STCD1 und
* STCD2 beide numerisch, so knnen bei einem der beiden
* Steuercodes die Stellen 8-10 von T005-FPRCD verschieden. In
* diesem Fall darf bei der Prfung nur eine Warnung ausgegeben
* werden.
if savestcd2 ne space.
xwarn = 'X'.
endif.
endif.
endif.

*------- Steuercode 1 prfen -------------------------------------------
if persfisica is initial and save_strlen eq const_11.
taxcode_i_message_flag = 'X'.
perform nif2_pruefen using ruc region pais xwarn.
taxcode_i_message_flag = space.
else.
perform ruc_pruefen using ruc.
endif.

*------- Steuercode 2 prfen -------------------------------------------
perform nif2_pruefen using nif2 region pais xwarn.

endform. "check_taxcode_i

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_PERSONS *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 fr natrliche Personen (Spanien) *
* -------------------------------------------------------------------- *
* RUC
* -------------------------------------------------------------------- *
form check_taxcode_persons using
ruc like kna1_bf-stcd1.

data: einer(1) type c,
refe1 type i,
refe2 type i,
savestcd1 like kna1_bf-stcd1,
umwandlung1(20) type c value '0T1R2W3A4G5M6Y7F8P9D',
umwandlung2(20) type c value 'TXRBWNAJGZMSYQFVPHDL',
umwandlung3(6) type c value 'XCBKNE',
zehner(1) type c.

savestcd1 = ruc.

*------- Prfziffer berechnen ------------------------------------------
refe2 = savestcd1(8).
refe1 = refe2 mod 23.
einer = refe1 mod 10. " Einerstelle bestimmen
zehner = ( refe1 - einer ) / 10. " Zehnerstelle bestimmen
translate einer using umwandlung1.
case zehner.
when '1'.
translate einer using umwandlung2.
when '2'.
translate einer using umwandlung2.
translate einer using umwandlung3.
endcase.

* ------ Vergleichen mit Kontrollziffer ( = 9. Stelle ) ----------------
if einer ne savestcd1+8(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_persons

*eject
*-----------------------------------------------------------------------
* FORM CHECK_TAXCODE_NO
*-----------------------------------------------------------------------
* Prfung Steuernummer 2 Norwegen
*-----------------------------------------------------------------------
* NIF2
* IVA
*-----------------------------------------------------------------------
form check_taxcode_no using
nif2 like kna1_bf-stcd2.

data: refe type i,
savestcd2 like kna1_bf-stcd2,
summe type i,
weights(8) type c value '32765432'.

check nif2 ne space.
savestcd2 = nif2.

*------- Ungltige Zeichen? --------------------------------------------
condense savestcd2 no-gaps.
if savestcd2(9) cn '0123456789'.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.

*------- Prfziffer berechnen ------------------------------------------
do 8 times.
summe = summe + ( savestcd2(1) * weights(1) ).
shift savestcd2.
shift weights.
enddo.
refe = summe mod 11.
refe = 11 - refe.
if refe = 10
or refe = 11.
refe = 0.
endif.

* ------ Vergleichen mit Kontrollziffer ( = 9. Stelle ) ----------------
if refe ne savestcd2(1).
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_no

*eject
*-----------------------------------------------------------------------
* FORM CHECK_TAXCODE_P
*-----------------------------------------------------------------------
* Prfung Steuernummer 1 Portugal
*-----------------------------------------------------------------------
* RUC
* IVA
*-----------------------------------------------------------------------
form check_taxcode_p using
ruc like kna1_bf-stcd1.

data: refe type i,
savestcd1 like kna1_bf-stcd1,
summe type i,
weights(8) type c value '98765432'.

check ruc ne space.
savestcd1 = ruc.

*------- Ungltige Zeichen? --------------------------------------------
if savestcd1(9) cn '0123456789'.
* MESSAGE e137 RAISING not_valid.
result = 1.
endif.

* ------ Prfziffer berechnen ------------------------------------------
do 8 times.
summe = summe + ( savestcd1(1) * weights(1) ).
shift savestcd1.
shift weights.
enddo.
refe = summe mod 11.
refe = 11 - refe.
if refe = 10
or refe = 11.
refe = 0.
endif.

* ------ Vergleichen mit Kontrollziffer ( = 9. Stelle ) ----------------
if refe ne savestcd1(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_p

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_S *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 2 Schweden *
* -------------------------------------------------------------------- *
* NIF2 *
* IVA *
* -------------------------------------------------------------------- *
form check_taxcode_s using
nif2 like kna1_bf-stcd2.

data: refe1 type i,
refe2 type i,
savestcd2 like kna1_bf-stcd2,
summ1 type i,
summ2 type i.

check nif2 ne space.
savestcd2 = nif2.

* -- Bindestrich entfernen ---------------------------------------------
translate savestcd2 using '- '.
condense savestcd2 no-gaps.
if savestcd2(10) cn '0123456789'.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.

* -- Prfziffer berechnen ----------------------------------------------
do 4 times.

* -- ... Ziffern mit ungeradem Stellenwert verdoppeln, Quersumme, ------
* addieren
refe1 = savestcd2(1) * 2.
if refe1 > 9.
refe1 = refe1 - 9.
endif.
summ2 = refe1 + summ2.
shift savestcd2.

* ------ ... Ziffern mit ungeradem Stellenwert addieren ----------------
summ1 = savestcd2(1) + summ1.
shift savestcd2.
enddo.

* ------ ... Die 9. Ziffer verdoppeln und zur Summe addieren -----------
refe1 = savestcd2(1) * 2.
if refe1 > 9.
refe1 = refe1 - 9.
endif.
summ2 = refe1 + summ2.
shift savestcd2.

* ------ ... Die beiden Summen addieren --------------------------------
summ1 = summ1 + summ2.

* ------ ... Die letzte Stelle von 10 subtrahieren, davon die letzte ---
* Stelle subtrahieren.
if summ1 ne 0.
refe2 = summ1 mod 10.
endif.
refe2 = 10 - refe2.
if refe2 = 10.
refe2 = 0.
endif.

* ------ Vergleichen mit Kontrollziffer ( = 11. Stelle ) ---------------
if refe2 ne savestcd2(1).
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_s

* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_CL *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 Chile *
* -------------------------------------------------------------------- *
* RUC *
* *
* -------------------------------------------------------------------- *
form check_taxcode_cl using
ruc like kna1_bf-stcd1.

data: hlp_code like kna1_bf-stcd1," scratch for tax number
ref(10) type n value '5432765432', " reference string
ref2(10) type n value '0000000000', " scratch string
ref3(10) type c, " scratch string
iref type i, " check number
iref2 type i, " num. div
ico type i, " length counter
iref3(1) type c. " check digit

check ruc ne space.
if ruc cn ' -0123456789K'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
if ruc ns '-'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
split ruc at '-' into ref3 hlp_code.
ref2 = ref3. " numeric field
* shift to left and insert zeros from right
* do 10 times.
* if ref2(1) = '0'.
* shift ref2 circular.
* else.
* exit.
* endif.
* enddo.
* check last entry
iref2 = strlen( hlp_code ). " use iref2 as scratch
if iref2 ne 1.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
* calculate check sum
iref = 0.
do 10 times.
iref = iref + ref2(1) * ref(1).
shift ref2 left.
shift ref left.
enddo.
* divide by 11
iref2 = iref mod 11.
* subtract from 11
if iref2 gt 1.
iref2 = 11 - iref2.
iref3 = iref2.
elseif iref2 eq 1.
iref3 = 'K'.
else.
iref3 = '0'.
endif.
if iref3 ne hlp_code(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_cl


*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_PE *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 Peru *
* -------------------------------------------------------------------- *
* RUC *
* *
* -------------------------------------------------------------------- *
form check_taxcode_pe using
ruc like kna1_bf-stcd1
persfisica like kna1_bf-stkzn.

data: hlp_code like kna1_bf-stcd1," scratch for tax number
ref(7) type n value '2765432'," reference string
iref type i, " check number
iref2 type i. " check digit

data: weights(10) type c value '5432765432',
sum type i,
length type i.

* CHECK PERSFISICA IS INITIAL.
check ruc ne space.

length = strlen( ruc ).
hlp_code = ruc. " save tax code
case length.
when 8.
* calculate check sum
iref = 0.
do 7 times.
iref = iref + hlp_code(1) * ref(1).
shift hlp_code left.
shift ref left.
enddo.
* divide by 11
iref2 = iref mod 11.
* subtract from 11
if iref2 gt 1.
iref2 = 11 - iref2.
else.
iref2 = 0.
endif.
if iref2 ne ruc+7(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

when 11. "new from 1.1.2001 NIT
do 10 times.
sum = sum + hlp_code(1) * weights(1).
shift hlp_code.
shift weights.
enddo.
iref = sum mod 11.
iref2 = 11 - iref.

if iref2 eq 10.
iref2 = 0.
endif.
if iref2 eq 11.
iref2 = 1.
endif.

if iref2 ne ruc+10(1). "last digit
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

when others.
* MESSAGE e129 RAISING not_valid.
result = 1.
endcase.

endform. "check_taxcode_pe

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_CO *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 Kolumbien *
* -------------------------------------------------------------------- *
* RUC *
* *
* -------------------------------------------------------------------- *
form check_taxcode_co using
ruc like kna1_bf-stcd1 stkzn.

data: hlp_code(16) type n, " scratch for tax number
hlp_cod2(16) type n, " scratch 2
ref(28) type n value '7167595347434137292319171373', " ref. str.
iref type i, " check number
iref2 type i. " check digit

check ruc ne space.
* check only for non natual persons
if stkzn is initial.
if ruc cn ' 0123456789'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
clear hlp_code.
hlp_code = ruc. " save tax code
hlp_cod2 = ruc. " save tax code
* calculate check sum
iref = 0.
do 13 times.
iref = iref + hlp_code(1) * ref(2).
shift hlp_code left.
shift ref left.
shift ref left.
enddo.
do 2 times.
iref = iref + hlp_code(1) * ref(1).
shift hlp_code left.
shift ref left.
enddo.
* divide by 11
iref2 = iref mod 11.
* subtract from 11
if iref2 gt 1.
iref2 = 11 - iref2.
endif.
if iref2 ne hlp_cod2+15(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.
endform. "check_taxcode_co

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_MX *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 1 Mexiko *
* -------------------------------------------------------------------- *
* RUC *
* *
* -------------------------------------------------------------------- *
form check_taxcode_mx using
ruc like kna1_bf-stcd1
persfisica like kna1_bf-stkzn.

data: hlp_code like kna1_bf-stcd1," scratch for tax number
length type i,
hlp_num(6) type n. " scratch for numbers

data: letters(27) type c value 'ABCDEFGHIJKLMNOQPRSTUVWXYZ&'."note612060

* CHECK PERSFISICA IS INITIAL.
check ruc ne space.
hlp_code = ruc. " save tax code

length = strlen( ruc ).
case length.
when '12'. "// Legal person
if hlp_code(3) cn letters. "// first 3 must be letters
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
when '13'. "// Natural person
if hlp_code(4) cn letters. "// first 4 must be letters
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
hlp_num = hlp_code+4(6).

* look for month range
if hlp_num+2(2) gt '12'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
* look for day range
if hlp_num+4(2) gt '31'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

when others.
* MESSAGE e129 RAISING not_valid.
result = 1.
endcase.

endform. "check_taxcode_mx

*eject
* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_VE *
* -------------------------------------------------------------------- *
* Prfung Steuernummer 2 Venezuela *
* -------------------------------------------------------------------- *
* NIF2 *
* *
* -------------------------------------------------------------------- *
form check_taxcode_ve using
ruc like kna1_bf-stcd1.

data: hlp_code like kna1_bf-stcd1," scratch for tax number
hlp_num(10) type c, " scratch for numbers
ico type i, " counter
hlp_scr(1) type c. " scratch for numbers


check ruc ne space.
hlp_code = ruc. " save tax code
shift hlp_code left deleting leading space.
* there must be two delimiters '-'
ico = 0.
do 12 times.
if hlp_code(1) eq '-'. ico = ico + 1. endif.
shift hlp_code left.
enddo.
if ico ne 2.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
hlp_code = ruc. " save tax code
shift hlp_code left deleting leading space.
* first char must be in (E,G,J,P,V)
if hlp_code(1) cn 'EGJPV'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
* second char must be '-'
if hlp_code+1(1) cn '-'.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
*
hlp_code = ruc. " save tax code
shift hlp_code left deleting leading space.
* get rest of string
hlp_num = hlp_code+2(10).
* eliminate second '-'
translate hlp_num using '- '.
* must now be numeric
if hlp_num cn '0123456789 '.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "check_taxcode_ve


*eject
* -------------------------------------------------------------------- *
* FORM RUC_PRUEFEN *
* -------------------------------------------------------------------- *
* Prfung Steuercode-1 Italien *
* -------------------------------------------------------------------- *
* RUC *
* -------------------------------------------------------------------- *
form ruc_pruefen using
ruc like kna1_bf-stcd1.

* ------ Datenfelder ---------------------------------------------------
data: einer(1) type c,
gerade(1) type c, " = 1., 2. (4., 6.) Ziffer in
" RUC bzw. NIF2
savestcd1 like kna1_bf-stcd1,
summ1(5) type c, " Zwischensumme
summand(2) type c, " Summand
zehner(1) type c.

data: umwandlung1(72) type c
value '00102030405161718192A0B0C0D0E0F1G1H1I1J2K0L0M1N2O1' &
'P0Q0R0S1T1U1V1W2X2Y2Z2'.

data: umwandlung2(72) type c
value '01102537495365778991A1B0C5D7E9F3G5H7I9J1K2L4M8N0O1' &
'P3Q6R8S2T4U6V0W2X5Y4Z3'.

data: umwandlung3(72) type c
value '00102030405060708090A0B0C0D0E0F0G0H0I0J0K1L1M1N1O1' &
'P1Q1R1S1T1U2V2W2X2Y2Z2'.

data: umwandlung4(72) type c
value '00112233445566778899A0B1C2D3E4F5G6H7I8J9K0L1M2N3O4' &
'P5Q6R7S8T9U0V1W2X3Y4Z5'.

data: umwandlung5(72) type c value '0A1B2C3D4E5F6G7H8I9J',
umwandlung6(72) type c value 'AKBLCMDNEOFPGQHRISJT',
umwandlung7(72) type c value 'AUBVCWDXEYFZ'.

* ------ Initialisierungen ---------------------------------------------
savestcd1 = ruc.
check savestcd1 ne space.
check savestcd1 cn '0 '.
summ1 = 0.
gerade = '0'.

* --- Check nur alphanumerische Zeichen
if savestcd1 cn '0123456789ABCDEFGHIJKLMNOPRQSTUVWXYZ'.
fname = 'Steuercode-1'(004).
* MESSAGE e099 WITH fname RAISING not_valid.
result = 1.
endif.

* ------ Prfverfahren -------------------------------------------------
do 15 times.
zehner = savestcd1(1).
einer = zehner.
if gerade = '0'.
* ------ Zehner- und Einerstelle umsetzen und Summand zusammensetzen - *
* Bsp: Ein 'I' auf einer Position mit ungeradem Stellenwert *
* wird zu '19' wie folgt: *
* Zehner = 'I' --> Umwandlung1 --> 1 *
* Einer = 'I' --> Umwandlung2 --> 9 *
* Zusammengesetzter Summand: '19'. *
* -------------------------------------------------------------------- *
translate zehner using umwandlung1.
summand(1) = zehner.
translate einer using umwandlung2.
summand+1(1) = einer.
else.
* ------ Zehner- und Einerstelle umsetzen und Summand zusammensetzen - *
* Bsp: Ein 'I' auf einer Position mit geradem Stellenwert *
* wird zu '08' wie folgt: *
* Zehner = 'I' --> Umwandlung3 --> 0 *
* Einer = 'I' --> Umwandlung4 --> 8 *
* Zusammengesetzter Summand: '08'. *
* ---------------------------------------------------------------------*
translate zehner using umwandlung3.
summand(1) = zehner.
translate einer using umwandlung4.
summand+1(1) = einer.
endif.
summ1 = summ1 + summand.

* ------ Nchster Stellenwert gerade oder ungerade? --------------------
if gerade = '0'.
gerade = '1'.
else.
gerade = '0'.
endif.
shift savestcd1.
enddo.

* ------ Summe modulo 26 -----------------------------------------------
summ1 = summ1 mod 26.

* ------ Aus einem Ergebnis ' 5' ein '05' machen ---------------------
condense summ1 no-gaps.
if summ1 < 10.
shift summ1 right.
summ1(1) = '0'.
endif.

*------- Ergebnis in Buchstaben umwandeln -----------------------------*
* Bsp: Eine '16' wird zu 'Q' wie folgt: *
* Einerstelle = '6' --> Umwandlung5 ----> G *
* Zehnerstelle = '1' --> Umwandlung6: G --> Q *
*----------------------------------------------------------------------*
translate summ1+1(1) using umwandlung5.
case summ1(1).
when '1'.
translate summ1+1(1) using umwandlung6.
when '2'.
translate summ1+1(1) using umwandlung7.
endcase.
shift summ1.

* ------ Vergleichen (SAVESTCD1 ist schon 15mal geshiftet) -------------
if summ1 ne savestcd1(1).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.

endform. "RUC_pruefen

*eject
* -------------------------------------------------------------------- *
* FORM NIF2_PRUEFEN *
* -------------------------------------------------------------------- *
* Prfung Steuercode 2 Italien *
* -------------------------------------------------------------------- *
* NIF2 *
* REGION *
* PAIS *
* -------------------------------------------------------------------- *
form nif2_pruefen using
nif2 type c
region like kna1_bf-regio
pais like kna1_bf-land1
xwarn type c.

data: refe1 type p,
savestcd2 like kna1_bf-stcd2,
summ1 type p,
summ2 type p.

savestcd2 = nif2.

* ------ TAX-CODE_2 numerisch und nicht initial? -----------------------
check savestcd2 cn '0 '.
if savestcd2 cn '1234567890'.
if taxcode_i_message_flag = 'X'.
* MESSAGE e137 RAISING not_valid.
result = 1.
else.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.
endif.

* ------ Stellen 8-10 gegen fiskalischen Provinzcode aus T005P prfen --
select single * from t005p
where land1 = pais
and bland = region
and fprcd = savestcd2+7(3).
if sy-subrc <> 0.

* ------ ... Message fr Steuercode 1 ----------------------------------
if taxcode_i_message_flag = 'X'.
if xwarn = space.
* CALL FUNCTION 'CUSTOMIZED_MESSAGE'
* EXPORTING
* I_ARBGB = 'AR'
* I_DTYPE = 'E'
* I_MSGNR = '169'.
data l_msgts like t100c-msgts.

call function 'READ_CUSTOMIZED_MESSAGE'
exporting
i_arbgb = 'AR'
i_dtype = 'E'
i_msgnr = '169'
importing
e_msgty = l_msgts.

if l_msgts ne '-'.
* message id i_arbgb type l_msgts number i_msgnr
* with i_var01 i_var02 i_var03 i_var04.
result = 1.
endif.
* MESSAGE e169 WITH region RAISING not_valid.
* ELSE.
* MESSAGE w169 WITH region RAISING different_fprcd.
endif.

* ------ ... Message fr Steuercode 2 ----------------------------------
* ELSE.
* IF xwarn = space.
* MESSAGE w170 WITH region RAISING not_valid.
* ELSE.
* MESSAGE w170 WITH region RAISING different_fprcd.
* ENDIF.
endif.
endif.

* ------ Ermittlung der Prfziffer -------------------------------------
summ1 = 0.
summ2 = 0.
do 5 times.

* ------ Ziffern mit ungeradem Stellenwert addieren --------------------
summ1 = savestcd2(1) + summ1.
shift savestcd2.

* ------ Ziffern mit geradem Stellenwert verdoppeln, Quersumme, addieren
refe1 = savestcd2(1) * 2.
if refe1 > 9.
refe1 = refe1 - 9.
endif.
summ2 = refe1 + summ2.
shift savestcd2.
enddo.

* ------ Die beiden Summen addieren, modulo 10 nehmen ------------------
summ1 = summ1 + summ2.
summ1 = summ1 mod 10.

* ------ Komplement der Einerstelle zu 10 ------------------------------
if summ1 ne 0.
summ1 = 10 - summ1.
endif.

* ------ Vergleichen mit Kontrollziffer ( = 11. Stelle ) ---------------
* condense summ1 no-gaps. "lt. Ute vom 30.11.95
if summ1 ne savestcd2(1).
if taxcode_i_message_flag = 'X'.
taxcode_i_message_flag = space.
* MESSAGE e129 RAISING not_valid.
result = 1.
else.
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.
endif.

endform. "NIF2_pruefen
*&---------------------------------------------------------------------*
*& Form CHECK_TAXCODE_BRA
*&---------------------------------------------------------------------*
* check tax code 1 (CGC) and tax code 2 (CPF)
* Change request: J1B_0001
*----------------------------------------------------------------------*
* -->STZKN flag for natural person *
* -->RUC CGC *
* -->NIF2 CPF *
*----------------------------------------------------------------------*
form check_taxcode_bra using stkzn
ruc
nif2.

if ruc <> space.
if stkzn = 'X'.
* MESSAGE e051(bf00) RAISING not_valid.
result = 1.
endif.
call function 'CONVERSION_EXIT_CGCBR_INPUT'
exporting
input = ruc
exceptions
not_valid = 1
others = 2.

if sy-subrc ne 0.
* MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
* WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4
* RAISING not_valid.
result = 1.
endif.

endif.
if nif2 <> space.
if stkzn = ' '.
* MESSAGE e052(bf00) RAISING not_valid.
result = 1.
endif.
call function 'CONVERSION_EXIT_CPFBR_INPUT'
exporting
input = nif2
exceptions
not_valid = 1
others = 2.

if sy-subrc ne 0.
* MESSAGE ID sy-msgid TYPE 'E' NUMBER sy-msgno
* WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4
* RAISING not_valid.
result = 1.
endif.

endif.
endform. " CHECK_TAXCODE_BRA
*&---------------------------------------------------------------------*
*& Form CHECK_TAXCODE_RA
*&---------------------------------------------------------------------*
* Pruefen von RUC in Abhngigkeit des Steuernummerntyps
*----------------------------------------------------------------------*
* -->P_RUC text *
* -->P_TIPNIF text *
*----------------------------------------------------------------------*
form check_taxcode_ra using p_ruc
p_tipnif.

data: x_tipnif(2) type c.

x_tipnif = p_tipnif.

call function 'J_1A_TAX_NUMBER_CHECK'
exporting
type_of_id = x_tipnif
tax_code_1 = p_ruc
exceptions
wrong_first_2_char = 1
code_not_numeric = 2
code_wrong_length = 3
wrong_check_digit = 4.
if sy-subrc ne 0.
case sy-subrc.
when '1'.
* MESSAGE e040(bf00) RAISING not_valid.
result = 1.
when '2'.
* MESSAGE e104 WITH text-004 RAISING not_valid.
result = 1.
when '3'.
* MESSAGE e102 WITH text-004 '11' RAISING not_valid.
result = 1.
when '4'.
* MESSAGE e041(bf00) RAISING not_valid.
result = 1.
endcase.
endif.
endform. " CHECK_TAXCODE_RA
*&--------------------------------------------------------------------*
*& Form check_taxcode_bg
*&--------------------------------------------------------------------*
* Tax code 1: Single Identification Code/ Personal Identification Code
* Tax code 2: Tax number
*---------------------------------------------------------------------*
* -->P_TAX_CODE_text
* -->P_TAX_CODE_text
* -->P_NATURAL_PtextN_FLAG
*---------------------------------------------------------------------*
form check_taxcode_bg using p_ruc type stcd1
p_nif2 type stcd2
p_persfisica type stkzn.
data: l_taxcode1 type stcd1,
l_main_code(9) type n,
l_add_code(4) type n,
l_taxcode2 type stcd2,

l_digit(1) type n,
l_check_digit(1) type n,
l_sum type i,
l_mod_value type i,
l_factor type i.

* Check tax code 1 --------------------------------------------------
if p_ruc ne space.
l_taxcode1 = p_ruc.
* Check for numerical characters -------------------------------
if l_taxcode1(9) cn '0123456789'.
* MESSAGE e137 RAISING not_valid.
result = 1.
endif.
* Check length -------------------------------------------------
if l_taxcode1+13 ne space.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
* Check for Natural Person Flag status---------------------------
if p_persfisica ne space. "personal identification Number
if l_taxcode1 eq '9999999999'.
return.
else.
l_check_digit = l_taxcode1+9(1).
clear: l_sum, l_mod_value.
do 9 times.
l_digit = l_taxcode1(1).
case sy-index.
when 1.
l_factor = 2.
when 2.
l_factor = 4.
when 3.
l_factor = 8.
when 4.
l_factor = 5.
when 5.
l_factor = 10.
when 6.
l_factor = 9.
when 7.
l_factor = 7.
when 8.
l_factor = 3.
when 9.
l_factor = 6.
endcase.
l_sum = l_sum + l_factor * l_digit.
shift l_taxcode1.
enddo.
l_mod_value = l_sum mod 11.
if l_mod_value = 10.
if l_check_digit ne 0.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
if l_check_digit ne l_mod_value.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.
endif.
else. "Single Identification Code
* Check digit of main code (position 1-9) ----------------------
l_main_code = l_taxcode1(9).
l_check_digit = l_main_code+8(1).
clear l_sum.
do 8 times.
l_digit = l_main_code(1).
l_sum = l_sum + l_digit * sy-index.
shift l_main_code.
enddo.
l_mod_value = l_sum mod 11.
if l_mod_value ne 10.
if l_check_digit ne l_mod_value.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
clear: l_sum, l_mod_value.
l_main_code = l_taxcode1(9).
do 8 times.
l_digit = l_main_code(1).
l_factor = sy-index + 2.
l_sum = l_sum + l_digit * l_factor.
shift l_main_code.
enddo.
l_mod_value = l_sum mod 11.
if l_mod_value = 10.
if l_check_digit ne 0.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
if l_check_digit ne l_mod_value.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.
endif.
* Check digit of additional code (position 10-13) ----------------
if l_taxcode1+9 ne space.
* Check for numerical characters ----------------------
if l_taxcode1+9(4) cn '0123456789'.
* MESSAGE e137 RAISING not_valid.
result = 1.
endif.
l_add_code = l_taxcode1+8(4).
l_check_digit = l_taxcode1+12(1).
clear: l_sum, l_mod_value.
do 4 times.
l_digit = l_add_code(1).
case sy-index.
when 1.
l_factor = 2.
when 2.
l_factor = 7.
when 3.
l_factor = 3.
when 4.
l_factor = 5.
endcase.
l_sum = l_sum + l_digit * l_factor.
shift l_add_code.
enddo.
l_mod_value = l_sum mod 11.
if l_mod_value ne 10.
if l_check_digit ne l_mod_value.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
l_add_code = l_taxcode1+8(4).
clear: l_sum, l_mod_value.
do 4 times.
l_digit = l_add_code(1).
case sy-index.
when 1.
l_factor = 4.
when 2.
l_factor = 9.
when 3.
l_factor = 5.
when 4.
l_factor = 7.
endcase.
l_sum = l_sum + l_digit * l_factor.
shift l_add_code.
enddo.
l_mod_value = l_sum mod 11.
if l_mod_value = 10.
if l_check_digit ne 0.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
else.
if l_check_digit ne l_mod_value.
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.
endif.
endif.
endif.
endif.

* Check tax code 2 --------------------------------------------------
if p_nif2 ne space.
l_taxcode2 = p_nif2.
* Check for numerical characters -------------------------------
if l_taxcode2(10) cn '0123456789'.
* MESSAGE e127 RAISING not_valid.
result = 1.
endif.
* Check length -------------------------------------------------
if l_taxcode2+10 ne space.
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.
* Check digit check depends on natural person flag -------------
if p_persfisica = space. "tax number
l_check_digit = l_taxcode2+9(1).
clear: l_sum, l_mod_value.
do 9 times.
l_digit = l_taxcode2(1).
case sy-index.
when '1'.
l_factor = 4.
when '2'.
l_factor = 3.
when '3'.
l_factor = 2.
when others.
l_factor = 11 - sy-index.
endcase.
l_sum = l_sum + l_factor * l_digit.
shift l_taxcode2.
enddo.
l_mod_value = l_sum mod 11.
* Compare check digit, special rules for MOD = 0 or MOD = 1 ----
if l_mod_value = 1.
* MESSAGE e130 RAISING not_valid.
result = 1.
elseif l_mod_value = 0 and l_check_digit ne 0.
* MESSAGE e130 RAISING not_valid.
result = 1.
elseif l_mod_value = 0.
if l_check_digit ne 0.
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.
else.
l_mod_value = 11 - l_mod_value.
if l_mod_value ne l_check_digit.
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.
endif.
* ELSE. "personal identifaction code
* l_check_digit = l_taxcode2+9(1).
* CLEAR: l_sum, l_mod_value.
* DO 9 TIMES.
* l_digit = l_taxcode2(1).
* CASE sy-index.
* WHEN 1.
* l_factor = 2.
* WHEN 2.
* l_factor = 4.
* WHEN 3.
* l_factor = 8.
* WHEN 4.
* l_factor = 5.
* WHEN 5.
* l_factor = 10.
* WHEN 6.
* l_factor = 9.
* WHEN 7.
* l_factor = 7.
* WHEN 8.
* l_factor = 3.
* WHEN 9.
* l_factor = 6.
* ENDCASE.
* l_sum = l_sum + l_factor * l_digit.
* SHIFT l_taxcode2.
* ENDDO.
* l_mod_value = l_sum MOD 11.
* IF l_mod_value = 10.
* IF l_check_digit NE 0.
* MESSAGE e130 RAISING not_valid.
* ENDIF.
* ELSE.
* IF l_check_digit NE l_mod_value.
* MESSAGE e130 RAISING not_valid.
* ENDIF.
* ENDIF.
* ENDIF.
endif.
endif.
endform. "check_taxcode_bg

* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_US *
* -------------------------------------------------------------------- *
* Prfung der Steuernummer USA *
* -------------------------------------------------------------------- *
* RUC *
* PERSFISICA *
* -------------------------------------------------------------------- *
form check_taxcode_us using
ruc like kna1_bf-stcd1
nif2 like kna1_bf-stcd2
persfisica like kna1_bf-stkzn.

data: savestcd1 like kna1_bf-stcd1,
savestcd2 like kna1_bf-stcd2,
save_strlen type i,
const_10 type i value 10,
const_11 type i value 11.

savestcd1 = ruc.
savestcd2 = nif2.

* 17/07/07
* Social Security Number should be of length 11 having the format NNN-NN-NNNN
* Employee Identification Number should be of length 10 having the format NN-
NNNNNNN

*IF PERSFISICA IS INITIAL.
if savestcd2 ne space.
save_strlen = strlen( savestcd2 ).

if save_strlen ne const_10.
* MESSAGE e130 RAISING not_valid.
result = 1.
else.
if savestcd2+2(1) ne '-'.
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.
if ( savestcd2(2) cn '1234567890' or savestcd2+3(7) cn '1234567890' )
.
* MESSAGE e130 RAISING not_valid.
result = 1.
endif.
endif.
endif.
*ELSE.
if savestcd1 ne space.
save_strlen = strlen( savestcd1 ).

if save_strlen ne const_11.
* MESSAGE e129 RAISING not_valid.
result = 1.
else.
if ( savestcd1+3(1) ne '-' or savestcd1+6(1) ne '-' ).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
if ( savestcd1(3) cn '1234567890' or savestcd1+4(2) cn '1234567890' o
r savestcd1+7(4) cn '1234567890' ).
* MESSAGE e129 RAISING not_valid.
result = 1.
endif.
endif.
endif.
*ENDIF.

endform. "check_taxcode_us

* -------------------------------------------------------------------- *
* FORM CHECK_TAXCODE_NL *
* -------------------------------------------------------------------- *
* RUC *
* NIF2 *
* -------------------------------------------------------------------- *
form check_taxcode_nl using ruc
nif2 like kna1_bf-stcd2.

data: refe type i,
savestcd1 like kna1_bf-stcd1,
savestcd2 like kna1_bf-stcd2,
summe type i,
weights(5) type c value '65432',
weight type i value 9,
return_flag(1) type c.

* CHECK RUC NE space.
savestcd1 = ruc.
if savestcd1 ne space.

if ( ( savestcd1(1) = 0 ) and ( savestcd1+1(1) = 0 ) and ( savestcd1+2(1) =
0 ) ).
* MESSAGE e501 RAISING invalid_taxnum.
result = 1.
endif.

do 8 times.
summe = summe + ( weight * savestcd1(1) ).
weight = weight - 1.
shift savestcd1.
enddo.

summe = summe mod 11.

if summe ne savestcd1.
if summe eq '10' and savestcd1 eq '0'.
return_flag = 'X'.
else.
return_flag = ''.
endif.
else.
return_flag = 'X'.
endif.

if return_flag <> 'X'.
* MESSAGE e501 RAISING invalid_taxnum.
result = 1.
endif.
endif.

* CHECK NIF2 NE space.
savestcd2 = nif2.
if savestcd2 ne space.

*------- Prfziffer berechnen ----------------------------------------
do 5 times.
summe = summe + ( savestcd2(1) * weights(1) ).
shift savestcd2.
shift weights.
enddo.
refe = summe mod 11.

if refe ne savestcd2.
if refe eq '10' and savestcd2+5(1) eq '0'.
return_flag = 'X'.
else.
return_flag = ''.
endif.
else.
return_flag = 'X'.
endif.

if return_flag <> 'X'.
* MESSAGE e502 RAISING invalid_taxnum.
result = 1.
endif.
endif.

endform. "CHECK_TAXCODE_NL

*eject
*-----------------------------------------------------------------------
* FORM CHECK_TAXCODE_RS
*-----------------------------------------------------------------------
* Prfung der Steuernummer SERBIA *
* -------------------------------------------------------------------- *
* RUC *
* PERSFISICA *
*-----------------------------------------------------------------------
form check_taxcode_rs using
ruc like kna1_bf-stcd1
persfisica like kna1_bf-stkzn.

data: refe type i,
savestcd1 like kna1_bf-stcd1,
summe type i,
weights(6) type c value '765432',
return_flag(1) type c,
save_strlen type i,
resultt type i value 10.

savestcd1 = ruc.
*------- Prfziffer berechnen ------------------------------------------
if persfisica ne space. "JMBG Number

save_strlen = strlen( savestcd1 ).
if save_strlen ne '13'.
* MESSAGE e503 RAISING invalid_taxnum.
result = 1.
else.
do 6 times.
summe = summe + ( savestcd1(1) * weights(1) ).
shift savestcd1.
shift weights circular.
enddo.

do 6 times.
summe = summe + ( savestcd1(1) * weights(1) ).
shift savestcd1.
shift weights.
enddo.

refe = summe mod 11.

if refe ne '0'.
refe = 11 - refe.
endif.

if refe ne savestcd1.
if refe eq '10' and savestcd1 eq '0'.
return_flag = 'X'.
else.
return_flag = ''.
endif.
else.
return_flag = 'X'.
endif.

if return_flag <> 'X'.
* MESSAGE e503 RAISING invalid_taxnum.
result = 1.
endif.
endif.

else. "PIB Number
save_strlen = strlen( savestcd1 ).
if save_strlen ne '9'.
* MESSAGE e504 RAISING invalid_taxnum.
result = 1.
else.
do 8 times.
summe = savestcd1(1) + resultt.
refe = summe mod 10.
if refe eq '0'.
refe = 10.
endif.
resultt = refe * 2.
resultt = resultt mod 11.
shift savestcd1.
clear summe.
enddo.

resultt = 11 - resultt.
if resultt ne savestcd1.
if resultt eq '10' and savestcd1 eq '0'.
return_flag = 'X'.
else.
return_flag = ''.
endif.
else.
return_flag = 'X'.
endif.

if return_flag <> 'X'.
* MESSAGE e504 RAISING invalid_taxnum.
result = 1.
endif.
endif.
endif.
endform. "CHECK_TAXCODE_RS


function zfi_rfcfn_csltmoneda.
*"----------------------------------------------------------------------
*"*"Interfase local
*" TABLES
*" MONEDAS STRUCTURE ZTMONEDA
*"----------------------------------------------------------------------


select waers ltext into corresponding fields of table monedas from tcurt wher
e spras eq 'S' and bnka-loevm eq ' '.


endfunction.


function zfi_rfcfn_crearacree.
*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(SOC) TYPE BUKRS
*" VALUE(ORGCOM) TYPE EKORG
*" VALUE(PAIS) TYPE LAND1
*" VALUE(NOMBRE1) TYPE NAME1_GP
*" VALUE(NOMBRE2) TYPE NAME2_GP OPTIONAL
*" VALUE(NOMBRE3) TYPE NAME3_GP OPTIONAL
*" VALUE(NOMBRE4) TYPE NAME4_GP OPTIONAL
*" VALUE(CONCEPTOBUS) TYPE AD_SORT1UL
*" VALUE(CALLE) TYPE AD_STREET
*" VALUE(DISTRITO) TYPE AD_CITY2 OPTIONAL
*" VALUE(POBLACION) TYPE AD_CITY1 OPTIONAL
*" VALUE(REGION) TYPE REGIO OPTIONAL
*" VALUE(TELEFONO1) TYPE AD_TLNMBR OPTIONAL
*" VALUE(EXTENSION1) TYPE AD_TLXTNS OPTIONAL
*" VALUE(NROESTANDAR1) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO1) TYPE AD_REMARK2 OPTIONAL
*" VALUE(TELEFONO2) TYPE AD_TLNMBR OPTIONAL
*" VALUE(EXTENSION2) TYPE AD_TLXTNS OPTIONAL
*" VALUE(NROESTANDAR2) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO2) TYPE AD_REMARK2 OPTIONAL
*" VALUE(TELEFONO3) TYPE AD_TLNMBR OPTIONAL
*" VALUE(EXTENSION3) TYPE AD_TLXTNS OPTIONAL
*" VALUE(NROESTANDAR3) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO3) TYPE AD_REMARK2 OPTIONAL
*" VALUE(TELEFONO4) TYPE AD_TLNMBR OPTIONAL
*" VALUE(EXTENSION4) TYPE AD_TLXTNS OPTIONAL
*" VALUE(NROESTANDAR4) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO4) TYPE AD_REMARK2 OPTIONAL
*" VALUE(TELEFONO5) TYPE AD_TLNMBR OPTIONAL
*" VALUE(EXTENSION5) TYPE AD_TLXTNS OPTIONAL
*" VALUE(NROESTANDAR5) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO5) TYPE AD_REMARK2 OPTIONAL
*" VALUE(TELEFONO6) TYPE AD_TLNMBR OPTIONAL
*" VALUE(EXTENSION6) TYPE AD_TLXTNS OPTIONAL
*" VALUE(NROESTANDAR6) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO6) TYPE AD_REMARK2 OPTIONAL
*" VALUE(EMAIL01) TYPE AD_SMTPADR OPTIONAL
*" VALUE(NROESTANDAR01) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO01) TYPE AD_REMARK2 OPTIONAL
*" VALUE(EMAIL02) TYPE AD_SMTPADR OPTIONAL
*" VALUE(NROESTANDAR02) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO02) TYPE AD_REMARK2 OPTIONAL
*" VALUE(EMAIL03) TYPE AD_SMTPADR OPTIONAL
*" VALUE(NROESTANDAR03) TYPE AD_FLGDFNR OPTIONAL
*" VALUE(COMENTARIO03) TYPE AD_REMARK2 OPTIONAL
*" VALUE(RUC) TYPE STCD1
*" VALUE(NIF02) TYPE STCD2 OPTIONAL
*" VALUE(NIF03) TYPE STCD3 OPTIONAL
*" VALUE(PERFISICA) TYPE STKZN OPTIONAL
*" VALUE(IVA) TYPE STKZU OPTIONAL
*" VALUE(FECHANAC) TYPE /BEV1/SRDATTXT OPTIONAL
*" VALUE(LUGARNAC) TYPE GBORT_Q OPTIONAL
*" VALUE(SEXO) TYPE SEXKZ OPTIONAL
*" VALUE(PROFESION) TYPE PROFS OPTIONAL
*" VALUE(PAIS01) TYPE BANKS OPTIONAL
*" VALUE(BANCO01) TYPE BANKK OPTIONAL
*" VALUE(CUENTA01) TYPE BANKN OPTIONAL
*" VALUE(CCI01) TYPE KOINH_FI OPTIONAL
*" VALUE(CC01) TYPE BKONT OPTIONAL
*" VALUE(TPBC01) TYPE BVTYP OPTIONAL
*" VALUE(REFERENCIA01) TYPE BKREF OPTIONAL
*" VALUE(PAIS02) TYPE BANKS OPTIONAL
*" VALUE(BANCO02) TYPE BANKK OPTIONAL
*" VALUE(CUENTA02) TYPE BANKN OPTIONAL
*" VALUE(CCI02) TYPE KOINH_FI OPTIONAL
*" VALUE(CC02) TYPE BKONT OPTIONAL
*" VALUE(TPBC02) TYPE BVTYP OPTIONAL
*" VALUE(REFERENCIA02) TYPE BKREF OPTIONAL
*" VALUE(PAIS03) TYPE BANKS OPTIONAL
*" VALUE(BANCO03) TYPE BANKK OPTIONAL
*" VALUE(CUENTA03) TYPE BANKN OPTIONAL
*" VALUE(CCI03) TYPE KOINH_FI OPTIONAL
*" VALUE(CC03) TYPE BKONT OPTIONAL
*" VALUE(TPBC03) TYPE BVTYP OPTIONAL
*" VALUE(REFERENCIA03) TYPE BKREF OPTIONAL
*" VALUE(PAIS04) TYPE BANKS OPTIONAL
*" VALUE(BANCO04) TYPE BANKK OPTIONAL
*" VALUE(CUENTA04) TYPE BANKN OPTIONAL
*" VALUE(CCI04) TYPE KOINH_FI OPTIONAL
*" VALUE(CC04) TYPE BKONT OPTIONAL
*" VALUE(TPBC04) TYPE BVTYP OPTIONAL
*" VALUE(REFERENCIA04) TYPE BKREF OPTIONAL
*" VALUE(CUENTAASOCIADA) TYPE AKONT
*" VALUE(GPTESORERIA) TYPE FDGRV
*" VALUE(CONDPAGO) TYPE DZTERM
*" VALUE(MONEDAPEDIDO) TYPE BSTWA
*" VALUE(GRESQUEMAPROVEEDOR) TYPE KALSK
*" EXPORTING
*" VALUE(RESULT) TYPE LIFNR
*"----------------------------------------------------------------------





*perform open_dataset using dataset.
*perform open_group.

*do.
*
*read dataset dataset into record.
*if sy-subrc <> 0. exit. endif.



perform bdc_dynpro using 'SAPMF02K' '0100'.
perform bdc_field using 'BDC_CURSOR'
'USE_ZAV'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'RF02K-BUKRS'
soc.
perform bdc_field using 'RF02K-EKORG'
orgcom.
perform bdc_field using 'RF02K-KTOKK'
'NR01'.
perform bdc_field using 'USE_ZAV'
'X'.
perform bdc_dynpro using 'SAPMF02K' '0111'.
perform bdc_field using 'BDC_OKCODE'
'=$MTE'.
perform bdc_field using 'BDC_CURSOR'
'ADDR1_DATA-REGION'.
perform bdc_field using 'ADDR1_DATA-NAME1'
nombre1.
perform bdc_field using 'ADDR1_DATA-NAME2'
nombre2.
perform bdc_field using 'ADDR1_DATA-NAME3'
nombre3.
perform bdc_field using 'ADDR1_DATA-NAME4'
nombre3.
perform bdc_field using 'ADDR1_DATA-SORT1'
conceptobus.
perform bdc_field using 'ADDR1_DATA-STREET'
calle.
perform bdc_field using 'ADDR1_DATA-CITY2'
distrito.
perform bdc_field using 'ADDR1_DATA-CITY1'
poblacion.
perform bdc_field using 'ADDR1_DATA-COUNTRY'
pais.
perform bdc_field using 'ADDR1_DATA-REGION'
region.
perform bdc_field using 'ADDR1_DATA-LANGU'
'ES'.
perform bdc_dynpro using 'SAPLSZA6' '0200'.
perform bdc_field using 'BDC_CURSOR'
'ADTEL-REMARK(01)'.
if not telefono2 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADTEL-TEL_NUMBER(01)'
telefono1.
perform bdc_field using 'ADTEL-TEL_EXTENS(01)'
extension1.
perform bdc_field using 'ADTEL-FLGDEFAULT(01)'
nroestandar1.
perform bdc_field using 'ADTEL-REMARK(01)'
comentario1.
if not telefono2 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0200'.
perform bdc_field using 'BDC_CURSOR'
'ADTEL-REMARK(01)'.

if not telefono3 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADTEL-TEL_NUMBER(01)'
telefono2.
perform bdc_field using 'ADTEL-TEL_EXTENS(01)'
extension2.
perform bdc_field using 'ADTEL-FLGDEFAULT(01)'
nroestandar2.
perform bdc_field using 'ADTEL-REMARK(01)'
comentario2.
endif.
if not telefono3 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0200'.
perform bdc_field using 'BDC_CURSOR'
'ADTEL-REMARK(01)'.
if not telefono4 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADTEL-TEL_NUMBER(01)'
telefono3.
perform bdc_field using 'ADTEL-TEL_EXTENS(01)'
extension3.
perform bdc_field using 'ADTEL-FLGDEFAULT(01)'
nroestandar3.
perform bdc_field using 'ADTEL-REMARK(01)'
comentario3.
endif.
if not telefono4 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0200'.
perform bdc_field using 'BDC_CURSOR'
'ADTEL-REMARK(01)'.
if not telefono5 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADTEL-TEL_NUMBER(01)'
telefono4.
perform bdc_field using 'ADTEL-TEL_EXTENS(01)'
extension4.
perform bdc_field using 'ADTEL-FLGDEFAULT(01)'
nroestandar4.
perform bdc_field using 'ADTEL-REMARK(01)'
comentario4.
endif.
if not telefono5 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0200'.
perform bdc_field using 'BDC_CURSOR'
'ADTEL-REMARK(01)'.
if not telefono6 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADTEL-TEL_NUMBER(01)'
telefono5.
perform bdc_field using 'ADTEL-TEL_EXTENS(01)'
extension5.
perform bdc_field using 'ADTEL-FLGDEFAULT(01)'
nroestandar5.
perform bdc_field using 'ADTEL-REMARK(01)'
comentario5.
endif.
if not telefono6 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0200'.
perform bdc_field using 'BDC_CURSOR'
'ADTEL-REMARK(01)'.

perform bdc_field using 'BDC_OKCODE'
'=CONT'.
perform bdc_field using 'ADTEL-TEL_NUMBER(01)'
telefono6.
perform bdc_field using 'ADTEL-TEL_EXTENS(01)'
extension6.
perform bdc_field using 'ADTEL-FLGDEFAULT(01)'
nroestandar6.
perform bdc_field using 'ADTEL-REMARK(01)'
comentario6.
endif.
perform bdc_dynpro using 'SAPMF02K' '0111'.
perform bdc_field using 'BDC_OKCODE'
'=$INT'.
perform bdc_field using 'BDC_CURSOR'
'ADDR1_DATA-REGION'.
perform bdc_field using 'ADDR1_DATA-NAME1'
nombre1.
perform bdc_field using 'ADDR1_DATA-NAME2'
nombre2.
perform bdc_field using 'ADDR1_DATA-NAME3'
nombre3.
perform bdc_field using 'ADDR1_DATA-NAME4'
nombre4.
perform bdc_field using 'ADDR1_DATA-SORT1'
conceptobus.
perform bdc_field using 'ADDR1_DATA-STREET'
calle.
perform bdc_field using 'ADDR1_DATA-CITY2'
distrito.
perform bdc_field using 'ADDR1_DATA-CITY1'
poblacion.
perform bdc_field using 'ADDR1_DATA-COUNTRY'
pais.
perform bdc_field using 'ADDR1_DATA-REGION'
region.
perform bdc_field using 'ADDR1_DATA-LANGU'
'ES'.
perform bdc_field using 'SZA1_D0100-TEL_NUMBER'
telefono1.
perform bdc_field using 'SZA1_D0100-TEL_EXTENS'
extension1.
perform bdc_dynpro using 'SAPLSZA6' '0600'.
perform bdc_field using 'BDC_CURSOR'
'ADSMTP-REMARK(01)'.
if not email02 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADSMTP-SMTP_ADDR(01)'
email01.
perform bdc_field using 'ADSMTP-FLGDEFAULT(01)'
nroestandar01.
perform bdc_field using 'ADSMTP-REMARK(01)'
comentario01.

if not email02 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0600'.
perform bdc_field using 'BDC_CURSOR'
'ADSMTP-REMARK(01)'.

if not email03 is initial.
perform bdc_field using 'BDC_OKCODE'
'=NEWL'.
else.
perform bdc_field using 'BDC_OKCODE'
'=CONT'.
endif.
perform bdc_field using 'ADSMTP-SMTP_ADDR(01)'
email02.
perform bdc_field using 'ADSMTP-FLGDEFAULT(01)'
nroestandar02.
perform bdc_field using 'ADSMTP-REMARK(01)'
comentario02.
endif.

if not email03 is initial.
perform bdc_dynpro using 'SAPLSZA6' '0600'.
perform bdc_field using 'BDC_CURSOR'
'ADSMTP-REMARK(01)'.

perform bdc_field using 'BDC_OKCODE'
'=CONT'.
perform bdc_field using 'ADSMTP-SMTP_ADDR(01)'
email03.
perform bdc_field using 'ADSMTP-FLGDEFAULT(01)'
nroestandar03.
perform bdc_field using 'ADSMTP-REMARK(01)'
comentario03.
endif.
perform bdc_dynpro using 'SAPMF02K' '0111'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'SZA1_D0100-SMTP_ADDR'.
perform bdc_field using 'ADDR1_DATA-NAME1'
nombre1.
perform bdc_field using 'ADDR1_DATA-NAME2'
nombre2.
perform bdc_field using 'ADDR1_DATA-NAME3'
nombre3.
perform bdc_field using 'ADDR1_DATA-NAME4'
nombre4.
perform bdc_field using 'ADDR1_DATA-SORT1'
conceptobus.
perform bdc_field using 'ADDR1_DATA-STREET'
calle.
perform bdc_field using 'ADDR1_DATA-CITY2'
distrito.
perform bdc_field using 'ADDR1_DATA-CITY1'
poblacion.
perform bdc_field using 'ADDR1_DATA-COUNTRY'
pais.
perform bdc_field using 'ADDR1_DATA-REGION'
region.
perform bdc_field using 'ADDR1_DATA-LANGU'
'ES'.
perform bdc_field using 'SZA1_D0100-TEL_NUMBER'
telefono1.
perform bdc_field using 'SZA1_D0100-TEL_EXTENS'
extension1.
perform bdc_field using 'SZA1_D0100-SMTP_ADDR'
email01.
perform bdc_dynpro using 'SAPMF02K' '0120'.
perform bdc_field using 'BDC_CURSOR'
'LFA1-PROFS'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'LFA1-KUNNR'
''.
perform bdc_field using 'LFA1-BEGRU'
'NR01'.
perform bdc_field using 'LFA1-KONZS'
''.
perform bdc_field using 'LFA1-STCD1'
ruc.
perform bdc_field using 'LFA1-STCDT'
'80'.
perform bdc_field using 'LFA1-STCD2'
nif02.
perform bdc_field using 'LFA1-STKZN'
perfisica.
perform bdc_field using 'LFA1-STKZU'
iva.
perform bdc_field using 'LFA1-STCD3'
nif03.
perform bdc_field using 'LFA1-GBDAT'
fechanac.
perform bdc_field using 'LFA1-GBORT'
lugarnac.
perform bdc_field using 'LFA1-SEXKZ'
sexo.
perform bdc_field using 'LFA1-PROFS'
profesion.
perform bdc_dynpro using 'SAPMF02K' '0130'.
perform bdc_field using 'BDC_CURSOR'
'LFBK-BVTYP(03)'.
perform bdc_field using 'BDC_OKCODE'
'ENTR'.
perform bdc_field using 'LFBK-BANKS(01)'
pais01.
if not pais02 is initial.
perform bdc_field using 'LFBK-BANKS(02)'
pais02.
endif.
perform bdc_field using 'LFBK-BANKL(01)'
banco01.
if not pais02 is initial.
perform bdc_field using 'LFBK-BANKL(02)'
banco02.
endif.
perform bdc_field using 'LFBK-BANKN(01)'
cuenta01.
if not pais02 is initial.
perform bdc_field using 'LFBK-BANKN(02)'
cuenta02.
endif.
perform bdc_field using 'LFBK-KOINH(01)'
cci01.
if not pais02 is initial.
perform bdc_field using 'LFBK-KOINH(02)'
cci02.
endif.
perform bdc_field using 'LFBK-BKONT(01)'
cc01.
if not pais02 is initial.
perform bdc_field using 'LFBK-BKONT(02)'
cc02.
endif.
perform bdc_field using 'LFBK-BVTYP(01)'
tpbc01.
if not pais02 is initial.
perform bdc_field using 'LFBK-BVTYP(02)'
tpbc02.
endif.
perform bdc_field using 'LFBK-BKREF(01)'
referencia01.
if not pais02 is initial.
perform bdc_field using 'LFBK-BKREF(02)'
referencia02.
endif.
if not pais03 is initial.
perform bdc_dynpro using 'SAPMF02K' '0130'.
perform bdc_field using 'BDC_CURSOR'
'LFBK-BKREF(04)'.
perform bdc_field using 'BDC_OKCODE'
'=ENTR'.
perform bdc_field using 'LFBK-BANKS(03)'
pais03.
if not pais04 is initial.
perform bdc_field using 'LFBK-BANKS(04)'
pais04.
endif.
perform bdc_field using 'LFBK-BANKL(03)'
banco03.
if not pais04 is initial.
perform bdc_field using 'LFBK-BANKL(04)'
banco04.
endif.
perform bdc_field using 'LFBK-BANKN(03)'
cuenta03.
if not pais04 is initial.
perform bdc_field using 'LFBK-BANKN(04)'
cuenta04.
endif.
perform bdc_field using 'LFBK-KOINH(03)'
cci03.
if not pais04 is initial.
perform bdc_field using 'LFBK-KOINH(04)'
cci04.
endif.
perform bdc_field using 'LFBK-BKONT(03)'
cc03.
if not pais04 is initial.
perform bdc_field using 'LFBK-BKONT(04)'
cc04.
endif.
perform bdc_field using 'LFBK-BVTYP(03)'
tpbc03.
if not pais04 is initial.
perform bdc_field using 'LFBK-BVTYP(04)'
tpbc04.
endif.
perform bdc_field using 'LFBK-BKREF(03)'
referencia03.
if not pais04 is initial.
perform bdc_field using 'LFBK-BKREF(04)'
referencia04.
endif.
endif.
perform bdc_dynpro using 'SAPMF02K' '0130'.
perform bdc_field using 'BDC_CURSOR'
'LFBK-BANKS(01)'.
perform bdc_field using 'BDC_OKCODE'
'=ENTR'.
perform bdc_dynpro using 'SAPMF02K' '0210'.
perform bdc_field using 'BDC_CURSOR'
'LFB1-FRGRP'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'LFB1-AKONT'
cuentaasociada.
perform bdc_field using 'LFB1-ZUAWA'
'040'.
perform bdc_field using 'LFB1-BEGRU'
'NR01'.
perform bdc_field using 'LFB1-FDGRV'
gptesoreria.
perform bdc_field using 'LFB1-FRGRP'
'PR00'.
perform bdc_dynpro using 'SAPMF02K' '0215'.
perform bdc_field using 'BDC_CURSOR'
'LFB1-ZWELS'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'LFB1-ZTERM'
condpago.
perform bdc_field using 'LFB1-REPRF'
'X'.
perform bdc_field using 'LFB1-ZWELS'
'C'.
perform bdc_dynpro using 'SAPMF02K' '0220'.
perform bdc_field using 'BDC_CURSOR'
'LFB5-MAHNA'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
*perform bdc_dynpro using 'SAPMF02K' '0610'.
*perform bdc_field using 'BDC_OKCODE'
* '/00'.
*perform bdc_field using 'BDC_CURSOR'
* 'LFB1-QLAND'.
*---
if perfisica eq '' and iva eq ''.
perform bdc_dynpro using 'SAPMF02K' '0610'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'LFBW-WT_SUBJCT(01)'.
perform bdc_field using 'LFBW-WITHT(01)'
'RJ'.
perform bdc_field using 'LFBW-WT_WITHCD(01)'
''.
perform bdc_field using 'LFBW-WT_SUBJCT(01)'
'X'.
perform bdc_dynpro using 'SAPMF02K' '0610'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'LFBW-WT_SUBJCT(01)'.
else.
if perfisica eq 'X' and iva eq ''.
perform bdc_dynpro using 'SAPMF02K' '0610'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'LFBW-WT_SUBJCT(01)'.
perform bdc_field using 'LFBW-WITHT(01)'
'RD'.
perform bdc_field using 'LFBW-WT_WITHCD(01)'
'RB'.
perform bdc_field using 'LFBW-WT_SUBJCT(01)'
'X'.
perform bdc_dynpro using 'SAPMF02K' '0610'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'LFBW-WT_SUBJCT(01)'.
else.
perform bdc_dynpro using 'SAPMF02K' '0610'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'LFBW-WT_SUBJCT(01)'.
perform bdc_field using 'LFBW-WITHT(01)'
'D0'.
perform bdc_field using 'LFBW-WT_WITHCD(01)'
'00'.
perform bdc_field using 'LFBW-WT_SUBJCT(01)'
'X'.
perform bdc_dynpro using 'SAPMF02K' '0610'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'LFBW-WT_SUBJCT(01)'.
endif.

endif.
*------
perform bdc_dynpro using 'SAPMF02K' '0310'.
perform bdc_field using 'BDC_CURSOR'
'LFM1-WEBRE'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'LFM1-WAERS'
monedapedido.
perform bdc_field using 'LFM1-ZTERM'
condpago.
perform bdc_field using 'LFM1-KALSK'
gresquemaproveedor.
perform bdc_field using 'LFM1-WEBRE'
'X'.
perform bdc_dynpro using 'SAPMF02K' '0320'.
perform bdc_field using 'BDC_CURSOR'
'WYT3-PARVW(01)'.
perform bdc_field using 'BDC_OKCODE'
'=UPDA'.
*perform bdc_transaction using 'XK01'.
opt-
defsize = 'X'. "Tamao Estandar (Para que las pantallas no varien de tamao)
opt-
dismode = 'N'. "Modo Visual (para que vean como se ejecuta el batch, registro
x reg.)
opt-
updmode = 'S'. "Actualizacin sincronic (No s q ser pero ponganlo noms)
* Llamada a la MM01
call transaction 'XK01' using bdcdata options from opt messages into mess
tab.
loop at messtab assigning <fs_record2>.
clear w_mensaje.
w_msgid = <fs_record2>-msgid.
w_msgno = <fs_record2>-msgnr.
w_msgty = <fs_record2>-msgtyp.
w_msgv1 = <fs_record2>-msgv1.
if not <fs_record2>-msgid is initial.

"Funcin convierte cdigos del messtab en mensajes
call function 'K_MESSAGE_TRANSFORM'
exporting
par_langu = 'S'"Espaol
par_msgid = w_msgid "ID Mensaje
par_msgno = w_msgno "Tipo mensaje
par_msgty = w_msgty
par_msgv1 = w_msgv1
importing
par_msgtx = w_mensaje. "Devuelve mensajes

append initial line to gdt_mensajes assigning <fs_record3>.
<fs_record3>-mensaje = w_mensaje.
<fs_record3>-tipo_mensaje = <fs_record2>-msgtyp.
endif.
endloop.
loop at gdt_mensajes assigning <fs_record3>.

"------>>> Validacion - 1
if <fs_record3>-tipo_mensaje = 'E'.
<fs_record3>-lights = '1'.
result = 0.
endif.

"------>>> Validacion - 1
* if <fs_record3>-tipo_mensaje = 'W'.
* <fs_record3>-lights = '2'.
* endif.
"------>>> Validacion - 1
if <fs_record3>-tipo_mensaje = 'S'.
<fs_record3>-lights = '3'.
select single lifnr into result from lfa1
where land1 = pais
and regio = region
and name1 = nombre1
and stcd1 = ruc.
endif.
endloop.
if sy-subrc ne 0.
"MESSAGE e001 WITH PAIS RAISING not_valid.
result = 0.
endif.
endfunction.

form bdc_dynpro using program dynpro.
clear bdcdata.
bdcdata-program = program.
bdcdata-dynpro = dynpro.
bdcdata-dynbegin = 'X'.
append bdcdata.
endform. "BDC_DYNPRO

*----------------------------------------------------------------------*
* Insert field *
*----------------------------------------------------------------------*
form bdc_field using fnam fval.
if fval <> nodata.
clear bdcdata.
bdcdata-fnam = fnam.
bdcdata-fval = fval.
append bdcdata.
endif.
endform.


function zfi_rfcfn_consultapedidos.
*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(RUC) TYPE STCD1 OPTIONAL
*" VALUE(MATERIAL) TYPE BAPIGSBOOL OPTIONAL
*" VALUE(SERVICIO) TYPE BAPIGSBOOL OPTIONAL
*" VALUE(COMPLETOS) TYPE BAPIGSBOOL OPTIONAL
*" VALUE(PENDIENTES) TYPE BAPIGSBOOL OPTIONAL
*" VALUE(PARCIALES) TYPE BAPIGSBOOL OPTIONAL
*" VALUE(FECHAINICIO) TYPE EBDAT OPTIONAL
*" VALUE(FECHAFIN) TYPE EBDAT OPTIONAL
*" TABLES
*" SOCIEDAD STRUCTURE ZRANGO_SOC OPTIONAL
*" RESULT STRUCTURE ZRESULT
*"----------------------------------------------------------------------

*IF MATERIAL EQ 'X'.
* PERFORM validar_material.
* ELSEIF SERVICIO EQ 'X'.
* PERFORM validar_servicio.
* ENDIF.
loop at sociedad assigning <fs_soc2>.
append initial line to ts_soc assigning <fs_soc>.
<fs_soc>-sign = 'I'.
<fs_soc>-option = 'EQ'.
<fs_soc>-low = <fs_soc2>-bukrs.

endloop.

select bwkey into table ts_centro from t001k where bukrs in ts_soc.
select single lifnr into acreedor from lfa1 where stcd1 = ruc.
loop at ts_centro assigning <fs_centro>.
append initial line to
ts_werks assigning <fs_werks>.
<fs_werks>-sign = 'I'.
<fs_werks>-option = 'EQ'.
<fs_werks>-low = <fs_centro>-centro.
endloop.

if material eq 'X'.
s_ebeln-sign = 'I'.
s_ebeln-option = 'CP'.
s_ebeln-low = '4*'.
append s_ebeln.
select ebeln bsart ernam lifnr ekgrp bedat waers
into table t_ekko
from ekko
where ebeln in s_ebeln
* AND bsart IN s_bsart
* AND ernam IN s_ernam
and lifnr eq acreedor
* AND ekgrp IN s_ekgrp
and bedat ge fechainicio
and bedat le fechafin
and frgke eq c_l.

if sy-subrc eq 0.
select l~lifnr l~name1 a~smtp_addr
into table t_lfa1
from lfa1 as l left join adr6 as a
on l~adrnr eq a~addrnumber
and a~flgdefault eq 'X' " CAA12072010
for all entries in t_ekko
where l~lifnr eq t_ekko-lifnr.
* AND a~flgdefault EQ 'X' " CAA12072010

select ebeln ebelp matnr txz01 werks meins bukrs netwr
appending corresponding fields of table t_ekpo
from ekpo
for all entries in t_ekko
where ebeln eq t_ekko-ebeln
* AND matnr IN s_matnr
and werks in ts_werks
and loekz eq space. "INS MCS200910

if not t_ekpo[] is initial.

select ebeln ebelp etenr eindt menge wemng
into table t_eket
from eket
for all entries in t_ekpo
where ebeln eq t_ekpo-ebeln
and ebelp eq t_ekpo-ebelp.

endif.
endif.

elseif servicio eq 'X'.

s_ebeln-sign = 'I'.
s_ebeln-option = 'CP'.
s_ebeln-low = '2*'.
append s_ebeln.
select ebeln bsart ernam lifnr ekgrp bedat waers
into table t_ekko
from ekko
where ebeln in s_ebeln
* AND bsart IN s_bsart
* AND ernam IN s_ernam
and lifnr eq acreedor
* AND ekgrp IN s_ekgrp
and bedat ge fechainicio
and bedat le fechafin
and frgke eq c_l.

if sy-subrc eq 0.
select l~lifnr l~name1 a~smtp_addr
into table t_lfa1
from lfa1 as l left join adr6 as a
on l~adrnr eq a~addrnumber
and a~flgdefault eq 'X' " CAA12072010
for all entries in t_ekko
where l~lifnr eq t_ekko-lifnr.
* AND a~flgdefault EQ 'X' " CAA12072010

select ebeln ebelp matnr txz01 werks meins packno bukrs netwr
into table t_ekpo
from ekpo
for all entries in t_ekko
where ebeln eq t_ekko-ebeln
* AND matnr IN s_matnr
and werks in ts_werks
and loekz eq space. "INS MCS200910

if not t_ekpo[] is initial.

select ebeln ebelp bewtp zekkn
bwart budat wrbtr waers elikz
into table t_ekbe
from ekbe
for all entries in t_ekpo
where ebeln eq t_ekpo-ebeln
and ebelp eq t_ekpo-ebelp
and bewtp eq c_e
and bwart eq c_101.
* AND elikz NE space.

if sy-subrc eq 0.

select ebeln ebelp zekkn netwr
into table t_ekkn
from ekkn
for all entries in t_ekbe
where ebeln eq t_ekbe-ebeln
and ebelp eq t_ekbe-ebelp
and zekkn eq t_ekbe-zekkn.

endif.

select distinct packno sub_packno
into table t_esll
from esll
for all entries in t_ekpo
where packno eq t_ekpo-packno.

select ebeln ebelp etenr eindt menge wemng
into table t_eket
from eket
for all entries in t_ekpo
where ebeln eq t_ekpo-ebeln
and ebelp eq t_ekpo-ebelp.
endif.
endif.
endif.
sort t_ekko by lifnr ebeln.
sort t_ekpo by ebeln ebelp packno.
sort t_eket by ebeln ebelp.
sort t_ekbe by ebeln ebelp zekkn.
sort t_ekkn by ebeln ebelp zekkn.
sort t_esll by packno.

if material eq 'X'.
loop at t_ekko.

loop at t_ekpo where ebeln eq t_ekko-ebeln.

loop at t_eket where ebeln eq t_ekpo-ebeln and
ebelp eq t_ekpo-ebelp.

* IF sy-subrc EQ 0.

t_reporte-ebeln = t_ekko-ebeln.
t_reporte-bsart = t_ekko-bsart.
t_reporte-ernam = t_ekko-ernam.
t_reporte-lifnr = t_ekko-lifnr.
t_reporte-ekgrp = t_ekko-ekgrp.
t_reporte-bedat = t_ekko-bedat.
t_reporte-waers = t_ekko-waers.
t_reporte-bukrs = t_ekpo-bukrs.
t_reporte-netwr = t_ekpo-netwr.

read table t_lfa1 with table key lifnr = t_ekko-lifnr.
if sy-subrc eq 0.

t_reporte-name1 = t_lfa1-name1.
t_reporte-smtp_addr = t_lfa1-smtp_addr.

endif.

t_reporte-ebelp = t_ekpo-ebelp.

call function 'CONVERSION_EXIT_MATN1_OUTPUT'
exporting
input = t_ekpo-matnr
importing
output = t_reporte-matnr.

t_reporte-txz01 = t_ekpo-txz01.
t_reporte-werks = t_ekpo-werks.

call function 'CONVERSION_EXIT_CUNIT_OUTPUT'
exporting
input = t_ekpo-meins
language = sy-langu
importing
output = t_reporte-mein1
exceptions
unit_not_found = 1
others = 2.
if sy-subrc <> 0.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.

t_reporte-mein2 = t_reporte-mein1.

t_reporte-etenr = t_eket-etenr.
t_reporte-eindt = t_eket-eindt.
t_reporte-menge = t_eket-menge.
t_reporte-wemng = t_eket-wemng.

read table t_ekbe with key ebeln = t_eket-ebeln
ebelp = t_eket-ebelp.
if sy-subrc eq 0.
t_reporte-elikz = t_ekbe-elikz.
endif.


if t_reporte-menge eq t_reporte-wemng or
t_reporte-elikz ne space.
t_reporte-estad = c_completo.
elseif t_reporte-menge ne t_reporte-wemng and
t_reporte-wemng gt 0 "INS MCS220910
* t_reporte-eindt GE sy-datum "DEL MCS220910
.
t_reporte-estad = c_parcial.
elseif t_reporte-menge ne t_reporte-wemng and
( t_reporte-eindt lt sy-datum ) or
( t_reporte-eindt gt sy-datum and "INS MCS220910
t_reporte-wemng eq 0 ). "INS MCS220910
t_reporte-estad = c_pendiente.
endif.

if t_reporte-estad ne c_completo.
if t_reporte-eindt le sy-datum.
t_reporte-diasc = sy-datum - t_reporte-eindt.
* t_reporte-icon = '@08@'. "CAAA11082010
t_reporte-icon = '@0A@'. "MCS220910
else.
t_reporte-diasc = ( t_reporte-eindt - sy-datum ) * -1.
* t_reporte-icon = '@0A@'. "CAAA11082010
t_reporte-icon = '@08@'. "MCS220910
endif.
endif.

* BEGIN LSA121010
* APPEND t_reporte.
if ( completos eq 'X' and t_reporte-estad eq c_completo )
or ( parciales eq 'X' and t_reporte-estad eq c_parcial )
or ( pendientes eq 'X' and t_reporte-estad eq c_pendiente ).
append t_reporte.

endif.
* END LSA121010

clear t_reporte.

* ENDIF.
endloop.
endloop.

endloop.
sort t_reporte by lifnr ebeln ebelp.
loop at t_reporte.
move: t_reporte-menge to v_menge.
move: t_reporte-wemng to v_wemng.
move: t_reporte-netwr to v_netwr.
concatenate t_reporte-bukrs t_reporte-ebeln t_reporte-ebelp t_reporte-
txz01 v_menge t_reporte-mein1 v_wemng t_reporte-mein2 t_reporte-
waers v_netwr t_reporte-eindt t_reporte-estad t_reporte-ernam into result-
resultado
separated by '|'.
append result.
endloop.
elseif servicio eq 'X'.
data: v_packno type packno,
v_zekkn type dzekkn.
data: t_esll_temp type standard table of ty_esll_temp with header line.

loop at t_ekko.
loop at t_ekpo where ebeln eq t_ekko-ebeln.
read table t_esll with table key packno = t_ekpo-packno.
if sy-subrc eq 0.
clear v_packno.
select single packno
into v_packno
from esll
where packno eq t_esll-sub_packno.
if sy-subrc eq 0.
refresh t_esll_temp.
clear t_esll_temp.
select extrow srvpos menge netwr ktext1
into table t_esll_temp
from esll
where packno eq v_packno.
if sy-subrc eq 0.
loop at t_esll_temp.
t_reporte-ebeln = t_ekko-ebeln.
t_reporte-ebelp = t_ekpo-ebelp.
t_reporte-txz01 = t_ekpo-txz01.
t_reporte-waers = t_ekko-waers.
t_reporte-bukrs = t_ekpo-bukrs.
t_reporte-netwr = t_ekpo-netwr.
t_reporte-ernam = t_ekko-ernam.

read table t_lfa1 with table key lifnr = t_ekko-lifnr.
if sy-subrc eq 0.

t_reporte-name1 = t_lfa1-name1.
t_reporte-smtp_addr = t_lfa1-smtp_addr.

endif.
t_reporte-lifnr = t_ekko-lifnr.
t_reporte-extrow = t_esll_temp-extrow.

call function 'CONVERSION_EXIT_ALPHA_OUTPUT'
exporting
input = t_esll_temp-srvpos
importing
output = t_reporte-srvpos.
* BEGIN MIH241110
select single waers into t_reporte-waer1
from eslh
where packno eq v_packno.
* END MIH241110
t_reporte-menge = t_esll_temp-menge.
t_reporte-valne = t_esll_temp-netwr. "MIH241110
t_reporte-ktext1 = t_esll_temp-ktext1.

clear v_zekkn.
v_zekkn = t_esll_temp-extrow / 10.

read table t_ekbe with table key ebeln = t_ekpo-ebeln
ebelp = t_ekpo-ebelp
zekkn = v_zekkn.
if sy-subrc eq 0.
t_reporte-elikz = t_ekbe-elikz.
t_reporte-budat = t_ekbe-budat.
t_reporte-valac = t_ekbe-wrbtr.
* t_reporte-waer1 = t_ekbe-waers. "MIH241110
t_reporte-waer2 = t_ekbe-waers.

read table t_ekkn with table key ebeln = t_ekbe-ebeln
ebelp = t_ekbe-ebelp
zekkn = t_ekbe-zekkn.
if sy-subrc eq 0.
* t_reporte-valne = t_ekkn-netwr. "MIH241110
endif.

endif.

read table t_eket with table key ebeln = t_ekpo-ebeln
ebelp = t_ekpo-ebelp.
if sy-subrc eq 0.
t_reporte-eindt = t_eket-eindt.
endif.

if t_reporte-valac eq t_reporte-valne or
t_reporte-elikz ne space.
t_reporte-estad = c_completo.
elseif t_reporte-valac ne t_reporte-valne and
t_reporte-valac gt 0 "INS MCS220910
* t_reporte-eindt GE sy-datum "DEL MCS220910
.
t_reporte-estad = c_parcial.
elseif t_reporte-valac ne t_reporte-valne and
( t_reporte-eindt lt sy-datum ) or
( t_reporte-eindt gt sy-datum and "INS MCS220910
t_reporte-valac eq 0 ). "INS MCS220910
t_reporte-estad = c_pendiente.
endif.

if t_reporte-estad ne c_completo.
if t_reporte-eindt le sy-datum.
t_reporte-diasc = sy-datum - t_reporte-eindt.
* t_reporte-icon = '@08@'. "CAAA11082010
t_reporte-icon = '@0A@'. "MCS220110
else.
t_reporte-diasc = ( t_reporte-eindt - sy-datum ) * -1.
* t_reporte-icon = '@0A@'. "CAAA11082010
t_reporte-icon = '@08@'. "MCS220110
endif.
endif.

* BEGIN LSA121010
* APPEND t_reporte.
if ( completos eq 'X' and t_reporte-estad eq c_completo )
or ( parciales eq 'X' and t_reporte-estad eq c_parcial )
or ( pendientes eq 'X' and t_reporte-
estad eq c_pendiente ).
append t_reporte.

endif.
* END LSA121010
clear t_reporte.

endloop.

endif.


endif.
endif.

endloop.

endloop.

sort t_reporte by lifnr ebeln ebelp extrow.
loop at t_reporte.
move: t_reporte-valne to v_netwr.
concatenate t_reporte-bukrs t_reporte-ebeln t_reporte-ebelp t_reporte-
ktext1 t_reporte-waers v_netwr t_reporte-eindt t_reporte-budat t_reporte-
estad t_reporte-ernam into result-resultado
separated by '|'.
append result.
endloop.
endif.
*PERFORM: "Obtenemos los datos del reporte de las tablas principales
* "Procesa la data obtenida y se almacena el la tabla final
* filtrar_data. "Filtra la data de acuerdo al radio buton marcado
por el usuario
*

endfunction.


function zfi_rfcfn_partidasacreedor.
*"----------------------------------------------------------------------
*"*"Interfase local
*" IMPORTING
*" VALUE(SOCIEDAD) TYPE BUKRS
*" VALUE(CUENTA) TYPE KOART
*" VALUE(FECHAINICIO) TYPE BUDAT
*" VALUE(FECHAFIN) TYPE BUDAT
*" VALUE(RUC) TYPE STCD1
*" VALUE(NRODOC) TYPE AUGBL OPTIONAL
*" VALUE(INDPAGO) TYPE AFWCH_FLAG OPTIONAL
*" TABLES
*" RESULT STRUCTURE ZRESULT
*"----------------------------------------------------------------------
if nrodoc is initial.
if cuenta eq 'K'.
if indpago eq ' '.
select single lifnr into acreedor from lfa1 where stcd1 = ruc.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'Q*'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'U*'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'L*'.
append s_blart.
* s_blart-SIGN = 'I'.
* s_blart-option = 'EQ'.
* s_blart-low = 'KO'.
* APPEND s_blart.
* s_blart-SIGN = 'I'.
* s_blart-option = 'NE'.
* s_blart-low = 'LX'.
* APPEND s_blart.
* s_blart-SIGN = 'I'.
* s_blart-option = 'NE'.
* s_blart-low = 'QX'.
* APPEND s_blart.
* s_blart-SIGN = 'I'.
* s_blart-option = 'NE'.
* s_blart-low = 'UX'.
* APPEND s_blart.
select bukrs lifnr budat xblnr zuonr
belnr blart bldat zfbdt zterm
waers wrbtr augbl augdt sgtxt
shkzg qbshb
into
(st_partida-socie, st_partida-codruc, st_partida-fecha, st_partida-
nrofactura, st_partida-asignacion,
st_partida-nrodocumento, st_partida-tipodoc, st_partida-
fechafact, st_partida-fecharecep, st_partida-conpago,
st_partida-moneda, st_partida-importe, st_partida-
docpago, st_partida-fechapago, st_partida-descripcion,
st_partida-signo, st_partida-qbshb)
* corresponding fields of table ti_partida
from bsik
where bukrs eq sociedad
and lifnr eq acreedor
and budat ge fechainicio
and budat le fechafin
and ( blart in s_blart or blart eq 'KO' )
and ( blart ne 'LX'and blart ne 'QX' and blart ne 'UX' )
and not augbl like '29%'
order by bukrs lifnr budat.
st_partida-importe = st_partida-importe + st_partida-qbshb.
st_partida-estado = 'Abierta'.
clear st_partida-vencimiento.
if st_partida-vencimiento is initial.
select single cpudt into st_partida-fecharegistro from bkpf
where bukrs eq sociedad
and blart eq st_partida-tipodoc
and belnr eq st_partida-nrodocumento
and budat eq st_partida-fecha.
select single ztag1 into st_partida-diasconpago from t052
where zterm eq st_partida-conpago.
v_fechafutura = st_partida-fecharecep + st_partida-diasconpago.
call function 'DAY_IN_WEEK'
exporting
datum = st_partida-fecharegistro
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago1 = st_partida-fecharegistro + 10.
endif.
if diatemp eq 2.
v_fechapago1 = st_partida-fecharegistro + 9.
endif.
if diatemp eq 3.
v_fechapago1 = st_partida-fecharegistro + 8.
endif.
if diatemp eq 4.
v_fechapago1 = st_partida-fecharegistro + 7.
endif.
if diatemp eq 5.
v_fechapago1 = st_partida-fecharegistro + 6.
endif.
if diatemp eq 6.
v_fechapago1 = st_partida-fecharegistro + 5.
endif.
if diatemp eq 7.
v_fechapago1 = st_partida-fecharegistro + 4.
endif.
call function 'DAY_IN_WEEK'
exporting
datum = v_fechafutura
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago2 = v_fechafutura - 4.
endif.
if diatemp eq 2.
v_fechapago2 = v_fechafutura - 5.
endif.
if diatemp eq 3.
v_fechapago2 = v_fechafutura - 6.
endif.
if diatemp eq 4.
v_fechapago2 = v_fechafutura.
endif.
if diatemp eq 5.
v_fechapago2 = v_fechafutura - 1.
endif.
if diatemp eq 6.
v_fechapago2 = v_fechafutura - 2.
endif.
if diatemp eq 7.
v_fechapago2 = v_fechafutura - 3.
endif.
if v_fechapago1 ge v_fechapago2.
st_partida-vencimiento = v_fechapago1.
else.
st_partida-vencimiento = v_fechapago2.
endif.
endif.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
if v_cuenta is initial.
select single koinh into v_cuenta from lfbk where lifnr eq acreed
or and bvtyp eq st_partida-moneda.
endif.
if not v_cuenta is initial.
st_partida-viaspago = 'TIB'.
else.
select single regio into v_region from lfa1 where lifnr eq acreed
or.
if v_region eq 'LIM' or v_region eq 'CAL' or v_region eq 'TRU' or
v_region eq 'ARE'.
st_partida-viaspago = 'NC1'.
else.
st_partida-viaspago = 'NC2'.
endif.
endif.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-nrodocumento
and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
append st_partida to ti_partida.
endif.
endselect.
select bukrs lifnr budat xblnr zuonr belnr blart bldat zfbdt zterm w
aers wrbtr augbl augdt sgtxt shkzg qbshb
into
(st_partida-socie, st_partida-codruc, st_partida-
fecha, st_partida-nrofactura, st_partida-asignacion, st_partida-
nrodocumento, st_partida-tipodoc, st_partida-fechafact, st_partida-
fecharecep, st_partida-conpago, st_partida-moneda,
st_partida-importe, st_partida-docpago, st_partida-
fechapago, st_partida-descripcion,
st_partida-signo, st_partida-qbshb)
* corresponding fields of table ti_partida
from bsak
where bukrs eq sociedad
and lifnr eq acreedor
and budat ge fechainicio
and budat le fechafin
and ( blart in s_blart or blart eq 'KO' )
and ( blart ne 'LX'and blart ne 'QX' and blart ne 'UX' )
and not augbl like '29%'
order by bukrs lifnr budat.
st_partida-importe = st_partida-importe + st_partida-qbshb.
st_partida-estado = 'Compensada'.
clear st_partida-vencimiento.
if st_partida-vencimiento is initial.
select single cpudt into st_partida-fecharegistro from bkpf
where bukrs eq sociedad
and blart eq st_partida-tipodoc
and belnr eq st_partida-nrodocumento
and budat eq st_partida-fecha.
select single ztag1 into st_partida-diasconpago from t052
where zterm eq st_partida-conpago.
v_fechafutura = st_partida-fecharecep + st_partida-diasconpago.
call function 'DAY_IN_WEEK'
exporting
datum = st_partida-fecharegistro
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago1 = st_partida-fecharegistro + 10.
endif.
if diatemp eq 2.
v_fechapago1 = st_partida-fecharegistro + 9.
endif.
if diatemp eq 3.
v_fechapago1 = st_partida-fecharegistro + 8.
endif.
if diatemp eq 4.
v_fechapago1 = st_partida-fecharegistro + 7.
endif.
if diatemp eq 5.
v_fechapago1 = st_partida-fecharegistro + 6.
endif.
if diatemp eq 6.
v_fechapago1 = st_partida-fecharegistro + 5.
endif.
if diatemp eq 7.
v_fechapago1 = st_partida-fecharegistro + 4.
endif.
call function 'DAY_IN_WEEK'
exporting
datum = v_fechafutura
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago2 = v_fechafutura - 4.
endif.
if diatemp eq 2.
v_fechapago2 = v_fechafutura - 5.
endif.
if diatemp eq 3.
v_fechapago2 = v_fechafutura - 6.
endif.
if diatemp eq 4.
v_fechapago2 = v_fechafutura.
endif.
if diatemp eq 5.
v_fechapago2 = v_fechafutura - 1.
endif.
if diatemp eq 6.
v_fechapago2 = v_fechafutura - 2.
endif.
if diatemp eq 7.
v_fechapago2 = v_fechafutura - 3.
endif.
if v_fechapago1 ge v_fechapago2.
st_partida-vencimiento = v_fechapago1.
else.
st_partida-vencimiento = v_fechapago2.
endif.
endif.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
if v_cuenta is initial.
select single koinh into v_cuenta from lfbk where lifnr eq acreed
or and bvtyp eq st_partida-moneda.
endif.
if not v_cuenta is initial.
st_partida-viaspago = 'TIB'.
else.
select single regio into v_region from lfa1 where lifnr eq acreed
or.
if v_region eq 'LIM' or v_region eq 'CAL' or v_region eq 'TRU' or
v_region eq 'ARE'.
st_partida-viaspago = 'NC1'.
else.
st_partida-viaspago = 'NC2'.
endif.
endif.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-
nrodocumento and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
endif.
append st_partida to ti_partida.

endselect.

** and ( BLART eq 'CC' or BLART eq 'CF' or BLART eq 'CN' or BLART eq 'CD
' or BLART eq 'CB' )
** and BLART NE 'CX'
else.
select single lifnr into acreedor from lfa1 where stcd1 = ruc.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'P*'.

select bukrs lifnr budat xblnr zuonr
belnr blart bldat zfbdt zterm
waers augbl augdt sgtxt
shkzg
into
(st_partida-socie, st_partida-codruc, st_partida-fecha, st_partida-
nrofactura, st_partida-asignacion,
st_partida-nrodocumento, st_partida-tipodoc, st_partida-
fechafact, st_partida-fecharecep, st_partida-conpago,
st_partida-moneda, st_partida-docpago, st_partida-
fechapago, st_partida-descripcion,
st_partida-signo)
* corresponding fields of table ti_partida
from bsik
where bukrs eq sociedad
and lifnr eq acreedor
and budat ge fechainicio
and budat le fechafin
and ( blart in s_blart )
and ( blart ne 'PX')
and not augbl like '19%'
order by bukrs lifnr budat.
st_partida-estado = 'Abierta'.
clear st_partida-vencimiento.
if st_partida-vencimiento is initial.
select single cpudt into st_partida-fecharegistro from bkpf
where bukrs eq sociedad
and blart eq st_partida-tipodoc
and belnr eq st_partida-nrodocumento
and budat eq st_partida-fecha.
select single ztag1 into st_partida-diasconpago from t052
where zterm eq st_partida-conpago.
v_fechafutura = st_partida-fecharecep + st_partida-diasconpago.
call function 'DAY_IN_WEEK'
exporting
datum = st_partida-fecharegistro
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago1 = st_partida-fecharegistro + 10.
endif.
if diatemp eq 2.
v_fechapago1 = st_partida-fecharegistro + 9.
endif.
if diatemp eq 3.
v_fechapago1 = st_partida-fecharegistro + 8.
endif.
if diatemp eq 4.
v_fechapago1 = st_partida-fecharegistro + 7.
endif.
if diatemp eq 5.
v_fechapago1 = st_partida-fecharegistro + 6.
endif.
if diatemp eq 6.
v_fechapago1 = st_partida-fecharegistro + 5.
endif.
if diatemp eq 7.
v_fechapago1 = st_partida-fecharegistro + 4.
endif.
call function 'DAY_IN_WEEK'
exporting
datum = v_fechafutura
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago2 = v_fechafutura - 4.
endif.
if diatemp eq 2.
v_fechapago2 = v_fechafutura - 5.
endif.
if diatemp eq 3.
v_fechapago2 = v_fechafutura - 6.
endif.
if diatemp eq 4.
v_fechapago2 = v_fechafutura.
endif.
if diatemp eq 5.
v_fechapago2 = v_fechafutura - 1.
endif.
if diatemp eq 6.
v_fechapago2 = v_fechafutura - 2.
endif.
if diatemp eq 7.
v_fechapago2 = v_fechafutura - 3.
endif.
if v_fechapago1 ge v_fechapago2.
st_partida-vencimiento = v_fechapago1.
else.
st_partida-vencimiento = v_fechapago2.
endif.
endif.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
if v_cuenta is initial.
select single koinh into v_cuenta from lfbk where lifnr eq acreed
or and bvtyp eq st_partida-moneda.
endif.
if not v_cuenta is initial.
st_partida-viaspago = 'TIB'.
else.
select single regio into v_region from lfa1 where lifnr eq acreed
or.
if v_region eq 'LIM' or v_region eq 'CAL' or v_region eq 'TRU' or
v_region eq 'ARE'.
st_partida-viaspago = 'NC1'.
else.
st_partida-viaspago = 'NC2'.
endif.
endif.
clear st_partida-importe.
if st_partida-importe is initial.
select single wrbtr into st_partida-importe from bseg
where bukrs eq sociedad
and hkont like '00104%'
and gjahr eq fechainicio+0(4)
and belnr eq st_partida-nrodocumento.
endif.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-nrodocumento
and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
append st_partida to ti_partida.
endif.

endselect.
select bukrs lifnr budat xblnr zuonr belnr blart bldat zfbdt zterm w
aers augbl augdt sgtxt
shkzg
into
(st_partida-socie, st_partida-codruc, st_partida-
fecha, st_partida-nrofactura, st_partida-asignacion, st_partida-
nrodocumento, st_partida-tipodoc, st_partida-fechafact, st_partida-
fecharecep, st_partida-conpago, st_partida-moneda,
st_partida-docpago, st_partida-fechapago, st_partida-
descripcion,
st_partida-signo)
* corresponding fields of table ti_partida
from bsak
where bukrs eq sociedad
and lifnr eq acreedor
and budat ge fechainicio
and budat le fechafin
and ( blart in s_blart )
and ( blart ne 'PX' )
and not augbl like '19%'
order by bukrs lifnr budat.
st_partida-estado = 'Compensada'.
clear st_partida-vencimiento.
if st_partida-vencimiento is initial.
select single cpudt into st_partida-fecharegistro from bkpf
where bukrs eq sociedad
and blart eq st_partida-tipodoc
and belnr eq st_partida-nrodocumento
and budat eq st_partida-fecha.
select single ztag1 into st_partida-diasconpago from t052
where zterm eq st_partida-conpago.
v_fechafutura = st_partida-fecharecep + st_partida-diasconpago.
call function 'DAY_IN_WEEK'
exporting
datum = st_partida-fecharegistro
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago1 = st_partida-fecharegistro + 10.
endif.
if diatemp eq 2.
v_fechapago1 = st_partida-fecharegistro + 9.
endif.
if diatemp eq 3.
v_fechapago1 = st_partida-fecharegistro + 8.
endif.
if diatemp eq 4.
v_fechapago1 = st_partida-fecharegistro + 7.
endif.
if diatemp eq 5.
v_fechapago1 = st_partida-fecharegistro + 6.
endif.
if diatemp eq 6.
v_fechapago1 = st_partida-fecharegistro + 5.
endif.
if diatemp eq 7.
v_fechapago1 = st_partida-fecharegistro + 4.
endif.
call function 'DAY_IN_WEEK'
exporting
datum = v_fechafutura
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago2 = v_fechafutura - 4.
endif.
if diatemp eq 2.
v_fechapago2 = v_fechafutura - 5.
endif.
if diatemp eq 3.
v_fechapago2 = v_fechafutura - 6.
endif.
if diatemp eq 4.
v_fechapago2 = v_fechafutura.
endif.
if diatemp eq 5.
v_fechapago2 = v_fechafutura - 1.
endif.
if diatemp eq 6.
v_fechapago2 = v_fechafutura - 2.
endif.
if diatemp eq 7.
v_fechapago2 = v_fechafutura - 3.
endif.
if v_fechapago1 ge v_fechapago2.
st_partida-vencimiento = v_fechapago1.
else.
st_partida-vencimiento = v_fechapago2.
endif.
endif.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
if v_cuenta is initial.
select single koinh into v_cuenta from lfbk where lifnr eq acreed
or and bvtyp eq st_partida-moneda.
endif.
if not v_cuenta is initial.
st_partida-viaspago = 'TIB'.
else.
select single regio into v_region from lfa1 where lifnr eq acreed
or.
if v_region eq 'LIM' or v_region eq 'CAL' or v_region eq 'TRU' or
v_region eq 'ARE'.
st_partida-viaspago = 'NC1'.
else.
st_partida-viaspago = 'NC2'.
endif.
endif.
clear st_partida-importe.
if st_partida-importe is initial.
select single wrbtr into st_partida-importe from bseg
where bukrs eq sociedad
and hkont like '00104%'
and gjahr eq fechainicio+0(4)
and belnr eq st_partida-nrodocumento.
endif.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-
nrodocumento and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
endif.
append st_partida to ti_partida.

endselect.
endif.
endif.
if cuenta eq 'D'.
select single kunnr into acreedor from kna1 where stcd1 = ruc.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CC'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CF'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CN'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CD'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CB'.
append s_blart.

select bukrs kunnr budat xblnr zuonr
belnr blart bldat zfbdt zterm
waers wrbtr augbl augdt sgtxt
shkzg
into
(st_partida-socie, st_partida-codruc, st_partida-fecha, st_partida-
nrofactura, st_partida-asignacion,
st_partida-nrodocumento, st_partida-tipodoc, st_partida-
fechafact, st_partida-fecharecep, st_partida-conpago,
st_partida-moneda, st_partida-importe, st_partida-
docpago, st_partida-fechapago, st_partida-descripcion,
st_partida-signo)
* corresponding fields of table ti_partida
from bsid
where bukrs eq sociedad
and kunnr eq acreedor
and budat ge fechainicio
and budat le fechafin
and ( blart in s_blart )
and ( blart ne 'CX')
and not augbl like '39%'
order by bukrs kunnr budat.
st_partida-estado = 'Abierta'.
* st_partida-vencimiento = '?????'.
clear st_partida-vencimiento.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
* SELECT SINGLE koinh INTO v_cuenta FROM lfbk WHERE lifnr EQ acreedor
AND bvtyp EQ st_partida-moneda.
* IF NOT v_cuenta IS INITIAL.
* st_partida-viaspago = 'TIB'.
* ELSE.
* SELECT SINGLE regio INTO v_region FROM lfa1 WHERE lifnr EQ acreedo
r.
* IF v_region EQ 'LIM' OR v_region EQ 'CAL' OR v_region EQ 'TRU' OR
v_region EQ 'ARE'.
* st_partida-viaspago = 'NC1'.
* ELSE.
* st_partida-viaspago = 'NC2'.
* ENDIF.
* ENDIF.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-
nrodocumento and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
endif.
append st_partida to ti_partida.

endselect.
select bukrs kunnr budat xblnr zuonr
belnr blart bldat zfbdt zterm
waers wrbtr augbl augdt sgtxt
shkzg
into
(st_partida-socie, st_partida-codruc, st_partida-
fecha, st_partida-nrofactura, st_partida-asignacion,
st_partida-nrodocumento, st_partida-tipodoc, st_partida-
fechafact, st_partida-fecharecep, st_partida-conpago,
st_partida-moneda, st_partida-importe, st_partida-
docpago, st_partida-fechapago, st_partida-descripcion,
st_partida-signo)
* corresponding fields of table ti_partida
from bsad
where bukrs eq sociedad
and kunnr eq acreedor
and budat ge fechainicio
and budat le fechafin
and ( blart in s_blart )
and ( blart ne 'CX')
and not augbl like '39%'
order by bukrs kunnr budat.
st_partida-estado = 'Compensada'.
* st_partida-vencimiento = '?????'.
clear st_partida-vencimiento.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
* SELECT SINGLE koinh INTO v_cuenta FROM lfbk WHERE lifnr EQ acreedor
AND bvtyp EQ st_partida-moneda.
* IF NOT v_cuenta IS INITIAL.
* st_partida-viaspago = 'TIB'.
* ELSE.
* SELECT SINGLE regio INTO v_region FROM lfa1 WHERE lifnr EQ acreedo
r.
* IF v_region EQ 'LIM' OR v_region EQ 'CAL' OR v_region EQ 'TRU' OR
v_region EQ 'ARE'.
* st_partida-viaspago = 'NC1'.
* ELSE.
* st_partida-viaspago = 'NC2'.
* ENDIF.
* ENDIF.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-
nrodocumento and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
endif.
append st_partida to ti_partida.

endselect.

endif.
else.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'Q*'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'U*'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'CP'.
s_blart-low = 'L*'.
append s_blart.
select single lifnr into acreedor from lfa1 where stcd1 = ruc.
select bukrs lifnr budat xblnr zuonr belnr blart bldat zfbdt zterm waers
wrbtr augbl augdt sgtxt
shkzg
into
(st_partida-socie, st_partida-codruc, st_partida-
fecha, st_partida-nrofactura, st_partida-asignacion, st_partida-
nrodocumento, st_partida-tipodoc, st_partida-fechafact, st_partida-
fecharecep, st_partida-conpago, st_partida-moneda,
st_partida-importe, st_partida-docpago, st_partida-
fechapago, st_partida-descripcion,
st_partida-signo)
* corresponding fields of table ti_partida
from bsak
where bukrs eq sociedad
and lifnr eq acreedor
and augdt ge fechainicio
and augdt le fechafin
and ( blart in s_blart or blart eq 'KO' )
and ( blart ne 'LX'and blart ne 'QX' and blart ne 'UX' )
and augbl eq nrodoc
order by bukrs lifnr budat.
st_partida-estado = 'Compensada'.
clear st_partida-vencimiento.
if st_partida-vencimiento is initial.
select single cpudt into st_partida-fecharegistro from bkpf
where bukrs eq sociedad
and blart eq st_partida-tipodoc
and belnr eq st_partida-nrodocumento
and budat eq st_partida-fecha.
select single ztag1 into st_partida-diasconpago from t052
where zterm eq st_partida-conpago.
v_fechafutura = st_partida-fecharecep + st_partida-diasconpago.
call function 'DAY_IN_WEEK'
exporting
datum = st_partida-fecharegistro
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago1 = st_partida-fecharegistro + 10.
endif.
if diatemp eq 2.
v_fechapago1 = st_partida-fecharegistro + 9.
endif.
if diatemp eq 3.
v_fechapago1 = st_partida-fecharegistro + 8.
endif.
if diatemp eq 4.
v_fechapago1 = st_partida-fecharegistro + 7.
endif.
if diatemp eq 5.
v_fechapago1 = st_partida-fecharegistro + 6.
endif.
if diatemp eq 6.
v_fechapago1 = st_partida-fecharegistro + 5.
endif.
if diatemp eq 7.
v_fechapago1 = st_partida-fecharegistro + 4.
endif.
call function 'DAY_IN_WEEK'
exporting
datum = v_fechafutura
importing
wotnr = diatemp.
if diatemp eq 1.
v_fechapago2 = v_fechafutura - 4.
endif.
if diatemp eq 2.
v_fechapago2 = v_fechafutura - 5.
endif.
if diatemp eq 3.
v_fechapago2 = v_fechafutura - 6.
endif.
if diatemp eq 4.
v_fechapago2 = v_fechafutura.
endif.
if diatemp eq 5.
v_fechapago2 = v_fechafutura - 1.
endif.
if diatemp eq 6.
v_fechapago2 = v_fechafutura - 2.
endif.
if diatemp eq 7.
v_fechapago2 = v_fechafutura - 3.
endif.
if v_fechapago1 ge v_fechapago2.
st_partida-vencimiento = v_fechapago1.
else.
st_partida-vencimiento = v_fechapago2.
endif.
endif.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
if v_cuenta is initial.
select single koinh into v_cuenta from lfbk where lifnr eq acreedor a
nd bvtyp eq st_partida-moneda.
endif.
if not v_cuenta is initial.
st_partida-viaspago = 'TIB'.
else.
select single regio into v_region from lfa1 where lifnr eq acreedor.
if v_region eq 'LIM' or v_region eq 'CAL' or v_region eq 'TRU' or v_r
egion eq 'ARE'.
st_partida-viaspago = 'NC1'.
else.
st_partida-viaspago = 'NC2'.
endif.
endif.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-
nrodocumento and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
endif.
append st_partida to ti_partida.
endselect.
loop at s_blart.
delete s_blart.
endloop.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CC'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CF'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CN'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CD'.
append s_blart.
s_blart-sign = 'I'.
s_blart-option = 'EQ'.
s_blart-low = 'CB'.
append s_blart.
select single kunnr into acreedor from kna1 where stcd1 = ruc.
select bukrs kunnr budat xblnr zuonr
belnr blart bldat zfbdt zterm
waers wrbtr augbl augdt sgtxt
shkzg
into
(st_partida-socie, st_partida-codruc, st_partida-fecha, st_partida-
nrofactura, st_partida-asignacion,
st_partida-nrodocumento, st_partida-tipodoc, st_partida-
fechafact, st_partida-fecharecep, st_partida-conpago,
st_partida-moneda, st_partida-importe, st_partida-
docpago, st_partida-fechapago, st_partida-descripcion,
st_partida-signo)
* corresponding fields of table ti_partida
from bsad
where bukrs eq sociedad
and kunnr eq acreedor
and augdt ge fechainicio
and augdt le fechafin
and ( blart in s_blart )
and ( blart ne 'CX')
and augbl eq nrodoc
order by bukrs kunnr budat.
st_partida-estado = 'Compensada'.
* st_partida-vencimiento = '?????'.
clear st_partida-vencimiento.
clear v_cuenta.
clear v_region.
clear st_partida-destipodoc.
if st_partida-destipodoc is initial.
select single ltext into st_partida-
destipodoc from t003t where blart eq st_partida-tipodoc and spras eq 'S'.
endif.
* SELECT SINGLE koinh INTO v_cuenta FROM lfbk WHERE lifnr EQ acreedor
AND bvtyp EQ st_partida-moneda.
* IF NOT v_cuenta IS INITIAL.
* st_partida-viaspago = 'TIB'.
* ELSE.
* SELECT SINGLE regio INTO v_region FROM lfa1 WHERE lifnr EQ acreedo
r.
* IF v_region EQ 'LIM' OR v_region EQ 'CAL' OR v_region EQ 'TRU' OR
v_region EQ 'ARE'.
* st_partida-viaspago = 'NC1'.
* ELSE.
* st_partida-viaspago = 'NC2'.
* ENDIF.
* ENDIF.
clear st_partida-doccompras.
if st_partida-doccompras is initial.
select single ebeln into st_partida-doccompras from bseg
where bukrs eq sociedad and belnr eq st_partida-
nrodocumento and gjahr eq st_partida-fechafact+0(4) and ebeln ne ''.
endif.
append st_partida to ti_partida.

endselect.
endif.
loop at ti_partida assigning <fs_partida>.

move: <fs_partida>-importe to v_importe.
if <fs_partida>-signo eq 'S'.
concatenate v_importe '-' into v_importe .
condense v_importe no-gaps.
endif.
concatenate <fs_partida>-estado <fs_partida>-nrofactura <fs_partida>-
asignacion <fs_partida>-nrodocumento <fs_partida>-destipodoc <fs_partida>-
fechafact <fs_partida>-fecharecep <fs_partida>-conpago <fs_partida>-
vencimiento <fs_partida>-moneda
v_importe <fs_partida>-docpago <fs_partida>-fechapago <fs_partida>-
doccompras <fs_partida>-viaspago <fs_partida>-descripcion into result-
resultado
separated by '|'.
append result.
endloop.
endfunction.