SDS - System Name ?

[gcraill]

Learned RPGers,

Is it possible to use the SDS to return the system name that a program was called on ?

Sorta like this ...

      * 
      *  program information 
      * 
     d PgmInfo        SDS 
     d  @PgmName               1     10 
     d  @Parms                37     39  0 
     d  @MsgID                40     46 
     d  @JobName             244    253 
     d  @UserId              254    263 
     d  @JobNbr              264    269  0 
     [B][COLOR="Blue"]d  @SysNam              xxx    yyy [/COLOR][/B]
      *

Google searches so far have not found an example, nor did infocenter ?

Cheers
GC

[jamief]

Re: SDS - System Name ?

from that as400pro site where they got it is anyones guess

Retrieving System Name with an API

Sure, I know a way in RPG IV... :)   
Of course, its not nearly as simple as calling the CL RTVNETA command, 
it actually involves calling an API. But, if you wanted to make a service 
program, you could make it just as easy to use as the CL command...

The API you need to use is called QWCRNETA and its documented in the
Work Management API manual.  

As an example, I created a subprocedure (designed to be easily made into 
a service program) that illustrates using this API to get the system name. 
Hope you find it useful.  Here it is:

 ** Note:  To do this right, we should put this prototype into
 *              a /COPY member.  (but will work okay as-is)

D RtvSysName      PR            10I 0
D   SystemName                   8A


C                   if        RtvSysName(MyName) < 0
c                   eval      Msg = 'RtvSysName ended in error!'
c                   dsply                   Msg              50
c                   else
c                   dsply                   MyName            8
c                   endif

c                   eval      *inlr = *on


 ** Note: If we wanted to do this right, the code below should
 *         be seperated into a service program (but will work
 *         okay as-is)

 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 *  Retrieve System Name procedure:   RtvSysName
 *
 *    Parm:    SysName = name of system returned.
 *
 *   Returns:  0 = Success
 *             negative value if an error occurred.  See below
 *             for a list of possible negative values.
 *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P RtvSysName      B                   Export
D RtvSysName      PI            10I 0
D   SysName                      8A

D QWCRNETA        PR                  ExtPgm('QWCRNETA')
D   RcvVar                   32766A   OPTIONS(*VARSIZE)
D   RcvVarLen                   10I 0 const
D   NbrNetAtr                   10I 0 const
D   AttrNames                   10A   const
D   ErrorCode                  256A

D* Error code structure
D EC              DS
D*                                    Bytes Provided (size of struct)
D  EC_BytesP              1      4B 0 INZ(256)
D*                                    Bytes Available (returned by API)
D  EC_BytesA              5      8B 0 INZ(0)
D*                                    Msg ID of Error Msg Returned
D  EC_MsgID               9     15
D*                                    Reserved
D  EC_Reserve            16     16
D*                                    Msg Data of Error Msg Returned
D  EC_MsgDta             17    256

D* Receiver variable for QWCRNETA with only one attribute
D RV              ds
D*                                    Number of Attrs returned
D   RV_Attrs                    10I 0
D*                                    Offset to first attribute
D   RV_Offset                   10I 0
D*                                    Add'l data returned.
D   RV_Data                      1A   DIM(1000)

D* Network attribute structure
D p_NA            S               *
D NA              ds                  based(p_NA)
D*                                    Attribute Name
D   NA_Attr                     10A
D*                                    Type of Data.  C=Char, B=Binary
D   NA_Type                      1A
D*                                    Status. L=Locked, Blank=Normal
D   NA_Status                    1A
D*                                    Length of Data
D   NA_Length                   10I 0
D*                                    Actual Data (in character)
D   NA_DataChr                1000A
D*                                    Actual Data (in binary)
D   NA_DataInt                  10I 0 overlay(NA_DataChr:1)


C* Call API to get system name
C*   -1 = API returned an error
C                   callp     QWCRNETA(RV: %size(RV): 1: 'SYSNAME': EC)
c                   if        EC_BytesA > 0
c                   return    -1
c                   endif

C*   -2 = RcvVar contained data that we
C*        dont understand :(
c                   if        RV_Attrs <> 1
c                               or RV_Offset < 8
c                               or RV_Offset > 1000
c                   return    -2
c                   endif

C*   Attach NetAttr structure
c                   eval      RV_Offset = RV_Offset - 7
c                   eval      p_NA = %addr(RV_Data(RV_Offset))

C*   -3 = NetAttr structure had data
C*        that we don't understand :(
c                   if        NA_Attr <> 'SYSNAME'
c                               or NA_Length < 1
c                               or NA_Length > 8
c                   return    -3
c                   endif

C*   -4 = Network attributes are locked
c                   if        NA_Status = 'L'
c                   return    -4
c                   endif

C*   Ahhh... we got it!
c                   eval      SysName = %subst(NA_DataChr:1:NA_Length)
c                   return    0
P                 E

[kitvb1]

Re: SDS - System Name ?

ufff ... jamie jumped in before me again...
Greg, you can also use the cl command rtvneta & retrieve the sysname value.

@jamie: in the book i'm reading the author writes: 'Dogs are wonderful, you can tell them anything and they won't love you any less'

[gcraill]

Re: SDS - System Name ?

Thx Jamie,

One day I might even be able to understand that example

? - What is the PI tag for as compared to the PR tag ?

I've done the CL thing for now, but of course that means I have 2 pgm objects instead of 1.

GC

[B.Hauser]

Re: SDS - System Name ?

Hi,

the PI-"Datastructure" replaces the *ENTRY PLIST.
the PR-"Datastructure" must be an exact match of the PI-"DataStructure" and must be embedded in every source where the Program or source will be called by CALLP.

In this way parameters can be checked at compile time and different parameter definitions (between PR and the CALLP-Statement) will cause a compile error.

Birgitta

[GlennGG]

The program status data structure was enhanced in 7.3 to include the system name char(8) from position 396 to 403.

[Barbara Morris]

They were new 2 new PSDS subfields added in 7.4, and also added by PTFs in 7.2 and 7.3. The PTFs are for the RPG runtime, so the enhancement works for program running on the machine, independent of the target release. You just have to define the subfield to pick up the enhancement.

• Internal job ID, in positions 380 to 395
• System name, in positions 396 - 403

Here's the RPG Cafe article that gives the PTFs: https://www.ibm.com/support/pages/node/1107699