QWVOLAGP API -- RPG400-L

Hello all,

Has anyone had any experience using the QWVOLAGP API to retrieve the root
program of the call. I have a service program that does some file I/O. But
I need to know which process invokes the service program. I created a
procedure using the API to return the root program. Sometime it works and
sometime it doesn't. I can't seem to find what is causing it to fail. When
it doesn't work, it returns some IBM system object names.

Here is the code:

     HOPTION(*NODEBUGIO:*SRCSTMT) NOMAIN bnddir('QC2LE')
?
F**********************************************************************************************
?    F*                   C O P Y R I G H T  -
*
?    F*                   Hanover Wire Cloth
*
?
F**********************************************************************************************
?    F*      DO NOT COPY OR DISTRIBUTE WITH OUT PERMISSION
*
?
F**********************************************************************************************
?    F*
*
?    F*      PROGRAM: getRootPgm
?    F*      PURPOSE: Retrieves the root program of the ActGroup of a job
?    F*       AUTHOR: Mark Walter
?    F*         DATE: 11/26/01
*
?
F**********************************************************************************************
?    F*               *** MODIFICATION LOG ***
*
?    F*  NAME/CO.                DATE    DESCRIPTION
*
?    F*  --------------------  --------
--------------------------------------------------------- *
?
F**********************************************************************************************
?    F*
*
?    F*
*
?    F*
*
?    F*
*
?
F**********************************************************************************************
?    F*               *** COMMAND KEY SUMMARY ***
*
?    F*  CF KEY       USAGE DESCRIPTION
*
?    F*  ------
----------------------------------------------------------------------------

*
?    F*
*
?    F*
*
?
F**********************************************************************************************
?    F*               *** INDICATOR SUMMARY ***
*
?    F*  IND          USAGE DESCRIPTION
*
?    F*  ---
-----------------------------------------------------------------------------*
?    F*
*
?    F*
*
?
F**********************************************************************************************
?    F*               *** SUBROUTINE SUMMARY ***
*
?    F*  NAME         PURPOSE
*
?    F*  --------
-----------------------------------------------------------------------------*
?    F*
*
?    F*
*
?
F**********************************************************************************************
?    F*               *** EXTERNAL PROGRAMS ***
*
?    F*  LIB/NAME              PURPOSE
*
?    F*  --------------------
--------------------------------------------------------------------*
?    F*
*
?    F*
*
?
F**********************************************************************************************

     DgetRootPgm       PR            10
     DcallSystem       PR            10i 0 EXTPROC('system')
     D cmdString                       *   VALUE OPTIONS(*string)


     PgetRootPgm       B                   EXPORT
     DgetRootPgm       PI            10

     DrcvVar           DS            64
     D rootPgm                37     46

     DrcvVarLen        S              9b 0 INZ(64)
     DlstInfo          S             80
     DnumRecs          S              9b 0 INZ(1)
     Dformat           S              8    INZ('RAGA0100')
     DjobName          S             26    INZ('*')
     DintID            S             16

     D APIERR          DS
     D  ERRPRV                 1      4B 0 INZ(67)
     D  ERRAVL                 5      8B 0
     D  ERRID                  9     15
     D  ERRPDT                17     67



?    C                   IF        callSystem('ADDLIBLE QGY') <> 0
     C                   RETURN    *blanks
?    C                   ENDIF
?
     C                   CALL      'QWVOLAGP'
     C                   PARM                    rcvVar
     C                   PARM                    rcvVarLen
     C                   PARM                    lstInfo
     C                   PARM                    numRecs
     C                   PARM                    format
     C                   PARM                    jobName
     C                   PARM                    intID
     C                   PARM                    aPIErr

     C                   CALLP     callSystem('RMVLIBLE QGY')

     C                   RETURN    rootPgm
     P                 E




Thanks,

Mark


Mark Walter
Sr. Programmer/Analyst
Hanover Wire Cloth a div of CCX, Inc.
mwalter@hanoverwire.com
http://www.hanoverwire.com
717.637.3795 Ext.3040