Read a message queue like a physical file

All of us know that we can read a Physical file WR to its RRN (Relative Record Number). But have you ever needed to replicate the same in case of message queues i.e. read a message queue in a similar manner.

I mean how about reading a message queue WR to the position of a message in it? Seems silly at very first thought… But it is possible.

This will be similar to reading a physical file WR to its RRN. It means that if a message queue contains 15 messages and you want to read say the 6th message (from the top) of that message queue, you can do it.

I have made a CL program RRNMSGQ to do this.

You'll need following to run this program:

 
1. MENU1 is a display file having DDS as shown below:

A               R MENU                                                  
A                                           CF03(03 'EXIT')             
A                                           CA05(05 'REFRESH')          
A                                       7  2'Enter the Message Number :'
A                                           COLOR(YLW) DSPATR(HI CS)    
A                 OPTION         2Y 0I    +2                            
A                                           DSPATR(MDT)                 
A                                      22  4'CF03=Exit'                 
A                                           COLOR(BLU)                  
A                                      22 15'CA05=Refresh'              
A                                           COLOR(BLU)      

2. The name of Message Queue having messages in it is NEW. It is having a number of messages in it. 

3. SYNGRAP is my current library. 

4. MYMESG is a Message file having the following message ids with the text as shown       below:

       I.) RAP0014 --  
            You typed message number as &1. Enter a value from 1-&2.
           
      II.) RAP0034 --   
             Only &1 messages in total in Message Queue NEW. Enter a value from 1-&1.


In the above two messages, data types of  variables &1 and &2 are as follows:

                  Field     Data Type     Length    
                   &1       *CHAR             2          
                   &2       *CHAR             2        

5. RRNMSGQ (CL Program)

             PGM
             DCLF       FILE(MENU1)
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)
             DCL        VAR(&KEY) TYPE(*CHAR) LEN(4)
             DCL        VAR(&KEY1) TYPE(*CHAR) LEN(4)
             DCL        VAR(&A) TYPE(*DEC) LEN(2 0) VALUE(0)
             DCL        VAR(&B) TYPE(*CHAR) LEN(2) VALUE('0')
             DCL        VAR(&T) TYPE(*DEC) LEN(2 0)
             DCL        VAR(&ABC) TYPE(*CHAR) LEN(2)

             MONMSG     MSGID(CPF2410)

             RCVMSG     MSGQ(NEW) MSGTYPE(*FIRST) RMV(*NO) +
                          KEYVAR(&KEY)


/* Display Error message if Message Queue NEW is Empty */

             IF         COND(&KEY *EQ ' ') THEN(DO)
             SNDPGMMSG  MSG('Message Queue NEW is empty. Enter some +
                          messages in it & then Try again.') +
                          TOPGMQ(*EXT)
             /*      RMVMSG     PGMQ(*EXT) CLEAR(*ALL) */    
             GOTO       CMDLBL(ENDPGM)
             ENDDO

             CHGVAR     VAR(&T) VALUE(&T + 1)

 RCV:        RCVMSG     MSGQ(NEW) MSGTYPE(*NEXT) MSGKEY(&KEY) +
                          RMV(*NO) KEYVAR(&KEY1)
             IF         COND(&KEY1 *NE ' ') THEN(DO)
             CHGVAR     VAR(&T) VALUE(&T + 1)
             CHGVAR     VAR(&KEY) VALUE(&KEY1)
             GOTO       CMDLBL(RCV)
             ENDDO

             CHGVAR     VAR(&ABC) VALUE(&T)
             CHGVAR     VAR(&KEY) VALUE(' ')
             CHGVAR     VAR(&KEY1) VALUE(' ')

 BEGIN:      SNDRCVF    RCDFMT(MENU)
             CHGVAR     VAR(&A)  VALUE(0)





/* Quit the program, if F3 is pressed on MENU1 screen*/

             IF         COND(&IN03 *EQ '1') THEN(DO)
             GOTO       CMDLBL(ENDPGM)
             ENDDO


/* Refresh the MENU1 screen for input capable field "OPTION" + 
   if F5 is pressed on MENU1 screen */

             IF         COND(&IN05 *EQ '1') THEN(DO)
             CHGVAR     VAR(&OPTION) VALUE(0)
             CHGVAR     VAR(&IN05) VALUE('0')
             GOTO       CMDLBL(BEGIN)
             ENDDO

/* Display Error message if user enters 0(zero) in   +
the input capable field "OPTION" on MENU1 screen */

             IF         COND(&OPTION *EQ 0) THEN(DO)
             SNDPGMMSG  MSGID(RAP0014) MSGF(MYMESG) MSGDTA(&B *BCAT +
                          &ABC) TOPGMQ(*EXT)
          /*      RMVMSG     PGMQ(*EXT) CLEAR(*ALL) */    
             GOTO       CMDLBL(BEGIN)
             ENDDO

     
/* Display Error message if user enters a value in   +
the input capable field "OPTION" on MENU1 screen which exceeds +
the total number of messages in the message queue NEW. +
For example: Message queue NEW has 12 messages & user enters 14 +
in the "OPTION" field.*/

             IF         COND(&OPTION *GT &T) THEN(DO)
             SNDPGMMSG  MSGID(RAP0034) MSGF(SYNGRAP/MYMESG) +
                          MSGDTA(&ABC) TOPGMQ(*EXT)
             CHGVAR     VAR(&OPTION) VALUE(0)
            /*      RMVMSG     PGMQ(*EXT) CLEAR(*ALL) */    
             GOTO       CMDLBL(BEGIN)
             ENDDO

             ELSE       CMD(DO)
             RCVMSG     MSGQ(NEW) MSGTYPE(*FIRST) RMV(*NO) +
                          KEYVAR(&KEY) MSG(&MSG)
             CHGVAR     VAR(&A) VALUE(&A + 1)

 START:      IF         COND(&A *NE &OPTION) THEN(DO)
             RCVMSG     MSGQ(NEW) MSGTYPE(*NEXT) MSGKEY(&KEY) +
                          RMV(*NO) KEYVAR(&KEY1) MSG(&MSG)
             CHGVAR     VAR(&A) VALUE(&A + 1)
             CHGVAR     VAR(&KEY) VALUE(&KEY1)
             ENDDO

             ELSE       CMD(DO)
             SNDPGMMSG  MSG(&MSG) TOPGMQ(*EXT)
             GOTO       CMDLBL(BEGIN)
            /*      RMVMSG     PGMQ(*EXT) CLEAR(*ALL) */    
             ENDDO

             GOTO       CMDLBL(START)
             ENDDO

 ENDPGM:     ENDPGM


If you want to read 6th message (from top) of  message queue NEW, you'll 
have to follow these steps :

a. Call CL program RRNMSGQ from command line. This will show a          screen to you.

b.  Enter 6 in the 'Enter the Message Number :' field shown on this            screen and press 
  
    key. This will either show you the 6th  message (from top) of  the  message queue NEW
                                                  
OR 

An appropriate error message will be displayed (as described in CL   
program) giving you the information regarding the exact cause of              error.


As shown above, in CL program RRNMSGQ, appropriate error handling has been done & error messages have been explained with the help of comments.

Note:  If, every time you want to refresh the screen on which the messages will be displayed, just uncomment the statement
            /*  RMVMSG     PGMQ(*EXT) CLEAR(*ALL) */  
           at various places in the CL Program, compile the program again &   
           then run the program. 
  

==================================
MORE INFORMATION ON THIS TOPIC
==================================

The Best Web Links: tips, tutorials and more.

Ask your programming questions--or help out your peers by answering them--in our live discussion forums.

Ask the Experts yourself: Our application development gurus are waiting to answer your programming questions.

Search400's targeted search engine: Get relevant information on RPG.