About cookies on this site Our websites require some cookies to function properly (required). In addition, other cookies may be used with your consent to analyze site usage, improve the user experience and for advertising. For more information, please review your options. By visiting our website, you agree to our processing of information as described in IBM’sprivacy statement. To provide a smooth navigation, your cookie preferences will be shared across the IBM web domains listed here.
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":
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)
[{"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
More support for:
IBM i
Component:
Programming ILE Languages
Software version:
All Versions
Operating system(s):
IBM i
Document number:
637391
Modified date:
26 November 2024
UID
nas8N1014858
Manage My Notification Subscriptions
