I do get many requests asking for whole example programs, especially ones with a subfile, rather than just bits and pieces of code that I usually give in these examples. With this in mind this post brings a number of things I have written about before together into one program, which I thought would be an interesting refresher. So here goes...
I was asked to write a program to only show jobs that are in message wait status, and I want to add the ability give the user some options that would allow the user to analyze the error and reply to it.
To summarize what I need to do:
- Get a list of all jobs in message wait status
- Load that information into a subfile to display
- Allow user to select one subfile record and then see the job's information
I have written about all of these in previous posts, so I will be referring to those posts from this one.
Let me get started with the definition section of the RPG program:
001 **free 002 ctl-opt option(*nodebugio:*srcstmt:*nounref:*showcpy) dftactgrp(*no) ; 003 dcl-ds Pgm extname('RPG4DS') psds qualified 004 end-ds ; 005 dcl-f CHKMSGWD workstn indds(Dspf) sfile(SFL01:Z1RRN) extfile('MYLIB/CHKMSGWD') ; 006 dcl-ds Dspf qualified ; 007 Exit ind pos(3) ; 008 Refresh ind pos(5) ; 009 DspSysOprMsg ind pos(7) ; 010 SflDspCtl ind pos(30) ; 011 SflDsp ind pos(31) ; 012 ProtectOption ind pos(40) ; 013 end-ds ; 014 dcl-ds Ds qualified dim(50) ; 015 JobName char(28) ; 016 Subsystem char(10) ; 017 User char(10) ; 018 JobType char(3) ; 019 JobStatus char(4) ; 020 Function char(10) ; 021 CpuTime packed(7) ; 022 end-ds ; 023 dcl-s String varchar(200) ; 024 dcl-s NbrOfRows packed(5) inz(%elem(DS)) ; 025 dcl-s RowsFetched packed(5) ; 026 Z1SCREEN = %trimr(Pgm.ProcNme) + '-1' ;
Line 1: The **FREE tells the compiler, and us, that this is written in totally free RPG.
Line 2: These are my standard control options, I use the OPTION keyword to define my compile options, and as I will be using procedures I specify DFTACTGRP(*NO).
Lines 3 and 4: I always use an externally described data structure to define the program status data structure. The QUALIFIED means that all of the data structure subfields have to be qualified with the data structure name.
Line 5: Here is the only file definition in the program, the display file. By stating it is a WORKSTN file I do not need to use the USAGE keyword. INDDS means that I am using an indicator data structure. SFILE gives the relative record field for the subfile. I have defined EXTFILE as this gives the library the display file is in. By using the EXTFILE the program can be called with needing the library the display file is in to be in the library list. I only use this for "utility" programs like this, I do not use it for display files in "application" programs.
Lines 6 – 13: Here is the indicator data structure for the display file. I hate using number indicators as they don't tell you what they mean. By using an indicator data structure I can give all of the indicators used in the display file a meaningful name. For example: Dspf.SflDsp tells me how this indicator is used, *IN31 does not.
Lines 14 – 22: This data structure array is what I will be using when I get the data, more on that later.
Line 23: The only thing of note with this line is that it is defined as a variable length character.
Line 24: This variable is initialized with a number that is the same as the number of elements in the data structure array. If I ever change the number of elements in the array I will not have to remember to change this variable too.
Line 26: By all means this is not a definition, but I am including here as it gets the program name from the program data structure and moves it to the program name field in the display file.
In the next piece of code I call the procedures to get the data and load the subfile.
027 GetData() ; 028 LoadSubfile() ;
I use, what I call, "open" subprocedures rather than subroutines. The difference between an "open" subprocedure and "closed" one is that the "open" lacks the procedure interface. This allows all of the variables defined in the main body of the program to be available to the "open" subprocedure, but any variables I define within the subprocedures are not available to the main body of the program.
Onto the first "open" subprocedure, which gets the data of the jobs in message wait status.
050 dcl-proc GetData ; 051 clear Ds ; 052 exec sql DECLARE C0 CURSOR FOR 053 SELECT JOB_NAME,SUBSYSTEM,AUTHORIZATION_NAME, 054 JOB_TYPE,JOB_STATUS,FUNCTION,CPU_TIME 055 FROM TABLE(QSYS2.ACTIVE_JOB_INFO(JOB_NAME_FILTER => '*ALL')) A 056 WHERE JOB_STATUS = 'MSGW' 057 ORDER BY ORDINAL_POSITION ; 058 exec sql OPEN C0 ; 059 exec sql FETCH C0 FOR :NbrOfRows ROWS INTO :Ds ; 060 exec sql GET DIAGNOSTICS :RowsFetched = ROW_COUNT ; 061 exec sql CLOSE C0 ; 062 end-proc ;
Line 50: All procedures start with a DCL-PROC, and end with an END-PROC, see line 62.
Line 51: I clear the data structure array that will be receiving the data as I don't know how many elements will be used and I don't want elements with data left over from the previous time it was loaded when I refresh.
Lines 52 – 57: Fortunately I do not have to mess around with APIs as the information about all the active jobs is available as a DB2 Table function, ACTIVE_JOB_INFO. I can just Select the columns/fields and the rows/records I want from this Table function. I am ordering/sorting it by the ordinal position, which is a unique number for each job with the lowest number being the oldest job.
Line 58: I open the cursor.
Line 59: This line is a fantastic "time saver" in terms of performance. I am getting more than one row in just one Fetch. The number of rows I am getting is held in the NbrOfRows variable, which is the number of number of elements in the data structure array. So in one I/O I am getting 50 rows, think of the time savings if I was to use a bigger value. But in this case I think 50 is more than enough, as I doubt if this IBM i ever has that many errors at one time. The fetched rows are loaded in the Data structure array, Ds.
Line 60: Later in this program I need to know how many elements in the array are used. By retrieving the number of rows fetched I have that number in the variable RowsFetched.
Line 61: I am all done with the cursor so I close it.
When this procedure ends all the data I need to load the subfile is held in the data structure array. This is what the next subprocedure, LoadSubfile, does. But before I explain the code in there it is best to give the DDS code for the display file.
Let me start with the file level keywords.
01 A DSPSIZ(24 80 *DS3) 02 A PRINT 03 A INDARA 04 A ERRSFL 05 A CA03(03 'F3=Exit') 06 A CA05(05 'F5=Refresh') 07 A CA07(07 'F7=DspMsg *Sysopr')
There are no surprises there. The INDARA, line 3, is the "other end" of RPG's indicator data area. The error subfile, line 4, means that the display file handles the error subfile rather than I having to write errors to the message subfile.
The subfile record format is straight forward.
08 A R SFL01 SFL 09 A Z1RRN 3S 0H 10 A Z1OPT 1A B 7 2 11 A 40 DSPATR(ND PR) 12 A JOBNAME 27 O 7 4 13 A SUBSYSTEM 10 O 7 32 14 A USER 10 O 7 43 15 A JOBTYPE 3 O 7 54 16 A JOBSTATUS 4 O 7 58 17 A FUNCTION 10 O 7 63 18 A CPUTIME 7Y 0O 7 74EDTCDE(Z)
The only thing to note is that for the Z1OPT field, line 10, when indicator 40 is on, line 11, the field is protected from input and non-displayed.
While the code for the control format is a lot longer than that of the subfile format, most of it is due to the formatting of the layout of the headings on the screen.
19 A R CTL01 SFLCTL(SFL01) 20 A SFLSIZ(0999) 21 A SFLPAG(0015) 22 A OVERLAY 23 A 31 SFLDSP 24 A 30 SFLDSPCTL 25 A N30 SFLDLT 26 A 30 SFLEND(*MORE) 27 A 1 2USER 28 A COLOR(BLU) 29 A 1 31'R P G P G M . C O M' 30 A DSPATR(HI) 31 A 1 63TIME 32 A COLOR(BLU) 33 A 1 72DATE 34 A EDTCDE(Y) 35 A COLOR(BLU) 36 A Z1SCREEN 12A O 2 2COLOR(BLU) 37 A 2 35'Jobs in MSGW' 38 A DSPATR(HI) 39 A 2 72SYSNAME 40 A COLOR(BLU) 41 A 3 2' - 42 A - 43 A ' 44 A COLOR(BLU) 45 A DSPATR(UL) 46 A 4 2'1=DSPJOB 2=WRKACTJOB user 3=Se- 47 A nd break msg' 48 A COLOR(BLU) 49 A 5 54'Job Job CPU' 50 A DSPATR(HI) 51 A 6 2'S Job name Subs- 52 A ystem User Typ Sts Function- 53 A time' 54 A DSPATR(UL) 55 A DSPATR(HI)
Line 19: CTL01 is the control format for the subfile SFL01.
Line 20: The subfile will have 999 records.
Line 21: 15 records will display on the screen at any one time.
Lines 20 and 21 give away that this is a "load all" type subfile.
Line 32: When *IN31 the subfile record format is displayed. As we are using an indicator area data structure *IN31 will be known by a real name in the RPG.
Line 24 – 26: *IN30 is being used to do a variety of tasks. When it is off it will delete the subfile. When it is on it will display the control record format and More... and Bottom to indicate that there is more than one page of the subfile.
I always like my screens to show the user, date, time, system, and program/screen id. The first three I can use Display file keywords. For user I can use the keyword USER (line 27), date DATE (line 33), time TIME (line 31), system SYSNAME (line 39), the only one I cannot get is the program/screen name (line 36) which I make in my RPG program.
The last record format, FOOT01, just displays which function keys can be used.
56 A R FOOT01 57 A 23 3'F3=Exit F5=Refresh F7=DspMsg - 58 A SysOpr' 59 A COLOR(BLU)
Back to the RPG program's subprocedure LoadSubfile. While it looks long it is simple.
063 dcl-proc LoadSubfile ; 064 Dspf.SflDspCtl = *off ; 065 Dspf.SflDsp = *off ; 066 write CTL01 ; 067 Dspf.SflDspCtl = *on ; 068 Dspf.SflDsp = *on ; 069 Z1OPT = ' ' ; 070 if (RowsFetched = 0) ; 071 clear SFL01 ; 072 JOBNAME = 'Hooray, no errors here' ; 073 Z1RRN = 1 ; 074 Dspf.ProtectOption = *on ; 075 write SFL01 ; 076 return ; 077 endif ; 078 Dspf.ProtectOption = *off ; 079 for Z1RRN = 1 to RowsFetched ; 080 JOBNAME = Ds(Z1RRN).JobName ; 081 SUBSYSTEM = Ds(Z1RRN).Subsystem ; 082 USER = Ds(Z1RRN).User ; 083 JOBTYPE = Ds(Z1RRN).JobType ; 084 JOBSTATUS = Ds(Z1RRN).JobStatus ; 085 FUNCTION = Ds(Z1RRN).Function ; 086 CPUTIME = Ds(Z1RRN).CpuTime ; 087 write SFL01 ; 088 endfor ; 089 end-proc ;
Lines 64 – 68: This is the part where I am deleting the existing subfile and replacing it will another new one.
Line 70 – 77: This is what I am going to do to the subfile if no rows were retrieved by the Fetch. I am going to write a message to the subfile that there are no errors, line 72, to the subfile and protect the option field from input by using the indicator Dspf.ProtectOption, which is *IN44 is the display file. To quit the subprocedure I use the return operation code, line 76, which I would want to do here as no rows were retrieved.
From this point on the subprocedure is very simple…
Lines 79 – 88: This is where I use the RowsFetched as I only want to perform the For loop for the same number of times as rows I fetched. From then on I am just moving the values from the data structure array subfields to the fields in the subfile record format, and then writing a subfile record.
Control returns to the main body of the program. From here all I do is to show the display file.
029 write FOOT01 ; 030 dow (1 = 1) ; 031 exfmt CTL01 ; 032 if (Dspf.Exit) ; 033 leave ; 034 elseif (Dspf.Refresh) ; 035 GetData() ; 036 LoadSubfile() ; 037 elseif (Dspf.DspSysOprMsg) ; 038 String = 'DSPMSG MSGQ(*SYSOPR)' ; 039 ExecuteCommand() ; 040 else ; 041 ReadSubfile() ; 042 endif ; 043 enddo ; 044 *inlr = *on ;
Line 29: I write bottom part of the display file as I will be using EXFMT with the control record format.
Line 30 - 43: The user remains in this Do loop until they press F3 to exit the program.
Line 31: I EXFMT the control format and wait for the user to do something.
If there were error messages the screen would look like:
SIMON R P G P G M . C O M TT:TT:TT DD/DD/DD CHKMSGW-1 Jobs in MSGW DEV730 1=DSPJOB 2=WRKACTJOB user 3=Send break msg Job Job CPU S Job name Subsystem User Typ Sts Function time _ 304922/ADMIN/WA1045C QBATCH ADMIN BCH MSGW WA0045C 652 _ 380832/SIMON/TESTCLP QPGMR SIMON BCH MSGW TESTCLP 7 F3=Exit F5=Refresh F7=DspMsg SysOpr
If there were no errors:
SIMON R P G P G M . C O M TT:TT:TT DD/DD/DD CHKMSGW-1 Jobs in MSGW DEV730 1=DSPJOB 2=WRKACTJOB user 3=Send break msg Job Job CPU S Job name Subsystem User Typ Sts Function time Hooray, no errors here
Next comes an IF-ELSEIF group. I could have used a Select group, but it is just a question of personal preference, and I prefer this way.
Lines 32 and 33: Dspf.Exit means that F3 was pressed, and the DO loop is exited.
Lines 34 – 36: Dspf.Refresh means that the F5=Refresh was pressed, data is fetched and the subfile loaded with it.
Lines 37 – 39: Dspf.DspSysOprMsg means that F7 was pressed to display the system operator messages. I move the command to be executed into the variable String, and then execute the subprocedure ExecuteCommand, no prizes for guessing what that subprocedure does.
Lines 40 and 41: If none of the above Ifs were executed the subprocedure ReadSubfile will be executed.
For all of you who were not able to guess what the subprocedure ExecuteCommand does it executes the command in String by calling the QCMDEXC API.
130 dcl-proc ExecuteCommand ; 131 dcl-pr QCMDEXC extpgm ; 132 *n char(200) options(*varsize) const ; 133 *n packed(15:5) const ; 134 end-pr ; 135 if (String <> ' ') ; 136 QCMDEXC(String:%len(%trim(String))) ; 137 endif ; 138 end-proc ;
Lines 131 – 134: This is the procedure definition to call the program QCMDEXC. I can tell it is a program as the EXTPGM keyword is present on line 131. As I called the procedure definition the same name as the program I do not have to give the program's name, just the EXTPGM.
Line 132: I don't both to give names to the parameters in the procedure definitions. This one will contain the commands, as the commands' length can vary I define it with the OPTIONS<(*VARSIZE).
Line 136: When there is a value in String I call QCMDEXC to execute it. The first parameter is the variable String, the second is the length of the text within String. There is no need for me to use another variable for that, I can just calculate it in the second parameter.
The next subprocedure reads the subfile to determine if the user put something next to one of the subfile's records, and then executes that command.
100 dcl-proc ReadSubfile ; 101 dow (1 = 1) ; 102 readc SFL01 ; 103 if (%eof) ; 104 leave ; 105 endif ; 106 if (Z1OPT = '1') ; 107 String = 'DSPJOB JOB(' + %trimr(Ds(Z1RRN).JobName) + ') + OUTPUT(*)' ; 108 ExecuteCommand() ; 109 elseif (Z1OPT = '2') ; 110 String = 'WRKUSRJOB USER(' + %trimr(Ds(Z1RRN).User) + ') + STATUS(*ACTIVE)' ; 111 ExecuteCommand() ; 112 elseif (Z1OPT = '3') ; 113 SendMessage() ; 114 endif ; 115 Z1OPT = ' ' ; 116 update SFL01 ; 117 enddo ; 118 end-proc ;
Line 102: READC is the operation code to read for changed records in a subfile.
Lines 106 - 108: If "1" was entered in the option field then the Display Job command is built for the user and placed in the variable String. By calling the ExecuteCommand the command in String will be executed.
Lines 109 - 111: This is part of the program I would like your help for. I wanted a simple (easy) way to display the error message. I looked many commands and could not find one to do what I want. Do you know of a way to display an error message for a job from another? If you do please let me know in the comments section at the bottom of this post.
Until I find something better I am using the Work User Job command to allow the user to display the job and answer the message.
Lines 112 and 113: I wanted to give the user the ability to send a message to the person with the error. Perhaps to say something like: "Your job has errored, stop submitting the same job again and again", etc. I prefer to send messages via the QEZSNDMG API, I put the call to that API in its own subprocedure, SendMessage.
Lines 115 and 116: When all the processing has happened for whatever choices the user had made the option field is cleared and the subfile updated. If I do not do this the modified data flag, that READC identifies, is not cleared, the next time this subprocedure is called the subfile's records that were processed before will be identified to be processed again.
The final subprocedure I need to discuss is the SendMessage. As I discussed how to use this in a previous post about sending break messages I am only going to describe this in the briefest manner.
150 dcl-proc SendMessage ; 151 dcl-pr QEZSNDMG extpgm ; 152 *n char(10) const ; 153 *n char(10) const ; 154 *n char(300) options(*varsize) const ; 155 *n int(10) const ; 156 *n char(10) const ; 157 *n int(10) const ; 158 *n int(10) const ; 159 *n int(10) const ; 160 *n char(8) ; 161 *n char(1) const ; 162 *n char(20) const ; 163 *n char(4) const ; 164 *n int(10) const ; 165 end-pr ; 166 dcl-s RtnError char(8) ; 167 QEZSNDMG('*INFO':'*BREAK':' ':1: Ds(Z1RRN).User: 1:0:0:RtnError:'Y':' ':'*USR':0) ; 168 end-proc ;
Lines 151 – 165: These are the parameters to be passed to the API QEZSNDMG. Notice how the parameter on line 160 does not have the CONST, that the others do, as this is a returned parameter.
Line 166: I need a variable for that returned parameter, even though I am not going to do anything with it.
Line 167: Then only thing to note in this call to the API is that I am passing the user id from the subfile record selected. When the send message screen is displayed the user id will appear in the "Send to" field.
So there we have it, a complete display file program that does something useful. This is a program is more than just an example, the operators at my employer now use this program to monitor for jobs in error on the production servers. You could use it too on your IBM i.
This article was written for IBM i 7.3, and while some parts will not work for earlier releases too other parts will you just need to change the RPG code.