midrange.com code scratchpad
Name:
EDTMSGD - Edit Message Detail
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
06/07/2013 07:27:54 pm
IP:
Logged
Description:
Published by Craig Pelkie at MCPressOnline (http://www.mcpressonline.com/tips-techniques/cl/techtalk-expanding-addmsgd.html). Problem was the code at that site was unreadable/unusable. I reworked the code, did a little renaming and modified the code to run on a 27 x 132 display so that it could handle longer second level text. The original code was limited to a text length of 1,200 characters - it can now handle up to 2,376 characters which is close enough to the maximum (3,000) to cover most situations. Nothing fancy just a CMD, DSPF and CLP to display the current message content and update it.
Code:
  1. EDTMSGD - Command Definition
  2.  
  3.      CMD        PROMPT('Edit Message Description')
  4.      PARM       KWD(MSGID) TYPE(*NAME) LEN(7) MIN(1) PROMPT('Message ID')
  5.  
  6.      PARM       KWD(MSGF) TYPE(QUAL1) MIN(1) PROMPT('Message + file name')
  7.  QUAL1:
  8.      QUAL       TYPE(*NAME) LEN(10) EXPR(*YES)
  9.      QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL)) EXPR(*YES) +
  10.            PROMPT('Library name') 
  11.  
  12.  
  13. EDTMSGDCLP: CPP for EDTMSGD command
  14.  
  15.      PGM        PARM(&MSGID &MSGFLIB)
  16.      DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
  17.      DCL        VAR(&MSGDATA1) TYPE(*CHAR) LEN(80)
  18.      DCL        VAR(&MSGDATA2) TYPE(*CHAR) LEN(2376)
  19.      DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)
  20.      DCL        VAR(&LIB) TYPE(*CHAR) LEN(10)
  21.      DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(20)
  22.      DCL        VAR(&NOTFOUND) TYPE(*LGL) LEN(1) VALUE('0')
  23.      DCLF       FILE(EDTMSGDDSP)
  24.      CHGVAR     VAR(&MSGF) VALUE(%SST(&MSGFLIB 1 10))
  25.      CHGVAR     VAR(&LIB) VALUE(%SST(&MSGFLIB 11 10))
  26.      RTVMSG     MSGID(&MSGID) MSGF(&LIB/&MSGF) MSG(&MSGDATA1) +
  27.            SECLVL(&MSGDATA2)
  28.      MONMSG     MSGID(CPF0000) EXEC(CHGVAR VAR(&NOTFOUND) VALUE('1'))
  29.      CHGVAR     VAR(&XMIC) VALUE(&MSGID)
  30.      CHGVAR     VAR(&XFIRST) VALUE(&MSGDATA1)
  31.      CHGVAR     VAR(&XSEC) VALUE(&MSGDATA2)
  32.      SNDRCVF    RCDFMT(EDTMSGDR)
  33.      IF         COND(&IN03 *OR &IN12) THEN(RETURN)
  34.      IF         COND(&NOTFOUND) THEN(DO)
  35.         ADDMSGD    MSGID(&MSGID) MSGF(&LIB/&MSGF) MSG(&XFIRST) +
  36.               SECLVL(&XSEC)
  37.         MONMSG     MSGID(CPF0000)
  38.         RETURN
  39.      ENDDO
  40.      CHGMSGD    MSGID(&MSGID) MSGF(&LIB/&MSGF) MSG(&XFIRST) SECLVL(&XSEC)
  41.      MONMSG     MSGID(CPF0000)
  42.      ENDPGM 
  43.  
  44.  
  45. EDTMSGDDSP: Display file used by EDTMSGDCLP
  46.  
  47.      A* 91/04/30 13:40:42 MALERN REL-R03M00 5728-PW1
  48.      A                                      DSPSIZ(27 132 *DS4)
  49.      A                                      PRINT
  50.      A          R EDTMSGDR
  51.      A* 91/04/30 13:40:42 MALERN REL-R03M00 5728-PW1
  52.      A                                      TEXT('DISPLAY FORMAT FOR EDTMSGD')
  53.      A                                      CF03(03 'EXIT')
  54.      A                                      CF12(12 'CANCEL')
  55.      A                                      BLINK
  56.      A                                  1 24'EDIT MESSAGE DESCRIPTION (EDTMSGD)'
  57.      A                                      DSPATR(HI)
  58.      A                                  2  1'MESSAGE IDENTIFIER:'
  59.      A            XMIC           7A  O  2 22TEXT('MIC NUMBER')
  60.      A                                      DSPATR(HI)
  61.      A                                      COLOR(WHT)
  62.      A                                  4  1'FIRST LEVEL TEXT:'
  63.      A            XFIRST        80A  B  5  1TEXT('FIRST LEVEL TEXT')
  64.      A                                      CHECK(LC)
  65.      A                                  7  1'SECOND LEVEL TEXT:'
  66.      A            XSEC        2376A  B  8  1TEXT('SECOND LEVEL TEXT')
  67.      A                                      CHECK(LC)
  68.      A                                 27  2'F3=EXIT F12=CANCEL'
  69.      A                                      COLOR(BLU) 
© 2004-2019 by midrange.com generated in 0.011s valid xhtml & css