Trucs et Astuces - AS400 - Tips and Tricks

page d'accueil   Boite à outils

 

See also

Table Function

this function returns many job attributes


CREATE FUNCTION mylib.RetrieveJobAttribute()
RETURNS TABLE ( JOB char (10) , USER char (10) , NBR char (6) , INQMSGRPY char (10) , USRLIBL char (2750) , CURLIB char (10) , SYSLIBL char (165) , CURUSER char (10) , LANGID char (3) , CNTRYID char (2) , CCSID decimal (5, 0) , DFTCCSID decimal (5, 0) , DECFMT char (1) ) LANGUAGE CL PARAMETER STYLE DB2SQL DETERMINISTIC NO SQL CALLED ON NULL INPUT NO DBINFO NO EXTERNAL ACTION NOT FENCED NO FINAL CALL DISALLOW PARALLEL SCRATCHPAD EXTERNAL NAME mylib.xcrtjbaf
CARDINALITY 1

this is the CLLE (yes, a CL, simply) that is inside the function


/* maxi 40 params, - 6 reserved for trailer */ /* each answer need 2 parameters : we can accept 17 values */
pgm parm(+ &JOB + &USER + &NBR + &INQMSGRPY + &USRLIBL + &CURLIB + &SYSLIBL + &CURUSER + &LANGID + &CNTRYID + &CCSID + &DFTCCSID + &DECFMT + &iJOB + &iUSER + &iNBR + &iINQMSGRPY + &iUSRLIBL + &iCURLIB + &iSYSLIBL + &iCURUSER + &iLANGID + &iCNTRYID + &iCCSID + &iDFTCCSID + &iDECFMT + &sqlstate + &function + &specific + &sqlmsg + &scratchpad + &calltype ) dcl &JOB *char (10) dcl &USER *char (10)
dcl &NBR *char (6)
dcl &INQMSGRPY *char (10)
dcl &USRLIBL *char (2750)
dcl &CURLIB *char (10)
dcl &SYSLIBL *char (165)
dcl &CURUSER *char (10)
dcl &LANGID *char (3)
dcl &CNTRYID *char (2)
dcl &CCSID *dec (5 0) dcl &DFTCCSID *dec (5 0) dcl &DECFMT *char (1)
dcl &iJOB *char (2)
dcl &iUSER *char (2)
dcl &iNBR *char (2)
dcl &iINQMSGRPY *char (2)
dcl &iUSRLIBL *char (2)
dcl &iCURLIB *char (2)
dcl &iSYSLIBL *char (2) dcl &iCURUSER *char (2) dcl &iLANGID *char (2) dcl &iCNTRYID *char (2) dcl &iCCSID *char (2) dcl &iDFTCCSID *char (2) dcl &iDECFMT *char (2) DCL VAR(&SQLSTATE) TYPE(*CHAR) LEN(5) DCL VAR(&FUNCTION) TYPE(*CHAR) LEN(517) DCL VAR(&SPECIFIC) TYPE(*CHAR) LEN(128) DCL VAR(&SQLMSG) TYPE(*CHAR) LEN(70) DCL VAR(&SCRATCHPAD) TYPE(*CHAR) LEN(104)
DCL VAR(&CALLTYPE) TYPE(*CHAR) LEN(4) DCL VAR(&CALLTYPEB) TYPE(*DEC) LEN(5 0) DCL VAR(&DECIN) TYPE(*DEC) LEN(1) DCL VAR(&N2) TYPE(*DEC) LEN(2 0) DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5 0) VALUE(70) DCL VAR(&X70) TYPE(*CHAR) LEN(2) VALUE(X'0046') DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(70) /*===========GESTION-DES-MESSAGES-D'ERREUR--------------------------*/
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
/*-RENVOI-DES-MESSAGES-VERS-L'APPELANT------------------*/
COPYRIGHT TEXT('Author is Jean-Paul Lamontre')
MONMSG MSGID(CPF0000 QWM0000) EXEC(GOTO +
CMDLBL(STDMONMSG))
GOTO CMDLBL(DEBUTPGM)
STDMONMSG:
/*-----------CAPTURE-DU-MESSAGE----------------------*/
RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
/*-----------PROMOTION-DU-MESSAGE--------------------*/
RTVMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSG(&MSGDTA) MSGLEN(&MSGLEN)
CHGVAR VAR(&SQLSTATE) VALUE('XC001')
CHGVAR VAR(&MSGTXT) VALUE(&X70 *CAT &MSGID *CAT +
&MSGDTA)
RETURN
DEBUTPGM:
/*===========CORPS-DU-PROGRAMME-------------------------------------*/
/* default values : sqlstate = ok, values = null */
CHGVAR VAR(&SQLSTATE) VALUE('00000')
CHGVAR VAR(&IJOB) VALUE(X'FFFF')
CHGVAR VAR(&IUSER) VALUE(X'FFFF')
CHGVAR VAR(&INBR) VALUE(X'FFFF')
CHGVAR VAR(&IINQMSGRPY) VALUE(X'FFFF')
CHGVAR VAR(&IUSRLIBL) VALUE(X'FFFF')
CHGVAR VAR(&ICURLIB) VALUE(X'FFFF')
CHGVAR VAR(&ISYSLIBL) VALUE(X'FFFF')
CHGVAR VAR(&ICURUSER) VALUE(X'FFFF')
CHGVAR VAR(&ILANGID) VALUE(X'FFFF')
CHGVAR VAR(&ICNTRYID) VALUE(X'FFFF')
CHGVAR VAR(&ICCSID) VALUE(X'FFFF')
CHGVAR VAR(&IDFTCCSID) VALUE(X'FFFF')
CHGVAR VAR(&IDECFMT) VALUE(X'FFFF')


/*&decin : 0=not null ; -1=null */
/* CHGVAR VAR(&DECIN) VALUE(%BIN(&INP1 ) */
CHGVAR VAR(&CALLTYPEB) VALUE(%BIN(&CALLTYPE 1 4))

IF COND(&CALLTYPEB = -2) THEN(GOTO +
CMDLBL(FIRSTCALL))
IF COND(&CALLTYPEB = -1) THEN(GOTO +
CMDLBL(OPENCALL))
IF COND(&CALLTYPEB = 0) THEN(GOTO +
CMDLBL(FETCHCALL))
IF COND(&CALLTYPEB = 1) THEN(GOTO +
CMDLBL(CLOSECALL))
IF COND(&CALLTYPEB = 2) THEN(GOTO +
CMDLBL(FINALCALL))
CHGVAR VAR(&SQLSTATE) VALUE('XC021')
CHGVAR VAR(&MSGTXT) VALUE(&X70 *CAT 'XC021 +
unattended call type received')
RETURN


firstcall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('FIRST')
RETURN

opencall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('OPEN')
RETURN
fetchcall:
IF COND(%SST(&SCRATCHPAD 5 5) = 'OPEN') THEN(DO)
RTVJOBA JOB(&JOB) USER(&USER) NBR(&NBR) +
INQMSGRPY(&INQMSGRPY) USRLIBL(&USRLIBL) +
CURLIB(&CURLIB) SYSLIBL(&SYSLIBL) +
CURUSER(&CURUSER) LANGID(&LANGID) +
CNTRYID(&CNTRYID) CCSID(&CCSID) +
DFTCCSID(&DFTCCSID) DECFMT(&DECFMT)

CHGVAR VAR(&IJOB) VALUE(X'0000')
CHGVAR VAR(&IUSER) VALUE(X'0000')
CHGVAR VAR(&INBR) VALUE(X'0000')
CHGVAR VAR(&IINQMSGRPY) VALUE(X'0000')
CHGVAR VAR(&IUSRLIBL) VALUE(X'0000')
CHGVAR VAR(&ICURLIB) VALUE(X'0000')
CHGVAR VAR(&ISYSLIBL) VALUE(X'0000')
CHGVAR VAR(&ICURUSER) VALUE(X'0000')
CHGVAR VAR(&ILANGID) VALUE(X'0000')
CHGVAR VAR(&ICNTRYID) VALUE(X'0000')
CHGVAR VAR(&ICCSID) VALUE(X'0000')
CHGVAR VAR(&IDFTCCSID) VALUE(X'0000')
CHGVAR VAR(&IDECFMT) VALUE(X'0000')

ENDDO
ELSE CMD(DO)

CHGVAR VAR(&SQLSTATE) VALUE('02000')
ENDDO
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('FETCH')
RETURN


closecall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('CLOSE')
RETURN

finalcall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('FINAL')
RETURN





FIN: ENDPGM


and here is how to call the function


SELECT * FROM table(retrievejobattribute()) as jobatr

 

 

This tool is a free source text; you can redistribute it and/or modify it as much as you need. Just add as comment in the code a reference to this site : http://jplamontre.free.fr/jpltools.htm ... and send me an email Contact with "jpltools" in the subject (it's for my antispam rules). I will be happy to know what you have done with the jpltools.This tool is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY :

THIS TOOLBOX IS PROVIDED ''AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PROVIDER OR ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS TOOLBOX, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.