Le web de Dominique Guebey – IBM AS/400 iSeries

Page : http://www.dg77.net/tekno/as400/as400sfl.htm


   D o m i n i q u e   G u e b e y    J u n g l e     IBM AS/400 iSeries

Sous-fichier dynamique en RPG III

Sommaire

Généralités

Exemples de programme interactif. Un concentré de programmation en informatique de gestion... Ce document a remplacé un ancien pense-bête mais est toujours en vieux GAP 3 (RPG III).

Le sous-fichier, dont la description est intégrée au format d’écran, permet la visualisation/sélection rapide par défilement d’une liste d’informations.

Le traîtement dit « dynamique » du sous-fichier signifie qu’on ne charge que le nombre d’enregistrements nécessaire à chaque affichage du format d’écran. Dans l’exemple ci-dessous, le programme commence par compter le nombre de lignes à afficher (cf sous-routine *INZSR). De cette façon il est inutile de modifier le source RPG si ce nombre est changé dans le source DDS (cf mots-clefs SFLSIZ et SFLPAG).

La définition de sous-fichier prévoit l’affichage sur une portion donnée de l’écran. Le format d’affichage associé (dont le mot-clef SFLCTL désigne le format du sous-fichier) ne doit pas empiéter sur cette partie. Cette particularité conduit souvent à la définition de l’affichage du bas de l’écran dans un format séparé.

English abstract

Brief summary
A superbly rich sample in programming (interactive program, not batch), using the very classical RPG 3 language.
A subfile allows displaying and scrolling pieces of data extracted from a file. Its description is implemented within the DDS of the display file.
These programs use dynamic method. For each page (screen display), only the necessary number of records is retrieved and this is done only when they are needed.

Programme MAINT01R

Description

Maintenance classique d’un fichier de données :

Ecrans
Affichage du sous-fichier pour choix
 MAINT01R   AS400SIX         Maintenance codages                        14/07/07
 GUEBEY                                                                 13:12:46
                                                                                
 Type de contrôle  . . . : ___         Code écran : ___                         
                                                                                
Indiquez vos options, puis appuyez sur Entrée.                                  
1=Commentaires   2=Modifier   3=Copier   4=Supprimer   5=Afficher
 O Typ Ano Séq Libellé                                O/N Com Blk Sai Ecr
 _ CAM 001 01 Absence de bon de livraison  . . . . . . O   O   N   B            
 _ CAM 004 04 Palettes écroulées . . . . . . . . . . . O   O   O   F  T01       
 _ CAM 005 05 Palettes inaccessibles . . . . . . . . . O   O   N   F  T01       
 _ CAM 006 06 Palettes inadaptées au contrôle. . . . . O   O   N   F            
   CND 001 00 Mauvais cond. paquet . . . . . . . . . . N   O   O   B            
 _ CND 002 00 Plusieurs parutions par paquet . . . . . N   O   O   B            
 _ CND 003 09 Etalon variable  . . . . . . . . . . . . O   O   O   F            
 _ CND 004 00 Paquet complet instable  . . . . . . . . N   O   N   B            
 _ CND 008 10 Etalon non conforme                      N   N   O   F  T01       
 _ CND 009 12 Paquet supérieur ou égal à 12kg          N   N   O   F            
 _ CND 010 03 Plusieurs parutions/palettes . . . . . . O   O   N   F  T02       
 _ CND 011 04 Edition différente mal repérée . . . . . O   O   O   F  T02       
                                                                                
 F3=Sortie              F6=Créer     Défil/haut  Défil/bas 
 F5=réaffichage   F7=recherche       F17=Début   F18=Fin   F4=Sélection
 Suppression impossible, clef CND-001 déjà utilisée
Modification d’un enregistrement (option 2)
 MAINT01R   AS400SIX         Maintenance codages                        14/07/07
 GUEBEY                                                                 13:12:46
                                                                                
 Type de contrôle  . . . : CAM                                                  
 Code anomalie . . . . . : 001                                                  
 MODIFICATION                                                                   
 Entrez les données puis appuyez sur Entrée
 Ordre d'affichage . . . :  1                                                   
 Libellé de l'anomalie   : Absence de bon de livraison  . . . . . .             
 Indicateur de blocage   : N                                                    
 Présence zone O/N . . . : O       Commentaire saisissable : O                  
                             B = invisible                                      
 Comportement à l'écran  : B F = saisie facultative                             
                             O = saisie obligatoire                             
 Code écran                ___     
 Top Actif                 _       
 Message                   _       
                                   
                                   
                                                                                
                                                                                
            F12=Retour               
 
Fenêtre pour recherche d’une suite de caractères (touche F7)

Remarques 

MAINT01R   AS400SIX         Maintenance co
GUEBEY                                    
                        
                          ___         Code
  Chaîne de recherche                     
  ________________        appuyez sur Entr
  F12=Retour             r   3=Copier   4=
                        
                         on de livraison
_ CAM 004 04 Palettes écroulées . . . . . 
_ CAM 005 05 Palettes inaccessibles . . . 
_ CAM 006 06 Palettes inadaptées au contrô
_ CND 001 00 Mauvais cond. paquet . . . . 
Gestion de sous-fichiers de message
Principe

Le programme adresse à l’opérateur certaines informations sous forme d’avertissement (par ex : « Enregistrement existe déja »). Au lieu d’utiliser un tableau de chaînes prédéfinies incluses dans un membre source (comme celà est fait dans le second exemple — MAINT02R infra), il est possible d’utiliser un sous-fichier de messages. Ce dernier permet d’accéder à un fichier de messages (*MSGF) prédéfini et modifiable à volonté par des commandes AS/400.

Lorsque le message apparaît, il est possible de faire apparaître un texte plus détaillé en positionnant le curseur sur la ligne de messages et en actionnant la touche F1.

Les spécifications concernées figurent sur fond bleu dans les listings ci-dessous.

Le fichier de message est censé être BIBLIO/FICMSG, les id. messages sont nommés DGMnnnn (DGM0001, DGM0002 etc.). Certains messages utilisent des variables de substitutions transmises par le programme. Dans l’exemple on en utilise 2 totalisant 6 caractères.

Fichier de messages
Création du fichier
CRTMSGF  [bibliotheq]/[nom_msgf]
Ajout d’un message
ADDMSGD  MSGID(XXX0000) MSGF([bibliotheq]/[nom_msgf]) MSG('Texte court') SECLVL('Texte détaillé')
Exemple d’une commande avec variables de substitutions
ADDMSGD MSGID(DGM0003) MSGF(VGUEBEY/DG_MSG) MSG('Enregistrement &1-&2 existe déjà') SECLVL('L''enregistrement ne peut être créé dans le fichier ARTICLL1 car la clef &1-&2 existe déjà') FMT((*CHAR 3) (*CHAR 3))
Gestion des messages
WRKMSGD MSGF([bibliotheq]/[nom_msgf])
                           Descriptions de messages
                                                           Système:   
Fichier de messages:   FICMSG         Bibliothèque:   BIBLIO         
                                                                      
Afficher à partir de  . .  _______    ID message                      
                                                                      
Indiquez vos options, puis appuyez sur ENTREE.
  2=Modifier   4=Supprimer   5=Afficher détails   6=Imprimer
                                                                      
Opt  ID message  Gravité  Texte du message                            
 _    DGM0001        0    Fin de liste atteinte                           
 _    DGM0002        0    Début de liste atteint                          
 _    DGM0003        0    Enregistrement &1-&2 existe déjà                
 _    DGM0004        0    Suppression impossible, clef &1-&2 déjà utilisée
 _    DGM0005        0    Donnée(s) entrée(s) non valide(s)               
 _    DGM0006        0    L'enregistrement &1-&2 n'existe plus            
 _    DGM0007        0    Pas d'aide prévue dans ce champ                 
                                                                      
                                                                  Fin 
Paramètres ou commande                                                    
===> _____________________________________________________________________
F3=Exit   F5=Réafficher   F6=Ajouter   F12=Annuler   F24=Autres touches
SQL et fenêtre externe de sélection

Voir la page Ma petite fenêtre de sélection (SQL en RPG III)

Le présent programme permet de restreindre l’affichage en fonction du choix d’un code. Un petit module, appelé par la touche F4, permet de dresser à la volée la liste des codes qui figurent dans le fichier, et d’en choisir un. Les spécifications concernées dans MAINT01R figurent sur fond vert dans le membre source.

Additif (3) : récupération du nom de système

L’écran affiche le nom du système directement récupéré par l’API QWCRNETA. Voir les spécifications sur fond rouge. A défaut il faut passer par un CL utilisant la commande RTVNETA.

Source du format d’écran (MAINT01£)
     A                                      DSPSIZ(24 80 *DS3)                  
     A                                      PRINT                               
     A                                      INDARA                              
     A                                      HELP ALTHELP(CA01)
     A  91                                  CA04(04 'Sélection  ')
     A  91                                  CA05(05 'Réaffichage')              
     A  91                                  CA06(06 'Ajout')                    
     A  91                                  CA07(07 'Recherche')
     A                                      CA12(12 'Annulation')               
     A  91                                  CA17(17 'Début')                    
     A  91                                  CA18(18 'Fin')                      
      * ------------------------------------------------------------- *         
      * Affiche 2 premières lignes de l'écran                         *         
      * ------------------------------------------------------------- *         
     A          R £1ENTETE
     A            ££PGM         10A  O  1  2COLOR(BLU)                          
     A            NOMSYS         8A  O  1 13COLOR(BLU)                          
     A                                  1 29' Maintenance codages '             
     A                                      DSPATR(RI)                          
     A                                  1 73DATE                                
     A                                      EDTCDE(Y)                           
     A                                      COLOR(BLU)                          
     A                                  2  2USER                                
     A                                      COLOR(BLU)                          
     A                                  2 73TIME                                
     A                                      COLOR(BLU)                          
      * ------------------------------------------------------------- *         
      * Définition du sous fichier (correspond au fichier ARTICL)     *
      * ------------------------------------------------------------- *         
     A          R £1SFL                     SFL
     A            £1OPT          1A  B  9  2DSPATR(UL)                          
     A                                      VALUES(' ' '1' '2' '3' '4' '5')     
     A            £1CODA         3A  O  9  4TEXT('Type de contrôle')   
     A            £1CODB         3A  O  9  8TEXT('Code anomalie')      
     A            £1B7NB         2Y 0O  9 12TEXT('Numéro de séquence') 
     A            £1G3TX        40A  O  9 15TEXT('Libellé de l''anomalie')
     A            £1L8ST         1A  O  9 56TEXT('Indicateur de présence')
     A            £1MZST         1A  O  9 60TEXT('Présence de commentaire')
     A            £1L7ST         1A  O  9 64TEXT('Indicateur de blocage')
     A            £1M0ST         1A  O  9 68TEXT('Indicateur de saisie')
     A            £1Z2TX         3A  O  9 71TEXT('Code écran programme')
     A* ------------------------------------------------------------- *         
     A* Format dit de contrôle associé au sous-fichier                *         
     A* ------------------------------------------------------------- *         
     A          R £1CTL                     SFLCTL(£1SFL)
     A                                      SFLSIZ(0012)
     A                                      SFLPAG(0012)
     A                                      ROLLUP(95)
     A                                      ROLLDOWN(96)
     A                                      CA03(03 'Fin de travail')           
     A                                      OVERLAY                             
     A  92                                  SFLDSP
     A N01                                  SFLDSPCTL
     A  01                                  SFLCLR
      * Recupere informations du curseur - enreg/zone/coord.)                   
     A                                      RTNCSRLOC(&CRSRCD &CRSFLD &CRSPOS)  
     A            CRSRCD        10A  H                                          
     A            CRSFLD        10A  H                                          
     A            CRSPOS         4S 0H                                          
      *                                                                         
     A            NUMREC         3S 0H      SFLRCDNBR(CURSOR)
     A                                  4  2'Type de contrôle  . . . :'
     A            ££TYPC         3A  B  4 28                                    
     A  93                                  DSPATR(PC)
     A                                  4 40'Code écran :'                      
     A            ££Z2TX         3A  B  4 53                                    
     A  97                              5  2'Sélection libellés contenant'
     A                                      COLOR(WHT)      
     A  97        £CHRCH        18      5 31COLOR(WHT)      
     A                                  6  1'Indiquez vos options, puis appuyez-
     A                                       sur Entrée.'                       
     A                                      COLOR(BLU)                          
     A                                  7  1'1=Commentaires'                    
     A                                      COLOR(BLU)                          
     A                                  7 18'2=Modifier'                        
     A                                      COLOR(BLU)                          
     A                                  7 31'3=Copier'                          
     A                                      COLOR(BLU)                          
     A                                  7 42'4=Supprimer'                       
     A                                      COLOR(BLU)                          
     A                                  7 56'5=Afficher'                        
     A                                      COLOR(BLU)                          
     A                                  8  1' O Typ Ano Séq '            
     A                                      DSPATR(HI)                          
     A                                  8 55'O/N'                               
     A                                      DSPATR(HI)                          
     A                                  8 59'Com'                               
     A                                      DSPATR(HI)                          
     A                                  8 63'Blk'                               
     A                                      DSPATR(HI)                          
     A                                  8 67'Sai'                               
     A                                      DSPATR(HI)                          
     A                                  8 71'Ecr'                               
     A                                      DSPATR(HI)                          
      * ------------------------------------------------------------- *         
      * Bas de l'écran : touches de fonction et messages              *         
      * ------------------------------------------------------------- *         
     A          R £1CMD                                                         
     A                                      OVERLAY                             
     A  91                             22  2'F3=Sortie'                         
     A                                      COLOR(BLU)                          
     A  90                             22 13'F12=Retour'                        
     A                                      COLOR(BLU)                          
     A  91                             22 25'F6=Créer'                          
     A                                      COLOR(BLU)                          
     A  91                             22 38'Défil/haut' 
     A                                      COLOR(BLU)   
     A  91                             22 50'Défil/bas'  
     A                                      COLOR(BLU)   
     A  91                             23  2'F5=réaffichage'                    
     A                                      COLOR(BLU)                          
     A  91N97                          23 18' F7=recherche    ' 
     A                                      COLOR(BLU)          
     A  91 97                          23 18' F7=fin recherche '
     A                                      COLOR(BLU)          
     A                                      DSPATR(RI)          
     A  91                             23 38'F17=Début'         
     A                                      COLOR(BLU)          
     A  91                             23 50'F18=Fin'           
     A                                      COLOR(BLU)          
     A  91                             23 60'F4=Sélection'
     A                                      COLOR(BLU)
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
      * Messages sur la 24e ligne                                     *
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
     A          R £0MSGSFL                  SFL                        
     A                                      SFLMSGRCD(24)              
     A            MSGKEY                    SFLMSGKEY                  
     A            $PGM                      SFLPGMQ                    
     A          R £0MSGCTL                  SFLCTL(£0MSGSFL)           
     A                                      SFLSIZ(2)                  
     A                                      SFLPAG(1)                  
     A                                      SFLDSP                     
     A                                      SFLDSPCTL                  
     A                                      SFLINZ                     
     A                                      OVERLAY                    
     A            $PGM                      SFLPGMQ                    
     A* ------------------------------------------------------------- *         
     A* Saisie ou affichage d'un enregistrement                       *         
     A* 84 = visualisation                                            *         
     A* 87 = suppression                                              *         
     A* 88 = suppression demandée mais enreg non supprimable          *         
     A* 89 = création                                                 *         
     A* ------------------------------------------------------------- *         
     A          R £2ENR
     A                                      OVERLAY                             
     A                                  4  2'Type de contrôle  . . . :' 
     A            £2CODA         3A  B  4 28                                    
     A N89                                  DSPATR(PR)                          
     A                                  5  2'Code anomalie . . . . . :' 
     A            £2CODB         3A  B  5 28                                    
     A N89                                  DSPATR(PR)                          
     A            £ACTIO        30   O  6  2DSPATR(HI)                          
     A                                  7  2'Entrez les données puis appuyez su-
     A                                      r Entrée'                           
     A                                      COLOR(BLU)                          
     A                                  8  2'Ordre d''affichage . . . :'        
     A            £2B7NB         2S 0B  8 28                                    
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A                                  9  2'Libellé de l''anomalie   :'        
     A            £2G3TX        40A  B  9 28CHECK(LC)                           
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  70                                  DSPATR(PC)                          
     A  70                                  DSPATR(RI)                          
     A                                 11  2'Présence zone O/N . . . :'         
     A            £2L8ST         1A  B 11 28                                    
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  71                                  DSPATR(PC)                          
     A  71                                  DSPATR(RI)                          
     A                                 10  2'Indicateur de blocage   :'
     A            £2L7ST         1A  B 10 28                                    
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  72                                  DSPATR(PC)                          
     A  72                                  DSPATR(RI)                          
     A                                 11 36'Commentaire saisissable :'         
     A            £2MZST         1A  B 11 62                                    
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  73                                  DSPATR(PC)                          
     A  73                                  DSPATR(RI)                          
     A                                 13  2'Comportement à l''écran  :'        
     A            £2M0ST         1A  B 13 28                                    
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  74                                  DSPATR(PC)                          
     A  74                                  DSPATR(RI)                          
     A                                 12 30'B = invisible'                     
     A                                 13 30'F = saisie facultative'            
     A                                 14 30'O = saisie obligatoire'            
     A                                 15  2'Code écran               '         
     A            £2Z2TX         3A  B 15 28                                    
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  87N88                          20  2'Confirmer la suppression :'        
     A                                      COLOR(WHT)                          
     A  87N88     £2CONF         1A  B 20 29DSPATR(PC)                          
     A  87N88                          20 31'(O/N)'                             
     A                                      COLOR(WHT)                          
     A* ------------------------------------------------------------- *
     A          R £3RECH
     A                                      WINDOW(3 2 5 20)
     A                                      BLINK           
     A                                      OVERLAY         
     A                                      WDWBORDER((*COLOR BLU) (*DSPATR RI)-
     A                                       (*CHAR '        '))                
     A                                  2  1'Chaîne de recherche'               
     A            £3ZONE        16A  B  3  1CHECK(LC)       
     A                                  4  1'F12=Retour'    
     A                                      COLOR(BLU)      
Source du programme RPG III (MAINT01R)
      *===============================================================*
      * MAINTENANCE DES CODIFICATIONS                                 *
      *===============================================================*
      * INDICATEURS :
      * 01 : effacement du sous-fichier         SBR SFL & *INZSR
      * 02 : sous-fichier plein                 SBR SFL         
      * 03 : F3  - fin de travail               Format écran    
      * 04 : F4  - Ecran de sélection           Format écran
      * 05 : F5  - réaffichage SFL              Format écran    
      * 06 : F6  - ajout d'enregistrement       Format écran    
      * 07 : F7  - recherche                    Format écran    
      * 12 : F12 - rend la main                 Format écran    
      * 17 : F17 - affichage du début           Format écran    
      * 18 : F18 - affichage de la fin          Format écran    
      * 70-77 : erreurs de saisie               SBR CONTRO      
      * 81 : contrôle de validité = FALSE       SBR CONTRO      
      * 83 : option 3 = copie                   SBR COPIE
      * 84 : option 5 = affichage               SBR VISU        
      * 85 : fin atteinte                       SBR SFL         
      * 86 : début atteint                      SBR SFL & REMONT
      * 87 : option 4 = suppression             SBR SUPPR       
      * 88 : suppression impossible             SBR SUPPR       
      * 89 : ajout                              SBR INSER       
      * 90 : contrôle certaines zones affichées SBR SFL INSER SUPPR VISU
      * 91 : affichage déroulant et sélection                   
      * 92 : au moins une ligne dans le SFL     SBR SFL         
      * 93 : si *OFF curseur sur la ligne                       
      * 94 : enreg. non trouve                  SBR CHARGE
      * 95 : ROLLUP (défilement page suivante)  Format écran    
      * 96 : ROLLDOWN (défil. page précédente)  Format écran    
      * 97 : F7 = recherche                     SBR CHERCH      
      * 98 : recherche de caractère concluante  SBR RECH        
      * 99 : indicateur de service                              
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      * Ce programme gère l'affichage du sous-fichier en mode   
      * dynamique : on charge une seule page à la fois.         
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      * 
     FARTICLL1UF  E           K        DISK                      A
     FCOMANDL3IF  E           K        DISK                     
     FMAINT01£CF  E                    WORKSTN                  
      * Définit le sous-fichier                                 
      *    NUMREC = positionne le curseur                       
     F                                        NUMRECKSFILE £1SFL
      * 
     E                    ACT     1   5 30                      
     E                    WW         18  1                      
      * Pour comparaisons de caractères dans la recherche sur chaine
     I              'abcdefghijklmnopqrst-C         WLO         
     I              'uvwxyzÀÂÄÉÊËÈÎÏÔÖÙÛÜ-                      
     I              'àâäéèëêìïîòôöùûüçñ'                        
     I              'ABCDEFGHIJKLMNOPQRST-C         WUP         
     I              'UVWXYZAAAEEEEIIOOUUU-                      
     I              'AAAEEEEIIIOOOUUUCN'                        
      * 
      * Utilisation des API pour sous-fichier de messages        
      * QMHSNDPM & QMHRMVPM - Initialise les zones a transmettre 
     IDS1         DS                                             
     I I            '*'                       1 256 Z1           
     I                                      257 276 Z2           
     I            DS                                             
     I                                        1 128 WMESS        
     I                                        1   3 ££CODA       
     I                                        4   6 ££CODB       
     I            DS                                             
     I I            128                   B   1   40DTALEN       
     I I                                  B   5   80CALSTK       
     I I                                  B   9  120MSGERR       
     I I            'FICMSG    BIBLIO    '   13  32 MSGLOC       
     I I            '*DIAG     '             33  43 MSGTYP       
     I I            '*ALL      '             44  53 MSGRMV       
      * Utilisation de l'API QWCRNETA                                           
      *==== récupère nom système - retrieve sysname ==================* 
     I*Type Definition for the Format of Data Returned.                 
     I£QCBV       DS                                                    
     I*                                             Qwc Rneta Attr Table
     I                                        1  10 £QCBVB              
     I*                                             Information Status  
     I                                    B  13  160£QCBVF              
     I*Record structure for Error Code Parameter                        
     I£QSBN       DS                                                    
     I*                                             Qus EC              
     I                                    B   1   40£QSBNB              
     IRCV         DS                            256                     
     I                                    B   1   40NUMBER              
     I                                    B   5   80OFF1                
     IMISC        DS                                                    
     I I            256                   B   1   40RCVSIZ              
     I I            1                     B   5   80NBR                 
     I I            'SYSNAME'                 9  18 NETA                
      * 
     I           SDS                                            
     I                                     *PROGRAM $PGM        
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Remarque : un chargement initial du SFL est déclenché dès le
      * lancement du programme (cf SBR *INZSR à la fin)         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * F3 = fin de travail                                     
     C           *IN03     DOWEQ'0'                             
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Affichage déroulant                                     
      * Traîtements entrées du sous-fichier                     
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C                     WRITE£1ENTETE                        
     C                     MOVEA'0001'    *IN,88                
     C                     EXSR ECRCMD                          
     C                     EXFMT£1CTL                           
     C                     EXSR RMVMSG
     C                     MOVE '0'       *IN91                 
     C                     MOVE '0'       *IN93                 
      * 
     C                     SELEC                                
       * F4 - Recherche                                             
     C           *IN04     WHEQ '1'                                 
      *     CRSFLD emplacement du curseur obtenu avec RTNCSRLOC dans
      *            le format d'ecran                                
     C           CRSFLD    IFEQ '££TYPC'                            
     C                     CALL 'LIST00R'                           
     C           ££TYPC    PARM           WCODA   3                 
     C                     PARM ' '       WRET    1                 
     C           ££TYPC    IFNE EXTYPC                              
     C           WRET      ANDEQ' '                                 
     C                     EXSR ZONSEL                              
     C                     ELSE                                     
      *          Touche F4 non prevue                               
     C                     MOVE 'DGM0007' MSGID                     
     C                     EXSR ENVMSG                              
     C                     ENDIF                                    
      * F5 - Réaffichage                                        
     C           *IN05     WHEQ '1'                             
     C                     MOVE '1'       *IN93                 
     C                     EXSR REPOSI                          
      * F6 = ajout                                              
     C           *IN06     WHEQ '1'                             
     C                     EXSR CREAT                           
      * F7 = recherche ou arret de la recherche                 
     C           *IN07     WHEQ '1'                             
     C                     EXSR CHAINE                          
     C                     EXSR REPOSI                          
      * F12 -                                                   
     C           *IN12     WHEQ '1'                             
     C                     LEAVE                                
      * F17 - aller au début                                    
     C           *IN17     WHEQ '1'                             
      * F18 - aller à la fin                                    
     C           *IN18     OREQ '1'                             
      * Scrolling vers le bas                                   
     C           *IN95     OREQ '1'                             
     C                     EXSR SFL                             
      * Scrolling en remontant                                  
     C           *IN96     WHEQ '1'                             
     C                     EXSR REMONT                          
     C                     EXSR SFL                             
      * Modification clef de départ                             
     C           ££TYPC    WHNE EXTYPC                          
     C           ££Z2TX    ORNE EXZ2TX                          
     C                     EXSR ZONSEL
      * Entrée = contrôle des options choisies                  
     C                     OTHER                                
     C           NUMREC    IFNE 0                               
      *    Boucle dans le SFL                                   
     C                     DO   *HIVAL                          
     C                     READC£1SFL                    99     
      *          Fin de SFL                                     
     C           *IN99     IFEQ '1'                             
     C                     EXSR REPOSI                          
     C                     LEAVE                                
     C                     ENDIF                                
      * 
     C                     SELEC                                
      *          Choix maintenance des commentaires             
     C           £1OPT     WHEQ '1'                             
     C                     CALL 'RETG001R'                      
     C                     PARM           £1CODA                
     C                     PARM           £1CODB                
     C                     PARM           £1G3TX                
     C                     MOVE ' '       £1OPT                 
     C                     UPDAT£1SFL                           
      *          Choix modification d'un enregistrement         
     C           £1OPT     WHEQ '2'
     C                     EXSR MODIF                           
     C           *IN94     IFEQ '1' 
     C                     LEAVE    
     C                     ENDIF    
      *          Choix copie d'un enregistrement                
     C           £1OPT     WHEQ '3'                             
     C                     EXSR COPIE                           
     C           *IN94     IFEQ '1' 
     C                     LEAVE    
     C                     ENDIF    
      *          Choix suppression  d'un enregistrement         
     C           £1OPT     WHEQ '4'                             
     C                     EXSR SUPPR                           
     C           *IN88     IFEQ '1'                             
     C           *IN94     OREQ '1' 
     C           *IN12     OREQ '1'                             
     C                     LEAVE                                
     C                     ENDIF                                
      *          Choix affichage d'un enregistrement            
     C           £1OPT     WHEQ '5'                             
     C                     EXSR VISU                            
     C           *IN94     IFEQ '1' 
     C                     LEAVE    
     C                     ENDIF    
      * 
     C                     ENDSL                                
      *          F3 ou F12                                      
     C           *IN03     IFEQ '1'                             
     C           *IN12     OREQ '1'                             
     C                     MOVE ' '       £1OPT                 
     C                     UPDAT£1SFL                           
     C                     LEAVE                                
     C                     ENDIF                                
      *          Fin boucle dans le SFL                         
     C                     ENDDO                                
     C                     ENDIF                                
      * 
     C                     ENDSL                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C                     ENDDO                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           *IN03     IFEQ '1'                             
      *                    Fin de programme                     
     C                     MOVE '1'       *INLR                 
     C                     ENDIF                                
      * -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-     
      *                SOUS-ROUTINES                            
      * -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-     
      * Traîtement du SFL                                       
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           SFL       BEGSR                                
      * Remet à blanc le SFL                                    
     C                     MOVE '1'       *IN01                 
     C                     WRITE£1CTL                           
     C                     MOVEA'00'      *IN,01                
     C                     Z-ADD0         NUMREC  30            
      * Fin de fichier                                          
      *                atteinte précédemment                    
     C           *IN95     IFEQ '1'                             
     C           *IN85     ANDEQ'1'                             
      *                demandée                                 
     C           *IN18     OREQ '1'                             
      * 
     C           *IN18     IFNE '1'                             
     C                     MOVE 'DGM0001' MSGID
     C                     EXSR ENVMSG         
     C                     ENDIF                                
     C           ££TYPC    IFEQ '  '                            
     C                     MOVE *HIVAL    SVCODA                
     C                     ELSE                                 
     C                     MOVE ££TYPC    SVCODA                
     C                     ENDIF                                
     C                     MOVE *HIVAL    SVCODB                
     C                     EXSR REMONT                          
      * 
     C                     ENDIF                                
      * Début de fichier                                        
      *                  atteint précédemment                   
     C           *IN96     IFEQ '1'                             
     C           *IN86     ANDEQ'1'                             
      *                  demandé                                
     C           *IN17     OREQ '1'                             
     C           *IN17     IFNE '1'                             
     C                     MOVE 'DGM0002' MSGID
     C                     EXSR ENVMSG         
     C                     ENDIF                                
     C           ££TYPC    IFEQ '  '                            
     C                     MOVE *LOVAL    SVCODA                
     C                     ELSE                                 
     C                     MOVE ££TYPC    SVCODA                
     C                     ENDIF                                
     C                     MOVE *LOVAL    SVCODB                
     C                     EXSR REMONT                          
     C                     ENDIF                                
      * 
      * Boucle de lecture pour chargement du SFL                
      * 
     C           *IN02     DOWEQ'0'                             
     C                     READ ARTICLL1            N    85     
     C           *IN85     IFEQ '0'                             
     C           ££TYPC    ANDNE'   '                           
     C           ££TYPC    ANDNEHTCODA                          
     C                     MOVE '1'       *IN85                 
     C                     ENDIF                                
      *          Fin de lecture fichier                         
     C           *IN85     IFEQ '1'                             
      *          SFL vide mais le fichier ne l'est pas          
     C           *IN95     IFEQ '1'                             
     C           NUMREC    ANDEQ0                               
     C                     MOVE 'DGM0001' MSGID
     C                     EXSR ENVMSG         
     C           KSAUVE    SETLLARTICLL1                        
     C                     READPARTICLL1            N    86     
     C           *IN86     IFEQ '1'                             
     C           *LOVAL    SETLLARTICLL1                        
     C                     ENDIF                                
     C                     MOVE '0'       *IN95                 
     C                     ELSE                                 
     C                     MOVE '1'       *IN02                 
     C                     ENDIF                                
      * 
     C                     ELSE                                 
      * 
     C           ££TYPC    IFEQ '   '                           
     C           ££TYPC    OREQ HTCODA                          
     C           ££Z2TX    IFEQ '   '                           
     C           ££Z2TX    OREQ HTZ2TX                          
      *          Comparaison chaîne de caractères éventuelle
     C           *IN97     IFEQ '1'                             
     C                     EXSR RECH                            
     C                     ENDIF                                
     C           *IN97     IFEQ '0'                             
     C           *IN98     OREQ '1'                             
      * 
     C                     MOVE '1'       *IN92                 
      * Charge les zones écran                                  
     C                     MOVE ' '       £1OPT                 
     C                     MOVE HTL8ST    £1L8ST                
     C                     MOVE HTMZST    £1MZST                
     C                     MOVE HTL7ST    £1L7ST                
     C                     MOVE HTM0ST    £1M0ST                
     C                     MOVE HTZ2TX    £1Z2TX                
     C                     MOVE HTCODA    £1CODA                
     C                     MOVE HTCODB    £1CODB                
     C                     Z-ADDHTB7NB    £1B7NB                
     C                     MOVE HTG3TX    £1G3TX                
      * 
     C                     ADD  1         NUMREC                
     C           NUMREC    IFEQ 1                               
     C                     MOVE HTCODA    SVCODA                
     C                     MOVE HTCODB    SVCODB                
     C                     ENDIF                                
      * 
     C                     WRITE£1SFL                    02     
      * 
     C                     ENDIF                                
     C                     ENDIF                                
     C                     ENDIF                                
      * 
     C                     ENDIF                                
      * 
     C                     ENDDO                                
      * Cas où il n'y a aucun enreg dans le SFL                 
     C           NUMREC    IFEQ 0                               
     C                     MOVE '0'       *IN92                 
     C                     ENDIF                                
      * Le curseur sera sur la première ligne                   
     C                     Z-ADD1         NUMREC                
      * 
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Cherche la première ligne à sortir si ROLL-DOWN         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           REMONT    BEGSR                                
     C           KSAUVE    SETLLARTICLL1                        
     C           WSFLIG    IFGE 0                               
     C           WSFLIG    ADD  1         WWNBRE  60            
     C                     Z-ADD0         WCPT    60            
     C           WCPT      DOWLTWWNBRE                          
      * 
     C                     READPARTICLL1            N    86     
     C           *IN86     IFEQ '0'                             
      *          Comparaison chaîne de caractères éventuelle
     C           *IN97     IFEQ '1'                             
     C                     EXSR RECH                            
     C                     ENDIF                                
     C           *IN97     IFEQ '0'                             
     C           ££TYPC    ANDNE'   '                           
     C           ££TYPC    ANDNEHTCODA                          
     C           *IN98     OREQ '1'                             
     C                     MOVE '1'       *IN86                 
     C                     ENDIF                                
     C                     ENDIF                                
      * Déjà au début : arrêt                                   
     C           *IN86     IFEQ '1'                             
     C           ££TYPC    IFNE '   '                           
     C                     MOVE ££TYPC    SVCODA                
     C                     ELSE                                 
     C                     MOVE *LOVAL    SVCODA                
     C                     ENDIF                                
     C                     MOVE *LOVAL    SVCODB                
     C           KSAUVE    SETLLARTICLL1                        
     C                     LEAVE                                
     C                     ELSE                                 
      * Sinon : continue de remonter                            
     C           *IN97     IFEQ '0'                             
     C           *IN98     OREQ '1'                             
     C           ££TYPC    IFEQ '   '                           
     C           ££TYPC    OREQ HTCODA                          
     C           ££Z2TX    IFEQ '   '                           
     C           ££Z2TX    OREQ HTZ2TX                          
     C                     ADD  1         WCPT                  
     C                     ENDIF                                
     C                     ENDIF                                
     C                     ENDIF                                
      * 
     C                     ENDIF                                
      * 
     C                     ENDDO                                
      * 
     C                     ENDIF                                
      * 
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Remplit les zones pour affichage d'un enregistrement    
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           CHARGE    BEGSR                                
     C                     CLEAR£2ENR                           
      * Relecture (on ne sait jamais...)                        
      *          Copie ou visu : pas besoin de verrouiller
     C           *IN83     IFEQ '1'                       
     C           *IN84     OREQ '1'                       
     C           KANREC    CHAINYANRECL1            N94
     C                     ELSE
     C           KANREC    CHAINYANRECL1             94
     C                     ENDIF
     C           *IN94     IFEQ '0'
     C                     MOVE HTL8ST    £2L8ST                
     C                     MOVE HTMZST    £2MZST                
     C                     MOVE HTL7ST    £2L7ST                
     C                     MOVE HTM0ST    £2M0ST                
     C                     MOVE HTZ2TX    £2Z2TX                
     C                     MOVE HTCODA    £2CODA                
     C                     MOVE HTCODB    £2CODB                
     C                     Z-ADDHTB7NB    £2B7NB                
     C                     MOVE HTG3TX    £2G3TX                
      *                                         
     C                     ELSE                 
     C                     MOVE 'DGM0006' MSGID 
     C                     EXSR ENVMSG          
     C                     ENDIF                                
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Mouvemente avant mise à jour du fichier                 
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           MOUVE     BEGSR                                
     C                     MOVE £2CODA    HTCODA
     C                     MOVE £2CODB    HTCODB
     C                     MOVE £2L8ST    HTL8ST
     C                     MOVE £2MZST    HTMZST
     C                     MOVE £2L7ST    HTL7ST
     C                     MOVE £2M0ST    HTM0ST
     C                     MOVE £2Z2TX    HTZ2TX
     C                     Z-ADD£2B7NB    HTB7NB
     C                     MOVE £2G3TX    HTG3TX
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Modification d'un enregistrement                         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           MODIF     BEGSR                                
     C                     MOVEA'0001'    *IN,87                
     C                     MOVE £1CODA    ££CODA                
     C                     MOVE £1CODB    ££CODB                
     C                     EXSR CHARGE                          
     C           *IN94     IFEQ '0'
     C                     MOVE ACT,1     £ACTIO                
     C           TAGMOD    TAG                                  
     C                     EXSR ECRSAI                          
     C           *IN12     IFNE '1'                             
     C           *IN03     ANDNE'1'                             
      * Contrôles de validité                                   
     C                     EXSR CONTRO                          
     C           *IN81     CABEQ'1'       TAGMOD                
      * Mise à jour     
      *          Modif seulement si changement reel
     C           £2L8ST    IFNE HTL8ST
     C           £2MZST    ORNE HTMZST
     C           £2L7ST    ORNE HTL7ST
     C           £2M0ST    ORNE HTM0ST
     C           £2Z2TX    ORNE HTZ2TX
     C           £2B7NB    ORNE HTB7NB
     C           £2G3TX    ORNE HTG3TX
     C                     EXSR MOUVE                           
     C                     UPDATARTFMT                 99
     C                     ELSE
      *          Pas de modification
     C                     UNLCKARTICLL1               99
     C                     ENDIF
      *
     C                     MOVE ' '       £1OPT                 
     C                     UPDAT£1SFL                           
      *
     C                     ENDIF                                
      *                          
     C                     ENDIF 
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Ajout d'un enregistrement                               
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           CREAT     BEGSR                                
      * Mise à blanc des zones écran                            
     C                     CLEAR£2ENR                           
      * 
     C                     MOVE ACT,3     £ACTIO                
      * 
     C                     EXSR INSER                           
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Copie   
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           COPIE     BEGSR                                
     C                     MOVE '1'       *IN83
     C                     MOVE £1CODA    ££CODA
     C                     MOVE £1CODB    ££CODB
     C                     EXSR CHARGE                          
     C           *IN94     IFEQ '0'
     C                     MOVE ACT,4     £ACTIO                
     C                     EXSR INSER                           
      *                          
     C                     ENDIF 
     C                     MOVE '0'       *IN83
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Création enregistrement saisi ou copié                  
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           INSER     BEGSR                                
     C                     MOVEA'0011'    *IN,87                
     C           TAGCRE    TAG                                  
     C                     EXSR ECRSAI                          
     C           *IN12     IFNE '1'                             
     C           *IN03     ANDNE'1'                             
      * Contrôle d'inexistence                                  
     C                     MOVE £2CODA    ££CODA
     C                     MOVE £2CODB    ££CODB
     C           KANREC    CHAINARTICLL1            N99         
      *          Existe déjà                                    
     C           *IN99     IFEQ '0'                             
     C                     MOVE 'DGM0003' MSGID
     C                     EXSR ENVMSG         
     C                     GOTO TAGCRE                          
     C                     ENDIF                                
      * Contrôles de validité                                   
     C                     EXSR CONTRO                          
     C           *IN81     CABEQ'1'       TAGCRE                
      * Mise à jour     
     C           KANREC    CHAINARTICLL1             99         
     C           *IN99     IFEQ '1'                             
     C                     MOVE £2CODA    £1CODA
     C                     MOVE £2CODB    £1CODB
     C                     EXSR MOUVE                           
     C                     WRITEARTFMT                         
     C                     ELSE                                 
     C                     MOVE 'DGM0003' MSGID
     C                     EXSR ENVMSG         
     C                     GOTO TAGCRE                          
     C                     ENDIF                                
      * 
     C                     ENDIF                                
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Suppression d'un enregistrement                         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           SUPPR     BEGSR                                
     C                     MOVEA'1001'    *IN,87                
      * Contrôle pas déjà utilisé                               
     C                     MOVE £1CODA    ££CODA
     C                     MOVE £1CODB    ££CODB
     C           KANREC    SETLLCOMANDL3                 88     
      *          Déjà utilisé : suppression impossible          
     C           *IN88     IFEQ '1'                             
     C                     MOVE ' '       £1OPT                 
     C                     MOVE 'DGM0004' MSGID
     C                     EXSR ENVMSG         
     C                     UPDAT£1SFL                           
      *          OK     
     C                     ELSE                                 
     C                     MOVE ' '       £2CONF                
      *          Demande de confirmation                        
     C                     EXSR CHARGE                          
     C           *IN94     IFEQ '0'
     C                     MOVE ACT,2     £ACTIO                
     C           CONF      TAG                                  
     C                     EXSR ECRSAI                          
      * 
     C                     SELEC                                
      * 
     C           £2CONF    WHEQ 'O'                             
     C           KANREC    CHAINARTICLL1             99         
     C           *IN99     IFEQ '0'                             
     C                     DELETARTFMT                         
     C                     ENDIF                                
      * 
     C           £2CONF    WHNE 'N'                             
     C           *IN03     ANDNE'1'                             
     C           *IN12     ANDNE'1'                             
     C                     GOTO CONF                            
      * 
     C                     ENDSL                                
      * 
     C                     MOVE ' '       £1OPT                 
     C                     UPDAT£1SFL                           
      *
     C                     ENDIF
      * 
     C                     ENDIF                                
      * 
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Affichage       
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           VISU      BEGSR                                
     C                     MOVE '1'       *IN84                 
     C                     MOVEA'0001'    *IN,87                
     C                     MOVE £1CODA    ££CODA                
     C                     MOVE £1CODB    ££CODB                
     C                     EXSR CHARGE                          
     C           *IN94     IFEQ '0'
     C                     MOVE ACT,5     £ACTIO                
     C                     EXSR ECRSAI
      *
     C           *IN12     IFNE '1'                             
     C                     MOVE ' '       £1OPT                 
     C                     UPDAT£1SFL                           
     C                     ENDIF                                
      *
     C                     ENDIF
      *
     C                     MOVE '0'       *IN84                 
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Contrôles de validité                                   
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           CONTRO    BEGSR                                
     C                     MOVE '1'       *IN81                 
     C                     SELEC                                
     C           £2G3TX    WHEQ *BLANK                          
     C                     MOVE '1'       *IN70                 
     C           £2L7ST    WHNE 'O'                             
     C           £2L7ST    ANDNE'N'                             
     C                     MOVE '1'       *IN72                 
     C           £2L8ST    WHNE 'O'                             
     C           £2L8ST    ANDNE'N'                             
     C                     MOVE '1'       *IN71                 
     C           £2MZST    WHNE 'O'                             
     C           £2MZST    ANDNE'N'                             
     C                     MOVE '1'       *IN73                 
     C           £2M0ST    WHNE 'O'                             
     C           £2M0ST    ANDNE'B'                             
     C           £2M0ST    ANDNE'F'                             
     C                     MOVE '1'       *IN74                 
     C                     OTHER                                
     C                     MOVE '0'       *IN81                 
     C                     ENDSL                                
      * 
     C           *IN81     IFEQ '1'                             
     C                     MOVE 'DGM0005' MSGID
     C                     EXSR ENVMSG         
     C                     ENDIF                                
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Repositionne pour raffraîchissement affichage           
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           REPOSI    BEGSR                                
     C           KSAUVE    SETLLARTICLL1                        
     C                     EXSR SFL                             
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Affiche format de saisie                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           ECRSAI    BEGSR                                
     C                     EXSR ECRCMD                          
     C                     EXFMT£2ENR                           
     C                     EXSR RMVMSG
     C                     MOVEA'00000000'*IN,70                
     C                     MOVEA'0'       *IN,81                
      * on abandonne la maj : deverrouiller illico l'enregistrement
     C           *IN12     IFEQ '1'                                
     C           *IN03     OREQ '1'                                
     C                     UNLCKYANRECL1               99          
     C                     ENDIF                                   
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Affiche bas d'écran                                     
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           ECRCMD    BEGSR                                
     C                     WRITE£1CMD
     C                     WRITE£0MSGCTL
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -
      * Traîtement changement zones de sélection
      * - - - - - - - - - - - - - - - - - - - - - - - - - -
     C           ZONSEL    BEGSR
     C                     MOVEA'00'      *IN,85
     C           ££TYPC    SETLLYANRECL1
     C                     MOVE ££TYPC    EXTYPC
     C                     MOVE ££Z2TX    EXZ2TX
     C                     EXSR SFL
     C                     ENDSR
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Fenetre entree Chaine de caractères                     
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           CHAINE    BEGSR                                
      * Bascule 97 ON <-> OFF                                   
     C           *IN97     IFEQ '0'                             
     C                     MOVE '1'       *IN99                 
     C                     ELSE                                 
     C                     MOVE '0'       *IN99                 
     C                     ENDIF                                
     C           *IN99     IFEQ '0'                             
     C                     MOVEA'00'      *IN,97
     C                     MOVE SVSVKJ    SVCODA
     C                     MOVE SVSVKI    SVCODB
     C                     ELSE                                 
     C                     MOVE '1'       *IN97
     C                     MOVE SVCODA    SVSVKJ  3
     C                     MOVE SVCODB    SVSVKI  3
     C           ££TYPC    IFEQ '  '               
     C                     MOVE *LOVAL    SVCODA   
     C                     ELSE                    
     C                     MOVE ££TYPC    SVCODA   
     C                     ENDIF                   
     C                     MOVE *LOVAL    SVCODB   
     C                     ENDIF                   
      * - - - - - - - - - - - - - - - - - - - - - 
     C           *IN97     IFEQ '1'                             
     C                     EXFMT£3RECH                          
     C           *IN12     IFEQ '1'                             
     C           £3ZONE    OREQ *BLANK                          
     C                     MOVEA'00'      *IN,97 
     C                     MOVE SVSVKJ    SVCODA 
     C                     MOVE SVSVKI    SVCODB 
     C                     ELSE                                 
     C           WLO:WUP   XLATE£3ZONE    £3ZONE                
      * Compte nombre de car. a scanner                         
     C                     MOVEA£3ZONE    WW                    
     C                     Z-ADD16        WC      60            
     C           WC        DOWGT0                               
     C           WW,WC     IFNE *BLANK                          
     C                     LEAVE                                
     C                     ENDIF                                
     C                     SUB  1         WC                    
     C                     ENDDO                                
      * Chaine à afficher entre guillemets
     C                     MOVEA'"'       WW,1                  
     C                     MOVEA' '       WW,18
     C                     MOVEA£3ZONE    WW,2                  
     C           WC        ADD  2         WN      60            
     C                     MOVEA'"'       WW,WN                 
     C                     MOVEAWW        £CHRCH                
      * 
     C                     ENDIF                                
     C                     ENDIF                                
     C           FINREC    ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Recherche chaine de caractères                          
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           RECH      BEGSR                                
     C                     MOVE '0'       *IN98                 
      * Normalisation : les caracteres sont convertis en majuscules     
      * sans accentuation (et suppression de la cédille)        
     C           WLO:WUP   XLATEHTG3TX    W3TX   40             
     C           WC        IFGT 0                               
     C           £3ZONE:WC SCAN W3TX      WRES    60            
     C           WRES      IFGT 0                               
     C                     MOVE '1'       *IN98                 
     C                     ENDIF                                
     C                     ENDIF                                
     C                     ENDSR                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -
      * Sortie SFL de message                              
      * - - - - - - - - - - - - - - - - - - - - - - - - - -
     C           ENVMSG    BEGSR                           
     C                     CALL 'QMHSNDPM'                 
     C                     PARM           MSGID   7        
     C                     PARM           MSGLOC           
     C                     PARM           WMESS            
     C                     PARM           DTALEN           
     C                     PARM           MSGTYP           
     C                     PARM           DS1              
     C                     PARM           CALSTK           
     C                     PARM           MSGKEY  4        
     C                     PARM           MSGERR           
     C                     ENDSR                           
      * - - - - - - - - - - - - - - - - - - - - - - - - - -
      * Retire le message de l'affichage                   
      * - - - - - - - - - - - - - - - - - - - - - - - - - -
     C           RMVMSG    BEGSR                           
     C                     CALL 'QMHRMVPM'                 
     C                     PARM           DS1              
     C                     PARM           CALSTK           
     C                     PARM '    '    MSGKEY  4        
     C                     PARM           MSGRMV           
     C                     PARM           MSGERR           
     C                     ENDSR                           
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
      * Diverses initialisations et définitions                 
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C           *INZSR    BEGSR                                
      *==== récupère nom système - retrieve sysname ==================*         
     C                     Z-ADD0         QUSBNB                                
     C                     CALL 'QWCRNETA'                                      
     C                     PARM           RCV                                   
     C                     PARM           RCVSIZ                                
     C                     PARM           NBR                                   
     C                     PARM           NETA                                  
     C                     PARM           QUSBN                                 
     C           NUMBER    IFEQ 1                                               
     C           OFF1      ADD  1         OFF     30                            
     C           16        SUBSTRCV:OFF   £QCBV                                 
     C                     ADD  16        OFF                                   
     C           £QCBVB    IFEQ 'SYSNAME'                                       
     C                     MOVE *BLANKS   NOMSYS                                
     C           £QCBVF    SUBSTRCV:OFF   NOMSYS                                
     C                     ENDIF                                                
     C                     ENDIF                                                
      * 
     C           KANREC    KLIST                                
     C                     KFLD           ££CODA  
     C                     KFLD           ££CODB  
      * 
     C           KSAUVE    KLIST                                
     C                     KFLD           SVCODA  3
     C                     KFLD           SVCODB  3
      * Compte la capacité du SFL                               
     C                     MOVE '1'       *IN01                 
     C                     WRITE£1CTL                      
     C           *IN02     DOWEQ'0'                             
     C                     ADD  1         NUMREC                
     C                     WRITE£1SFL                    02     
     C                     ENDDO                                
     C                     Z-ADDNUMREC    WSFLIG  60            
     C                     MOVE '0'       *IN01                 
      * 
     C                     MOVEL$PGM      ££PGM                 
     C                     MOVE '   '     EXTYPC  3             
     C                     MOVE '   '     EXZ2TX  3             
     C                     MOVE '0'       *IN93                 
      * Se positionne   
     C           KANREC    SETLLARTICLL1                        
      * 
     C                     EXSR SFL                             
      * 
     C                     ENDSR                                
** ACT  
MODIFICATION    
SUPPRESSION     
CREATION
COPIE   
VISUALISATION   

Programme MAINT02R

Description

Ce programme est appelé par le précédent. Il n’est d’ailleurs pas aussi achevé, mais comporte des particularités intéressantes :

Ecran
 MAINT02R                    Commentaires des anomalies                 15/07/08
 GUEBEY                                                                 13:07:34
 Anomalie : CAM 001 Absence de bon de livraison  . . . . . .                    
Indiquez vos options, puis appuyez sur Entrée                                   
2=Modifier   3=Copier   4=Supprimer   5=Afficher
 O Typ Ano Sq Commentaire 1                  Commentaire 2
 _ CAM 001 00 B.L. manifestement faux                                           
 _ CAM 001 01 B.L. arraché                                                      
 _ CAM 001 03 test                           test                               









                                                                                
                                                                                
                                                                                
 F3=Sortie              F6=Créer  Défil/haut  Défil/bas                         
 F5=réaffichage   F17=Début   F18=Fin
 Début atteint

               
Source du format d’écran (MAINT02£)
     A                                      DSPSIZ(24 80 *DS3)                  
     A                                      INDARA                              
     A                                      PRINT                               
     A                                      CA03(03 'Fin de travail')           
     A  91                                  CA05(05 'Réaffichage')              
     A  91                                  CA06(06 'Ajout')                    
     A  91                                  CA17(17 'Début')                    
     A  91                                  CA18(18 'Fin')                      
     A  90                                                                      
     AO 91                                  CA12(12 'Annulation')               
     A  91                                  CA21(21 'Tout voir')                
      * ------------------------------------------------------------- *         
     A          R £1ENTETE                                                      
     A                                      OVERLAY                             
     A            ££PGM         10A  O  1  2COLOR(BLU)                          
     A                                  1 29' Commentaires des anomalies '      
     A                                      DSPATR(RI)                          
     A                                  1 73DATE                                
     A                                      EDTCDE(Y)                           
     A                                      COLOR(BLU)                          
     A                                  2  2USER                                
     A                                      COLOR(BLU)                          
     A                                  2 73TIME                                
     A                                      COLOR(BLU)                          
      * ------------------------------------------------------------- *         
     A          R £1SFL                     SFL                                 
     A            £1OPT          1A  B  7  2DSPATR(UL)                          
     A                                      VALUES(' ' '2' '3' '4' '5')         
     A            £1CODA         3A  O  7  4TEXT('Type de contrôle')  
     A            £1CODB         3A  O  7  8TEXT('Code anomalie')     
     A            £1B7NB         2Y 0O  7 12TEXT('Numéro de séquence')
     A            £1EATX        30A  O  7 15TEXT('Commentaire 1         ')      
     A            £1B9NA        30A  O  7 46TEXT('Commentaire 2         ')      
      * ------------------------------------------------------------- *         
     A          R £1CTL                     SFLCTL(£1SFL)                       
     A                                      SFLSIZ(0012)                        
     A                                      SFLPAG(0012)                        
     A                                      ROLLUP(95)                          
     A                                      ROLLDOWN(96)                        
     A                                      OVERLAY                             
     A  92                                  SFLDSP                              
     A N01                                  SFLDSPCTL                           
     A  01                                  SFLCLR                              
     A            NUMREC         3S 0H      SFLRCDNBR(CURSOR)                   
     A                                  3  2'Anomalie :'                        
     A            £ECODA         3A  O  3 13                                    
     A            £ECODB         3A  O  3 17                                    
     A            £EG3TX        40A  O  3 21                                    
     A                                  4  1'Indiquez vos options, puis appuyez-
     A                                       sur Entrée'                        
     A                                      COLOR(BLU)                          
     A                                  5  1'2=Modifier'                        
     A                                      COLOR(BLU)                          
     A                                  5 14'3=Copier'                          
     A                                      COLOR(BLU)                          
     A                                  5 25'4=Supprimer'                       
     A                                      COLOR(BLU)                          
     A                                  5 39'5=Afficher'                        
     A                                      COLOR(BLU)                          
     A                                  6  2'O Typ Ano Sq'                      
     A                                      DSPATR(HI)                          
     A                                  6 15''                     
     A                                      DSPATR(HI)                          
     A                                  6 46'Commentaire 2'                     
     A                                      DSPATR(HI)                          
      * ------------------------------------------------------------- *         
     A          R £1CMD                                                         
     A                                      OVERLAY                             
     A                                 22  2'F3=Sortie'                         
     A                                      COLOR(BLU)                          
     A  90                             22 13'F12=Retour'                        
     A                                      COLOR(BLU)                          
     A  91                             22 25'F6=Créer'                          
     A                                      COLOR(BLU)                          
     A  91                             22 35'Défil/haut  Défil/bas'             
     A                                      COLOR(BLU)                          
     A  91                             23  2'F5=réaffichage'                    
     A                                      COLOR(BLU)                          
     A  91                             23 19'F17=Début'                         
     A                                      COLOR(BLU)                          
     A  91                             23 31'F18=Fin'                           
     A                                      COLOR(BLU)                          
     A            £1MSG         72   O 24  2COLOR(RED)                          
     A                                      DSPATR(HI)                          
     A                                      DSPATR(BL)                          
      * ------------------------------------------------------------- *         
     A          R £2ENR                                                         
     A                                      OVERLAY                             
     A                                  3  2'Anomalie :'                        
     A            £2G3TX        40A  O  3 21                                    
     A                                  4  1'Entrez vos données, puis appuyez-  
     A                                       sur Entrée.'                       
     A                                      COLOR(BLU)                          
     A            £ACTIO        30   O  5  2DSPATR(HI)                          
     A                                  6  2'Type de contrôle :' 
     A            £2CODA         3A  O  6 21DSPATR(RI)                          
     A                                  6 27'Code anomalie :' 
     A            £2CODB         3A  O  6 43DSPATR(RI)                          
     A                                  6 49'Numéro d''ordre :'
     A N89        £1B7NB         2S 0O  6 66DSPATR(RI)                          
     A  89        £2B7NB         2S 0B  6 68DSPATR(RI)                          
     A  89                                  DSPATR(PC)                          
     A                                  7  4'Commentaires :'                    
      * CHECK(LC) : admet les minuscules en entree                              
     A            £1EATX        30A  B  7 19CHECK(LC)                           
     A N84N87N89                            DSPATR(PC)                          
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A            £1B9NA        30A  B  7 50CHECK(LC)                           
     A  84                                                                      
     AO 87                                  DSPATR(PR)                          
     A  87N88                           8 13'Confirmer la suppression :'        
     A                                      COLOR(WHT)                          
     A  87N88     £1CONF         1A  B  8 40DSPATR(PC)                          
     A  87N88                           8 42'(O/N)'                             
     A                                      COLOR(WHT)                          
Source du programme RPG III (MAINT02R)
      *===============================================================*         
      * MAINTENANCE DES COMMENTAIRES                                  *         
      *===============================================================*         
      * INDICATEURS :                                                           
      * 01 : effacement du sous-fichier                                         
      * 02 : sous-fichier plein                                                 
      * 03 : F3  - fin de travail                                               
      * 05 : F5  - réaffichage SFL                                              
      * 06 : ajout d'enregistrement                                             
      * 12 : F12 - rend la main                                                 
      * 17 : F17 - affichage du début                                           
      * 18 : F18 - affichage de la fin                                          
      * 21 : F21 - tout voir ou pas
      * 31 : alternativement ON/OFF avec F21
      * 82 : F12 utilisé précédemment                                           
      * 84 : option 5 = affichage                                               
      * 85 : fin atteinte                                                       
      * 86 : début atteint                                                      
      * 87 : option 4 = suppression                                             
      * 89 : F6 = création                                                      
      * 90 : affichage SFL protégé                                              
      * 91 : affichage déroulant et sélection                                   
      * 92 : au moins une ligne sortie dans le SFL                              
      * 93 : si *OFF affiche SFL avec curseur même ligne                        
      * 95 : ROLLUP (défilement page suivante)                                  
      * 96 : ROLLDOWN (défilement page précédente)                              
      * 98 : indicateur de service                                              
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -           
      * Ce programme gère l'affichage du sous-fichier en mode                   
      * dynamique : on charge une seule page à la fois, la capacité             
      *             du sous-fichier est égale au nombre d'enreg                 
      *             affichés.                                                   
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -           
      *                                                                         
     FTTEXTSL1UF  E           K        DISK                      A              
     FMAINT02£CF  E                    WORKSTN                                  
      * Définit le sous-fichier                                                 
      *    NUMREC = positionne le curseur                                       
     F                                        NUMRECKSFILE £1SFL                
      *                                                                         
     E                    ACT     1   5 30                                      
     E                    MSG     1   6 72                                      
      *                                                                         
     I           SDS                                                            
     I                                     *PROGRAM $PGM                        
      * F3 = fin de travail                                                     
     C           *IN03     DOWEQ'0'                                             
     C                     WRITE£1ENTETE                                        
     C                     MOVEA'0001'    *IN,88                                
     C                     EXSR ECRCMD                                          
     C                     EXFMT£1CTL                                           
     C                     MOVE '0'       *IN91                                 
     C                     MOVE '0'       *IN93                                 
      *                                                                         
     C                     SELEC                                                
      * F5 - Réaffichage                                                        
     C           *IN05     WHEQ '1'                                             
     C                     MOVE '1'       *IN93                                 
     C                     EXSR REPOSI                                          
      * F6 = ajout                                                              
     C           *IN06     WHEQ '1'                                             
     C                     EXSR CREAT                                           
     C           *IN12     IFNE '1'                                             
     C                     EXSR REPOSI                                          
     C                     ENDIF                                                
      * F12 -                                                                   
     C           *IN12     WHEQ '1'                                             
     C                     LEAVE                                                
      * F17 - aller au début                                                    
     C           *IN17     WHEQ '1'                                             
      * F18 - aller à la fin                                                    
     C           *IN18     OREQ '1'                                             
     C                     EXSR SFL                                             
      * F21 - tout voir
     C           *IN21     WHEQ '1'                                             
     C           *IN31     IFEQ '0'
     C                     MOVE '1'       *IN98                                 
     C                     ELSE
     C                     MOVE '0'       *IN98                                 
     C                     ENDIF                                                
     C           *IN98     IFEQ '0'                                             
     C                     MOVE '0'       *IN31                                 
     C                     ELSE                                                 
     C                     MOVE '1'       *IN31                                 
     C                     ENDIF                                                
     C                     EXSR REPOSI
      * Scrolling vers le bas                                                   
     C           *IN95     WHEQ '1'                                             
     C                     EXSR SFL                                             
      * Scrolling en remontant                                                  
     C           *IN96     WHEQ '1'                                             
     C                     EXSR REMONT                                          
     C                     EXSR SFL                                             
      * Entrée = contrôle des options choisies                                  
     C                     OTHER                                                
     C           NUMREC    IFNE 0                                               
      *    Boucle dans le SFL                                                   
     C                     DO   *HIVAL                                          
     C                     READC£1SFL                    98                     
      *          Fin de SFL                                                     
     C           *IN98     IFEQ '1'                                             
     C                     EXSR REPOSI
     C                     LEAVE                                                
     C                     ENDIF                                                
      *
     C                     SELEC                                                
      *          Choix modification d'un enregistrement                         
     C           £1OPT     WHEQ '2'                                             
     C                     MOVE ACT,1     £ACTIO                                
     C                     EXSR MODIF                                           
      *          Choix copie d'un enregistrement                                
     C           £1OPT     WHEQ '3'                                             
     C                     MOVE ACT,4     £ACTIO                                
     C                     EXSR COPIE                                           
      *          Choix suppression  d'un enregistrement                         
     C           £1OPT     WHEQ '4'                                             
     C                     MOVE ACT,2     £ACTIO                                
     C                     EXSR SUPPR
     C           *IN88     IFEQ '1'
     C           *IN12     OREQ '1'
     C                     LEAVE   
     C                     ENDIF   
      *          Choix affichage d'un enregistrement                            
     C           £1OPT     WHEQ '5'                                             
     C                     MOVE ACT,5     £ACTIO                                
     C                     EXSR VISU                                            
      *                                                                         
     C                     ENDSL                                                
      *          F3 OU F12
     C           *IN03     IFEQ '1'                                             
     C           *IN12     OREQ '1'                                             
     C                     MOVE ' '       £1OPT                                 
     C                     UPDAT£1SFL                                           
     C                     LEAVE                                                
     C                     ENDIF                                                
      *          Fin boucle dans le SFL                                         
     C                     ENDDO                                                
     C*
     C                     ENDIF                                                
      *                                                                         
     C                     ENDSL                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C                     ENDDO                                                
     C           *IN03     IFEQ '1'                                             
     C           *IN12     OREQ '1'                                             
      *                    Fin de programme                                     
     C                     MOVE '1'       *INLR                                 
     C                     ENDIF                                                
      * -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-                     
      *                SOUS-ROUTINES                                            
      * -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-                     
      * Traîtement du SFL                                                       
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           SFL       BEGSR                                                
      * Remet à blanc le SFL                                                    
     C                     MOVE '1'       *IN01                                 
     C                     WRITE£1CTL                                           
     C                     MOVEA'00'      *IN,01                                
     C                     Z-ADD0         NUMREC  30                            
      * Fin de fichier                                                          
      *                atteinte précédemment                                    
     C           *IN95     IFEQ '1'                                             
     C           *IN85     ANDEQ'1'                                             
      *                demandée                                                 
     C           *IN18     OREQ '1'                                             
      *                                                                         
     C           *IN18     IFNE '1'                                             
     C                     MOVE MSG,1     £1MSG                                 
     C                     ENDIF                                                
     C           *IN31     IFEQ '0'
     C                     MOVE £ECODA    SVCODA                                
     C                     MOVE £ECODB    SVCODB                                
     C                     ELSE
     C                     MOVE *HIVAL    SVCODA                                
     C                     MOVE *HIVAL    SVCODB                                
     C                     ENDIF                                                
     C                     MOVE *HIVAL    SVB7NB  20                            
     C                     EXSR REMONT                                          
      *                                                                         
     C                     ENDIF                                                
      * Début de fichier                                                        
      *                  atteint précédemment                                   
     C           *IN96     IFEQ '1'                                             
     C           *IN86     ANDEQ'1'                                             
      *                demandé                                                  
     C           *IN17     OREQ '1'                                             
     C           *IN17     IFNE '1'                                             
     C                     MOVE MSG,2     £1MSG                                 
     C                     ENDIF                                                
     C                     MOVE *LOVAL    SVCODA                                
     C                     MOVE *LOVAL    SVCODB                                
     C                     MOVE *LOVAL    SVB7NB                                
     C                     EXSR REMONT                                          
     C                     ENDIF                                                
      *                                                                         
      * Boucle de lecture pour chargement du SFL                                
      *                                                                         
     C           *IN02     DOWEQ'0'                                             
     C           *IN31     IFEQ '0'                                             
     C           KMAN      READETTEXTSL1            N    85                     
     C                     ELSE
     C                     READ TTEXTSL1            N    85                     
     C                     ENDIF                                                
      *          Fin de fichier / ou clef dépassée                              
     C           *IN85     IFEQ '1'                                             
      *          SFL vide mais le fichier ne l'est pas                          
     C           *IN95     IFEQ '1'                                             
     C           NUMREC    ANDEQ0                                               
     C                     MOVE MSG,1     £1MSG                                 
     C           KSAUVE    SETLLTTEXTSL1                                        
     C                     READPTTEXTSL1            N    86                     
     C           *IN86     IFEQ '1'                                             
     C           *LOVAL    SETLLTTEXTSL1                                        
     C                     ENDIF                                                
     C                     MOVE '0'       *IN95                                 
     C                     ELSE                                                 
     C                     MOVE '1'       *IN02                                 
     C                     ENDIF                                                
      *                                                                         
     C                     ELSE                                                 
     C                     MOVE '1'       *IN92                                 
      * Charge les zones écran                                                  
     C                     MOVE ' '       £1OPT                                 
     C                     MOVE O7CODA    £1CODA                
     C                     MOVE O7CODB    £1CODB                   
     C                     Z-ADDO7B7NB    £1B7NB              
     C                     MOVE O7EATX    £1EATX                   
     C                     MOVE O7B9NA    £1B9NA                   
      *                                                                         
     C                     ADD  1         NUMREC                                
     C           NUMREC    IFEQ 1                                               
     C                     MOVE O7CODA    SVCODA                                
     C                     MOVE O7CODB    SVCODB                                
     C                     Z-ADDO7B7NB    SVB7NB                                
     C                     ENDIF                                                
     C                     WRITE£1SFL                    02                     
     C                     ENDIF                                                
      *                                                                         
     C                     ENDDO                                                
      * Cas où il n'y a aucun enreg dans le SFL                                 
     C           NUMREC    IFEQ 0                                               
     C                     MOVE '0'       *IN92                                 
     C                     ENDIF                                                
      * Le curseur sera sur la première ligne                                   
     C                     Z-ADD1         NUMREC                                
      *                                                                         
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Cherche la première ligne à sortir si ROLL-DOWN                         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           REMONT    BEGSR                                                
     C           KSAUVE    SETLLTTEXTSL1                                        
     C           WSFLIG    IFGE 0                                               
     C           WSFLIG    ADD  1         WWNBRE  60
     C                     DO   WWNBRE                                          
     C                     READPTTEXTSL1            N    86                     
      * Autre clef : arrêt                                                      
     C           *IN86     IFEQ '0'                                             
     C           *IN31     ANDEQ'0'
     C           O7CODA    IFNE £ECODA                                          
     C           O7CODB    ORNE £ECODB                                          
     C                     MOVE '1'       *IN86                                 
     C                     ENDIF                                                
     C                     ENDIF                                                
      * Arrêt défilement                                                        
     C           *IN86     IFEQ '1'                                             
      *                                                                         
     C           *IN31     IFEQ '0'
     C           KMAN      SETLLTTEXTSL1                                        
     C                     ELSE
     C           *LOVAL    SETLLTTEXTSL1                                        
     C                     ENDIF                                                
      *                                                                         
     C                     LEAVE                                                
     C                     ENDIF                                                
      *                                                                         
     C                     ENDDO                                                
     C                     ENDIF                                                
      *                                                                         
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Mouvemente avant mise à jour du fichier                                 
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           MOUVE     BEGSR                                                
     C                     MOVE £1CODA    O7CODA                                
     C                     MOVE £1CODB    O7CODB                                
     C                     Z-ADD£1B7NB    O7B7NB                                
     C                     MOVE £1EATX    O7EATX                                
     C                     MOVE £1B9NA    O7B9NA                                
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Mise-à-jour d'un enregistrement                                         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           MODIF     BEGSR                                                
     C                     MOVEA'0001'    *IN,87                                
     C           TAGMOD    TAG                                                  
     C                     EXSR ECRSAI                                          
     C           *IN12     IFNE '1'                                             
     C           *IN03     ANDNE'1'                                             
      * Mise à jour                                                             
     C                     MOVE £1CODA    ££CODA                   
     C                     MOVE £1CODB    ££CODB                   
     C                     Z-ADD£1B7NB    ££B7NB  20               
     C           KMANO     CHAINTTEXTSL1             98                         
     C           *IN98     IFEQ '0'                                             
     C                     EXSR MOUVE                                           
     C                     UPDATTEXTFMT                                         
     C                     MOVE ' '       £1OPT                                 
     C                     UPDAT£1SFL                                           
     C                     ELSE                                                 
     C                     MOVE MSG,6     £1MSG                                 
     C                     GOTO TAGMOD                                          
     C                     ENDIF                                                
      *                                                                         
     C                     ENDIF                                                
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Ajout d'un enregistrement                                               
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           CREAT     BEGSR                                                
      * Mise à blanc des zones écran                                            
     C                     CLEAR£2ENR                                           
      *                                                                         
     C                     MOVE ACT,3     £ACTIO                                
      * Propose une clef                                                        
     C                     MOVE £ECODA    £2CODA                                
     C                     MOVE £ECODB    £2CODB                                
     C                     Z-ADD0         £2B7NB                                
      *                                                                         
     C                     EXSR INSER                                           
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Création enregistrement saisi ou copié                                  
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           INSER     BEGSR                                                
     C                     MOVEA'0011'    *IN,87                                
     C           TAGCRE    TAG                                                  
     C                     EXSR ECRSAI                                          
     C           *IN12     IFNE '1'                                             
     C           *IN03     ANDNE'1'                                             
      * Contrôle d'inexistence                                                  
     C                     MOVE £2CODA    ££CODA                   
     C                     MOVE £2CODB    ££CODB                   
     C                     Z-ADD£2B7NB    ££B7NB                                
     C           KMANO     CHAINTTEXTSL1            N98                         
      *          Existe déjà
     C           *IN98     IFEQ '0'                                             
     C                     MOVE MSG,3     £1MSG                                 
     C                     GOTO TAGCRE                                          
     C                     ENDIF                                                
      * Mise à jour                                                             
     C           KMANO     CHAINTTEXTSL1             98                         
     C           *IN98     IFEQ '1'                                             
     C                     MOVE £2CODA    £1CODA                   
     C                     MOVE £2CODB    £1CODB                   
     C                     Z-ADD£2B7NB    £1B7NB                   
     C                     EXSR MOUVE                                           
     C                     WRITETEXTFMT                                         
     C                     ELSE                                                 
     C                     MOVE MSG,3     £1MSG                                 
     C                     GOTO TAGCRE                                          
     C                     ENDIF                                                
      *                                                                         
     C                     ENDIF                                                
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Suppression d'un enregistrement                                         
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           SUPPR     BEGSR                                                
     C                     MOVEA'1001'    *IN,87                                
     C                     MOVE *BLANK    £1MSG                                 
     C                     MOVE ' '       £1CONF                                
      *      demande de confirmation                                            
     C           CONF      TAG                                                  
     C                     EXSR ECRSAI                                          
      *                                                                         
     C                     SELEC                                                
      *                                                                         
     C           £1CONF    WHEQ 'O'                                             
     C                     MOVE £1CODA    ££CODA                   
     C                     MOVE £1CODB    ££CODB                   
     C                     MOVE £1B7NB    ££B7NB                                
     C           KMANO     CHAINTTEXTSL1             98                         
     C           *IN98     IFEQ '0'                                             
     C                     DELETTEXTFMT                                         
     C                     ENDIF                                                
      *                                                                         
     C           £1CONF    WHNE 'N'                                             
     C           *IN03     ANDNE'1'                                             
     C           *IN12     ANDNE'1'                                             
     C                     GOTO CONF                                            
      *                                                                         
     C                     ENDSL                                                
      *                                         
     C                     MOVE ' '       £1OPT 
     C                     UPDAT£1SFL           
      *                                                                         
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Affichage                                                               
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           VISU      BEGSR                                                
     C                     MOVE '1'       *IN84                                 
     C                     MOVEA'0001'    *IN,87                                
     C                     MOVE *BLANK    £1MSG                                 
     C                     EXSR ECRSAI                                          
      *
     C           *IN12     IFNE '1'                                             
     C                     MOVE ' '       £1OPT                                 
     C                     UPDAT£1SFL                                           
     C                     ENDIF
      *
     C                     MOVE '0'       *IN84                                 
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Copie                                                                   
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           COPIE     BEGSR                                                
     C                     MOVE £1CODA    £2CODA                                
     C                     MOVE £1CODB    £2CODB                                
     C                     Z-ADD0         £2B7NB                                
     C                     EXSR INSER                                           
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Repositionne pour rafraîchissement affichage                           
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           REPOSI    BEGSR                                                
     C                     MOVE £ECODA    SVCODA                                
     C                     MOVE £ECODB    SVCODB                                
     C           *IN92     IFEQ '0'                                             
     C                     MOVE *LOVAL    SVB7NB  20                            
     C                     ENDIF                                                
     C           *IN31     IFEQ '0'
     C           KSAUVE    SETLLTTEXTSL1                                        
     C                     ELSE
     C           *LOVAL    SETLLTTEXTSL1                                        
     C                     ENDIF                                                
     C                     EXSR SFL                                             
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Affiche format de saisie                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           ECRSAI    BEGSR                                                
     C                     EXSR ECRCMD
     C                     MOVE £1CODA    £2CODA 
     C                     MOVE £1CODB    £2CODB 
     C                     MOVE £EG3TX    £2G3TX 
     C                     EXFMT£2ENR                                           
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Affiche bas d'écran                                                     
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           ECRCMD    BEGSR                                                
     C                     WRITE£1CMD                                           
     C                     MOVE *BLANK    £1MSG                                 
     C                     ENDSR                                                
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
      * Diverses initialisations et définitions                                 
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           *INZSR    BEGSR                                                
      *                                                                         
     C           *ENTRY    PLIST
     C                     PARM           £ECODA
     C                     PARM           £ECODB
     C                     PARM           £EG3TX
     C                     MOVE £ECODA    £2CODA  3                             
     C                     MOVE £ECODB    £2CODB  3                             
      *                                                                         
     C           KMANO     KLIST                                                
     C                     KFLD           ££CODA  3                
     C                     KFLD           ££CODB  3                
     C                     KFLD           ££B7NB  20       N. Sequence          
      *                                                                         
     C           KMAN      KLIST                                                
     C                     KFLD           £ECODA  3                
     C                     KFLD           £ECODB  3                
      *                                                                         
     C           KSAUVE    KLIST                                                
     C                     KFLD           SVCODA  3                
     C                     KFLD           SVCODB  3                
     C                     KFLD           SVB7NB  20                 
      * Compte la capacité du SFL                                               
     C                     MOVE '1'       *IN01                                 
     C                     WRITE£1CTL                      EFFACE SFL           
     C                     Z-ADD0         WSFLIG  60                            
     C           *IN02     DOWEQ'0'                                             
     C                     ADD  1         NUMREC                                
     C                     WRITE£1SFL                    02                     
     C                     ENDDO                                                
     C                     Z-ADDNUMREC    WSFLIG  60                            
     C                     MOVE '0'       *IN01                                 
      * Se positionne                                                           
     C           KMAN      SETLLTTEXTSL1                 98                     
      * Cas où on est en fin de fichier                                         
     C           *IN98     IFEQ '0'                                             
     C                     MOVE £ECODA    SVCODA                                
     C                     MOVE £ECODB    SVCODB                                
     C                     MOVE *HIVAL    SVB7NB  20                            
     C                     EXSR REMONT                                          
     C                     ENDIF                                                
      *                                                                         
     C                     EXSR SFL                                             
      *                                                                         
     C                     MOVEL$PGM      ££PGM                                 
     C                     MOVE '   '     EXTYPC  3                             
     C                     MOVE '0'       *IN93                                 
      *                                                                         
     C                     ENDSR                                                
** ACT                                                                          
MODIFICATION                                                                    
SUPPRESSION                                                                     
CREATION                                                                        
COPIE                                                                           
VISUALISATION                                                                   
** MSG                                                                          
Fin atteinte                                                                    
Début atteint                                                                   
Cet enregistrement existe déjà                                                  
                                                                                
Données entrées non valides                                                     
L'enregistrement a été supprimé