Re: QMHLJOBL API Example? -- MIDRANGE-L

Hello David,

I have the following example from John Henckel.  I hope it is useful.  It
is followed by some 
additional comments on the original append.

----- APPLPGMG CFORUM appended at 19:12:59 on 94/11/16 GMT (by HENCK at RCHVMV)
Subject: Removing messages from the jog log

I would like to put out some unsolicited advice on this topic.  It seems
that this is a fairly common problem when programming on the AS/400
and the solution eluded me for a long time.  Now that I came up with
how to do it, I thought others might benefit from it.

The problem is this
   PGMA calls PGMB
   PGMB gets some messages sent to itself
   PGMB returns to PGMA
   PGMA wants to remove the messages sent to PGMB
These messages are on the "call message queue" of an inactive call
stack entry (PGMB).  There are two ways (that I know of) for PGMA
to remove these from the job log -- a sledgehammer, or a scalpel.
PGMA can do RMVMSG *ALLINACT CLEAR(*ALL) which remove ALL messages
from the joblog that are to inactive programs.  This is the
sledgehammer!!!  A much better method is to use QMHLJOBL and loop
through the messages and remove by key the unwanted ones.
The following code shows how to do this is CL.

Warning!  It is not for the faint-hearted!!!

Notes:
I don't use very many comments, read the code.
x'400' is the userspace size.  You may need to make it bigger.
CPF9870 means the userspace already exists.
The most confusing thing here is that %SST and QUSRTVUS address the
data based on 1, but QMHLJOBL addresses it based on 0.  If you
use QUSRTVUS and %SST both then your offset is off by 2, e.g. the
CHGVARs right after the loop.  This is not a problem once you get used
to it.
This program looks at each message, if it is a CPF9801 or a blank
(blank msg ids are "impromptu" messages) or if the sender program
name was MYPGM, then remove the message from the joblog.  It is
probably not a good idea to remove all impromptu msgs because the
then you remove the ones with ">" beside them!  (from QMHGSD).
I just did it for illustrative purposes.
If you only want to look at msgid, you can change number of fields
to 0 and remove all the code to set &offset and &sender.
I wrote this with the help of V3R1 SPI guide chapter 42.

-------------------------------------------------------------------------
PGM
  DCL &SPACE      *CHAR 20 VALUE('LJOBL     QTEMP')
  DCL &BIN4       *CHAR 4
  DCL &OFFSET     *CHAR 4
  DCL &CNT *DEC LEN(5 0) VALUE(0)
  DCL &JSLT *CHAR 200 VALUE(' ')
  DCL &BUFFER *CHAR 200
  DCL &DESC *CHAR 50 VALUE(' ')
  DCL &MSGID *CHAR 7
  DCL &MSGKY *CHAR 4
  DCL &SENDER *CHAR 12

  CALL QUSCRTUS PARM(&SPACE +
          'USF400     ' X'00000400' ' ' '*CHANGE   ' &DESC)
    MONMSG CPF9870 EXEC(RCVMSG MSGTYPE(*LAST))

  /*  LIST THE 10 MOST RECENT MESSAGES IN THE JOB LOG            */

  CHGVAR %SST(&JSLT 1  4) X'0000000A'     /* MAX TO RETURN */
  CHGVAR %SST(&JSLT 5 11) '*PRV      *'
  CHGVAR %SST(&JSLT 57 4) X'FFFFFFFF'     /* LAST MSG FIRST */
  CHGVAR %SST(&JSLT 69 4) X'00000058'     /* OFFSET 89 */
  CHGVAR %SST(&JSLT 73 4) X'00000001'     /* NUMBER OF FIELDS */
  CHGVAR %SST(&JSLT 77 4) X'00000054'     /* OFFSET 85 */
  CHGVAR %SST(&JSLT 81 4) X'00000001'
  CHGVAR %SST(&JSLT 85 1) '*'             /* ALL MESSAGES */
  CHGVAR %SST(&JSLT 89 4) X'0000025B'     /* 603 IS SENDER PGM NAME */

  CALL QMHLJOBL PARM(&SPACE LJOB0100 &JSLT X'00000060' 'JSLT0100' +
         X'00000000')
  CALL QUSRTVUS PARM(&SPACE X'00000085' X'00000004' &BIN4)
  CHGVAR &CNT %BINARY(&BIN4)
  IF (&CNT = 0) THEN(GOTO NOMSG)
  CALL QUSRTVUS PARM(&SPACE X'0000007D' X'00000004' &BIN4)
LOOP:
  CALL QUSRTVUS PARM(&SPACE &BIN4 X'0000003E' &BUFFER)
  CHGVAR &BIN4   %SST(&BUFFER 2 4)     /* NEXT RECORD */
  CHGVAR &OFFSET %SST(&BUFFER 6 4)
  CHGVAR &MSGID  %SST(&BUFFER 18 7)
  CHGVAR &MSGKY  %SST(&BUFFER 27 4)
  CALL QUSRTVUS PARM(&SPACE &OFFSET X'0000003E' &BUFFER)
  CHGVAR &SENDER %SST(&BUFFER 34 12)    /* skip 32-byte data header */
  IF (&MSGID ='CPF9801') THEN(RMVMSG MSGKEY(&MSGKY))
  IF (&MSGID ='       ') THEN(RMVMSG MSGKEY(&MSGKY))
  IF (&SENDER='MYPGM') THEN(RMVMSG MSGKEY(&MSGKY))
  CHGVAR &CNT (&CNT - 1)
  IF (&CNT *GT 0) THEN(GOTO LOOP)
  RETURN
NOMSG:
  SNDPGMMSG 'No messages found!'
ENDPGM
-------------------------------------------------------------------------
John Henckel
----- APPLPGMG CFORUM appended at 21:46:59 on 94/11/16 GMT (by ACCOLA at
RCHVMX2)
Subject: Removing messages from the jog log
Ref:     Append at 19:12:59 on 94/11/16 GMT (by HENCK at RCHVMV)

Be careful when you are specifying hex values in CL. I've seen some
very strange errors that are a result of typing, for example,
x'000108' when you really mean x'00000108'.  If you do
   DCL &VAR *CHAR 4
   CHGVAR &VAR x'000108'
your variable will end up with x'00010840' because the CL compiler
pads with blanks.  Because x'10840' is much bigger than x'108', you
can get some really weird results.

An easy way to get avoid this problem is to use the %BINARY (or %BIN)
builtin to convert a decimal value to hexadecimal:
   CHGVAR %BINARY(&VAR) 264

For example, I would probably replace these statements from John's
program:
  CHGVAR %SST(&JSLT 1  4) X'0000000A'     /* MAX TO RETURN */
  CHGVAR %SST(&JSLT 69 4) X'00000058'     /* OFFSET 89 */
with these:
  CHGVAR %BIN(&JSLT 1  4) 10              /* MAX TO RETURN */
  CHGVAR %BIN(&JSLT 69 4) 88              /* OFFSET 89 */

Note: there seems to be a discrepancy between the code in the second
of these statements and the comment.  X'58' is the same as decimal 88,
not 89 as the comment seems to indicate.  %BIN can also help you avoid
decimal to hex conversion errors like this.  8-)

Julia Accola

----- APPLPGMG CFORUM appended at 04:56:46 on 94/11/17 GMT (by COULTERS at
SYDVM1)
Subject: Removing messages from the jog log
Ref:     Append at 21:46:59 on 94/11/16 GMT (by ACCOLA at RCHVMX2)

> Note: there seems to be a discrepancy between the code in the second
> of these statements and the comment.  X'58' is the same as decimal 88,
> not 89 as the comment seems to indicate.  %BIN can also help you avoid
> decimal to hex conversion errors like this.  8-)

This is just a misuse of the word OFFSET. The convention is that offsets
start at zero, positions start at one. As John stated %SST and QUSRTVUS
use starting position, but QMHLJOBL takes offsets to various parameters
in the parameter block.

    OFFSET 88 is equivalent to POSITION 89
    OFFSET 84 is equivalent to POSITION 85

The comments should use the word POSITION or reduce the value by one.

While using %BIN can be clearer that hardcoding HEX values, either method
would appear to be at odds with the comments.

Regards,                         | Australian Programming Centre,
Simon Coulter.                   | IBM A/NZ, Melbourne, Australia.
Seconded to ISSC Australia - Does 'Golgafrincham' mean anything to you?
VNet:COULTERS at SYDVM1   Internet:shc@vnet.ibm.com   BitNet:shc at vnet

----- APPLPGMG CFORUM appended at 20:08:18 on 94/11/21 GMT (by HENCK at RCHVMV)
Subject: Removing messages from the jog log
Ref:     Append at 21:46:59 on 94/11/16 GMT (by ACCOLA at RCHVMX2)

Julie,
I didn't know you could do that!  Thanks for the advice, suddenly
using binary numbers in CL is not so ugly.

Another useful enhancement is to make the user space automatically
get bigger so that you don't have to guess at the correct size.
After QUSCRTUS then insert this code...

   CHGVAR  %BIN(&ATTR 1 4) 1     /* number of attributes */
   CHGVAR  %BIN(&ATTR 5 4) 3     /* 3=auto extend */
   CHGVAR  %BIN(&ATTR 9 4) 1     /* data len */
   CHGVAR  %SST(&ATTR 13 1) '1'  /* yes */
   CHGVAR  %BIN(&ERR  1 4) 0     /* bytes provided */
   CALL QUSCUSAT PARM(&BUFFER &SPACE &ATTR &ERR)

You need to declare &ATTR and &ERR as *CHAR 13

John Henckel




Regards,
Simon Coulter.

//----------------------------------------------------------
// FlyByNight Software         AS/400 Technical Specialists
// Phone: +61 3 9419 0175      Mobile: +61 0411 091 400
// Fax:   +61 3 9419 0175      E-mail: shc@flybynight.com.au
// 
// Windoze should not be open at Warp speed.

X-Mailer: Mozilla 4.06 [en] (Win95; U)
Date: Fri, 02 Oct 98 10:11:55 -0500
From: "David Gibbs" <david.gibbs@mks.com>
To: "Midrange Mailing List" <MIDRANGE-L@midrange.com>
Reply-To: MIDRANGE-L@midrange.com
Cc: "Bill Freiberg" <bill.freiberg@mks.com>
Subject: QMHLJOBL API Example?

Folks:

Does anyone have a good example of how the QMHLJOBL api is used?

A developer in my office is trying to use the API, but is having
problems with the parameter groups.

TIA!

david

--

David Gibbs
Sr. Software Engineer
Mortice Kern Systems Development, Inc
900 Oakmont Ln, Suite 400
Westmont, IL  60559
DID: (630) 734-5451
http://www.mks.com
mailto:david.gibbs@mks.com

Opinions expressed are strictly my own and do
not necessarily reflect those of my employer

You'll only see your obstacles each time you take
     your eyes off of your goal!

                   -- DMRoth

begin:          vcard
fn:             David Gibbs
n:              Gibbs;David
org:            Mortice Kern Systems US, Inc.
adr:            900 Oakmont Lane, Suite 400;;;Westmont;IL;60074;USA
email;internet: david.gibbs@mks.com
title:          Sr. Software Engineer
tel;work:       (630) 734-5479
tel;fax:        (630) 655-6396
note;quoted-printable:Personal web page ...=0D=0A=
	http://www.midrange.com/david=0D=0A=
	
x-mozilla-cpt:  ;0
x-mozilla-html: TRUE
version:        2.1
end:            vcard