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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
Identification Division.
PROGRAM-ID. VSAISIE.
*---------------------*
* - Lecture d'un fichier de test qui contient la longueur d'un
* et le montant dont on veut vérifier la validité
* - Appel d'un programme CSAISIE qui controle ce montant
* (en source interne pour validation de tous les cas de tests)
*---------------------*
Environment Division.
*---------------------*
Configuration Section.
Input-Output Section.
File-Control.
Select FICIN Assign to SYSIN.
Data Division.
File Section.
FD FICIN
Recording mode is F
Block 0.
01 FICHIER-TEST.
05 FICIN-DATA-LG PIC 9(3).
05 FICIN-DATA PIC X(77).
Working-Storage Section.
01 WS-WORK.
05 WS-LECTURE pic X.
88 FINI Value '1'.
05 WS-COUNT Pic s9(8) Binary.
05 WS-COMM.
10 WS-COMM-RET pic x.
10 WS-COMM-DATA pic x(64).
Procedure Division.
Move space to WS-WORK
Open Input FICIN.
Perform until FINI
Read FICIN
At End Set FINI to TRUE
Not At End
Display 'LIGNE : ' FICHIER-TEST(1:40)
If FICIN-DATA-LG numeric and
FICIN-DATA-LG not = ZERO
Compute WS-COUNT = FICIN-DATA-LG
+ FICIN-DATA-LG + 1
Move FICIN-DATA to WS-COMM-DATA
CALL 'CSAISIE' Using WS-COMM WS-COUNT
Display 'RENDU : ' WS-COMM(1:65)
End-if
End-Read
End-Perform
Close FICIN
Goback.
Identification Division.
PROGRAM-ID. CSAISIE.
*==============================================================*
* Module de contrôle de numéricité d'un montant cadré à gauche *
* de 1 à 31 caractères =maximum en pic 9 ;z/OS si ARITH(EXTEND)*
* Reçoit l'adresse d'une zone de communication et sa longueur *
* sur un mot pour CALL 'CSAISIE' Using ZCOMM *
* By Content length of ZCOM *
* Reçoit dans la zone de communication un code retour rendu à :*
* Blanc si le montant cadré à gauche est numérique *
* (mais en tenant compte de blancs éventuels devant)*
* 'E' si la longueur recue est invalide ou oubliée *
* '0' si le montant cadré à gauche est n'est pas numérique *
* Ce code retour est suivi du montant de 1 à 32 caractères, *
* Lequel est lui même suivi du montant restitué cadré à droite *
*==============================================================*
Data Division.
Working-Storage Section.
01 WS.
05 WS-PTR Pointer.
05 WS-LENGTH Pic s9(4) Binary.
05 WS-COUNT Pic s9(4) Binary.
05 WS-RESTIT Pic s9(4) Binary.
05 WS-DATA Pic x(33).
Linkage Section.
*================
01 LS-ZCOMM.
05 LS-RET Pic x.
05 LS-DATA Pic x(64).
01 LS-LONGUEUR Pic s9(8) Binary.
Procedure Division using LS-ZCOMM LS-LONGUEUR.
* On élimine les cas de longueur reçue invalide
Move 'E' to LS-RET
Set WS-PTR to address of LS-LONGUEUR
if WS-PTR = NULL or
LS-LONGUEUR = ZERO or Greater 65 Then Goback
End-if
* Longueur ZCOM valide : calcul longeur du montant à traiter
* Code retour non numérique par défaut.
Move '0' to LS-RET
Compute WS-LENGTH = ((LS-LONGUEUR - 1) / 2)
* Donnée de restitution calculée et initialisée à zéro
Compute WS-RESTIT = WS-LENGTH + 1
Move ZERO to LS-DATA(WS-RESTIT:WS-LENGTH)
* Gestion du montant reçu
Move function REVERSE(LS-DATA(1:WS-LENGTH)) to WS-DATA
Move Zero to WS-COUNT
Inspect WS-DATA Tallying WS-COUNT For Leading Space
Add WS-COUNT to WS-RESTIT
Compute WS-COUNT = WS-LENGTH - WS-COUNT
If WS-COUNT > 0
* Si MONTANT à blancs WS-COUNT = 0, sinon restit. si OK
Inspect LS-DATA(1:WS-COUNT) Replacing Leading ' ' BY '0'
If LS-DATA(1:WS-COUNT) is Numeric
Move Space to LS-RET
Move LS-DATA(1:WS-COUNT) to LS-DATA(WS-RESTIT:WS-COUNT)
End-if
End-if
Goback.
End Program CSAISIE.
End Program VSAISIE. |
