Inside COBOL #24
by
Shawn M. Gordon
President S.M.Gordon & Associates

Ok, so I have built up a bit of a buffer on these COBOL tips columns so that I can take some time off for my new son. So the chances are good that this will be the last one for a while, but who knows, I keep saying that. Anyway, as I promised last month, we are going to cover the GENMESSAGE intrinsic as it applies to reading the system message catalog.

I use this technique in several programs that I wrote. One of them is in an MPEXish type program I wrote (because I can’t afford to buy MPEX for my personal use) and I needed to handle MPE commands in it, so if there was something wrong with the command I wanted to display the actual system error message. The other scenario I use it for is in a Client/Server program I wrote. The server issues MPE commands sometimes that are initiated by the client. The server doesn’t really care what the result is, but the client does, so I get the message back from the system catalog and pass it back to the client and through it up in a message box. This works out pretty darn good actually.

So by now you are all excited and are sitting by your keyboard ready to start typing, so wait no more.

  01 USER-COMMAND         PIC X(78)  VALUE SPACES.

  01 CAT-FILE             PIC X(28)  VALUE "CATALOG.PUB.SYS".
  01 CAT-FNUM             PIC S9(4)  COMP VALUE 0.
  01 CAT-ERR              PIC S9(4)  COMP VALUE 0.
  01 CAT-BUFF             PIC X(78)  VALUE SPACES.
 *
  01 COM-IMAGE.
     05 COMMAND-IMAGE     PIC X(79)  VALUE SPACES.
     05                   PIC X      VALUE %15.
  01 COMMAND-ERROR        PIC S9(4)  COMP VALUE 0.
  01 ERR-PARM             PIC S9(4)  COMP VALUE 0.

  PROCEDURE DIVISION.
 A0000-MACROS.
 $DEFINE %COMIMAGE=
         MOVE !1
                 TO COMMAND-IMAGE
         CALL INTRINSIC 'COMMAND' USING COM-IMAGE,
                                        COMMAND-ERROR,
                                        ERR-PARM
         IF COMMAND-ERROR <> 0
            MOVE SPACES                 TO CAT-BUFF
            CALL INTRINSIC "GENMESSAGE" USING CAT-FNUM, 2,
                                        COMMAND-ERROR,
                                        CAT-BUFF, 78, \\, \\, \\,
                                        \\, \\, \\, \\, CAT-ERR
            DISPLAY CAT-BUFF
         END-IF
         IF ERR-PARM > 1
            MOVE SPACES                 TO CAT-BUFF
            CALL INTRINSIC "GENMESSAGE" USING CAT-FNUM, 8,
                                        ERR-PARM,
                                        CAT-BUFF, 78, \\, \\, \\,
                                        \\, \\, \\, \\, CAT-ERR
            DISPLAY CAT-BUFF
         END-IF#

  A1000-INIT.
      CALL INTRINSIC "FOPEN" USING CAT-FILE, %5, %2720
                            GIVING CAT-FNUM.
      ACCEPT USER-COMMAND FREE.
      %COMIMAGE(USER-COMMAND#).

So the first thing we have to do is FOPEN the system catalog file CATALOG.PUB.SYS. For those of you who like to know, the %5 for foptions is a binary 101, which means open the file as an old permanent ASCII file. The %2720 for aoptions is a binary 10111010000 which means the file is read only, multi-record, no FLOCK, shared non-buffered access, that allows inter-job multi-access.

As usual I am using a MACRO to make use of the COMMAND intrinsic, and do a check of any errors that might be returned. If there is an error, then we call GENMESSAGE to get the text of the error number. First if the variable COMMAND-ERROR is not equal to zero then that indicates a CIERROR has occured. We then call GENMESSAGE passing the FNUM that we retrieved in the FOPEN of the catalog file, the message set is 2 to specify that we want the CI message set out of the catalog (there are messages for all sorts of subsystems in the catalog). Then we pass the error number that was returned from the command intrinsic, a buffer to hold the message, and the length of the buffer. Finally there is a variable to hold any error that occurs in the call to GENMESSAGE. I am being lazy here, and I am not checking the return error value. The last step of course is to display CAT-BUFF to see what the message was.

Now you are probably wondering why I call GENMESSAGE again. Well if the value in ERR-PARM is greater than 1, then that means we also got a file system error, and we are going to want to know what it is. So now we call GENMESSAGE with a message set of 8, and with ERR-PARM so we can get the file system error message. Finally, we display CAT-BUFF again to see what the error was.

It’s not hard to do, but you do need to know the steps involved. I hoped you enjoyed this months installement. Remember to send your ideas and comments to me so we can all keep this column alive. If nothing else I will start up again when COBOL97 comes out.