midrange.com code scratchpad |
Name:
Carsten Flensburg
|
Scriptlanguage:
Plain Text
|
Tabwidth:
4
|
Date:
01/18/2014 10:04:29 am
|
IP:
Logged
|
|
Description:
QMHRTVM API wrapped in subprocedure RtvMsgTxt()
|
Code:
- **-- API error data structure:
- D ERRC0100 Ds Qualified
- D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
- D BytAvl 10i 0
- D MsgId 7a
- D 1a
- D MsgDta 128a
- **-- Retrieve message:
- D RtvMsg Pr ExtPgm( 'QMHRTVM' )
- D RcvVar 32767a Options( *VarSize )
- D RcvVarLen 10i 0 Const
- D FmtNam 10a Const
- D MsgId 7a Const
- D MsgFq 20a Const
- D MsgDta 512a Const Options( *VarSize )
- D MsgDtaLen 10i 0 Const
- D RplSubVal 10a Const
- D RtnFmtChr 10a Const
- D Error 32767a Options( *VarSize )
- D RtvOpt 10a Const Options( *NoPass )
- D CvtCcsId 10i 0 Const Options( *NoPass )
- D RplCcsId 10i 0 Const Options( *NoPass )
- **-- Retrieve message text:
- D RtvMsgTxt Pr 1024a Varying
- D PxMsgId 7a Value
- D PxMsgFil 10a Value
- D PxMsgFilLib 10a Value
- D PxMsgDta 1024a Const Varying
- D Options( *NoPass: *Trim )
- **-- Retrieve message text:
- P RtvMsgTxt B Export
- D Pi 1024a Varying
- D PxMsgId 7a Value
- D PxMsgFil 10a Value
- D PxMsgFilLib 10a Value
- D PxMsgDta 1024a Const Varying
- D Options( *NoPass: *Trim )
-
- **-- Local variables:
- D MsgDta s 1024a Varying
- **-- Local constants:
- D NULL c ''
- D RPL_SUB_VAL c '*YES'
- D IGN_FMT_CTL c '*NO'
- D JOB_CCSID c 0
- **-- Return structure:
- D RTVM0100 Ds Qualified
- D BytRtn 10i 0
- D BytAvl 10i 0
- D RtnMsgLen 10i 0
- D RtnMsgAvl 10i 0
- D RtnHlpLen 10i 0
- D RtnHlpAvl 10i 0
- D Msg 1024a
-
- /Free
-
- If %Parms >= 4;
- MsgDta = PxMsgDta;
- EndIf;
-
- RtvMsg( RTVM0100
- : %Size( RTVM0100 )
- :'RTVM0100'
- : PxMsgId
- : PxMsgFil + PxMsgFilLib
- : MsgDta
- : %Len( MsgDta )
- : RPL_SUB_VAL
- : IGN_FMT_CTL
- : ERRC0100
- );
-
- If ERRC0100.BytAvl = *Zero;
- Return %SubSt( RTVM0100.Msg: 1: RTVM0100.RtnMsgLen );
-
- Else;
- Return NULL;
- EndIf;
-
- /End-Free
-
- P RtvMsgTxt E
-
- Example:
-
- To retrieve message ID UTL1204 from message file FILENAME in library *LIBL, you then simply code:
-
- MsgTxt = RtvMsgTxt( 'UTL2004': 'FILENAME': '*LIBL' );
-
-
-
|
|
|