Re: ENDMSGW QUSLJOB API

Hi Jon,

Inf_Len should be defined as 10i 0. Not 4b 0. You should never use the B data type. Ever.

Your call to QUSRJOBI does absolutely no error checking... so if the API detects an error (such as an invalid length in the Inf_Len field), you'll get the blank DS that you've noted.




On 5/31/2011 8:57 AM, Jon Allen wrote:

Great thanks, the code is below! I was think that maybe the JOBL0200 format changed?


H DFTACTGRP(*NO)

*
D CMDS S 29 DIM(2) CTDATA
*
* List jobs API
*
D QUSLJOB PR ExtPgm('QUSLJOB')
D UsrSpc 20A const
D Format 8A const
D QualJob 26A const
D Status 10A const
D ErrorCode 32767A options(*varsize)
D JobType 1A const options(*nopass)
D NumFldsToRtn 10I 0 const options(*nopass)
D FldsToRtn 10I 0 const options(*nopass)

*
* Create User Space API
*
D QUSCRTUS PR ExtPgm('QUSCRTUS')
D UserSpc 20A const
D ExtAttr 10A const
D InitSize 10I 0 const
D InitVal 1A const
D PublicAuth 10A const
D Text 50A const
D Replace 10A const
D ErrorCode 32766A options(*varsize)

*
* retrieve pointer to user space API
*
D QUSPTRUS PR ExtPgm('QUSPTRUS')
D UserSpc 20A CONST
D Pointer *
*
* API error code structure
* (we inz to 0 to cause the APIs to return errors using normal
* OS/400 error handling)
*
D dsEC DS
D dsECBytesP 10I 0 INZ(0)
D dsECBytesA 10I 0 INZ(0)

D*****************************************************
D* List API header data structure
D
D*****************************************************
D p_UsrSpc S *
D dsLH DS BASED(p_UsrSpc)
D* Filler
D dsLHFill1 103A
D* Status
D* Status (I=Incomplete,C=Complete
D* F=Partially Complete)
D dsLHStatus 1A
D* Filler
D dsLHFill2 12A
D* Header Offset
D dsLHHdrOff 10I 0
D* Header Size
D dsLHHdrSiz 10I 0
D* List Offset
D dsLHLstOff 10I 0
D* List Size
D dsLHLstSiz 10I 0
D* Count of Entries in List
D dsLHEntCnt 10I 0
D* Size of a single entry
D dsLHEntSiz 10I 0

D p_Job S *
D dsJob DS based(p_Job)
D dsJobName 10A
D dsJobUser 10A
D dsJobNbr 6A
D dsJobIntID 16A
D dsJobSts 10A
D dsJobType 1A
D dsJobSubType 1A
D dsJobReserv 2A
D dsJobInfSts 1A
D dsJobReserv2 3A
D dsJobNbrFlds 10I 0
D dsJobKeyAry 1A

D p_KeyAry S *
D dsKeyAry DS based(p_KeyAry)
D dsKA_Len 10I 0
D dsKA_Field 10I 0
D dsKA_Type 1A
D dsKA_Reserv 3A
D dsKA_DtaLen 10I 0
D dsKA_Data 20A

* Used with the QWCRSVAL api
D QwcrDs DS
D BytesRtn 1 4B 0
D BytesAvl 5 8B 0
D JobStatus 9 18
D IntJobId 19 34
D FullJobNam 35 60

* Used with the QWCRSVAL api
D QUSEC DS
D QUSBPRV 1 4B 0
D QUSBAVL 5 8B 0
D QUSEI 9 15
D QUSERVED 16 16
D QUSED01 17 116

* Used with the QUSRJOBI api
D Job_Inf DS 256
d JobName 9 18
d JobUser 19 28
d JobNumber 29 34
d InternalId 35 50
d Status 51 60
D JobType 61 61
D JobSubType 62 62
D Subsystem 63 72
D JobRunPty 73 76b 0
D SystemPool 77 80b 0
D ProcessUnit 81 84b 0
D AuxRequests 85 88b 0
D InteractTrans 89 92b 0
D TotRespTime 93 96b 0
d FunctionType 97 97
D FunctionName 98 107
D ActJobStatus 108 111
D Reserved 112 112
D DBLockWait 113 116b 0
D NDBLockWait 117 120b 0
D MchLockWait 121 124b 0
D TimeDBLckW 125 127
D TimeNDBLckW 128 130
D TimeMchLckW 131 133

D JOBLIST C 'JOBLIST QTEMP'
D SBSDNAME C 1906

D Inf_Len S 4B 0
D peSbsName S 10A
D msg s 50A
D Ent s 10I 0

* Used with the QWCRSVAL api
D FormatName s 8 inz('JOBS0200')
D IntJobName s 16
D ReceiveLen s 10I 0 inz(60)

*
* Check parms
*

C *entry plist
C parm peSbsName
C parm MessageWait 1
C Eval MessageWait = ' '

C if %parms< 1
C eval msg = 'You need to pass a subsystem'
C dsply msg
C eval *inlr = *on
C return
C endif

*
* Create a user space
*
C callp QUSCRTUS(JOBLIST: 'USRSPC':
C %size(dsJob) * 1000: *Blank:
C '*ALL': 'List of jobs on system':
C '*YES': dsEC)

*
* List jobs to the user space
*
C callp QUSLJOB(JOBLIST: 'JOBL0200':
C '*ALL *ALL *ALL':
C '*ACTIVE':
C dsEC: '*': 1: SBSDNAME)

*
* Read entries in user space
*
C callp QUSPTRUS(JOBLIST: p_UsrSpc)

C for Ent = 0 to (dsLHEntCnt - 1)

C eval p_Job = p_UsrSpc + dsLHLstOff +
C (dsLhEntSiz * Ent)
C eval p_KeyAry = %addr(dsJobKeyAry)

C if dsKA_Field<> SBSDNAME
C or dsKA_Type<> 'C'
C or dsKA_DtaLen<> 20
C*** eval msg = 'Unknown key in key array'
C*** dsply msg
C*** leave
C endif

** only jobs in requested subsystem.
** and ignore subsystem monitor jobs.
C if %subst(dsKA_Data: 1: 10) = peSbsName
C and dsJobType<> 'M'
C Eval Job_Qual = dsJobName + dsJobUser +
C dsJobNbr
* Call the API to retrieve the WRKACTJOB info for this job:
C call 'QUSRJOBI'
C parm Job_Inf
C parm 256 INF_Len
C parm 'JOBI0200' Api_Format 8
C parm Job_Qual 26
C parm *BLANKS Job_Int 16

C If ActJobStatus = 'MSGW'

C CLEAR @79 79
C MOVEA CMDS(1) @29 29
C @29 CAT dsJobNbr:0 @79
C CAT '/':0 @79
C CAT dsJobUser:0 @79
C CAT '/':0 @79
C CAT dsJobName:0 @79
C MOVEA CMDS(2) @29
C CAT @29:0 @79
C Z-ADD 79 #LEN 15 5
C CALL 'QCMDEXC'
C PARM @79
C PARM #LEN

C Eval MessageWait = 'Y'
C Return
C end

C end

C endfor

C eval *inlr = *on
C*** Call 'QWCRJBST'
C*** Parm QwcrDs
C*** Parm ReceiveLen
C*** Parm IntJobName
C*** Parm FormatName
C*** Parm QusEc
** CTDATA CMDS
ENDJOB JOB(
) OPTION(*IMMED)




-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Dennis
Sent: Tuesday, May 31, 2011 9:31 AM
To: RPG programming on the IBM i / System i
Subject: Re: ENDMSGW QUSLJOB API

Gonna need to see some code, I'm afraid. What I'd be looking for first: were the positions, offsets, et cetera hard-coded or retrieved/calculated from the results?
--
Sent from my Galaxy tablet phone with with K-9 Mail. Please excuse my brevity.

"Jon Allen"<jallen@xxxxxxxxx> wrote:

Hi, I have a job that runs every few minutes looking for *MSGW status
of a job in a particular subsystem, and if it finds a job in MSGW it
will automatically end it. This job has been working fine until we
upgraded to V6R1M0.

The program creates a user space (QUSCRTUS), then List's the jobs to
the user space (QUSLJOB using JOBL0200) then I read the entries in the
user space. My problem is that when I read the entries, the job info
DS (see below) is the same for every record. No job info, just numbers
in a few fields.

Has anyone run into this on V6R1M0 and have a solution? This program
is years old and has been working perfectly until now. Thanks!


JOBNAME OF JOB_INF = ' '
JOBUSER OF JOB_INF = ' '
JOBNUMBER OF JOB_INF = ' '
INTERNALID OF JOB_INF = ' '
STATUS OF JOB_INF = ' '
JOBTYPE OF JOB_INF = ' '
JOBSUBTYPE OF JOB_INF = ' '
SUBSYSTEM OF JOB_INF = ' '
JOBRUNPTY OF JOB_INF = 077952576.
SYSTEMPOOL OF JOB_INF = 077952576.
PROCESSUNIT OF JOB_INF = 077952576.
AUXREQUESTS OF JOB_INF = 077952576.
INTERACTTRANS OF JOB_INF = 077952576.
TOTRESPTIME OF JOB_INF = 077952576.
FUNCTIONTYPE OF JOB_INF = ' '
FUNCTIONNAME OF JOB_INF = ' '
ACTJOBSTATUS OF JOB_INF = ' '

________________________________
Important Confidentiality Notice: This email message, including all
attachments is for the exclusive use by the person(s) to whom it is
addressed, and may contain information that is confidential or
privileged. Any unauthorized review, use, disclosure or distribution is
prohibited under applicable law. If you have received this email in
error, please notify me immediately by reply email and delete this
message and any attachments. Thank you.
--
This is the RPG programming on the IBM i / System i (RPG400-L) mailing
list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.

--
This is the RPG programming on the IBM i / System i (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.


Important Confidentiality Notice: This email message, including all attachments is for the exclusive use by the person(s) to whom it is addressed, and may contain information that is confidential or privileged. Any unauthorized review, use, disclosure or distribution is prohibited under applicable law. If you have received this email in error, please notify me immediately by reply email and delete this message and any attachments. Thank you.