Reputation: 153
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.
Upvotes: 2
Views: 4034
Reputation: 11473
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.
Upvotes: 2