How to find the physical file path of the current FUSER of a Natural runtime

Here’s a short subroutine for reading the physical file path of the current FUSER of a Natural (from Software AG) runtime. I’m not sure if it works on a mainframe, but it definitely runs on a Linux system.

The subroutine returns the following information, if it runs successfully:

P-FUSER-PATH /home/macke/fuser
P-RC 0

Otherwise the return code P-RC will have a value other than zero.

It uses two user exits:

• USR6006N: Get path to system file
• USR2013N: Get SYSPROF information

USR2013N reads the information about the current FUSER and returns its DB-ID and File Number. And USR6006L takes these two inputs and returns the physical file path of the FUSER.

Subroutine GET-CURRENT-FUSER-PATH

**************************************************************************
*
*  File: GET-CURRENT-FUSER-PATH (VNGFUPAT)
*
*  Reads the physical file path for the current FUSER.
*
*  Tags: FUSER, UserExit
*
*  Parameters:
*    -
*
*  Returns:
*    P-FUSER-PATH - File path for the current FUSER.
*    P-RC - Return code
*
**************************************************************************
DEFINE DATA
*
PARAMETER
*
01 P-RC (I4) BY VALUE RESULT
01 P-FUSER-PATH (A) DYNAMIC BY VALUE RESULT
*
LOCAL
*
* Get path to system file
01 USR6006L
  02 INPUTS
    03 SYSF-DBID (I4)
    03 SYSF-FNR (I4)
  02 OUTPUTS
    03 SYSF-PATH (A253)
    03 RESPONSE-CODE (I4)
    03 INFOTEXT (A65)
01 EXTENSIONS (A1/1:1)
*
* Get SYSPROF information
01 USR2013L
  02 OUTPUTS
    03 FILENAME (A12/1:50)
    03 DBID (P5/1:50)
    03 FNR (P5/1:50)
    03 DBNAME (A11/1:50)
    03 AMOUNT (P4)
*
01 #INDEX (I4)
*
01 #FUSER-DBID (N8)
01 #FUSER-FNR (N8)
*
END-DEFINE
*
DEFINE SUBROUTINE GET-CURRENT-FUSER-PATH
*
RESET P-FUSER-PATH P-RC USR6006L USR2013L EXTENSIONS(*) #FUSER-DBID #FUSER-FNR
*
CALLNAT 'USR2013N'  USR2013L
*
FOR #INDEX = 1 TO USR2013L.AMOUNT
  IF USR2013L.FILENAME(#INDEX) EQ 'FUSER'
    #FUSER-DBID := USR2013L.DBID(#INDEX)
    #FUSER-FNR  := USR2013L.FNR(#INDEX)
  END-IF
END-FOR
*
IF #FUSER-DBID EQ 0 OR #FUSER-FNR EQ 0
  P-RC := 1
  ESCAPE MODULE
END-IF
*
USR6006L.SYSF-DBID := #FUSER-DBID
USR6006L.SYSF-FNR  := #FUSER-FNR
*
CALLNAT 'USR6006N' USR6006L EXTENSIONS(*)
*
P-FUSER-PATH := USR6006L.SYSF-PATH
P-RC := USR6006L.RESPONSE-CODE
*
END-SUBROUTINE
*
END