Change Current Library
From MidrangeWiki
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.
By Dave Clark
Service Prototype
Place the following in a separate copybook for inclusion in both the caller and the service program source members.
**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-pr GenUtl_ChangeCurrentLibrary ind;
pLibrary like(PGM_LIB) const;
pMessage likeds(GenUtl_Message) dim(1) options(*nopass:*varsize);
end-pr;
//==============================================================================
// 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);
//==============================================================================
// 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;
Service Procedure
Place the following in a service program source member.
**free
ctl-opt NoMain AlwNull(*UsrCtl) Debug Option(*SrcStmt:*NoDebugIo)
DatFmt(*ISO) TimFmt(*ISO);
//==============================================================================
// 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
