Change Current Library

Summary

The following are the RPG/LE fully free-form definitions and instructions needed for using the Change Current Library service procedure. This service procedure simply allows the caller to change the Current Library setting of the library list for the active job.

Service Prototype

Place the following in a separate copybook for inclusion in both the caller and the service program source members.

**free

//==============================================================================
// The following is an abbreviated program status data structure definition
//==============================================================================
dcl-ds MyPSDS           PSDS;
  PROC_NAME             *PROC;              // Procedure name
  PGM_STATUS            *STATUS;            // Status code
  PRV_STATUS            zoned(5:0) pos(16); // Previous status
  LINE_NUM              char(8)    pos(21); // Src list line num
  ROUTINE               *ROUTINE;           // Routine name
  PARMS                 *PARMS;             // Num passed parms
  EXCP_MSGID            char(7)    pos(40); // Exception msg id
  PGM_LIB               char(10)   pos(81); // Program library
  EXCP_DATA             char(80)   pos(91); // Exception msg data
  JOB_NAME              char(10)   pos(244); // Job name
  USERNAME              char(10)   pos(254); // User name
  JOB_NUMB              char(6)    pos(264); // Job number
end-ds;

//==============================================================================
// This template data structure defines the components of a message for passing
// between programs.  A sample data structure then follows that for passing an
// array of such message blocks.  You can use that array data structure or
// create your own array data structure, based on this template, to meet your
// particular needs.
//==============================================================================
dcl-ds GenUtl_Message   qualified template;
  inUse                 ind       inz(*off);
  Id                    char(7)   inz(*blanks);
  Type                  char(10)  inz(*blanks);
  File                  char(10)  inz('WSMSGF'); // your default
  FLib                  char(10)  inz('*LIBL');
  Data                  varchar(3000);
end-ds;
dcl-ds GenUtl_Messages  likeds(GenUtl_Message) dim(20) inz(*likeds);

//==============================================================================
// This procedure changes the current library setting, e.g., to programmatically
// support dynamic local company data references.  At end of proccessing, the
// caller should reset it back by passing a library value of *CRTDFT or *RESET.
// It can optionally be reset to match the current user profile default by
// passing a library value of *USRPRF or *DEFAULT.
//==============================================================================
dcl-pr GenUtl_ChangeCurrentLibrary     ind;
  pLibrary              like(PGM_LIB)  const;
  pMessage              likeds(GenUtl_Message) dim(1) options(*nopass:*varsize);
end-pr;

Service Procedure

Place the following in a service program source member.

**free
//==============================================================================
// This procedure changes the current library setting, e.g., to programmatically
// support dynamic local company data references.  At end of proccessing, the
// caller should reset it back by passing a library value of *CRTDFT or *RESET.
// It can optionally be reset to match the current user profile default by
// passing a library value of *USRPRF or *DEFAULT.
//==============================================================================
dcl-proc GenUtl_ChangeCurrentLibrary   export;
  dcl-pi *n             ind;
    pLibrary            like(PGM_LIB)  const;
    pMessage            likeds(GenUtl_Message) dim(1) options(*nopass:*varsize);
  end-pi;

  dcl-c ChgCurLib       'CHGCURLIB CURLIB(&L)';
  dcl-s iResult         ind  inz(*on); // default to success
  dcl-s VarStr          varchar(512);

  if %parms() < %parmnum(pMessage)     // if not passed
  or %addr(pMessage) = *null;          // or was omitted
  else;                                // skip parm, else
    pMessage(1).inUse = *off;          // message entry not yet in use
  endif;

  VarStr = ChgCurLib;                  // get command string

  select;                              // check library parameter
    when GenUtl_inList(pLibrary: '*CRTDFT,*RESET'); // reset current library?
      VarStr = GenUtl_ScanAndReplace('&L': VarStr: '*CRTDFT');
    when GenUtl_inList(pLibrary: '*DEFAULT,*USRPRF'); // match user profile?
      callp IBMAPI_RtvUsrPrfInfo( QSYI0300: %size(QSYI0300): 'USRI0300'
                                : USERNAME: ApiErrC ); // get user profile
      if ApiErrC.BytAvail > *zero      // if user profile not found
      or QSYCLIB <= *blanks;           // or current library field is blank
         QSYCLIB = '*CRTDFT';          // use "create default"
      endif;
      VarStr = GenUtl_ScanAndReplace('&L': VarStr: %trimr(QSYCLIB));
    other;                             // else, set requested value;
      VarStr = GenUtl_ScanAndReplace('&L': VarStr: %trimr(pLibrary));
  endsl;

  monitor;                             // execute the change
    callp IBMAPI_ExecSysCmd(VarStr: %len(VarStr));
  on-error *all;                       // exception occurred?
    if %parms() < %parmnum(pMessage)   // if not passed
    or %addr(pMessage) = *null;        // or was omitted
    else;                              // skip message capture, else
      pMessage(1).inUse = *on;         // indicate message used
      pMessage(1).Id   = EXCP_MSGID;   // from PSDS
      pMessage(1).Type = '*ESCAPE';    // set message type
      pMessage(1).File = 'QCPFMSG';    // set message file
      pMessage(1).FLib = '*LIBL';      // set msgfile library
      pMessage(1).Data = EXCP_DATA;    // from PSDS
    endif;
    iResult = *off;                    // indicate failure
  endmon;

  return iResult;                      // return result to caller
end-proc;

References

• API Error Code Structure (ApiErrC)
• GenUtl_inList service procedure
• GenUtl_ScanAndReplace service procedure
• Execute System Command (QCMDEXC) API
• Retrieve User Profile Information (QSYRUSRI) API