Troubleshooting
Problem
This document provides an example of an ILE RPG program that calls a CL program that runs the SNDPGMMSG command.
Resolving The Problem
Following is an example of an ILE RPG program "SNDPGMMSG"calling CL program "TESTCL".
ILE RPG Program "SNDPGMMSG":
DDS for the Display File "TESTDSP":
CL Program "TESTCL":
ILE RPG Program "SNDPGMMSG":
H DATEDIT(*YMD) DEBUG(*YES)
FTESTDSP CF E WORKSTN INFDS(DSPFDS)
*
D Clear_Msg PR
D Send_Msg PR
*
D PGM_N s 10a
D #MSGF s 10a
D #MSGID s 7a
D #MSGDT s 132a
D #MSGTP s 10a
D #ACTON s 8a
*
* PROGRAM INFORMATION
D SDS
D PGM_NAME *PROC
D JOB_NAME 244 253
D USER 254 263
*
*DISPLAY FILE INFORMATION
D DSPFDS DS
D CMD_KEY 369 369
D LOW_RRN 378 379B 0
*
*** MISC FLAGS
D Return_Value DS 1
D Valid_Proc 1n overlay(Return_Value)
*
D NO C CONST('N')
D YES C CONST('Y')
D TRUE C CONST('1')
D FALSE C CONST('0')
D Error_Select C CONST('Invalid Selection')
*
*** MISC FLAGS
D CONFIRM C CONST('Message has been sent')
*
*** COMMAND KEYS
D F3 C CONST(X'33')
D F12 C CONST(X'3C')
D F16 C CONST(X'B4')
D ENTER C CONST(X'F1')
D DONE S 1a
*
/free
Clear_Msg();
/end-free
*
C DONE DOUEQ YES
C WRITE CMDTEST
C WRITE MSGCTL
C EXFMT TEST
/free
Clear_Msg();
/end-free
*
C SELECT
C CMD_KEY WHENEQ F3
C MOVE YES DONE
*
C CMD_KEY WHENEQ F12
C MOVE YES DONE
*
C CMD_KEY WHENEQ ENTER
C MOVEL 'MSG0001' #MSGID
C MOVEL(P) CONFIRM #MSGDT
/free
Send_Msg();
/end-free
c endsl
c enddo
c seton lr
*****************************************************************
* Clear_Msg - clear message subfile **
*****************************************************************
P Clear_Msg B Export
D Clear_Msg PI
*
* Call CL program to clear program message queue
C MOVEL *BLANKS SCPGMQ
C MOVEL '*' SCPGMQ
C CALL 'TESTCL'
C PARM 'CWCMSGF' #MSGF
C PARM #MSGID
C PARM #MSGDT
C PARM #MSGTP
C PARM 'CLRMSG' #ACTON
C PARM 'CLEAR_MSG' PGM_N
*
* Reset message data and message type
C MOVEL *BLANKS #MSGID
c MOVEL *BLANKS #MSGDT
C MOVEL '*DIAG ' #MSGTP
P Clear_Msg E
*****************************************************************
* Send_Msg - send message subfile **
*****************************************************************
P Send_Msg B Export
D Send_Msg PI
*
* Call CL program to send the message to the program message que
C CALL 'TESTCL'
C PARM 'CWCMSGF' #MSGF
C PARM #MSGID
C PARM #MSGDT
C PARM #MSGTP
C PARM 'SNDMSG' #ACTON
C PARM 'SEND_MSG' PGM_N
*
* Reset message data and message type
C MOVEL *BLANKS #MSGID
C MOVEL *BLANKS #MSGDT
C MOVEL '*DIAG ' #MSGTP
P Send_Msg E
Note that compilation failure message:
RNF3788 - DFTACTGRP(*NO) must be specified for a prototype that does not have the EXTPGM keyword.
...requires adding "DFTACTGRP(*NO)" to the compile command.
DDS for the Display File "TESTDSP":
A DSPSIZ(24 80 *DS3)
A R TEST
A CF03
A CF12
A CF16
A OVERLAY
A 9 14'TO GET TODAYS DATE'
A 10 14'PLEASE HIT ENTER'
A R CMDTEST
A OVERLAY
A 23 3'F3=Exit'
A COLOR(BLU)
A 23 12'F12=Previous'
A COLOR(BLU)
A 23 26'F16=Confirm'
A COLOR(BLU)
A R MSGSFL SFL
A SFLMSGRCD(24)
A SCMSGK SFLMSGKEY
A SCPGMQ SFLPGMQ(10)
A R MSGCTL SFLCTL(MSGSFL)
A RTNCSRLOC(&@@RCD &@@FLD)
A CSRLOC(@@ROW @@COL)
A OVERLAY
A PUTOVR
A SFLDSP
A SFLINZ
A N03 SFLEND
A SFLSIZ(0002)
A SFLPAG(0001)
A @@COL 3S 0H
A @@ROW 3S 0H
A @@FLD 10A H
A @@RCD 10A H
A SCPGMQ SFLPGMQ(10)
CL Program "TESTCL":
PGM PARM(&MSGF &MSGID &MSGDTA &MSGTYP &ACTION +
&PGMN)
DCL VAR(&PGMN) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
DCL VAR(&MSGTYP) TYPE(*CHAR) LEN(10)
DCL VAR(&ACTION) TYPE(*CHAR) LEN(8)
DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
/* CHECK MESSAGE ACTION */
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
IF COND(&ACTION *EQ 'CLRMSG') THEN(GOTO +
CMDLBL(CLRMSG))
IF COND(&ACTION *EQ 'SNDMSG') THEN(GOTO +
CMDLBL(SNDMSG))
/* CLEAR MESSAGE QUEUE */
CLRMSG: RMVMSG PGMQ(*PRV) CLEAR(*ALL)
GOTO CMDLBL(END)
/* SEND A MESSAGE */
SNDMSG: SNDPGMMSG MSG('TODAYS DATE IS' *CAT ' ' *CAT &DATE) +
TOPGMQ(*PRV (&PGMN *NONE))
GOTO CMDLBL(END)
END: ENDPGM
[{"Type":"MASTER","Line of Business":{"code":"LOB68","label":"Power HW"},"Business Unit":{"code":"BU070","label":"IBM Infrastructure"},"Product":{"code":"SWG60","label":"IBM i"},"ARM Category":[{"code":"a8m0z0000000CHtAAM","label":"Programming ILE Languages"}],"ARM Case Number":"","Platform":[{"code":"PF012","label":"IBM i"}],"Version":"All Versions"}]
Historical Number
421856573
Was this topic helpful?
Document Information
Modified date:
16 October 2025
UID
nas8N1014858