WrkMsgs
From MidrangeWiki
The following utility can be used to browse and edit iSeries message files.
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
