How to display messages from a message file on a display screen using RPGLE?

Question

I have designed a screen using SDA in AS/400 that takes an ID number as input and searches in two PFs for that ID and displays corresponding values fetched from those PFs in the respective fields on screen. Below is the DSPF code:

 A*%%TS  SD  20180813  084626  PATELDH     REL-V7R1M0  5770-WDS 
 A*%%EC                                                         
 A                                      DSPSIZ(24 80 *DS3)      
 A          R HEADER                                            
 A*%%TS  SD  20180802  075026  PATELDH     REL-V7R1M0  5770-WDS 
 A                                  2  2USER                    
 A                                  2 30'PRODUCT INQUIRY SCREEN'
 A                                      COLOR(WHT)              
 A                                  2 63DATE                    
 A                                      EDTCDE(Y)               
 A                                  3 63TIME                    
 A          R FOOTER                                            
 A*%%TS  SD  20180802  074433  PATELDH     REL-V7R1M0  5770-WDS 
 A                                      OVERLAY                 
 A                                 22  4'F3=EXIT'               
 A          R DETAIL                                            
 A*%%TS  SD  20180813  073420  PATELDH     REL-V7R1M0  5770-WDS 
 A                                      CA03(03 'EXIT')         
 A                                      CA12(12 'PREVIOUS')     
 A                                      OVERLAY                             
 A                                  7 16'ID:'                               
 A                                 10 16'NAME:'                             
 A                                 12 16'CATEGORY:'                         
 A            @ID       R        I  7 20REFFLD(CATEGORIES/ID AS400KT2/RCATE-
 A                                      GORY)                               
 A            @NAME     R        O 10 22REFFLD(PRODUCTS/NAME AS400KT2/RPROD-
 A                                      UCTS)                               
 A            @CATEGORY R        O 12 26REFFLD(CATEGORIES/CATEGORY AS400KT2-
 A                                      /RCATEGORY)                         
 A          R MSGSFL                    SFL                                 
 A*%%TS  SD  20180803  054959  PATELDH     REL-V7R1M0  5770-WDS             
 A                                      SFLMSGRCD(24)                       
 A            MSGKEY                    SFLMSGKEY                           
 A            MSGQ                      SFLPGMQ(10)                         
 A          R MSGCTL                    SFLCTL(MSGSFL)                      
 A*%%TS  SD  20180813  084626  PATELDH     REL-V7R1M0  5770-WDS             
 A                                      OVERLAY                             
 A                                      SFLDSP                              
 A                                      SFLDSPCTL   
 A                                      SFLINZ      
 A  01                                  SFLEND      
 A                                      SFLSIZ(0002)
 A                                      SFLPAG(0001)
 A            MSGQ                      SFLPGMQ(10) 

I have written a free format RPGLE code that makes this screen work. Below is the RPGLE code:

 FDSPPRD    CF   E             WorkStn                   
 FRPRODUCTS IF   E           K DISK                      
 FRCATEGORY IF   E           K DISK                      
 FRPRODCATEGO  A E           K DISK                      
 DtempID           S                   LIKE(ID)          
 DmsgID            S              7A                     
 DmsgF             S             10A                     
 D getMsg          PR                  EXTPGM('MSGSFLCL')
 D  msgID                         7A                     
 D  msgF                         10A                     
  /Free                                                  
     DoW *In03 = *Off;                                   
      Write HEADER;                                      
      Write FOOTER;                                      
      ExFmt DETAIL;                                      
      If @ID = *Zeros;                                   
          msgID = 'MSG0001';                             
          msgF = 'ASGNMSGF';                             
          getMsg(msgID:msgF);                            
      Else;                       
       Chain @ID RPRODUCTS;       
       If %Found(RPRODUCTS);      
          @NAME = NAME;           
          Chain ID RCATEGORY;     
          If %Found(RCATEGORY);   
             @CATEGORY = CATEGORY;
          EndIf;                  
       EndIf;                     
      EndIf;                      
     EndDo;                       
      *InLR = *On;                
  /End-Free                       

Below is the CL program called by RPGLE program to get the message text from the msgfile:

         PGM       PARM(&MSGID &MSGF)             
         DCL       VAR(&MSGID) TYPE(*CHAR) LEN(7) 
         DCL       VAR(&MSGF)  TYPE(*CHAR) LEN(10)

         SNDPGMMSG MSGID(&MSGID) MSGF(&MSGF)      
         ENDPGM                                   

Below are the two PFs from which the records are read:

RPRODUCTS-

 A          R PRODUCTS           
 A            ID             2P 0
 A            NAME          16A  
 A          K ID                 

RCATEGORY-

 A          R CATEGORIES         
 A            ID             2P 0
 A            CATEGORY      15A  
 A          K ID                 

All the above codes compile successfully. But the problem is that the msg from the msgf does not appear on the screen. Rest all works. Just the msg from msgf is not being displayed when I press 'Enter' key with a blank ID on screen. Can someone please suggest an information source from where I can learn the concepts of such applications. Also, a help with this one would be appreciated.

Answer 1

You are not writing the MSGCTL record. If you don't write that, then the message subfile will not be displayed. You are also not providing a value for MSGQ.

When using a message subfile, I generally get the program name out of the program status data structure, and put that into MSGQ during program initialization time. It should never change. I also pass that to my procedure that sends the message to the message queue. That way I know that both values will be the same. If they are not the messages will not display.

Here is my message subfile definition:

 A* ========================================================================
 A* Message Subfile
 A* ------------------------------------------------------------------------
 A          R MSGSFL                    SFL
 A                                      SFLMSGRCD(27)
 A            MSGKEY                    SFLMSGKEY
 A            PGMQ                      SFLPGMQ(10)
 A* ------------------------------------------------------------------------
 A* Message Subfile Control
 A* ------------------------------------------------------------------------
 A          R MSGCTL                    SFLCTL(MSGSFL)
 A                                      SFLPAG(1)
 A                                      SFLSIZ(2)
 A                                      SFLDSP SFLDSPCTL
 A                                      SFLINZ
 A  53
 AON53                                  SFLEND
 A            PGMQ                      SFLPGMQ(10)

There are only a few differences from yours. Lets go through them.

 A                                      SFLMSGRCD(27)

This is 27 because I am using the *DS4 screen size. Not an issue.

You are using OVERLAY, I'm not because I write that format first, but as long as you write MSGCTL after you write HEADER you should be good there.

You are using SFLCLR. That is unnecessary, remove it.

 A  53
 AON53                                  SFLEND

This is a bit different. I do this because SFLEND requires a conditioning indicator, but I really don't care, I want SFLEND active no matter what that indicator says. (I use *In53 as my SFLEND for regular subfiles too, and I don't want to have to worry whether it is on or off.

I use a sub-procedure to send the message: here is my code for that:

// ----------------------------------------
// SndDspfMsg - sends an *INFO message to the
//     message subfile in a display file.
//
// Parameters:
//  StackEntry - The program call stack entry to which the message is sent.
//               Usually the program name. This must be the same value that
//               is placed in the SFLPGMQ variable in the message subfile
//               control format.
//  MsgId - The Message ID from message file JCMSGF to be sent to the program
//               message Queue.
//  MsgDta - (optional) Data to be used by the message to provide dynamic
//               message content. Defaults to blank.
//  MsgDtaLen - (optional) The length of the message data provided above.
//               This parameter is required if MsgDta is provided. Defaults
//               to zero. If this is not provided or is zero, MsgDta is ignored.
// ----------------------------------------
dcl-proc SndDspfMsg Export;
  dcl-pi *n;
    StkEnt      Char(10)  Const;
    MsgId       Char(7)   Const;
    MsgDta      Char(512) Const Options(*VarSize: *NoPass);
    MsgDtaLen   Int(10)   Const Options(*NoPass);
  end-pi;

  dcl-s Name_t           Char(10) Template Inz('');

  // Call Stack Qualifier - used by message handling APIs
  dcl-ds CallStackQual_t  Qualified Template Inz;
    Module                Like(Name_t) Inz('*NONE');
    Program               Like(Name_t) Inz('*NONE');
  end-ds;

  // Qualified Name
  dcl-ds QualName_t       Qualified Template Inz;
    Name                  Like(Name_t) Inz('');
    User                  Like(Name_t) Inz('');
  end-ds;

  // Standard Error Code Format
  dcl-ds ErrorCdType1_t   Qualified Template Inz;
    BytesProv             Int(10)   Inz(%size(ErrorCdType1_t));
    BytesAvail            Int(10);
    MsgId                 Char(7);
    Data                  Char(1024) Pos(17);
  end-ds;

  dcl-ds MsgFile       LikeDs(QualName_t) Inz(*LikeDs);
  dcl-ds ErrorCd       LikeDs(ErrorCdType1_t) Inz(*LikeDs);

  dcl-s pmMsgDta         Char(512) Inz('');
  dcl-s pmMsgDtaLen      Int(10)   Inz(0);
  dcl-s pmMsgTyp         Char(10)  Inz('*INFO');
  dcl-s pmStkCnt         Int(10)   Inz(0);
  dcl-s pmMsgKey         Char(4)   Inz('');

  // Send Program Message
  dcl-pr qmhsndpm        ExtPgm('QMHSNDPM');
    MessageId            Char(7)    Const;
    MessageFile          LikeDs(QualName_t) Const;
    MessageDta           Char(512)  Const Options(*Varsize);
    MessageLen           Int(10)    Const;
    MessageType          Char(10)   Const;
    StackEntry           Char(4102) Const Options(*Varsize);
    StackCounter         Int(10)    Const;
    MessageKey           Char(4);
    Error                LikeDs(ErrorCdType1_t);
    StackEntryLen        Int(10)    Const Options(*NoPass);
    StackEntryQual       LikeDs(CallStackQual_t)
                                    Const Options(*NoPass);
    ScreenWaitTime       Int(10)    Const Options(*NoPass);
    StackEntryType       Char(10)   Const Options(*NoPass);
    Ccsid                Int(10)    Const Options(*NoPass);
  end-pr;      

  // Handle *NoPass Parms
  if %parms() >= %parmnum(MsgDtaLen);
    pmMsgDtaLen = MsgDtaLen;
  endif;

  // if Message Data is provided,
  if pmMsgDtaLen > 0;
    pmMsgDtaLen = min(%size(pmMsgDta): pmMsgDtaLen);
    pmMsgDta = %subst(MsgDta: 1: pmMsgDtaLen);
  endif;

  MsgFile.Name = 'JCMSGF';
  qmhsndpm(MsgId: MsgFile: pmMsgDta: pmMsgDtaLen:
           pmMsgTyp: StkEnt: pmStkCnt: pmMsgKey:
           ErrorCd);
end-proc;

This should get your message subfile working. As for why the other fields are not populating, maybe your product ID and category ID are not found in the file. Note, the product ID and category ID will be the same value when this program runs because ID is mapped to the display file, the product file, and the category file. This doesn't seem to be what you want. If you have trouble dealing with that, ask a new question.