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 :
- Gestion des données :
- Création d’enregistrement nouveau (touche F6).
- Modification d’enregistrement (option 2).
- Création par copie d’enregistrement préexistant (option 3).
- Suppression d’enregistrement (option 4).
- Visualisation sans mise-à-jour (option 5).
- Aide à la recherche
- Déplacement rapide vers la fin (touche F18) ou le début (touche F17).
- Fonction de recherche par comparaison avec une chaîne de caractères (touche F7). Les caractères de recherche sont entrés dans une fenêtre (format de type WINDOW, voir £3RECH).
- Critères facultatifs de sélection des lignes affichées : possibilité d’entrer des codes dans une ou les deux zones de saisie du haut de l’écran (Type de contrôle et Code écran).
- Aide à la sélection de critère : la touche F4 fait apparaître une fenêtre donnant les codes existants. Cette fonction appelle un programme externe utilisant une requêtre SQL.
- Particularités :
- Option 1 : enchaîne l’appel d’un autre programme (MAINT02R) de maintenance de commentaires associés à l’enregistrement.
- La suppression (option 4) n'est autorisée que si l’enregistrement concerné n’a jamais été utilisé dans un autre fichier.
- La touche F5 permet non seulement de « rafraîchir » l’affichage, mais encore fait remonter le curseur sur le premier champ (Type de contrôle).
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
- La recherche est insensible à la casse ainsi qu’aux accents et à la cédille sous la lettre C.
- Les caractères espace qui terminent la zone ne sont pas pris en compte.
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éjà »). Au lieu d’utiliser un tableau de chaînes prédéfinies incluses dans un membre source (comme cela 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.
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 :
-
- Paramètres reçus
- Type (3 car.)
- Anomalie (3 car.)
- Libellé anomalie (40 car.)
- L’affichage est limité a priori au choix de codes passés en paramètres (Type et Code).
- La touche F21 permet d’accéder à tous les enregistrements du fichier. Il est possible de modifier ou supprimer des clefs ne correspondant pas aux codes reçus en paramètres.
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é