We have some jobs which are controled by message queues similar to data
queues. They get a special message for ending the job.
The task is to write a program, which sends the end-message and to wait,
until the jobs are ended, but we have an endless loop, if any of the
programs within the job crashes. That's why I'm looking for a way to
recognize the difference (for example via an API).
Hope somebody can help me! Alexander
You probably need the Retrieve Job Information (QUSRJOBI) API, which gives you
all kinds of information about a given job. If you need a list of all (or some)
jobs, look into the List Job (QUSLJOB) API.
They are documented in System API Reference - OS/400 Work Management APIs,
Document Number SC41-4878-01
Regards, Martin
the main problem is, that when a job waits for a message with RCVMSG
WAIT(*MAX), the status is MSGW.
If a program sends a message and waits for an answer, it's MSGW, too, which
is false, it should be ANSW, waiting for an answer.
But i do not think that this is changed in the future, as thousands of users
are educated to think that the status MSGW is telling that the job is
waiting for an answer. (A form of investment protection :-)
I do not know a method to tell the crashed ones from the waiting ones.
(Let me guess: Is it the recipe transmission from AS/400 to the UNIX system?
:-)
--
Anton Gombkötö
AS Software
http://www.assoft.com (Language: German)
Vienna, Austria, Europe
All opinions are mine, not necessarily those of AS Software.
Alexander Seeling wrote in message <6t6q35$l6b$2...@news.netway.at>...
I presume you want to know the difference when looking at active jobs. There's the obvious
"use option 7" to display the message and if you get a message indicating "not waiting for
a specific message" you know it's a RCVMSG, not an error.
I don't necessarily agree that you should use data queues rather than message queues for
your purposes. Data queues have some associated adminstrative requirements (cleanup,
etc.), whereas message queues don't have those issues (not the same type, anyhow).
Further, some monitor jobs might be monitoring for messages to arrive in a message queue
as a means of automation. In this case data queues won't help.
There is a solution, and one I suggest and use. Place monitor jobs (those with RCVMSG) in
their own subsystem(s), and only run these jobs in those subsystems. You can then
determine what MSGW by virtue of the subsystem in which it is running.
Gary Guthrie
Editor, The RPG Source
Technical Editor, NEWS/400 magazine
As you've apparently already discovered, there's no easy way to determine the
difference (although I'd sure like to see a response if a way is known).
There are only a couple of real answers that I'm aware of. First, there
shouldn't be any conflicts because the application should be handling
exceptions. (I know, it isn't always the case.) And second, don't use RCVMSG,
but use RCVDTAQ (via the API of course) or some other signalling mechanism.
Tom Liotta
In article <6t6q35$l6b$2...@news.netway.at>,
"Alexander Seeling" <alex.seelin...@hausleitner.at> wrote:
> Does anybody know a way to distinguish in a program between a job in status
> MSGW because of an escape message and a job, which is waiting for no special
> message.
>
> We have some jobs which are controled by message queues similar to data
> queues. They get a special message for ending the job.
>
> The task is to write a program, which sends the end-message and to wait,
> until the jobs are ended, but we have an endless loop, if any of the
> programs within the job crashes. That's why I'm looking for a way to
> recognize the difference (for example via an API).
>
> Hope somebody can help me! Alexander
>
>
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
http://www.dejanews.com/rg_mkgrp.xp Create Your Own Free Member Forum
In other words, he didn't know which of his jobs were monitor jobs.
As for the situation you describe - all jobs should, but monitor jobs particularly should,
have sufficient error handling code to prevent a message wait status due to an error. I
guess the bottom line is that unless a person is willing to write truly robust code,
there's no guarantees.
It would be helpful to know more specifics about the questioners problem(s) and goal(s).
As I mentioned, if he just wants to know when he's looking at the WRKACTJOB screen (or any
other WRK* command that shows the same stuff) option 7 to display messages will work fine.
If there is a need to find out in a program what the reason for the MSGW status is, there
are some options, but they will vary depending on whether the message queues are locked
exclusively or not. You can examine the call stack of the job in MSGW status and if
QMHRCVPM is the last program it's an inquiry message on the message queue awaiting a
response. QMHRCVMS indicates a RCVMSG command is the culprit. This will likely be the next
to last program in the stack, followed by QMHRCVM. You can write some low-level code to
work with system objects to determine what is at the root of MSGW, but that gets involved.
Gary Guthrie
Editor, The RPG Source
Technical Editor, NEWS/400 magazine
> I'm not sure I understand. How will that tell the difference between when the
> monitor job is doing it's normal RCVMSG and when it's in MSGW due to an error,
> possibly waiting on a response from QSYSOPR?
>
> As I understood the original question, that's the distinction the poster was
> trying to make.
>
I'm not sure I understand. How will that tell the difference between when the
monitor job is doing it's normal RCVMSG and when it's in MSGW due to an error,
possibly waiting on a response from QSYSOPR?
As I understood the original question, that's the distinction the poster was
trying to make.
Tom Liotta
In article <35F88C8E...@airmail.net>,
> Gary Guthrie
> Editor, The RPG Source
> Technical Editor, NEWS/400 magazine
>
-----== Posted via Deja News, The Leader in Internet Discussion ==-----
I've checked the APIs QUSRJOBI and QUSLJOB and they offer an enormous
amount of possibilities, but I can't find a way to distinguish between the
MSGW-status because of an error and the MSGW-status because of RCVMSG
WAIT(*MAX).
On the WRKACTJOB screen you can choose '7 = show messages' for a Job with
status MSGW. If the reason for the MSGW is an error, the message is
displayed, else a message with ID CPI1150 is displayed. So how do they
recognize the difference?
Do I have to analyse the QSYSOPR message queue :-(((
Are there any other alternatives?
Regards, Alexander
Martin Neugebauer schrieb in Nachricht <35F78F7E...@xpoint.at>...
>Hi Alex!
>
>You probably need the Retrieve Job Information (QUSRJOBI) API, which gives
you
>all kinds of information about a given job. If you need a list of all (or
some)
>jobs, look into the List Job (QUSLJOB) API.
>
>They are documented in System API Reference - OS/400 Work Management APIs,
>Document Number SC41-4878-01
>
>Regards, Martin
>
>
Alex
Gary Guthrie schrieb in Nachricht <35F9F90D...@airmail.net>...
>You may be right, I don't know. I read the post to mean he wanted to
distinguish between
>jobs that were monitor jobs in MSGW status and non-monitor jobs that were
in MSGW status.
>
>In other words, he didn't know which of his jobs were monitor jobs.
>
>As for the situation you describe - all jobs should, but monitor jobs
particularly should,
>have sufficient error handling code to prevent a message wait status due to
an error. I
>guess the bottom line is that unless a person is willing to write truly
robust code,
>there's no guarantees.
>
>It would be helpful to know more specifics about the questioners problem(s)
and goal(s).
>As I mentioned, if he just wants to know when he's looking at the WRKACTJOB
screen (or any
>other WRK* command that shows the same stuff) option 7 to display messages
will work fine.
>
>If there is a need to find out in a program what the reason for the MSGW
status is, there
>are some options, but they will vary depending on whether the message
queues are locked
>exclusively or not. You can examine the call stack of the job in MSGW
status and if
>QMHRCVPM is the last program it's an inquiry message on the message queue
awaiting a
>response. QMHRCVMS indicates a RCVMSG command is the culprit. This will
likely be the next
>to last program in the stack, followed by QMHRCVM. You can write some
low-level code to
>work with system objects to determine what is at the root of MSGW, but that
gets involved.
>
>Gary Guthrie
>Editor, The RPG Source
>Technical Editor, NEWS/400 magazine
>
>
>
I understand the general inability to distinguish between the two scenarios of MSGW status
when looking at a WRKACTJOB screen, but...
Are you wanting to figure out how to do it when looking at the WRKACTJOB panel? I think
probably not, since you can use option 7 to determine if it's awaiting a reply to an error
or just sitting on a RCVMSG statement.
Are you wanting some way for a PROGRAM to distinguish the difference?
If you can give me specific info it would help.
Thanks.
Instead of having your batch jobs monitoring a message queue for a shut down
message, have them monitor a data queue instead. Your shutdown program can
then send the shut down message to the data queues of those jobs that are
not at MSGW status. It could then be assumed that the jobs at MSGW are
waiting on an inquiry message.
An even better method is to have your programs simply check the SHUTDN (RPG)
op code to see if a controlled shut down has been requested. Your shut down
program could then issue a Controlled shut down with a really long delay
time.
This is the method we use for our background batch jobs.
Alexander Seeling wrote in message <6tedbb$cho$1...@news.netway.at>...
Hope you help.
Tadashi Kakefuda :tada...@tk.airnet.ne.jp
CMD:JOBCHK
--------
CMD PROMPT('JOB STATUS CHECK')
PARM KWD(STATUS) TYPE(STSLIST) PROMPT('JOB STATUS')
PARM KWD(PRINT) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) PROMPT('PRINT +
JOBLOG')
PARM KWD(MSG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) PROMPT('SEND +
MESSAGE')
PARM KWD(TOUSR) TYPE(USRLIST) PROMPT('USER NAME')
DEP CTL(&MSG *EQ *YES) PARM((TOUSR))
STSLIST: ELEM TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*MSGW) +
SPCVAL((*MSGW MSGW) (*LCKW LCKW) (*SRQ +
SRQ) (*NONE NONE))
ELEM TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*LCKW) +
SPCVAL((*MSGW MSGW) (*LCKW LCKW) (*SRQ +
SRQ) (*NONE NONE))
ELEM TYPE(*CHAR) LEN(4) RSTD(*YES) DFT(*SRQ) +
SPCVAL((*MSGW MSGW) (*LCKW LCKW) (*SRQ +
SRQ) (*NONE NONE))
USRLIST: ELEM TYPE(*NAME) LEN(10)
ELEM TYPE(*NAME) LEN(10)
ELEM TYPE(*NAME) LEN(10)
CLP:JOBCHKCL
/* JOB CHECKER */
/* BY T.KAKEFUDA 92.06.09 */
/* */
PGM (&STATUS &PRINT &MESSAGE &TOUSR)
DCL &STATUS *CHAR 14 /* PARM. CHECKED JOB-STATUS */
DCL &STS1 *CHAR 4
DCL &STS2 *CHAR 4
DCL &STS3 *CHAR 4
DCL &PRINT *CHAR 4 /* PARM. DO DSPJOB OUTFILE(*PRINT)? */
DCL &MESSAGE *CHAR 4 /* PARM. SEND INFROAMTION ? */
DCL &TOUSR *CHAR 32 /* PARM. TO WHOM SEND MESSAGE ? */
DCL &TOUSR1 *CHAR 10
DCL &TOUSR2 *CHAR 10
DCL &TOUSR3 *CHAR 10
DCL &USR_SPACE *CHAR 20 'JOBLIST QTEMP '
DCL &JOB_JOB *CHAR 26 '*ALL *ALL *ALL '
DCL &JOB_STS *CHAR 10 '*ACTIVE'
DCL &JOB_JOBI *CHAR 26 '*INT '
DCL &JOB_INFO *CHAR 52
DCL &JOB_NAME *CHAR 10
DCL &JOB_USER *CHAR 10
DCL &JOB_JOBNO *CHAR 6
DCL &JOB_FULL *CHAR 28
DCL &JOB_INT# *CHAR 16
DCL &JOB_TYPE *CHAR 1
DCL &JOB_STATUS *CHAR 4
DCL &RTV_DATA *CHAR 16
DCL &RCV_DATA *CHAR 111
DCL &MSG *CHAR 250
/* FOR DECIMAL */
DCL &RTV_START *DEC (9 0)
DCL &RTV_LNGTH *DEC (9 0)
DCL &LST_OFFSET *DEC (9 0)
DCL &LST_COUNT *DEC (9 0)
DCL &LST_SIZE *DEC (9 0)
DCL &WRK_COUNT *DEC (5 0) /* COUNTER */
/* FOR BINARY */
DCL &RTV_STARTB *CHAR 4
DCL &RTV_LNGTHB *CHAR 4
DCL &LST_OFSETB *CHAR 4
DCL &LST_COUNTB *CHAR 4
DCL &LST_SIZEB *CHAR 4
MONMSG CPF0000 *N GOTO RETURN
/*--------------------------------------*/
/* INITIALIZE ROUTINE */
/*--------------------------------------*/
/* &STATUS IS RESOLVED INTO 3 WORK FILEDS */
CHGVAR &STS1 %SST(&STATUS 3 4)
CHGVAR &STS2 %SST(&STATUS 7 4)
CHGVAR &STS3 %SST(&STATUS 11 4)
IF (&MESSAGE ='*YES') DO
CHGVAR &TOUSR1 %SST(&TOUSR 3 10)
CHGVAR &TOUSR2 %SST(&TOUSR 13 10)
CHGVAR &TOUSR3 %SST(&TOUSR 23 10)
IF (&TOUSR1='*REQUESTER') RTVUSRPRF MSGQ(&TOUSR1)
IF (&TOUSR2='*REQUESTER') RTVUSRPRF MSGQ(&TOUSR2)
IF (&TOUSR3='*REQUESTER') RTVUSRPRF MSGQ(&TOUSR3)
IF (&TOUSR1^=' ') CHKOBJ &TOUSR1 *MSGQ
IF (&TOUSR2^=' ') CHKOBJ &TOUSR2 *MSGQ
IF (&TOUSR3^=' ') CHKOBJ &TOUSR3 *MSGQ
ENDDO
/*--------------------------------------*/
/* MAIN ROUTINE */
/*--------------------------------------*/
/* CREATE USER SPACE */
CHKOBJ %SST(&USR_SPACE 11 10)/%SST(&USR_SPACE 1 10) *USRSPC
MONMSG CPF9801 *N CALL QUSCRTUS +
(&USR_SPACE 'WRK ' X'00001000' ' ' '*ALL' 'WORK USER SPACE')
/* SET A JOB LIST INTO THE USER SPACE */
RETRY:
CHGVAR &WRK_COUNT 0
CALL QUSLJOB (&USR_SPACE 'JOBL0100' &JOB_JOB &JOB_STS)
/* RETRIEVE HEADER INFORMATION OF THE JOB LIST FROM THE USER SPACE */
CHGVAR %BIN(&RTV_STARTB) 125
CHGVAR %BIN(&RTV_LNGTHB) 16
CALL QUSRTVUS (&USR_SPACE &RTV_STARTB &RTV_LNGTHB &RTV_DATA)
CHGVAR &LST_COUNTB %SST(&RTV_DATA 9 4)
CHGVAR &LST_COUNT %BIN(&LST_COUNTB)
IF (&LST_COUNT = 0 ) GOTO NEXT /* NO DATA IN THE LIST */
CHGVAR &LST_OFSETB %SST(&RTV_DATA 1 4)
CHGVAR &LST_OFFSET %BIN(&LST_OFSETB)
CHGVAR &LST_SIZEB %SST(&RTV_DATA 13 4)
CHGVAR &LST_SIZE %BIN(&LST_SIZEB)
CHGVAR &RTV_START (&LST_OFFSET + 1)
CHGVAR %BIN(&RTV_STARTB) &RTV_START
CHGVAR &RTV_LNGTH &LST_SIZE
CHGVAR %BIN(&RTV_LNGTHB) &RTV_LNGTH
/* RETRIEVE LIST DATA FROM THE USER SPACE */
RTV_JOB:CHGVAR &WRK_COUNT (&WRK_COUNT + 1) /* COUNT UP */
CALL QUSRTVUS (&USR_SPACE &RTV_STARTB &RTV_LNGTHB &JOB_INFO)
/* GET THE JOB INFORMATION BY RETRIEVED DATA. */
CHGVAR &JOB_INT# %SST(&JOB_INFO 27 16)
CALL QUSRJOBI (&RCV_DATA X'0000006F' 'JOBI0200' &JOB_JOBI &JOB_INT#)
MONMSG CPF0000 *N GOTO SKIP
CHGVAR &JOB_TYPE %SST(&RCV_DATA 61 1)
CHGVAR &JOB_STATUS %SST(&RCV_DATA 108 4)
/* IF IT IS BATCH JOB OR IT IS INTERACTIVE JOB,CHECK STATUS OF IT.*/
IF (&JOB_TYPE='B' | &JOB_TYPE='I') DO
IF (&JOB_STATUS=&STS1 | &JOB_STATUS=&STS2 | &JOB_STATUS=&STS3) DO
CHGVAR &JOB_NAME %SST(&RCV_DATA 9 10)
CHGVAR &JOB_USER %SST(&RCV_DATA 19 10)
CHGVAR &JOB_JOBNO %SST(&RCV_DATA 29 6)
IF (&PRINT ='*YES') DSPJOB &JOB_JOBNO/&JOB_USER/&JOB_NAME *PRINT
IF (&MESSAGE='*YES') DO
CHGVAR &JOB_FULL (&JOB_NAME|<'/'|<&JOB_USER|<'/'|< &JOB_JOBNO)
CHGVAR &MSG +
('Job '|<&JOB_FULL|<' is '|<&JOB_STATUS|<' ! ')
IF (&TOUSR1^=' ') SNDPGMMSG MSG(&MSG) TOUSR(&TOUSR1)
IF (&TOUSR2^=' ') SNDPGMMSG MSG(&MSG) TOUSR(&TOUSR2)
IF (&TOUSR3^=' ') SNDPGMMSG MSG(&MSG) TOUSR(&TOUSR3)
ENDDO
ENDDO
ENDDO
SKIP: IF (&LST_COUNT = &WRK_COUNT) GOTO NEXT
CHGVAR &RTV_START (&RTV_START + &LST_SIZE)
CHGVAR %BIN(&RTV_STARTB) &RTV_START
GOTO RTV_JOB
/* RETRY AFTER 10 MINUTES */
NEXT:
DLYJOB DLY(600)
GOTO RETRY
RETURN: RETURN
ENDPGM
But it seems as if I have already a solution for it (thanks Tadashi)!
Alexander
Gary Guthrie schrieb in Nachricht <35FAD3EE...@airmail.net>...
API QUSRJOBI (the API Tadashi's program uses) will return the status of the job as MSGW,
but it does not distinguish between the two possibilities I thought you were trying to
determine.
If memory serves me, you can't modify the existing programs so here's some more food for
thought.
I mentioned retrieving the program stack before, so I won't go over that again.
If your environment is such that you can obtain an exclusive lock on message queue
QSYSOPR, you could add logic to RCVMSG for inquiry messages, specifying the SENDER
parameter. The first 26 bytes of the message data will contain the job name with the
outstanding inquiry message. If it's one of your monitor job names, chances are you've
crashed. You can also look at the message data at position 27 to see if the FROM program
name is QCLXERR.
I hope this helps.
Regards, Chuck
-- Comments provided "as is" with no warranties of any kind whatsoever.
I must apologize to you. My program is not the one you needed. Maybe you
noticed it already. I'm so sorry. I try to reach you by the e-mail but the
error message came.
I'll try to make some another program by message API. If I success, I will
post again.
After I submitted one program, and it stopped by some errors, a message
came. But when I submit another program, in which RCVMSG WAIT(*MAX) is used,
there comes no message. So, I GUESS there is some way to distinguish it.
Anyway, I'm sorry again.
CU
Now, I have no time for making a program, but I find there is an API that
can do with your task. QMHLJOBL will be help you.
I think that MSGW ,caused by a program error, requires the reply. And MSGW
that caused by RCVMSG doesn't require it. And it seems that QMHLJOBL can
retrieve message information by job ID and message type or so on.
Please take a look at API manual.
Tadashi:tada...@tk.airnet.ne.jp
Alexander
Tadashi Kakefuda schrieb in Nachricht
<6u5j2a$ac8$1...@news1.tokyo.airnet.ne.jp>...
I will post here also, because I've a kind of responsibility of my article here.
This is my sample program that distinguish between MSGW by errors and MSGW by
RCVMSG.
Paramater STSRPY='W' means MSGW by errors, and 'N' means MSGW by RCVMSG.
I'm sorry it a long source.
Recently API becomes complex and hard to make. To IBM, Would you give us a book
of samples of
ALL APIs?
BTW, can I attach a file in this case in this news group??
H 1 Y/ 1
E****************************************************
E* A R R A Y T A B L E *
E****************************************************
E ID 1 29 4 :
I******************************************************
I* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
IUSRSPC DS
I I 'JOBLOGMSG' 1 10 USNAME
I I 'QTEMP' 11 20 USLIB
I* QUSRTVUS
IRCVVAR DS
I B 1 40OFFSTH
I B 5 80LSTSZH
I B 9 120OFFSET
I B 13 160LSTSSZ
I B 17 200NOENTR
I B 21 240LSTSIZ
IIDCHR IDS
I B 1 40IDBIN
I* JSLT0100
IQMHBJ IDS
I B 1 40QMHBJB
I 5 14 QMHBJC
I 15 24 QMHBJD
I 25 34 QMHBJF
I 35 40 QMHBJG
I 41 56 QMHBJH
I 57 60 QMHBJJ
I B 61 640QMHBJK
I B 65 680QMHBJL
I B 69 720QMHBJM
I B 73 760QMHBJN
I B 77 800QMHBJP
I B 81 840QMHBJQ
I 85 200 DSIDS
I 201 204 DSMSGQ
I IDS
I B 1 40MSGSIZ
I IDS
I B 1 40USSIZE
I B 5 80LENDTA
I B 9 120STRPO1
I B 13 160STRPO2
IPBERR DS
I I 116 B 1 40BYTPRV
I I 0 B 5 80BYTAVA
I 9 15 ERRID
I 16 16 ERR###
I 17 272 ERRDTA
I* LJOB0100 (1)
IQMHBG IDS
I B 1 40QMHBGB
I B 5 80QMHBGC
I B 9 120QMHBGD
I B 13 160QMHBGF
I 17 23 QMHBGG
I 24 25 QMHBGH
I 26 29 QMHBGJ
I 30 39 QMHBGK
I 40 49 QMHBGL
I 50 56 QMHBGM
I 57 62 QMHBGN
I 63 63 QMHBGP
I* LJOB0100 (2) ARRAY
IQMHBH IDS
I B 1 40QMHBHB
I B 5 80QMHBHC
I B 9 120QMHBHD
I 13 13 QMHBHF
I 14 14 QMHBHG
I 15 28 QMHBHH
I B 29 320QMHBHJ
I* 200 BYTE.
I 33 233 QMHBHK
C******************************************************
C* DEFINITION MODULE ( PLIST FIELD KLIST ) *
C******************************************************
C* :
C* DEFINE ENTRY :
C* :
C *ENTRY PLIST :
C PARM PITYP 1 :1=JOB,USR,JB#,2=*INT
C PARM PIJOB 10 :
C PARM PIUSR 10 :
C PARM PIJOB# 6 :
C PARM PIINT 16 :
C PARM STSRPY :
C******************************************************
C* M A I N - R O U T I N E :
C******************************************************
C EXSR @PARM :
C* :
C EXSR @SPRED :
C* ERROR OCCURS :
B001 C BYTAVA IFNE 0 :
001 C DUMP :
+001 C ELSE :
001 C EXSR @RTV :
B002 C NOENTR IFNE 0 :
002 C EXSR @DTLH :
E002 C END :
E001 C END :
C* :
C MOVE *ON *INLR :
C RETRN :
C******************************************************
C* S U B - R O U T I N E
C******************************************************
C*----------------------------------------------------*
C *INZSR BEGSR :
C*----------------------------------------------------*
C* MAKE USER SPACE :
C* THIS PGM MAKE OR REPLACE USESPACE EVRY TIME. :
C* IF YOU DON'T LIKE IT, REMAKE HERE. :
C* :
C CALL 'QUSCRTUS' :
C PARM USRSPC :
C PARM *BLANK EXTATR 10 :
C PARM 3000 USSIZE :
C PARM X'00' USINIT 1 :
C PARM '*ALL' USAUTH 10 :
C PARM *BLANK USTEXT 50 :
C PARM '*YES' USREPL 10 :
C PARM PBERR :
C* :
B001 C BYTAVA IFNE 0 :
001 C DUMP :
001 C MOVE *ON *INLR :
001 C RETRN :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PARM BEGSR :
C*----------------------------------------------------*
C MOVE *BLANK STSRPY :
C* :
B001 C PITYP IFEQ '1' :
001 C MOVE *BLANK PIINT :
+001 C ELSE :
001 C MOVEL'*INT' PIJOB P :
001 C MOVE *BLANK PIUSR :
001 C MOVE *BLANK PIJOB# :
E001 C END :
C* HOW MAY TIMES GET THE MSG FORM JOBLOG ? (*NOMAX=-1):
C* YOU'VE GOT TO CHECK THE VALUE BEOREHAND. :
C* IN THIS PGM, IT IS 1 'CAUSE OF GETTING ONLY THE LAST MSG IN LOG.
C Z-ADD1 QMHBJB :
C* DIRECTION OF RTV MSG :
C MOVEL'*PRV ' QMHBJC :OR *NEXT
C MOVE *HIVAL QMHBJJ :OR *LOVAL
C* SET JOB INFORMATION :
C MOVELPIJOB QMHBJD :
C MOVELPIUSR QMHBJF :
C MOVELPIJOB# QMHBJG :
C MOVELPIINT QMHBJH :
C* MAX LENGHT OF MSG, MAX LENGTH OF MSG HELP (*NOMAX=-1)
C Z-ADD200 QMHBJK :
C Z-ADD200 QMHBJL :
C* OFFSET OF IDS ( 85 - 1 = 84 ) FIXED :START FROM 0.
C Z-ADD84 QMHBJM :
C* SET IDS FROM ARRAY 'ID' :
B001 C 1 DO 29 II 30 :
B002 C ID,II IFEQ *BLANK :
002 C Z-ADD0 IDBIN :
002 C CAT IDCHR:0 DSIDS :A MUST !
+002 C ELSE :
002 C Z-ADD0 IDBIN :
002 C MOVE ID,II IDBIN :
002 C CAT IDCHR:0 DSIDS :
002 C ADD 1 QMHBJN :CNT OF IDS
E002 C END :
E001 C END :
C* OFFSET OF MSGQ ; NEXT TO IDS (LEN=4,QTY=29) :
C 4 MULT 29 W1LEN 50 :LEN OF IDS
C QMHBJM ADD W1LEN QMHBJP :
C* MSGQ (* OR *EXT) AND IT'S LENGTH :
C MOVEL'*' DSMSGQ :OR *EXT
C ' ' CHEKRDSMSGQ:1 QMHBJQ :GET LEN OF MSGQ
C* GET LENGTH OF WHOLE OF QMHBJ :
C ' ' CHEKRQMHBJ MSGSIZ :GET LEN OF QMHBJ
C* :
C ENDSR :
C*----------------------------------------------------*
C @SPRED BEGSR :
C*----------------------------------------------------*
C CALL 'QMHLJOBL' :
C PARM USRSPC :
C PARM 'LJOB0100'FMTNAM 8 :
C PARM QMHBJ :
C PARM MSGSIZ :
C PARM 'JSLT0100'MSGFMT 8 :
C PARM PBERR :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RTV BEGSR :
C*----------------------------------------------------*
C* GET GENERAL HEADER INFORAMTION IN USERSPACE. :
C* ATTENTION: THE VALUE OF LSTSIZ (IN RCVVAR) IS 0 .. WHY?
C CALL 'QUSRTVUS' :
C PARM USRSPC :
C PARM 117 STRPO1 :
C PARM 24 LENDTA :
C PARM RCVVAR :
C OFFSET ADD 1 STRPO1 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DTLH BEGSR :
C*----------------------------------------------------*
C* THE LENGTH OF QMHBG IS 63. :
B001 C 1 DO NOENTR :
001 C CALL 'QUSRTVUS' :
001 C PARM USRSPC :
001 C PARM STRPO1 :
001 C PARM 63 LENDTA :LEN OF QMHBG
001 C PARM QMHBG :
B002 C QMHBGD IFNE 0 :
002 C EXSR @DTLL :
E002 C END :
001 C QMHBGB ADD 1 STRPO1 :NEXT STR-POINT
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DTLL BEGSR :
C*----------------------------------------------------*
C* THE LENGTH OF QMHBH IS 233. :
C QMHBGC ADD 1 STRPO2 :OFFSET+1
C* :
B001 C 1 DO QMHBGD :
001 C CALL 'QUSRTVUS' :
001 C PARM USRSPC :
001 C PARM STRPO2 :
001 C PARM 233 LENDTA :
001 C PARM QMHBH :
001 C EXSR @INFO :
001 C QMHBHB ADD 1 STRPO2 :NEXT STR-POINT
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @INFO BEGSR :
C*----------------------------------------------------*
C* YOU CAN USE API-DATA HERE LIKE BELOW. :
C* MSGW BY ERROR=W, MSGW BY RCVMSG=N.
C* PLEASE CHECK IT BY DEBUGGER.
B001 C QMHBHD IFEQ 1001 :
001 C QMHBHJ SUBSTQMHBHK:1 STSRPY 1 :A,W,N
E001 C END :
C* MAYBE NEEDLESS (IT IS JUST AN EXAMPLE) :
B001 C QMHBHD IFEQ 1101 :
001 C QMHBHJ SUBSTQMHBHK:1 STSREQ 1 :O,C,N,' '
E001 C END :
C* MAYBE NEEDLESS (IT IS JUST AN EXAMPLE) :
B001 C QMHBHD IFEQ 302 :
*001 C QMHBHJ ANDLE200 :
001 C QMHBHJ SUBSTQMHBHK:1 MSGTXT200 :TEXT
E001 C END :
C* :
C ENDSR :
** IDS ; YOU CAN ADD IDS BELOW (IN THE ARRAY) UP TO 29.
1001 ; 1
1101 ; 2 YOU CAN OMIT HERE. IT IS AN EXAMPLE.
0302 ; 3 YOU CAN OMIT HERE. IT IS AN EXAMPLE.
; 4
; 5
; 6
; 7
; 8
; 9
;10
;11
;12
;13
;14
;15
;16
;17
;18
;19
;20
;21
;22
;23
;24
;25
;26
;27
;28
;29
/* ---------------------------------------------------------*/
Tadashi Kakefuda
The Internet Mail Address ; tada...@tk.airnet.ne.jp
* Home Page ; http://www2c.airnet.ne.jp/as400/
* Private page ; http://www2c.airnet.ne.jp/as400/private/
/*----------------------------------------------------------*/