Tweet
*
* CrtUsrSpc: Create User Space for OS/400 API's
*
d QUSCRTUS pr extpgm('QUSCRTUS')
d UsrSpc 20A const
d ExtAttr 10A const
d InitialSize 10I 0 const
d InitialVal 1A const
d PublicAuth 10A const
d Text 50A const
d Replace 10A const
d ErrorCode 32766A options(*nopass: *varsize)
*
* --- Prototype for API Retrive User Space
*
d QUSRTVUS pr extpgm( 'QUSRTVUS' )
d QRtvUserSpace...
d 20
d QRtvStartingPosition...
d 8b 0
d QRtvLengthOfData...
d 8b 0
d QRtvReceiverVariable...
d 32048
d QRtvError...
d 256
* --- Prototype for API Retrive List Job
*
d QUSLJOB pr extpgm( 'QUSLJOB' )
d QJobUserSpace...
d 20
d QJobFormatName...
d 8
d QJobJobName...
d 26
d QFldStatus...
d 10
d QFldError...
d 256
d QJobType...
d 1
d QNbrFldRtn...
d 8b 0
d QKeyFldRtn...
d 8b 0 dim( 100 )
*
d qcmdexc pr extpgm( 'QCMDEXC' )
d os400_cmd 2000A options( *varsize ) const
d cmdlength 15P 5 const
*
* Defined variables
*
d emailaddress s 24 inz('as400pro@russianladies.com')
d size s 10I 0
d UsrSpcName s 20 inz( 'DSPJOB QTEMP ' )
*
******************************************************************
dQUSA0100 DS
d QUsrSpcOffset...
d 1 4B 0
d QUsrSpcEntries...
d 9 12B 0
d QUsrSpcEntrieSize...
d 13 16B 0
dLJOBINPUT ds qualified
d JobName...
d 1 10
d UserName...
d 11 20
d JobNumber...
d 21 26
d Status...
d 27 36
d UserSpace...
d 37 46
d UserSpaceLibrary...
d 47 56
d Format...
d 57 64
d JobType...
d 65 65
d Reserved01...
d 66 68
d Reserved02...
d 69 72B 0
*
dLJOB100 ds qualified
d JobName...
d 1 10
d UserName...
d 11 20
d JobNumber...
d 21 26
d InternalJobId...
d 27 42
d Status...
d 43 52
d JobType...
d 53 53
d JobSubType...
d 54 54
d Reserved01...
d 55 56
*
dLJOB200 ds qualified
d JobName...
d 1 10
d UserName...
d 11 20
d JobNumber...
d 21 26
d InternalJobId...
d 27 42
d Status...
d 43 52
d JobType...
d 53 53
d JobSubType...
d 54 54
d Reserved01...
d 55 56
d JobInfoStatus...
d 57 57
d Reserved02...
d 58 60
d NumberOfFieldsReturned...
d 61 64B 0
d ReturnedData...
d 65 1064
*
dLJOB200KEY ds qualified
d KeyNumber01...
d 1 4B 0
d NumberOfKeys...
d 5 8B 0
*
dLJOBKEYINFO ds qualified
d LengthOfInformation...
d 1 4b 0
d KeyField...
d 5 8b 0
d TypeOfData...
d 9 9
d Reserved01...
d 10 12
d LengthOfData...
d 13 16B 0
d KeyData...
d 17 1016
*
* APIErrDef Standard API error handling structure. *
*
dQUSEC DS
d ErrorBytesProvided...
d 1 4B 0
d ErrorBytesAvailble...
d 5 8b 0
d ErrorExceptionId...
d 9 15
d ErrorReserved...
d 16 16
*
dAPIError DS
d APIErrorProvied...
d LIKE( ErrorBytesProvided )
d INZ( %LEN( APIError ) )
d APIErrorAvailble...
d LIKE( ErrorBytesAvailble )
d APIErrorMessageID...
d LIKE( ErrorExceptionId )
d APIErrorReserved...
d LIKE( ErrorReserved )
d APIErrorInformation...
d 240A
*-----------------------------------------------------------------
* program status dataarea
*-----------------------------------------------------------------
d PgmSts SDS
d P1User 254 263
d W1Program *PROC
*--------------------------------------------------------------*
* work fields *
*--------------------------------------------------------------*
d Variables ds
d Q 1 inz( '''' )
d Count 15 0 inz( 0 )
d KeyCount 15 0 inz( 0 )
d EndPos 15 0 inz( 0 )
d JobbStatus 4 inz( ' ' )
d Subsystem 20 inz( ' ' )
d ReturnCode 1 inz( ' ' )
d FormatName 8 inz( ' ' )
d QualifedJobName...
d 26 inz( ' ' )
d JobStatus 10 inz( ' ' )
d JobType 1 inz( ' ' )
d NbrOfFldRtn 8B 0 inz( 0 )
d KeyFldRtn 8B 0 inz( 0 ) dim( 100 )
d StartingPosition...
d 8B 0 inz( 0 )
d LengthOfData...
d 8B 0 inz( 0 )
d KeyStartingPosition...
d 8B 0 inz( 0 )
d KeyLengthOfData...
d 8B 0 inz( 0 )
d ReceiverVariable...
d 32048
d OS400_Cmd 2000 inz( ' ' )
d CmdLength 15P 5 inz( %size( OS400_Cmd ) )
d True 1 inz( *on )
d False 1 inz( *off )
*
/free
//
// Create a user space
//
size = 10000;
// Create a user space
QUSCRTUS(UsrSpcName: 'USRSPC': size: x'00': '*ALL':
'Temp User Space for QUSLJOB API': '*YES': APIError);
exsr CheckStatusOfJob;
*inlr = *on;
// *************************************************************
// check status of an job
// -------------------------------------------------------------
begsr CheckStatusOfJob;
// run API to fill user space with information about all iSeries job
FormatName = 'JOBL0200';
QualifedJobName = '*ALL ' + '*ALL ' + '*ALL ';
JobStatus = '*ACTIVE';
JobType = '*';
NbrOfFldRtn = 2;
KeyFldRtn( 1 ) = 0101;
KeyFldRtn( 2 ) = 1906;
callp QUSLJOB( UsrSpcName : FormatName : QualifedJobName :
JobStatus : APIError :
JobType : NbrOfFldRtn : KeyFldRtn );
// if error message from the retrieve job API then dump program
if APIErrorMessageID <> ' ';
dump;
ReturnCode = True;
leavesr;
endif;
// run API to get user space attribute
StartingPosition = 125;
LengthOfData = 16;
callp QUSRTVUS( UsrSpcName : StartingPosition :
LengthOfData : ReceiverVariable :
APIError );
QUSA0100 = ReceiverVariable;
// if error message from the retrieve user space API then dump program
if APIErrorMessageID <> ' ';
dump;
ReturnCode = True;
leavesr;
endif;
// preperation to read from user space
StartingPosition = QUsrSpcOffset + 1;
LengthOfData = QUsrSpcEntrieSize;
// read from user space
for count = 1 to QUsrSpcEntries;
callp QUSRTVUS( UsrSpcName : StartingPosition :
LengthOfData : ReceiverVariable :
APIError );
LJOB200 = ReceiverVariable;
if APIErrorMessageID <> ' ';
dump;
ReturnCode = True;
leavesr;
endif;
// check status of job
JobbStatus = ' ';
Subsystem = ' ';
LJobKeyInfo = LJob200.ReturnedData;
// Job type
// A The job is an autostart job.
// B The job is a batch job.
// I The job is an interactive job.
// M The job is a subsystem monitor job.
// R The job is a spooled reader job.
// S The job is a system job.
// W The job is a spooled writer job.
// X The job is the SCPF system job.
// Job subtype
// D The job is a batch immediate job.
// E The job started with a procedure start request.
// F The job is an AS/400 Advanced 36 machine server job.
// J The job is a prestart job.
// P The job is a print driver job.
// T The job is a System/36 multiple requester terminal (MRT) job.
// U The job is an alternate spool user.
KeyStartingPosition = 1;
KeyLengthOfData = LJobKeyInfo.LengthOfInformation;
for keycount = 1 to LJob200.NumberOfFieldsReturned;
LJobKeyInfo = %subst( LJob200.ReturnedData :
KeyStartingPosition :
KeyLengthOfData );
KeyLengthOfData = LJobKeyInfo.LengthOfInformation;
LJobKeyInfo = %subst( LJob200.ReturnedData :
KeyStartingPosition :
KeyLengthOfData );
Endpos = LJobKeyInfo.LengthOfData;
if LJobKeyInfo.KeyField = 0101;
JobbStatus = %subst( LJobKeyInfo.KeyData : 1 : Endpos );
elseif LJobKeyInfo.KeyField = 1906;
Subsystem = %subst( LJobKeyInfo.KeyData : 1 : Endpos );
endif;
KeyStartingPosition = KeyStartingPosition + KeyLengthOfData;
endfor;
// if job in message wait then email message to address in
// variable email address
if Jobbstatus = 'MSGW';
endif;
StartingPosition = StartingPosition + LengthOfData;
endfor;
endsr;
// ****************************************************************** //
// * Compile Options * //
// ****************************************************************** //
H Option(*SRCSTMT:*NODEBUGIO)
// ****************************************************************** //
// * Definition Specifations * //
// ****************************************************************** //
// ------------------------------------------------------------------ //
// - External Prototypes - //
// ------------------------------------------------------------------ //
D GETJOBQ PR EXTPGM('QSPRJOBQ')
D RECIEVER 144A
D RCVRLEN 10I 0 const
D FORMAT 8A const
D JOBQ 20A conST
D ERROR 116A
*
****** /INCLUDE QSYSINC/QRPGLESRC,QSPRJOBQ
*
DQSPQ010000 DS
D* Qsp JOBQ0100
D QSPBRTN00 1 4B 0
D* Bytes Returned
D QSPBAVL00 5 8B 0
D* Bytes Available
D QSPJQN 9 18
D* Job Queue Name
D QSPJQLN 19 28
D* Job Queue Lib Name
D QSPOC01 29 38
D* Operator Controlled
D QSPAC 39 48
D* Authority Check
D QSPNBRJ 49 52B 0
D* Number Jobs
D QSPJQS 53 62
D* Job Queue Status
D QSPSN 63 72
D* Subsystem Name
D QSPTD 73 122
D* Text Description
D QSPSLN 123 132
D* Subsystem Lib Name
D QSPSNBR01 133 136B 0
D* Sequence Number
D QSPMA00 137 140B 0
D* Maximum Active
D QSPCA00 141 144B 0
* Current Active
*
*
DQSPQ020000 DS
D* Qsp JOBQ0200
D QSPBRTN05 1 4B 0
D* Bytes Returned
D QSPBAVL03 5 8B 0
D* Bytes Available
D QSPJQN02 9 18
D* Job Queue Name
D QSPJQLN02 19 28
D* Job Queue Lib Name
D QSPOC02 29 38
D* Operator Controlled
D QSPAC00 39 48
D* Authority Check
D QSPNBRJ00 49 52B 0
D* Number Jobs
D QSPJQS01 53 62
D* Job Queue Status
D QSPSN02 63 72
D* Subsystem Name
D QSPSLN00 73 82
D* Subsystem Lib Name
D QSPTD00 83 132
D* Text Description
D QSPSNBR02 133 136B 0
D* Sequence Number
D QSPMA01 137 140B 0
D* Maximum Active
D QSPCA01 141 144B 0
D* Current Active
D QSPMAP1 145 148B 0
D* Max Active Priority
D QSPMAP2 149 152B 0
D* Max Active Priority
D QSPMAP3 153 156B 0
D* Max Active Priority
D QSPMAP4 157 160B 0
D* Max Active Priority
D QSPMAP5 161 164B 0
D* Max Active Priority
D QSPMAP6 165 168B 0
D* Max Active Priority
D QSPMAP7 169 172B 0
D* Max Active Priority
D QSPMAP8 173 176B 0
D* Max Active Priority
D QSPMAP9 177 180B 0
D* Max Active Priority
D QSPAJP0 181 184B 0
D* Active Jobs Priorit
D QSPAJP1 185 188B 0
D* Active Jobs Priorit
D QSPAJP2 189 192B 0
D* Active Jobs Priorit
D QSPAJP3 193 196B 0
D* Active Jobs Priorit
D QSPAJP4 197 200B 0
D* Active Jobs Priorit
D QSPAJP5 201 204B 0
D* Active Jobs Priorit
D QSPAJP6 205 208B 0
D* Active Jobs Priorit
D QSPAJP7 209 212B 0
D* Active Jobs Priorit
D QSPAJP8 213 216B 0
D* Active Jobs Priorit
D QSPAJP9 217 220B 0
D* Active Jobs Priorit
D QSPJOQP0 221 224B 0
D* RLS Jobs on Queue P
D QSPJOQP1 225 228B 0
D* RLS Jobs on Queue P
D QSPJOQP2 229 232B 0
D* RLS Jobs on Queue P
D QSPJOQP3 233 236B 0
D* RLS Jobs on Queue P
D QSPJOQP4 237 240B 0
D* RLS Jobs on Queue P
D QSPJOQP5 241 244B 0
D* RLS Jobs on Queue P
D QSPJOQP6 245 248B 0
D* RLS Jobs on Queue P
D QSPJOQP7 249 252B 0
D* RLS Jobs on Queue P
D QSPJOQP8 253 256B 0
D* RLS Jobs on Queue P
D QSPJOQP9 257 260B 0
D* RLS Jobs on Queue P
D QSPJOQP000 261 264B 0
D* SCH Jobs on Queue P
D QSPJOQP100 265 268B 0
D* SCH Jobs on Queue P
D QSPJOQP200 269 272B 0
D* SCH Jobs on Queue P
D QSPJOQP300 273 276B 0
D* SCH Jobs on Queue P
D QSPJOQP400 277 280B 0
D* SCH Jobs on Queue P
D QSPJOQP500 281 284B 0
D* SCH Jobs on Queue P
D QSPJOQP600 285 288B 0
D* SCH Jobs on Queue P
D QSPJOQP700 289 292B 0
D* SCH Jobs on Queue P
D QSPJOQP800 293 296B 0
D* SCH Jobs on Queue P
D QSPJOQP900 297 300B 0
D* SCH Jobs on Queue P
D QSPJOQP001 301 304B 0
D* HLD Jobs on Queue P
D QSPJOQP101 305 308B 0
D* HLD Jobs on Queue P
D QSPJOQP201 309 312B 0
D* HLD Jobs on Queue P
D QSPJOQP301 313 316B 0
D* HLD Jobs on Queue P
D QSPJOQP401 317 320B 0
D* HLD Jobs on Queue P
D QSPJOQP501 321 324B 0
D* HLD Jobs on Queue P
D QSPJOQP601 325 328B 0
D* HLD Jobs on Queue P
D QSPJOQP701 329 332B 0
D* HLD Jobs on Queue P
D QSPJOQP801 333 336B 0
D* HLD Jobs on Queue P
D QSPJOQP901 337 340B 0
* HLD Jobs on Queue P
*
*/INCLUDE QSYSINC/QRPGLESRC,QUSEC
*
DQUSEC DS
* Qus EC
D QUSBPRV 1 4B 0
* Bytes Provided
D QUSBAVL 5 8B 0
* Bytes Available
D QUSEI 9 15
* Exception Id
D QUSERVED 16 16
* Reserved
D*QUSED01 17 17
D*
D* Varying length
DQUSC0200 DS
D* Qus ERRC0200
D QUSK01 1 4B 0
D* Key
D QUSBPRV00 5 8B 0
D* Bytes Provided
D QUSBAVL14 9 12B 0
D* Bytes Available
D QUSEI00 13 19
D* Exception Id
D QUSERVED39 20 20
D* Reserved
D QUSCCSID11 21 24B 0
D* CCSID
D QUSOED01 25 28B 0
D* Offset Exc Data
D QUSLED01 29 32B 0
D* Length Exc Data
D*QUSRSV214 33 33
D* Reserved2
D QUSED01 100A
*
* Standard API error data structure
*
d APIERROR DS INZ
d AEBYPR 1 4B 0
d AEBYAV 5 8B 0
d AEEXID 9 15
d AEEXDT 16 116
*
// ****************************************************************** //
// * Main Calculations * //
// ****************************************************************** //
/Free
GETJOBQ(QSPQ020000:%SIZE(QSPQ020000):'JOBQ0200':
'QNIGHT QGPL':APIERROR);
DSPLY QSPSN;
*INLR = *On;
/End-Free
JobType = '*';
JobType = 'I';
if Jobbstatus = 'RUN';
dsply 'Found a running Job';
endif;
Comment