View source for Change Current Library

[[Category:Sample Code]]
[[Category:Service Procedures]]
__FORCETOC__
== Summary ==
The following are the RPG/LE fully free-form definitions and instructions needed for using the {{AN}} service procedure.  This service procedure simply allows the caller to change the [[Current Library]] setting of the library list for the active job.

== Service Procedure ==
<pre>
**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;

//==============================================================================
// 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;
</pre>

== References ==
* [[API Error Code Structure (ApiErrC)]]
* [[In List|GenUtl_inList]] service procedure
* [[Scan and Replace|GenUtl_ScanAndReplace]] service procedure
* [[Execute System Command (QCMDEXC)]] API
* [[Retrieve User Profile Information (QSYRUSRI)]] API