Une procédure RPGLE de la Formule de Luhn

Petite définition de la Luhn:

La formule de Luhn permet de vérifier la validité d’une suite de chiffre. Ex:SIREN, N°CB, N°PS (Médecin praticien, etc…). Le nombre est lu de droite à gauche. Les chiffres en position impaire restent tel que et les chiffres en position paire sont multipliées par 2. Tous les chiffres résultants sont ajoutés. Exemple 456:

Chiffres      4             5           6
Position      3             2           1
Résultats     4            10           6

Résultat 4 + 1 + 0 + 6 = 11

Un nombre Luhn est validé si le résultat est divisible par 10. Dans l’exemple précédent, le nombre n’est pas valide; 11 n’est pas divisible par 10. Un nombre valide est par exemple 455.

Coding

Voici ci-dessous, une procédure écrite pour vérifier un nombre. Elle est composée d’un procédure principale et 2 sous-procédures. La sous-procédure calcul détermine le résultat des additions successives. Remarque: dans le cas du calcul des positions paires, une autre règle a été appliquée sur les résultats supérieurs à 9. La somme des chiffres obtenus est égale à la multiplication par 2 moins 9.

5×2=10 Résultat 1+2=1 mais aussi 5×2-9=1
6×2=12 Résultat 1+2=3 mais aussi 6×2-9=3
7×2=14 Résultat 1+4=5 mais aussi 7×2-9=5
8×2=16 Résultat 1+6=7mais aussi 8×2-9=7
9×2=18 Résultat 1+8=9 mais aussi 9×2-9=9

La sous-procédure parité détermine si la position est paire ou impaire.

     h nomain

     dVerif_Luhn       PR              N
     d a_Nombre_Luhn              32768A   OPTIONS(*VARSIZE) CONST


     dCalcul           PR             6  0
     d a_Nombre_Luhn              32768A   OPTIONS(*VARSIZE) CONST

     d a_longueur                     5i 0

     D*--------------------------------------------------
     D* Procedure name: parite
     D* Purpose:        Déterminer si un nombre est pair ou impair
     D* Returns:
     D* Parameter:      a_nombre => Nombre dont on vérifie la parité
     D*--------------------------------------------------
     Dparite           PR              N
     D  a_nombre                      6P 0 value

     pVerif_Luhn       b                   Export
     dVerif_Luhn       PI              N
     dg_nbre_luhn                 32768A   OPTIONS(*VARSIZE) CONST

     d g_longueur      s              5i 0
     d g_valid         s              1  0
     d g_luhn          s               N
     d g_Nombre_Luhn   s             20A   Varying
      /free
       g_Nombre_Luhn=%trim(g_nbre_luhn);
       g_longueur=%len(%trim(g_Nombre_Luhn));
       g_valid=%rem( calcul(g_Nombre_Luhn:g_longueur):10);
       If g_valid=0;
         g_Luhn=*on;
       Else;
         g_Luhn=*off;
       ENDIF;
       Return g_Luhn;
      /end-free

     pVerif_Luhn       e

     pcalcul           b
     dCalcul           PI             6  0
     d l_Nombre_Luhn              32768A   OPTIONS(*VARSIZE) CONST
     d l_longueur                     5i 0

     d l_pos           s              5i 0
     d l_total         s              6  0
     d l_ajout         s              2  0

      /free

       FOR l_pos = l_longueur DOWNTO 1;
       // Le corps de la boucle va ici
         l_ajout=%dec(%subst(l_Nombre_Luhn:l_pos:1):2:0);
         if parite(l_pos);
           l_ajout=l_ajout*2;
           if l_ajout>9;
             l_ajout=l_ajout-9;
           ENDIF;
         ENDIF;
         l_total=l_total+l_ajout;
       ENDFOR;

       return l_total;
      /end-free

     pcalcul           e


     P*--------------------------------------------------
     P* Procedure name: parite
     P* Purpose:        Déterminer di un nombre est pair ou impair
     P* Returns:
     P* Parameter:      a_nombre => Nombre dont on vérifie la parité
     P*--------------------------------------------------
     P parite          B
     D parite          PI              N
     D  l_nombre                      6P 0 value


     D* Local fields
     D l_reste         s              1  0
     d l_pair          s               N   inz(*off)

      /FREE

        l_reste= %rem( l_nombre:2);
        if l_reste=0;
          l_pair=*on;
        ENDIF;

        RETURN l_pair;

      /END-FREE
     P parite          E
 

3 comments for “Une procédure RPGLE de la Formule de Luhn

  1. janvier 26, 2016 at 8:31

    Merci pour cet outil !

    Une petite correction est nécessaire, en effet lors de la détermination de la parité du chiffre selon sa position, il faut partir de la droite vers la gauche de la chaîne, ce qui n’est pas le cas dans le code.

    En l’état, le contrôle fonctionne pour un SIREN à 9 positions mais pas pour un SIRET à 14 positions !

    j’ai corrigé comme ceci :

    Dans la procédure calcul :
    // déclaration d’une variable position à partir de la droite
    d l_pos_droite s 5i 0

    /free

    l_pos_droite = 1;
    FOR l_pos = l_longueur DOWNTO 1;

    // Le corps de la boucle va ici
    l_ajout=%dec(%subst(l_Nombre_Luhn:l_pos:1):2:0);

    // envoyer la position du chiffre à partir de la droite à la procédure parité.
    if parite(l_pos_droite);
    l_ajout=l_ajout*2;
    if l_ajout>9;
    l_ajout=l_ajout-9;
    ENDIF;
    ENDIF;
    // partie modifiée par rapport au code
    // position en partant de la droite.
    // +1 à chaque occurence et c’est cette position
    // qui est envoyée à la procédure parité
    l_pos_droite +=1;

    C’est tout ! dans ce cas les contrôles SIREN / SIRET sont OK !

    Encore merci pour votre contribution.

    • Tips et tours de mains sur IBM i
      février 12, 2016 at 5:55

      Êtes-vous sûr, si nous partons avec une valeur l_pos_droite égale à 1 et ajout de 1 à chaque tour dans la boucle, ne partons-nous pas plutôt de la gauche vers la droite?

    • Ibmiiste
      mai 4, 2017 at 11:28

      Je suis d’accord, il faut que je revois le source.

Laisser un commentaire

Votre adresse de messagerie ne sera pas publiée. Les champs obligatoires sont indiqués avec *