Cobol écran

Il existe mainte façon de coder un programme interactif en Cobol 400...
Ici, parti-pris a été de déclarer les zones du fichier écran (dds) en both, éventuellement limitées par dspatr(pr) et chginpdft,  de manière à n'utiliser qu'un seul buffer (le i bien sûr !).
N'oublions pas indara.

Le lecteur audacieux enrichira sa réflection en comparant ce source avec celui-ci !

ID DIVISION.
PROGRAM-ID. ZFIC045.

* saisie 2
* date
* zones en B

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

SELECT ecranfm ASSIGN TO WORKSTATION-zfic045fm-si
ORGANIZATION TRANSACTION.

SELECT zfic010p ASSIGN TO DATABASE-zfic010p
RECORD KEY EXTERNALLY-DESCRIBED-KEY
ORGANIZATION INDEXED
ACCESS random.


DATA DIVISION.
FILE SECTION.

FD zfic010p.
01 zfic010p01.
COPY DDS-ALL-FORMATS OF zfic010p.

FD ecranfm.
01 ecran pic x(1920).



WORKING-STORAGE SECTION.

01 lesindics.
02 tc pic 1 occurs 99 indic 1.

01 ecranw1-es.
copy dds-ecranw1-i of zfic045fm.

01 ecranw2-es.
copy dds-ecranw2-i of zfic045fm.

77 identw2 pic x(5).
77 trtw pic x(10).


PROCEDURE DIVISION.
debut.

open i-o ecranfm
open i-o zfic010p

write ecran                                     Fond 1°affichage.
format is "ECRAN01" indic are tc.

initialize ecranw1-i

move "ecranw1" to trtw. 1°écran


boucle.
perform with test after until trtw = "fin"      Boucle générale


if trtw = "ecranw1"

write ecran from ecranw1-i
format is "ECRANW1" indic are tc            Fenetre ou l'on saisi
read ecranfm into ecranw1-i                 la clé du fichier.
format is "ECRANW1" indic are tc
if tc(03) = b"1" or tc(12) = b"1"
move "fin" to trtw Fin.
go to boucle
end-if

move " " to messw

if identw of ecranw1-i = 0
move b"1" to tc(51)                          Ctrl saisie
go to boucle
end-if

move identw of ecranw1-i to ident of zfic010p01   Chain du
read zfic010p with no lock                        fichier

invalid key
move b"1" to tc(21)                               non trouvé
initialize zfic010f
move 20010101 to zd1 of zfic010f
move 20020202 to zd2 of zfic010f

not invalid key
move b"0" to tc(21)                                trouvé
end-read

move corr zfic010f to ecranw2-i
move identw of ecranw1-i to ident of ecranw2-i

move b"0" to tc(89)                          Témoin touché
move "ecranw2" to trtw                       Ecran suivant

end-if


if trtw = "ecranw2"

write ecran from ecranw2-i
format is "ECRANW2" indic are tc         Fenetre de saisie
read ecranfm into ecranw2-i
format is "ECRANW2" indic are tc
if tc(03) = b"1"
move "fin" to trtw                            Fin.
go to boucle
end-if
if tc(12) = b"1"
move "ecranw1" to trtw                         Retour.
go to boucle
end-if

if tc(88) = b"1"                              Change
move b"1" to tc(89)                           Touché
end-if

if tc(23) = b"1"                             Suppression

write ecran
format is "ECRCONF" indic are tc              Fenetre de
read ecranfm                                  confirmation
format is "ECRCONF" indic are tc
if not (tc(03) = b"1" or tc(12) = b"1")       Si "entrée"
move "maj" to trtw                            Suppression
else
continue
end-if
go to boucle
end-if

if za1 of ecranw2-i = " "
move b"1" to tc(51)                          Ctrl saisie
go to boucle
end-if

if za2 of ecranw2-i = " "
move b"1" to tc(52)                          Ctrl saisie
go to boucle
end-if

if tc(88) = b"1"                          Réaffichage si
go to boucle                              change
end-if

if tc(89) = b"1"
move "maj" to trtw                       Maj
else
move "ecranw1" to trtw                  Retour 1° écran
move 0 to identw of ecranw1-i
end-if

end-if


if trtw = "maj"

move corr ecranw2-i to zfic010f
if tc(23) = b"1"
delete zfic010p                          Suppression
invalid key
move "Opération NON effectuée !" to messw  Situation
move "ecranw1" to trtw                     inatendue !
go to boucle                            Retour 1°écran
not invalid key
move "supprimé" to messw(7 : )
end-delete
else
if tc(21) = b"1"
write zfic010p01                          Création
invalid key
move "Opération NON effectuée !" to messw  Situation
move "ecranw1" to trtw                     inatendue !
go to boucle                             Retour 1°écran
not invalid key
move "créé" to messw(7 :)
end-write
else
rewrite zfic010p01                        Mise à jour
invalid key
move "Opération NON effectuée !" to messw  Situation
move "ecranw1" to trtw                     inatendue !
go to boucle                           Retour 1°écran
not invalid key
move "modifié" to messw(7 : )
end-rewrite
end-if
end-if

move ident of zfic010f to identw2
move identw2 to messw(1 : 5)
move "ecranw1" to trtw               Retour 1° écran
move 0 to identw of ecranw1-i

end-if


end-perform                           Boucle générale


goback. Fin