These are functions we used (as they were from the iseriestoolkit project).
/TITLE Tlk_RtvJobLibl - Retrieve job library list information.
//*******************************************************************************************
// *RtvJobLibl Retrieve job library list information.
//*******************************************************************************************
Dcl-Proc Tlk_RtvJobLibl Export;
Dcl-Pi Tlk_RtvJobLibl LIKE(RtnErr);
OptJob Char(10) CONST OPTIONS(*OMIT); // Name
OptUsr Char(10) CONST OPTIONS(*OMIT); // User
OptNbr Char(6) CONST OPTIONS(*OMIT); // Number
RtnLibl Char(10) DIM(250) OPTIONS(*OMIT);
RtnCurLib Char(10) OPTIONS(*OMIT: *NOPASS);
RtnPrdLib Char(10) DIM(2) OPTIONS(*OMIT: *NOPASS);
RtnSysLibl Char(10) DIM(15) OPTIONS(*NOPASS);
End-Pi;
//***************
// Return Error *
//***************
Dcl-S RtnErr Ind INZ(*OFF); // Return flag.
//********************
// Working Variables *
//********************
Dcl-S ArgPas Int(10); // Parm passed.
Dcl-Ds QJob;
Job LIKE(OptJob); // Optional Job.
Usr LIKE(OptUsr); // Optional user.
Nbr LIKE(OptNbr); // Optional number.
End-Ds;
Dcl-S RtnLen Int(10) INZ(%LEN(APIRtn)); // Information lengt
Dcl-S I Int(10); // Library index.
Dcl-S Off Int(10); // Library offset.
Dcl-S Off2 Int(10); // Library offset.
Dcl-S Off3 Int(10); // Library offset.
//*******************************
// Returned library information *
//*******************************
Dcl-Ds APIRtn;
BytRtn LIKE(QUSBR06);
BytAvl LIKE(QUSBA06);
JobNam LIKE(QUSJN09);
UsrNam LIKE(QUSUN08);
JobNbr LIKE(QUSJNBR08);
IntJobID LIKE(QUSIJID06);
JobSts LIKE(QUSJS17);
JobTyp LIKE(QUSJT09);
JobSubTyp LIKE(QUSJS18);
Reserved LIKE(QUSERVED31);
SysLiblCnt LIKE(QUSLIS);
PrdLibCnt LIKE(QUSPL);
CurLibCnt LIKE(QUSCL01);
LiblCnt LIKE(QUSLIU);
LIBL Char(11) Dim(268);
End-Ds;
EXSR SubSetPrm; // Setup input parms
Rtnlen = %Size(Apirtn);
APIQUsrJobI(
APIRtn:
RtnLen:
'JOBI0700':
QJob:
*BLANKS:
APIErr);
RtnErr = Tlk_SndAPIErr(APIErr); // No error.
// No error on API call.
IF RtnErr = *OFF;
// Return library list.
CEETSTA(ArgPas:%Parmnum( RtnLibl ):*OMIT);
IF ArgPas = 1; // Not omitted.
CLEAR RtnLibl;
OFF = %SIZE(APIRTN)-(%SIZE(LIBL)*%ELEM(LIBL))
+((SYSLIBLCNT + PRDLIBCNT +
CURLIBCNT) * %SIZE(QUSLN01));
For I = 1 To LiblCnt;
RtnLibl(I) = %SUBST(APIRtn: Off + 1: 10);
Off = Off + %SIZE(QUSLN01);
EndFor;
ENDIF; // ArgPas=1
// Return current library.
IF %PARMS >= %Parmnum( RtnCurLib );
CEETSTA(ArgPas:%Parmnum( RtnCurLib ):*OMIT);
IF ArgPas = 1; // Not omitted.
IF CurLibCnt = *ZEROS;
CLEAR RtnCurLib;
ELSE;
OFF = %SIZE(APIRTN)-(%SIZE(LIBL)*%ELEM(LIBL))
+((SYSLIBLCNT+PRDLIBCNT)*%SIZE(QUSLN01));
RtnCurLib = %SUBST(APIRtn: Off + 1: 10);
ENDIF; // CurLibCnt=*ZEROS
ENDIF; // ArgPas=1
// Return product libraries.
IF %PARMS >= %Parmnum( RtnPrdLib );
CEETSTA(ArgPas:%Parmnum( RtnPrdLib ):*OMIT);
IF ArgPas = 1; // Not omitted.
CLEAR RtnPrdLib;
OFF = %SIZE(APIRTN)-(%SIZE(LIBL)*%ELEM(LIBL))
+((SYSLIBLCNT)*%SIZE(QUSLN01));
For I = 1 To PrdLibCnt;
RtnPrdLib(I)
= %SUBST(APIRtn: Off + 1: 10);
Off = Off + %SIZE(QUSLN01);
EndFor;
ENDIF; // ArgPas=1
// Return system libraries.
IF %PARMS >= %Parmnum( RtnSysLibl );
CLEAR RtnSysLibl;
OFF = %SIZE(APIRTN)-(%SIZE(LIBL)*%ELEM(LIBL));
For I = 1 To SysLiblCnt;
RtnSysLibl(I)
= %SUBST(APIRtn: Off + 1: 10);
Off = Off + %SIZE(QUSLN01);
EndFor;
ENDIF; // %PARMS>=7
ENDIF; // %PARMS>=6
ENDIF; // %PARMS>=5
ENDIF; // RtnErr=*OFF
RETURN RtnErr;
//*************************************************************************
// SubSetPrm - Set input parameter values. *
//*************************************************************************
BEGSR SubSetPrm;
CEETSTA(ArgPas:1:*OMIT); // Parm passed?
IF ArgPas = 1; // Yes.
Job = OptJob;
ELSE;
Job = '*'; // Use default.
ENDIF; // ArgPas=1
CEETSTA(ArgPas:2:*OMIT); // Parm passed?
IF ArgPas = 1; // Yes.
Usr = OptUsr;
ELSE;
Usr = *BLANKS; // Use default.
ENDIF; // ArgPas=1
CEETSTA(ArgPas:3:*OMIT); // Parm passed?
IF ArgPas = 1; // Yes.
Nbr = OptNbr;
ELSE;
Nbr = *BLANKS; // Use default.
ENDIF; // ArgPas=1
ENDSR;
End-Proc Tlk_RtvJobLibl;
/TITLE Tlk_SetJobLibl - Set one or all job library list.
//*******************************************************************************************
// *RtvJobLibl Retrieve job library list information.
//*******************************************************************************************
Dcl-Proc Tlk_SetJobLibl Export;
Dcl-Pi Tlk_SetJobLibl LIKE(RtnErr);
SetLibl Char(10) DIM(250) OPTIONS(*OMIT);
SetCurLib Char(10) OPTIONS(*OMIT: *NOPASS) CONST;
SetPrdLib Char(10) DIM(2) OPTIONS(*OMIT: *NOPASS) CONST;
ClrLibl Ind OPTIONS(*NOPASS) CONST;
End-Pi;
//***************
// Return Error *
//***************
Dcl-S RtnErr Ind INZ(*OFF); // Return flag.
//********************
// Working Variables *
//********************
Dcl-Ds Libs Qualified;
Usr Char(11) Dim(250);
Usrl# Int(10);
Prd Char(11) Dim(2) Inz('*SAME');
Cur Char(11) Inz('*SAME');
End-Ds;
Dcl-Ds QJob Qualified Inz;
Job Char(10) Inz('*');
Usr Char(10);
Nbr Char(10);
End-Ds;
Dcl-Ds Rtn Qualified;
Libl Char(10) Dim(250);
Curlib Char(10);
PrdLib Char(10) Dim(2);
End-Ds;
Dcl-S ArgPas Int(10); // Parm passed.
Dcl-S ClearLibl Ind;
Dcl-S I Int(10); // Library index.
Dcl-S Usecurl Ind;
Dcl-S Useprdl Ind;
Dcl-S Useusrl Ind;
EXSR SubSetPrm;
// Nothing sent then do nothing and not asked to clear
If Not Useusrl And Not Usecurl And Not Useprdl And Not ClearLibl;
RtnErr = '0';
Return Rtnerr;
Endif;
APIQLICHGLL(
Libs.Cur
:Libs.Prd(1)
:Libs.Prd(2)
:Libs.Usr
:Libs.Usrl#
:APIErr);
RtnErr = Tlk_SndAPIErr(APIErr);
RETURN RtnErr;
//*************************************************************************
// SubSetPrm - Set input parameter values. *
//*************************************************************************
BEGSR SubSetPrm;
If %Addr(SetLibl) <> *Null;
Libs.Usrl# = 0;
For I = 1 to 250 by 1;
If SetLibl(I) = *Blanks;
Iter;
Endif;
Libs.Usrl# += 1;
Libs.Usr(Libs.Usrl#) = SetLibl(I);
Endfor;
Useusrl = *On;
ELSE;
Useusrl = *Off;
Libs.Usrl# = -1;// Have system leave alone
ENDIF;
If %Parms() >= %Parmnum( SetCurLib );
If %Addr(SetCurlib) <> *Null;
Usecurl = *ON;
Libs.Cur = SetCurlib;
ELSE;
Usecurl = *Off;
Libs.Cur = '*SAME';
ENDIF;
ELSE;
Usecurl = *Off;
Libs.Cur = '*SAME';
ENDIF;
If %Parms() >= %Parmnum( SetPrdLib );
If %Addr(SetPrdlib) <> *Null;
Useprdl = *ON;
Libs.Prd(1) = SetPrdlib(1);
Libs.Prd(2) = SetPrdlib(2);
ELSE;
Useprdl = *Off;
ENDIF;
ELSE;
Useprdl = *Off;
ENDIF;
If %Parms() >= %Parmnum( ClrLibl );
ClearLibl = Clrlibl;
If ClearLibl;
Libs.Usrl# = 0;
Endif;
ELSE;
ClearLibl = *OFF;
ENDIF;
Endsr;
End-Proc Tlk_SetJobLibl;
This is a production use of this function, where YELIB is another name.
Tlk_Rtvjoblibl( Optjob :Optusr :Optnum :Rtnlib :Rtncurlib );
If %SUBST( Rtncurlib:1:5 ) = 'YELIB';
Xyear = %INT( %SUBST( Rtncurlib:6:4 ));
Tlk_Setjoblibl( *OMIT :'*CRTDFT' );
Else;
For Xidx = 1 To 250;
If Rtnlib( Xidx ) <> *BLANKS;
If %SUBST( Rtnlib( Xidx ) :1:5 ) = 'WFIPR';
Xyear = %INT( %SUBST( Rtnlib( Xidx ) :6:4 ) );
Leave;
Endif;
Else;
Iter;
Endif;
Endfor;
Endif;
// later and program exit
IF Rtncurlib > ' ';
Tlk_Setjoblibl( *OMIT :Rtncurlib );
Endif;
-Matt
-----Original Message-----
From: RPG400-L <rpg400-l-bounces@xxxxxxxxxxxxxxxxxx> On Behalf Of midrangel@xxxxxxxxxxxxxxxxx
Sent: Friday, August 27, 2021 9:22 AM
To: 'RPG programming on IBM i' <rpg400-l@xxxxxxxxxxxxxxxxxx>
Subject: QLICHGLL api APIError
I have a POC program that is setting the current library, product library 1 and product library 2 using the QLICHGLL api. It works, meaning it changes the libraries in the job. When setting the current library to *CRTDFT the api throws an error CPF2110, (library not found) which yea, I get it "*CRTDFT" does not exist, however it is an allowed input for the API.
Any thoughts on how to deal with that? Here's the relevant code:
**free
DCL-PI *n;
curLib char(11);
prodLib1 char(11);
prodLib2 char(11);
END-PI;
dcl-ds APIError qualified;
Bytes_provided int(10) inz(268);
Bytes_Available int(10);
MsgId char(7);
Reserved char(1);
MsgData char(240);
END-DS;
dcl-pr QLICHGLL extpgm('QLICHGLL');
Curlib char(11) const;
Prodlib1 char(11) const;
Prodlib2 char(11) const;
UsrLibl char(22) const dim(10);
nUsrLIblCount int(10) const;
Api_Error char(16);
END-PR;
//call the API
QLICHGLL(curLib : prodLib1 : prodLib2 : ' ' : -1 : APIError);
dsply APIError.MsgID;
return;
--
Jim Oberholtzer
Agile Technology Architects
--
This is the RPG programming on IBM i (RPG400-L) mailing list To post a message email: RPG400-L@xxxxxxxxxxxxxxxxxx To subscribe, unsubscribe, or change list options,
visit:
https://urldefense.com/v3/__https://lists.midrange.com/mailman/listinfo/rpg400-l__;!!O6xM9Yim9Yk!qjI1CSSV7tVFj4oz9VvNYL6XgTN98zjaCYzbbYzC2YRkNKnd8t5M9GmDRzkVq4VkQcL5$
or email: RPG400-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives at
https://urldefense.com/v3/__https://archive.midrange.com/rpg400-l__;!!O6xM9Yim9Yk!qjI1CSSV7tVFj4oz9VvNYL6XgTN98zjaCYzbbYzC2YRkNKnd8t5M9GmDRzkVq656hEj7$ .
Please contact support@xxxxxxxxxxxxxxxxxxxx for any subscription related questions.
Help support midrange.com by shopping at amazon.com with our affiliate link:
https://urldefense.com/v3/__https://amazon.midrange.com__;!!O6xM9Yim9Yk!qjI1CSSV7tVFj4oz9VvNYL6XgTN98zjaCYzbbYzC2YRkNKnd8t5M9GmDRzkVq5ZdPMEF$
midrange.com
