データキューの再編成と属性取得

2019.01.28

データキューの再編成を行います。

/*********************************************************************/
/*                                                                   */
/*    CRTCMD  CMD(XXX/RGZDTAQ) +                                     */
/*            PGM(XXX/RGZDTAQC) +                                    */
/*            SRCFILE(XXX/QCMDSRC) +                                 */
/*            TEXT('データキューの再編成') +                         */
/*            ALLOW(*ALL)                                            */
/*                                                                   */
/*********************************************************************/
CMD 'データキューの再編成'

   PARM DTAQ Q1 MIN(1) PROMPT('DATA QUEUE')
Q1: +
      QUAL *NAME 10 MIN(1)
      QUAL *NAME 10 DFT(*LIBL) SPCVAL((*LIBL)) PROMPT('LIBRARY')

   PARM PROMPT *CHAR 4 RSTD(*YES) DFT(*NO) VALUES(*YES *NO) +
        PROMPT('PROMPT FOR CRTDTAQ COMMAND')

   PARM AUT *NAME 10 DFT(*LIBCRTAUT) SPCVAL((*LIBCRTAUT) (*CHANGE) +
        (*ALL) (*USE) (*EXCLUDE)) PROMPT('AUTHORITY')

/*********************************************************************/
/*                                                                   */
/*    CRTCLPGM  PGM(XXX/RGZDTAQC) +                                  */
/*              SRCFILE(XXX/QCLSRC) +                                */
/*              TEXT('RGZDTAQ COMMAND')                              */
/*                                                                   */
/*********************************************************************/

PGM (&QDTAQ &PROMPT &AUT)

   DCL &AUT        *CHAR   10
   DCL &CMD        *CHAR  500
   DCL &DTAQ       *CHAR   10
   DCL &DTAQLIB    *CHAR   10
   DCL &FORCE      *CHAR    4
   DCL &KEYLEN     *DEC     3
   DCL &KEYLEN_C   *CHAR    3
   DCL &MAXLEN     *DEC     5
   DCL &MAXLEN_C   *CHAR    5
   DCL &PROMPT     *CHAR    4
   DCL &QDTAQ      *CHAR   20
   DCL &SENDERID   *CHAR    4
   DCL &SEQ        *CHAR    6
   DCL &TEXT       *CHAR   50
   DCL &TEXT_P     *CHAR   52

   CHGVAR &DTAQ    %SST(&QDTAQ  1 10)
   CHGVAR &DTAQLIB %SST(&QDTAQ 11 10)

   CHKOBJ &DTAQLIB/&DTAQ *DTAQ

   IF (&AUT *NE '*LIBCRTAUT' *AND +
       &AUT *NE '*CHANGE'    *AND +
       &AUT *NE '*ALL'       *AND +
       &AUT *NE '*USE'       *AND +
       &AUT *NE '*EXCLUDE'        ) DO
      CHKOBJ &AUT *AUTL
   ENDDO

   /* データキューの属性取得 */
   RTVDTAQD &DTAQLIB/&DTAQ MAXLEN(&MAXLEN) SEQ(&SEQ) KEYLEN(&KEYLEN) +
            TEXT(&TEXT) FORCE(&FORCE) SENDERID(&SENDERID)

   CHGVAR     VAR(&TEXT_P)  VALUE('''' *CAT &TEXT *CAT '''')

   CHGVAR &MAXLEN_C &MAXLEN
   CHGVAR &KEYLEN_C &KEYLEN

　 /* CRTDTAQの組み立て */
   CHGVAR &CMD ('CRTDTAQ DTAQ('               *CAT +
                &DTAQLIB *TCAT '/' *CAT &DTAQ *TCAT +
                ') MAXLEN('                   *CAT +
                &MAXLEN_C                     *CAT +
                ') SEQ('                      *CAT +
                &SEQ                          *TCAT +
                ') TEXT('                     *CAT +
                &TEXT_P                       *TCAT +
                ') FORCE('                    *CAT +
                &FORCE                        *TCAT +
                ') SENDERID('                 *CAT +
                &SENDERID                     *TCAT +
                ') AUT('                      *CAT +
                &AUT                          *TCAT +
                ')')

   IF (&KEYLEN *GT 0) DO
      CHGVAR &CMD (&CMD *BCAT 'KEYLEN(' *CAT &KEYLEN_C *CAT ')')
   ENDDO

   IF (&PROMPT *EQ '*YES') DO
      CHGVAR &CMD ('?' *BCAT &CMD)
   ENDDO

   CALL QCMDCHK (&CMD 500)
   MONMSG CPF6801 EXEC(GOTO END)

   /* DELETE AND RE-CREATE DATA QUEUE */
   ALCOBJ ((&DTAQLIB/&DTAQ *DTAQ *EXCL)) WAIT(0)
   MONMSG CPF0000 EXEC(DO)
      SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
                MSGDTA('再編成できませんでした。') +
                MSGTYPE(*ESCAPE)
   ENDDO

   DLTDTAQ &DTAQLIB/&DTAQ

   DLCOBJ ((&DTAQLIB/&DTAQ *DTAQ *EXCL))
   MONMSG CPF0000

   CALL QCMDEXC (&CMD 500)

   SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
             MSGDTA('再編成完了！') +
             MSGTYPE(*COMP)

END:
ENDPGM

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

/*********************************************************************/

/* */

/* CRTCMD CMD(XXX/RGZDTAQ) + */

/* PGM(XXX/RGZDTAQC) + */

/* SRCFILE(XXX/QCMDSRC) + */

/* TEXT('データキューの再編成') + */

/* ALLOW(*ALL) */

/* */

/*********************************************************************/

CMD 'データキューの再編成'

PARM DTAQ Q1 MIN(1) PROMPT('DATA QUEUE')

Q1: +

QUAL *NAME 10 MIN(1)

QUAL *NAME 10 DFT(*LIBL) SPCVAL((*LIBL)) PROMPT('LIBRARY')

PARM PROMPT *CHAR 4 RSTD(*YES) DFT(*NO) VALUES(*YES *NO) +

PROMPT('PROMPT FOR CRTDTAQ COMMAND')

PARM AUT *NAME 10 DFT(*LIBCRTAUT) SPCVAL((*LIBCRTAUT) (*CHANGE) +

(*ALL) (*USE) (*EXCLUDE)) PROMPT('AUTHORITY')

/*********************************************************************/

/* */

/* CRTCLPGM PGM(XXX/RGZDTAQC) + */

/* SRCFILE(XXX/QCLSRC) + */

/* TEXT('RGZDTAQ COMMAND') */

/* */

/*********************************************************************/

PGM (&QDTAQ &PROMPT &AUT)

DCL &AUT *CHAR 10

DCL &CMD *CHAR 500

DCL &DTAQ *CHAR 10

DCL &DTAQLIB *CHAR 10

DCL &FORCE *CHAR 4

DCL &KEYLEN *DEC 3

DCL &KEYLEN_C *CHAR 3

DCL &MAXLEN *DEC 5

DCL &MAXLEN_C *CHAR 5

DCL &PROMPT *CHAR 4

DCL &QDTAQ *CHAR 20

DCL &SENDERID *CHAR 4

DCL &SEQ *CHAR 6

DCL &TEXT *CHAR 50

DCL &TEXT_P *CHAR 52

CHGVAR &DTAQ %SST(&QDTAQ 1 10)

CHGVAR &DTAQLIB %SST(&QDTAQ 11 10)

CHKOBJ &DTAQLIB/&DTAQ *DTAQ

IF (&AUT *NE '*LIBCRTAUT' *AND +

&AUT *NE '*CHANGE' *AND +

&AUT *NE '*ALL' *AND +

&AUT *NE '*USE' *AND +

&AUT *NE '*EXCLUDE' ) DO

CHKOBJ &AUT *AUTL

ENDDO

/* データキューの属性取得 */

RTVDTAQD &DTAQLIB/&DTAQ MAXLEN(&MAXLEN) SEQ(&SEQ) KEYLEN(&KEYLEN) +

TEXT(&TEXT) FORCE(&FORCE) SENDERID(&SENDERID)

CHGVAR VAR(&TEXT_P) VALUE('''' *CAT &TEXT *CAT '''')

CHGVAR &MAXLEN_C &MAXLEN

CHGVAR &KEYLEN_C &KEYLEN

　 /* CRTDTAQの組み立て */

CHGVAR &CMD ('CRTDTAQ DTAQ(' *CAT +

&DTAQLIB *TCAT '/' *CAT &DTAQ *TCAT +

') MAXLEN(' *CAT +

&MAXLEN_C *CAT +

') SEQ(' *CAT +

&SEQ *TCAT +

') TEXT(' *CAT +

&TEXT_P *TCAT +

') FORCE(' *CAT +

&FORCE *TCAT +

') SENDERID(' *CAT +

&SENDERID *TCAT +

') AUT(' *CAT +

&AUT *TCAT +

')')

IF (&KEYLEN *GT 0) DO

CHGVAR &CMD (&CMD *BCAT 'KEYLEN(' *CAT &KEYLEN_C *CAT ')')

ENDDO

IF (&PROMPT *EQ '*YES') DO

CHGVAR &CMD ('?' *BCAT &CMD)

ENDDO

CALL QCMDCHK (&CMD 500)

MONMSG CPF6801 EXEC(GOTO END)

/* DELETE AND RE-CREATE DATA QUEUE */

ALCOBJ ((&DTAQLIB/&DTAQ *DTAQ *EXCL)) WAIT(0)

MONMSG CPF0000 EXEC(DO)

SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +

MSGDTA('再編成できませんでした。') +

MSGTYPE(*ESCAPE)

ENDDO

DLTDTAQ &DTAQLIB/&DTAQ

DLCOBJ ((&DTAQLIB/&DTAQ *DTAQ *EXCL))

MONMSG CPF0000

CALL QCMDEXC (&CMD 500)

SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +

MSGDTA('再編成完了！') +

MSGTYPE(*COMP)

END:

ENDPGM

データキューの属性取得を行います。

/*********************************************************************/
/*                                                                   */
/*    CRTCMD  CMD(XXX/RTVDTAQD) +                                    */
/*            PGM(XXX/RTVDTAQDC) +                                   */
/*            SRCFILE(XXX/QCMDSRC) +                                 */
/*            TEXT('データキューの属性取得') +                       */
/*            ALLOW(*IPGM *BPGM *IMOD *BMOD)                         */
/*                                                                   */
/*********************************************************************/
CMD   PROMPT('RETRIEVE DTAQ DESCRIPTION')
   PARM DTAQ Q1 MIN(1) PROMPT('DATA QUEUE')
Q1: +
      QUAL *NAME 10 MIN(1)
      QUAL *NAME 10 DFT(*LIBL) SPCVAL((*LIBL) (*CURLIB)) +
                      PROMPT('LIBRARY')
   PARM MAXLEN *DEC 5 RTNVAL(*YES) PROMPT('MAXIMUM ENTRY LENGTH (5 0)')
   PARM SEQ *CHAR 6 RTNVAL(*YES) PROMPT('SEQUENCE (6)')
   PARM KEYLEN *DEC 3 RTNVAL(*YES) PROMPT('KEY LENGTH (3 0)')
   PARM TEXT *CHAR 50 RTNVAL(*YES) PROMPT('TEXT ''DESCRIPTION'' (50)')
   PARM FORCE *CHAR 4 RTNVAL(*YES) +
        PROMPT('FORCE TO AUXILIARY STORAGE (4)')
   PARM SENDERID *CHAR 4 RTNVAL(*YES) PROMPT('INCLUDE SENDER ID (4)')

/*********************************************************************/
/*                                                                   */
/*    CRTCLPGM  PGM(XXX/RTVDTAQDC) +                                 */
/*              SRCFILE(XXX/QCLSRC) +                                */
/*              TEXT('RTVDTAQD COMMAND')                             */
/*                                                                   */
/*********************************************************************/
PGM (&QDTAQ &MAXLEN &SEQ &KEYLEN &TEXT &FORCE &SENDERID)

   DCL &DTAQ          *CHAR   10
   DCL &DTAQLIB       *CHAR   10
   DCL &FORCE         *CHAR    4
   DCL &FORCE_X       *CHAR    4
   DCL &KEYLEN        *DEC     3
   DCL &KEYLEN_X      *DEC     3
   DCL &MAXLEN        *DEC     5
   DCL &MAXLEN_X      *DEC     5
   DCL &QDTAQ         *CHAR   20
   DCL &SENDERID      *CHAR    4
   DCL &SENDERID_X    *CHAR    4
   DCL &SEQ           *CHAR    6
   DCL &SEQ_X         *CHAR    6
   DCL &STRUCT        *CHAR   69  /* DATA STRUCTURE */
   DCL    &BYTRTN     *CHAR    4  /* BINARY */
   DCL    &BYTAVL     *CHAR    4  /* BINARY */
   DCL    &MAXL       *CHAR    4  /* BINARY */
   DCL    &KEYL       *CHAR    4  /* BINARY */
   DCL    &SEQ1       *CHAR    1
   DCL    &SND1       *CHAR    1
   DCL    &FORCE1     *CHAR    1
   DCL    &TEXT50     *CHAR   50
   DCL &STRUCT_LEN    *CHAR    4  /* BINARY */
   DCL &TEXT          *CHAR   50
   DCL &TEXT_X        *CHAR   50

   CHGVAR &DTAQ    %SST(&QDTAQ  1 10)
   CHGVAR &DTAQLIB %SST(&QDTAQ 11 10)

   CHKOBJ &DTAQLIB/&DTAQ *DTAQ

   CHGVAR %BIN(&STRUCT_LEN) 69

   CALL QMHQRDQD (&STRUCT &STRUCT_LEN 'RDQD0100' &QDTAQ)

   CHGVAR  &BYTRTN         %SST(&STRUCT  1  4)
   CHGVAR  &BYTAVL         %SST(&STRUCT  5  4)
   CHGVAR  &MAXL           %SST(&STRUCT  9  4)
   CHGVAR  &KEYL           %SST(&STRUCT 13  4)
   CHGVAR  &SEQ1           %SST(&STRUCT 17  1)
   CHGVAR  &SND1           %SST(&STRUCT 18  1)
   CHGVAR  &FORCE1         %SST(&STRUCT 19  1)
   CHGVAR  &TEXT50         %SST(&STRUCT 20 50)

   IF (&SEQ1 *EQ 'F') +
      CHGVAR &SEQ_X '*FIFO'
   ELSE IF (&SEQ1 *EQ 'L') +
      CHGVAR &SEQ_X '*LIFO'
   ELSE +
      CHGVAR &SEQ_X '*KEYED'
   CHGVAR &SEQ &SEQ_X
   MONMSG MCH3601

   CHGVAR &MAXLEN_X %BIN(&MAXL)
   CHGVAR &MAXLEN   &MAXLEN_X
   MONMSG MCH3601

   CHGVAR &KEYLEN_X %BIN(&KEYL)
   CHGVAR &KEYLEN   &KEYLEN_X
   MONMSG MCH3601

   IF (&SND1 *EQ 'Y') +
      CHGVAR &SENDERID_X '*YES'
   ELSE +
      CHGVAR &SENDERID_X '*NO'
   CHGVAR &SENDERID &SENDERID_X
   MONMSG MCH3601

   IF (&FORCE1 *EQ 'Y') +
      CHGVAR &FORCE_X '*YES'
   ELSE +
      CHGVAR &FORCE_X '*NO'
   CHGVAR &FORCE &FORCE_X
   MONMSG MCH3601

   CHGVAR &TEXT_X &TEXT50
   CHGVAR &TEXT   &TEXT_X
   MONMSG MCH3601

ENDPGM

100

101

102

103

104

105

106

107

108

109

110

111

112

/*********************************************************************/

/* */

/* CRTCMD CMD(XXX/RTVDTAQD) + */

/* PGM(XXX/RTVDTAQDC) + */

/* SRCFILE(XXX/QCMDSRC) + */

/* TEXT('データキューの属性取得') + */

/* ALLOW(*IPGM *BPGM *IMOD *BMOD) */

/* */

/*********************************************************************/

CMD PROMPT('RETRIEVE DTAQ DESCRIPTION')

PARM DTAQ Q1 MIN(1) PROMPT('DATA QUEUE')

Q1: +

QUAL *NAME 10 MIN(1)

QUAL *NAME 10 DFT(*LIBL) SPCVAL((*LIBL) (*CURLIB)) +

PROMPT('LIBRARY')

PARM MAXLEN *DEC 5 RTNVAL(*YES) PROMPT('MAXIMUM ENTRY LENGTH (5 0)')

PARM SEQ *CHAR 6 RTNVAL(*YES) PROMPT('SEQUENCE (6)')

PARM KEYLEN *DEC 3 RTNVAL(*YES) PROMPT('KEY LENGTH (3 0)')

PARM TEXT *CHAR 50 RTNVAL(*YES) PROMPT('TEXT ''DESCRIPTION'' (50)')

PARM FORCE *CHAR 4 RTNVAL(*YES) +

PROMPT('FORCE TO AUXILIARY STORAGE (4)')

PARM SENDERID *CHAR 4 RTNVAL(*YES) PROMPT('INCLUDE SENDER ID (4)')

/*********************************************************************/

/* */

/* CRTCLPGM PGM(XXX/RTVDTAQDC) + */

/* SRCFILE(XXX/QCLSRC) + */

/* TEXT('RTVDTAQD COMMAND') */

/* */

/*********************************************************************/

PGM (&QDTAQ &MAXLEN &SEQ &KEYLEN &TEXT &FORCE &SENDERID)

DCL &DTAQ *CHAR 10

DCL &DTAQLIB *CHAR 10

DCL &FORCE *CHAR 4

DCL &FORCE_X *CHAR 4

DCL &KEYLEN *DEC 3

DCL &KEYLEN_X *DEC 3

DCL &MAXLEN *DEC 5

DCL &MAXLEN_X *DEC 5

DCL &QDTAQ *CHAR 20

DCL &SENDERID *CHAR 4

DCL &SENDERID_X *CHAR 4

DCL &SEQ *CHAR 6

DCL &SEQ_X *CHAR 6

DCL &STRUCT *CHAR 69 /* DATA STRUCTURE */

DCL &BYTRTN *CHAR 4 /* BINARY */

DCL &BYTAVL *CHAR 4 /* BINARY */

DCL &MAXL *CHAR 4 /* BINARY */

DCL &KEYL *CHAR 4 /* BINARY */

DCL &SEQ1 *CHAR 1

DCL &SND1 *CHAR 1

DCL &FORCE1 *CHAR 1

DCL &TEXT50 *CHAR 50

DCL &STRUCT_LEN *CHAR 4 /* BINARY */

DCL &TEXT *CHAR 50

DCL &TEXT_X *CHAR 50

CHGVAR &DTAQ %SST(&QDTAQ 1 10)

CHGVAR &DTAQLIB %SST(&QDTAQ 11 10)

CHKOBJ &DTAQLIB/&DTAQ *DTAQ

CHGVAR %BIN(&STRUCT_LEN) 69

CALL QMHQRDQD (&STRUCT &STRUCT_LEN 'RDQD0100' &QDTAQ)

CHGVAR &BYTRTN %SST(&STRUCT 1 4)

CHGVAR &BYTAVL %SST(&STRUCT 5 4)

CHGVAR &MAXL %SST(&STRUCT 9 4)

CHGVAR &KEYL %SST(&STRUCT 13 4)

CHGVAR &SEQ1 %SST(&STRUCT 17 1)

CHGVAR &SND1 %SST(&STRUCT 18 1)

CHGVAR &FORCE1 %SST(&STRUCT 19 1)

CHGVAR &TEXT50 %SST(&STRUCT 20 50)

IF (&SEQ1 *EQ 'F') +

CHGVAR &SEQ_X '*FIFO'

ELSE IF (&SEQ1 *EQ 'L') +

CHGVAR &SEQ_X '*LIFO'

ELSE +

CHGVAR &SEQ_X '*KEYED'

CHGVAR &SEQ &SEQ_X

MONMSG MCH3601

CHGVAR &MAXLEN_X %BIN(&MAXL)

CHGVAR &MAXLEN &MAXLEN_X

MONMSG MCH3601

CHGVAR &KEYLEN_X %BIN(&KEYL)

CHGVAR &KEYLEN &KEYLEN_X

MONMSG MCH3601

IF (&SND1 *EQ 'Y') +

CHGVAR &SENDERID_X '*YES'

ELSE +

CHGVAR &SENDERID_X '*NO'

CHGVAR &SENDERID &SENDERID_X

MONMSG MCH3601

IF (&FORCE1 *EQ 'Y') +

CHGVAR &FORCE_X '*YES'

ELSE +

CHGVAR &FORCE_X '*NO'

CHGVAR &FORCE &FORCE_X

MONMSG MCH3601

CHGVAR &TEXT_X &TEXT50

CHGVAR &TEXT &TEXT_X

MONMSG MCH3601

ENDPGM

古い記事へ新しい記事へ