I am attempting to wade into the pool of MVC for RPG ILE. So I have two modules VIEW, and MODEL, that are bound to my main program CNTRL. I validate information entered in my VIEW module with calls to the MODEL module, and then pass back to the View any errors. When I try to use the QHNSNDPM api, I see the error in the job log, followed by CALL STACK ENTRY NOT FOUND. I tried to find theVIEW module on the call stack, and it is not there. Not being super strong in DDS and the ILE, I am not sure how/what to do about this error. Any Suggestions would be greatly appreciated!
The DCL-F DISPLAY WORKSTN; is in the VIEW module.
And now for a little code from the VIEW Module....
dcl-pr SendMsg Extpgm('QMHSNDPM');
MsgID char(7) const;
MsgF char(20) const;
MsgData char(30) const;
MsgDataLen int(10) const;
MsgType char(10) const;
CallStackEnt char(10) const;
CallStackCtr int(10) const;
MsgKey char(4) const;
Error like(ErrorDS);
end-pr;
*******************************************************************
dcl-proc VIEW_SetError EXPORT;
dcl-pi *n;
Msg int(3);
MSGQ char(10);
end-pi ;
// The MSGQ parameter is from the PSDS *PROC
// I tried having this defined in the view where the DDS file
// is defined, and I have tried with it defined in the main CNTRL program
Dcl-s MsgTxt char(30);
if Msg=1;
MsgTxt='Invalid Facility';
AT1FAC=setAttr(*omit:'RI');
elseif Msg=2;
MsgTxt='Status must be O, C, or A!';
AT1STAT=setAttr(*omit:'RI');
elseif Msg=3;
MsgTxt='Invalid Order Number';
AT1ITEM=setAttr(*omit:'RI');
elseif Msg=4;
MsgTxt='Invalid Vendor Number';
AT1VEND=setAttr(*omit:'RI');
elseif Msg=5;
MsgTxt='Invalid Pallet Number';
AT1PLT=setAttr(*omit:'RI');
endif;
callp SendMsg (*blanks: *blanks :
MsgTxt : %size(MsgTxt):
'*INFO': '*':
0: *blanks: ErrorDS);
// I have tried setting the CallStackEnt to * and C
// And the CallStackCtr to 0,1,2
write msgctl;
end-proc ;
and the DDS for DISPLAY....
A DSPSIZ(24 80 *DS3)
A CHGINPDFT(UL FE)
A PRINT
A HELP
A ALTHELP(CA01)
A* ALTPAGEUP(CF07)
A* ALTPAGEDWN(CF08)
A CF03(03)
A CF04(04)
A CF06(06)
A CF12(12)
*------------------------------------------------------------------*
* Screen 1 - Filter Criteria
*------------------------------------------------------------------*
A R SCREEN1
A OVERLAY
A BLINK
A RTNCSRLOC(&REC1 &FLD1)
A CSRLOC(XROW1 XCOL1)
A XROW1 3S 0H
A XCOL1 3S 0H
A REC1 10A H
A FLD1 10A H
A 1 2'SCN200-01'
A COLOR(BLU)
A COMPANY 40A O 1 20DSPATR(HI)
A WSID 10A O 1 62
A 1 73DATE
A EDTCDE(Y)
A 2 2SYSNAME
A 2 23'Pallet Maintenance'
A COLOR(BLU)
A 2 62USER
A 2 73TIME
A 5 4'Enter Facility to Search'
A COLOR(BLU)
A 7 7'Facility:'
A DFAC1 2 B 7 21
A DSPATR(&AT1FAC)
A AT1FAC 1A P
A 7 24'+'
A 8 2'Pallet Status:'
A DSTAT 1 B 8 21
A DSPATR(&AT1STAT)
A AT1STAT 1A P
A 8 24'(O=Open, C=Closed, or A=All)'
A 10 4'Search by Item and/or Vendor:'
A COLOR(BLU)
A 11 11'Item:'
A DITM1 15A B 11 21
A DSPATR(&AT1ITEM)
A AT1ITEM 1A P
A 11 37'+ (Blank=All)'
A 12 9'Vendor:'
A DVND1 5S 0B 12 21
A DSPATR(&AT1VEND)
A AT1VEND 1A P
A 12 28'+ (Blank=All)'
A 15 7'Or By Pallet ID:'
A COLOR(BLU)
A 16 9'Pallet:'
A DPLT1 11A B 16 21
A DSPATR(&AT1PLT)
A AT1PLT 1A P
A 18 4'IF ALL SEARCH FIELDS LEFT BLANK, +
A ALL FACILITY RECORDS'
A COLOR(BLU)
A 19 6 'DISPLAYED IN PALLET ID ORDER.'
A COLOR(BLU)
A 23 2'F3=Exit'
A COLOR(BLU)
*------------------------------------------------------------------*
* Message Subfile
*------------------------------------------------------------------*
A R MSGRCD TEXT('MSG SFL RECORD')
A SFL SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMSGQ SFLPGMQ
*------------------------------------------------------------------*
* Message Subfile Control
*------------------------------------------------------------------*
A R MSGCTL TEXT('MSG SFL CONTROL')
A OVERLAY SFLCTL(MSGRCD) SFLSIZ(10)
A SFLPAG(1) SFLDSPCTL SFLDSP SFLINZ
A N98 SFLEND
A PGMSGQ SFLPGMQ
Here is the CL that starts the process....its pretty basic, but we use a lot of overrides in our legacy code, so I thought it would help to start with a CL...
PGM
DCL VAR(&COMPANY) TYPE(*CHAR) LEN(40) VALUE('BROWNFOX')
CALL PGM(CNTRL) PARM(&Company)
ENDPGM
By the way, the company bit is a relic to my testing. I have added the Company retrieval from the service program.
And the CNTRL RPGLE...
ctl-opt dftactgrp(*no) BNDDIR('MVC');
*------------------------------------------------------------------*
* Mainline processing
*------------------------------------------------------------------*
/define MODEL_PalletMaintenance
/copy TEMPLATE/QCPYSRC,MODEL
/undefine MODEL_PalletMaintenance
/define VIEW_GetParms
/copy TEMPLATE/QCPYSRC,VIEW
/undefine VIEW_GetParms
dcl-ds *N PSDS;
PGMSGQ *PROC;
WSID CHAR(10) Pos(244);
USER CHAR(10) Pos(254);
end-ds;
//dcl-s Exit ind;
//dcl-s ErrorField char(30);
dcl-s ErrorText char(30);
dcl-s ErrorID int(3);
//dcl-ds Screen1DS likeDS(Screen1);
dcl-s CurrentStep int(5);
dcl-c StepExit 0;
dcl-c StepPrep 1;
dcl-c StepShowScreen1 2;
dcl-c StepValidateScreen1 3;
//dcl-c StepShowScreen2 0;
dcl-pr cntrl EXTPGM ;
END-PR;
//dcl-PROC cntrl;
dcl-pi *n;
END-PI;
CurrentStep=StepPrep;
DoU CurrentStep=StepExit;
select;
When CurrentStep=StepPrep;
VIEW_Prep(Screen1DS);
MODEL_Prep(Screen1DS);
CurrentStep=StepShowScreen1;
When CurrentStep=StepShowScreen1;
if (VIEW_GetParms(Screen1DS));
CurrentStep=StepValidateScreen1;
else;
CurrentStep=StepExit;
ENDIF;
When CurrentStep=StepValidateScreen1;
ErrorID=MODEL_ValidateScreen1(Screen1DS);
if (ErrorID<>0);
VIEW_SetError(ErrorID:PGMSGQ);
CurrentStep=StepShowScreen1;
else;
CurrentStep=StepExit;
ENDIF;
ENDSL;
enddo;
*INLR=*on;
Return;
And I guess if I've taken it this far, I might as well throw in the copy members
MODEL Copy
/if defined(MODEL_PalletMaintenance)
dcl-ds Screen1DS qualified;
Company char(40);
Facility char(2);
Status char(1);
Item char(35);
Vendor zoned(5:0);
Pallet char(11);
END-DS;
DCL-PR MODEL_Prep;
*n likeds(Screen1DS);
END-PR;
DCL-PR MODEL_ValidateScreen1 int(3);
*n likeds(Screen1DS);
END-PR;
/endif
And View....
/if defined(VIEW_GetParms)
dcl-ds VScreen1DS qualified;
Company char(40);
Facility char(2);
Status char(1);
Item char(35);
Vendor zoned(5:0);
Pallet char(11);
END-DS;
DCL-PR VIEW_Prep;
*n likeds(VScreen1DS);
END-PR;
DCL-PR VIEW_GetParms Ind;
*n likeds(VScreen1DS);
END-PR;
DCL-PR screen1ResetIndicators;
END-PR;
DCL-PR ClearScreen1;
END-PR;
DCL-PR VIEW_SetError;
*n int(3);
*n char(10);
END-PR;
/endif
Troubleshoot QMHSNDPM: Before calling QMHRMVPM' and after calling QMHSNDPM look at the messages for the interactive job (system request 3 then option 10 then f10 then f18) if you don't see your message something is wrong with the program sending the message. If you do see the message press f1 with cursor on the message then press F9 to see where the message was delivered.
Probably you need a msgCallStack of 2 or 3 for your program or 4 or 5 if you want the message back at the command line.
I put in oldschool format to see the variable names.
call 'QMHSNDPM'
parm msgIdIN
parm msgLoc
parm msgRplDta
parm msgRplDtaLen
parm msgType
parm msgQueue
parm 3 msgCallStack
parm msgKey
parm msgErr
That should shoot the message up from a procedure in the model back to the view.
For MVC style program in rpg interactive you start with the view then call down to the model which shoots the message back up to the view. Maybe you have a controller that calls the view.