Home > AS/400 Tips > iSeries programmer tips > Clear data queues -- easily
iSeries 400 Tips:
EMAIL THIS
 TIPS & NEWSLETTERS TOPICS 

ISERIES PROGRAMMER TIPS

Clear data queues -- easily


Naveen Dronavalli
06.19.2003
Rating: -2.89- (out of 5)


Digg This!    StumbleUpon Toolbar StumbleUpon    Bookmark with Delicious Del.icio.us   


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.

Code

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

Rate this Tip
To rate tips, you must be a member of Search400.com.
Register now to start rating these tips. Log in if you are already a member.




Digg This!    StumbleUpon Toolbar StumbleUpon    Bookmark with Delicious Del.icio.us   



RELATED CONTENT
iSeries CL programming
A power-handling CL program for multiple IBM i servers
Taking advantage of CL advancements, starting with V5R3
Checking in on your IBM i authorization lists
Running PHP open source applications: NOBODY needs authority
Simplify the process of converting a spool file from iSeries into an Excel spreadsheet
CL program for daily backups
An automated CL method of moving a query from AS/400 to Excel
Changing user password expiration
Eight steps for creating program documentation using AS/400 utilities
DAYSPAST CLLE program for AS/400: Compares object creation date with today's date

iSeries programmer tips
A power-handling CL program for multiple IBM i servers
Enhancing RPG with external SQL stored procedures
Tracking data changes on IBM i with triggers
Introduction to SQLRPGLE on IBM i: Making a report
Implementing a browser interface in COBOL: Displaying database fields
Taking advantage of CL advancements, starting with V5R3
TAATOOL: Useful tools for programmers on IBM i
Implementing a browser interface in COBOL: Creating your graphic Web page
Implementing a browser interface in COBOL: Getting started
Making the most of RPG data handling on IBM i

Application Development
iSeries calling an .exe
Top 10 programmer tips
Formatted work job scheduler
Convert system date and time
Mixing free format code with embedded SQL
SQL update a field in one file from a field in another file
Webcasts for iSeries programmers
Programming advice from the pros
Easy code copying via the drag and drop method
Setting FTP time-outs

RELATED RESOURCES
2020software.com, trial software downloads for accounting software, ERP software, CRM software and business software systems
Search Bitpipe.com for the latest white papers and business webcasts
Whatis.com, the online computer dictionary

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.



iSeries Security - Security Tools, Physical Security and System Security
HomeNewsTopicsITKnowledge ExchangeTipsBlogsAsk the ExpertsMultimediaWhite PapersProducts
About Us  |  Contact Us  |  For Advertisers  |  For Business Partners  |  Site Index  |  RSS
SEARCH 
TechTarget provides technology professionals with the information they need to perform their jobs - from developing strategy, to making cost-effective purchase decisions and managing their organizations' technology projects - with its network of technology-specific websites, events and online magazines.

TechTarget Corporate Web Site  |  Media Kits  |  Site Map




All Rights Reserved, Copyright 1999 - 2009, TechTarget | Read our Privacy Policy 		  TechTarget - The IT Media ROI Experts