|
midrange.com
Instead of using an API, get it from the Program Status Data Structure.
Use either @PGMUsrPrf or @PGMUsrID. There is all kinds of info
available here, as you can see. There is more information in the RPG
manuals.
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords++++++++++++++++++++++++++
+++Comments++++++++++++
D @PGMDS SDS
D @PGMPEP *PROC
Program Entry Point
D @PGMSts *STATUS
Program Status Code
D @PGMPrvSts 16 20S 0
Previous Pgm Status
D @PGMStmt 21 28
Program Statement
D @PGMRtn *ROUTINE
Program Routine
D @PGMParms *PARMS
Number of Parameters
D @PGMMsgID 40 46
Error Message ID
D @PGMLib 81 90
Program Library
D @PGMMsgDTA 91 170
If *STATUS IS = 09999
D @PGMFileOp 175 184
File Op causing Err
D @PGMFileNm 201 208
File causing Error
D @PGMJobNm 244 253
/
D @PGMUsrID 254 263
| Qualified Job Name
D @PGMJobNbr 264 269S 0
\
D @PGMPgmNm 334 343
Program Name
D @PGMModNm 344 353
Module Name
D @PGMUsrPrf 358 367
Curr User Profile
-----Original Message-----
>date: Mon, 15 Nov 2004 19:52:02 -0600
>from: "D.W. Palme" <dpalme@xxxxxxxxxxxxxxxxxxxxx>
>subject: Newbie question - Getting the userid with RPGLE
>
>I am very new to RPG and I have been searching the net and
>experts-exchange in an attempt to figure out how to acquire the userid
>of the person signed in and running a program with RPG.
>
>I thought I could do it the same way as with a display file but that
>did not work..
>
>Would someone provide me a tiny bit of assistance here or at least
>point me in the right direction?
>
>Thanks,
>
>Douglas
>
------------------------------
message: 3
date: Wed, 17 Nov 2004 04:28:06 -0800 (PST)
from: Eduard Sluis <eduard@xxxxxxxxxxxxxxxxxxxxxxx>
subject: RE: Message Subfiles
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.
------------------------------
message: 4
date: Wed, 17 Nov 2004 14:24:33 +0100
from: Joep Beckeringh <joep@xxxxxxxxxxxxxxxxxxx>
subject: Re: Updating file via datastructure
Hi Tilo,
IIRC the field Record is added to the datastructure, thus making the
datastructure longer than the record. You should add OVERLAY(DSHISTRC)
to the
Record field.
Joep Beckeringh
Tilo von Brandis wrote:
> Hi
>
> I am trying to update a file using a datastructure because I want to
update
> 24 fields on the file as an array
>
> DDSHISTRC E DS EXTName(SHISTRCL1)
> D Record 406
> D RM 3P 0 OVERLAY(Record:72) DIM(24)
> D*
>
> When I try to update the file using the following command:
>
> UPDATE RISREC DSHISTRC;
>
> the compiler gives the following error message:
>
> *RNF7701 20 The data structure is not allowed for the operation.
>
> What am I doing wrong?
>
> Tilo von Brandis
> Manager: IT
> Safair (PTY) Ltd
> Work : +27 11 928 0043
> Cell : +27 83 675 7778
------------------------------
message: 5
date: Wed, 17 Nov 2004 15:36:12 +0200
from: Tilo von Brandis <tvonbrandis@xxxxxxxxxxxx>
subject: RE: Updating file via datastructure
Hi Joep
Thanks for you reply.
I tried your suggestion and the compiler stoped with the same error.
I changed the code to
> DDSHISTRC E DS EXTName(SHISTRCL1)
> D RM 3P 0 OVERLAY(DSHISTRC:72) DIM(24)
and it still gave the same problem.
According to the manual this should not be a problem.
Thanks
Tilo
-----Original Message-----
From: Joep Beckeringh [mailto:joep@xxxxxxxxxxxxxxxxxxx]
Sent: 17 November 2004 15:25
To: RPG programming on the AS400 / iSeries
Subject: Re: Updating file via datastructure
Hi Tilo,
IIRC the field Record is added to the datastructure, thus making the
datastructure longer than the record. You should add OVERLAY(DSHISTRC)
to
the
Record field.
Joep Beckeringh
Tilo von Brandis wrote:
> Hi
>
> I am trying to update a file using a datastructure because I want to
update
> 24 fields on the file as an array
>
> D*
>
> When I try to update the file using the following command:
>
> UPDATE RISREC DSHISTRC;
>
> the compiler gives the following error message:
>
> *RNF7701 20 The data structure is not allowed for the operation.
>
> What am I doing wrong?
>
> Tilo von Brandis
> Manager: IT
> Safair (PTY) Ltd
> Work : +27 11 928 0043
> Cell : +27 83 675 7778
--
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.
------------------------------
message: 6
date: Wed, 17 Nov 2004 08:12:49 -0600
from: Mel Rothman <mel@xxxxxxxxxxxxxx>
subject: Re: Updating file via datastructure
In addition to the previous suggestion about defining the array as
overlaying
the data structure:
1) Using a data structure for UPDATE with an externally described file
was not
supported by the language until V5R3M0.
2) It also requires that the data structure be defined with
EXTNAME(...:*INPUT)
or LIKEREC(...:*INPUT). If the parameter where *INPUT would be
specified is
missing, the compiler defaults to *INPUT, so that probably is not your
problem.
I hope this helps.
Mel Rothman
Mel Rothman, Inc.
Tilo von Brandis wrote:
>
> Hi Joep
>
> Thanks for you reply.
>
> I tried your suggestion and the compiler stoped with the same error.
> I changed the code to
>
>
>>DDSHISTRC E DS EXTName(SHISTRCL1)
>>D RM 3P 0 OVERLAY(DSHISTRC:72) DIM(24)
>
>
> and it still gave the same problem.
>
> According to the manual this should not be a problem.
>
> Thanks
>
> Tilo
>
>
> -----Original Message-----
> From: Joep Beckeringh [mailto:joep@xxxxxxxxxxxxxxxxxxx]
> Sent: 17 November 2004 15:25
> To: RPG programming on the AS400 / iSeries
> Subject: Re: Updating file via datastructure
>
> Hi Tilo,
>
> IIRC the field Record is added to the datastructure, thus making the
> datastructure longer than the record. You should add OVERLAY(DSHISTRC)
to
> the
> Record field.
>
> Joep Beckeringh
>
>
> Tilo von Brandis wrote:
>
>>Hi
>>
>>I am trying to update a file using a datastructure because I want to
>
> update
>
>>24 fields on the file as an array
>>
>>D*
>>
>>When I try to update the file using the following command:
>>
>> UPDATE RISREC DSHISTRC;
>>
>>the compiler gives the following error message:
>>
>>*RNF7701 20 The data structure is not allowed for the operation.
>>
>>What am I doing wrong?
>>
>>Tilo von Brandis
>>Manager: IT
>>Safair (PTY) Ltd
>>Work : +27 11 928 0043
>>Cell : +27 83 675 7778
>
------------------------------
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) digest
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.
End of RPG400-L Digest, Vol 3, Issue 935
****************************************
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
