RTVJRNE
et est donc assez souple.
De nombreuses astuces sont mises en oeuvre, en particulier le contrôle d'invite.
| Source | Type | Texte et commentaires |
|---|---|---|
| JRNE | CMD | Affichage de journal Compiler avec PGM(JRNE1C) HLPPNLGRP(*LIBL/JRNE1H) HLPID(*CMD) PMTOPTCTL(JRNEINV)
|
| JRNEH | PNLGRP | Aide en ligne (compiler par option 14) |
| JRNE1C | CLP | Programme lié à la commande |
| JRNEINV | CLP | Programme de gestion d'invite |
| JRNE1 | RPG | Programme principal, fait tout le travail. L'utilisation des API donne un programme compact pour ce qu'il fait. Il est auto documenté. |
| JRNE1FM | DSPF | Ecran associé au RPG. |
CMD PROMPT('Affichage de Journal')
/* compiler avec PGM(JRNE1C) */
PARM KWD(JRN) TYPE(JRN) PROMPT('Journal')
PARM KWD(TYPE) TYPE(*CHAR) LEN(5) RSTD(*YES) +
DFT(*TIME) VALUES(*SEQ *TIME *TIMX) +
PROMPT('Type de sélection')
PARM KWD(DATE) TYPE(*DATE) DFT(*TODAY) +
SPCVAL((*TODAY 0000000)) PROMPT('Date début')
PARM KWD(TIME) TYPE(*TIME) DFT(*NOW) SPCVAL((*NOW +
000000)) PROMPT('Heure début')
PARM KWD(USRPRF) TYPE(*NAME) LEN(10) DFT(*ALL) +
SPCVAL((*CURRENT) (*ALL)) PROMPT('Profil +
utilisateur')
JRN: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) +
SPCVAL((*LIBL) (*CURRENT) (*USRLIBL)) +
PROMPT('Bibliothèque')
:PNLGRP. :HELP NAME='JRNE'.Affichage de journal. :p.Cette commande est potentiellement équivalente à :pk.DSPJRN.:epk. Elle est limitée aux informations enregistrement, affiche le détail du contenu des fichiers et rapproche les enregistrements avant et après modification. :EHELP. :HELP NAME='JRNE/JRN'.Journal. - Aide. :XH2.Journal :P.Saisir le nom du journal à afficher. Le nom du journal à afficher peut être trouvé en utilisant :pk.DSPFD:epk. sur l'un des fichiers gérés. Le plus souvent, tous les fichiers utilisent le même journal. :EHELP. :HELP NAME='JRNE/TYPE'.Type d'analyse. - Aide. :XH2.Type d'analyse :P.Définit le type de lancement pour la commande :pk.RCVJRNE:epk.: :parml. :pt.*SEQ :pd. accès par numéro de journal, :pt.*TIME:pd. accès rapide par date et heure, :pt.*TIMX:pd. accès détaillé par date et heure. :eparml. :EHELP. :HELP NAME='JRNE/DATE'.Date. - Aide. :XH2.Date :P.Saisir une date, ou :pk.*TODAY:epk. pour date du jour. :EHELP. :HELP NAME='JRNE/TIME'.Heure - Aide. :XH2.Heure :P.Saisir une heure, ou :pk.*NOW:epk. pour l'heure courante :EHELP. :HELP NAME='JRNE/USRPRF'.Profil utilisateur - Aide. :XH2.Profil utilisateur :P.Saisir le nom d'un profil utilisateur, ou :pk.*ALL:epk. pour ne pas faire de sélection sur ce critère. :EHELP. :EPNLGRP.
/* --------------------------------------------------------*/
/* Affichage de postes de journal */
/* */
/* *SEQ Par numéro de séquence */
/* *TIME Par heure */
/* *TIMX Par heure avec toutes options */
/* */
/* --------------------------------------------------------*/
PGM (&jrnlib &mode &date &time &usr)
dcl &jrnlib *char 20
dcl &lib *char 10
dcl &jrn *char 10
dcl &mode *char 5
DCL &DATE *CHAR 7
DCL &TIME *CHAR 6
DCL &usr *CHAR 10
DCL &QDATE *CHAR 6
DCL &QTIME *CHAR 6
DCL &ERR *CHAR 1 VALUE('0')
DCL &MSGID *CHAR 7
DCL &MSGF *CHAR 10
DCL &MSGLIB *CHAR 10
DCL &MSGDTA *CHAR 256
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERREUR))
chgvar &jrn %sst(&jrnlib 1 10)
chgvar &lib %sst(&jrnlib 11 10)
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDATE)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&QTIME)
IF COND(&DATE *NE '0000000') THEN(do)
CVTDAT DATE(&DATE) TOVAR(&QDATE) FROMFMT(*CYMD) +
TOSEP(*NONE)
enddo
IF COND(&time *NE '000000') THEN(CHGVAR +
VAR(&QTIME) VALUE(&time))
IF COND(&USR = '*CURRENT') THEN(RTVJOBA +
USER(&USR))
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('JRNE' !> &lib !< '/' !! &jrn +
!> &mode !> &qdate !> &qtime !> &usr)
IF COND(&MODE *EQ '*TIME') THEN(GOTO +
CMDLBL(BYTIME))
IF COND(&MODE *EQ '*TIMX') THEN(GOTO +
CMDLBL(BYTIMX))
RCVJRNE ??JRN(&LIB/&JRN) EXITPGM(JRNE1) +
??FROMENT(*FIRST) ??FROMTIME(*N) +
?*ENTTYP(*RCD) DELAY(1 1)
goto finok
bytime:
RCVJRNE ??JRN(&LIB/&JRN) EXITPGM(JRNE1) +
??FROMTIME(&QDATE &QTIME) ?*ENTTYP(*RCD) +
??USRPRF(&USR) DELAY(1 1)
goto finok
bytimx:
? RCVJRNE ??JRN(&LIB/&JRN) EXITPGM(JRNE1) +
??FROMTIME(&QDATE &QTIME) ?*ENTTYP(*RCD) +
??USRPRF(&USR) DELAY(1 1)
goto finok
/* L'écran peut ne pas se vider */
finok:
rclrsc
goto finfin
ERREUR: IF (&ERR = '1') GOTO FINFIN
CHGVAR &ERR '1'
RCVMSG MSGTYPE(*LAST) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
finfin: ENDPGM
Se référer à la commande FD, sur ce site, pour plus d'information. Consulter la documentation sur les API. Des adaptations intéressantes sont possibles.
H*------------------------------------------------------------
H* Affichage du détail d'un poste de journal
H* Programme d'Escape d'un RTVJRNE,
H* avec récup dynamique de dexcription de fichier
H* et découpage des données
H*------------------------------------------------------------
FJRNE7FM CF E WORKSTN
F KINFDS ECRDS
F C1RN KSFILE F1S
F C2RN KSFILE F2S
E TZA 5 1 Alpha 5
E RCD 1000 1 RC2 1 Record
E NBA 15 1 Nombre alpha
E NA1 15 1
E NA2 16 1
E VAL 80 1 VA2 1 Valeur affi
E COP 1 10 2 COL 25 Descripteurs maj
I* Data structure to retrieve cursor location
IECRDS DS
I B 370 3710D1CURS
I B 378 3790D1RRN1
I SDS
I 1 10 PGMNAM
I 244 253 WS
I 254 263 USER
I DS
I 1 120TIMHR
I 1 60H1TIME
I 7 120H1DATE
I* Traitement des champs numériques
I DS
I 1 15 NBA
I P 9 150NBRP
I 1 150NBRS
I DS
I 1 15 NA1
I 1 15 NA1A
I DS
I 1 17 NBRAFF
I 1 16 NA2
I 1 16 NA2A
I 17 17 SIGNE
I* 1er paramètre info journal
IJRNINF DS
I 15 15 JOTSX1
I 6 150JOSEQN
I 16 16 JOCODE
I 17 18 JOENTT
I 19 25 JODATE
I 25 25 JOTSX2
I 25 300JOTIME
I 41 50 JOUSER
I 57 66 JOPGM
I 67 76 JOOBJ
I 77 86 JOLIB
I 125 125 JOFLAG
I 1261125 RCD
IJRNACT DS
I 1 1 JOACT1
I 2 2 JOACT2
I 3 3 JOACT3
I*
I DS
I 1 65 S2FVAL
I 1 80 VAL
I 1 32 S2A1
I 34 65 S2A2
I 32 32 S2DIF
I 1 17 S2NB1
I 41 57 S2NB2
I* Libellés alpha longs
I DS
I 1 65 S2FVA2
I 1 80 VA2
I* Erreurs d'appel API
IERRCOD DS
I B 1 40BYTPRO
I B 5 80BYTAVA
I 9 15 EXCID
I 16 16 RSRVD
I* Compteurs binaires sur récup caractéristiques User Space
I DS
I B 1 40USLEN
I B 5 80USPOS
I B 9 120USSPSQ
I B 13 160SCSPN2
I B 17 200SCLEN
I B 21 240U2LEN
I B 25 280U2POS
I B 29 320U3LEN
I B 33 360U3POS
I* Compteurs binaires sur caractéristiques récupérées
I* Ces informations sont récupérées dans la portion fixe
I* du User Space. La technique est standard pour tous les API
I* utilisant une liste.
IUSINFO DS
I B 1 40USDEPL
I B 9 120USNBLS
I B 13 160USSZLS
IU2INFO DS
I B 1 40U2DEPL
I B 9 120U2NBLS
I B 13 160U2SZLS
IU3INFO DS
I B 1 40U3DEPL
I B 9 120U3NBLS
I B 13 160U3SZLS
I* Infos QDBLDBR, Infos fichier, format DBLR0100 (Longueur 320)
IWHINFO DS
I 1 10 WHRFI
I 11 20 WHRLI
I 21 30 WHREFI
I 31 40 WHRELI
I 41 41 WHTYPE
I* Taille du User Space en binaire
I DS
I B 1 40USSIZ
I* Binary values values for API
I DS
I B 1 40INFOLN
I* User Space and Object information
ID1INFO DS
I 9 18 D1OBJ
I 19 28 D1LIB1
I 29 38 D1TYPE
I 39 48 D1LIBO
I 101 150 D1TXT
I 151 160 D1SRC
I 161 170 D1LIB
I 171 180 D1MBR
I* L'information Format la plus simple ne contient que le format.
ID2INFO DS
I 1 10 D2FMT
I 33 82 D2TXT
I* Prefix D2
I*
I* Fields information. FLDL0100 is lengh 285
ID3INFO DS
I 1 10 D3NAME
I 11 11 D3TYP
I 12 12 D3TYPE
I B 13 160D3POS
I B 21 240D3BYTS
I B 25 280D3DIGS
I B 29 320D3DECP
I 33 82 D3TXT
I 153 171 D3CH1
I 173 191 D3CH2
I 193 211 D3CH3
I* Constantes User space
I 'USPFFD1 QTEMP 'C C1USP
I 'FFDFMT 'C C1ATR
I 2000 C C1SIZ
I 'USPFFD2 QTEMP 'C C2USP
I 'FFDFLD 'C C2ATR
I 10000 C C2SIZ
I '*ALL ' C C1AUT
I 'Database Relations 'C C1TXT
I 14 C C1LINS
C*------------------------------------------------------------------------
C* Paramètres d'appel commande
C *ENTRY PLIST
C PARM JRNINF User
C PARM JRNACT Action
C* Traitement de première fois
C *IN01 IFEQ '0'
C Z-ADD0 APPSEQ 30
C Z-ADD0 S1LINS 30
C EXSR INI00
C SETON 01
C ELSE
C ADD 1 APPSEQ
C ENDIF
C*------------------------------------------------------------------------
C* Interprétation des codes action
C* JOACT1 '0' Pas d'entrée
C* '1' Une ligne en entrée
C* '2' Un blec d'enregistrements en entrée
C* '3' Aucune entrée, changement de récepteur
C* '4' journal inactif
C* '8' Sortie: passer en mode bloc.
C* '9' Sortie: arrêter le balayage
C*
C* JOACT2 'Y'=Il y a une suite 'N'=Fin de liste
C*
C JOACT1 IFEQ '1' 1 poste reçu
C JOACT1 OREQ '2' bloc reçu
C MOVE '1' RCVOK 1 Poste reçu
C ELSE
C MOVE '0' RCVOK
C END
C* Limiter les plantages
C JOTSX1 IFLT '0'
C JOTSX1 ORGT '9'
C Z-ADD0 JOSEQN
C ENDIF
C JOTSX2 IFLT '0'
C JOTSX2 ORGT '9'
C Z-ADD0 JOTIME
C ENDIF
C* Le programme doit être appelé plusieurs fois
C* avant qu'un écran ne soit rempli.
C MOVE ' ' S1SEL
C MOVE JOCODE S1CODE
C MOVE JOUSER S1USER
C MOVE JOPGM S1PGM
C MOVE JOSEQN S1SEQN
C MOVE JOACT1 S1ACT1
C MOVE JOACT2 S1ACT2
C MOVE JOACT3 S1ACT3
C MOVE JOLIB S1LIB
C MOVE JOOBJ S1OBJ
C MOVE JOENTT S1ENTT
C MOVE JOTIME S1TIME
C MOVEARCD S1RCD
C ADD 1 S1LINS
C ADD 1 C1TRN 50
C MOVE '0' C1END 1
C Z-ADDC1TRN C1RN 50 Records
C WRITEF1S
C Z-ADDC1TRN RNB1
C* On retourne si le remplissage n'est pas complet
C S1LINS IFLT C1LINS Ecran non plein
C RCVOK ANDEQ'1' Pas de problème
C JOACT2 ANDEQ'Y' Reste à lire
C RETRN
C ENDIF
C* First display : list form the beginning
C Z-ADD12 C1SIZE 50
C MOVE 01 ECRAN 20
C MOVE *ALL'0' CLRIND 29
C MOVE '0' ERREUR 1
C CALL 'SFLCLR'
C* Display Loop
1{ C ECRAN DOWNE99
C TIME TIMHR
2<--C ECRAN CASEQ01 TRT01
2<--C ECRAN CASEQ02 TRT02
2} C ENDCS
1} C ENDDO
C* Appels successifs par RCVJRNE sans nettoyage
C RETRN
C*======================================================================
2---C TRT01 BEGSR
C* Use default positioning when error
1{ C ERREUR IFEQ '1'
C Z-ADD0 C1LIN
C Z-ADD0 C1COL
1} C END
C* Display screen
C WRITEF1
C WRITEMSGC Messages
C SETON 33
1{ C C1TRN IFNE 0
C SETON 32
1| C ELSE
C SETOF 32
1} C END
C MOVE C1END *IN35
C WRITEF1C
C READ F1C 97
C READ F1 97
C Z-ADDD1RRN1 C1TOP 50 Top of screen
C Z-ADDC1TOP RNB1 Sflrcdnbr
C D1CURS DIV 256 C1LIN
C MVR C1COL
C* Clear error fields
C MOVEACLRIND *IN,40
C CALL 'SFLCLR'
C MOVE '0' ERREUR 1
C* F3 or F12 to exit program
1{ C SELEC
1| C *IN03 WHEQ '1'
C Z-ADD99 ECRAN
C MOVE '03' P1CRET 2
C MOVE '9' JOACT1
C SETON LR
1| C *IN12 WHEQ '1'
C Z-ADD99 ECRAN
C MOVE '12' P1CRET
C MOVE '9' JOACT1
C* Rollup: retour au RCVJRNE pour boucler à nouveau
1| C *IN25 WHEQ '1'
C Z-ADD99 ECRAN
C Z-ADD0 S1LINS 30
C* Sinon, recherche des sélections
C OTHER
C EXSR CTR01
C ENDSL
C*
C ENDSR
C*======================================================================
1---C CTR01 BEGSR
C* Affichage du détail pour lignes sélectionnées
C DO *HIVAL
C READCF1S 97
C 97 LEAVE
C S1SEL IFEQ '5'
C Z-ADD02 ECRAN
C MOVE ' ' S1SEL
C MOVE S2DIFF *IN41
C UPDATF1S
C EXSR SET02
C LEAVE
C ELSE
C MOVE ' ' S1SEL
C MOVE S2DIFF *IN41
C UPDATF1S
C ENDIF
C ENDDO
C*
C ENDSR
C*======================================================================
1---C SET02 BEGSR
C* Zones fixes de l'écran
C MOVE S1CODE F2CODE
C MOVE S1SEQN F2SEQN
C MOVE S1ACT1 F2ACT1
C MOVE S1ACT2 F2ACT2
C MOVE S1ACT3 F2ACT3
C MOVE S1LIB F2LIB
C MOVE S1OBJ F2OBJ
C MOVE S1ENTT F2ENT1
C MOVE S1TIME F2TIME
C MOVE *BLANK F2ENT2
C MOVE *BLANK L2ENT2
C MOVEAS1RCD RCD
C* Accès au suivant sur état avant modif, avec vérif fichier
C MOVE '0' F2MAJ 1
C S1ENTT IFEQ 'UB'
C S1ENTT OREQ 'BR'
C C1RN ANDLTC1TRN
C ADD 1 C1RN
C C1RN CHAINF1S 97
C *IN97 IFEQ '0'
C F2OBJ ANDEQS1OBJ
C MOVE '1' F2MAJ 1
C MOVEAS1RCD RC2
C MOVE S1ENTT F2ENT2
C MOVE ' ' S1SEL
C UPDATF1S
C ENDIF
C ENDIF
C* Clear Subfile
C MOVE '0' S2CHGD 1
C SETOF 3233
C SETON 34
C WRITEF2C
C SETOF 34
C Z-ADD0 C2TRN 50
C* Remplissage
C EXSR INIFD
C*
C MOVE '1' C2END 1
C Z-ADD1 RNB2
C*
C ENDSR
C*======================================================================
2---C TRT02 BEGSR
C* Use default positioning when error
1{ C ERREUR IFEQ '1'
C Z-ADD0 C2LIN
C Z-ADD0 C2COL
1} C END
C* Display screen to select instrument
C WRITEF2
C WRITEMSGC Messages
C SETON 33
1{ C C2TRN IFNE 0
C SETON 32
1| C ELSE
C SETOF 32
1} C END
C MOVE C2END *IN35
C WRITEF2C
C READ F2C 97
C READ F2 97
C Z-ADDD1RRN1 C2TOP 50 Top of screen
C Z-ADDC2TOP RNB2 Sflrcdnbr
C D1CURS DIV 256 C2LIN
C MVR C2COL
C* Clear error fields
C MOVEACLRIND *IN,40
C CALL 'SFLCLR'
C MOVE '0' ERREUR 1
C* F3 or F12 to exit program
1{ C SELEC
1| C *IN03 WHEQ '1'
C Z-ADD99 ECRAN
C MOVE '03' P1CRET 2
C MOVE '9' JOACT1
C SETON LR
1| C *IN12 WHEQ '1'
C Z-ADD99 ECRAN
C MOVE '12' P1CRET
C OTHER
C Z-ADD01 ECRAN
C EXSR CTR01
C ENDSL
C*
C ENDSR
C*======================================================================
5---C INI00 BEGSR
C* Vérification de présence du Userspace Format
C MOVE ' ' EXCID
C*
C CALL 'QUSROBJD'
C PARM D1INFO
C PARM 180 INFOLN
C PARM 'OBJD0200'FORMAT 8
C PARM C1USP OBJLIB 20
C PARM '*USRSPC' OBJTYP 10
C PARM ERRCOD
C* ... Création si absent
1{ C EXCID IFNE ' '
C Z-ADDC1SIZ USSIZ
C CALL 'QUSCRTUS' API
C PARM C1USP USP1 20 Nom qualifié
C PARM C1ATR USATR 10 Attribut
C PARM USSIZ Taille en binaire
C PARM ' ' USINI 1 Remplissage
C PARM C1AUT USAUT 10 Droits
C PARM C1TXT USTXT 50 Description
1} C ENDIF
C* Vérification de présence du Userspace Zones
C MOVE ' ' EXCID
C*
C CALL 'QUSROBJD'
C PARM D1INFO
C PARM 180 INFOLN
C PARM 'OBJD0200'FORMAT 8
C PARM C2USP OBJLIB 20
C PARM '*USRSPC' OBJTYP 10
C PARM ERRCOD
C* ... Création si absent
1{ C EXCID IFNE ' '
C Z-ADDC2SIZ USSIZ
C CALL 'QUSCRTUS' API
C PARM C2USP USP2 20 Nom qualifié
C PARM C2ATR USATR 10 Attribut
C PARM USSIZ Taille en binaire
C PARM ' ' USINI 1 Remplissage
C PARM C1AUT USAUT 10 Droits
C PARM C1TXT USTXT 50 Description
1} C ENDIF
C*
C ENDSR
C*======================================================================
5---C INIFD BEGSR
C* Code de mise à jour
C Z-ADD1 I1 50
C F2ENT1 LOKUPCOP,I1 97
C N97 Z-ADD10 I1
C MOVE COL,I1 L2ENT1
C F2ENT2 IFNE ' '
C F2ENT2 LOKUPCOP,I1 97
C N97 Z-ADD10 I1
C MOVE COL,I1 L2ENT2
C ENDIF
C*
2<--C EXSR GETFIL Infos fichier
C EXSR GETFMT
C* Boucle sur les champs du format
C*---------------------------
2{ C DO U3NBLS N3 50 Pour chaque champ
C*---------------------------
C N3 IFGT 100
C LEAVE
C ENDIF
C MOVE '0' S2DIFF
4<--C EXSR GETFLD
C EXSR TRTFLD
C MOVE D3NAME S2FLDN
C ADD 1 C2TRN
C Z-ADDC2TRN C2RN 50 Records
C* Deux lignes à écrire en cas de libellé long
C F2MAJ IFEQ '1'
C F2TYPF ANDEQ'B'
C S2FVAL IFEQ S2FVA2
C MOVE '=' S2FLDN
C ELSE
C MOVE '1' S2DIFF
C MOVE S2DIFF *IN41
C WRITEF2S
C MOVE '*' S2FLDN
C MOVE S2FVA2 S2FVAL
C ADD 1 C2TRN
C Z-ADDC2TRN C2RN 50 Records
C ENDIF
C ENDIF
C MOVE S2DIFF *IN41
C WRITEF2S
C*---------------------------
2} C ENDDO
C*---------------------------
C*
C ENDSR
C*====================================================================
2---C TRTFLD BEGSR
C*
C MOVE *BLANK S2FVAL
C* Si packé ou numérique, traiter comme num
C D3TYP IFEQ 'P'
C D3TYP OREQ 'S'
C MOVE 'N' F2TYPF 1 Numérique
C MOVE '1' F2TOUR 1 1er passage
C EXSR TRTNUM
C MOVELNA2A S2NB1
C F2MAJ IFEQ '1'
C MOVE '2' F2TOUR 2eme passage
C EXSR TRTNUM
C MOVELNA2A S2NB2
C S2NB1 IFEQ S2NB2
C MOVE '=' S2DIF
C ELSE
C MOVE '1' S2DIFF
C MOVE '*' S2DIF
C ENDIF
C ENDIF
C ELSE
C* Copie du nombre de caractères nécessaires
C D3BYTS IFLE 32
C MOVE 'A' F2TYPF
C ELSE
C MOVE 'B' F2TYPF
C ENDIF
C MOVE *BLANK VAL
C MOVE *BLANK VA2
C Z-ADDD3POS J1 50
C 1 DO D3BYTS J2 50
C J2 IFGT 80
C LEAVE
C ENDIF
C MOVE RCD,J1 VAL,J2
C MOVE RC2,J1 VA2,J2
C ADD 1 J1
C ENDDO
C* Report du second libellé en mise à jour
C F2MAJ IFEQ '1'
C F2TYPF IFEQ 'A'
C MOVEAVA2 S2A2
C S2A1 IFEQ S2A2
C MOVE '=' S2DIF
C ELSE
C MOVE '1' S2DIFF
C MOVE '*' S2DIF
C ENDIF
C ENDIF
C ENDIF
C*
C ENDIF
C*
C ENDSR
C*====================================================================
2---C TRTNUM BEGSR
C* Deux passages: un pour 1er et un pour second
C D3TYP IFEQ 'P'
C Z-ADD0 NBRP
C ELSE
C Z-ADD0 NBRS
C ENDIF
C*
C Z-ADDD3POS J1
C 16 SUB D3BYTS J2
C J2 DOWLE15
C F2TOUR IFEQ '1'
C MOVE RCD,J1 NBA,J2
C ELSE
C MOVE RC2,J1 NBA,J2
C ENDIF
C ADD 1 J1
C ADD 1 J2
C ENDDO
C* Packé
C D3TYP IFEQ 'P'
C NBRP IFLT 0
C MOVE '-' SIGNE
C Z-SUBNBRP NBRP
C ELSE
C MOVE ' ' SIGNE
C END
C MOVE NBRP NA1A
C* Etendu
C ELSE
C NBRS IFLT 0
C MOVE '-' SIGNE
C Z-SUBNBRS NBRS
C ELSE
C MOVE ' ' SIGNE
C END
C MOVE NBRS NA2A
C ENDIF
C*
C* Ecrire la virgule après...
C 15 SUB D3DECP VAPRES 20
C* Début copie avec et sans virgule
C D3DECP IFEQ 0
C Z-ADD2 J2
C ELSE
C Z-ADD1 J2
C END
C*
C MOVE *BLANK NA2A
C MOVE '1' TOUT0 1
C* Ecriture chiffre par chiffre
C DO 15 J1
C NA1,J1 IFNE '0'
C NA1,J1 ANDNE' '
C MOVE '0' TOUT0
C ENDIF
C J1 IFEQ VAPRES
C MOVE '0' TOUT0
C ENDIF
C TOUT0 IFEQ '0'
C MOVE NA1,J1 NA2,J2
C ENDIF
C ADD 1 J2
C J1 IFEQ VAPRES
C J2 ANDLE15
C MOVE ',' NA2,J2
C ADD 1 J2
C ENDIF
C*
C ENDDO
C*
C ENDSR
C*====================================================================
2---C GETFIL BEGSR
C* Description du fichier
C MOVE F2OBJ P0FILE 10
C MOVE F2LIB P0LIB 10
C P0FILE CAT P0LIB P1FILQ 20
C*
C MOVE ' ' EXCID
C*
C CALL 'QUSROBJD'
C PARM D1INFO
C PARM 180 INFOLN
C PARM 'OBJD0200'FORMAT 8
C PARM P1FILQ OBJLIB 20
C PARM '*FILE ' OBJTYP 10
C PARM ERRCOD
C*
C MOVE D1LIBO H1LIB 10
C MOVE D1TXT H1TXT 50
C* Info en cas de problème
1{ C EXCID IFNE ' '
C EXCID CAT P1FILQ:1 H1TXT
1} C ENDIF
C* Description des formats du fichier
C CALL 'QUSLRCD'
C PARM C1USP USP1
C PARM 'RCDL0200'FORMAT 8
C PARM P1FILQ OBJLIB 20
C PARM '0' FILOVR 1
C PARM ERRCOD
C* Recupération du formatage de la liste en début de userspace
C CALL 'QUSRTVUS'
C PARM C1USP USP1 User Space
C PARM 125 USPOS Position
C PARM 16 USLEN Longueur
C PARM U2INFO DS infos User Space
C* Préparation des pointeurs pour récup de la liste
C 1 ADD U2DEPL U2POS Depuis
C** $$ 10 est pris Z-ADDU2SZLS U2LEN Taille poste liste
C* Si U2LEN ne fait pas 10, problèmes
C ENDSR
C*====================================================================
3---C GETFMT BEGSR
C* Récupération du nom de format et de la liste des zones
C*
C* Nom du format dans user space format, nom + texte
C CALL 'QUSRTVUS'
C PARM C1USP USP1 User Space
C PARM U2POS USPOS Position
C PARM 82 USLEN Longueur
C PARM D2INFO DS infos Format
1{ C D2TXT IFEQ *BLANK
C MOVELH1TXT D2TXT P
1} C ENDIF
C* Positionnement sur le format suivant dans le User Space.
C ADD U2SZLS U2POS
C* Récupération de la liste des champs du format
C CALL 'QUSLFLD'
C PARM C2USP USP2 Destination Info
C PARM 'FLDL0100'FORMAT 8 Format récupéré
C PARM P1FILQ OBJLIB 20 Fichier / Bib
C PARM D2FMT W2FMT 10 Format
C PARM '0' FILOVR 1 Pas d'override
C PARM ERRCOD En cas d'erreur.
C* Recupération du formatage de la liste des champs
C CALL 'QUSRTVUS'
C PARM C2USP USP2 User Space
C PARM 125 USPOS Position
C PARM 16 USLEN Longueur
C PARM U3INFO DS infos User Space
C* Préparation des pointeurs pour récup du premier champ
C 1 ADD U3DEPL U3POS Depuis
C** Z-ADDU3SZLS U3LEN Taille poste liste
C*
C ENDSR
C*====================================================================
4---C GETFLD BEGSR
C* Récupération des infos concernant un champ
C CALL 'QUSRTVUS'
C PARM C2USP USP2 User Space
C PARM U3POS USPOS Position
C PARM 211 USLEN Longueur DS
C PARM D3INFO DS infos Champs
C* Positionnement sur le champ suivant
C ADD U3SZLS U3POS
C*
C ENDSR
C*====================================================================
** COP / COL Codes Opération
BRAvant Rollback 1
DLSupprimé 2
DRSupprimé pour Rollback 3
PTAjouté 4
PXAjouté par rang 5
UBAvant Mise à jour 6
UPAprès mise à jour 7
URAprès MàJ Rollback 8
?? ............. 9
??Indéterminé 10
Cet écran simple est rattaché au programme JRNE1FM.
A DSPSIZ(24 80 *DS3)
A PRINT
A INDARA
A CF03(03)
A CF12(12)
A* Standard Message subfile
A R MSGS SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMNAM SFLPGMQ
A*
A R MSGC SFLCTL(MSGS)
A SFLSIZ(2)
A SFLPAG(1)
A OVERLAY
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N34 SFLEND
A PGMNAM SFLPGMQ
A*
A R F1
A*
A 1 6'JRNE1'
A COLOR(BLU)
A APPSEQ 3S 0O 1 13COLOR(BLU)
A 1 20'Affichage d''un journal'
A DSPATR(HI)
A 1 69DATE
A EDTCDE(Y)
A COLOR(BLU)
A 3 3'5=Détail'
A COLOR(BLU)
A 5 2'Sel'
A DSPATR(HI)
A 5 10'Séquence'
A DSPATR(HI)
A 5 19'Poste'
A DSPATR(HI)
A 5 25'Biblio.'
A DSPATR(HI)
A 5 36'Fichier'
A DSPATR(HI)
A 5 47'Act'
A DSPATR(HI)
A 5 53'Heure'
A DSPATR(HI)
A 5 59'User'
A DSPATR(HI)
A 5 70'Pgm'
A DSPATR(HI)
A R F1S SFL
A*
A 39 SFLNXTCHG
A S1RCD 1000A H
A S1SEL 1A B 6 3
A S1CODE 1A O 6 6
A S1SEQN 10Y 0O 6 8EDTCDE(4)
A S1ACT1 1A O 6 19
A S1ACT2 1A O 6 21
A S1ACT3 1A O 6 23
A S1LIB 10A O 6 25
A S1OBJ 10A O 6 36
A S1ENTT 2A O 6 47
A S1TIME 6Y 0O 6 50EDTWRD(' : : ')
A S1USER 10 O 6 59
A S1PGM 10 O 6 70
A R F1C SFLCTL(F1S)
A*
A SFLSIZ(0015)
A SFLPAG(0014)
A N35 ROLLUP(25)
A BLINK
A CSRLOC(C1LIN C1COL)
A OVERLAY
A 32 SFLDSP
A 33 SFLDSPCTL
A 34 SFLCLR
A 35 SFLEND(*MORE)
A RNB1 4S 0H SFLRCDNBR
A C1LIN 3S 0H
A C1COL 3S 0H
A 22 4'F3=Exit'
A COLOR(BLU)
A 22 30'F12=Retour'
A COLOR(BLU)
A R F2
A*
A 1 6'JRNE1'
A COLOR(BLU)
A APPSEQ 3S 0O 1 13COLOR(BLU)
A 1 20'Détail poste de journal'
A DSPATR(HI)
A F2CODE 1A O 1 47COLOR(BLU)
A F2SEQN 10S 0O 1 49COLOR(BLU)
A F2ACT1 1A O 1 60COLOR(BLU)
A F2ACT2 1A O 1 62COLOR(BLU)
A F2ACT3 1A O 1 64COLOR(BLU)
A 1 69DATE
A EDTCDE(Y)
A COLOR(BLU)
A F2LIB 10A O 2 6
A F2OBJ 10A O 2 20DSPATR(HI)
A F2TIME 6Y 0O 2 69EDTWRD(' : : ')
A F2ENT1 2A O 4 14COLOR(BLU)
A L2ENT1 25A O 4 17COLOR(BLU)
A F2ENT2 2A O 4 45COLOR(BLU)
A L2ENT2 25A O 4 48COLOR(BLU)
A 5 3'Champ'
A DSPATR(HI)
A 5 14'Valeur'
A DSPATR(HI)
A 5 23'Nombre>'
A DSPATR(HI)
A R F2S SFL
A*
A 39 SFLNXTCHG
A S2DIFF 1A H
A S2FLDN 10A O 6 3
A 41 DSPATR(HI)
A S2FVAL 65A O 6 14
A 41 DSPATR(HI)
A R F2C SFLCTL(F2S)
A*
A N35 ROLLUP(25)
A BLINK
A CSRLOC(C2LIN C2COL)
A OVERLAY
A 32 SFLDSP
A 33 SFLDSPCTL
A 34 SFLCLR
A 35 SFLEND(*MORE)
A SFLSIZ(0015)
A SFLPAG(0014)
A RNB2 4S 0H SFLRCDNBR
A C2LIN 3S 0H
A C2COL 3S 0H
A 22 4'F3=Exit'
A COLOR(BLU)
A 22 30'F12=Retour'
A COLOR(BLU)
Patrick Larreya, Mars 2002.