Voir le flux RSS

Ibmiiste

Afficher les postes du journal de façon intelligible

Noter ce billet
par , 11/06/2018 à 15h20 (112 Affichages)
DSPJRN est la commande qui permet de voir les postes du journal. Et ce que l'on aime, c'est de voir le contenu de l'enregistrement concerné. Mais voilà l'enregistrement est placé brut dans une zone de type caractère, la plupart du temps illisible s'il y a des champs en Decimal Packed. Voici une petite commande qui permet de le rendre lisible : DSPJRNPST

Elle se compose des étapes de création d'un membre source DDS à partir des caractéristiques du fichier type1 d'une sortie de DSPJRN et du source du fichier dont nous voulons les postes du journal.

Puis la commande DSPJRN récupère les postes qui sont insérés dans le fichier constitué précédemment. Et pour finir un QUERY(obsolète, c'est une partie à revoir)

Le source de la commande DSPJRNPST:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
             CMD        PROMPT('AFFICHAGE POSTE JOURNAL')
             PARM       KWD(JRN) TYPE(QJRN) MIN(1) PROMPT('JOURNAL')
 QJRN:       QUAL       TYPE(*NAME) LEN(10)
             QUAL       TYPE(*NAME) LEN(10) DFT(*CURLIB) SPCVAL((*CURLIB *CURLIB) (*LIBL)) +
                          PROMPT('BIBLIOTHÈQUE')

             PARM       KWD(FILE) TYPE(QFILE) MIN(1) PROMPT('FICHIER')
 QFILE:      QUAL       TYPE(*NAME) LEN(10)
             QUAL       TYPE(*NAME) LEN(10) DFT(*CURLIB) SPCVAL((*CURLIB *CURLIB)) +
                          PROMPT('BIBLIOTHÈQUE')

             PARM       KWD(FROMTIME) TYPE(QFROMTIME) PROMPT('DATE ET HEURE DE DÉBUT')
 QFROMTIME:  QUAL       TYPE(*NAME) LEN(10) DFT(*CURRENT) SPCVAL((*CURRENT '*CURRENT'))
             QUAL       TYPE(*NAME) LEN(8) PROMPT('HEURE DE DÉBUT')

             PARM       KWD(TOTIME) TYPE(QTOTIME) MIN(0) PROMPT('DATE ET HEURE DE FIN')

 QTOTIME:    QUAL       TYPE(*NAME) LEN(10) DFT(*NONE) SPCVAL((*NONE '*NONE'))
             QUAL       TYPE(*NAME) LEN(8) PROMPT('HEURE DE FIN')

             PARM       KWD(PGM) TYPE(QPGM) MIN(1) PROMPT('PROGRAMME')
 QPGM:       QUAL       TYPE(*NAME) LEN(10) DFT(*ALL) SPCVAL((*ALL))
             PARM       KWD(RCVRNGD) TYPE(QRCVRNG) MIN(1) PROMPT('PLAGE DE RÉCEPTEURS DE +
                          JOURNAL')
 QRCVRNG:    QUAL       TYPE(*NAME) LEN(10) DFT(*CURRENT) SPCVAL((*CURRENT *CURRENT))
             QUAL       TYPE(*NAME) LEN(10) DFT(*CURLIB) SPCVAL((*CURLIB *CURLIB) (*LIBL)) +
                          PROMPT('BIBLIOTHÈQUE')
             PARM       KWD(RCVRNGF) TYPE(QRCVRNG2)

 QRCVRNG2:   QUAL       TYPE(*NAME) LEN(10) DFT(*NONE) SPCVAL((*NONE '*NONE'))
             QUAL       TYPE(*NAME) LEN(10) SPCVAL((*CURLIB *CURLIB) (*LIBL)) +
                          PROMPT('BIBLIOTHÈQUE')

             PARM       KWD(FROMENTLRG) TYPE(*CHAR) LEN(25) DFT(*NONE) SPCVAL((*NONE '*NONE')) +
                          PROMPT('PREMIER NUM. SÉQ. MAXI')

             PARM       KWD(TOENTLRG) TYPE(*CHAR) LEN(25) DFT(*NONE) SPCVAL((*NONE '*NONE')) +
                          PROMPT('DERN. NUM. SÉQ. MAXI')

             PARM       KWD(JOB) TYPE(QJOB) MIN(1) PROMPT('TRAVAIL')
 QJOB:       QUAL       TYPE(*NAME) LEN(10) DFT(*ALL) SPCVAL((*ALL))
             QUAL       TYPE(*NAME) LEN(10) PROMPT('UTILISATEUR')
             QUAL       TYPE(*CHAR) LEN(6) RANGE(000000 999999) PROMPT('NUMÉRO')
Cette commande appelle le CLLE RTVJRNPST:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
             PGM        PARM(&QJRN &QFILE &QFROMTIME &QTOTIME &PGM &QRCVRNG1 &QRCVRNG2 +
                          &FROMENTLRG &TOENTLRG &QJOB)

             DCL        VAR(&QJRN) TYPE(*CHAR) LEN(20)
             DCL        VAR(&JRN) TYPE(*CHAR) LEN(10)
             DCL        VAR(&BIBJRN) TYPE(*CHAR) LEN(10)
             DCL        VAR(&QFILE) TYPE(*CHAR) LEN(20)
             DCL        VAR(&FIC) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FICJRN) TYPE(*CHAR) LEN(10)
             DCL        VAR(&BIBFIC) TYPE(*CHAR) LEN(10)
             DCL        VAR(&MBR) TYPE(*CHAR) LEN(10) VALUE('*FIRST')
             DCL        VAR(&BIBOBJ) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJ) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TYPOBJ) TYPE(*CHAR) LEN(7)
             DCL        VAR(&MBROBJ) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJPATH) TYPE(*CHAR) LEN(50)
             DCL        VAR(&INCLOBJ) TYPE(*CHAR) LEN(8) VALUE('*INCLUDE')
             DCL        VAR(&SUBTREE) TYPE(*CHAR) LEN(5) VALUE('*NONE')
             DCL        VAR(&MASQUE) TYPE(*CHAR) LEN(450) VALUE('*')
             DCL        VAR(&INCMASQ) TYPE(*CHAR) LEN(8) VALUE('*INCLUDE')
             DCL        VAR(&QRCVRNG1) TYPE(*CHAR) LEN(20)
             DCL        VAR(&RCVRNG1) TYPE(*CHAR) LEN(10)
             DCL        VAR(&BIBRCV1) TYPE(*CHAR) LEN(10)
             DCL        VAR(&QRCVRNG2) TYPE(*CHAR) LEN(20)
             DCL        VAR(&RCVRNG2) TYPE(*CHAR) LEN(10)
             DCL        VAR(&BIBRCV2) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FROMENTLRG) tyPE(*CHAR) LEN(25)
             DCL        VAR(&QFROMTIME) TYPE(*CHAR) LEN(20)
             DCL        VAR(&FROMTIME) TYPE(*CHAR) LEN(8)
             DCL        VAR(&FROMDATE) TYPE(*CHAR) LEN(12)
             DCL        VAR(&TOENTLRG) TYPE(*CHAR) LEN(25)
             DCL        VAR(&QTOTIME) TYPE(*CHAR) LEN(20)
             DCL        VAR(&TOTIME) TYPE(*CHAR) LEN(8)
             DCL        VAR(&TODATE) TYPE(*CHAR) LEN(12)
             DCL        VAR(&NBRENT) TYPE(*CHAR) LEN(10) value('*ALL')
             DCL        VAR(&CDJRN) TYPE(*CHAR) LEN(50)  value('*ALL')
             DCL        VAR(&ENTTYP) TYPE(*CHAR) LEN(50) value('*ALL')
             DCL        VAR(&QJOB) TYPE(*CHAR) LEN(26)
             DCL        VAR(&NUMJOB) TYPE(*CHAR) LEN(6)
             DCL        VAR(&NOMJOB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&PRF) TYPE(*CHAR) LEN(10)
             DCL        VAR(&PGM) TYPE(*CHAR) LEN(10)
             DCL        VAR(&CCIDLRG) TYPE(*CHAR) LEN(24) value('*ALL')
             DCL        VAR(&DEPENT) TYPE(*CHAR) LEN(5) value('*ALL')
             DCL        VAR(&OUTFMT) TYPE(*CHAR) LEN(5) value('*CHAR')
             DCL        VAR(&JRNID) TYPE(*CHAR) LEN(5)
             DCL        VAR(&INCHIDENT) TYPE(*CHAR) LEN(4) value('*NO')
             DCL        VAR(&OUTPUT) TYPE(*CHAR) LEN(7) value('*')
             DCL        VAR(&OUTFILFMT) TYPE(*CHAR) LEN(6) value('*TYPE1')
             DCL        VAR(&BIBOUTF) TYPE(*CHAR) LEN(10) value('QTEMP')
             DCL        VAR(&OUTFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OUTMBR) TYPE(*CHAR) LEN(10) value('*FIRST')
             DCL        VAR(&REPLACE) TYPE(*CHAR) LEN(8) value('*REPLACE')
             DCL        VAR(&ENTDTALEN) TYPE(*CHAR) LEN(10) value('*CALC')
             DCL        VAR(&LNGENTDTA) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LNGAENTDTA) TYPE(*CHAR) LEN(10)
             DCL        VAR(&NULLINDLEN) TYPE(*CHAR) LEN(10) value('*OUTFILFMT')
             DCL        VAR(&LNGNULLIND) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LNGANULLIN) TYPE(*CHAR) LEN(10)
             DCL        VAR(&INCENT) TYPE(*CHAR) LEN(10) value('*CONFIRMED')
             DCL        VAR(&FROMENT) TYPE(*CHAR) LEN(16) value('*FIRST')
             DCL        VAR(&TOENT) TYPE(*CHAR) LEN(16) value('*LAST')
             DCL        VAR(&CMTCYCID) TYPE(*CHAR) LEN(16) value('*ALL')
             DCL        VAR(&ASPDEV) TYPE(*CHAR) LEN(9) value('*')
             DCL        VAR(&CMD) TYPE(*CHAR) LEN(500)
             DCL        VAR(&LNGCMD) TYPE(*DEC) LEN(15 5) VALUE(500)
             DCL        VAR(&TEXT) TYPE(*CHAR) LEN(50)
             DCL        VAR(&QUOTE) TYPE(*CHAR) LEN(3) VALUE('''')

             CHGVAR     VAR(&BIBJRN) VALUE(%SST(&qjrn 11 10))
             CHGVAR     VAR(&JRN) VALUE(%SST(&qjrn 1 10))

             CHGVAR     VAR(&BIBfic) VALUE(%SST(&qfile 11 10))
             CHGVAR     VAR(&fic) VALUE(%SST(&qfile 1 10))

             CHGVAR     VAR(&FROMDATE) VALUE(%SST(&QFROMTIME 1 10))
             CHGVAR     VAR(&FROMTIME) VALUE(%SST(&QFROMTIME 11 8))

             CHGVAR     VAR(&TODATE) VALUE(%SST(&QTOTIME 1 10))
             CHGVAR     VAR(&TOTIME) VALUE(%SST(&QTOTIME 11 8))

             CHGVAR     VAR(&RCVRNG1) VALUE(%SST(&QRCVRNG1  1 10))
             CHGVAR     VAR(&BIBRCV1) VALUE(%SST(&QRCVRNG1 11 10))

             CHGVAR     VAR(&RCVRNG2) VALUE(%SST(&QRCVRNG2  1 10))
             CHGVAR     VAR(&BIBRCV2) VALUE(%SST(&QRCVRNG2 11 10))

             CHGVAR     VAR(&NOMJOB) VALUE(%SST(&QJOB  1 10))
             CHGVAR     VAR(&PRF) VALUE(%SST(&Qjob  11 10))
             CHGVAR     VAR(&NUMJOB) VALUE(%SST(&QJOB 21 6))

             CHGVAR     VAR(&FICJRN) VALUE(%SST(&FIC 1 7) *TCAT 'JRN')

             DLTF       FILE(QTEMP/&FICJRN)
             MONMSG     MSGID(CPF0000)
             DLTF       FILE(QTEMP/QDDSSRC)
             MONMSG     MSGID(CPF0000)
             CRTSRCPF   FILE(QTEMP/QDDSSRC) RCDLEN(112)

             DLTF       FILE(QTEMP/RTVPFSRC1)
             MONMSG     MSGID(CPF0000)

 CHARGE:     DSPFD      FILE(&BIBFIC/&FIC) TYPE(*ACCPTH) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/RTVPFSRC1)

             DLTF       FILE(QTEMP/RTVPFSRC)
             MONMSG     MSGID(CPF0000)
             RTVMBRD    FILE(&BIBFIC/&FIC) TEXT(&TEXT)
             DSPFFD     FILE(&BIBFIC/&FIC) OUTPUT(*OUTFILE) OUTFILE(QTEMP/RTVPFSRC)
             MONMSG     MSGID(CPF0000) EXEC(DO)
                SNDUSRMSG  MSG(&BIBFIC *TCAT '/' *TCAT &FIC *BCAT 'n''existe pas')
                GOTO       CMDLBL(FIN)
             ENDDO

             ADDPFM     FILE(QTEMP/QDDSSRC) MBR(&FIC) TEXT(&TEXT) SRCTYPE(PF)
             OVRDBF     FILE(QDDSSRC) TOFILE(QTEMP/QDDSSRC) MBR(&FIC)

             CALL       PGM(RTVPFSRC)

             DLTOVR     FILE(*ALL)
             CPYF       FROMFILE(*libl/QDDSSRC) TOFILE(QTEMP/QDDSSRC) FROMMBR(ENTJRN) +
                          TOMBR(ENTJRN) MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*MAP *DROP)

             CPYF       FROMFILE(QTEMP/QDDSSRC) TOFILE(QTEMP/QDDSSRC) FROMMBR(&FIC) +
                          TOMBR(ENTJRN) MBROPT(*ADD) FMTOPT(*MAP *DROP)

             CRTPF      FILE(QTEMP/&FICJRN) SRCFILE(QTEMP/QDDSSRC) SRCMBR(ENTJRN) SIZE(*NOMAX)

             CHGVAR     VAR(&CMD) VALUE('DSPJRN JRN(' *TCAT &BIBJRN *TCAT '/' *TCAT &JRN *TCAT +
                          ') FILE((' *TCAT &BIBFIC *TCAT '/' *TCAT &FIC *BCAT &MBR *TCAT ')) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/' *TCAT &FIC *TCAT ') +
                          ENTDTALEN(*CALC)')

             IF         COND(&NOMJOB *NE *ALL) THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'JOB(' +
                          *TCAT &NUMJOB *TCAT '/' *TCAT &PRF *TCAT '/' *TCAT &NOMJOB *TCAT +
                          ')'))

             IF         COND(&PGM *NE *ALL) THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'PGM(' +
                          *TCAT &PGM *TCAT ')'))

             IF         COND(&FROMENTLRG *NE '*NONE') THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT +
                          'FROMENTLRG(' *TCAT &FROMENTLRG *TCAT ')'))

             IF         COND(&TOENTLRG *NE '*NONE') THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT +
                          'TOENTLRG(' *TCAT &TOENTLRG *TCAT ')'))

             IF         COND(&FROMDATE *NE '*CURRENT') THEN(DO)
                CHGVAR     VAR(&CMD) VALUE(&CMD *BCAT 'FROMTIME(''' *TCAT &FROMDATE *BCAT +
                             &FROMTIME *TCAT ''')')
             ENDDO

             IF         COND(&TODATE *NE '*NONE') THEN(DO)
                CHGVAR     VAR(&CMD) VALUE(&CMD *BCAT 'TOTIME(''' *TCAT &TODATE *BCAT &TOTIME +
                             *TCAT ''')')
             ENDDO

             IF         COND(&RCVRNG1 *NE *CURRENT) THEN(do)
                CHGVAR     VAR(&CMD) VALUE(&CMD *BCAT 'RCVRNG(' *TCAT &BIBRCV1 *TCAT '/' *TCAT +
                             &RCVRNG1)
                IF         COND(&RCVRNG2 *NE '          ') THEN(CHGVAR VAR(&CMD) VALUE(&CMD +
                             *BCAT &BIBRCV2 *TCAT '/' *TCAT &RCVRNG2 ))
                CHGVAR     VAR(&CMD) VALUE(&CMD *TCAT ')')
             ENDDO

             CALL       PGM(QCMDEXC) PARM(&CMD &LNGCMD)

             CPYF       FROMFILE(QTEMP/&FIC) TOFILE(QTEMP/&FICJRN) MBROPT(*REPLACE) +
                          FMTOPT(*NOCHK) ERRLVL(*NOMAX)

             RUNQRY     QRYFILE((QTEMP/&FICJRN *FIRST)) RCDSLT(*YES)

 FIN:        ENDPGM
Le programme RTVPFSRC permet de régénérer un source à partir du DSPFFD d'un fichier:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
     FQDDSSRC   O  A E             DISK
     F                                     RENAME(QDDSSRC:SOURCE)
     FRTVPFSRC  IP   E             DISK
     FRTVPFSRC1 IF   E             DISK
     DSRCDTA           DS
     DT                               1    DIM(80)
     DXHFLDP           DS
     DU                               1    DIM(2)
     DXHFLDB           DS
     DV                               1    DIM(5)
     DXHFLDD           DS
     DW                               1    DIM(2)
     DED1              S              1    DIM(10) CTDATA PERRCD(10)
     

 * format fichier
     C                   READ      RTVPFSRC1                              41
      *
     C                   MOVEA     *BLANKS       T
     C                   MOVEA     WHFLDI        T(19)
     C                   MOVEL     WHFLDP        XHFLDP
     C                   MOVEL     WHFLDB        XHFLDB
     C                   MOVEL     WHFLDD        XHFLDD
      * cadrage droite zero suppress
     C     U(1)          IFEQ      '0'
     C                   MOVE      ' '           U(1)
     C                   ENDIF
     C                   DO        4             X                 2 0
     C                   Z-ADD     1             Y                 2 0
     C     V(X)          LOOKUP    ED1(Y)                                 40
     C  N40              MOVE      ' '           V(X)
     C                   ENDDO
     C     W(1)          IFEQ      '0'
     C                   MOVE      ' '           W(1)
     C                   ENDIF
     C                   SELECT
      * zone date
     C     WHFLDT        WHENeq    'L'
     C                   MOVE      *blank        XHFLDD
     C                   MOVE      *blank        XHFLDP
     C                   MOVE      *blank        wHFLDD
     C                   MOVE      *blank        wHFLDP
      * zone horodatage
     C     WHFLDT        WHENeq    'T'
     C                   MOVE      *blank        XHFLDD
     C                   MOVE      *blank        XHFLDP
     C                   MOVE      *blank        wHFLDD
     C                   MOVE      *blank        wHFLDP
      * zone alpha
     C     WHFLDD        WHENEQ    0
     C                   MOVEA     XHFLDB        T(30)
     C                   MOVEA     '  '          T(36)
      * zone signée
     C     WHFLDD        WHENEQ    WHFLDB
     C                   MOVEA     XHFLDD        T(33)
     C                   MOVEA     XHFLDP        T(36)
      * zone packee
     C     WHFLDD        WHENNE    WHFLDB
     C                   MOVEA     XHFLDD        T(33)
     C                   MOVEA     XHFLDP        T(36)
     C                   ENDSL
     C                   MOVEA     WHFLDT        T(35)
     C                   MOVE      *BLANKS       WKA036           36
      * texte zone
     C     WHFTXT        IFNE      *BLANKS
     C     '''':' '      XLATE     WHFTXT        WHFTXT
     C     ' '           CHECKR    WHFTXT        WKN002            2 0
     C     WKN002        IFGT      28
     C                   MOVEL     WHFTXT        WKA027           27
     C                   MOVE      WHFTXT        WKA023           23
     C     'TEXT('''     CAT       WKA027:0      WKA036
     C     WKA036        CAT       '+':0         WKA036
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   MOVE      *BLANKS       WKA036
     C     WKA023        CAT       ''')':0       WKA036
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ELSE
     C     'TEXT('''     CAT       WHFTXT:0      WKA036
     C     WKA036        CAT       ''')':0       WKA036
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ENDIF
     C                   ENDIF
      * colhdg
     C     WHCHD1        IFNE      *BLANKS
     C     '''':' '      XLATE     WHCHD1        WHCHD1
     C                   MOVE      *BLANKS       WKA036
     C     'COLHDG('''   CAT       WHCHD1:0      WKA036
     C     WHCHD2        IFNE      *BLANKS
     C     WKA036        CAT       ''' +':0      WKA036
     C                   ELSE
     C     WKA036        CAT       ''')':0       WKA036
     C                   ENDIF
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ENDIF
     C     WHCHD2        IFNE      *BLANKS
     C     '''':' '      XLATE     WHCHD2        WHCHD2
     C                   MOVE      *BLANKS       WKA036
     C     ''''          CAT       WHCHD2:0      WKA036
     C     WHCHD3        IFNE      *BLANKS
     C     WKA036        CAT       ''' +':0      WKA036
     C                   ELSE
     C     WKA036        CAT       ''')':0       WKA036
     C                   ENDIF
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ENDIF
     C     WHCHD3        IFNE      *BLANKS
     C     '''':' '      XLATE     WHCHD3        WHCHD3
     C                   MOVE      *BLANKS       WKA036
     C     ''''          CAT       WHCHD3:0      WKA036
     C     WKA036        CAT       ''')':0       WKA036
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ENDIF
      * Format de la date.
     C     WHFMT         IFNE      *BLANKS
     c     WHFLDT        andeq     'L'
     C                   eval      WKA036='DATFMT('+WHFMT+')'
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ENDIF
      * Format de l'heure
     C     WHFMT         IFNE      *BLANKS
     c     WHFLDT        andeq     'T'
     C                   eval      WKA036='TIMFMT('+WHFMT+')'
     C                   MOVEA     WKA036        T(45)
     C                   EXSR      WTR
     C                   ENDIF
      *
     CLR                 EXSR      ROOT
      *
     CSR   WTR           BEGSR
     C                   ADD       10            SRCSEQ
     C                   MOVEA     'A'           T(6)
     C                   WRITE     SOURCE
     C                   MOVEA     *BLANKS       T
     CSR                 ENDSR
      *
     CSR   ROOT          BEGSR
     C     REDO          TAG
     C     APKEYF        IFNE      *BLANKS
     C                   MOVEA     'K'           T(17)
     C                   MOVEA     APKEYF        T(19)
     C     APKSEQ        IFEQ      'D'
     C                   MOVEA     'DESCEND'     T(45)
     C                   ENDIF
     C                   EXSR      WTR
     C                   ENDIF
     C     *IN41         IFNE      '1'
     C                   READ      RTVPFSRC1                              41
     C  N41              GOTO      REDO
     C                   ENDIF
     CSR                 ENDSR
**
 123456789
Et pour finir la première partie d'un source DDS, ENTJRN, correspondant au fichier TYPE1 d'une sortie de DSPJRN.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
     A          R QJORDJE
     A                                      TEXT('Journal Entries')
     A            JOENTL         5S 0       TEXT('Length of entry')
     A                                      COLHDG('ENTRY' +
     A                                      'LENGTH')
     A            JOSEQN        10S 0       TEXT('Sequence number')
     A                                      COLHDG('SEQUENCE' +
     A                                      'NUMBER')
     A            JOCODE         1A         TEXT('Journal Code')
     A                                      COLHDG('CODE')
     A            JOENTT         2A         TEXT('Entry Type')
     A                                      COLHDG('TYPE')
     A            JODATE         6A         TEXT('Date of entry: Job date for+
     A                                      mat')
     A                                      COLHDG('DATE')
     A            JOTIME         6S 0       TEXT('Time of entry: hour/minute/+
     A                                      second')
     A                                      COLHDG('TIME')
     A            JOJOB         10A         TEXT('Name of Job')
     A                                      COLHDG('JOB' +
     A                                      'NAME')
     A            JOUSER        10A         TEXT('Name of User')
     A                                      COLHDG('USER' +
     A                                      'NAME')
     A            JONBR          6S 0       TEXT('Number of Job')
     A                                      COLHDG('JOB' +
     A                                      'NUMBER')
     A            JOPGM         10A         TEXT('Name of Program')
     A                                      COLHDG('PROGRAM' +
     A                                      'NAME')
     A            JOOBJ         10A         TEXT('Name of Object')
     A                                      COLHDG('OBJECT' +
     A                                      'NAME')
     A            JOLIB         10A         TEXT('Objects Library')
     A                                      COLHDG('LIBRARY' +
     A                                      'NAME')
     A            JOMBR         10A         TEXT('Name of Member')
     A                                      COLHDG('MEMBER' +
     A                                      'NAME')
     A            JOCTRR        10S 0       TEXT('Count or relative record nu+
     A                                      mber changed')
     A                                      COLHDG('COUNT/' +
     A                                      'RRN')
     A            JOFLAG         1A         TEXT('Flag: 1 or 0')
     A                                      COLHDG('FLAG')
     A            JOCCID        10S 0       TEXT('Commit cycle identifier')
     A                                      COLHDG('COMMIT' +
     A                                      'CYCLE ID')
     A            JOINCDAT       1A         TEXT('Incomplete Data: 1 or 0')
     A                                      COLHDG('INCOMPLETE' +
     A                                      'DATA')
     A            JOMINESD       1A         TEXT('Minimized ESD: 0, 1, or 2')
     A                                      COLHDG('MINIMIZED' +
     A                                      'ESD')
     A            JORES          6A         TEXT('Not used')
     A                                      COLHDG('RESERVED')
Plus le petit programme de compilation qui va bien, n'oublier pas de remplacer "USERBIB" par la ou les bibliothèques qui correspondent à vos besoins :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
PGM
DCL &FAILED TYPE(*DEC) LEN(10 0) VALUE(0)
DCL &FAILEDSTR TYPE(*CHAR) LEN(10)

CRTPF      FILE(QTEMP/BROUILLON) RCDLEN(1)
DSPFD      FILE(QTEMP/BROUILLON) TYPE(*ACCPTH) OUTPUT(*OUTFILE) OUTFILE(QTEMP/RTVPFSRC1)
DSPFFD     FILE(QTEMP/BROUILLON) OUTPUT(*OUTFILE) OUTFILE(QTEMP/RTVPFSRC)

CRTBNDRPG  PGM(USERBIB/RTVPFSRC) SRCFILE(USERBIB/QJRNPSTSRC) SRCMBR(RTVPFSRC) +
             OPTION(*EVENTF) DBGVIEW(*ALL) OPTIMIZE(*FULL) INDENT(2) +
             REPLACE(*YES)
MONMSG MSGID(CPF0000) EXEC(DO)
  CHGVAR VAR(&FAILED) VALUE(&FAILED + 1)
ENDDO

CRTBNDCL   PGM(USERBIB/RTVJRNPST) SRCFILE(USERBIB/QJRNPSTSRC) SRCMBR(RTVJRNPST) +
             OPTION(*EVENTF) REPLACE(*YES) OPTIMIZE(*FULL) DBGVIEW(*ALL)
MONMSG MSGID(CPF0000) EXEC(DO)
  CHGVAR VAR(&FAILED) VALUE(&FAILED + 1)
ENDDO

CRTCMD     SRCFILE(USERBIB/QJRNPSTSRC) SRCMBR(DSPJRNPST) REPLACE(*YES)  +
             CMD(USERBIB/DSPJRNPST) PGM(*LIBL/RTVJRNPST)
MONMSG MSGID(CPF0000) EXEC(DO)
  CHGVAR VAR(&FAILED) VALUE(&FAILED + 1)
ENDDO

CHGVAR VAR(&FAILEDSTR) VALUE(&FAILED)
ADDENVVAR ENVVAR(QRB_NUMBER_FAILED) VALUE(&FAILEDSTR) REPLACE(*YES)
ENDPGM
Reste à moderniser le tout, passer en Free Format, transformer en architecture ILE avec utilisation de programmes multi-modules et de procédures, utiliser du SQL à la place du QUERY, etc...

Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Viadeo Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Twitter Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Google Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Facebook Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Digg Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Delicious Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog MySpace Envoyer le billet « Afficher les postes du journal de façon intelligible » dans le blog Yahoo

Tags: ibm i, journal
Catégories
Programmation

Commentaires