|
Hi Arco,
HOPTION(*NODEBUGIO:*SRCSTMT:*SHOWCPY)
**********************************************************************
* What's happening here..?
*
* 1) There's a compile-time array at the foot of the program.
* 2) There's a DS containing a number of 132a fields - these
* will contain the message text of each Message description
* listed in the compile-time array.
* 3) Overlaying each field in the DS is a screen/print field.
* These fields are denoted FLDxxx. They have no definition
* in the program because it is retrieved from the external
* description in the disply/print file.
* 4) Overlaying the whole of the DS is an array. This array is
* populated in a loop - processing each message description
* at a time.
*
* The net result is the screen/print fields are populated
* with the text from each message description.
********************************************************************** * Report Text...
Dmsg s 7 Dim(12) CTDATA
D msgElem s 3s 0 inz(%elem(msg)) Dds_SFLDSO ds
D SFLFLD1 132
D SFLFLD2 132
D SFLFLD3 132
D SFLFLD4 132
D SFLFLD5 132
D SFLFLD6 132
D SFLFLD7 132
D SFLFLD8 132
D SFLFLD9 132
D SFLFLD10 132
D SFLFLD11 132
D SFLFLD12 132
D FLD001 100 OVERLAY(SFLFLD1:1)
D FLD002 100 OVERLAY(SFLFLD2:1)
D FLD003 100 OVERLAY(SFLFLD3:1)
D FLD004 100 OVERLAY(SFLFLD4:1)
D FLD005 100 OVERLAY(SFLFLD5:1)
D FLD006 100 OVERLAY(SFLFLD6:1)
D FLD007 100 OVERLAY(SFLFLD7:1)
D FLD008 100 OVERLAY(SFLFLD8:1)
D FLD009 100 OVERLAY(SFLFLD1:1)
D FLD010 100 OVERLAY(SFLFLD9:1)
D FLD011 100 OVERLAY(SFLFLD10:1)
D FLD012 100 OVERLAY(SFLFLD11:1) * Array overlaying the DS containing the soft-coded fields...
DSFLDSO_P s * inz(%addr(ds_SFLDSO))
DSFLDSO s 132 Based(SFLDSO_P) dim(%elem(msg))
DIdx s 3s 0
DdisplayField s 50a
********************************************************************** * ...Retrieve override language details (if required) here...
C***** eval RM_LANG = overrideLang C call 'RTVMSG'
C parm RM_MSGID 7
C parm RM_RPLDTA 40
C parm RM_MSGTXT 132
C parm RM_HLPTXT 512
C parm RM_LANG 2
C parm RM_RTCD 2C eval SFLDSO(idx) = %trim(RM_MSGTXT)
C eval displayField = SFLDSO(idx)
C displayField dsply ' '
C endforH OPTION(*NODEBUGIO) ??**********************************************************************
??* Define Variables for QMHRTVM API call...
D a_MsgInf DS 4000
D a_Data 1 4000
D a_RtvMsgID 7 OVERLAY(a_Data:27)
D a_MsgSev 9B 0 OVERLAY(a_Data:9)
D a_NbrSbsFmt 9B 0 OVERLAY(a_Data:37)
D a_MsgCCSID 9B 0 OVERLAY(a_Data:49)
D a_MsgOffSet 9B 0 OVERLAY(a_Data:65)
D a_MsgLen 9B 0 OVERLAY(a_Data:69)
D a_HlpOffSet 9B 0 OVERLAY(a_Data:77)
D a_HlpLen 9B 0 OVERLAY(a_Data:81)
D a_SbsOffSet 9B 0 OVERLAY(a_Data:89)
D a_SbsOffLen 9B 0 OVERLAY(a_Data:93) D a_MsgInfLen S 9B 0
D a_Format S 8
D a_MsgId S 7
D a_FullMsgf S 20
D a_RplDta S 40
D a_RplDtaLen S 9B 0
D a_SubValues S 10
D a_CtlChar S 10
D a_ErrCde S 9B 0
D a_RtvOpt S 10
D a_CCSID S 9B 0
D a_RplCCSID S 9B 0 D a_MsgTxt S 132
D a_HlpTxt S 512
D a_FmtStr S 250
D a_MsgFound S N D SDS
Dw_Parms *PARMS * Retrieve Message Description API Prototype...
DQMHRTVM PR EXTPGM('QMHRTVM')
D a_MsgInf 4000
D a_MsgInfLen 9B 0
D a_Format 8
D a_MsgId 7
D a_FullMsgf 20
D a_RplDta 40
D a_RplDtaLen 9B 0
D a_SubValues 10
D a_CtlChar 10
D a_ErrCde 9B 0
D a_RtvOpt 10
D a_CCSID 9B 0
D a_RplCCSID 9B 0
**********************************************************************
C *ENTRY PLIST
C parm RM_MSGID 7
C parm RM_RPLDTA 40
C parm RM_MSGTXT 132
C parm RM_HLPTXT 512
C parm RM_LANG 2
C parm RM_RTCD 2
********************************************************************** * No call parameters, then shut down program...
C if w_Parms = 0
C eval *inLR = *on
C return
C endif * Retrieve message text...
C exsr Rtv_MsgTxt C return
*******************************************************************
* Retreive Message Text visa API
*******************************************************************C Rtv_MsgTxt begsr
* Load API parameter fields...
C eval a_MsgInf = *BLANKS
C eval a_MsgInfLen = 4000
C eval a_MsgId = rm_MsgId
C eval a_Format = 'RTVM0300'
C eval a_RplDta = rm_RplDta
C eval a_RplDtaLen = 0040
C eval a_SubValues = '*YES'
C eval a_CtlChar = '*YES'
C eval a_ErrCde = 0
C eval a_RtvOpt = '*MSGID'
C eval a_CCSID = 0
C eval a_RplCCSID = 0 * Retreive message text...
C callp(e) QMHRTVM(a_MsgInf:
C a_MsgInfLen:
C a_Format:
C a_MsgId:
C a_FullMsgf:
C a_RplDta:
C a_RplDtaLen:
C a_SubValues:
C a_CtlChar:
C a_ErrCde:
C a_RtvOpt:
C a_CCSID:
C a_RplCCSID) * No error, then load return variables...
C if not %error
C eval a_MsgTxt =
C %SUBST(a_Data:a_MsgOffSet+1:a_MsgLen)
C eval rm_MsgTxt = a_MsgTxt
C eval a_HlpTxt =
C %SUBST(a_Data:a_HlpOffSet+1:a_HlpLen)
C eval rm_HlpTxt = a_HlpTxt
C eval rm_Rtcd = *blanksC endsr
??*******************************************************************
Simply compile both programs and call program 1 - name it what you wish.
Good luck!
Larry Ducie
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.