Difference between revisions of "Change Current Library"

From MidrangeWiki
Jump to: navigation, search
 
(5 intermediate revisions by the same user not shown)
Line 1: Line 1:
 +
[[Category:RPG Examples]]
 
[[Category:Sample Code]]
 
[[Category:Sample Code]]
 
[[Category:Service Procedures]]
 
[[Category:Service Procedures]]
Line 4: Line 5:
 
== Summary ==
 
== 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.
 
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.
 +
 +
By [[User:DaveLClarkI|Dave Clark]]
  
 
== Service Prototype ==
 
== Service Prototype ==
Line 11: Line 14:
  
 
//==============================================================================
 
//==============================================================================
// The following is an abbreviated program status data structure definition
+
// 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-ds MyPSDS          PSDS;
+
dcl-pr GenUtl_ChangeCurrentLibrary    ind;
   PROC_NAME            *PROC;             // Procedure name
+
   pLibrary             like(PGM_LIB) const;
  PGM_STATUS            *STATUS;            // Status code
+
   pMessage             likeds(GenUtl_Message) dim(1) options(*nopass:*varsize);
  PRV_STATUS            zoned(5:0) pos(16); // Previous status
+
end-pr;
   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;
 
  
 
//==============================================================================
 
//==============================================================================
Line 46: Line 43:
  
 
//==============================================================================
 
//==============================================================================
// This procedure changes the current library setting, e.g., to programmatically
+
// The following is an abbreviated program status data structure definition
// 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;
+
dcl-ds MyPSDS          PSDS;
   pLibrary             like(PGM_LIB) const;
+
   PROC_NAME            *PROC;              // Procedure name
   pMessage             likeds(GenUtl_Message) dim(1) options(*nopass:*varsize);
+
  PGM_STATUS            *STATUS;            // Status code
end-pr;
+
  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;
 
</pre>
 
</pre>
  
Line 62: Line 65:
 
<pre>
 
<pre>
 
**free
 
**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
 
// This procedure changes the current library setting, e.g., to programmatically

Latest revision as of 19:53, 26 December 2018


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