× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



This is the routine I use.  Hope it helps.

Regards,

Gerry Tucker
Technicolor I.S.






Usage:

D/Copy ToolKitCpy,ApPgmH

 * Program name
D  PgmNam                       10

C                   Eval      PgmNam     = ApGetPgmNam( *Omit )



Source for member ApPgmH:


D ApGetPgmNam     Pr            10
D  DummyPrm                      1    Options( *Omit )



Source for member ApPgm:


'*=====================================================================

'* ApPgm      - Application Program Procedures
'*
'* Author:
'*    Gerry Tucker, February 2001
'*=====================================================================

H NoMain

/Copy ToolKitCpy,ApPgmH

P ApGetPgmNam     B                   Export
D ApGetPgmNam     Pi            10
D  DummyPrm                      1    Options( *Omit )

* Prototypes
D SndMsg          Pr                  ExtPgm( 'QMHSNDPM' )
D  MsgId                         7    Const
D  QlMsgfName                   20    Const
D  MsgDta                      256    Const
D                                     Options( *VarSize )
D  LenMsgDta                    10i 0 Const
D  MsgType                      10    Const
D  ClStkEntry                   10    Const
D  ClStkCtr                     10i 0 Const
D  MsgKey                        4
D  ApiErrDs                    272

D RcvMsg          Pr                  ExtPgm( 'QMHRCVPM' )
D  MsgDtaDs                    120
D  LenMsgIfn                    10i 0 Const
D  FmtName                       8    Const
D  ClStkEntry                   10    Const
D  ClStkCtr                     10i 0 Const
D  MsgType                      10    Const
D  MsgKey                        4    Const
D  WaitTime                     10i 0 Const
D  MsgAct                       10    Const
D  ApiErrDs                    272

* Local data
D MsgKey          S              4

D ApiErrDs        Ds
D  ApiErrSiz                    10i 0 Inz( 272 )
D  ApiErrLen                    10i 0
D  ApiErrId                      7
D                                1
D  ApiErrTxt                   256

D MsgDtaDs        Ds
D  MsgDtaSiz              1      4b 0
D  MsgDtaLen              5      8b 0 Inz( 120 )
D  MsgPgmNam            111    120

D TrgPgmNam       S             10
D CurPgmNam       S             10
D PgmNamChgs      S              1p 0
D ClStkCtr        S             10i 0

* Send a dummy message to the trigger
C                   CallP     SndMsg( 'CPF9898': 'QCPFMSG   QSYS':

C                                     ' ':       1:
C                                     '*INFO':   '*PGMBDY':
C                                     1:         MsgKey:
C                                     ApiErrDs )

* Receive the message back and pick up the trigger program name
C                   CallP     RcvMsg( MsgDtaDs:    %Size( MsgDtaDs ):

C                                     'RCVM0200':  '*':
C                                     *Zero:       '*INFO':
C                                     MsgKey:      0:
C                                     '*REMOVE':   ApiErrDs )

C                   Eval      TrgPgmNam  = MsgPgmNam

* Keep going backward in the call stack until the program name changes

* twice. The second change to the program name will be the name of

* the application which caused the trigger to fire.

C                   Eval      CurPgmNam  = TrgPgmNam
C                   Eval      PgmNamChgs = 0
C                   Eval      ClStkCtr   = 2
C                   DoU       PgmNamChgs = 2

C                   CallP     SndMsg( 'CPF9898': 'QCPFMSG   QSYS': ' ':

C                                     1: '*INFO': '*PGMBDY': ClStkCtr:

C                                     MsgKey: ApiErrDs )

C                   CallP     RcvMsg( MsgDtaDs: %Size( MsgDtaDs ):

C                                     'RCVM0200':  '*':
C                                     *Zero:       '*INFO':
C                                     MsgKey:      0:
C                                     '*REMOVE':   ApiErrDs )

C                   If        MsgPgmNam <> CurPgmNam
C                   Eval      CurPgmNam  = MsgPgmNam
C                   Eval      PgmNamChgs = PgmNamChgs + 1
C                   Else
C                   Eval      ClStkCtr   = ClStkCtr + 1
C                   EndIf

C                   EndDo

C                   Return    CurPgmNam

P ApGetPgmNam     E




-----Original Message-----
From: Joe Pluta [mailto:joepluta@PlutaBrothers.com]
Sent: 15 November 2001 17:14
To: midrange-l@midrange.com
Subject: RE: Getting the library name from a CL program


Mike, JT, the RTVOBJD won't work in my case because by definition I
don't
have a library list yet.  The reason I'm trying to find the library is
so
that I can add it into my library list!  I'll continue to think about
this.

Joe


> -----Original Message-----
> From: Mike.Collins@syan.co.uk
>
> You can send a message to the program and then receive it to get the
> program name (within the SENDER parameter on RCVMSG). IF you
> could make the
> assumption that the called program would be the first of that name in
your
> library list, you could then do a RTVOBJD on the said program name.

_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@midrange.com
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/cgi-bin/listinfo/midrange-l
or email: MIDRANGE-L-request@midrange.com
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.



As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.