Hola, Adjunto 2 archivos fuente COBOL:
CAIBANM.txt - Calcula el dígito de control
VRIBANM.txt - Comprueba el dígito de control
Saludos
El 23 de septiembre de 2013 17:32, TURCO <[email protected]>escribió:
> Hola Fernando
> Si pudieras adjuntarla.
> Muchaa gracias
>
> Carlos
>
> El 23/09/2013, a las 13:23, FB FB <[email protected]> escribió:
>
> Hola Vicente,
>
> yo tengo una "recientita" en COBOL.
> De todas formas, adjunto un link para el algoritmo de cálculo para
> determinar el dígito de control. No es complicado.
>
> Un saludo.
>
> Página con el detalle del algoritmo:
>
>
> http://www.finanzasybanca.com/iberfinanzas/index.php/C/Codigo-Internacional-de-Cuenta-Bancaria-IBAN.html
>
>
> Página para validar cuentas e Iban:
>
> http://es.ibancalculator.com/bic_und_iban.html
>
>
>
> El 23 de septiembre de 2013 12:53, Vicente Aliaga | Silomar <
> [email protected]> escribió:
>
>> Buenos días a todos ****
>>
>> ** **
>>
>> Con la nueva “próxima” aplicación de la normativa SEPA, lógicamente tengo
>> que añadir el IBAN en la ficha del cliente para ****
>>
>> el cambio de formato de los cuadernos (antes de Febrero del 2014 claro !
>> )****
>>
>> ** **
>>
>> Alguien tiene alguna utilidad que pasándole cuentas CCC me las convierta
>> a IBAN ?****
>>
>> ** **
>>
>> Para lo que no sabéis que es SEPA os adelanto este link****
>>
>> ** **
>>
>> http://www.bbva.es/TLBS/tlbs/esp/metainf/sepa.jsp****
>>
>> ** **
>>
>> ** **
>>
>> Así como si alguien está pasando los cuadernos *a la normativa XML ISO
>> 20022*, para tomar de referencia y agilizarnos la migración.****
>>
>> ** **
>>
>> Gracias foro****
>>
>> ** **
>>
>> 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.
>> ****
>>
>> ** **
>>
>> ** **
>>
>> ** **
>>
>> ____________________________________________________
>> Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd )
>> Forum.Help400 © Publicaciones Help400, S.L.
>>
>
>
>
> ____________________________________________________
> Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd )
> Forum.Help400 © Publicaciones Help400, S.L.
>
>
> ____________________________________________________
> Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd )
> Forum.Help400 © Publicaciones Help400, S.L.
>
--
Atentamente.
RP Director Técnico
Tel. 93 255 31 51
Fax. 93 255 31 09
PROCESS NOSTDERR.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. CAIBANM.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA, LOCAL-DATA IS L-D-A.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
DATA DIVISION.
FILE SECTION.
*
WORKING-STORAGE SECTION.
01 RTABLET.
03 FILLER PIC X VALUE "A".
03 FILLER PIC X VALUE "B".
03 FILLER PIC X VALUE "C".
03 FILLER PIC X VALUE "D".
03 FILLER PIC X VALUE "E".
03 FILLER PIC X VALUE "F".
03 FILLER PIC X VALUE "G".
03 FILLER PIC X VALUE "H".
03 FILLER PIC X VALUE "I".
03 FILLER PIC X VALUE "J".
03 FILLER PIC X VALUE "K".
03 FILLER PIC X VALUE "L".
03 FILLER PIC X VALUE "M".
03 FILLER PIC X VALUE "N".
03 FILLER PIC X VALUE "O".
03 FILLER PIC X VALUE "P".
03 FILLER PIC X VALUE "Q".
03 FILLER PIC X VALUE "R".
03 FILLER PIC X VALUE "S".
03 FILLER PIC X VALUE "T".
03 FILLER PIC X VALUE "U".
03 FILLER PIC X VALUE "V".
03 FILLER PIC X VALUE "W".
03 FILLER PIC X VALUE "X".
03 FILLER PIC X VALUE "Y".
03 FILLER PIC X VALUE "Z".
01 TABLET REDEFINES RTABLET.
03 TLET PIC X OCCURS 26.
*
01 RTABNUM.
03 FILLER PIC 99 VALUE 10.
03 FILLER PIC 99 VALUE 11.
03 FILLER PIC 99 VALUE 12.
03 FILLER PIC 99 VALUE 13.
03 FILLER PIC 99 VALUE 14.
03 FILLER PIC 99 VALUE 15.
03 FILLER PIC 99 VALUE 16.
03 FILLER PIC 99 VALUE 17.
03 FILLER PIC 99 VALUE 18.
03 FILLER PIC 99 VALUE 19.
03 FILLER PIC 99 VALUE 20.
03 FILLER PIC 99 VALUE 21.
03 FILLER PIC 99 VALUE 22.
03 FILLER PIC 99 VALUE 23.
03 FILLER PIC 99 VALUE 24.
03 FILLER PIC 99 VALUE 25.
03 FILLER PIC 99 VALUE 26.
03 FILLER PIC 99 VALUE 27.
03 FILLER PIC 99 VALUE 28.
03 FILLER PIC 99 VALUE 29.
03 FILLER PIC 99 VALUE 30.
03 FILLER PIC 99 VALUE 31.
03 FILLER PIC 99 VALUE 32.
03 FILLER PIC 99 VALUE 33.
03 FILLER PIC 99 VALUE 34.
03 FILLER PIC 99 VALUE 35.
01 TABNUM REDEFINES RTABNUM.
03 TNUM PIC 99 OCCURS 26.
*
*
01 OBAN.
03 OBAN-ENT PIC 9999.
03 OBAN-AGE PIC 9999.
03 OBAN-DG2 PIC 99.
03 OBAN-CTA PIC 9(10).
03 OBAN-NA1 PIC 99.
03 OBAN-NA2 PIC 99.
03 OBAN-DG1 PIC 99.
01 R-OBAN REDEFINES OBAN.
03 OBAN-01 PIC 9(09).
03 OBAN-02 PIC 9(09).
03 OBAN-03 PIC 9(08).
*
01 VAL-OBAN-2.
03 R1 PIC 99.
03 V-OBAN-2 PIC 9(09).
01 R-VAL-OBAN-2 REDEFINES VAL-OBAN-2 PIC 9(11).
*
01 VAL-OBAN-3.
03 R2 PIC 99.
03 V-OBAN-3 PIC 9(08).
01 R-VAL-OBAN-3 REDEFINES VAL-OBAN-3 PIC 9(10).
*
01 DIVISOR PIC 9(9).
01 ZZ PIC 99.
01 RESTO1 PIC 99.
01 RESTO2 PIC 99.
01 RESTO3 PIC 99.
*
LINKAGE SECTION.
01 IBAN.
03 IBAN-NAC PIC XX.
03 IBAN-DG1 PIC 99.
03 IBAN-ENT PIC 9999.
03 IBAN-AGE PIC 9999.
03 IBAN-DG2 PIC 99.
03 IBAN-CTA PIC 9(10).
*
PROCEDURE DIVISION USING IBAN.
INICIO.
MOVE ZEROS TO IBAN-DG1 OF IBAN.
*
PERFORM VARYING ZZ FROM 1 BY 1 UNTIL ZZ > 26
IF (TLET(ZZ) = IBAN-NAC(1:1))
MOVE TNUM(ZZ) TO OBAN-NA1 OF OBAN
MOVE 50 TO ZZ
END-IF
END-PERFORM.
IF (ZZ > 26 AND
ZZ < 50)
MOVE ZEROS TO OBAN-NA1 OF OBAN
END-IF.
PERFORM VARYING ZZ FROM 1 BY 1 UNTIL ZZ > 26
IF (TLET(ZZ) = IBAN-NAC(2:1))
MOVE TNUM(ZZ) TO OBAN-NA2 OF OBAN
MOVE 50 TO ZZ
END-IF
END-PERFORM.
IF (ZZ > 26 AND
ZZ < 50)
MOVE ZEROS TO OBAN-NA2 OF OBAN
END-IF.
MOVE IBAN-DG1 OF IBAN TO OBAN-DG1 OF OBAN.
MOVE IBAN-ENT OF IBAN TO OBAN-ENT OF OBAN.
MOVE IBAN-AGE OF IBAN TO OBAN-AGE OF OBAN.
MOVE IBAN-DG2 OF IBAN TO OBAN-DG2 OF OBAN.
MOVE IBAN-CTA OF IBAN TO OBAN-CTA OF OBAN.
*
DIVIDE OBAN-01 OF R-OBAN BY 97
GIVING DIVISOR REMAINDER RESTO1.
*
MOVE RESTO1 TO R1 OF VAL-OBAN-2.
MOVE OBAN-02 OF R-OBAN TO V-OBAN-2 OF VAL-OBAN-2.
DIVIDE R-VAL-OBAN-2 BY 97
GIVING DIVISOR REMAINDER RESTO2.
*
MOVE RESTO2 TO R2 OF VAL-OBAN-3.
MOVE OBAN-03 OF R-OBAN TO V-OBAN-3 OF VAL-OBAN-3.
DIVIDE R-VAL-OBAN-3 BY 97
GIVING DIVISOR REMAINDER RESTO3.
*
COMPUTE IBAN-DG1 OF IBAN = 98 - RESTO3.
* DISPLAY IBAN.
*
FIN.
GOBACK.
PROCESS NOSTDERR.
*
* Si no es vÃÆÃâÃâ ââ¬â¢ÃÆÃ¢â¬Â
âââ‰âÂ¢ÃÆÃââââ¬ÃÂ
̢̢̮ââ¬Å¡Ã¬Ã¢ââ¬Å¾ÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬ÃâÃÂ ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢Ã¢ââ¬Ã
¾ÃâÃÂ¢ÃÆÃâÃâ ââ¬â¢ÃÆÃ¢â¬Â
âââ‰âÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢â¬Å¡ÃâÃÂ ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬Ãâ¦ÃÂ¡ÃÆÃ¢â¬Å¡ÃâÃÂ¬ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬Ãâ¦ÃÂ¾ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Â âââ‰âÂ¢ÃÆÃââââ¬ÃÂ
̢̢̮ââ¬Å¡Ã¬Ã¢ââ¬Å¾ÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬Ãâ¦ÃÂ¡ÃÆÃ¢â¬Å¡ÃâÃÂ¬ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ ÃÆÃâÃâ ââ¬â¢ÃÆÃ¢â¬Â
âââ‰âÂ¢ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢â¬Â¦ÃâÃÂ¡ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ¬ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢â¬Â¦ÃâÃÂ¾ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâ ââ¬â¢ÃÆÃ¢â¬Â
âââ‰âÂ¢ÃÆÃââââ¬ÃÂ
̢̢̮ââ¬Å¡Ã¬Ã¢ââ¬Å¾ÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬ÃâÃÂ ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢Ã¢ââ¬Ã
¾ÃâÃÂ¢ÃÆÃâÃâ ââ¬â¢ÃÆÃ¢â¬Â
âââ‰âÂ¢ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢â¬Â¦ÃâÃÂ¡ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ¬ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬ÃâÃÂ¦ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡ÃâÃÂ¡ÃÆÃâÃâ ââ¬â¢ÃÆÃ¢â¬Â
âââ‰âÂ¢ÃÆÃââââ¬ÃÂ
̢̢̮ââ¬Å¡Ã¬Ã¢ââ¬Å¾ÃÂ¢ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Å¡ÃâÃÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬Ãâ¦ÃÂ¡ÃÆÃ¢â¬Å¡ÃâÃÂ¬ÃÆÃââââ¬ÃÂ¦ÃÆÃ¢â¬Å¡ÃâÃÂ¡ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢â¬Â âââ‰âÂ¢ÃÆÃâÃâÃÂ¢ÃÆÃ¢Ã¢ââ¬Ã
¡ÃâÃÂ¬ÃÆÃ¢â¬Â¦ÃâÃÂ¡ÃÆÃâÃâ
ââ¬â¢ÃÆÃ¢Ã¢ââ¬Å¡Ã¬Ãâ¦ÃÂ¡ÃÆÃââââ¬Ã
Â¡ÃÆÃ¢â¬Å¡Ãâálido, se devuelve IBAN = ALL "0"
*
IDENTIFICATION DIVISION.
PROGRAM-ID. CAIBANM.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. DECIMAL-POINT IS COMMA, LOCAL-DATA IS L-D-A.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
DATA DIVISION.
FILE SECTION.
*
WORKING-STORAGE SECTION.
01 RTABLET.
03 FILLER PIC X VALUE "A".
03 FILLER PIC X VALUE "B".
03 FILLER PIC X VALUE "C".
03 FILLER PIC X VALUE "D".
03 FILLER PIC X VALUE "E".
03 FILLER PIC X VALUE "F".
03 FILLER PIC X VALUE "G".
03 FILLER PIC X VALUE "H".
03 FILLER PIC X VALUE "I".
03 FILLER PIC X VALUE "J".
03 FILLER PIC X VALUE "K".
03 FILLER PIC X VALUE "L".
03 FILLER PIC X VALUE "M".
03 FILLER PIC X VALUE "N".
03 FILLER PIC X VALUE "O".
03 FILLER PIC X VALUE "P".
03 FILLER PIC X VALUE "Q".
03 FILLER PIC X VALUE "R".
03 FILLER PIC X VALUE "S".
03 FILLER PIC X VALUE "T".
03 FILLER PIC X VALUE "U".
03 FILLER PIC X VALUE "V".
03 FILLER PIC X VALUE "W".
03 FILLER PIC X VALUE "X".
03 FILLER PIC X VALUE "Y".
03 FILLER PIC X VALUE "Z".
01 TABLET REDEFINES RTABLET.
03 TLET PIC X OCCURS 26.
*
01 RTABNUM.
03 FILLER PIC 99 VALUE 10.
03 FILLER PIC 99 VALUE 11.
03 FILLER PIC 99 VALUE 12.
03 FILLER PIC 99 VALUE 13.
03 FILLER PIC 99 VALUE 14.
03 FILLER PIC 99 VALUE 15.
03 FILLER PIC 99 VALUE 16.
03 FILLER PIC 99 VALUE 17.
03 FILLER PIC 99 VALUE 18.
03 FILLER PIC 99 VALUE 19.
03 FILLER PIC 99 VALUE 20.
03 FILLER PIC 99 VALUE 21.
03 FILLER PIC 99 VALUE 22.
03 FILLER PIC 99 VALUE 23.
03 FILLER PIC 99 VALUE 24.
03 FILLER PIC 99 VALUE 25.
03 FILLER PIC 99 VALUE 26.
03 FILLER PIC 99 VALUE 27.
03 FILLER PIC 99 VALUE 28.
03 FILLER PIC 99 VALUE 29.
03 FILLER PIC 99 VALUE 30.
03 FILLER PIC 99 VALUE 31.
03 FILLER PIC 99 VALUE 32.
03 FILLER PIC 99 VALUE 33.
03 FILLER PIC 99 VALUE 34.
03 FILLER PIC 99 VALUE 35.
01 TABNUM REDEFINES RTABNUM.
03 TNUM PIC 99 OCCURS 26.
*
*
01 OBAN.
03 OBAN-ENT PIC 9999.
03 OBAN-AGE PIC 9999.
03 OBAN-DG2 PIC 99.
03 OBAN-CTA PIC 9(10).
03 OBAN-NA1 PIC 99.
03 OBAN-NA2 PIC 99.
03 OBAN-DG1 PIC 99.
01 R-OBAN REDEFINES OBAN.
03 OBAN-01 PIC 9(09).
03 OBAN-02 PIC 9(09).
03 OBAN-03 PIC 9(08).
*
01 VAL-OBAN-2.
03 R1 PIC 99.
03 V-OBAN-2 PIC 9(09).
01 R-VAL-OBAN-2 REDEFINES VAL-OBAN-2 PIC 9(11).
*
01 VAL-OBAN-3.
03 R2 PIC 99.
03 V-OBAN-3 PIC 9(08).
01 R-VAL-OBAN-3 REDEFINES VAL-OBAN-3 PIC 9(10).
*
01 DIVISOR PIC 9(9).
01 ZZ PIC 99.
01 RESTO1 PIC 99.
01 RESTO2 PIC 99.
01 RESTO3 PIC 99.
*
LINKAGE SECTION.
01 IBAN.
03 IBAN-NAC PIC XX.
03 IBAN-DG1 PIC 99.
03 IBAN-ENT PIC 9999.
03 IBAN-AGE PIC 9999.
03 IBAN-DG2 PIC 99.
03 IBAN-CTA PIC 9(10).
*
PROCEDURE DIVISION USING IBAN.
INICIO.
*
PERFORM VARYING ZZ FROM 1 BY 1 UNTIL ZZ > 26
IF (TLET(ZZ) = IBAN-NAC(1:1))
MOVE TNUM(ZZ) TO OBAN-NA1 OF OBAN
MOVE 50 TO ZZ
END-IF
END-PERFORM.
IF (ZZ > 26 AND
ZZ < 50)
MOVE ZEROS TO OBAN-NA1 OF OBAN
END-IF.
PERFORM VARYING ZZ FROM 1 BY 1 UNTIL ZZ > 26
IF (TLET(ZZ) = IBAN-NAC(2:1))
MOVE TNUM(ZZ) TO OBAN-NA2 OF OBAN
MOVE 50 TO ZZ
END-IF
END-PERFORM.
IF (ZZ > 26 AND
ZZ < 50)
MOVE ZEROS TO OBAN-NA2 OF OBAN
END-IF.
*
IF NOT(IBAN(05:20) IS NUMERIC)
MOVE ALL "0" TO IBAN
GO TO FIN
END-IF.
*
MOVE IBAN-DG1 OF IBAN TO OBAN-DG1 OF OBAN.
MOVE IBAN-ENT OF IBAN TO OBAN-ENT OF OBAN.
MOVE IBAN-AGE OF IBAN TO OBAN-AGE OF OBAN.
MOVE IBAN-DG2 OF IBAN TO OBAN-DG2 OF OBAN.
MOVE IBAN-CTA OF IBAN TO OBAN-CTA OF OBAN.
*
DIVIDE OBAN-01 OF R-OBAN BY 97
GIVING DIVISOR REMAINDER RESTO1.
*
MOVE RESTO1 TO R1 OF VAL-OBAN-2.
MOVE OBAN-02 OF R-OBAN TO V-OBAN-2 OF VAL-OBAN-2.
DIVIDE R-VAL-OBAN-2 BY 97
GIVING DIVISOR REMAINDER RESTO2.
*
MOVE RESTO2 TO R2 OF VAL-OBAN-3.
MOVE OBAN-03 OF R-OBAN TO V-OBAN-3 OF VAL-OBAN-3.
DIVIDE R-VAL-OBAN-3 BY 97
GIVING DIVISOR REMAINDER RESTO3.
*
IF (RESTO3 NOT = 1)
MOVE ALL "0" TO IBAN
END-IF.
* DISPLAY IBAN.
*
FIN.
GOBACK.
____________________________________________________
Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd )
Forum.Help400 © Publicaciones Help400, S.L.