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.

Responder a