Difference between revisions of "WrkMsgs"

From MidrangeWiki
Jump to: navigation, search
Line 254: Line 254:
  
 
== RPG ==
 
== RPG ==
 +
<pre>
 +
      /////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
 +
      //=========================================================
 +
    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
 +
 +
</pre>

Revision as of 05:34, 4 June 2014

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                                                      */
/*                                                                            */
/*----------------------------------------------------------------------------*/
             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*/ Notes..:                                                
     A*/   1) This *pgm courtesy of CLOVER                       
     A*/ Log....:                                                
     A*/ 2014May19 - Copied from archive                         
     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
      //=========================================================
     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
Retrieved from "https://wiki.midrange.com/index.php?title=WrkMsgs&oldid=11740"