|
midrange.com
You do not need the CL. You can call the msg api's directly from RPG.
See Below (this is very old code):
D*****************************************************************
D** DATA STRUCTURE VARIABLES USED BY SEND/RETRIEVE MESSAGE API ***
D*****************************************************************
D QMHGEN DS
D QMHFIL 1 20 INZ('IBNKMSGF *LIBL ')
D QMHLEN 21 24B 0 INZ(240)
D QMHTYP 25 34 INZ('*INFO ')
D QMHPGQ 35 44 INZ('*EXT ')
D QMHSTK 45 48B 0 INZ(0)
D QMHKEY 49 52 INZ(' ')
D QMHRMV 53 62 INZ('*ALL ')
D QMHM2S 63 69 INZ('CPF9999')
D QMHMDT 70 309 INZ(' ')
D QMHFMT 310 317 INZ('RTVM0100')
D QMHMID 318 324 INZ('CPI0C09')
D QMHDTA 325 524 INZ(' ')
D QMHMDL 525 528B 0 INZ(200)
D QMHRPL 529 538 INZ('*YES ')
D QMHCTL 539 548 INZ('*YES ')
*
D QMHERR DS
D QMHEBA 1 4B 0 INZ(256)
D QMHEBR 5 8B 0 INZ(0)
D QMHEMI 9 15
D QMHRSV 16 16
D QMHEMD 17 256
*
D QMHRTV DS
D QMHDBR 1 4B 0 INZ(0)
D QMHDBA 5 8B 0 INZ(0)
D QMHL1R 9 12B 0 INZ(0)
D QMHL1A 13 16B 0 INZ(0)
D QMHL2R 17 20B 0 INZ(0)
D QMHL2A 21 24B 0 INZ(0)
D QMHMSG 53 240 INZ(' ')
D*****************************************************************
D* QUSEMD (240A) Error message data *
D*****************************************************************
D QUSGEN DS
D QUSRV2 1 180 INZ(' ')
D QUSODT 101 150
D QUSRVL 181 184B 0 INZ(180)
D QUSIFN 185 192 INZ('OBJD0200')
D QUSONL 193 212 INZ(' *LIBL ')
D QUSOTR 213 222 INZ('*FILE ')
D*****************************************************************
D QUSERR DS
D QUSEBA 1 4B 0 INZ(256)
D QUSEBR 5 8B 0 INZ(0)
D QUSEMI 9 15
D QUSRSV 16 16
D QUSEMD 17 256
*****************************************************************
* DATASTRUCTURES FOR MULTI_MESSAGE DATA *
*---------------------------------------------------------------*
* These is the standard Messagehandling datastructure. *
D*****************************************************************
D MSG001 DS
D MSGF01 1 40
D MSGF02 41 80
D MSGF03 81 120
D MSGF04 121 160
D MSGF05 161 200
D MSGF06 201 240
Routines to execute the calls
***************************************************************
* SUBR : R10 : Put message in the messagequeue. *
*****************************************************************
C R10 BEGSR
*
* Field Initializations if not already done
*----------------------------------------------------------------
C QMHPGQ IFEQ *BLANK
*
C MOVEL(P) $PGMN QMHPGQ
C CLEAR QMHM2S
C CLEAR QMHEMI
C CLEAR QMHRSV
C CLEAR QMHMDT
C CLEAR QMHSTK
*
C ENDIF
*----------------------------------------------------------------
C CALL 'QMHSNDPM' $LSNDM 04
*
C ENDSR
*
*****************************************************************
* SUBR : R11 : Delete messages from messagequeue. *
*****************************************************************
C R11 BEGSR
*
* RESET error parameters.
*
C RESET QMHKEY
C RESET QMHEBA
C RESET QMHEBR
*
C CALL 'QMHRMVPM' $LRMVM 04
*
* Definition section.
*----------------------------------------------------------------
* PARAMETERLIST FOR REMOVE MESSAGE
*----------------------------------------------------------------
C $LRMVM PLIST
REMOVE MESSAGE
C PARM QMHPGQ
MESSAGE QUEUE
C PARM QMHSTK CALL
STCK COUNT
C PARM QMHKEY MSG
KEY
C PARM QMHRMV MSG
2 REMOVE
C PARM QMHERR
ERROR CODE
*
* PARAMETERLIST FOR SEND MESSAGE
*----------------------------------------------------------------
C $LSNDM PLIST SEND
MESSAGE
C PARM QMHM2S MSG
IDENTIFIER
C PARM QMHFIL MSG
FILE
C PARM QMHMDT MSG
DATA
C PARM QMHLEN MSG
LENGTH
C PARM QMHTYP MSG
TYPE
C PARM QMHPGQ MSG
QUEUE
C PARM QMHSTK CALL
STCK COUNT
C PARM QMHKEY MSG
KEY
C PARM QMHERR
ERROR CODE
*----------------------------------------------------------------
C ENDSR
*****************************************************************
* SUBR : R12 : Send finishing message to previous PGM. *
*****************************************************************
C R12 BEGSR
*
C MOVEL(P) '*INFO ' QMHTYP
C MOVEL(P) '* ' QMHPGQ
C Z-ADD 2 QMHSTK
C EXSR R10
*
C ENDSR
Standard way to send a message (For a message without or with one variable)
C MOVEL(P) K@53 QMHMDT
C MOVEL 'APP0001' QMHM2S
C EXSR R10
And a multy variable message (all variables are standard 40 positions long).
C CLEAR MSG001
C MOVEL(P) K@52 MSGF01
C MOVEL(P) K@52F MSGF02
C MOVEL(P) MSG001 QMHMDT
C MOVE 'GEN0002' QMHM2S
C EXSR R10
Cheers,
Eduard.
"Beeson, Terry" <Terry.Beeson@xxxxxxxxxxxxxxxxx> wrote:
Thanks Marco. I'll give it a go.
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]On Behalf Of Marco Facchinetti
Sent: 16 November 2004 12:29
To: RPG programming on the AS400 / iSeries
Subject: Re: Message Subfiles
This is something that I copy from a looong time:
A R SFLMSG SFL
A*%%TS SD 20000602 095106 METAILE REL-V4R4M0
5769-PW1
A TEXT('MSG PGM')
A SFLMSGRCD(24)
A MSGKEYW SFLMSGKEY
A PROGRAM SFLPGMQ(10)
A R SFLMSGC SFLCTL(SFLMSG)
A OVERLAY
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N33
AON33 SFLEND
A SFLSIZ(0010)
A SFLPAG(0001)
A PROGRAM SFLPGMQ
and this is the cl part:
(PGM MSNDMSG)
PGM PARM(&MSG &MSGF)
DCL VAR(&MSG) TYPE(*CHAR) LEN(7) /* Msgkey */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /* Msg file */
SNDPGMMSG MSGID(&MSG) MSGF(&MSGF)
MONMSG MSGID(CPF0000)
endpgm
(PGM MRMVMSG)
PGM
RMVMSG PGMQ(*PRV) MSGQ(*PGMQ) CLEAR(*ALL)
MONMSG MSGID(CPF0000)
ENDPGM
and the rpg calling part:
dMrmvmsg PR
dMsndmsg PR
d 7 const
d 10
d filemsg s 10 inz('MSGFNAME')
dutility sds
d program *proc
....
a typical use:
c write sflmsgc
c exfmt ad0000d
c callp mrmvmsg
...
c callp msndmsg('ATT0002':FILEMSG)
Don't like procedures? use CALL and PARM.
HTH
Marco
--- "Beeson, Terry" wrote:
> Hi All
>
> What is the best (and easiest?) method to display
> multiple messages at the bottom of a screen?
>
> If anyone has got some sample code they are willing to
> share - I would be most grateful.
>
> Thanks and regards,,
> Terry
>
__________________________________
Do you Yahoo!?
The all-new My Yahoo! - Get yours free!
http://my.yahoo.com
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
