Clear data queues -- easily

I recently saw someone writing a program to read all of the data queue entries to clear a data queue -- using QRCVDTAQ API. With a very large data queue, you can just imagine how long it would take to clear because your program has to read each and every entry of the data queue. In fact, it will consume a lot of resources since you are calling an API so many times. This problem can be solved in a simple way bay calling a singe API just once. QCLRDTAQ API is supplied by IBM. By using it, you can delete all entries in a data queue or some specified entries if the data queue is a keyed one. For this I've written a utility, the code is included.
Command Source: 
 

/*==================================================================*/
/* ^Creation Details                                               EUR*/
/*==================================================================*/
/* 'Command Name   :EURCLRDTAQ     EUR                                  */
/* 'Author         :EURNaveen Dronavalli                             EUR*/
/* 'Date           :EUR08 April 2003                                 EUR*/
/* 'Description    :EURThis Command basically use QCLRDTAQ API to    EUR*/
/*                   clear all the data from the specified queue orEUR*/
/*                   clears messages that match the key specified  EUR*/
/*                   for a keyed data queue.                       EUR*/
/*==================================================================*/
/* ^Revision History                                               EUR*/
/*==================================================================*/
/* 'Request Number :                                               EUR*/
/* 'Date           :                                               EUR*/
/* 'Description    :                                               EUR*/
/*                                                                  */
/*==================================================================*/
             CMD        PROMPT('Clear Data Queue')

             PARM       KWD(DATAQ) TYPE(QUAL1) MIN(1) PROMPT('Data +
                          Queue Name')

             PARM       KWD(KEY) TYPE(*CHAR) LEN(10) RSTD(*YES) +
                          DFT(*NONKEYED) VALUES(*NONKEYED *KEYED) +
                          MIN(0) PROMPT('Process Mode')

             PARM       KWD(KEYODR) TYPE(*CHAR) LEN(2) RSTD(*YES) +
                          VALUES(GT LT NE EQ GE LE) MIN(0) +
                          PMTCTL(P1) PROMPT('Key Order')

             PARM       KWD(KEYLEN) TYPE(*DEC) LEN(3) RANGE(0 256) +
                          MIN(0) PMTCTL(P1) PROMPT('Key Length')

             PARM       KWD(KEYDTA) TYPE(*CHAR) LEN(256) MIN(0) +
                          PMTCTL(P1) PROMPT('Key Data')

 QUAL1:      QUAL       TYPE(*NAME) LEN(10) MIN(1)
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
                          SPCVAL((*LIBL)) PROMPT('Library Name')

 P1:         PMTCTL     CTL(KEY) COND((*EQ *KEYED))

CLLE Source:
============================
/*==================================================================*/
/* ^Creation Details                                               EUR*/
/*==================================================================*/
/* 'Program Name   :EURCLRDTAQ     EUR                                  */
/* 'Author         :EURNaveen Dronavalli                             EUR*/
/* 'Date           :EUR09 April 2003                                 EUR*/
/* 'Description    :EURThis is Command Processing Program for commandEUR*/
/*                   CLRDTAQ, basically it deletes the entries in  EUR*/
/*                   any type of data queue (Keyed or Non-Keyed).  EUR*/
/*==================================================================*/
/* ^Revision History                                               EUR*/
/*==================================================================*/
/* 'Request Number :                                               EUR*/
/* 'Date           :                                               EUR*/
/* 'Description    :                                               EUR*/
/*                                                                  */
/*==================================================================*/

             PGM        PARM(&NAMLI &DQTYP &KYODR &KYLEN &KYDTA)

/* 'Variable Declaration                                           EUR*/

             DCL        VAR(&NAMLI) TYPE(*CHAR) LEN(20)
             DCL        VAR(&DQNAM) TYPE(*CHAR) LEN(10)
             DCL        VAR(&DQLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&DQTYP) TYPE(*CHAR) LEN(04)
             DCL        VAR(&KYODR) TYPE(*CHAR) LEN(02)
             DCL        VAR(&KYLEN) TYPE(*DEC) LEN(3 0)
             DCL        VAR(&KYDTA) TYPE(*CHAR) LEN(256)
             DCL        VAR(&ERCOD) TYPE(*CHAR) LEN(256)
             DCL        VAR(&MSGTXT) TYPE(*CHAR) LEN(1024)
             DCL        VAR(&MSGLEN) TYPE(*DEC) LEN(5 0)
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(50)
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(007)
             DCL        VAR(&MSGFIL) TYPE(*CHAR) LEN(010)
             DCL        VAR(&MSGLIB) TYPE(*CHAR) LEN(010)
             DCL        VAR(&ERRCOD) TYPE(*CHAR) LEN(016)
             DCL        VAR(&MSGHDG) TYPE(*CHAR) LEN(020) +
                          VALUE(':Message Description')

             CHGVAR     VAR(&DQNAM) VALUE(%SST(&NAMLI 1 10))
             CHGVAR     VAR(&DQLIB) VALUE(%SST(&NAMLI 11 10))
/* 'Call QCLRDTAQ API to clear the data queue entries              EUR*/

             CALL       PGM(QCLRDTAQ) PARM(&DQNAM &DQLIB &KYODR +
                          &KYLEN &KYDTA &ERCOD)

/* 'If any error occurred intimate the user                        EUR*/

             IF         COND(&ERCOD *NE *BLANKS) THEN(DO)

/*' Form the Message data                                         EUR */

             CHGVAR     VAR(&MSGID) VALUE(%SST(&ERCOD 9 7))
             CHGVAR     VAR(&MSGFIL) VALUE('QCPFMSG')
             CHGVAR     VAR(&MSGLIB) VALUE('QSYS')
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&ERCOD 17 50))

/* 'Retrieve the message information                                */

             RTVMSG     MSGID(&MSGID) MSGF(&MSGLIB/&MSGFIL) +
                          MSGDTA(&MSGDTA) SECLVL(&MSGTXT)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(END))

/* 'Call DSPWMSG Procedure to display message in a window          EUR*/

             CALLPRC    PRC(DSPWMSG) PARM(&MSGTXT &MSGID &MSGHDG +
                          &ERRCOD) RTNVAL(&ERRCOD)

             ENDDO

 END:        ENDPGM

RPGLE Source:
===========================
      *==================================================================
      * ^Creation Details
      *==================================================================
      * 'Program Name   :EURDSPWMSG
      * 'Author         :EURNaveen Dronavalli
      * 'Date           :EUR09 April 2003
      * 'Description    :EURThis Progarm will use QUILNGTX API to display
      *                   the errors occurred during the process.
      *==================================================================
      * ^Revision History
      *==================================================================
      * 'Request Number :EUR
      * 'Date           :EUR
      * 'Description    :EUR
      *
      *==================================================================
      * ^Header Specification Section
      *==================================================================
     H  CopyRight('Exel Logistics')
     H  DeBug(*No)
      *==================================================================
      * ^Declaration section
      *==================================================================
      *'Procedure Prototype
      *
     DMsgWindow        Pr                  ExtPgm('QUILNGTX')
     D  MsgTxt                     1024a
     D  TxtLen                       10i 0 Const
     D  Tittle                        7a
     D  Headng                       20a
     D  Errcod                       16a
      *
     '*'Define Entry Parameters
      *
     D WuMsgTxt        s           1024a
     D   MsgTxt        s           1024a   Inz(*Blanks)
     D WuTittle        s              7a
     D WuHeadng        s             20a
     D WuErrcod        s             16a
     D WuMsg1          s            512a
     D WuMsg2          s            512a
     D WuMsgLen        s              5s 0
     D WuPos           s              5s 0
      *=====================================================================
      *'Main line of the Program
      *=====================================================================
     '* Entry Parameters
     C     *Entry        Plist
     C                   Parm                    WuMsgTxt
     C                   Parm                    WuTittle
     C                   Parm                    WuHeadng
     C                   Parm                    WuErrcod
     '* Call Procedure to display the error message
     C                   If        WuMsgTxt  <> *Blanks
     C                   Eval      WuMsgLen  =  %Len(WuMsgTxt)
     C     '&N Recovery' Scan      WuMsgTxt      WuPos
     '* Remove &N from the Message
     C                   If        WuPos  > *Zero
     C                   Eval      WuMsg1 = %Subst(WuMsgTxt:1:WuPos-1)
     C                   Eval      WuMsg2 = %Subst(WuMsgTxt:WuPos + 3:
+
     C                                             WuMsgLen - WuPos - 2)
     C                   Eval      WuMsgTxt = *Blanks
     C                   Eval      WuMsgTxt = WuMsg1 + WuMsg2
     C                   EndIf
     '*
     C                   Eval      WuMsgLen =  %Len(WuMsgTxt)
     C                   Eval      MsgTxt   =  %Subst(WuMsgTxt:4:WuMsgLen-3)
     C                   Eval      WuErrCod =  *Blanks
     '* Call the procedure to display the long message text
     C                   CallP     MsgWindow(MsgTxt         :
     C                                       %Len(MsgTxt)   :
     C                                       WuTittle       :
     C                                       WuHeadng       :
     C                                       WuErrcod)
     '*
     C                   EndIf
     C                   Return

This was first published in June 2003

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.

Back to top