https://wiki.midrange.com/api.php?action=feedcontributions&user=Houstonking&feedformat=atom
MidrangeWiki - User contributions [en]
2024-03-29T12:45:51Z
User contributions
MediaWiki 1.30.0
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11742
WrkMsgs
2014-06-04T05:39:25Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<br />
== CMD ==<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre><br />
<br />
== CL ==<br />
<pre><br />
/*=========================================================================== */<br />
/* Name...: WRKMSGSC */<br />
/* Version: n/a */<br />
/* Purpose: Run test cases for EDP824D */<br />
/* Summary: */<br />
/* 1) Dump *MSGF to temp file */<br />
/* 2) Run pgm */<br />
/* Params.: */<br />
/* : i_FILELIB : Message File */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCLPGM ??PGM(R50MODS/*PGM) */<br />
/* ?*SRCFILE(*LIBL/QCLSRC) */<br />
/* ?*SRCMBR(WRKMSGSC) */<br />
/* ??REPLACE(*YES) */<br />
/* Log....: */<br />
/* 2014May19 JK- Updated */<br />
/* */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*----------------------------------------------------------------------------*/<br />
PGM (&FL)<br />
DCL &FL *CHAR 20<br />
<br />
DCL &MSG *CHAR 80<br />
DCL &MS *CHAR 7<br />
DCL &SYSDTA *CHAR 750 /* /002 */<br />
DCL &SYSVR *CHAR 6 /* /002 */<br />
<br />
MONMSG CPF0000 EXEC(GOTO ERROR)<br />
<br />
/* Dump *MSGF to temp file */<br />
DSPOBJD OBJ(%SST(&FL 11 10)/%SST(&FL 1 10)) +<br />
OBJTYPE(*MSGF) OUTPUT(*OUTFILE) +<br />
OUTFILE(QTEMP/QADSPOBJ)<br />
<br />
OVRDBF QADSPOBJ QTEMP/QADSPOBJ SECURE(*YES) SHARE(*NO)<br />
<br />
RTVDTAARA DTAARA(QSS1MRI) RTNVAR(&SYSDTA) /* /002 */<br />
CHGVAR VAR(&SYSVR) VALUE(&SYSDTA) /* /002 */<br />
<br />
/* Run pgm */<br />
CALL WRKMSGSR (&FL &SYSVR) /* /002 */<br />
RETURN<br />
<br />
ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSG) MSGID(&MS)<br />
SNDPGMMSG MSGID(&MS) MSGF(QCPFMSG) MSGDTA(&MSG) +<br />
MSGTYPE(*ESCAPE)<br />
EOJ:<br />
ENDPGM<br />
<br />
</pre><br />
<br />
== DDS ==<br />
<pre><br />
A*========================================================= <br />
A*/ Name...: WRKMSGSD <br />
A*/ Version: n/a <br />
A*/ Purpose: Work with message files <br />
A*/ Summary: <br />
A*/ N/A : <br />
A*/ Params.: <br />
A*/ N/A : <br />
A*/ LDA....: <br />
A*/ N/A : <br />
A*/ Compile: <br />
A*/ CRTDSPF FILE(WRKMSGSD) <br />
A*/ SRCFILE(QDDSSRC) <br />
A*/ SRCMBR(WRKMSGSD) <br />
A*/ REPLACE(*YES) <br />
A*/ Log....: <br />
A*/ 2014May19 - Copied from archive <br />
A*/ Notes..:<br />
A*/ COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997<br />
A*/=========================================================<br />
A* INDARA IS REQUIRED FOR RETKEY/RETCMDKEY<br />
A*%%EC<br />
A DSPSIZ(24 80 *DS3)<br />
A REF(*LIBL/QADSPOBJ)<br />
A MSGLOC(23)<br />
A INDARA<br />
A PRINT(*LIBL/QSYSPRT)<br />
A OPENPRT<br />
A ERRSFL<br />
*-------------------------------------------------------------------------<br />
* PANEL 1 - LIST OF MESSAGE FILES<br />
*-------------------------------------------------------------------------<br />
A R WRKMSG01 PUTOVR<br />
A 1 3'WRKMSGS.01'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72DATE OVRATR EDTCDE(Y)<br />
A 2 72TIME OVRATR<br />
A 2 26' MESSAGE FILES '<br />
A DSPATR(HI)<br />
A 2 2'12-WORK WITH'<br />
A 4 2' FILE LIBRARY TEXT -<br />
A '<br />
A DSPATR(UL)<br />
<br />
A R WRKMSGS1 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 5 2CHECK(AB)<br />
A VALUES(' ' '12')<br />
A 51 DSPATR(RI PC)<br />
A ODOBNM R + 1<br />
A ODLBNM R + 1<br />
A ODOBTX R + 1<br />
<br />
A R WRKMSGC1 SFLCTL(WRKMSGS1) CA03<br />
A CA12<br />
A SFLSIZ(50) SFLPAG(16)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO WORK WITH FILE')<br />
<br />
A #DSPC1 4S 0H SFLRCDNBR<br />
A 21 2 ' '<br />
A 24 5'F3=EXIT'<br />
A 24 17'F12 CANCEL'<br />
<br />
*-------------------------------------------------------------------------<br />
* INSERT PANEL - DETAILS OF THE SELECTION<br />
*-------------------------------------------------------------------------<br />
A R WRKMSGA1 CLRL(*NO) RETKEY RETCMDKEY<br />
A 3 2'FILE'<br />
A ODOBNM R + 1DSPATR(HI)<br />
A ODLBNM R + 1DSPATR(HI)<br />
A ODOBTX R + 1DSPATR(HI)<br />
<br />
<br />
A*-------------------------------------------------------------------------<br />
A* PANEL 2 - LIST OF MESSAGES<br />
A*-------------------------------------------------------------------------<br />
A R WRKMSG02<br />
A*%%TS SD 20140529 201332 JKING REL-V6R1M0 5761-WDS<br />
A PUTOVR<br />
A 1 3'WRKMSGS.02'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72OVRATR<br />
A DATE<br />
A EDTCDE(Y)<br />
A 2 72TIME<br />
A OVRATR<br />
A 2 26'MESSAGE DESCRIPTIONS'<br />
A DSPATR(HI)<br />
A 4 2'3-COPY, 12-WORK WITH'<br />
A 5 13'AND/OR'<br />
A ANDOR 1A B 5 20VALUES('A' 'O')<br />
A SELMID 7A B 6 5OVRDTA<br />
A SELTX1 10A B 6 13DSPATR(PC)<br />
A OVRATR<br />
A CHECK(LC)<br />
A SELTX2 10A B 6 24CHECK(LC)<br />
A SELTX3 10A B 6 35CHECK(LC)<br />
A SELTX4 10A B 6 46CHECK(LC)<br />
A SELTX5 10A B 6 57CHECK(LC)<br />
A SELTX6 10A B 6 68CHECK(LC)<br />
A 7 2' MESSAGE TEXT -<br />
A -<br />
A '<br />
A DSPATR(UL)<br />
A R WRKMSGS2 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 8 2DSPATR(HI)<br />
A 25N50 DSPATR(PC)<br />
A MESSID 7 + 1<br />
A MESSTX 65 + 1<br />
A MSTEXT 132 H<br />
A MSSECL 800 H<br />
<br />
<br />
A R WRKMSGC2 SFLCTL(WRKMSGS2)<br />
A CA03 CF05 CA12 CF21<br />
A SFLSIZ(50) SFLPAG(14)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO EDIT MESSAGE')<br />
A #DSPC2 4S 0H SFLRCDNBR<br />
A 22 2 ' '<br />
A 24 5'F3=EXIT F5=REFRESH -<br />
A F12=PREVIOUS F21=PRINT'<br />
<br />
<br />
*-------------------------------------------------------------------------<br />
* MISCELLANEOUS PANELS<br />
*-------------------------------------------------------------------------<br />
<br />
A R @CONFIRM OVERLAY CLRL(*NO) CF05 CA12<br />
A 23 7'PRESS F5 TO CONFIRM.'<br />
<br />
A R @BOX OVERLAY PROTECT CLRL(3)<br />
A 22 2' -<br />
A -<br />
A ' DSPATR(RI)<br />
A 23 2' ' DSPATR(RI)<br />
A 23 80' ' DSPATR(RI)<br />
A 24 2' -<br />
A F12=PREVIOUS -<br />
A ' DSPATR(RI)<br />
<br />
A R @CLEAR1 OVERLAY<br />
A 8 1' '<br />
<br />
</pre><br />
<br />
== RPG ==<br />
<pre><br />
/////copy *LIBL/QRPGLESRC,@StdH_H<br />
H Option(*NoShowCpy : *NoDebugIO : *SrcStmt )<br />
H DftActGrp(*no) ActGrp('QILE')<br />
//=========================================================<br />
// Name...: WRKMSGSR<br />
// Version: n/a<br />
// Purpose: Work with message files<br />
// Summary:<br />
// 1) Prompts for message file<br />
// 2) Reads selected message file into SFL<br />
// Params.:<br />
// i_libfil : Library/file<br />
// i_SYSVRr : System Version<br />
// LDA....:<br />
// *None :<br />
// Compile:<br />
// CRTBNDRPG lib/pgm SRCFILE(srclib/srcfile) DBGVIEW(*ALL)<br />
// Notes..:<br />
// 1) This *pgm courtesy of CLOVER<br />
// 2) Converted from RPG3 with CVTRPGPGM<br />
// Log....:<br />
// 2014May19 - Copied from archive<br />
/002 // ???? - Mod to adjust for OS version<br />
/003 // 2014May19 - JEK: Mod for V6 and presumably V7<br />
// Notes..:<br />
// 1) COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997<br />
// 2) Converted from RPG3 with CVTRPGPGM<br />
//=========================================================<br />
FQADSPOBJ IF E DISK INFDS(INFDB1)<br />
FWRKMSGSD CF E WORKSTN<br />
F SFILE(WRKMSGS1:RRN1)<br />
F SFILE(WRKMSGS2:RRN2)<br />
FQSYSPRT O F 132 PRINTER OFLIND(*INOF)<br />
F USROPN<br />
*<br />
D VAL S 1 DIM(4)<br />
*<br />
D INFDB1 DS<br />
D RECDB 397 400B 0<br />
D POS1 DS INZ<br />
D RECDB1 1 7 0<br />
*<br />
* PROGRAM DS<br />
D SDS<br />
D WRKSTN 244 253<br />
D USRPRF 254 263<br />
* TEXT SELECTIONS<br />
D SELTXT DS<br />
D SELT 1 60<br />
D DIM(6)<br />
D SELTX1 1 10<br />
D SELTX2 11 20<br />
D SELTX3 21 30<br />
D SELTX4 31 40<br />
D SELTX5 41 50<br />
D SELTX6 51 60<br />
/002 * THE VERSION OF THE OPERATING SYSTEM<br />
/002 D @SYSVR DS 6<br />
/002 D @VER 1 2<br />
/002 D @RLS 3 4<br />
/002 D @MOD 5 6<br />
* 1ST LEVEL MESSAGE<br />
D MSTEXT DS<br />
D MSTEX1 1 80<br />
/002 D MSTXT4 2 80<br />
D MSTEX2 81 132<br />
* 2ND LEVEL MESSAGE<br />
D MSSECL DS<br />
D MS2 1 800<br />
D DIM(10)<br />
* API DATA STRUCTURES<br />
D FORM DS 2048<br />
D MRET 1 4B 0<br />
D MID 27 33<br />
D MO 65 68B 0<br />
D ML 69 72B 0<br />
D M2 77 80B 0<br />
D M2L 81 84B 0<br />
* API FIELDS<br />
D APIF DS<br />
D FLEN 1 4B 0<br />
D RLEN 5 8B 0<br />
D FCCS 9 12B 0<br />
D TCCS 13 16B 0<br />
* API ERROR<br />
D APIERR DS INZ<br />
D ERRAV 1 4B 0<br />
D ERRPR 5 8B 0 INZ(116)<br />
D ERRMS 9 15<br />
D ERRRS 16 16<br />
D ERRDT 17 116<br />
D DS INZ<br />
D BIN41 1 4B 0<br />
D BIN42 5 8B 0<br />
*<br />
* CONSTANTS<br />
D LODATE C CONST('1960-01-01')<br />
D LO C CONST('ABCDEFGHIJKLMNOPQRST-<br />
D UVWXYZ')<br />
D HI C CONST('ABCDEFGHIJKLMNOPQRST-<br />
D UVWXYZ')<br />
*<br />
*<br />
*****************************************************************<br />
** MAIN PROCESSING *<br />
*****************************************************************<br />
C CTRL DOUEQ 'EXIT'<br />
* 01 - FILE SELECTION<br />
C CTRL CASEQ 'CON1' $ACON1<br />
C CTRL CASEQ 'DSP1' $ADSP1<br />
C CTRL CASEQ 'EDT1' $AEDT1<br />
C CTRL CASEQ 'ACT1' $AACT1<br />
* 02 - MESSAGES<br />
C CTRL CASEQ 'CON2' $ACON2<br />
C CTRL CASEQ 'DSP2' $ADSP2<br />
C CTRL CASEQ 'EDT2' $AEDT2<br />
C CTRL CASEQ 'ACT2' $AACT2<br />
*<br />
C CTRL CASEQ 'FINI' $AFNSH<br />
C CAS XPSSR<br />
C END<br />
C END<br />
* END OF PROGRAM<br />
C SETON LR<br />
C RETURN<br />
*****************************************************************<br />
* CONSTRUCT PANEL 1<br />
*****************************************************************<br />
C $ACON1 BEGSR<br />
*<br />
* CLEAR SUBFILE<br />
C SETON 21<br />
C WRITE WRKMSGC1<br />
C SETOFF 21<br />
C Z-ADD *ZERO RRN1<br />
C Z-ADD *ZERO LSTRR1<br />
C Z-ADD *ZERO #DSPC1<br />
*<br />
* FILL SUBFILE FROM THE BEGINNING POSITION<br />
C RESET POS1<br />
C EXSR $DROL1<br />
* SET CONTROL<br />
C RRN1 IFEQ 1<br />
C MOVEL 'CON2' CTRL<br />
C ELSE<br />
C MOVEL 'DSP1' CTRL<br />
C END<br />
C ENDSR<br />
*****************************************************************<br />
* DISPLAY PANEL 1<br />
*****************************************************************<br />
C $ADSP1 BEGSR<br />
*<br />
C #DSPC1 IFEQ *ZERO<br />
C #DSPC1 ORGT LSTRR1<br />
C Z-ADD LSTRR1 #DSPC1<br />
C END<br />
* DISPLAY SUBFILE<br />
C LSTRR1 COMP *ZERO 22<br />
C N22 WRITE @CLEAR1<br />
C WRITE WRKMSG01<br />
C EXFMT WRKMSGC1<br />
* SET ERROR INDICATORS OFF<br />
C MOVE 'N' @ERR<br />
C Z-ADD *ZERO #DSPC1<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(71)<br />
* F3 - EXIT<br />
* F12 - CANCEL<br />
C SELECT<br />
C *INKC WHENEQ '1'<br />
C *INKL OREQ '1'<br />
C MOVEL 'FINI' CTRL<br />
* ROLL-UP<br />
C *IN19 WHENEQ '1'<br />
C EXSR $DROL1<br />
C MOVEL 'DSP1' CTRL<br />
* NO RECORDS<br />
C LSTRR1 WHENEQ *ZERO<br />
C MOVEL 'DSP1' CTRL<br />
* SET CONTROL<br />
C OTHER<br />
C MOVEL 'EDT1' CTRL<br />
C ENDSL<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT PANEL 1<br />
*****************************************************************<br />
C $AEDT1 BEGSR<br />
C MOVE 'N' @ERR<br />
C MOVEL 'DSP1' CTRL<br />
*<br />
* READ CHANGED RECORDS<br />
C Z-ADD *ZERO RRN1<br />
C Z-ADD *ZERO #DSPC1<br />
C DO *HIVAL<br />
C READC WRKMSGS1 31<br />
C 31 LEAVE<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
*<br />
* BEGIN EDIT<br />
* APPROPRIATE SELECTIONS<br />
C SELECT<br />
* NO SELECTION<br />
C #SEL WHENEQ *BLANKS<br />
*<br />
C ENDSL<br />
* UPDATE THE SFL<br />
C MOVEA *IN(51) @IND<br />
C @IND IFNE *ZERO<br />
C MOVE 'Y' @ERR<br />
C END<br />
C #SEL IFNE *BLANKS<br />
C SETON 25<br />
C END<br />
C UPDATE WRKMSGS1<br />
C SETOFF 25<br />
C #DSPC1 IFEQ *ZERO<br />
C @ERR ANDEQ 'Y'<br />
C Z-ADD RRN1 #DSPC1<br />
C END<br />
C END<br />
*<br />
* ALL SFL ENTRIES EDITED<br />
C #DSPC1 IFEQ *ZERO<br />
C Z-ADD RRN1 #DSPC1<br />
C END<br />
*<br />
C @ERR IFEQ 'N'<br />
C MOVEL 'ACT1' CTRL<br />
C END<br />
*<br />
C EXEDT1 ENDSR<br />
*****************************************************************<br />
* ACTION PANEL 1<br />
*****************************************************************<br />
C $AACT1 BEGSR<br />
C MOVEL 'DSP1' CTRL<br />
*<br />
* READ SELECTED RECORDS FROM SUBFILE<br />
C Z-ADD 1 #DSPC1<br />
C WRITE WRKMSGC1<br />
*<br />
C DO *HIVAL<br />
C READC WRKMSGS1 31<br />
C *IN31 IFEQ '1'<br />
C MOVEL 'DSP2' CTRL<br />
C LEAVE<br />
C END<br />
C #SEL IFEQ *BLANKS<br />
C ITER<br />
C END<br />
C MOVE #SEL SEL<br />
C MOVE *BLANKS #SEL<br />
C UPDATE WRKMSGS1<br />
C Z-ADD RRN1 #DSPC1<br />
* NEXT DISPLAY FOR THE SELECTED RECORD<br />
C SELECT<br />
C SEL WHENEQ '12'<br />
C MOVE *BLANKS MSGID2<br />
C MOVEL 'CON2' CTRL<br />
C LEAVE<br />
C ENDSL<br />
* NEXT SFL RECORD<br />
C END<br />
*<br />
C EXACT1 ENDSR<br />
*****************************************************************<br />
* CONSTRUCT PANEL 2<br />
*****************************************************************<br />
C $ACON2 BEGSR<br />
* CLEAR SUBFILE<br />
C SETON 21<br />
C WRITE WRKMSGC2<br />
C SETOFF 21<br />
C Z-ADD *ZERO RRN2<br />
C Z-ADD *ZERO LSTRR2<br />
C Z-ADD *ZERO #DSPC2<br />
*<br />
* FILL SUBFILE FROM THE BEGINNING POSITION<br />
C ANDOR IFEQ *BLANKS<br />
C MOVE 'A' ANDOR<br />
C END<br />
C EXSR $DROL2<br />
C MOVEL SELMID MIDLST<br />
C MOVEL SELTXT TXTLST<br />
C MOVEL ANDOR ANDLST<br />
* SET CONTROL<br />
C MOVEL 'DSP2' CTRL<br />
C ENDSR<br />
*****************************************************************<br />
* DISPLAY PANEL 2<br />
*****************************************************************<br />
C $ADSP2 BEGSR<br />
*<br />
C #DSPC2 IFEQ *ZERO<br />
C #DSPC2 ORGT LSTRR2<br />
C Z-ADD LSTRR2 #DSPC2<br />
C END<br />
* DISPLAY SUBFILE<br />
C LSTRR2 COMP *ZERO 22<br />
C N22 WRITE @CLEAR1<br />
C WRITE WRKMSG02<br />
C WRITE WRKMSGA1<br />
C EXFMT WRKMSGC2<br />
C READ WRKMSG02 51<br />
* SET ERROR INDICATORS OFF<br />
C MOVE 'N' @ERR<br />
C Z-ADD *ZERO #DSPC2<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(71)<br />
* F3 - EXIT<br />
C SELECT<br />
C *INKC WHENEQ '1'<br />
C MOVEL 'FINI' CTRL<br />
* F12 - RETURN<br />
C *INKL WHENEQ '1'<br />
C MOVEL 'DSP1' CTRL<br />
* F21 - PRINT<br />
C *INKV WHENEQ '1'<br />
C EXSR $PRNT2<br />
C MOVEL 'DSP2' CTRL<br />
* F5 - REFRESH<br />
* OR NEW SELECTIONS<br />
C *INKE WHENEQ '1'<br />
C SELMID ORNE MIDLST<br />
C SELTXT ORNE TXTLST<br />
C ANDOR ORNE ANDLST<br />
C MOVEL SELMID MSGID2<br />
C MSGID2 IFNE *BLANKS<br />
C MOVE MSGID2 TEST4<br />
C MOVEA TEST4 VAL<br />
C DO 4 X<br />
C VAL(X) IFLT 'A'<br />
C VAL(X) ORGT 'F'<br />
C VAL(X) ANDLT '0'<br />
C MOVE '0' VAL(X)<br />
C END<br />
C ENDDO<br />
C END<br />
C MOVEA VAL TEST4<br />
C MOVE TEST4 MSGID2<br />
C MOVE MSGID2 SELMID<br />
C MOVE MSGID2 MIDLST<br />
C MOVE 'CON2' CTRL<br />
* ROLL-UP<br />
C *IN19 WHENEQ '1'<br />
C EXSR $DROL2<br />
C MOVEL 'DSP2' CTRL<br />
* NO RECORDS<br />
C LSTRR2 WHENEQ *ZERO<br />
C MOVEL 'DSP2' CTRL<br />
* SET CONTROL<br />
C OTHER<br />
C MOVEL 'EDT2' CTRL<br />
C ENDSL<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT PANEL 2<br />
*****************************************************************<br />
C $AEDT2 BEGSR<br />
C MOVE 'N' @ERR<br />
C MOVEL 'DSP2' CTRL<br />
*<br />
* READ CHANGED RECORDS<br />
C Z-ADD *ZERO RRN2<br />
C Z-ADD *ZERO #DSPC2<br />
C SETON 25<br />
C DO *HIVAL<br />
C READC WRKMSGS2 31<br />
C 31 LEAVE<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
* EDITING<br />
*<br />
* UPDATE THE SFL<br />
C MOVEA *IN(51) @IND<br />
C @IND IFNE *ZERO<br />
C MOVE 'Y' @ERR<br />
C END<br />
C UPDATE WRKMSGS2<br />
C #DSPC2 IFEQ *ZERO<br />
C @ERR ANDEQ 'Y'<br />
C Z-ADD RRN2 #DSPC2<br />
C END<br />
C END<br />
*<br />
* ALL SFL ENTRIES EDITED<br />
C SETOFF 25<br />
C #DSPC2 IFEQ *ZERO<br />
C Z-ADD RRN2 #DSPC2<br />
C END<br />
* SET CONTROL<br />
C @ERR IFEQ 'N'<br />
C MOVEL 'ACT2' CTRL<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ACTION PANEL 2<br />
*****************************************************************<br />
C $AACT2 BEGSR<br />
C MOVEL 'DSP2' CTRL<br />
*<br />
* READ SELECTED RECORDS FROM SUBFILE<br />
C Z-ADD 1 #DSPC2<br />
C WRITE WRKMSGC2<br />
C DO *HIVAL<br />
C READC WRKMSGS2 31<br />
C 31 LEAVE<br />
C MOVE #SEL SEL<br />
C MOVE *BLANKS #SEL<br />
C UPDATE WRKMSGS2<br />
C Z-ADD RRN2 #DSPC2<br />
*<br />
* EDIT<br />
C SELECT<br />
C SEL WHENEQ '03'<br />
C SEL OREQ '3 '<br />
C '?CPYMSGD' CAT(P) MESSID:1 CMD<br />
C CAT ODLBNM:1 CMD<br />
C CAT '/':0 CMD<br />
C CAT ODOBNM:0 CMD<br />
C CALL 'QCMDEXC' 90<br />
C PARM CMD<br />
C PARM 256 LN<br />
C MOVE SELMID MSGID2<br />
C MOVEL 'CON2' CTRL<br />
*<br />
C SEL WHENEQ '12'<br />
C 'WRKMSGD' CAT(P) MESSID:1 CMD<br />
C CAT ODLBNM:1 CMD<br />
C CAT '/':0 CMD<br />
C CAT ODOBNM:0 CMD<br />
C CALL 'QCMDEXC' 90<br />
C PARM CMD<br />
C PARM 256 LN<br />
C MOVE SELMID MSGID2<br />
C MOVEL 'CON2' CTRL<br />
*<br />
C ENDSL<br />
*<br />
* NEXT SFL RECORD<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ROLL-UP PANEL 1<br />
*****************************************************************<br />
C $DROL1 BEGSR<br />
* REPOSITION THE FILE TO AFTER THE LAST USED RECORD<br />
C RECDB1 SETGT QLIDOBJD<br />
C Z-ADD LSTRR1 RRN1<br />
* FILL 1 PAGE.<br />
C DO PAG1<br />
* NEXT SFL DETAILS<br />
C READ QLIDOBJD 11<br />
C 11 LEAVE<br />
* WRITE THE SFL RECORD<br />
C EXSR $FSFL1<br />
C ADD 1 RRN1<br />
C WRITE WRKMSGS1<br />
C ENDDO<br />
*<br />
C Z-ADD RECDB RECDB1<br />
C Z-ADD RRN1 LSTRR1<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* FILL SFL 1 RECORD<br />
*****************************************************************<br />
C $FSFL1 BEGSR<br />
*<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
C MOVE *BLANKS #SEL<br />
*<br />
* FILL THE SFL RECORD<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ROLL-UP PANEL 2<br />
*****************************************************************<br />
C $DROL2 BEGSR<br />
*<br />
C Z-ADD LSTRR2 RRN2<br />
C Z-ADD *ZERO LSTRR2<br />
* FILL 1 PAGE.<br />
C DO PAG2 CNT2<br />
* NEXT SFL DETAILS<br />
C EXSR $NXTMS<br />
C 11 LEAVE<br />
C EXSR $INCL2<br />
C 11 LEAVE<br />
C @INCL IFNE 'Y'<br />
C SUB 1 CNT2<br />
C ITER<br />
C END<br />
* WRITE THE SFL RECORD<br />
C EXSR $FSFL2<br />
C ADD 1 RRN2<br />
C EXSR $XEDT2<br />
C MOVEA *IN(51) @IND<br />
C @IND COMP *ZERO 2525<br />
C WRITE WRKMSGS2<br />
C MOVEL MESSID MSGID2<br />
C ENDDO<br />
*<br />
C Z-ADD RRN2 LSTRR2<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* NXTMS - GET THE NEXT MESSAGE<br />
*****************************************************************<br />
C $NXTMS BEGSR<br />
*<br />
C MOVEL ODOBNM MFLLIB<br />
C MOVE ODLBNM MFLLIB<br />
C MOVEL(P) '*NEXT' ROPT<br />
C MSGID2 IFEQ *BLANKS<br />
C MOVEL(P) '*FIRST' ROPT<br />
C END<br />
C MSGID2 IFEQ SELMID<br />
C MSGID2 ANDNE *BLANKS<br />
C RRN2 ANDEQ *ZERO<br />
C MOVEL(P) '*MSGID' ROPT<br />
C END<br />
*<br />
C $RETRY TAG<br />
C CALL 'QMHRTVM' 11<br />
C PARM FORM<br />
C PARM 2048 FLEN<br />
C PARM 'RTVM0300' FMTR 10<br />
C PARM MSGID2<br />
C PARM MFLLIB 20<br />
C PARM *BLANKS RDTA 1<br />
C PARM 1 RLEN<br />
C PARM '*NO' RVAL 10<br />
C PARM '*NO' CVAL 10<br />
C PARM APIERR<br />
C PARM ROPT 10<br />
C PARM 0 FCCS<br />
C PARM 0 TCCS<br />
C N11MRET COMP 84 11<br />
C *IN11 IFEQ '0'<br />
C MOVEL MID MSGID2<br />
C ADD 1 MO<br />
C ML SUBST(P) FORM:MO MSTEXT<br />
C*** EXSR SETTXT<br />
C*** ML SUBSTFORM:XX MSTEXT P<br />
C M2L IFEQ *ZERO<br />
C MOVE *BLANKS MSSECL<br />
C ELSE<br />
C M2L SUBST(P) FORM:M2 MSSECL<br />
C END<br />
C END<br />
C 11ROPT IFEQ '*MSGID'<br />
C MOVEL(P) '*NEXT' ROPT<br />
C GOTO $RETRY<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* TEST SFL 2 RECORD FOR INCLUSION<br />
*****************************************************************<br />
C $INCL2 BEGSR<br />
*<br />
C SELTXT IFEQ *BLANKS<br />
C MOVE 'Y' @INCL<br />
C GOTO XINCL2<br />
C END<br />
*<br />
* AND/OR SELECTIONS<br />
C ANDOR IFEQ 'A'<br />
C MOVE 'N' @INCL<br />
C ELSE<br />
C MOVE 'Y' @INCL<br />
C END<br />
* TEXT SELECTOR<br />
C LO:HI XLATE MSTEXT TSTTXT<br />
*<br />
* FOR EACH TEXT PART<br />
* IF FOUND, USING OR THEN FINISHED<br />
* IF NOT FOUND, USING AND THEN FINISHED<br />
*<br />
C DO 6 Y<br />
C SELT(Y) IFEQ *BLANKS<br />
C ITER<br />
C END<br />
*<br />
C ' ' CHECKR SELT(Y) X<br />
C X IFEQ *ZERO<br />
C Z-ADD 10 X<br />
C END<br />
C SELT(Y):X SCAN TSTTXT 51<br />
C *IN51 IFEQ '1'<br />
C ANDOR ANDEQ 'O'<br />
C *IN51 OREQ '0'<br />
C ANDOR ANDEQ 'A'<br />
C GOTO XINCL2<br />
C END<br />
C ENDDO<br />
*<br />
* TESTED ALL<br />
* USING AND, THEN INCLUDE<br />
* USING OR, THEN EXCLUDE<br />
C ANDOR IFEQ 'A'<br />
C MOVE 'Y' @INCL<br />
C ELSE<br />
C MOVE 'N' @INCL<br />
C END<br />
*<br />
C XINCL2 ENDSR<br />
*****************************************************************<br />
* FILL SFL 2 RECORD<br />
*****************************************************************<br />
C $FSFL2 BEGSR<br />
*<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
C MOVE *BLANKS #SEL<br />
*<br />
* FILL THE SFL RECORD<br />
C MOVEL MID MESSID<br />
/002 C @VER IFEQ 'V3'<br />
/002 C @VER OREQ 'V4'<br />
/002 C @VER OREQ 'V5'<br />
/003 C @VER OREQ 'V6'<br />
/003 C @VER OREQ 'V7'<br />
C MOVEL MSTEXT MESSTX<br />
/002 C ELSE<br />
/002 C MOVEL MSTXT4 MESSTX<br />
/002 C ENDIF<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT SFL 2 RECORD<br />
*****************************************************************<br />
C $XEDT2 BEGSR<br />
*<br />
* FULL EDIT IS DONE HERE<br />
* INCLUDING WARNINGS<br />
C SETOFF 50<br />
*<br />
C XXEDT2 ENDSR<br />
*****************************************************************<br />
* FINISHING SUBROUTINE / CLOSE FILES ETC.<br />
*****************************************************************<br />
C $AFNSH BEGSR<br />
*<br />
C MOVEL 'EXIT' CTRL<br />
C ENDSR<br />
*****************************************************************<br />
* INITIALISATION SUBROUTINE<br />
*****************************************************************<br />
C *INZSR BEGSR<br />
* PARAMETERS AND KEY LISTS<br />
C *ENTRY PLIST<br />
C PARM FILLIB 20<br />
/002 C PARM @SYSVR<br />
*<br />
*<br />
* FIELD DEFINITIONS AND INITIALISATION<br />
C Z-ADD 16 PAG1 5 0<br />
C Z-ADD 14 PAG2 5 0<br />
C Z-ADD *ZERO RRN1 4 0<br />
C Z-ADD *ZERO RRN2 4 0<br />
*<br />
C MOVE *BLANKS MSGID2 7<br />
C MOVE *BLANKS @ERR 1<br />
C MOVE *BLANKS @IND 20<br />
C MOVE *BLANKS CMD 256<br />
C Z-ADD *ZERO LN 15 5<br />
C Z-ADD *ZERO X 5 0<br />
C Z-ADD *ZERO Y 5 0<br />
C MOVE *BLANKS @INCL 1<br />
C MOVE *BLANKS TEST4 4<br />
*<br />
C *LIKE DEFINE RRN1 LSTRR1<br />
C *LIKE DEFINE RRN2 LSTRR2<br />
C *LIKE DEFINE PAG1 CNT1<br />
C *LIKE DEFINE PAG2 CNT2<br />
C *LIKE DEFINE #SEL SEL<br />
C *LIKE DEFINE SELMID MIDLST<br />
C *LIKE DEFINE SELTXT TXTLST<br />
C *LIKE DEFINE ANDOR ANDLST<br />
C *LIKE DEFINE MSTEXT TSTTXT<br />
*<br />
* SET CONTROL FOR INITIAL DISPLAY<br />
C MOVEL 'CON1' CTRL 4<br />
C ENDSR<br />
*****************************************************************<br />
** ERROR SUBROUTINE *<br />
*****************************************************************<br />
C XPSSR BEGSR<br />
** CHECK ERROR ONCE ONLY<br />
C* @PSSR IFEQ *BLANK<br />
C* MOVEL'Y' @PSSR 1<br />
** DUMP PROGRAM TO TRACE FAULT<br />
C* DUMP<br />
C* END<br />
* EXIT THE PROGRAM<br />
C SETON LR<br />
C RETURN<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
* $PRNT2 - PRINT PANEL 2<br />
*----------------------------------------------------------------<br />
C $PRNT2 BEGSR<br />
C *IN11 DOWNE '1'<br />
C EXSR $DROL2<br />
C END<br />
C Z-ADD *ZERO PAGE<br />
C TIME RTIME 12 0<br />
* SYSTEM NAME<br />
C CALL 'QWCRNETA' 51<br />
C PARM NETDET 32<br />
C PARM 32 BIN41<br />
C PARM 1 BIN42<br />
C PARM 'SYSNAME' NETATR 10<br />
C PARM APIERR<br />
C MOVE NETDET SYSNAM 8<br />
* OPEN THE PRINTER<br />
C OPEN QSYSPRT<br />
C SETON OF<br />
C DO *HIVAL RRN2<br />
C RRN2 CHAIN WRKMSGS2 5151<br />
C 51 LEAVE<br />
C EXCEPT #DETL1<br />
C MSTEX2 IFNE *BLANKS<br />
C EXCEPT #DETL2<br />
C END<br />
C DO 10 Y<br />
C MS2(Y) IFNE *BLANKS<br />
C EXCEPT #DETL3<br />
C END<br />
C ENDDO<br />
C ENDDO<br />
*<br />
C CLOSE QSYSPRT<br />
*<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
* SETTXT - CHECK TO MAKE SURE STARTING POSITION IS VALID<br />
*----------------------------------------------------------------<br />
C SETTXT BEGSR<br />
*<br />
* THIS SUBROUTINE IS DESIGNED TO FIND THE POSITION OF THE 1ST<br />
* CHARACTER OF THE MESSAGE TEXT<br />
*<br />
C Z-ADD 100 XX 4 0<br />
C MOVE 'N' OK 1<br />
C OK DOWEQ 'N'<br />
C 6 SUBST FORM:XX TSTFLD 6<br />
C TSTFLD IFGE ' '<br />
C MOVE 'Y' OK<br />
C ELSE<br />
C ADD 1 XX<br />
C ENDIF<br />
C ENDDO<br />
*<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
C* *PSSR BEGSR<br />
** CHECK ERROR ONCE ONLY<br />
C* @PSSR IFEQ *BLANK<br />
C* MOVEL'Y' @PSSR 1<br />
** DUMP PROGRAM TO TRACE FAULT<br />
C* DUMP<br />
C* END<br />
* EXIT THE PROGRAM<br />
C* SETON LR<br />
C* RETRN<br />
C* ENDSR<br />
*<br />
*****************************************************************<br />
OQSYSPRT H OF 2 03<br />
O SYSNAM 10<br />
O + 3 'MESSAGE DESCRIPTIONS:'<br />
O RTIME + 5 ' 0: : && / / '<br />
O PAGE Z + 12<br />
O - 8 'PAGE:'<br />
O H OF 1<br />
O ODOBNM + 1<br />
O ODLBNM + 1<br />
O ODOBTX + 1<br />
O H OF 1<br />
O 'SELECT:'<br />
O + 1 'MESSAGEID'<br />
O SELMID + 1<br />
O H OF 1<br />
O + 8 'MESSAGE TEXT'<br />
O + 1 '(AND/OR)'<br />
O ANDOR + 1<br />
O SELTX1 + 1<br />
O SELTX2 + 1<br />
O SELTX3 + 1<br />
O SELTX4 + 1<br />
O SELTX5 + 1<br />
O SELTX6 + 1<br />
O EF #DETL1 1 1<br />
O MESSID 7<br />
O MSTEX1 + 1<br />
O E #DETL2 1<br />
O MSTEX2 + 8<br />
O E #DETL3 1<br />
O MS2(Y) 100<br />
<br />
</pre><br />
[[Category:Utilities]]</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11741
WrkMsgs
2014-06-04T05:36:31Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<br />
== CMD ==<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre><br />
<br />
== CL ==<br />
<pre><br />
/*=========================================================================== */<br />
/* Name...: WRKMSGSC */<br />
/* Version: n/a */<br />
/* Purpose: Run test cases for EDP824D */<br />
/* Summary: */<br />
/* 1) Dump *MSGF to temp file */<br />
/* 2) Run pgm */<br />
/* Params.: */<br />
/* : i_FILELIB : Message File */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCLPGM ??PGM(R50MODS/*PGM) */<br />
/* ?*SRCFILE(*LIBL/QCLSRC) */<br />
/* ?*SRCMBR(WRKMSGSC) */<br />
/* ??REPLACE(*YES) */<br />
/* Log....: */<br />
/* 2014May19 JK- Updated */<br />
/* */<br />
/*----------------------------------------------------------------------------*/<br />
PGM (&FL)<br />
DCL &FL *CHAR 20<br />
<br />
DCL &MSG *CHAR 80<br />
DCL &MS *CHAR 7<br />
DCL &SYSDTA *CHAR 750 /* /002 */<br />
DCL &SYSVR *CHAR 6 /* /002 */<br />
<br />
MONMSG CPF0000 EXEC(GOTO ERROR)<br />
<br />
/* Dump *MSGF to temp file */<br />
DSPOBJD OBJ(%SST(&FL 11 10)/%SST(&FL 1 10)) +<br />
OBJTYPE(*MSGF) OUTPUT(*OUTFILE) +<br />
OUTFILE(QTEMP/QADSPOBJ)<br />
<br />
OVRDBF QADSPOBJ QTEMP/QADSPOBJ SECURE(*YES) SHARE(*NO)<br />
<br />
RTVDTAARA DTAARA(QSS1MRI) RTNVAR(&SYSDTA) /* /002 */<br />
CHGVAR VAR(&SYSVR) VALUE(&SYSDTA) /* /002 */<br />
<br />
/* Run pgm */<br />
CALL WRKMSGSR (&FL &SYSVR) /* /002 */<br />
RETURN<br />
<br />
ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSG) MSGID(&MS)<br />
SNDPGMMSG MSGID(&MS) MSGF(QCPFMSG) MSGDTA(&MSG) +<br />
MSGTYPE(*ESCAPE)<br />
EOJ:<br />
ENDPGM<br />
<br />
</pre><br />
<br />
== DDS ==<br />
<pre><br />
A*========================================================= <br />
A*/ Name...: WRKMSGSD <br />
A*/ Version: n/a <br />
A*/ Purpose: Work with message files <br />
A*/ Summary: <br />
A*/ N/A : <br />
A*/ Params.: <br />
A*/ N/A : <br />
A*/ LDA....: <br />
A*/ N/A : <br />
A*/ Compile: <br />
A*/ CRTDSPF FILE(WRKMSGSD) <br />
A*/ SRCFILE(QDDSSRC) <br />
A*/ SRCMBR(WRKMSGSD) <br />
A*/ REPLACE(*YES) <br />
A*/ Notes..: <br />
A*/ 1) This *pgm courtesy of CLOVER <br />
A*/ Log....: <br />
A*/ 2014May19 - Copied from archive <br />
A*/=========================================================<br />
A* INDARA IS REQUIRED FOR RETKEY/RETCMDKEY<br />
A*%%EC<br />
A DSPSIZ(24 80 *DS3)<br />
A REF(*LIBL/QADSPOBJ)<br />
A MSGLOC(23)<br />
A INDARA<br />
A PRINT(*LIBL/QSYSPRT)<br />
A OPENPRT<br />
A ERRSFL<br />
*-------------------------------------------------------------------------<br />
* PANEL 1 - LIST OF MESSAGE FILES<br />
*-------------------------------------------------------------------------<br />
A R WRKMSG01 PUTOVR<br />
A 1 3'WRKMSGS.01'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72DATE OVRATR EDTCDE(Y)<br />
A 2 72TIME OVRATR<br />
A 2 26' MESSAGE FILES '<br />
A DSPATR(HI)<br />
A 2 2'12-WORK WITH'<br />
A 4 2' FILE LIBRARY TEXT -<br />
A '<br />
A DSPATR(UL)<br />
<br />
A R WRKMSGS1 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 5 2CHECK(AB)<br />
A VALUES(' ' '12')<br />
A 51 DSPATR(RI PC)<br />
A ODOBNM R + 1<br />
A ODLBNM R + 1<br />
A ODOBTX R + 1<br />
<br />
A R WRKMSGC1 SFLCTL(WRKMSGS1) CA03<br />
A CA12<br />
A SFLSIZ(50) SFLPAG(16)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO WORK WITH FILE')<br />
<br />
A #DSPC1 4S 0H SFLRCDNBR<br />
A 21 2 ' '<br />
A 24 5'F3=EXIT'<br />
A 24 17'F12 CANCEL'<br />
<br />
*-------------------------------------------------------------------------<br />
* INSERT PANEL - DETAILS OF THE SELECTION<br />
*-------------------------------------------------------------------------<br />
A R WRKMSGA1 CLRL(*NO) RETKEY RETCMDKEY<br />
A 3 2'FILE'<br />
A ODOBNM R + 1DSPATR(HI)<br />
A ODLBNM R + 1DSPATR(HI)<br />
A ODOBTX R + 1DSPATR(HI)<br />
<br />
<br />
A*-------------------------------------------------------------------------<br />
A* PANEL 2 - LIST OF MESSAGES<br />
A*-------------------------------------------------------------------------<br />
A R WRKMSG02<br />
A*%%TS SD 20140529 201332 JKING REL-V6R1M0 5761-WDS<br />
A PUTOVR<br />
A 1 3'WRKMSGS.02'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72OVRATR<br />
A DATE<br />
A EDTCDE(Y)<br />
A 2 72TIME<br />
A OVRATR<br />
A 2 26'MESSAGE DESCRIPTIONS'<br />
A DSPATR(HI)<br />
A 4 2'3-COPY, 12-WORK WITH'<br />
A 5 13'AND/OR'<br />
A ANDOR 1A B 5 20VALUES('A' 'O')<br />
A SELMID 7A B 6 5OVRDTA<br />
A SELTX1 10A B 6 13DSPATR(PC)<br />
A OVRATR<br />
A CHECK(LC)<br />
A SELTX2 10A B 6 24CHECK(LC)<br />
A SELTX3 10A B 6 35CHECK(LC)<br />
A SELTX4 10A B 6 46CHECK(LC)<br />
A SELTX5 10A B 6 57CHECK(LC)<br />
A SELTX6 10A B 6 68CHECK(LC)<br />
A 7 2' MESSAGE TEXT -<br />
A -<br />
A '<br />
A DSPATR(UL)<br />
A R WRKMSGS2 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 8 2DSPATR(HI)<br />
A 25N50 DSPATR(PC)<br />
A MESSID 7 + 1<br />
A MESSTX 65 + 1<br />
A MSTEXT 132 H<br />
A MSSECL 800 H<br />
<br />
<br />
A R WRKMSGC2 SFLCTL(WRKMSGS2)<br />
A CA03 CF05 CA12 CF21<br />
A SFLSIZ(50) SFLPAG(14)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO EDIT MESSAGE')<br />
A #DSPC2 4S 0H SFLRCDNBR<br />
A 22 2 ' '<br />
A 24 5'F3=EXIT F5=REFRESH -<br />
A F12=PREVIOUS F21=PRINT'<br />
<br />
<br />
*-------------------------------------------------------------------------<br />
* MISCELLANEOUS PANELS<br />
*-------------------------------------------------------------------------<br />
<br />
A R @CONFIRM OVERLAY CLRL(*NO) CF05 CA12<br />
A 23 7'PRESS F5 TO CONFIRM.'<br />
<br />
A R @BOX OVERLAY PROTECT CLRL(3)<br />
A 22 2' -<br />
A -<br />
A ' DSPATR(RI)<br />
A 23 2' ' DSPATR(RI)<br />
A 23 80' ' DSPATR(RI)<br />
A 24 2' -<br />
A F12=PREVIOUS -<br />
A ' DSPATR(RI)<br />
<br />
A R @CLEAR1 OVERLAY<br />
A 8 1' '<br />
<br />
</pre><br />
<br />
== RPG ==<br />
<pre><br />
/////copy *LIBL/QRPGLESRC,@StdH_H<br />
H Option(*NoShowCpy : *NoDebugIO : *SrcStmt )<br />
H DftActGrp(*no) ActGrp('QILE')<br />
//=========================================================<br />
// Name...: WRKMSGSR<br />
// Version: n/a<br />
// Purpose: Work with message files<br />
// Summary:<br />
// 1) Prompts for message file<br />
// 2) Reads selected message file into SFL<br />
// Params.:<br />
// i_libfil : Library/file<br />
// i_SYSVRr : System Version<br />
// LDA....:<br />
// *None :<br />
// Compile:<br />
// CRTBNDRPG lib/pgm SRCFILE(srclib/srcfile) DBGVIEW(*ALL)<br />
// Notes..:<br />
// 1) This *pgm courtesy of CLOVER<br />
// 2) Converted from RPG3 with CVTRPGPGM<br />
// Log....:<br />
// 2014May19 - Copied from archive<br />
/002 // ???? - Mod to adjust for OS version<br />
/003 // 2014May19 - JEK: Mod for V6 and presumably V7<br />
//=========================================================<br />
FQADSPOBJ IF E DISK INFDS(INFDB1)<br />
FWRKMSGSD CF E WORKSTN<br />
F SFILE(WRKMSGS1:RRN1)<br />
F SFILE(WRKMSGS2:RRN2)<br />
FQSYSPRT O F 132 PRINTER OFLIND(*INOF)<br />
F USROPN<br />
*<br />
D VAL S 1 DIM(4)<br />
*<br />
D INFDB1 DS<br />
D RECDB 397 400B 0<br />
D POS1 DS INZ<br />
D RECDB1 1 7 0<br />
*<br />
* PROGRAM DS<br />
D SDS<br />
D WRKSTN 244 253<br />
D USRPRF 254 263<br />
* TEXT SELECTIONS<br />
D SELTXT DS<br />
D SELT 1 60<br />
D DIM(6)<br />
D SELTX1 1 10<br />
D SELTX2 11 20<br />
D SELTX3 21 30<br />
D SELTX4 31 40<br />
D SELTX5 41 50<br />
D SELTX6 51 60<br />
/002 * THE VERSION OF THE OPERATING SYSTEM<br />
/002 D @SYSVR DS 6<br />
/002 D @VER 1 2<br />
/002 D @RLS 3 4<br />
/002 D @MOD 5 6<br />
* 1ST LEVEL MESSAGE<br />
D MSTEXT DS<br />
D MSTEX1 1 80<br />
/002 D MSTXT4 2 80<br />
D MSTEX2 81 132<br />
* 2ND LEVEL MESSAGE<br />
D MSSECL DS<br />
D MS2 1 800<br />
D DIM(10)<br />
* API DATA STRUCTURES<br />
D FORM DS 2048<br />
D MRET 1 4B 0<br />
D MID 27 33<br />
D MO 65 68B 0<br />
D ML 69 72B 0<br />
D M2 77 80B 0<br />
D M2L 81 84B 0<br />
* API FIELDS<br />
D APIF DS<br />
D FLEN 1 4B 0<br />
D RLEN 5 8B 0<br />
D FCCS 9 12B 0<br />
D TCCS 13 16B 0<br />
* API ERROR<br />
D APIERR DS INZ<br />
D ERRAV 1 4B 0<br />
D ERRPR 5 8B 0 INZ(116)<br />
D ERRMS 9 15<br />
D ERRRS 16 16<br />
D ERRDT 17 116<br />
D DS INZ<br />
D BIN41 1 4B 0<br />
D BIN42 5 8B 0<br />
*<br />
* CONSTANTS<br />
D LODATE C CONST('1960-01-01')<br />
D LO C CONST('ABCDEFGHIJKLMNOPQRST-<br />
D UVWXYZ')<br />
D HI C CONST('ABCDEFGHIJKLMNOPQRST-<br />
D UVWXYZ')<br />
*<br />
*<br />
*****************************************************************<br />
** MAIN PROCESSING *<br />
*****************************************************************<br />
C CTRL DOUEQ 'EXIT'<br />
* 01 - FILE SELECTION<br />
C CTRL CASEQ 'CON1' $ACON1<br />
C CTRL CASEQ 'DSP1' $ADSP1<br />
C CTRL CASEQ 'EDT1' $AEDT1<br />
C CTRL CASEQ 'ACT1' $AACT1<br />
* 02 - MESSAGES<br />
C CTRL CASEQ 'CON2' $ACON2<br />
C CTRL CASEQ 'DSP2' $ADSP2<br />
C CTRL CASEQ 'EDT2' $AEDT2<br />
C CTRL CASEQ 'ACT2' $AACT2<br />
*<br />
C CTRL CASEQ 'FINI' $AFNSH<br />
C CAS XPSSR<br />
C END<br />
C END<br />
* END OF PROGRAM<br />
C SETON LR<br />
C RETURN<br />
*****************************************************************<br />
* CONSTRUCT PANEL 1<br />
*****************************************************************<br />
C $ACON1 BEGSR<br />
*<br />
* CLEAR SUBFILE<br />
C SETON 21<br />
C WRITE WRKMSGC1<br />
C SETOFF 21<br />
C Z-ADD *ZERO RRN1<br />
C Z-ADD *ZERO LSTRR1<br />
C Z-ADD *ZERO #DSPC1<br />
*<br />
* FILL SUBFILE FROM THE BEGINNING POSITION<br />
C RESET POS1<br />
C EXSR $DROL1<br />
* SET CONTROL<br />
C RRN1 IFEQ 1<br />
C MOVEL 'CON2' CTRL<br />
C ELSE<br />
C MOVEL 'DSP1' CTRL<br />
C END<br />
C ENDSR<br />
*****************************************************************<br />
* DISPLAY PANEL 1<br />
*****************************************************************<br />
C $ADSP1 BEGSR<br />
*<br />
C #DSPC1 IFEQ *ZERO<br />
C #DSPC1 ORGT LSTRR1<br />
C Z-ADD LSTRR1 #DSPC1<br />
C END<br />
* DISPLAY SUBFILE<br />
C LSTRR1 COMP *ZERO 22<br />
C N22 WRITE @CLEAR1<br />
C WRITE WRKMSG01<br />
C EXFMT WRKMSGC1<br />
* SET ERROR INDICATORS OFF<br />
C MOVE 'N' @ERR<br />
C Z-ADD *ZERO #DSPC1<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(71)<br />
* F3 - EXIT<br />
* F12 - CANCEL<br />
C SELECT<br />
C *INKC WHENEQ '1'<br />
C *INKL OREQ '1'<br />
C MOVEL 'FINI' CTRL<br />
* ROLL-UP<br />
C *IN19 WHENEQ '1'<br />
C EXSR $DROL1<br />
C MOVEL 'DSP1' CTRL<br />
* NO RECORDS<br />
C LSTRR1 WHENEQ *ZERO<br />
C MOVEL 'DSP1' CTRL<br />
* SET CONTROL<br />
C OTHER<br />
C MOVEL 'EDT1' CTRL<br />
C ENDSL<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT PANEL 1<br />
*****************************************************************<br />
C $AEDT1 BEGSR<br />
C MOVE 'N' @ERR<br />
C MOVEL 'DSP1' CTRL<br />
*<br />
* READ CHANGED RECORDS<br />
C Z-ADD *ZERO RRN1<br />
C Z-ADD *ZERO #DSPC1<br />
C DO *HIVAL<br />
C READC WRKMSGS1 31<br />
C 31 LEAVE<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
*<br />
* BEGIN EDIT<br />
* APPROPRIATE SELECTIONS<br />
C SELECT<br />
* NO SELECTION<br />
C #SEL WHENEQ *BLANKS<br />
*<br />
C ENDSL<br />
* UPDATE THE SFL<br />
C MOVEA *IN(51) @IND<br />
C @IND IFNE *ZERO<br />
C MOVE 'Y' @ERR<br />
C END<br />
C #SEL IFNE *BLANKS<br />
C SETON 25<br />
C END<br />
C UPDATE WRKMSGS1<br />
C SETOFF 25<br />
C #DSPC1 IFEQ *ZERO<br />
C @ERR ANDEQ 'Y'<br />
C Z-ADD RRN1 #DSPC1<br />
C END<br />
C END<br />
*<br />
* ALL SFL ENTRIES EDITED<br />
C #DSPC1 IFEQ *ZERO<br />
C Z-ADD RRN1 #DSPC1<br />
C END<br />
*<br />
C @ERR IFEQ 'N'<br />
C MOVEL 'ACT1' CTRL<br />
C END<br />
*<br />
C EXEDT1 ENDSR<br />
*****************************************************************<br />
* ACTION PANEL 1<br />
*****************************************************************<br />
C $AACT1 BEGSR<br />
C MOVEL 'DSP1' CTRL<br />
*<br />
* READ SELECTED RECORDS FROM SUBFILE<br />
C Z-ADD 1 #DSPC1<br />
C WRITE WRKMSGC1<br />
*<br />
C DO *HIVAL<br />
C READC WRKMSGS1 31<br />
C *IN31 IFEQ '1'<br />
C MOVEL 'DSP2' CTRL<br />
C LEAVE<br />
C END<br />
C #SEL IFEQ *BLANKS<br />
C ITER<br />
C END<br />
C MOVE #SEL SEL<br />
C MOVE *BLANKS #SEL<br />
C UPDATE WRKMSGS1<br />
C Z-ADD RRN1 #DSPC1<br />
* NEXT DISPLAY FOR THE SELECTED RECORD<br />
C SELECT<br />
C SEL WHENEQ '12'<br />
C MOVE *BLANKS MSGID2<br />
C MOVEL 'CON2' CTRL<br />
C LEAVE<br />
C ENDSL<br />
* NEXT SFL RECORD<br />
C END<br />
*<br />
C EXACT1 ENDSR<br />
*****************************************************************<br />
* CONSTRUCT PANEL 2<br />
*****************************************************************<br />
C $ACON2 BEGSR<br />
* CLEAR SUBFILE<br />
C SETON 21<br />
C WRITE WRKMSGC2<br />
C SETOFF 21<br />
C Z-ADD *ZERO RRN2<br />
C Z-ADD *ZERO LSTRR2<br />
C Z-ADD *ZERO #DSPC2<br />
*<br />
* FILL SUBFILE FROM THE BEGINNING POSITION<br />
C ANDOR IFEQ *BLANKS<br />
C MOVE 'A' ANDOR<br />
C END<br />
C EXSR $DROL2<br />
C MOVEL SELMID MIDLST<br />
C MOVEL SELTXT TXTLST<br />
C MOVEL ANDOR ANDLST<br />
* SET CONTROL<br />
C MOVEL 'DSP2' CTRL<br />
C ENDSR<br />
*****************************************************************<br />
* DISPLAY PANEL 2<br />
*****************************************************************<br />
C $ADSP2 BEGSR<br />
*<br />
C #DSPC2 IFEQ *ZERO<br />
C #DSPC2 ORGT LSTRR2<br />
C Z-ADD LSTRR2 #DSPC2<br />
C END<br />
* DISPLAY SUBFILE<br />
C LSTRR2 COMP *ZERO 22<br />
C N22 WRITE @CLEAR1<br />
C WRITE WRKMSG02<br />
C WRITE WRKMSGA1<br />
C EXFMT WRKMSGC2<br />
C READ WRKMSG02 51<br />
* SET ERROR INDICATORS OFF<br />
C MOVE 'N' @ERR<br />
C Z-ADD *ZERO #DSPC2<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(71)<br />
* F3 - EXIT<br />
C SELECT<br />
C *INKC WHENEQ '1'<br />
C MOVEL 'FINI' CTRL<br />
* F12 - RETURN<br />
C *INKL WHENEQ '1'<br />
C MOVEL 'DSP1' CTRL<br />
* F21 - PRINT<br />
C *INKV WHENEQ '1'<br />
C EXSR $PRNT2<br />
C MOVEL 'DSP2' CTRL<br />
* F5 - REFRESH<br />
* OR NEW SELECTIONS<br />
C *INKE WHENEQ '1'<br />
C SELMID ORNE MIDLST<br />
C SELTXT ORNE TXTLST<br />
C ANDOR ORNE ANDLST<br />
C MOVEL SELMID MSGID2<br />
C MSGID2 IFNE *BLANKS<br />
C MOVE MSGID2 TEST4<br />
C MOVEA TEST4 VAL<br />
C DO 4 X<br />
C VAL(X) IFLT 'A'<br />
C VAL(X) ORGT 'F'<br />
C VAL(X) ANDLT '0'<br />
C MOVE '0' VAL(X)<br />
C END<br />
C ENDDO<br />
C END<br />
C MOVEA VAL TEST4<br />
C MOVE TEST4 MSGID2<br />
C MOVE MSGID2 SELMID<br />
C MOVE MSGID2 MIDLST<br />
C MOVE 'CON2' CTRL<br />
* ROLL-UP<br />
C *IN19 WHENEQ '1'<br />
C EXSR $DROL2<br />
C MOVEL 'DSP2' CTRL<br />
* NO RECORDS<br />
C LSTRR2 WHENEQ *ZERO<br />
C MOVEL 'DSP2' CTRL<br />
* SET CONTROL<br />
C OTHER<br />
C MOVEL 'EDT2' CTRL<br />
C ENDSL<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT PANEL 2<br />
*****************************************************************<br />
C $AEDT2 BEGSR<br />
C MOVE 'N' @ERR<br />
C MOVEL 'DSP2' CTRL<br />
*<br />
* READ CHANGED RECORDS<br />
C Z-ADD *ZERO RRN2<br />
C Z-ADD *ZERO #DSPC2<br />
C SETON 25<br />
C DO *HIVAL<br />
C READC WRKMSGS2 31<br />
C 31 LEAVE<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
* EDITING<br />
*<br />
* UPDATE THE SFL<br />
C MOVEA *IN(51) @IND<br />
C @IND IFNE *ZERO<br />
C MOVE 'Y' @ERR<br />
C END<br />
C UPDATE WRKMSGS2<br />
C #DSPC2 IFEQ *ZERO<br />
C @ERR ANDEQ 'Y'<br />
C Z-ADD RRN2 #DSPC2<br />
C END<br />
C END<br />
*<br />
* ALL SFL ENTRIES EDITED<br />
C SETOFF 25<br />
C #DSPC2 IFEQ *ZERO<br />
C Z-ADD RRN2 #DSPC2<br />
C END<br />
* SET CONTROL<br />
C @ERR IFEQ 'N'<br />
C MOVEL 'ACT2' CTRL<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ACTION PANEL 2<br />
*****************************************************************<br />
C $AACT2 BEGSR<br />
C MOVEL 'DSP2' CTRL<br />
*<br />
* READ SELECTED RECORDS FROM SUBFILE<br />
C Z-ADD 1 #DSPC2<br />
C WRITE WRKMSGC2<br />
C DO *HIVAL<br />
C READC WRKMSGS2 31<br />
C 31 LEAVE<br />
C MOVE #SEL SEL<br />
C MOVE *BLANKS #SEL<br />
C UPDATE WRKMSGS2<br />
C Z-ADD RRN2 #DSPC2<br />
*<br />
* EDIT<br />
C SELECT<br />
C SEL WHENEQ '03'<br />
C SEL OREQ '3 '<br />
C '?CPYMSGD' CAT(P) MESSID:1 CMD<br />
C CAT ODLBNM:1 CMD<br />
C CAT '/':0 CMD<br />
C CAT ODOBNM:0 CMD<br />
C CALL 'QCMDEXC' 90<br />
C PARM CMD<br />
C PARM 256 LN<br />
C MOVE SELMID MSGID2<br />
C MOVEL 'CON2' CTRL<br />
*<br />
C SEL WHENEQ '12'<br />
C 'WRKMSGD' CAT(P) MESSID:1 CMD<br />
C CAT ODLBNM:1 CMD<br />
C CAT '/':0 CMD<br />
C CAT ODOBNM:0 CMD<br />
C CALL 'QCMDEXC' 90<br />
C PARM CMD<br />
C PARM 256 LN<br />
C MOVE SELMID MSGID2<br />
C MOVEL 'CON2' CTRL<br />
*<br />
C ENDSL<br />
*<br />
* NEXT SFL RECORD<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ROLL-UP PANEL 1<br />
*****************************************************************<br />
C $DROL1 BEGSR<br />
* REPOSITION THE FILE TO AFTER THE LAST USED RECORD<br />
C RECDB1 SETGT QLIDOBJD<br />
C Z-ADD LSTRR1 RRN1<br />
* FILL 1 PAGE.<br />
C DO PAG1<br />
* NEXT SFL DETAILS<br />
C READ QLIDOBJD 11<br />
C 11 LEAVE<br />
* WRITE THE SFL RECORD<br />
C EXSR $FSFL1<br />
C ADD 1 RRN1<br />
C WRITE WRKMSGS1<br />
C ENDDO<br />
*<br />
C Z-ADD RECDB RECDB1<br />
C Z-ADD RRN1 LSTRR1<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* FILL SFL 1 RECORD<br />
*****************************************************************<br />
C $FSFL1 BEGSR<br />
*<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
C MOVE *BLANKS #SEL<br />
*<br />
* FILL THE SFL RECORD<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ROLL-UP PANEL 2<br />
*****************************************************************<br />
C $DROL2 BEGSR<br />
*<br />
C Z-ADD LSTRR2 RRN2<br />
C Z-ADD *ZERO LSTRR2<br />
* FILL 1 PAGE.<br />
C DO PAG2 CNT2<br />
* NEXT SFL DETAILS<br />
C EXSR $NXTMS<br />
C 11 LEAVE<br />
C EXSR $INCL2<br />
C 11 LEAVE<br />
C @INCL IFNE 'Y'<br />
C SUB 1 CNT2<br />
C ITER<br />
C END<br />
* WRITE THE SFL RECORD<br />
C EXSR $FSFL2<br />
C ADD 1 RRN2<br />
C EXSR $XEDT2<br />
C MOVEA *IN(51) @IND<br />
C @IND COMP *ZERO 2525<br />
C WRITE WRKMSGS2<br />
C MOVEL MESSID MSGID2<br />
C ENDDO<br />
*<br />
C Z-ADD RRN2 LSTRR2<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* NXTMS - GET THE NEXT MESSAGE<br />
*****************************************************************<br />
C $NXTMS BEGSR<br />
*<br />
C MOVEL ODOBNM MFLLIB<br />
C MOVE ODLBNM MFLLIB<br />
C MOVEL(P) '*NEXT' ROPT<br />
C MSGID2 IFEQ *BLANKS<br />
C MOVEL(P) '*FIRST' ROPT<br />
C END<br />
C MSGID2 IFEQ SELMID<br />
C MSGID2 ANDNE *BLANKS<br />
C RRN2 ANDEQ *ZERO<br />
C MOVEL(P) '*MSGID' ROPT<br />
C END<br />
*<br />
C $RETRY TAG<br />
C CALL 'QMHRTVM' 11<br />
C PARM FORM<br />
C PARM 2048 FLEN<br />
C PARM 'RTVM0300' FMTR 10<br />
C PARM MSGID2<br />
C PARM MFLLIB 20<br />
C PARM *BLANKS RDTA 1<br />
C PARM 1 RLEN<br />
C PARM '*NO' RVAL 10<br />
C PARM '*NO' CVAL 10<br />
C PARM APIERR<br />
C PARM ROPT 10<br />
C PARM 0 FCCS<br />
C PARM 0 TCCS<br />
C N11MRET COMP 84 11<br />
C *IN11 IFEQ '0'<br />
C MOVEL MID MSGID2<br />
C ADD 1 MO<br />
C ML SUBST(P) FORM:MO MSTEXT<br />
C*** EXSR SETTXT<br />
C*** ML SUBSTFORM:XX MSTEXT P<br />
C M2L IFEQ *ZERO<br />
C MOVE *BLANKS MSSECL<br />
C ELSE<br />
C M2L SUBST(P) FORM:M2 MSSECL<br />
C END<br />
C END<br />
C 11ROPT IFEQ '*MSGID'<br />
C MOVEL(P) '*NEXT' ROPT<br />
C GOTO $RETRY<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* TEST SFL 2 RECORD FOR INCLUSION<br />
*****************************************************************<br />
C $INCL2 BEGSR<br />
*<br />
C SELTXT IFEQ *BLANKS<br />
C MOVE 'Y' @INCL<br />
C GOTO XINCL2<br />
C END<br />
*<br />
* AND/OR SELECTIONS<br />
C ANDOR IFEQ 'A'<br />
C MOVE 'N' @INCL<br />
C ELSE<br />
C MOVE 'Y' @INCL<br />
C END<br />
* TEXT SELECTOR<br />
C LO:HI XLATE MSTEXT TSTTXT<br />
*<br />
* FOR EACH TEXT PART<br />
* IF FOUND, USING OR THEN FINISHED<br />
* IF NOT FOUND, USING AND THEN FINISHED<br />
*<br />
C DO 6 Y<br />
C SELT(Y) IFEQ *BLANKS<br />
C ITER<br />
C END<br />
*<br />
C ' ' CHECKR SELT(Y) X<br />
C X IFEQ *ZERO<br />
C Z-ADD 10 X<br />
C END<br />
C SELT(Y):X SCAN TSTTXT 51<br />
C *IN51 IFEQ '1'<br />
C ANDOR ANDEQ 'O'<br />
C *IN51 OREQ '0'<br />
C ANDOR ANDEQ 'A'<br />
C GOTO XINCL2<br />
C END<br />
C ENDDO<br />
*<br />
* TESTED ALL<br />
* USING AND, THEN INCLUDE<br />
* USING OR, THEN EXCLUDE<br />
C ANDOR IFEQ 'A'<br />
C MOVE 'Y' @INCL<br />
C ELSE<br />
C MOVE 'N' @INCL<br />
C END<br />
*<br />
C XINCL2 ENDSR<br />
*****************************************************************<br />
* FILL SFL 2 RECORD<br />
*****************************************************************<br />
C $FSFL2 BEGSR<br />
*<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
C MOVE *BLANKS #SEL<br />
*<br />
* FILL THE SFL RECORD<br />
C MOVEL MID MESSID<br />
/002 C @VER IFEQ 'V3'<br />
/002 C @VER OREQ 'V4'<br />
/002 C @VER OREQ 'V5'<br />
/003 C @VER OREQ 'V6'<br />
/003 C @VER OREQ 'V7'<br />
C MOVEL MSTEXT MESSTX<br />
/002 C ELSE<br />
/002 C MOVEL MSTXT4 MESSTX<br />
/002 C ENDIF<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT SFL 2 RECORD<br />
*****************************************************************<br />
C $XEDT2 BEGSR<br />
*<br />
* FULL EDIT IS DONE HERE<br />
* INCLUDING WARNINGS<br />
C SETOFF 50<br />
*<br />
C XXEDT2 ENDSR<br />
*****************************************************************<br />
* FINISHING SUBROUTINE / CLOSE FILES ETC.<br />
*****************************************************************<br />
C $AFNSH BEGSR<br />
*<br />
C MOVEL 'EXIT' CTRL<br />
C ENDSR<br />
*****************************************************************<br />
* INITIALISATION SUBROUTINE<br />
*****************************************************************<br />
C *INZSR BEGSR<br />
* PARAMETERS AND KEY LISTS<br />
C *ENTRY PLIST<br />
C PARM FILLIB 20<br />
/002 C PARM @SYSVR<br />
*<br />
*<br />
* FIELD DEFINITIONS AND INITIALISATION<br />
C Z-ADD 16 PAG1 5 0<br />
C Z-ADD 14 PAG2 5 0<br />
C Z-ADD *ZERO RRN1 4 0<br />
C Z-ADD *ZERO RRN2 4 0<br />
*<br />
C MOVE *BLANKS MSGID2 7<br />
C MOVE *BLANKS @ERR 1<br />
C MOVE *BLANKS @IND 20<br />
C MOVE *BLANKS CMD 256<br />
C Z-ADD *ZERO LN 15 5<br />
C Z-ADD *ZERO X 5 0<br />
C Z-ADD *ZERO Y 5 0<br />
C MOVE *BLANKS @INCL 1<br />
C MOVE *BLANKS TEST4 4<br />
*<br />
C *LIKE DEFINE RRN1 LSTRR1<br />
C *LIKE DEFINE RRN2 LSTRR2<br />
C *LIKE DEFINE PAG1 CNT1<br />
C *LIKE DEFINE PAG2 CNT2<br />
C *LIKE DEFINE #SEL SEL<br />
C *LIKE DEFINE SELMID MIDLST<br />
C *LIKE DEFINE SELTXT TXTLST<br />
C *LIKE DEFINE ANDOR ANDLST<br />
C *LIKE DEFINE MSTEXT TSTTXT<br />
*<br />
* SET CONTROL FOR INITIAL DISPLAY<br />
C MOVEL 'CON1' CTRL 4<br />
C ENDSR<br />
*****************************************************************<br />
** ERROR SUBROUTINE *<br />
*****************************************************************<br />
C XPSSR BEGSR<br />
** CHECK ERROR ONCE ONLY<br />
C* @PSSR IFEQ *BLANK<br />
C* MOVEL'Y' @PSSR 1<br />
** DUMP PROGRAM TO TRACE FAULT<br />
C* DUMP<br />
C* END<br />
* EXIT THE PROGRAM<br />
C SETON LR<br />
C RETURN<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
* $PRNT2 - PRINT PANEL 2<br />
*----------------------------------------------------------------<br />
C $PRNT2 BEGSR<br />
C *IN11 DOWNE '1'<br />
C EXSR $DROL2<br />
C END<br />
C Z-ADD *ZERO PAGE<br />
C TIME RTIME 12 0<br />
* SYSTEM NAME<br />
C CALL 'QWCRNETA' 51<br />
C PARM NETDET 32<br />
C PARM 32 BIN41<br />
C PARM 1 BIN42<br />
C PARM 'SYSNAME' NETATR 10<br />
C PARM APIERR<br />
C MOVE NETDET SYSNAM 8<br />
* OPEN THE PRINTER<br />
C OPEN QSYSPRT<br />
C SETON OF<br />
C DO *HIVAL RRN2<br />
C RRN2 CHAIN WRKMSGS2 5151<br />
C 51 LEAVE<br />
C EXCEPT #DETL1<br />
C MSTEX2 IFNE *BLANKS<br />
C EXCEPT #DETL2<br />
C END<br />
C DO 10 Y<br />
C MS2(Y) IFNE *BLANKS<br />
C EXCEPT #DETL3<br />
C END<br />
C ENDDO<br />
C ENDDO<br />
*<br />
C CLOSE QSYSPRT<br />
*<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
* SETTXT - CHECK TO MAKE SURE STARTING POSITION IS VALID<br />
*----------------------------------------------------------------<br />
C SETTXT BEGSR<br />
*<br />
* THIS SUBROUTINE IS DESIGNED TO FIND THE POSITION OF THE 1ST<br />
* CHARACTER OF THE MESSAGE TEXT<br />
*<br />
C Z-ADD 100 XX 4 0<br />
C MOVE 'N' OK 1<br />
C OK DOWEQ 'N'<br />
C 6 SUBST FORM:XX TSTFLD 6<br />
C TSTFLD IFGE ' '<br />
C MOVE 'Y' OK<br />
C ELSE<br />
C ADD 1 XX<br />
C ENDIF<br />
C ENDDO<br />
*<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
C* *PSSR BEGSR<br />
** CHECK ERROR ONCE ONLY<br />
C* @PSSR IFEQ *BLANK<br />
C* MOVEL'Y' @PSSR 1<br />
** DUMP PROGRAM TO TRACE FAULT<br />
C* DUMP<br />
C* END<br />
* EXIT THE PROGRAM<br />
C* SETON LR<br />
C* RETRN<br />
C* ENDSR<br />
*<br />
*****************************************************************<br />
OQSYSPRT H OF 2 03<br />
O SYSNAM 10<br />
O + 3 'MESSAGE DESCRIPTIONS:'<br />
O RTIME + 5 ' 0: : && / / '<br />
O PAGE Z + 12<br />
O - 8 'PAGE:'<br />
O H OF 1<br />
O ODOBNM + 1<br />
O ODLBNM + 1<br />
O ODOBTX + 1<br />
O H OF 1<br />
O 'SELECT:'<br />
O + 1 'MESSAGEID'<br />
O SELMID + 1<br />
O H OF 1<br />
O + 8 'MESSAGE TEXT'<br />
O + 1 '(AND/OR)'<br />
O ANDOR + 1<br />
O SELTX1 + 1<br />
O SELTX2 + 1<br />
O SELTX3 + 1<br />
O SELTX4 + 1<br />
O SELTX5 + 1<br />
O SELTX6 + 1<br />
O EF #DETL1 1 1<br />
O MESSID 7<br />
O MSTEX1 + 1<br />
O E #DETL2 1<br />
O MSTEX2 + 8<br />
O E #DETL3 1<br />
O MS2(Y) 100<br />
<br />
</pre><br />
[[Category:Utilities]]</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11740
WrkMsgs
2014-06-04T05:34:12Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<br />
== CMD ==<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre><br />
<br />
== CL ==<br />
<pre><br />
/*=========================================================================== */<br />
/* Name...: WRKMSGSC */<br />
/* Version: n/a */<br />
/* Purpose: Run test cases for EDP824D */<br />
/* Summary: */<br />
/* 1) Dump *MSGF to temp file */<br />
/* 2) Run pgm */<br />
/* Params.: */<br />
/* : i_FILELIB : Message File */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCLPGM ??PGM(R50MODS/*PGM) */<br />
/* ?*SRCFILE(*LIBL/QCLSRC) */<br />
/* ?*SRCMBR(WRKMSGSC) */<br />
/* ??REPLACE(*YES) */<br />
/* Log....: */<br />
/* 2014May19 JK- Updated */<br />
/* */<br />
/*----------------------------------------------------------------------------*/<br />
PGM (&FL)<br />
DCL &FL *CHAR 20<br />
<br />
DCL &MSG *CHAR 80<br />
DCL &MS *CHAR 7<br />
DCL &SYSDTA *CHAR 750 /* /002 */<br />
DCL &SYSVR *CHAR 6 /* /002 */<br />
<br />
MONMSG CPF0000 EXEC(GOTO ERROR)<br />
<br />
/* Dump *MSGF to temp file */<br />
DSPOBJD OBJ(%SST(&FL 11 10)/%SST(&FL 1 10)) +<br />
OBJTYPE(*MSGF) OUTPUT(*OUTFILE) +<br />
OUTFILE(QTEMP/QADSPOBJ)<br />
<br />
OVRDBF QADSPOBJ QTEMP/QADSPOBJ SECURE(*YES) SHARE(*NO)<br />
<br />
RTVDTAARA DTAARA(QSS1MRI) RTNVAR(&SYSDTA) /* /002 */<br />
CHGVAR VAR(&SYSVR) VALUE(&SYSDTA) /* /002 */<br />
<br />
/* Run pgm */<br />
CALL WRKMSGSR (&FL &SYSVR) /* /002 */<br />
RETURN<br />
<br />
ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSG) MSGID(&MS)<br />
SNDPGMMSG MSGID(&MS) MSGF(QCPFMSG) MSGDTA(&MSG) +<br />
MSGTYPE(*ESCAPE)<br />
EOJ:<br />
ENDPGM<br />
<br />
</pre><br />
<br />
== DDS ==<br />
<pre><br />
A*========================================================= <br />
A*/ Name...: WRKMSGSD <br />
A*/ Version: n/a <br />
A*/ Purpose: Work with message files <br />
A*/ Summary: <br />
A*/ N/A : <br />
A*/ Params.: <br />
A*/ N/A : <br />
A*/ LDA....: <br />
A*/ N/A : <br />
A*/ Compile: <br />
A*/ CRTDSPF FILE(WRKMSGSD) <br />
A*/ SRCFILE(QDDSSRC) <br />
A*/ SRCMBR(WRKMSGSD) <br />
A*/ REPLACE(*YES) <br />
A*/ Notes..: <br />
A*/ 1) This *pgm courtesy of CLOVER <br />
A*/ Log....: <br />
A*/ 2014May19 - Copied from archive <br />
A*/=========================================================<br />
A* INDARA IS REQUIRED FOR RETKEY/RETCMDKEY<br />
A*%%EC<br />
A DSPSIZ(24 80 *DS3)<br />
A REF(*LIBL/QADSPOBJ)<br />
A MSGLOC(23)<br />
A INDARA<br />
A PRINT(*LIBL/QSYSPRT)<br />
A OPENPRT<br />
A ERRSFL<br />
*-------------------------------------------------------------------------<br />
* PANEL 1 - LIST OF MESSAGE FILES<br />
*-------------------------------------------------------------------------<br />
A R WRKMSG01 PUTOVR<br />
A 1 3'WRKMSGS.01'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72DATE OVRATR EDTCDE(Y)<br />
A 2 72TIME OVRATR<br />
A 2 26' MESSAGE FILES '<br />
A DSPATR(HI)<br />
A 2 2'12-WORK WITH'<br />
A 4 2' FILE LIBRARY TEXT -<br />
A '<br />
A DSPATR(UL)<br />
<br />
A R WRKMSGS1 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 5 2CHECK(AB)<br />
A VALUES(' ' '12')<br />
A 51 DSPATR(RI PC)<br />
A ODOBNM R + 1<br />
A ODLBNM R + 1<br />
A ODOBTX R + 1<br />
<br />
A R WRKMSGC1 SFLCTL(WRKMSGS1) CA03<br />
A CA12<br />
A SFLSIZ(50) SFLPAG(16)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO WORK WITH FILE')<br />
<br />
A #DSPC1 4S 0H SFLRCDNBR<br />
A 21 2 ' '<br />
A 24 5'F3=EXIT'<br />
A 24 17'F12 CANCEL'<br />
<br />
*-------------------------------------------------------------------------<br />
* INSERT PANEL - DETAILS OF THE SELECTION<br />
*-------------------------------------------------------------------------<br />
A R WRKMSGA1 CLRL(*NO) RETKEY RETCMDKEY<br />
A 3 2'FILE'<br />
A ODOBNM R + 1DSPATR(HI)<br />
A ODLBNM R + 1DSPATR(HI)<br />
A ODOBTX R + 1DSPATR(HI)<br />
<br />
<br />
A*-------------------------------------------------------------------------<br />
A* PANEL 2 - LIST OF MESSAGES<br />
A*-------------------------------------------------------------------------<br />
A R WRKMSG02<br />
A*%%TS SD 20140529 201332 JKING REL-V6R1M0 5761-WDS<br />
A PUTOVR<br />
A 1 3'WRKMSGS.02'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72OVRATR<br />
A DATE<br />
A EDTCDE(Y)<br />
A 2 72TIME<br />
A OVRATR<br />
A 2 26'MESSAGE DESCRIPTIONS'<br />
A DSPATR(HI)<br />
A 4 2'3-COPY, 12-WORK WITH'<br />
A 5 13'AND/OR'<br />
A ANDOR 1A B 5 20VALUES('A' 'O')<br />
A SELMID 7A B 6 5OVRDTA<br />
A SELTX1 10A B 6 13DSPATR(PC)<br />
A OVRATR<br />
A CHECK(LC)<br />
A SELTX2 10A B 6 24CHECK(LC)<br />
A SELTX3 10A B 6 35CHECK(LC)<br />
A SELTX4 10A B 6 46CHECK(LC)<br />
A SELTX5 10A B 6 57CHECK(LC)<br />
A SELTX6 10A B 6 68CHECK(LC)<br />
A 7 2' MESSAGE TEXT -<br />
A -<br />
A '<br />
A DSPATR(UL)<br />
A R WRKMSGS2 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 8 2DSPATR(HI)<br />
A 25N50 DSPATR(PC)<br />
A MESSID 7 + 1<br />
A MESSTX 65 + 1<br />
A MSTEXT 132 H<br />
A MSSECL 800 H<br />
<br />
<br />
A R WRKMSGC2 SFLCTL(WRKMSGS2)<br />
A CA03 CF05 CA12 CF21<br />
A SFLSIZ(50) SFLPAG(14)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO EDIT MESSAGE')<br />
A #DSPC2 4S 0H SFLRCDNBR<br />
A 22 2 ' '<br />
A 24 5'F3=EXIT F5=REFRESH -<br />
A F12=PREVIOUS F21=PRINT'<br />
<br />
<br />
*-------------------------------------------------------------------------<br />
* MISCELLANEOUS PANELS<br />
*-------------------------------------------------------------------------<br />
<br />
A R @CONFIRM OVERLAY CLRL(*NO) CF05 CA12<br />
A 23 7'PRESS F5 TO CONFIRM.'<br />
<br />
A R @BOX OVERLAY PROTECT CLRL(3)<br />
A 22 2' -<br />
A -<br />
A ' DSPATR(RI)<br />
A 23 2' ' DSPATR(RI)<br />
A 23 80' ' DSPATR(RI)<br />
A 24 2' -<br />
A F12=PREVIOUS -<br />
A ' DSPATR(RI)<br />
<br />
A R @CLEAR1 OVERLAY<br />
A 8 1' '<br />
<br />
</pre><br />
<br />
== RPG ==<br />
<pre><br />
/////copy *LIBL/QRPGLESRC,@StdH_H<br />
H Option(*NoShowCpy : *NoDebugIO : *SrcStmt )<br />
H DftActGrp(*no) ActGrp('QILE')<br />
//=========================================================<br />
// Name...: WRKMSGSR<br />
// Version: n/a<br />
// Purpose: Work with message files<br />
// Summary:<br />
// 1) Prompts for message file<br />
// 2) Reads selected message file into SFL<br />
// Params.:<br />
// i_libfil : Library/file<br />
// i_SYSVRr : System Version<br />
// LDA....:<br />
// *None :<br />
// Compile:<br />
// CRTBNDRPG lib/pgm SRCFILE(srclib/srcfile) DBGVIEW(*ALL)<br />
// Notes..:<br />
// 1) This *pgm courtesy of CLOVER<br />
// 2) Converted from RPG3 with CVTRPGPGM<br />
// Log....:<br />
// 2014May19 - Copied from archive<br />
/002 // ???? - Mod to adjust for OS version<br />
/003 // 2014May19 - JEK: Mod for V6 and presumably V7<br />
//=========================================================<br />
FQADSPOBJ IF E DISK INFDS(INFDB1)<br />
FWRKMSGSD CF E WORKSTN<br />
F SFILE(WRKMSGS1:RRN1)<br />
F SFILE(WRKMSGS2:RRN2)<br />
FQSYSPRT O F 132 PRINTER OFLIND(*INOF)<br />
F USROPN<br />
*<br />
D VAL S 1 DIM(4)<br />
*<br />
D INFDB1 DS<br />
D RECDB 397 400B 0<br />
D POS1 DS INZ<br />
D RECDB1 1 7 0<br />
*<br />
* PROGRAM DS<br />
D SDS<br />
D WRKSTN 244 253<br />
D USRPRF 254 263<br />
* TEXT SELECTIONS<br />
D SELTXT DS<br />
D SELT 1 60<br />
D DIM(6)<br />
D SELTX1 1 10<br />
D SELTX2 11 20<br />
D SELTX3 21 30<br />
D SELTX4 31 40<br />
D SELTX5 41 50<br />
D SELTX6 51 60<br />
/002 * THE VERSION OF THE OPERATING SYSTEM<br />
/002 D @SYSVR DS 6<br />
/002 D @VER 1 2<br />
/002 D @RLS 3 4<br />
/002 D @MOD 5 6<br />
* 1ST LEVEL MESSAGE<br />
D MSTEXT DS<br />
D MSTEX1 1 80<br />
/002 D MSTXT4 2 80<br />
D MSTEX2 81 132<br />
* 2ND LEVEL MESSAGE<br />
D MSSECL DS<br />
D MS2 1 800<br />
D DIM(10)<br />
* API DATA STRUCTURES<br />
D FORM DS 2048<br />
D MRET 1 4B 0<br />
D MID 27 33<br />
D MO 65 68B 0<br />
D ML 69 72B 0<br />
D M2 77 80B 0<br />
D M2L 81 84B 0<br />
* API FIELDS<br />
D APIF DS<br />
D FLEN 1 4B 0<br />
D RLEN 5 8B 0<br />
D FCCS 9 12B 0<br />
D TCCS 13 16B 0<br />
* API ERROR<br />
D APIERR DS INZ<br />
D ERRAV 1 4B 0<br />
D ERRPR 5 8B 0 INZ(116)<br />
D ERRMS 9 15<br />
D ERRRS 16 16<br />
D ERRDT 17 116<br />
D DS INZ<br />
D BIN41 1 4B 0<br />
D BIN42 5 8B 0<br />
*<br />
* CONSTANTS<br />
D LODATE C CONST('1960-01-01')<br />
D LO C CONST('ABCDEFGHIJKLMNOPQRST-<br />
D UVWXYZ')<br />
D HI C CONST('ABCDEFGHIJKLMNOPQRST-<br />
D UVWXYZ')<br />
*<br />
*<br />
*****************************************************************<br />
** MAIN PROCESSING *<br />
*****************************************************************<br />
C CTRL DOUEQ 'EXIT'<br />
* 01 - FILE SELECTION<br />
C CTRL CASEQ 'CON1' $ACON1<br />
C CTRL CASEQ 'DSP1' $ADSP1<br />
C CTRL CASEQ 'EDT1' $AEDT1<br />
C CTRL CASEQ 'ACT1' $AACT1<br />
* 02 - MESSAGES<br />
C CTRL CASEQ 'CON2' $ACON2<br />
C CTRL CASEQ 'DSP2' $ADSP2<br />
C CTRL CASEQ 'EDT2' $AEDT2<br />
C CTRL CASEQ 'ACT2' $AACT2<br />
*<br />
C CTRL CASEQ 'FINI' $AFNSH<br />
C CAS XPSSR<br />
C END<br />
C END<br />
* END OF PROGRAM<br />
C SETON LR<br />
C RETURN<br />
*****************************************************************<br />
* CONSTRUCT PANEL 1<br />
*****************************************************************<br />
C $ACON1 BEGSR<br />
*<br />
* CLEAR SUBFILE<br />
C SETON 21<br />
C WRITE WRKMSGC1<br />
C SETOFF 21<br />
C Z-ADD *ZERO RRN1<br />
C Z-ADD *ZERO LSTRR1<br />
C Z-ADD *ZERO #DSPC1<br />
*<br />
* FILL SUBFILE FROM THE BEGINNING POSITION<br />
C RESET POS1<br />
C EXSR $DROL1<br />
* SET CONTROL<br />
C RRN1 IFEQ 1<br />
C MOVEL 'CON2' CTRL<br />
C ELSE<br />
C MOVEL 'DSP1' CTRL<br />
C END<br />
C ENDSR<br />
*****************************************************************<br />
* DISPLAY PANEL 1<br />
*****************************************************************<br />
C $ADSP1 BEGSR<br />
*<br />
C #DSPC1 IFEQ *ZERO<br />
C #DSPC1 ORGT LSTRR1<br />
C Z-ADD LSTRR1 #DSPC1<br />
C END<br />
* DISPLAY SUBFILE<br />
C LSTRR1 COMP *ZERO 22<br />
C N22 WRITE @CLEAR1<br />
C WRITE WRKMSG01<br />
C EXFMT WRKMSGC1<br />
* SET ERROR INDICATORS OFF<br />
C MOVE 'N' @ERR<br />
C Z-ADD *ZERO #DSPC1<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(71)<br />
* F3 - EXIT<br />
* F12 - CANCEL<br />
C SELECT<br />
C *INKC WHENEQ '1'<br />
C *INKL OREQ '1'<br />
C MOVEL 'FINI' CTRL<br />
* ROLL-UP<br />
C *IN19 WHENEQ '1'<br />
C EXSR $DROL1<br />
C MOVEL 'DSP1' CTRL<br />
* NO RECORDS<br />
C LSTRR1 WHENEQ *ZERO<br />
C MOVEL 'DSP1' CTRL<br />
* SET CONTROL<br />
C OTHER<br />
C MOVEL 'EDT1' CTRL<br />
C ENDSL<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT PANEL 1<br />
*****************************************************************<br />
C $AEDT1 BEGSR<br />
C MOVE 'N' @ERR<br />
C MOVEL 'DSP1' CTRL<br />
*<br />
* READ CHANGED RECORDS<br />
C Z-ADD *ZERO RRN1<br />
C Z-ADD *ZERO #DSPC1<br />
C DO *HIVAL<br />
C READC WRKMSGS1 31<br />
C 31 LEAVE<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
*<br />
* BEGIN EDIT<br />
* APPROPRIATE SELECTIONS<br />
C SELECT<br />
* NO SELECTION<br />
C #SEL WHENEQ *BLANKS<br />
*<br />
C ENDSL<br />
* UPDATE THE SFL<br />
C MOVEA *IN(51) @IND<br />
C @IND IFNE *ZERO<br />
C MOVE 'Y' @ERR<br />
C END<br />
C #SEL IFNE *BLANKS<br />
C SETON 25<br />
C END<br />
C UPDATE WRKMSGS1<br />
C SETOFF 25<br />
C #DSPC1 IFEQ *ZERO<br />
C @ERR ANDEQ 'Y'<br />
C Z-ADD RRN1 #DSPC1<br />
C END<br />
C END<br />
*<br />
* ALL SFL ENTRIES EDITED<br />
C #DSPC1 IFEQ *ZERO<br />
C Z-ADD RRN1 #DSPC1<br />
C END<br />
*<br />
C @ERR IFEQ 'N'<br />
C MOVEL 'ACT1' CTRL<br />
C END<br />
*<br />
C EXEDT1 ENDSR<br />
*****************************************************************<br />
* ACTION PANEL 1<br />
*****************************************************************<br />
C $AACT1 BEGSR<br />
C MOVEL 'DSP1' CTRL<br />
*<br />
* READ SELECTED RECORDS FROM SUBFILE<br />
C Z-ADD 1 #DSPC1<br />
C WRITE WRKMSGC1<br />
*<br />
C DO *HIVAL<br />
C READC WRKMSGS1 31<br />
C *IN31 IFEQ '1'<br />
C MOVEL 'DSP2' CTRL<br />
C LEAVE<br />
C END<br />
C #SEL IFEQ *BLANKS<br />
C ITER<br />
C END<br />
C MOVE #SEL SEL<br />
C MOVE *BLANKS #SEL<br />
C UPDATE WRKMSGS1<br />
C Z-ADD RRN1 #DSPC1<br />
* NEXT DISPLAY FOR THE SELECTED RECORD<br />
C SELECT<br />
C SEL WHENEQ '12'<br />
C MOVE *BLANKS MSGID2<br />
C MOVEL 'CON2' CTRL<br />
C LEAVE<br />
C ENDSL<br />
* NEXT SFL RECORD<br />
C END<br />
*<br />
C EXACT1 ENDSR<br />
*****************************************************************<br />
* CONSTRUCT PANEL 2<br />
*****************************************************************<br />
C $ACON2 BEGSR<br />
* CLEAR SUBFILE<br />
C SETON 21<br />
C WRITE WRKMSGC2<br />
C SETOFF 21<br />
C Z-ADD *ZERO RRN2<br />
C Z-ADD *ZERO LSTRR2<br />
C Z-ADD *ZERO #DSPC2<br />
*<br />
* FILL SUBFILE FROM THE BEGINNING POSITION<br />
C ANDOR IFEQ *BLANKS<br />
C MOVE 'A' ANDOR<br />
C END<br />
C EXSR $DROL2<br />
C MOVEL SELMID MIDLST<br />
C MOVEL SELTXT TXTLST<br />
C MOVEL ANDOR ANDLST<br />
* SET CONTROL<br />
C MOVEL 'DSP2' CTRL<br />
C ENDSR<br />
*****************************************************************<br />
* DISPLAY PANEL 2<br />
*****************************************************************<br />
C $ADSP2 BEGSR<br />
*<br />
C #DSPC2 IFEQ *ZERO<br />
C #DSPC2 ORGT LSTRR2<br />
C Z-ADD LSTRR2 #DSPC2<br />
C END<br />
* DISPLAY SUBFILE<br />
C LSTRR2 COMP *ZERO 22<br />
C N22 WRITE @CLEAR1<br />
C WRITE WRKMSG02<br />
C WRITE WRKMSGA1<br />
C EXFMT WRKMSGC2<br />
C READ WRKMSG02 51<br />
* SET ERROR INDICATORS OFF<br />
C MOVE 'N' @ERR<br />
C Z-ADD *ZERO #DSPC2<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(71)<br />
* F3 - EXIT<br />
C SELECT<br />
C *INKC WHENEQ '1'<br />
C MOVEL 'FINI' CTRL<br />
* F12 - RETURN<br />
C *INKL WHENEQ '1'<br />
C MOVEL 'DSP1' CTRL<br />
* F21 - PRINT<br />
C *INKV WHENEQ '1'<br />
C EXSR $PRNT2<br />
C MOVEL 'DSP2' CTRL<br />
* F5 - REFRESH<br />
* OR NEW SELECTIONS<br />
C *INKE WHENEQ '1'<br />
C SELMID ORNE MIDLST<br />
C SELTXT ORNE TXTLST<br />
C ANDOR ORNE ANDLST<br />
C MOVEL SELMID MSGID2<br />
C MSGID2 IFNE *BLANKS<br />
C MOVE MSGID2 TEST4<br />
C MOVEA TEST4 VAL<br />
C DO 4 X<br />
C VAL(X) IFLT 'A'<br />
C VAL(X) ORGT 'F'<br />
C VAL(X) ANDLT '0'<br />
C MOVE '0' VAL(X)<br />
C END<br />
C ENDDO<br />
C END<br />
C MOVEA VAL TEST4<br />
C MOVE TEST4 MSGID2<br />
C MOVE MSGID2 SELMID<br />
C MOVE MSGID2 MIDLST<br />
C MOVE 'CON2' CTRL<br />
* ROLL-UP<br />
C *IN19 WHENEQ '1'<br />
C EXSR $DROL2<br />
C MOVEL 'DSP2' CTRL<br />
* NO RECORDS<br />
C LSTRR2 WHENEQ *ZERO<br />
C MOVEL 'DSP2' CTRL<br />
* SET CONTROL<br />
C OTHER<br />
C MOVEL 'EDT2' CTRL<br />
C ENDSL<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT PANEL 2<br />
*****************************************************************<br />
C $AEDT2 BEGSR<br />
C MOVE 'N' @ERR<br />
C MOVEL 'DSP2' CTRL<br />
*<br />
* READ CHANGED RECORDS<br />
C Z-ADD *ZERO RRN2<br />
C Z-ADD *ZERO #DSPC2<br />
C SETON 25<br />
C DO *HIVAL<br />
C READC WRKMSGS2 31<br />
C 31 LEAVE<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
* EDITING<br />
*<br />
* UPDATE THE SFL<br />
C MOVEA *IN(51) @IND<br />
C @IND IFNE *ZERO<br />
C MOVE 'Y' @ERR<br />
C END<br />
C UPDATE WRKMSGS2<br />
C #DSPC2 IFEQ *ZERO<br />
C @ERR ANDEQ 'Y'<br />
C Z-ADD RRN2 #DSPC2<br />
C END<br />
C END<br />
*<br />
* ALL SFL ENTRIES EDITED<br />
C SETOFF 25<br />
C #DSPC2 IFEQ *ZERO<br />
C Z-ADD RRN2 #DSPC2<br />
C END<br />
* SET CONTROL<br />
C @ERR IFEQ 'N'<br />
C MOVEL 'ACT2' CTRL<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ACTION PANEL 2<br />
*****************************************************************<br />
C $AACT2 BEGSR<br />
C MOVEL 'DSP2' CTRL<br />
*<br />
* READ SELECTED RECORDS FROM SUBFILE<br />
C Z-ADD 1 #DSPC2<br />
C WRITE WRKMSGC2<br />
C DO *HIVAL<br />
C READC WRKMSGS2 31<br />
C 31 LEAVE<br />
C MOVE #SEL SEL<br />
C MOVE *BLANKS #SEL<br />
C UPDATE WRKMSGS2<br />
C Z-ADD RRN2 #DSPC2<br />
*<br />
* EDIT<br />
C SELECT<br />
C SEL WHENEQ '03'<br />
C SEL OREQ '3 '<br />
C '?CPYMSGD' CAT(P) MESSID:1 CMD<br />
C CAT ODLBNM:1 CMD<br />
C CAT '/':0 CMD<br />
C CAT ODOBNM:0 CMD<br />
C CALL 'QCMDEXC' 90<br />
C PARM CMD<br />
C PARM 256 LN<br />
C MOVE SELMID MSGID2<br />
C MOVEL 'CON2' CTRL<br />
*<br />
C SEL WHENEQ '12'<br />
C 'WRKMSGD' CAT(P) MESSID:1 CMD<br />
C CAT ODLBNM:1 CMD<br />
C CAT '/':0 CMD<br />
C CAT ODOBNM:0 CMD<br />
C CALL 'QCMDEXC' 90<br />
C PARM CMD<br />
C PARM 256 LN<br />
C MOVE SELMID MSGID2<br />
C MOVEL 'CON2' CTRL<br />
*<br />
C ENDSL<br />
*<br />
* NEXT SFL RECORD<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ROLL-UP PANEL 1<br />
*****************************************************************<br />
C $DROL1 BEGSR<br />
* REPOSITION THE FILE TO AFTER THE LAST USED RECORD<br />
C RECDB1 SETGT QLIDOBJD<br />
C Z-ADD LSTRR1 RRN1<br />
* FILL 1 PAGE.<br />
C DO PAG1<br />
* NEXT SFL DETAILS<br />
C READ QLIDOBJD 11<br />
C 11 LEAVE<br />
* WRITE THE SFL RECORD<br />
C EXSR $FSFL1<br />
C ADD 1 RRN1<br />
C WRITE WRKMSGS1<br />
C ENDDO<br />
*<br />
C Z-ADD RECDB RECDB1<br />
C Z-ADD RRN1 LSTRR1<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* FILL SFL 1 RECORD<br />
*****************************************************************<br />
C $FSFL1 BEGSR<br />
*<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
C MOVE *BLANKS #SEL<br />
*<br />
* FILL THE SFL RECORD<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* ROLL-UP PANEL 2<br />
*****************************************************************<br />
C $DROL2 BEGSR<br />
*<br />
C Z-ADD LSTRR2 RRN2<br />
C Z-ADD *ZERO LSTRR2<br />
* FILL 1 PAGE.<br />
C DO PAG2 CNT2<br />
* NEXT SFL DETAILS<br />
C EXSR $NXTMS<br />
C 11 LEAVE<br />
C EXSR $INCL2<br />
C 11 LEAVE<br />
C @INCL IFNE 'Y'<br />
C SUB 1 CNT2<br />
C ITER<br />
C END<br />
* WRITE THE SFL RECORD<br />
C EXSR $FSFL2<br />
C ADD 1 RRN2<br />
C EXSR $XEDT2<br />
C MOVEA *IN(51) @IND<br />
C @IND COMP *ZERO 2525<br />
C WRITE WRKMSGS2<br />
C MOVEL MESSID MSGID2<br />
C ENDDO<br />
*<br />
C Z-ADD RRN2 LSTRR2<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* NXTMS - GET THE NEXT MESSAGE<br />
*****************************************************************<br />
C $NXTMS BEGSR<br />
*<br />
C MOVEL ODOBNM MFLLIB<br />
C MOVE ODLBNM MFLLIB<br />
C MOVEL(P) '*NEXT' ROPT<br />
C MSGID2 IFEQ *BLANKS<br />
C MOVEL(P) '*FIRST' ROPT<br />
C END<br />
C MSGID2 IFEQ SELMID<br />
C MSGID2 ANDNE *BLANKS<br />
C RRN2 ANDEQ *ZERO<br />
C MOVEL(P) '*MSGID' ROPT<br />
C END<br />
*<br />
C $RETRY TAG<br />
C CALL 'QMHRTVM' 11<br />
C PARM FORM<br />
C PARM 2048 FLEN<br />
C PARM 'RTVM0300' FMTR 10<br />
C PARM MSGID2<br />
C PARM MFLLIB 20<br />
C PARM *BLANKS RDTA 1<br />
C PARM 1 RLEN<br />
C PARM '*NO' RVAL 10<br />
C PARM '*NO' CVAL 10<br />
C PARM APIERR<br />
C PARM ROPT 10<br />
C PARM 0 FCCS<br />
C PARM 0 TCCS<br />
C N11MRET COMP 84 11<br />
C *IN11 IFEQ '0'<br />
C MOVEL MID MSGID2<br />
C ADD 1 MO<br />
C ML SUBST(P) FORM:MO MSTEXT<br />
C*** EXSR SETTXT<br />
C*** ML SUBSTFORM:XX MSTEXT P<br />
C M2L IFEQ *ZERO<br />
C MOVE *BLANKS MSSECL<br />
C ELSE<br />
C M2L SUBST(P) FORM:M2 MSSECL<br />
C END<br />
C END<br />
C 11ROPT IFEQ '*MSGID'<br />
C MOVEL(P) '*NEXT' ROPT<br />
C GOTO $RETRY<br />
C END<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* TEST SFL 2 RECORD FOR INCLUSION<br />
*****************************************************************<br />
C $INCL2 BEGSR<br />
*<br />
C SELTXT IFEQ *BLANKS<br />
C MOVE 'Y' @INCL<br />
C GOTO XINCL2<br />
C END<br />
*<br />
* AND/OR SELECTIONS<br />
C ANDOR IFEQ 'A'<br />
C MOVE 'N' @INCL<br />
C ELSE<br />
C MOVE 'Y' @INCL<br />
C END<br />
* TEXT SELECTOR<br />
C LO:HI XLATE MSTEXT TSTTXT<br />
*<br />
* FOR EACH TEXT PART<br />
* IF FOUND, USING OR THEN FINISHED<br />
* IF NOT FOUND, USING AND THEN FINISHED<br />
*<br />
C DO 6 Y<br />
C SELT(Y) IFEQ *BLANKS<br />
C ITER<br />
C END<br />
*<br />
C ' ' CHECKR SELT(Y) X<br />
C X IFEQ *ZERO<br />
C Z-ADD 10 X<br />
C END<br />
C SELT(Y):X SCAN TSTTXT 51<br />
C *IN51 IFEQ '1'<br />
C ANDOR ANDEQ 'O'<br />
C *IN51 OREQ '0'<br />
C ANDOR ANDEQ 'A'<br />
C GOTO XINCL2<br />
C END<br />
C ENDDO<br />
*<br />
* TESTED ALL<br />
* USING AND, THEN INCLUDE<br />
* USING OR, THEN EXCLUDE<br />
C ANDOR IFEQ 'A'<br />
C MOVE 'Y' @INCL<br />
C ELSE<br />
C MOVE 'N' @INCL<br />
C END<br />
*<br />
C XINCL2 ENDSR<br />
*****************************************************************<br />
* FILL SFL 2 RECORD<br />
*****************************************************************<br />
C $FSFL2 BEGSR<br />
*<br />
C MOVE *ZERO @IND<br />
C MOVEA @IND *IN(51)<br />
C MOVE *BLANKS #SEL<br />
*<br />
* FILL THE SFL RECORD<br />
C MOVEL MID MESSID<br />
/002 C @VER IFEQ 'V3'<br />
/002 C @VER OREQ 'V4'<br />
/002 C @VER OREQ 'V5'<br />
/003 C @VER OREQ 'V6'<br />
/003 C @VER OREQ 'V7'<br />
C MOVEL MSTEXT MESSTX<br />
/002 C ELSE<br />
/002 C MOVEL MSTXT4 MESSTX<br />
/002 C ENDIF<br />
*<br />
C ENDSR<br />
*****************************************************************<br />
* EDIT SFL 2 RECORD<br />
*****************************************************************<br />
C $XEDT2 BEGSR<br />
*<br />
* FULL EDIT IS DONE HERE<br />
* INCLUDING WARNINGS<br />
C SETOFF 50<br />
*<br />
C XXEDT2 ENDSR<br />
*****************************************************************<br />
* FINISHING SUBROUTINE / CLOSE FILES ETC.<br />
*****************************************************************<br />
C $AFNSH BEGSR<br />
*<br />
C MOVEL 'EXIT' CTRL<br />
C ENDSR<br />
*****************************************************************<br />
* INITIALISATION SUBROUTINE<br />
*****************************************************************<br />
C *INZSR BEGSR<br />
* PARAMETERS AND KEY LISTS<br />
C *ENTRY PLIST<br />
C PARM FILLIB 20<br />
/002 C PARM @SYSVR<br />
*<br />
*<br />
* FIELD DEFINITIONS AND INITIALISATION<br />
C Z-ADD 16 PAG1 5 0<br />
C Z-ADD 14 PAG2 5 0<br />
C Z-ADD *ZERO RRN1 4 0<br />
C Z-ADD *ZERO RRN2 4 0<br />
*<br />
C MOVE *BLANKS MSGID2 7<br />
C MOVE *BLANKS @ERR 1<br />
C MOVE *BLANKS @IND 20<br />
C MOVE *BLANKS CMD 256<br />
C Z-ADD *ZERO LN 15 5<br />
C Z-ADD *ZERO X 5 0<br />
C Z-ADD *ZERO Y 5 0<br />
C MOVE *BLANKS @INCL 1<br />
C MOVE *BLANKS TEST4 4<br />
*<br />
C *LIKE DEFINE RRN1 LSTRR1<br />
C *LIKE DEFINE RRN2 LSTRR2<br />
C *LIKE DEFINE PAG1 CNT1<br />
C *LIKE DEFINE PAG2 CNT2<br />
C *LIKE DEFINE #SEL SEL<br />
C *LIKE DEFINE SELMID MIDLST<br />
C *LIKE DEFINE SELTXT TXTLST<br />
C *LIKE DEFINE ANDOR ANDLST<br />
C *LIKE DEFINE MSTEXT TSTTXT<br />
*<br />
* SET CONTROL FOR INITIAL DISPLAY<br />
C MOVEL 'CON1' CTRL 4<br />
C ENDSR<br />
*****************************************************************<br />
** ERROR SUBROUTINE *<br />
*****************************************************************<br />
C XPSSR BEGSR<br />
** CHECK ERROR ONCE ONLY<br />
C* @PSSR IFEQ *BLANK<br />
C* MOVEL'Y' @PSSR 1<br />
** DUMP PROGRAM TO TRACE FAULT<br />
C* DUMP<br />
C* END<br />
* EXIT THE PROGRAM<br />
C SETON LR<br />
C RETURN<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
* $PRNT2 - PRINT PANEL 2<br />
*----------------------------------------------------------------<br />
C $PRNT2 BEGSR<br />
C *IN11 DOWNE '1'<br />
C EXSR $DROL2<br />
C END<br />
C Z-ADD *ZERO PAGE<br />
C TIME RTIME 12 0<br />
* SYSTEM NAME<br />
C CALL 'QWCRNETA' 51<br />
C PARM NETDET 32<br />
C PARM 32 BIN41<br />
C PARM 1 BIN42<br />
C PARM 'SYSNAME' NETATR 10<br />
C PARM APIERR<br />
C MOVE NETDET SYSNAM 8<br />
* OPEN THE PRINTER<br />
C OPEN QSYSPRT<br />
C SETON OF<br />
C DO *HIVAL RRN2<br />
C RRN2 CHAIN WRKMSGS2 5151<br />
C 51 LEAVE<br />
C EXCEPT #DETL1<br />
C MSTEX2 IFNE *BLANKS<br />
C EXCEPT #DETL2<br />
C END<br />
C DO 10 Y<br />
C MS2(Y) IFNE *BLANKS<br />
C EXCEPT #DETL3<br />
C END<br />
C ENDDO<br />
C ENDDO<br />
*<br />
C CLOSE QSYSPRT<br />
*<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
* SETTXT - CHECK TO MAKE SURE STARTING POSITION IS VALID<br />
*----------------------------------------------------------------<br />
C SETTXT BEGSR<br />
*<br />
* THIS SUBROUTINE IS DESIGNED TO FIND THE POSITION OF THE 1ST<br />
* CHARACTER OF THE MESSAGE TEXT<br />
*<br />
C Z-ADD 100 XX 4 0<br />
C MOVE 'N' OK 1<br />
C OK DOWEQ 'N'<br />
C 6 SUBST FORM:XX TSTFLD 6<br />
C TSTFLD IFGE ' '<br />
C MOVE 'Y' OK<br />
C ELSE<br />
C ADD 1 XX<br />
C ENDIF<br />
C ENDDO<br />
*<br />
C ENDSR<br />
*----------------------------------------------------------------<br />
C* *PSSR BEGSR<br />
** CHECK ERROR ONCE ONLY<br />
C* @PSSR IFEQ *BLANK<br />
C* MOVEL'Y' @PSSR 1<br />
** DUMP PROGRAM TO TRACE FAULT<br />
C* DUMP<br />
C* END<br />
* EXIT THE PROGRAM<br />
C* SETON LR<br />
C* RETRN<br />
C* ENDSR<br />
*<br />
*****************************************************************<br />
OQSYSPRT H OF 2 03<br />
O SYSNAM 10<br />
O + 3 'MESSAGE DESCRIPTIONS:'<br />
O RTIME + 5 ' 0: : && / / '<br />
O PAGE Z + 12<br />
O - 8 'PAGE:'<br />
O H OF 1<br />
O ODOBNM + 1<br />
O ODLBNM + 1<br />
O ODOBTX + 1<br />
O H OF 1<br />
O 'SELECT:'<br />
O + 1 'MESSAGEID'<br />
O SELMID + 1<br />
O H OF 1<br />
O + 8 'MESSAGE TEXT'<br />
O + 1 '(AND/OR)'<br />
O ANDOR + 1<br />
O SELTX1 + 1<br />
O SELTX2 + 1<br />
O SELTX3 + 1<br />
O SELTX4 + 1<br />
O SELTX5 + 1<br />
O SELTX6 + 1<br />
O EF #DETL1 1 1<br />
O MESSID 7<br />
O MSTEX1 + 1<br />
O E #DETL2 1<br />
O MSTEX2 + 8<br />
O E #DETL3 1<br />
O MS2(Y) 100<br />
<br />
</pre></div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11739
WrkMsgs
2014-06-04T05:31:37Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<br />
== CMD ==<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre><br />
<br />
== CL ==<br />
<pre><br />
/*=========================================================================== */<br />
/* Name...: WRKMSGSC */<br />
/* Version: n/a */<br />
/* Purpose: Run test cases for EDP824D */<br />
/* Summary: */<br />
/* 1) Dump *MSGF to temp file */<br />
/* 2) Run pgm */<br />
/* Params.: */<br />
/* : i_FILELIB : Message File */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCLPGM ??PGM(R50MODS/*PGM) */<br />
/* ?*SRCFILE(*LIBL/QCLSRC) */<br />
/* ?*SRCMBR(WRKMSGSC) */<br />
/* ??REPLACE(*YES) */<br />
/* Log....: */<br />
/* 2014May19 JK- Updated */<br />
/* */<br />
/*----------------------------------------------------------------------------*/<br />
PGM (&FL)<br />
DCL &FL *CHAR 20<br />
<br />
DCL &MSG *CHAR 80<br />
DCL &MS *CHAR 7<br />
DCL &SYSDTA *CHAR 750 /* /002 */<br />
DCL &SYSVR *CHAR 6 /* /002 */<br />
<br />
MONMSG CPF0000 EXEC(GOTO ERROR)<br />
<br />
/* Dump *MSGF to temp file */<br />
DSPOBJD OBJ(%SST(&FL 11 10)/%SST(&FL 1 10)) +<br />
OBJTYPE(*MSGF) OUTPUT(*OUTFILE) +<br />
OUTFILE(QTEMP/QADSPOBJ)<br />
<br />
OVRDBF QADSPOBJ QTEMP/QADSPOBJ SECURE(*YES) SHARE(*NO)<br />
<br />
RTVDTAARA DTAARA(QSS1MRI) RTNVAR(&SYSDTA) /* /002 */<br />
CHGVAR VAR(&SYSVR) VALUE(&SYSDTA) /* /002 */<br />
<br />
/* Run pgm */<br />
CALL WRKMSGSR (&FL &SYSVR) /* /002 */<br />
RETURN<br />
<br />
ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSG) MSGID(&MS)<br />
SNDPGMMSG MSGID(&MS) MSGF(QCPFMSG) MSGDTA(&MSG) +<br />
MSGTYPE(*ESCAPE)<br />
EOJ:<br />
ENDPGM<br />
<br />
</pre><br />
<br />
== DDS ==<br />
<pre><br />
A*========================================================= <br />
A*/ Name...: WRKMSGSD <br />
A*/ Version: n/a <br />
A*/ Purpose: Work with message files <br />
A*/ Summary: <br />
A*/ N/A : <br />
A*/ Params.: <br />
A*/ N/A : <br />
A*/ LDA....: <br />
A*/ N/A : <br />
A*/ Compile: <br />
A*/ CRTDSPF FILE(WRKMSGSD) <br />
A*/ SRCFILE(QDDSSRC) <br />
A*/ SRCMBR(WRKMSGSD) <br />
A*/ REPLACE(*YES) <br />
A*/ Notes..: <br />
A*/ 1) This *pgm courtesy of CLOVER <br />
A*/ Log....: <br />
A*/ 2014May19 - Copied from archive <br />
A*/=========================================================<br />
A* INDARA IS REQUIRED FOR RETKEY/RETCMDKEY<br />
A*%%EC<br />
A DSPSIZ(24 80 *DS3)<br />
A REF(*LIBL/QADSPOBJ)<br />
A MSGLOC(23)<br />
A INDARA<br />
A PRINT(*LIBL/QSYSPRT)<br />
A OPENPRT<br />
A ERRSFL<br />
*-------------------------------------------------------------------------<br />
* PANEL 1 - LIST OF MESSAGE FILES<br />
*-------------------------------------------------------------------------<br />
A R WRKMSG01 PUTOVR<br />
A 1 3'WRKMSGS.01'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72DATE OVRATR EDTCDE(Y)<br />
A 2 72TIME OVRATR<br />
A 2 26' MESSAGE FILES '<br />
A DSPATR(HI)<br />
A 2 2'12-WORK WITH'<br />
A 4 2' FILE LIBRARY TEXT -<br />
A '<br />
A DSPATR(UL)<br />
<br />
A R WRKMSGS1 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 5 2CHECK(AB)<br />
A VALUES(' ' '12')<br />
A 51 DSPATR(RI PC)<br />
A ODOBNM R + 1<br />
A ODLBNM R + 1<br />
A ODOBTX R + 1<br />
<br />
A R WRKMSGC1 SFLCTL(WRKMSGS1) CA03<br />
A CA12<br />
A SFLSIZ(50) SFLPAG(16)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO WORK WITH FILE')<br />
<br />
A #DSPC1 4S 0H SFLRCDNBR<br />
A 21 2 ' '<br />
A 24 5'F3=EXIT'<br />
A 24 17'F12 CANCEL'<br />
<br />
*-------------------------------------------------------------------------<br />
* INSERT PANEL - DETAILS OF THE SELECTION<br />
*-------------------------------------------------------------------------<br />
A R WRKMSGA1 CLRL(*NO) RETKEY RETCMDKEY<br />
A 3 2'FILE'<br />
A ODOBNM R + 1DSPATR(HI)<br />
A ODLBNM R + 1DSPATR(HI)<br />
A ODOBTX R + 1DSPATR(HI)<br />
<br />
<br />
A*-------------------------------------------------------------------------<br />
A* PANEL 2 - LIST OF MESSAGES<br />
A*-------------------------------------------------------------------------<br />
A R WRKMSG02<br />
A*%%TS SD 20140529 201332 JKING REL-V6R1M0 5761-WDS<br />
A PUTOVR<br />
A 1 3'WRKMSGS.02'<br />
A 1 20' WORK WITH MESSAGE DESCRIPTIONS '<br />
A DSPATR(RI)<br />
A 1 60SYSNAME<br />
A 1 72OVRATR<br />
A DATE<br />
A EDTCDE(Y)<br />
A 2 72TIME<br />
A OVRATR<br />
A 2 26'MESSAGE DESCRIPTIONS'<br />
A DSPATR(HI)<br />
A 4 2'3-COPY, 12-WORK WITH'<br />
A 5 13'AND/OR'<br />
A ANDOR 1A B 5 20VALUES('A' 'O')<br />
A SELMID 7A B 6 5OVRDTA<br />
A SELTX1 10A B 6 13DSPATR(PC)<br />
A OVRATR<br />
A CHECK(LC)<br />
A SELTX2 10A B 6 24CHECK(LC)<br />
A SELTX3 10A B 6 35CHECK(LC)<br />
A SELTX4 10A B 6 46CHECK(LC)<br />
A SELTX5 10A B 6 57CHECK(LC)<br />
A SELTX6 10A B 6 68CHECK(LC)<br />
A 7 2' MESSAGE TEXT -<br />
A -<br />
A '<br />
A DSPATR(UL)<br />
A R WRKMSGS2 SFL<br />
A 25 SFLNXTCHG<br />
A #SEL 2 B 8 2DSPATR(HI)<br />
A 25N50 DSPATR(PC)<br />
A MESSID 7 + 1<br />
A MESSTX 65 + 1<br />
A MSTEXT 132 H<br />
A MSSECL 800 H<br />
<br />
<br />
A R WRKMSGC2 SFLCTL(WRKMSGS2)<br />
A CA03 CF05 CA12 CF21<br />
A SFLSIZ(50) SFLPAG(14)<br />
A OVERLAY PUTOVR<br />
A N21 22 SFLDSP<br />
A N21 SFLDSPCTL<br />
A 21 SFLCLR<br />
A N11 ROLLUP(19)<br />
A 11 SFLEND<br />
A 71 SFLMSG('UNABLE TO EDIT MESSAGE')<br />
A #DSPC2 4S 0H SFLRCDNBR<br />
A 22 2 ' '<br />
A 24 5'F3=EXIT F5=REFRESH -<br />
A F12=PREVIOUS F21=PRINT'<br />
<br />
<br />
*-------------------------------------------------------------------------<br />
* MISCELLANEOUS PANELS<br />
*-------------------------------------------------------------------------<br />
<br />
A R @CONFIRM OVERLAY CLRL(*NO) CF05 CA12<br />
A 23 7'PRESS F5 TO CONFIRM.'<br />
<br />
A R @BOX OVERLAY PROTECT CLRL(3)<br />
A 22 2' -<br />
A -<br />
A ' DSPATR(RI)<br />
A 23 2' ' DSPATR(RI)<br />
A 23 80' ' DSPATR(RI)<br />
A 24 2' -<br />
A F12=PREVIOUS -<br />
A ' DSPATR(RI)<br />
<br />
A R @CLEAR1 OVERLAY<br />
A 8 1' '<br />
<br />
</pre><br />
<br />
== RPG ==</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11738
WrkMsgs
2014-06-04T05:20:22Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<br />
== CMD ==<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre><br />
<br />
== CL ==<br />
<pre><br />
/*=========================================================================== */<br />
/* Name...: WRKMSGSC */<br />
/* Version: n/a */<br />
/* Purpose: Run test cases for EDP824D */<br />
/* Summary: */<br />
/* 1) Dump *MSGF to temp file */<br />
/* 2) Run pgm */<br />
/* Params.: */<br />
/* : i_FILELIB : Message File */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCLPGM ??PGM(R50MODS/*PGM) */<br />
/* ?*SRCFILE(*LIBL/QCLSRC) */<br />
/* ?*SRCMBR(WRKMSGSC) */<br />
/* ??REPLACE(*YES) */<br />
/* Log....: */<br />
/* 2014May19 JK- Updated */<br />
/* */<br />
/*----------------------------------------------------------------------------*/<br />
PGM (&FL)<br />
DCL &FL *CHAR 20<br />
<br />
DCL &MSG *CHAR 80<br />
DCL &MS *CHAR 7<br />
DCL &SYSDTA *CHAR 750 /* /002 */<br />
DCL &SYSVR *CHAR 6 /* /002 */<br />
<br />
MONMSG CPF0000 EXEC(GOTO ERROR)<br />
<br />
/* Dump *MSGF to temp file */<br />
DSPOBJD OBJ(%SST(&FL 11 10)/%SST(&FL 1 10)) +<br />
OBJTYPE(*MSGF) OUTPUT(*OUTFILE) +<br />
OUTFILE(QTEMP/QADSPOBJ)<br />
<br />
OVRDBF QADSPOBJ QTEMP/QADSPOBJ SECURE(*YES) SHARE(*NO)<br />
<br />
RTVDTAARA DTAARA(QSS1MRI) RTNVAR(&SYSDTA) /* /002 */<br />
CHGVAR VAR(&SYSVR) VALUE(&SYSDTA) /* /002 */<br />
<br />
/* Run pgm */<br />
CALL WRKMSGSR (&FL &SYSVR) /* /002 */<br />
RETURN<br />
<br />
ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSG) MSGID(&MS)<br />
SNDPGMMSG MSGID(&MS) MSGF(QCPFMSG) MSGDTA(&MSG) +<br />
MSGTYPE(*ESCAPE)<br />
EOJ:<br />
ENDPGM<br />
<br />
</pre><br />
<br />
== DDS ==<br />
<br />
<br />
<br />
== RPG ==</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11737
WrkMsgs
2014-06-04T03:14:32Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<br />
== CMD ==<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre><br />
<br />
<br />
<br />
== CL ==<br />
<br />
<br />
<br />
== DDS ==<br />
<br />
<br />
<br />
== RPG ==</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11736
WrkMsgs
2014-06-04T03:12:57Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<pre><br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')<br />
</pre></div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11735
WrkMsgs
2014-06-04T03:09:48Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JEK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*============================================================================*/<br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11734
WrkMsgs
2014-06-04T03:07:38Z
<p>Houstonking: </p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.<br />
<br />
<nowiki>/*============================================================================*/<br />
/* Name...: WRKMSGS */<br />
/* Version: n/a */<br />
/* Purpose: Work with Message Descriuptions */<br />
/* Summary: */<br />
/* : 1) Call CL */<br />
/* Params : */<br />
/* : i_FILE : Message File name */<br />
/* : i_LIB : Message File lib */<br />
/* Useage : */<br />
/* Compile: */<br />
/* CRTCMD ??CMD(*LIBL/WRKMSGS) */<br />
/* ??PGM(*LIBL/WRKMSGSC) */<br />
/* ?*SRCFILE(*LIBL/QCMDSRC) */<br />
/* ?*SRCMBR(WRKMSGS) */<br />
/* ??REPLACE(*NO) */<br />
/* Log....: */<br />
/* 06AUG11 JEK- Updated */<br />
/* Notes..: */<br />
/* COURTESY OF CLOVER BUSINESS ASSOCIATES LTD 1997 */<br />
/*===============================================================*/</nowiki><br />
CMD PROMPT('Work with message descriptions')<br />
PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('MESSAGE +<br />
FILE NAME (GEN*,*ALL)')<br />
<br />
FILE: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1)<br />
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +<br />
(*USRLIBL) (*ALLUSR) (*ALL)) +<br />
PROMPT('LIBRARY')</div>
Houstonking
https://wiki.midrange.com/index.php?title=WrkMsgs&diff=11733
WrkMsgs
2014-06-04T02:43:38Z
<p>Houstonking: Created page with "The following utility can be used to browse and edit iSeries message files."</p>
<hr />
<div>The following utility can be used to browse and edit iSeries message files.</div>
Houstonking