ID #1135

データキューの再編成

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

 
/*********************************************************************/
/*                                                                   */
/*    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

タグ: -

関連エントリー: -

最終更新: 2011-12-03 18:31
製作者:
改訂: 1.1

Digg it! Share on Facebook このレコードを印刷する 友達に教える PDF ファイルで表示する
Propose a translation for Propose a translation for
この FAQ を評価してください:

評価点数: 0 (0 件の投票)

完全に役に立たない 1 2 3 4 5 最も価値がある

このエントリーにコメントできません。