Example of an Error Message Subfile in an ILE COBOL program

Troubleshooting

Problem

The following is an example of using an error message subfile in an ILE COBOL program.

Resolving The Problem

Important Note: This is an example only. IBM accepts no responsibility for its correctness.

The following is an example of using an error message subfile in an ILE COBOL program:

DDS Source (FS2CBL):

     A                                      INDARA
     A                                      CF03(03)
     A                                      HELP
     A          R FMT1
     A                                      OVERLAY
     A                                  2  3'FULL SCREEN'
     A            FLD1          10   B  3  3
      *
     A          R MSGSFL                    SFL
     A                                      SFLMSGRCD(24)
     A            MSGKEY                    SFLMSGKEY
     A            PGMQ                      SFLPGMQ
     A          R MSGSFLC                   SFLCTL(MSGSFL)
     A                                      SFLSIZ(0002)
     A                                      SFLPAG(0001)
     A                                      OVERLAY
     A                                      SFLDSP
     A                                      SFLDSPCTL
     A                                      SFLINZ
     A  98                                  SFLEND
     A            PGMQ                      SFLPGMQ

COBOL Source(MSGSFLCBL):

       IDENTIFICATION DIVISION.
       PROGRAM-ID. MSGSFLCBL.
         DATE-WRITTEN. Nov. 2024.
         DATE-COMPILED.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
         SOURCE-COMPUTER. IBM-AS400.
         OBJECT-COMPUTER. IBM-AS400.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

            SELECT DISPLAY-FILE
             ASSIGN       TO WORKSTATION-FS2CBL
             ORGANIZATION IS TRANSACTION
             ACCESS MODE IS SEQUENTIAL
             FILE STATUS IS DISPLAY-FILE-STATUS.


       DATA DIVISION.
       FILE SECTION.
       FD  DISPLAY-FILE
           LABEL RECORDS ARE STANDARD.
       01  DISPLAY-RECORD.
           COPY DDS-ALL-FORMATS OF FS2CBL.


        WORKING-STORAGE SECTION.

        01 FILE-STATUS.
           05  DISPLAY-FILE-STATUS            PIC 99.


        01 SENDPGM-PARMS.
          05 MSGID              PIC X(7).
          05 MSGF               PIC X(10).
          05 MSGDTA             PIC X(62).
          05 MSGOPT             PIC X(1).

        01 WS-INDICATORS.

           05  IN03                   PIC 1 INDIC 03.
              88 END-PROGRAM         VALUE B"1".
              88 NOT-END-PROGRAM     VALUE B"0".
     *
          05  IN98                   PIC 1 INDIC 98.
              88 SFLEND              VALUE B"1".
              88 NOT-SFLEND          VALUE B"1".

        PROCEDURE DIVISION.
        MAIN-PROCESS.
            PERFORM INITIALIZE-001.
      ****************************************************************
      * SEND ERROR MESSAGES TO PROGRAM MESSAGE QUEUE.
      ****************************************************************
           MOVE 'USR0003' TO MSGID.
           MOVE 'MYMSGF' TO MSGF.
           MOVE 'FILE      LIBRARY' TO MSGDTA.
           MOVE 'I' TO MSGOPT
           CALL 'SENDMSG' USING MSGID, MSGF, MSGDTA, MSGOPT.
           MOVE 'USR0003' TO MSGID.
           CALL 'SENDMSG' USING MSGID, MSGF, MSGDTA, MSGOPT.

      * SET SFLEND ON ERROR MESSAGE SUBFILE
           SET SFLEND TO TRUE.

           PERFORM DISPLAY-001 UNTIL END-PROGRAM.
           CLOSE DISPLAY-FILE.
           EXIT PROGRAM.
           STOP RUN.


         DISPLAY-001.
           MOVE SPACES TO FLD1 OF FMT1-O.
           WRITE DISPLAY-RECORD FORMAT IS "FMT1".

      * *  MAKE SURE TO CHECK THAT THE PROGRAM NAME IN THIS MOVE STATEMENT IS THE
      *    NAME OF YOUR PROGRAM.

           MOVE 'MSGSFLCBL' TO PGMQ OF MSGSFLC-O.
           WRITE DISPLAY-RECORD
             FORMAT IS "MSGSFLC"
             INDICATORS ARE WS-INDICATORS.
           READ DISPLAY-FILE
             INDICATORS ARE WS-INDICATORS.
      ****************************************************************
      * CLEAR THE PROGRAM MESSAGE QUEUE AFTER EACH DISPLAY OF THE
      * SCREEN.
      ****************************************************************
           MOVE 'C' TO MSGOPT.
           CALL 'SENDMSG' USING MSGID, MSGF, MSGDTA, MSGOPT.


         INITIALIZE-001.
           OPEN I-O DISPLAY-FILE.
           SET NOT-END-PROGRAM TO TRUE.
           MOVE 'C' TO MSGOPT.
           CALL 'SENDMSG' USING MSGID, MSGF, MSGDTA, MSGOPT.

CL Source for Sending Message (SENDMSG):

         PGM        PARM(&MSGID &MSGF &MSGDTA &MSGOPT)
         DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
         DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)
         DCL        VAR(&MSGOPT) TYPE(*CHAR) LEN(1)
         DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(62)

         IF         COND(&MSGOPT *EQ 'I') THEN(SNDPGMMSG MSGID(&MSGID) MSGF(&MSGF) +
                      MSGDTA(&MSGDTA) TOPGMQ(*SAME (MSGSFLCBL *NONE *NONE)))
         IF         COND(&MSGOPT *EQ 'C') THEN(RMVMSG PGMQ(*PRV (*)) CLEAR(*ALL))
         ENDPGM

This sample uses
Message ID . . . . . . . . . : USR0003
Message file . . . . . . . . : MYMSGF
Library . . . . . . . . . : <yourlib>
Message text . . . . . . . . : TEST: &1

Field Data Type Length
&1 *CHAR 62

Compile the program using CRTBNDCBL

Call from command line

Type command, press Enter.
===> call msgsflcbl

[{"Type":"MASTER","Line of Business":{"code":"LOB68","label":"Power HW"},"Business Unit":{"code":"BU070","label":"IBM Infrastructure"},"Product":{"code":"SWG60","label":"IBM i"},"ARM Category":[{"code":"a8m3p000000F98bAAC","label":"Programming ILE Languages-\u003ECOBOL"}],"ARM Case Number":"","Platform":[{"code":"PF012","label":"IBM i"}],"Version":"All Versions"}]

Historical Number

7695934

Was this topic helpful?

Document Information

Modified date:
25 November 2024

UID

nas8N1010285

Tips