Buenas tardes foro,
Os paso, gracias a lo que me habéis pasado, unos programillas para
calcular los dígitos de control tanto del IBAN como del de la CCC
en mi caso mi fichero de clientes tiene 10 + 10 en la CCC.
CALCCCDC Rutina calcula el DC de una CCC
CALIBANR y CALIBANFM - Versión que te muestra el DC de una CCC introducida
Esta rutina es otra diferente a la de CALIBAN
CALIBANRF procesa un fichero y actualiza (llama a CALIBAN)
IBANPF - Fichero que se procesa
CALIBAN Rutina que calcula el Digito de Control del IBAN (llama a
CALCCCDC)
Con algunos retoques podréis usarlos ya que el SEPA se acerca
Repito muchas gracias a TODOS/AS
Y FELICES FIESTASSSSSSS
P No lo imprima si no es necesario. Protejamos el medio ambiente.
Este mensaje y sus archivos adjuntos pueden contener información
confidencial y están dirigidos exclusivamente a su destinatario. Le
informamos que la legislación vigente prohíbe el uso, divulgación o copia
del contenido del presente mensaje por persona distinta del destinatario sin
autorización previa. Si Ud. no es el destinatario de este mensaje y lo ha
recibido por error le agradeceríamos que nos lo comunicara y que procediera
a destruirlo. This message can contain confidential information and is
directed exclusively to its adressee. We inform you that the legislation
prohibits to use, spreading or copy the content of the present message by
person different from the adressee without previous authorization. If you
are not the adressee of this message or you have received it by error we
would be thankful if you notify us and delete it.
A R IBANR
A AJAHCD 7A TEXT('Codigo cliente')
A COLHDG('Codigo' +
A 'cliente')
A AJAGCD 10 TEXT('Codigo de Banco')
A COLHDG('Codigo de' +
A 'Banco')
A AJA3TX 10 TEXT('Cuenta Banco')
A COLHDG('Cuenta' +
A 'Banco')
A PAIS 2
A COLHDG('Pais')
A DIGITOS 2S 0
A COLHDG('Digitos IBAN')
A BANCO 4S 0
A COLHDG('Banco')
A SUCURSAL 4S 0
A COLHDG('Sucursal')
A DC 2S 0
A COLHDG('DC CCC')
A CUENTA 10S 0
A COLHDG('CTA CCC')
A* CLAVES
A K AJAHCD H*=====================================================================
H*
H* CalCCCDC - Calcular DIGITO DE CONTROL DE UNA CCC
H*
H* La forma de calcular el dígito de control es esta: Entidad Oficina D.C. Nº
de cuenta
H* La primera cifra del banco se multiplica por 4.
H* La segunda cifra del banco se multiplica por 8.
H* La tercera cifra del banco se multiplica por 5.
H* La cuarta cifra del banco se multiplica por 10.
H* La primera cifra de la entidad se multiplica por 9.
H* La segunda cifra de la entidad se multiplica por 7.
H* La tercera cifra de la entidad se multiplica por 3.
H* La cuarta cifra de la entidad se multiplica por 6.
H* Se suman todos los resultados obtenidos.
H* Se divide entre 11 y nos quedamos con el resto de la división.
H* A 11 le quitamos el resto anterior, y ese el el primer dígito de control,
con la salvedad de
H* que si nos da 10, el dígito es 1
H* Para obtener el segundo dígito de control:
H* La primera cifra de la cuenta se multiplica por 1
H* La primera cifra de la cuenta se multiplica por 2
H* La primera cifra de la cuenta se multiplica por 4
H* La primera cifra de la cuenta se multiplica por 8
H* La primera cifra de la cuenta se multiplica por 5
H* La primera cifra de la cuenta se multiplica por 10
H* La primera cifra de la cuenta se multiplica por 9
H* La primera cifra de la cuenta se multiplica por 7
H* La primera cifra de la cuenta se multiplica por 3
H* La primera cifra de la cuenta se multiplica por 6
H* Se suman todos los resultados obtenidos.
H* Se divide entre 11 y nos quedamos con el resto de la división.
H* A 11 le quitamos el resto anterior, y ese el el segundo dígito de control,
con la salvedad
H* de que si nos da 10, el dígito es 1
H*
H*=====================================================================
H datedit(*DMY) decedit(*jobrun) datfmt(*DMY/) cvtopt(*datetime)
H DFTACTGRP(*NO)
D DSBANC DS INZ
D W$BANC 1 4
D W$SUCU 5 8
D DSBS01 1 1 0
D DSBS02 2 2 0
D DSBS03 3 3 0
D DSBS04 4 4 0
D DSBS05 5 5 0
D DSBS06 6 6 0
D DSBS07 7 7 0
D DSBS08 8 8 0
D DSCTA DS INZ
D W$CTA 1 10
D DSCT01 1 1 0
D DSCT02 2 2 0
D DSCT03 3 3 0
D DSCT04 4 4 0
D DSCT05 5 5 0
D DSCT06 6 6 0
D DSCT07 7 7 0
D DSCT08 8 8 0
D DSCT09 9 9 0
D DSCT10 10 10 0
*--------------------------------------------------------------*
C EXSR @DBANC
C EXSR @DCTA
C movel W$DBCO P$DC2
C move W$DCTA P$DC2
C eval *inLR = *on
*--------------------------------------------------------------*
* @DBANC: CALCULO DEL DIGITO CONTROL DEL BANC + SUCURSAL *
C @DBANC BEGSR
*
C DSBS08 MULT 6 W$UNID
C DSBS07 MULT 3 W$DESE
C DSBS06 MULT 7 W$CENT
C DSBS05 MULT 9 W$UMIL
C DSBS04 MULT 10 W$DMIL
C DSBS03 MULT 5 W$CMIL
C DSBS02 MULT 8 W$UMMI
C DSBS01 MULT 4 W$DMMI
*
C Z-ADD W$UNID W$SUMA
C ADD W$DESE W$SUMA
C ADD W$CENT W$SUMA
C ADD W$UMIL W$SUMA
C ADD W$DMIL W$SUMA
C ADD W$CMIL W$SUMA
C ADD W$UMMI W$SUMA
C ADD W$DMMI W$SUMA
*
C W$SUMA DIV 11 W$RESU
C MVR W$REST
*
C 11 SUB W$REST W$RES1
C SELECT
C W$RES1 WHENLT 10
C MOVE W$RES1 W$DBCO
C W$RES1 WHENEQ 11
C MOVE '0' W$DBCO
C W$RES1 WHENEQ 10
C MOVE '1' W$DBCO
C ENDSL
*
C ENDSR
*--------------------------------------------------------------*
* @DCTA: CALCULO DEL DIGITO CONTROL DE LA CUENTA
C @DCTA BEGSR
*
C DSCT10 MULT 6 W$UNID
C DSCT09 MULT 3 W$DESE
C DSCT08 MULT 7 W$CENT
C DSCT07 MULT 9 W$UMIL
C DSCT06 MULT 10 W$DMIL
C DSCT05 MULT 5 W$CMIL
C DSCT04 MULT 8 W$UMMI
C DSCT03 MULT 4 W$DMMI
C DSCT02 MULT 2 W$CMMI
C DSCT01 MULT 1 W$UMMM
*
C Z-ADD W$UNID W$SUMA
C ADD W$DESE W$SUMA
C ADD W$CENT W$SUMA
C ADD W$UMIL W$SUMA
C ADD W$DMIL W$SUMA
C ADD W$CMIL W$SUMA
C ADD W$UMMI W$SUMA
C ADD W$DMMI W$SUMA
C ADD W$CMMI W$SUMA
C ADD W$UMMM W$SUMA
*
C W$SUMA DIV 11 W$RESU
C MVR W$REST
*
C 11 SUB W$REST W$RES1
C SELECT
C W$RES1 WHENLT 10
C MOVE W$RES1 W$DCTA
C W$RES1 WHENEQ 11
C MOVE '0' W$DCTA
C W$RES1 WHENEQ 10
C MOVE '1' W$DCTA
C ENDSL
*
C ENDSR
*--------------------------------------------------------------*
* *INZSR
C *INZSR BEGSR
*
C MOVE P$BANC P$BANC 4
C MOVE P$CTA P$CTA 10
C MOVE P$DBCO P$DBCO 1
C MOVE P$DCTA P$DCTA 1
C MOVE P$SUCU P$SUCU 4
*
C Z-ADD W$CENT W$CENT 2 0
C Z-ADD W$CMIL W$CMIL 2 0
C *LIKE DEFINE P$DBCO W$DBCO
C *LIKE DEFINE P$DCTA W$DCTA
C Z-ADD W$DESE W$DESE 2 0
C Z-ADD W$DMIL W$DMIL 2 0
C Z-ADD W$DMMI W$DMMI 2 0
C Z-ADD W$CMMI W$CMMI 2 0
C Z-ADD W$REST W$REST 2 0
C Z-ADD W$RESU W$RESU 2 0
C Z-ADD W$RES1 W$RES1 2 0
C Z-ADD W$SUMA W$SUMA 4 0
C Z-ADD W$UMIL W$UMIL 2 0
C Z-ADD W$UMMI W$UMMI 2 0
C Z-ADD W$UMMM W$UMMM 2 0
C Z-ADD W$UNID W$UNID 2 0
* Limpiar campos del resultado
C CLEAR W$DBCO
C CLEAR W$DCTA
C CLEAR P$DC2 2
C*
c*------------------------------------*
c* *ENTRY: PARAMETROS *
c* P$BANC: CODIGO DEL BANCO *
c* P$SUCU: CODIGO DE LA SUCURSAL *
c* P$CTA: NUMERO DE LA CUENTA *
c* P$DC2 : DIGIT CONTROL *
c*------------------------------------*
C *ENTRY PLIST
C W$BANC PARM P$BANC
C W$SUCU PARM P$SUCU
C W$CTA PARM P$CTA
C PARM P$DC2
*
C ENDSR
h datedit(*DMY) decedit(*jobrun) datfmt(*DMY/) cvtopt(*datetime)
h DFTACTGRP(*NO)
*==================================================================·
h*
h* CalIBAN - Calcular IBAN de cuenta bancaria
h*
D*=====================================================================
d*
d True c *on
d False c *off
d Letras s 26a inz('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
d Numero s 30p 0 inz(0)
d Resto s 2p 0 inz(0)
d Entrada s 24a inz(*blank)
d Salida s 256a inz(*blank)
d Posicion s 2p 0 inz(0)
d Peso s 2p 0 inz(0)
d Digitos s 2p 0 inz(0)
c*
c* Construir valor para cálculo
c eval Digitos = 0
c eval Salida = *blanks
c*
c eval Pais = 'ES'
c eval Banco = 0000
c eval Sucursal = 0000
c eval DC = 00
c eval Cuenta = 0000000000
c*
===================================================================================
c* Descomponer la CCC
c eval ABanco = %subst(AJAGCD:1:4)
c eval ASucursal = %subst(AJAGCD:5:4)
c eval ADC = %subst(AJAGCD:9:2)
c eval ACuenta = AJA3TX
c* Comprobar que no tienen basura los campos
c If ABanco <= '0000' or Abanco > '9999'
c Goto Novale
c Endif
c If ASucursal <= '0000' or ASucursal > '9999'
c Goto Novale
c Endif
c If ADC < '00' or ADC > '99'
c Goto Novale
c Endif
c If ACuenta <= '0000000000' or
c ACuenta > '9999999999'
c Goto Novale
c Endif
c*
===================================================================================
c* Comprobar DC - llamar al progrtama de calculo de DC verdadero
c clear P$DC
c *like define ABanco P$Banco
c *like define ASucursal P$Sucursal
c *like define ACuenta P$Cuenta
c Call 'CALCCCDC'
c Parm ABanco P$Banco
c Parm ASucursal P$Sucursal
c Parm ACuenta P$Cuenta
c Parm P$DC 2
c* Si son diferentes meto el Calculado por ser el Bueno.
c* quedaria con un QRY comparar el grabado con el calculado para ver los
erroneos
c If ADC <> P$DC
c eval ADC = P$DC
c endif
c*
===================================================================================
c* Moverlos a numericos
c move ABanco Banco 4 0
pasar a numerico
c move ASucursal Sucursal 4 0
pasar a numerico
c move ADC DC 2 0
pasar a numerico
c move ACuenta Cuenta 10 0
pasar a numerico
c*
===================================================================================
c*
c eval Entrada = %editc(Banco:'X') +
c %editc(Sucursal:'X') +
c %editc(DC:'X') +
c %editc(Cuenta:'X') + Pais + '00'
c* Comprobar si hay letras
c eval Posicion = 0
c Dou Posicion >= %len(%trim(Entrada))
c eval Posicion = Posicion + 1
c if %scan(%subst(Entrada:Posicion:1):Letras)=0
c eval Salida = %trim(Salida) +
c %subst(Entrada:Posicion:1)
c else
c eval Peso = +
c %scan(%subst(Entrada:Posicion:1):Letras)+9
c eval Salida = %trim(Salida) + %editc(Peso:'X')
c endif
c enddo
c* Calcular
c eval Numero = %dec(%trim(Salida):30:0)
c eval Resto = %rem(Numero:97)
c eval Digitos = 98 - Resto
c move Digitos ADigitos
C*
c NoVale Tag
c eval *inLR = *on
c*
c *inzsr Begsr
C *ENTRY Plist
c* Campos entran
C Parm AJAGCD 10
C Parm AJA3TX 10
c* Campos retorno
c Parm Pais 2 ES
c Parm ABanco 4
c Parm ASucursal 4
c Parm ADC 2
recalculado
c Parm ACuenta 10
c Parm ADigitos 2
Digitos del IBAN
*
C ENDSR
A*%%TS SD 20131211 123754 VICENTE REL-V7R1M0 5770-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A CHGINPDFT
A PRINT
A R CALIBAN01
A*%%TS SD 20131211 123754 VICENTE REL-V7R1M0 5770-WDS
A OVERLAY
A 2 2'Introduce la cuenta y pulsa
Intro.'
A 4 2'Pais'
A 4 8'Banco'
A 4 15'Sucursal'
A 4 24'Digito C.'
A 4 35'Cuenta'
A PAIS 2A B 5 3DSPATR(UL)
A DSPATR(HI)
A 55 DSPATR(PR)
A BANCO 4Y 0B 5 8DSPATR(UL)
A DSPATR(HI)
A 55 DSPATR(PR)
A SUCURSAL 4Y 0B 5 17DSPATR(UL)
A DSPATR(HI)
A 55 DSPATR(PR)
A DC 2Y 0B 5 27DSPATR(UL)
A DSPATR(HI)
A 55 DSPATR(PR)
A CUENTA 10Y 0B 5 33DSPATR(UL)
A DSPATR(HI)
A 55 DSPATR(PR)
A 55 14 2'Digito:'
A DSPATR(RI)
A 55 DIGITOSDSP 2S 0B 14 10DSPATR(RI)
A 55 14 15'<<<=============='
A 55 16 2'Pulsa INTRO para salir'
A DSPATR(HI) h datedit(*DMY) decedit(*jobrun) datfmt(*DMY/) cvtopt(*datetime)
h DFTACTGRP(*NO)
*==================================================================·
h*
h* @CalIBAN - Calcular IBAN de cuenta bancaria
h*
h*=====================================================================
FCalIbanfm CF E WORKSTN
D*=====================================================================
d* ---------------------------------------------------------------------
d* Procedimiento de cálculo
d* ---------------------------------------------------------------------
d Pais s 2a
d Banco s 4p 0
d Sucursal s 4p 0
d DC s 2p 0
d Cuenta s 10p 0
d*
d True c *on
d False c *off
d Letras s 26a inz('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
d Numero s 30p 0 inz(0)
d Resto s 2p 0 inz(0)
d Entrada s 24a inz(*blank)
d Salida s 256a inz(*blank)
d Posicion s 2p 0 inz(0)
d Peso s 2p 0 inz(0)
d Digitos s 2p 0 inz(0)
c*
c* Construir valor para cálculo
c eval Digitos = 0
c eval Salida = *blanks
c*
c eval Pais = 'ES'
c eval Banco = 0000
c eval Sucursal = 0000
c eval DC = 00
c eval Cuenta = 0000000000
c*
c Exfmt Caliban01
c eval Entrada = %editc(Banco:'X') +
c %editc(Sucursal:'X') +
c %editc(DC:'X') +
c %editc(Cuenta:'X') + Pais + '00'
c* Comprobar si hay letras
c eval Posicion = 0
c Dou Posicion >= %len(%trim(Entrada))
c eval Posicion = Posicion + 1
c if %scan(%subst(Entrada:Posicion:1):Letras)=0
c eval Salida = %trim(Salida) +
c %subst(Entrada:Posicion:1)
c else
c eval Peso = +
c %scan(%subst(Entrada:Posicion:1):Letras)+9
c eval Salida = %trim(Salida) + %editc(Peso:'X')
c endif
c enddo
c* Calcular
c eval Numero = %dec(%trim(Salida):30:0)
c eval Resto = %rem(Numero:97)
c eval Digitos = 98 - Resto
c eval SalidaDSP = Salida
c eval DigitosDSP = Digitos
C*
c eval *in55 = *on
c Exfmt Caliban01
C*
c eval *inLR = *on h datedit(*DMY) decedit(*jobrun) datfmt(*DMY/) cvtopt(*datetime)
h DFTACTGRP(*NO)
*==================================================================·
h*
h* CalIBAN - Calcular IBAN de cuenta bancaria
h*
h*=====================================================================
FIbanPF UPE E K DISK
D*=====================================================================
c eval Digitos = 0
c eval Pais = 'ES'
c eval Banco = 0000
c eval Sucursal = 0000
c eval DC = 00
c eval Cuenta = 0000000000
c*
===================================================================================
c* Descomponer la CCC
c Call 'CALIBAN'
c* Campos envio
C Parm AJAGCD
C Parm AJA3TX
c* Campos retorno
c Parm aPais 2 ES
c Parm ABanco 4
c Parm ASucursal 4
c Parm ADC 2
recalculado
c Parm ACuenta 10
c Parm ADigitos 2
Digitos del IBAN
*
c*
===================================================================================
c* Moverlos a numericos
c move Apais Pais
c move ABanco Banco
pasar a numerico
c move ASucursal Sucursal
pasar a numerico
c move ADC DC
pasar a numerico
c move ACuenta Cuenta
pasar a numerico
c move ADigitos Digitos
pasar a numerico
c*
===================================================================================
c*
c Update IBANR
c* ____________________________________________________ Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd ) Forum.Help400 © Publicaciones Help400, S.L.
