Tester No de Sirete

Permet de tester un No de Sirete par l'algorithme de Luhn
Paramètres d'Entrée No de Sirete, et indicateur d'erreur
En sortie indicateur d'erreur = 1 si le Sirete n'est pas bon, à 0 si le Sirete est bon
Il marche sur tout type de compilateur cobol , aucune spécificité d'un quelconque constructeur étant employé

Nos ressources disponibles

Code Cobol :

Sélectionner tout

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 IDENTIFICATION DIVISION. 
       PROGRAM-ID. TSTSIR. 
* 
*       Ce programme sert à tester qu'un no de sirete est correct 
*        
       DATA DIVISION. 
       WORKING-STORAGE SECTION. 
       01 W-TOTAL PIC 9(3) value 0. 
       01       w-tot10 pic 999. 
       01 w-rest pic 99 value 0. 
       01       w-i pic 99 value 0. 
       01       w-elesir2 pic 99. 
       01       w-toggle pic 9 value 0. 
                88 toggle value is 0. 
       LINKAGE SECTION. 
       01       L-sirete. 
                        02 l-elesir pic 9 occurs 14 times. 
       01 w-erreur pic 9. 
       PROCEDURE DIVISION using l-sirete , w-erreur. 
       DEBUT. 
                move 1 to w-erreur. 
                if l-sirete is not numeric  
                        exit program. 
                move 0 to w-total w-toggle. 
                PERFORM VARYING W-i from 1 by 1 until w-i > 14 
                if toggle  
                        compute w-elesir2 = l-elesir(w-i) * 2 
                        if w-elesir2 > 9 
                                subtract 9 from w-elesir2 
                        end-if 
                        add w-elesir2 to w-total 
                        move 1 to w-toggle 
                        else 
                        add l-elesir(w-i) to w-total 
                        move 0 to w-toggle 
                end-if 
                end-perform. 
                compute w-tot10 = w-total / 10  
                compute w-rest = w-total - (w-tot10 * 10) 
                if w-rest = 0 move 0 to w-erreur. 
                exit program.

Signaler un problème

escartefigue

Modérateur

Le 21/10/2015 à 14:26

Bonjour,

Merci pour ce petit utilitaire qui peut rendre service.

Quelques remarques :

- C'est dommage de ne positionner qu'un code erreur unique, ici "1" alors que 2 types d'erreur sont possibles : SIRET non numérique (testé au début) et reste de la division différent de zéro (testé à la fin)
tout sous programme doit effectuer un diagnostic fin, avec donc un code erreur par type d'erreur, ici, on aurait pu avoir par exemple 1 et 2. Faute de quoi le traitement en amont ne peut pas savoir ce qu'il en est

- Un filler balise en début et en fin de working est toujours le bienvenu, ca permet, en cas de dump, de retrouver plus facilement le contenu de la WSS

Code :

Sélectionner tout

 01  FILLER PIC X(32) VALUE '*** DEBUT WSS TSTSIR ***'.

- C'est dommage de déclarer des variables de petite taille en utilisant des level "01" qui vont aligner les éléments sur 16 octets, il est préférable de créer une zone groupe "01 FILLER" dans laquelle on déclare autant de niveaux 02 qu'il y a de petites variable à déclarer, par exemple :

Code :

Sélectionner tout

1
2
3
4
5
6
7
8
01  FILLER.
    02  W-TOTAL PIC 9(3) value 0.
    02  w-tot10 pic 999.
    02  w-rest pic 99 value 0.
    02  w-i pic 99 value 0.
    02  w-elesir2 pic 99.
    02  w-toggle pic 9 value 0.
        88 toggle value is 0.

Ca peut sembler un détail, mais si on appelle un grand nombre de sous-programmes tous construits ainsi, on charge inutilement la région.

- il faut savoir qu'en COBOL, les variables faisant l'objet de calculs sont plus performantes si elles sont déclarées en packé signé.
si le code source demande un calcul sur une zone déclarée en étendu non signé (PIC 9(nn)) alors le calcul sera fait de la façon suivante :

ajout du signe
pack
calcul
unpack
suppression du signe
restitution du résultat ! (ouf)

Tout ceci n'est évidemment pas neutre en temps de traitement (jusqu'à 8 fois plus pour un calcul)