WrkMsgs

From MidrangeWiki
Jump to: navigation, search

The following utility can be used to browse and edit iSeries message files.


Contents

CMD

/*============================================================================*/
/* Name...: WRKMSGS                                                           */
/* Version: n/a                                                               */
/* Purpose: Work with Message Descriuptions                                   */
/* Summary:                                                                   */
/*        : 1) Call CL                                                        */
/* Params :                                                                   */
/*        : i_FILE    : Message File name                                     */
/*        : i_LIB     : Message File lib                                      */
/* Useage :                                                                   */
/* Compile:                                                                   */
/*  CRTCMD ??CMD(*LIBL/WRKMSGS)                                               */
/*         ??PGM(*LIBL/WRKMSGSC)                                              */
/*         ?*SRCFILE(*LIBL/QCMDSRC)                                           */
/*         ?*SRCMBR(WRKMSGS)                                                  */
/*         ??REPLACE(*NO)                                                     */
/* Log....:                                                                   */
/*  06AUG11 JK- Updated                                                       */
/* Notes..:                                                                   */
/*  COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997                           */
/*============================================================================*/
             CMD        PROMPT('Work with message descriptions')
             PARM       KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +
                          FILE NAME (GEN*,*ALL)')

 FILE:       QUAL       TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)
             QUAL       TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
                          (*USRLIBL) (*ALLUSR) (*ALL)) +
                          PROMPT('LIBRARY')

CL

/*=========================================================================== */
/* Name...: WRKMSGSC                                                          */
/* Version: n/a                                                               */
/* Purpose: Run test cases for EDP824D                                        */
/* Summary:                                                                   */
/*          1) Dump *MSGF to temp file                                        */
/*          2) Run pgm                                                        */
/* Params.:                                                                   */
/*        : i_FILELIB : Message File                                          */
/* Useage :                                                                   */
/* Compile:                                                                   */
/*  CRTCLPGM ??PGM(R50MODS/*PGM)                                              */
/*           ?*SRCFILE(*LIBL/QCLSRC)                                          */
/*           ?*SRCMBR(WRKMSGSC)                                               */
/*           ??REPLACE(*YES)                                                  */
/* Log....:                                                                   */
/* 2014May19 JK- Updated                                                      */
/*                                                                            */
/* Notes..:                                                                   */
/*  COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997                           */
/*----------------------------------------------------------------------------*/
             PGM (&FL)
             DCL &FL   *CHAR 20

             DCL &MSG  *CHAR 80
             DCL &MS   *CHAR 7
             DCL &SYSDTA  *CHAR 750                      /* /002 */
             DCL &SYSVR   *CHAR 6                        /* /002 */

             MONMSG CPF0000 EXEC(GOTO ERROR)

             /* Dump *MSGF to temp file */
             DSPOBJD    OBJ(%SST(&FL 11 10)/%SST(&FL 1 10)) +
                          OBJTYPE(*MSGF) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/QADSPOBJ)

             OVRDBF QADSPOBJ QTEMP/QADSPOBJ SECURE(*YES) SHARE(*NO)

             RTVDTAARA  DTAARA(QSS1MRI) RTNVAR(&SYSDTA)        /* /002 */
             CHGVAR     VAR(&SYSVR) VALUE(&SYSDTA)             /* /002 */

             /* Run pgm */
             CALL WRKMSGSR (&FL  &SYSVR) /* /002 */
             RETURN

             ERROR:       RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSG) MSGID(&MS)
                          SNDPGMMSG  MSGID(&MS) MSGF(QCPFMSG) MSGDTA(&MSG) +
                                       MSGTYPE(*ESCAPE)
EOJ:
             ENDPGM

DDS

     A*========================================================= 
     A*/ Name...: WRKMSGSD                                       
     A*/ Version: n/a                                            
     A*/ Purpose: Work with message files                        
     A*/ Summary:                                                
     A*/   N/A       :                                           
     A*/ Params.:                                                
     A*/   N/A       :                                           
     A*/ LDA....:                                                
     A*/   N/A       :                                           
     A*/ Compile:                                                
     A*/   CRTDSPF FILE(WRKMSGSD)                                
     A*/           SRCFILE(QDDSSRC)                              
     A*/           SRCMBR(WRKMSGSD)                              
     A*/           REPLACE(*YES)                                 
     A*/ Log....:                                                
     A*/ 2014May19 - Copied from archive                         
     A*/ Notes..:
     A*/  COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997
     A*/=========================================================
     A*  INDARA IS REQUIRED FOR RETKEY/RETCMDKEY
     A*%%EC
     A                                      DSPSIZ(24 80 *DS3)
     A                                      REF(*LIBL/QADSPOBJ)
     A                                      MSGLOC(23)
     A                                      INDARA
     A                                      PRINT(*LIBL/QSYSPRT)
     A                                      OPENPRT
     A                                      ERRSFL
      *-------------------------------------------------------------------------
      *  PANEL 1 - LIST OF MESSAGE FILES
      *-------------------------------------------------------------------------
     A          R WRKMSG01                  PUTOVR
     A                                  1  3'WRKMSGS.01'
     A                                  1 20'  WORK WITH MESSAGE DESCRIPTIONS '
     A                                      DSPATR(RI)
     A                                  1 60SYSNAME
     A                                  1 72DATE OVRATR EDTCDE(Y)
     A                                  2 72TIME OVRATR
     A                                  2 26'   MESSAGE FILES    '
     A                                      DSPATR(HI)
     A                                  2  2'12-WORK WITH'
     A                                  4  2'   FILE       LIBRARY    TEXT     -
     A                                                                         '
     A                                      DSPATR(UL)

     A          R WRKMSGS1                  SFL
     A  25                                  SFLNXTCHG
     A            #SEL           2   B  5  2CHECK(AB)
     A                                      VALUES('  ' '12')
     A  51                                  DSPATR(RI PC)
     A            ODOBNM    R            + 1
     A            ODLBNM    R            + 1
     A            ODOBTX    R            + 1

     A          R WRKMSGC1                  SFLCTL(WRKMSGS1) CA03
     A                                      CA12
     A                                      SFLSIZ(50) SFLPAG(16)
     A                                      OVERLAY PUTOVR
     A N21 22                               SFLDSP
     A N21                                  SFLDSPCTL
     A  21                                  SFLCLR
     A N11                                  ROLLUP(19)
     A  11                                  SFLEND
     A  71                                  SFLMSG('UNABLE TO WORK WITH FILE')

     A            #DSPC1         4S 0H      SFLRCDNBR
     A                                 21  2 ' '
     A                                 24  5'F3=EXIT'
     A                                 24 17'F12 CANCEL'

      *-------------------------------------------------------------------------
      *  INSERT PANEL - DETAILS OF THE SELECTION
      *-------------------------------------------------------------------------
     A          R WRKMSGA1                  CLRL(*NO) RETKEY RETCMDKEY
     A                                  3  2'FILE'
     A            ODOBNM    R            + 1DSPATR(HI)
     A            ODLBNM    R            + 1DSPATR(HI)
     A            ODOBTX    R            + 1DSPATR(HI)


     A*-------------------------------------------------------------------------
     A*  PANEL 2 - LIST OF MESSAGES
     A*-------------------------------------------------------------------------
     A          R WRKMSG02
     A*%%TS  SD  20140529  201332  JKING       REL-V6R1M0  5761-WDS
     A                                      PUTOVR
     A                                  1  3'WRKMSGS.02'
     A                                  1 20'  WORK WITH MESSAGE DESCRIPTIONS '
     A                                      DSPATR(RI)
     A                                  1 60SYSNAME
     A                                  1 72OVRATR
     A                                      DATE
     A                                      EDTCDE(Y)
     A                                  2 72TIME
     A                                      OVRATR
     A                                  2 26'MESSAGE DESCRIPTIONS'
     A                                      DSPATR(HI)
     A                                  4  2'3-COPY, 12-WORK WITH'
     A                                  5 13'AND/OR'
     A            ANDOR          1A  B  5 20VALUES('A' 'O')
     A            SELMID         7A  B  6  5OVRDTA
     A            SELTX1        10A  B  6 13DSPATR(PC)
     A                                      OVRATR
     A                                      CHECK(LC)
     A            SELTX2        10A  B  6 24CHECK(LC)
     A            SELTX3        10A  B  6 35CHECK(LC)
     A            SELTX4        10A  B  6 46CHECK(LC)
     A            SELTX5        10A  B  6 57CHECK(LC)
     A            SELTX6        10A  B  6 68CHECK(LC)
     A                                  7  2'   MESSAGE  TEXT                  -
     A                                                                         -
     A                                             '
     A                                      DSPATR(UL)
     A          R WRKMSGS2                  SFL
     A  25                                  SFLNXTCHG
     A            #SEL           2   B  8  2DSPATR(HI)
     A  25N50                               DSPATR(PC)
     A            MESSID         7       + 1
     A            MESSTX        65       + 1
     A            MSTEXT       132   H
     A            MSSECL       800   H


     A          R WRKMSGC2                  SFLCTL(WRKMSGS2)
     A                                      CA03 CF05 CA12 CF21
     A                                      SFLSIZ(50) SFLPAG(14)
     A                                      OVERLAY PUTOVR
     A N21 22                               SFLDSP
     A N21                                  SFLDSPCTL
     A  21                                  SFLCLR
     A N11                                  ROLLUP(19)
     A  11                                  SFLEND
     A  71                                  SFLMSG('UNABLE TO EDIT MESSAGE')
     A            #DSPC2         4S 0H      SFLRCDNBR
     A                                 22  2 ' '
     A                                 24  5'F3=EXIT             F5=REFRESH    -
     A                                            F12=PREVIOUS        F21=PRINT'


      *-------------------------------------------------------------------------
      *  MISCELLANEOUS PANELS
      *-------------------------------------------------------------------------

     A          R @CONFIRM                  OVERLAY CLRL(*NO) CF05 CA12
     A                                 23  7'PRESS F5 TO CONFIRM.'

     A          R @BOX                      OVERLAY PROTECT CLRL(3)
     A                                 22  2'                                  -
     A                                                                         -
     A                                                ' DSPATR(RI)
     A                                 23  2' ' DSPATR(RI)
     A                                 23 80' ' DSPATR(RI)
     A                                 24  2'                                  -
     A                                         F12=PREVIOUS                    -
     A                                                ' DSPATR(RI)

     A          R @CLEAR1                   OVERLAY
     A                                  8  1' '

RPG

      /////copy *LIBL/QRPGLESRC,@StdH_H
     H Option(*NoShowCpy : *NoDebugIO : *SrcStmt )
     H DftActGrp(*no) ActGrp('QILE')
      //=========================================================
      // Name...: WRKMSGSR
      // Version: n/a
      // Purpose: Work with message files
      // Summary:
      //   1) Prompts for message file
      //   2) Reads selected message file into SFL
      // Params.:
      //   i_libfil  : Library/file
      //   i_SYSVRr  : System Version
      // LDA....:
      //   *None     :
      // Compile:
      //  CRTBNDRPG lib/pgm SRCFILE(srclib/srcfile) DBGVIEW(*ALL)
      // Notes..:
      //   1) This *pgm courtesy of CLOVER
      //   2) Converted from RPG3 with CVTRPGPGM
      // Log....:
      // 2014May19 - Copied from archive
/002  // ????      - Mod to adjust for OS version
/003  // 2014May19 - JEK: Mod for V6 and presumably V7
      // Notes..:
      //  1) COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997
      //  2) Converted from RPG3 with CVTRPGPGM
      //=========================================================
     FQADSPOBJ  IF   E             DISK    INFDS(INFDB1)
     FWRKMSGSD  CF   E             WORKSTN
     F                                     SFILE(WRKMSGS1:RRN1)
     F                                     SFILE(WRKMSGS2:RRN2)
     FQSYSPRT   O    F  132        PRINTER OFLIND(*INOF)
     F                                     USROPN
      *
     D VAL             S              1    DIM(4)
      *
     D INFDB1          DS
     D  RECDB                397    400B 0
     D POS1            DS                  INZ
     D  RECDB1                 1      7  0
      *
      *  PROGRAM DS
     D                SDS
     D  WRKSTN               244    253
     D  USRPRF               254    263
      *  TEXT SELECTIONS
     D SELTXT          DS
     D  SELT                   1     60
     D                                     DIM(6)
     D  SELTX1                 1     10
     D  SELTX2                11     20
     D  SELTX3                21     30
     D  SELTX4                31     40
     D  SELTX5                41     50
     D  SELTX6                51     60
/002  *  THE VERSION OF THE OPERATING SYSTEM
/002 D @SYSVR          DS             6
/002 D  @VER                   1      2
/002 D  @RLS                   3      4
/002 D  @MOD                   5      6
      *  1ST LEVEL MESSAGE
     D MSTEXT          DS
     D  MSTEX1                 1     80
/002 D  MSTXT4                 2     80
     D  MSTEX2                81    132
      *  2ND LEVEL MESSAGE
     D MSSECL          DS
     D  MS2                    1    800
     D                                     DIM(10)
      *  API DATA STRUCTURES
     D FORM            DS          2048
     D  MRET                   1      4B 0
     D  MID                   27     33
     D  MO                    65     68B 0
     D  ML                    69     72B 0
     D  M2                    77     80B 0
     D  M2L                   81     84B 0
      *  API FIELDS
     D APIF            DS
     D  FLEN                   1      4B 0
     D  RLEN                   5      8B 0
     D  FCCS                   9     12B 0
     D  TCCS                  13     16B 0
      *  API ERROR
     D APIERR          DS                  INZ
     D  ERRAV                  1      4B 0
     D  ERRPR                  5      8B 0 INZ(116)
     D  ERRMS                  9     15
     D  ERRRS                 16     16
     D  ERRDT                 17    116
     D                 DS                  INZ
     D  BIN41                  1      4B 0
     D  BIN42                  5      8B 0
      *
      *  CONSTANTS
     D LODATE          C                   CONST('1960-01-01')
     D LO              C                   CONST('ABCDEFGHIJKLMNOPQRST-
     D                                     UVWXYZ')
     D HI              C                   CONST('ABCDEFGHIJKLMNOPQRST-
     D                                     UVWXYZ')
      *
      *
      *****************************************************************
      ** MAIN PROCESSING                                              *
      *****************************************************************
     C     CTRL          DOUEQ     'EXIT'
      *  01 - FILE SELECTION
     C     CTRL          CASEQ     'CON1'        $ACON1
     C     CTRL          CASEQ     'DSP1'        $ADSP1
     C     CTRL          CASEQ     'EDT1'        $AEDT1
     C     CTRL          CASEQ     'ACT1'        $AACT1
      *  02 - MESSAGES
     C     CTRL          CASEQ     'CON2'        $ACON2
     C     CTRL          CASEQ     'DSP2'        $ADSP2
     C     CTRL          CASEQ     'EDT2'        $AEDT2
     C     CTRL          CASEQ     'ACT2'        $AACT2
      *
     C     CTRL          CASEQ     'FINI'        $AFNSH
     C                   CAS                     XPSSR
     C                   END
     C                   END
      *  END OF PROGRAM
     C                   SETON                                        LR
     C                   RETURN
      *****************************************************************
      *  CONSTRUCT PANEL 1
      *****************************************************************
     C     $ACON1        BEGSR
      *
      *  CLEAR SUBFILE
     C                   SETON                                        21
     C                   WRITE     WRKMSGC1
     C                   SETOFF                                       21
     C                   Z-ADD     *ZERO         RRN1
     C                   Z-ADD     *ZERO         LSTRR1
     C                   Z-ADD     *ZERO         #DSPC1
      *
      *  FILL SUBFILE FROM THE BEGINNING POSITION
     C                   RESET                   POS1
     C                   EXSR      $DROL1
      *  SET CONTROL
     C     RRN1          IFEQ      1
     C                   MOVEL     'CON2'        CTRL
     C                   ELSE
     C                   MOVEL     'DSP1'        CTRL
     C                   END
     C                   ENDSR
      *****************************************************************
      *  DISPLAY PANEL 1
      *****************************************************************
     C     $ADSP1        BEGSR
      *
     C     #DSPC1        IFEQ      *ZERO
     C     #DSPC1        ORGT      LSTRR1
     C                   Z-ADD     LSTRR1        #DSPC1
     C                   END
      *  DISPLAY SUBFILE
     C     LSTRR1        COMP      *ZERO                              22
     C  N22              WRITE     @CLEAR1
     C                   WRITE     WRKMSG01
     C                   EXFMT     WRKMSGC1
      *  SET ERROR INDICATORS OFF
     C                   MOVE      'N'           @ERR
     C                   Z-ADD     *ZERO         #DSPC1
     C                   MOVE      *ZERO         @IND
     C                   MOVEA     @IND          *IN(71)
      *  F3 - EXIT
      *  F12 - CANCEL
     C                   SELECT
     C     *INKC         WHENEQ    '1'
     C     *INKL         OREQ      '1'
     C                   MOVEL     'FINI'        CTRL
      *  ROLL-UP
     C     *IN19         WHENEQ    '1'
     C                   EXSR      $DROL1
     C                   MOVEL     'DSP1'        CTRL
      *  NO RECORDS
     C     LSTRR1        WHENEQ    *ZERO
     C                   MOVEL     'DSP1'        CTRL
      *  SET CONTROL
     C                   OTHER
     C                   MOVEL     'EDT1'        CTRL
     C                   ENDSL
      *
     C                   ENDSR
      *****************************************************************
      *  EDIT PANEL 1
      *****************************************************************
     C     $AEDT1        BEGSR
     C                   MOVE      'N'           @ERR
     C                   MOVEL     'DSP1'        CTRL
      *
      *  READ CHANGED RECORDS
     C                   Z-ADD     *ZERO         RRN1
     C                   Z-ADD     *ZERO         #DSPC1
     C                   DO        *HIVAL
     C                   READC     WRKMSGS1                               31
     C   31              LEAVE
     C                   MOVE      *ZERO         @IND
     C                   MOVEA     @IND          *IN(51)
      *
      *  BEGIN EDIT
      *   APPROPRIATE SELECTIONS
     C                   SELECT
      *  NO SELECTION
     C     #SEL          WHENEQ    *BLANKS
      *
     C                   ENDSL
      *  UPDATE THE SFL
     C                   MOVEA     *IN(51)       @IND
     C     @IND          IFNE      *ZERO
     C                   MOVE      'Y'           @ERR
     C                   END
     C     #SEL          IFNE      *BLANKS
     C                   SETON                                        25
     C                   END
     C                   UPDATE    WRKMSGS1
     C                   SETOFF                                       25
     C     #DSPC1        IFEQ      *ZERO
     C     @ERR          ANDEQ     'Y'
     C                   Z-ADD     RRN1          #DSPC1
     C                   END
     C                   END
      *
      *  ALL SFL ENTRIES EDITED
     C     #DSPC1        IFEQ      *ZERO
     C                   Z-ADD     RRN1          #DSPC1
     C                   END
      *
     C     @ERR          IFEQ      'N'
     C                   MOVEL     'ACT1'        CTRL
     C                   END
      *
     C     EXEDT1        ENDSR
      *****************************************************************
      *  ACTION PANEL 1
      *****************************************************************
     C     $AACT1        BEGSR
     C                   MOVEL     'DSP1'        CTRL
      *
      *  READ SELECTED RECORDS FROM SUBFILE
     C                   Z-ADD     1             #DSPC1
     C                   WRITE     WRKMSGC1
      *
     C                   DO        *HIVAL
     C                   READC     WRKMSGS1                               31
     C     *IN31         IFEQ      '1'
     C                   MOVEL     'DSP2'        CTRL
     C                   LEAVE
     C                   END
     C     #SEL          IFEQ      *BLANKS
     C                   ITER
     C                   END
     C                   MOVE      #SEL          SEL
     C                   MOVE      *BLANKS       #SEL
     C                   UPDATE    WRKMSGS1
     C                   Z-ADD     RRN1          #DSPC1
      *  NEXT DISPLAY FOR THE SELECTED RECORD
     C                   SELECT
     C     SEL           WHENEQ    '12'
     C                   MOVE      *BLANKS       MSGID2
     C                   MOVEL     'CON2'        CTRL
     C                   LEAVE
     C                   ENDSL
      *  NEXT SFL RECORD
     C                   END
      *
     C     EXACT1        ENDSR
      *****************************************************************
      *  CONSTRUCT PANEL 2
      *****************************************************************
     C     $ACON2        BEGSR
      *  CLEAR SUBFILE
     C                   SETON                                        21
     C                   WRITE     WRKMSGC2
     C                   SETOFF                                       21
     C                   Z-ADD     *ZERO         RRN2
     C                   Z-ADD     *ZERO         LSTRR2
     C                   Z-ADD     *ZERO         #DSPC2
      *
      *  FILL SUBFILE FROM THE BEGINNING POSITION
     C     ANDOR         IFEQ      *BLANKS
     C                   MOVE      'A'           ANDOR
     C                   END
     C                   EXSR      $DROL2
     C                   MOVEL     SELMID        MIDLST
     C                   MOVEL     SELTXT        TXTLST
     C                   MOVEL     ANDOR         ANDLST
      *  SET CONTROL
     C                   MOVEL     'DSP2'        CTRL
     C                   ENDSR
      *****************************************************************
      *  DISPLAY PANEL 2
      *****************************************************************
     C     $ADSP2        BEGSR
      *
     C     #DSPC2        IFEQ      *ZERO
     C     #DSPC2        ORGT      LSTRR2
     C                   Z-ADD     LSTRR2        #DSPC2
     C                   END
      *  DISPLAY SUBFILE
     C     LSTRR2        COMP      *ZERO                              22
     C  N22              WRITE     @CLEAR1
     C                   WRITE     WRKMSG02
     C                   WRITE     WRKMSGA1
     C                   EXFMT     WRKMSGC2
     C                   READ      WRKMSG02                               51
      *  SET ERROR INDICATORS OFF
     C                   MOVE      'N'           @ERR
     C                   Z-ADD     *ZERO         #DSPC2
     C                   MOVE      *ZERO         @IND
     C                   MOVEA     @IND          *IN(71)
      *  F3 - EXIT
     C                   SELECT
     C     *INKC         WHENEQ    '1'
     C                   MOVEL     'FINI'        CTRL
      *  F12 - RETURN
     C     *INKL         WHENEQ    '1'
     C                   MOVEL     'DSP1'        CTRL
      *  F21 - PRINT
     C     *INKV         WHENEQ    '1'
     C                   EXSR      $PRNT2
     C                   MOVEL     'DSP2'        CTRL
      *  F5 - REFRESH
      *  OR NEW SELECTIONS
     C     *INKE         WHENEQ    '1'
     C     SELMID        ORNE      MIDLST
     C     SELTXT        ORNE      TXTLST
     C     ANDOR         ORNE      ANDLST
     C                   MOVEL     SELMID        MSGID2
     C     MSGID2        IFNE      *BLANKS
     C                   MOVE      MSGID2        TEST4
     C                   MOVEA     TEST4         VAL
     C                   DO        4             X
     C     VAL(X)        IFLT      'A'
     C     VAL(X)        ORGT      'F'
     C     VAL(X)        ANDLT     '0'
     C                   MOVE      '0'           VAL(X)
     C                   END
     C                   ENDDO
     C                   END
     C                   MOVEA     VAL           TEST4
     C                   MOVE      TEST4         MSGID2
     C                   MOVE      MSGID2        SELMID
     C                   MOVE      MSGID2        MIDLST
     C                   MOVE      'CON2'        CTRL
      *  ROLL-UP
     C     *IN19         WHENEQ    '1'
     C                   EXSR      $DROL2
     C                   MOVEL     'DSP2'        CTRL
      *  NO RECORDS
     C     LSTRR2        WHENEQ    *ZERO
     C                   MOVEL     'DSP2'        CTRL
      *  SET CONTROL
     C                   OTHER
     C                   MOVEL     'EDT2'        CTRL
     C                   ENDSL
      *
     C                   ENDSR
      *****************************************************************
      *  EDIT PANEL 2
      *****************************************************************
     C     $AEDT2        BEGSR
     C                   MOVE      'N'           @ERR
     C                   MOVEL     'DSP2'        CTRL
      *
      *  READ CHANGED RECORDS
     C                   Z-ADD     *ZERO         RRN2
     C                   Z-ADD     *ZERO         #DSPC2
     C                   SETON                                        25
     C                   DO        *HIVAL
     C                   READC     WRKMSGS2                               31
     C   31              LEAVE
     C                   MOVE      *ZERO         @IND
     C                   MOVEA     @IND          *IN(51)
      * EDITING
      *
      *  UPDATE THE SFL
     C                   MOVEA     *IN(51)       @IND
     C     @IND          IFNE      *ZERO
     C                   MOVE      'Y'           @ERR
     C                   END
     C                   UPDATE    WRKMSGS2
     C     #DSPC2        IFEQ      *ZERO
     C     @ERR          ANDEQ     'Y'
     C                   Z-ADD     RRN2          #DSPC2
     C                   END
     C                   END
      *
      *  ALL SFL ENTRIES EDITED
     C                   SETOFF                                       25
     C     #DSPC2        IFEQ      *ZERO
     C                   Z-ADD     RRN2          #DSPC2
     C                   END
      *  SET CONTROL
     C     @ERR          IFEQ      'N'
     C                   MOVEL     'ACT2'        CTRL
     C                   END
      *
     C                   ENDSR
      *****************************************************************
      *  ACTION PANEL 2
      *****************************************************************
     C     $AACT2        BEGSR
     C                   MOVEL     'DSP2'        CTRL
      *
      *  READ SELECTED RECORDS FROM SUBFILE
     C                   Z-ADD     1             #DSPC2
     C                   WRITE     WRKMSGC2
     C                   DO        *HIVAL
     C                   READC     WRKMSGS2                               31
     C   31              LEAVE
     C                   MOVE      #SEL          SEL
     C                   MOVE      *BLANKS       #SEL
     C                   UPDATE    WRKMSGS2
     C                   Z-ADD     RRN2          #DSPC2
      *
      *  EDIT
     C                   SELECT
     C     SEL           WHENEQ    '03'
     C     SEL           OREQ      '3 '
     C     '?CPYMSGD'    CAT(P)    MESSID:1      CMD
     C                   CAT       ODLBNM:1      CMD
     C                   CAT       '/':0         CMD
     C                   CAT       ODOBNM:0      CMD
     C                   CALL      'QCMDEXC'                            90
     C                   PARM                    CMD
     C                   PARM      256           LN
     C                   MOVE      SELMID        MSGID2
     C                   MOVEL     'CON2'        CTRL
      *
     C     SEL           WHENEQ    '12'
     C     'WRKMSGD'     CAT(P)    MESSID:1      CMD
     C                   CAT       ODLBNM:1      CMD
     C                   CAT       '/':0         CMD
     C                   CAT       ODOBNM:0      CMD
     C                   CALL      'QCMDEXC'                            90
     C                   PARM                    CMD
     C                   PARM      256           LN
     C                   MOVE      SELMID        MSGID2
     C                   MOVEL     'CON2'        CTRL
      *
     C                   ENDSL
      *
      *  NEXT SFL RECORD
     C                   END
      *
     C                   ENDSR
      *****************************************************************
      *  ROLL-UP PANEL 1
      *****************************************************************
     C     $DROL1        BEGSR
      *  REPOSITION THE FILE TO AFTER THE LAST USED RECORD
     C     RECDB1        SETGT     QLIDOBJD
     C                   Z-ADD     LSTRR1        RRN1
      *  FILL 1 PAGE.
     C                   DO        PAG1
      *  NEXT SFL DETAILS
     C                   READ      QLIDOBJD                               11
     C   11              LEAVE
      *  WRITE THE SFL RECORD
     C                   EXSR      $FSFL1
     C                   ADD       1             RRN1
     C                   WRITE     WRKMSGS1
     C                   ENDDO
      *
     C                   Z-ADD     RECDB         RECDB1
     C                   Z-ADD     RRN1          LSTRR1
      *
     C                   ENDSR
      *****************************************************************
      *  FILL SFL 1 RECORD
      *****************************************************************
     C     $FSFL1        BEGSR
      *
     C                   MOVE      *ZERO         @IND
     C                   MOVEA     @IND          *IN(51)
     C                   MOVE      *BLANKS       #SEL
      *
      *  FILL THE SFL RECORD
      *
     C                   ENDSR
      *****************************************************************
      *  ROLL-UP PANEL 2
      *****************************************************************
     C     $DROL2        BEGSR
      *
     C                   Z-ADD     LSTRR2        RRN2
     C                   Z-ADD     *ZERO         LSTRR2
      *  FILL 1 PAGE.
     C                   DO        PAG2          CNT2
      *  NEXT SFL DETAILS
     C                   EXSR      $NXTMS
     C   11              LEAVE
     C                   EXSR      $INCL2
     C   11              LEAVE
     C     @INCL         IFNE      'Y'
     C                   SUB       1             CNT2
     C                   ITER
     C                   END
      *  WRITE THE SFL RECORD
     C                   EXSR      $FSFL2
     C                   ADD       1             RRN2
     C                   EXSR      $XEDT2
     C                   MOVEA     *IN(51)       @IND
     C     @IND          COMP      *ZERO                              2525
     C                   WRITE     WRKMSGS2
     C                   MOVEL     MESSID        MSGID2
     C                   ENDDO
      *
     C                   Z-ADD     RRN2          LSTRR2
      *
     C                   ENDSR
      *****************************************************************
      *  NXTMS - GET THE NEXT MESSAGE
      *****************************************************************
     C     $NXTMS        BEGSR
      *
     C                   MOVEL     ODOBNM        MFLLIB
     C                   MOVE      ODLBNM        MFLLIB
     C                   MOVEL(P)  '*NEXT'       ROPT
     C     MSGID2        IFEQ      *BLANKS
     C                   MOVEL(P)  '*FIRST'      ROPT
     C                   END
     C     MSGID2        IFEQ      SELMID
     C     MSGID2        ANDNE     *BLANKS
     C     RRN2          ANDEQ     *ZERO
     C                   MOVEL(P)  '*MSGID'      ROPT
     C                   END
      *
     C     $RETRY        TAG
     C                   CALL      'QMHRTVM'                            11
     C                   PARM                    FORM
     C                   PARM      2048          FLEN
     C                   PARM      'RTVM0300'    FMTR             10
     C                   PARM                    MSGID2
     C                   PARM                    MFLLIB           20
     C                   PARM      *BLANKS       RDTA              1
     C                   PARM      1             RLEN
     C                   PARM      '*NO'         RVAL             10
     C                   PARM      '*NO'         CVAL             10
     C                   PARM                    APIERR
     C                   PARM                    ROPT             10
     C                   PARM      0             FCCS
     C                   PARM      0             TCCS
     C  N11MRET          COMP      84                                   11
     C     *IN11         IFEQ      '0'
     C                   MOVEL     MID           MSGID2
     C                   ADD       1             MO
     C     ML            SUBST(P)  FORM:MO       MSTEXT
     C***                  EXSR SETTXT
     C***        ML        SUBSTFORM:XX   MSTEXT    P
     C     M2L           IFEQ      *ZERO
     C                   MOVE      *BLANKS       MSSECL
     C                   ELSE
     C     M2L           SUBST(P)  FORM:M2       MSSECL
     C                   END
     C                   END
     C   11ROPT          IFEQ      '*MSGID'
     C                   MOVEL(P)  '*NEXT'       ROPT
     C                   GOTO      $RETRY
     C                   END
      *
     C                   ENDSR
      *****************************************************************
      *  TEST SFL 2 RECORD FOR INCLUSION
      *****************************************************************
     C     $INCL2        BEGSR
      *
     C     SELTXT        IFEQ      *BLANKS
     C                   MOVE      'Y'           @INCL
     C                   GOTO      XINCL2
     C                   END
      *
      * AND/OR SELECTIONS
     C     ANDOR         IFEQ      'A'
     C                   MOVE      'N'           @INCL
     C                   ELSE
     C                   MOVE      'Y'           @INCL
     C                   END
      *  TEXT SELECTOR
     C     LO:HI         XLATE     MSTEXT        TSTTXT
      *
      * FOR EACH TEXT PART
      *  IF FOUND, USING OR THEN FINISHED
      *  IF NOT FOUND, USING AND THEN FINISHED
      *
     C                   DO        6             Y
     C     SELT(Y)       IFEQ      *BLANKS
     C                   ITER
     C                   END
      *
     C     ' '           CHECKR    SELT(Y)       X
     C     X             IFEQ      *ZERO
     C                   Z-ADD     10            X
     C                   END
     C     SELT(Y):X     SCAN      TSTTXT                                 51
     C     *IN51         IFEQ      '1'
     C     ANDOR         ANDEQ     'O'
     C     *IN51         OREQ      '0'
     C     ANDOR         ANDEQ     'A'
     C                   GOTO      XINCL2
     C                   END
     C                   ENDDO
      *
      * TESTED ALL
      *  USING AND, THEN INCLUDE
      *  USING OR, THEN EXCLUDE
     C     ANDOR         IFEQ      'A'
     C                   MOVE      'Y'           @INCL
     C                   ELSE
     C                   MOVE      'N'           @INCL
     C                   END
      *
     C     XINCL2        ENDSR
      *****************************************************************
      *  FILL SFL 2 RECORD
      *****************************************************************
     C     $FSFL2        BEGSR
      *
     C                   MOVE      *ZERO         @IND
     C                   MOVEA     @IND          *IN(51)
     C                   MOVE      *BLANKS       #SEL
      *
      *  FILL THE SFL RECORD
     C                   MOVEL     MID           MESSID
/002 C     @VER          IFEQ      'V3'
/002 C     @VER          OREQ      'V4'
/002 C     @VER          OREQ      'V5'
/003 C     @VER          OREQ      'V6'
/003 C     @VER          OREQ      'V7'
     C                   MOVEL     MSTEXT        MESSTX
/002 C                   ELSE
/002 C                   MOVEL     MSTXT4        MESSTX
/002 C                   ENDIF
      *
     C                   ENDSR
      *****************************************************************
      *  EDIT SFL 2 RECORD
      *****************************************************************
     C     $XEDT2        BEGSR
      *
      *  FULL EDIT IS DONE HERE
      *   INCLUDING WARNINGS
     C                   SETOFF                                       50
      *
     C     XXEDT2        ENDSR
      *****************************************************************
      *  FINISHING SUBROUTINE / CLOSE FILES ETC.
      *****************************************************************
     C     $AFNSH        BEGSR
      *
     C                   MOVEL     'EXIT'        CTRL
     C                   ENDSR
      *****************************************************************
      *  INITIALISATION SUBROUTINE
      *****************************************************************
     C     *INZSR        BEGSR
      *  PARAMETERS AND KEY LISTS
     C     *ENTRY        PLIST
     C                   PARM                    FILLIB           20
/002 C                   PARM                    @SYSVR
      *
      *
      *  FIELD DEFINITIONS AND INITIALISATION
     C                   Z-ADD     16            PAG1              5 0
     C                   Z-ADD     14            PAG2              5 0
     C                   Z-ADD     *ZERO         RRN1              4 0
     C                   Z-ADD     *ZERO         RRN2              4 0
      *
     C                   MOVE      *BLANKS       MSGID2            7
     C                   MOVE      *BLANKS       @ERR              1
     C                   MOVE      *BLANKS       @IND             20
     C                   MOVE      *BLANKS       CMD             256
     C                   Z-ADD     *ZERO         LN               15 5
     C                   Z-ADD     *ZERO         X                 5 0
     C                   Z-ADD     *ZERO         Y                 5 0
     C                   MOVE      *BLANKS       @INCL             1
     C                   MOVE      *BLANKS       TEST4             4
      *
     C     *LIKE         DEFINE    RRN1          LSTRR1
     C     *LIKE         DEFINE    RRN2          LSTRR2
     C     *LIKE         DEFINE    PAG1          CNT1
     C     *LIKE         DEFINE    PAG2          CNT2
     C     *LIKE         DEFINE    #SEL          SEL
     C     *LIKE         DEFINE    SELMID        MIDLST
     C     *LIKE         DEFINE    SELTXT        TXTLST
     C     *LIKE         DEFINE    ANDOR         ANDLST
     C     *LIKE         DEFINE    MSTEXT        TSTTXT
      *
      *  SET CONTROL FOR INITIAL DISPLAY
     C                   MOVEL     'CON1'        CTRL              4
     C                   ENDSR
      *****************************************************************
      ** ERROR SUBROUTINE                                             *
      *****************************************************************
     C     XPSSR         BEGSR
      ** CHECK ERROR ONCE ONLY
     C*          @PSSR     IFEQ *BLANK
     C*                    MOVEL'Y'       @PSSR   1
      ** DUMP PROGRAM TO TRACE FAULT
     C*                    DUMP
     C*                    END
      *  EXIT THE PROGRAM
     C                   SETON                                        LR
     C                   RETURN
     C                   ENDSR
      *----------------------------------------------------------------
      *  $PRNT2 - PRINT PANEL 2
      *----------------------------------------------------------------
     C     $PRNT2        BEGSR
     C     *IN11         DOWNE     '1'
     C                   EXSR      $DROL2
     C                   END
     C                   Z-ADD     *ZERO         PAGE
     C                   TIME                    RTIME            12 0
      * SYSTEM NAME
     C                   CALL      'QWCRNETA'                           51
     C                   PARM                    NETDET           32
     C                   PARM      32            BIN41
     C                   PARM      1             BIN42
     C                   PARM      'SYSNAME'     NETATR           10
     C                   PARM                    APIERR
     C                   MOVE      NETDET        SYSNAM            8
      * OPEN THE PRINTER
     C                   OPEN      QSYSPRT
     C                   SETON                                        OF
     C                   DO        *HIVAL        RRN2
     C     RRN2          CHAIN     WRKMSGS2                           5151
     C   51              LEAVE
     C                   EXCEPT    #DETL1
     C     MSTEX2        IFNE      *BLANKS
     C                   EXCEPT    #DETL2
     C                   END
     C                   DO        10            Y
     C     MS2(Y)        IFNE      *BLANKS
     C                   EXCEPT    #DETL3
     C                   END
     C                   ENDDO
     C                   ENDDO
      *
     C                   CLOSE     QSYSPRT
      *
     C                   ENDSR
      *----------------------------------------------------------------
      *  SETTXT - CHECK TO MAKE SURE STARTING POSITION IS VALID
      *----------------------------------------------------------------
     C     SETTXT        BEGSR
      *
      * THIS SUBROUTINE IS DESIGNED TO FIND THE POSITION OF THE 1ST
      * CHARACTER OF THE MESSAGE TEXT
      *
     C                   Z-ADD     100           XX                4 0
     C                   MOVE      'N'           OK                1
     C     OK            DOWEQ     'N'
     C     6             SUBST     FORM:XX       TSTFLD            6
     C     TSTFLD        IFGE      ' '
     C                   MOVE      'Y'           OK
     C                   ELSE
     C                   ADD       1             XX
     C                   ENDIF
     C                   ENDDO
      *
     C                   ENDSR
      *----------------------------------------------------------------
     C*          *PSSR     BEGSR
      ** CHECK ERROR ONCE ONLY
     C*          @PSSR     IFEQ *BLANK
     C*                    MOVEL'Y'       @PSSR   1
      ** DUMP PROGRAM TO TRACE FAULT
     C*                    DUMP
     C*                    END
      *  EXIT THE PROGRAM
     C*                    SETON                     LR
     C*                    RETRN
     C*                    ENDSR
      *
      *****************************************************************
     OQSYSPRT   H    OF                     2 03
     O                       SYSNAM              10
     O                                         +  3 'MESSAGE DESCRIPTIONS:'
     O                       RTIME             +  5 ' 0:  :  &&  /  /  '
     O                       PAGE          Z   + 12
     O                                         -  8 'PAGE:'
     O          H    OF                     1
     O                       ODOBNM            +  1
     O                       ODLBNM            +  1
     O                       ODOBTX            +  1
     O          H    OF                     1
     O                                              'SELECT:'
     O                                         +  1 'MESSAGEID'
     O                       SELMID            +  1
     O          H    OF                     1
     O                                         +  8 'MESSAGE TEXT'
     O                                         +  1 '(AND/OR)'
     O                       ANDOR             +  1
     O                       SELTX1            +  1
     O                       SELTX2            +  1
     O                       SELTX3            +  1
     O                       SELTX4            +  1
     O                       SELTX5            +  1
     O                       SELTX6            +  1
     O          EF           #DETL1      1  1
     O                       MESSID               7
     O                       MSTEX1            +  1
     O          E            #DETL2         1
     O                       MSTEX2            +  8
     O          E            #DETL3         1
     O                       MS2(Y)             100