**
** Program . . : CBX131
** Description : Retrieve system information using APIs
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : February 24, 2005
**
**
** Program summary
** ---------------
**
** Work management APIs:
** QWCRSVAL Retrieve system Retrieves one or more system
** value values into the data structure
** supplied as the receiver variable
** parameter.
**
** QWCRNETA Retrieve net Retrieves the specified net
** attribute attribute(s) into the data
** structure supplied as the
** receiver variable parameter.
**
** QWCRSSTS Retrieve system Retrieves a group of statistics
** status that represents the current
** current status of the system.
**
** Different groups of statistics
** are available, including system,
** subsystem and pool information.
**
** QUSRJOBI Retrieve job Retrieves specific information
** information about a specific job, covering
** all attributes and other state
** and runtime related information.
**
** Software product APIs:
** QSZRTVPR Retrieve product Retrieves information about a
** information specific product load for a
** software product.
**
** The Display Software Resources
** (DSPSFWRSC) command and the
** Select Product (QSZSLTPR) API
** will obtain a list of installed
** products about which you can
** retrieve information.
**
** QpzListPTF List program Returns a list of PTFs for the
** temporary fixes specified product, option, load,
** and release. The product must be
** supported or installed before the
** list of PTFs is returned.
**
** Miscellaneous APIs:
** QWCCVTDT Convert date and Converts date and time values
** time format from one format to another,
** including a system timestamp of
** type *DTS to character format.
**
** Object - User space APIs:
** QUSCRTUS Create user space Creates a user space in either
** user domain or system domain.
** Only user domain user spaces are
** accessible by the user space APIs.
**
** QUSDLTUS Delete user space Deletes the user space specified.
**
** QUSPTRUS Retrieve pointer to The address of the first byte
** user space of the storage allocated by the
** user space requested is returned.
**
** Edit function API:
** QECCVTEC Convert edit code Converts an edit code into an
** mask edit mask, which is a set of
** instructions used by the edit
** function to format a numeric
** value into a character string.
**
** MI builtins:
** _LBEDIT Late bound edit Transforms a numeric value from
** its internal format to character
** form, using the provided edit
** mask. Late bound here refers to
** the source value location not
** having to be provided until
** runtime.
**
** _MATMATR1 Materialize machine Retrieves a broad range of system
** attributes software and hardware related
** attributes.
**
** C library function:
** tstbts Test bits Tests the bit value of the bit
** located with the bit offset
** parameter, bit 0 being the
** leftmost and 64k the maximum.
**
** Compile options required:
**
** BndSrvPgm( QPZLSTFX ) - on V5R2 the compiler is not able to locate
** the 'QpzListPTF' API itself.
**
** CrtRpgMod Module( CBX131 )
** DbgView( *LIST )
**
** CrtSrvPgm SrvPgm( CBX131 )
** Module( CBX131 )
** Export( *ALL )
** BndSrvPgm( QPZLSTFX )
** ActGrp( QSRVPGM )
**
**
**-- Header Specifications: --------------------------------------------**
H NoMain Option( *SrcStmt ) BndDir( 'QC2LE' ) DecEdit( *JobRun )
**-- API Error Data Structure:
D ERRC0100 Ds Qualified Inz
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 256a
**-- Global constants:
D NULL c ''
**-- Product information:
D PRDR0100 Ds Qualified
D BytPrv 10i 0
D BytRtn 10i 0
D 10i 0
D PrdId 7a
D Release 6a
D PrdOpt 4a
D LodId 4a
D LodTyp 10a
D SymLodStt 10a
D LodErrInd 10a
D LodStt 2a
D SupFlg 1a
D RegTyp 2a
D RegVal 14a
D 2a
D OfsAddInf 10i 0
D PriLodId 4a
D MinTrgRel 6a
D MinVrmBas 6a
D RqmBasOpt 1a
D Level 3a
**-- System status information:
D SSTS0200 Ds Qualified
D BytAvl 10i 0
D BytRtn 10i 0
D RstStt 1a Overlay( SSTS0200: 31 )
**-- Edit template:
D DPA_Template_T Ds Qualified
D SclTyp 1a
D SclLen 5i 0
D DecPos 3i 0 Overlay( SclLen: 1 )
D DecLen 3i 0 Overlay( SclLen: 2 )
D Rsv 10i 0 Inz
**-- Inz status record:
D MatInzSts Ds Qualified
D BytPrv 10i 0 Inz( %Size( MatInzSts ))
D BytAvl 10i 0
D StrIpl 8a Overlay( MatInzSts: 441 )
**-- Convert edit code to mask:
D CvtCdeMsk Pr ExtPgm( 'QECCVTEC' )
D CcEdtMsk 256a
D CcEdtMskLen 10i 0
D CcRcvVarLen 10i 0
D CcZroFilChr 1a
D CcEdtCde 1a Const
D CcCcyInd 1a Const
D CcSrcVarPrc 10i 0 Const
D CcSrcVarDec 10i 0 Const
D CcError 32767a Options( *VarSize )
**-- Retrieve system status:
D RtvSysSts Pr ExtPgm( 'QWCRSSTS' )
D RsRcvVar 32767a Options( *VarSize )
D RsRcvVarLen 10i 0 Const
D RsFmtNam 10a Const
D RsRstStc 10a Const
D RsError 32767a Options( *VarSize )
**
D RsPoolSltInf 24a Const Options( *VarSize: *NoPass )
D RsPoolSltSiz 10i 0 Const Options( *NoPass )
**-- Retrieve system value:
D RtvSysVal Pr ExtPgm( 'QWCRSVAL' )
D GsRcvVar 32767a Options( *VarSize )
D GsRcvVarLen 10i 0 Const
D GsNbrSysVal 10i 0 Const
D GsSysVal 10a Const Dim( 256 )
D Options( *VarSize )
D GsError 32767a Options( *VarSize )
**-- Retrieve net attribute:
D RtvNetAtr Pr ExtPgm( 'QWCRNETA' )
D RnRcvVar 32767a Options( *VarSize )
D RnRcvVarLen 10i 0 Const
D RnNbrNetAtr 10i 0 Const
D RnNetAtr 10a Const Dim( 256 )
D Options( *VarSize )
D RnError 32767a Options( *VarSize )
**-- Retrieve product information:
D RtvPrdInf Pr ExtPgm( 'QSZRTVPR' )
D PiDta Like( PRDR0100 )
D PiDtaLen 10i 0 Const
D PiFmtNam 8a Const
D PiPrdInf 27a Const
D PiError 1024a Options( *VarSize )
**-- Retrieve job information:
D RtvJobInf Pr ExtPgm( 'QUSRJOBI' )
D RiRcvVar 32767a Options( *VarSize )
D RiRcvVarLen 10i 0 Const
D RiFmtNam 8a Const
D RiJobNamQ 26a Const
D RiJobIntId 16a Const
D RiError 32767a Options( *NoPass: *VarSize )
D RiRstStc 1a Options( *NoPass )
**-- Convert date & time:
D CvtDtf Pr ExtPgm( 'QWCCVTDT' )
D CdInpFmt 10a Const
D CdInpVar 17a Const Options( *VarSize )
D CdOutFmt 10a Const Options( *VarSize )
D CdOutVar 17a Const Options( *VarSize )
D CdError 32767a Options( *VarSize )
**-- Create user space:
D CrtUsrSpc Pr ExtPgm( 'QUSCRTUS' )
D CsSpcNamQ 20a Const
D C***tAtr 10a Const
D CsInzSiz 10i 0 Const
D CsInzVal 1a Const
D CsPubAut 10a Const
D CsText 50a Const
D CsReplace 10a Const Options( *NoPass )
D CsError 32767a Options( *NoPass: *VarSize )
D CsDomain 10a Const Options( *NoPass )
**-- Delete user space:
D DltUsrSpc Pr ExtPgm( 'QUSDLTUS' )
D DsSpcNamQ 20a Const
D DsError 32767a Options( *VarSize )
**-- Retrieve pointer to user space:
D RtvPtrSpc Pr ExtPgm( 'QUSPTRUS' )
D RpSpcNamQ 20a Const
D RpPointer *
D RpError 32767a Options( *NoPass: *VarSize )
**-- List PTFs:
D LstPtfs Pr ExtProc( 'QpzListPTF' )
D LpSpcNamQ 20a Const
D LpPrdId 50a Const
D LpFmtNam 8a Const
D LpError 32767a Options( *VarSize )
**-- Edit function:
D Edit Pr ExtProc( '_LBEDIT' )
D RcvVar * Value
D RcvVarLen 10u 0 Const
D SrcVar * Value
D SrcVarAtr Const Like( DPA_Template_T )
D EdtMsk 256a Const
D EdtMskLen 10u 0 Const
**-- Materialize machine attributes:
D MatMatr Pr ExtProc('_MATMATR1')
D Atr 32767a Options( *VarSize )
D Opt 2a Const
**-- Test bit in string:
D tstbts Pr 10i 0 ExtProc( 'tstbts' )
D string * Value
D bitofs 10u 0 Value
**-- Get system state:
D GetSysStt Pr 1a Varying
**-- Get system value:
D GetSysVal Pr 4096a Varying
D PxSysVal 10a Const
**-- Get network attribute
D GetNetAtr Pr 4096a Varying
D PxNetAtr 10a Const
**-- Get system release level:
D GetRlsLvl Pr 6a
**-- Get IPL timestamp:
D GetIplDts Pr z
**-- Get cumulative PTF package level:
D GetCumLvl Pr 5s 0
**-- Get processor group:
D GetPrcGrp Pr 4a
**-- Get processor type:
D GetPrcTyp Pr 4a
**-- Get key position:
D GetKeyPos Pr 6a
**-- Get IPL type:
D GetIplTyp Pr 1a
**-- Edit code:
D EditC Pr 256a Varying
D PxDecVar * Value
D PxDecTyp 1a Const
D PxDecDig 5u 0 Const
D PxDecPos 5u 0 Const
D PxEdtCde 1a Const
**-- Apply decimal format:
D ApyDecFmt Pr 64a Varying
D PxInpStr 64a Value Varying
D PxDecPos 5u 0 Const
**-- Get system state:
P GetSysStt B Export
D Pi 1a Varying
/Free
RtvSysSts( SSTS0200
: %Size( SSTS0200 )
: 'SSTS0200'
: '*NO'
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return NULL;
Else;
Return SSTS0200.RstStt;
EndIf;
/End-Free
P GetSysStt E
**-- Get system value:
P GetSysVal B Export
D Pi 4096a Varying
D PxSysVal 10a Const
**
**-- Local variables:
D Idx s 10i 0
D SysVal s 4096a Varying
**
D RsRtnVarLen s 10i 0
D RsSysValNbr s 10i 0 Inz( %Elem( RsSysVal ))
D RsSysVal s 10a Dim( 1 )
***
D RsRtnVar Ds
D RsRtnVarNbr 10i 0
D RsRtnVarOfs 10i 0 Dim( %Elem( RsSysVal ))
D RsRtnVarDta 4096a
**
D RsSysValInf Ds Based( pSysVal )
D RsSysValKwd 10a
D RsDtaTyp 1a
D RsInfSts 1a
D RsDtaLen 10i 0
D RsDta 4096a
/Free
RsRtnVarLen = %Elem( RsSysVal ) * 24 + %Size( SysVal ) + 4;
RsSysVal(1) = PxSysVal;
RtvSysVal( RsRtnVar
: RsRtnVarLen
: RsSysValNbr
: RsSysVal
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
SysVal = NULL;
Else;
For Idx = 1 to RsRtnVarNbr;
pSysVal = %Addr( RsRtnVar ) + RsRtnVarOfs(Idx);
If RsSysValKwd = PxSysVal;
Select;
When RsDtaTyp = 'C';
SysVal = %Subst( RsDta: 1: RsDtaLen );
When RsDtaTyp = 'B';
SysVal = EditC( %Addr( RsDta ): RsDtaTyp: 10: 0: 'P' );
Other;
SysVal = NULL;
EndSl;
EndIf;
EndFor;
EndIf;
Return SysVal;
/End-Free
P GetSysVal E
**-- Get network attribute: --------------------------------------------**
P GetNetAtr B Export
D Pi 4096a Varying
D PxNetAtr 10a Const
**
**-- Local variables:
D Idx s 10i 0
D NetAtr s 4096a Varying
**
D RnRtnAtrLen s 10i 0
D RnNetAtrNbr s 10i 0 Inz( %Elem( RnNetAtr ))
D RnNetAtr s 10a Dim( 1 )
**
D RnRtnVar Ds
D RnRtnVarNbr 10i 0
D RnRtnVarOfs 10i 0 Dim( %Elem( RnNetAtr ))
D RnRtnVarDta 4096a
**
D RnRtnAtr Ds Based( RtnValPtr )
D RnAtrNam 10a
D RnDtaTyp 1a
D RnInfSts 1a
D RnDtaLen 10i 0
D RnDta 4096a
/Free
RnRtnAtrLen = %Elem( RnNetAtr ) * 24 + ( %Size( NetAtr )) + 4;
RnNetAtr(1) = PxNetAtr;
RtvNetAtr( RnRtnVar
: RnRtnAtrLen
: RnNetAtrNbr
: RnNetAtr
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
NetAtr = NULL;
Else;
For Idx = 1 to RnRtnVarNbr;
RtnValPtr = %Addr( RnRtnVar ) + RnRtnVarOfs(Idx);
If RnAtrNam = PxNetAtr;
Select;
When RnDtaTyp = 'C';
NetAtr = %SubSt( RnDta: 1: RnDtaLen );
When RnDtaTyp = 'B';
NetAtr = EditC( %Addr( RnDta ): RnDtaTyp: 10: 0: 'P' );
Other;
NetAtr = NULL;
EndSl;
EndIf;
EndFor;
EndIf;
Return NetAtr;
/End-Free
P GetNetAtr E
**-- Get system release level: -----------------------------------------**
P GetRlsLvl B Export
D Pi 6a
/Free
RtvPrdInf( PRDR0100
: %Size( PRDR0100 )
: 'PRDR0100'
: '*OPSYS *CUR 0000*CODE '
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
PRDR0100.Release = *Blanks;
EndIf;
Return PRDR0100.Release;
/End-Free
P GetRlsLvl E
**-- Edit code: --------------------------------------------------------**
P EditC B
D Pi 256a Varying
D PxDecVar * Value
D PxDecTyp 1a Const
D PxDecDig 5u 0 Const
D PxDecPos 5u 0 Const
D PxEdtCde 1a Const
**-- Local variables & constants:
D EdtMsk s 256a
D EdtMskLen s 10i 0
D RcvVar s 256a
D RcvVarLen s 10i 0
D ZroFilChr s 1a
D DecDig s 10u 0
**
D T_SIGNED c x'00'
D T_FLOAT c x'01'
D T_ZONED c x'02'
D T_PACKED c x'03'
D T_UNSIGNED c x'0A'
**
/Free
Select;
When PxDecTyp = 'P' Or PxDecTyp = 'Z';
If PxDecTyp = 'P';
DPA_Template_T.SclTyp = T_PACKED;
Else;
DPA_Template_T.SclTyp = T_ZONED;
EndIf;
DecDig = PxDecDig;
DPA_Template_T.DecPos = PxDecPos;
DPA_Template_T.DecLen = PxDecDig;
When PxDecTyp = 'I' Or PxDecTyp = 'U';
If PxDecTyp = 'I';
DPA_Template_T.SclTyp = T_SIGNED;
Else;
DPA_Template_T.SclTyp = T_UNSIGNED;
EndIf;
DecDig = PxDecDig;
DPA_Template_T.DecPos = *Zero;
If DecDig > 5;
DPA_Template_T.DecLen = 4;
Else;
DPA_Template_T.DecLen = 2;
EndIf;
When PxDecTyp = 'B';
DPA_Template_T.SclTyp = T_SIGNED;
DPA_Template_T.DecPos = *Zero;
DecDig = PxDecDig;
If DecDig > 5;
DecDig = 10;
DPA_Template_T.DecLen = 4;
Else;
DecDig = 5;
DPA_Template_T.DecLen = 2;
EndIf;
EndSl;
CvtCdeMsk( EdtMsk
: EdtMskLen
: RcvVarLen
: ZroFilChr
: PxEdtCde
: ' '
: DecDig
: DPA_Template_T.DecPos
: ERRC0100
);
CallP(e) Edit( %Addr( RcvVar )
: RcvVarLen
: PxDecVar
: DPA_Template_T
: EdtMsk
: EdtMskLen
);
If %Error;
Return NULL;
ElseIf PxDecTyp = 'B' And PxDecPos > *Zero;
Return %Trim( ApyDecFmt( %SubSt( RcvVar: 1: RcvVarLen ): PxDecPos ));
Else;
Return %Trim( %SubSt( RcvVar: 1: RcvVarLen ));
EndIf;
/End-Free
P EditC E
**-- Apply decimal format: ---------------------------------------------**
P ApyDecFmt B
D Pi 64a Varying
D PxInpStr 64a Value Varying
D PxDecPos 5u 0 Const
**-- Local variables:
D ZroOfs s 5u 0
D DecOfs s 5u 0
**-- Job info format JOBI0400:
D JOBI0400 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D JobNam 10a
D UsrNam 10a
D JobNbr 6a
D DecFmt 1a Overlay( JOBI0400: 457 )
/Free
RtvJobInf( JOBI0400
: %Size( JOBI0400 )
: 'JOBI0400'
: '*'
: *Blank
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return PxInpStr;
Else;
If JOBI0400.DecFmt = 'J';
ZroOfs = %Len( PxInpStr ) - PxDecPos;
DecOfs = ZroOfs + 1;
Else;
ZroOfs = %Len( PxInpStr ) - PxDecPos + 1;
DecOfs = ZroOfs;
EndIf;
PxInpStr = %Xlate( ' ': '0': PxInpStr: ZroOfs );
If JOBI0400.DecFmt = ' ';
Return %Replace( '.': PxInpStr: DecOfs: 0 );
Else;
Return %Replace( ',': PxInpStr: DecOfs: 0 );
EndIf;
EndIf;
/End-Free
P ApyDecFmt E
**-- Get Cumulative PTF package level: ---------------------------------**
P GetCumLvl B Export
D Pi 5s 0
**-- Local variables:
D Idx s 10u 0
D CumLvl s 5s 0 Inz
**-- Local constants:
D USRSPC_NAM c 'LSTPTFS QTEMP'
**-- User space generic header:
D UsrSpc Ds Qualified Based( pUsrSpc )
D OfsHdr 10i 0 Overlay( UsrSpc: 117 )
D OfsLst 10i 0 Overlay( UsrSpc: 125 )
D NumLstEnt 10i 0 Overlay( UsrSpc: 133 )
D SizLstEnt 10i 0 Overlay( UsrSpc: 137 )
**-- User space pointers:
D pUsrSpc s * Inz( *Null )
D pHdrInf s * Inz( *Null )
D pLstEnt s * Inz( *Null )
**-- Product information - QpzListPTF:
D PtfPrdInf Ds Qualified
D PrdId 7a
D Release 6a
D PrdOpt 4a
D LodId 10a
D IncSpsPtf 1a Inz( '0' )
D 22a Inz( *Allx'00' )
**-- PTF list entry:
D PTFL0100 Ds Qualified Based( pLstEnt )
D PtfId 7a
D PtfPfx 2a Overlay( PtfId: 1 )
D PtfCum 1a Overlay( PtfId: 2 )
D PtfNbr 5s 0 Overlay( PtfId: 3 )
D RelLvlPtf 6a
D RelV 1a Overlay( RelLvlPtf: 2 )
D RelR 1a Overlay( RelLvlPtf: 4 )
D RelM 1a Overlay( RelLvlPtf: 6 )
D PrdOptPtf 4a
D PrdLodPtf 4a
D LodSts 1a
D SvfSts 1a
D CvrSts 1a
D OrdSts 1a
D IplAct 1a
D ActPnd 1a
D ActReq 1a
D IplReq 1a
D PtfRls 1a
D MinLvl 2a
D MaxLvl 2a
D StsDts 13a
D StsDat 7a Overlay( StsDts: 1 )
D StsTim 6a Overlay( StsDts: 8 )
D SpsPtfId 7a
/Free
RtvPrdInf( PRDR0100
: %Size( PRDR0100 )
: 'PRDR0100'
: '*OPSYS *CUR 0000*CODE '
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
CrtUsrSpc( USRSPC_NAM
: *Blanks
: 65535
: x'00'
: '*CHANGE'
: *Blanks
: '*YES'
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
PtfPrdinf.PrdId = PRDR0100.PrdId;
PtfPrdinf.Release = PRDR0100.Release;
PtfPrdinf.PrdOpt = PRDR0100.PrdOpt;
PtfPrdinf.LodId = PRDR0100.LodId;
LstPtfs( USRSPC_NAM: PtfPrdInf: 'PTFL0100': ERRC0100 );
If ERRC0100.BytAvl = *Zero;
RtvPtrSpc( USRSPC_NAM: pUsrSpc );
pHdrInf = pUsrSpc + UsrSpc.OfsHdr;
pLstEnt = pUsrSpc + UsrSpc.OfsLst;
For Idx = 1 to UsrSpc.NumLstEnt;
If PTFL0100.PtfPfx = 'TC';
If PTFL0100.PtfNbr > CumLvl;
CumLvl = PTFL0100.PtfNbr;
EndIf;
EndIf;
If Idx < UsrSpc.NumLstEnt;
pLstEnt += UsrSpc.SizLstEnt;
EndIf;
EndFor;
EndIf;
EndIf;
DltUsrSpc( USRSPC_NAM: ERRC0100 );
EndIf;
Return CumLvl;
/End-Free
P GetCumLvl E
**-- Get IPL timestamp: ------------------------------------------------**
P GetIplDts B Export
D Pi z
**
D IplDts Ds 17 Qualified
D Date 8a
D Time 6a
/Free
MatMatr( MatInzSts: x'0108' );
CvtDtf( '*DTS': MatInzSts.StrIpl: '*YYMD': IplDts: ERRC0100 );
Return %Date( IplDts.Date: *ISO0 ) + %Time( IplDts.Time: *HMS0 );
/End-Free
P GetIplDts E
**-- Get processor group: ----------------------------------------------**
P GetPrcGrp B Export
D Pi 4a
**
D matmatr Pr ExtProc( 'matmatr' )
D mchatr * Value
D mchatrlen 5i 0 Value
**
D MMTR_012C_T Ds 2616 Qualified
D BytPrv 10i 0 Inz( %Size( MMTR_012C_T ))
D BytAvl 10i 0
D reserved 8a
D Mem_Offset 10i 0
D Proc_Offset 10i 0
D Col_Offset 10i 0
D CEC_Offset 10i 0
D Panel_Offset 10i 0
**
D CEC_VPD_T Ds Qualified Based( pCEC_VPD_T )
D CEC_read 4a
D Manufacturing 4a
D reserved1 4a
D Type 4a
D Model 4a
D Pseudo_Model 4a
D Group_Id 4a
D reserved2 4a
D Sys_Type_Ext 1a
D Feature_Code 4a
D Serial_No 10a
D reserved3 1a
**
D MMTR_VPD c x'012c'
/Free
matmatr( %Addr( MMTR_012C_T ): MMTR_VPD );
pCEC_VPD_T = %Addr( MMTR_012C_T ) + MMTR_012C_T.CEC_Offset;
Return %Trim( CEC_VPD_T.Group_Id );
/End-Free
P GetPrcGrp E
**-- Get processor type: -----------------------------------------------**
P GetPrcTyp B Export
D Pi 4a
**
D matmatr Pr ExtProc( 'matmatr' )
D mchatr * Value
D mchatrlen 5i 0 Value
**
D MMTR_012C_T Ds 2616 Qualified
D BytPrv 10i 0 Inz( %Size( MMTR_012C_T ))
D BytAvl 10i 0
D reserved 8a
D Mem_Offset 10i 0
D Proc_Offset 10i 0
D Col_Offset 10i 0
D CEC_Offset 10i 0
D Panel_Offset 10i 0
**
D CEC_VPD_T Ds Qualified Based( pCEC_VPD_T )
D CEC_read 4a
D Manufacturing 4a
D reserved1 4a
D Type 4a
D Model 4a
D Pseudo_Model 4a
D Group_Id 4a
D reserved2 4a
D Sys_Type_Ext 1a
D Feature_Code 4a
D Serial_No 10a
D reserved3 1a
**
D MMTR_VPD c x'012c'
/Free
matmatr( %Addr( MMTR_012C_T ): MMTR_VPD );
pCEC_VPD_T = %Addr( MMTR_012C_T ) + MMTR_012C_T.CEC_Offset;
Return CEC_VPD_T.Type;
/End-Free
P GetPrcTyp E
**-- Get key position: -------------------------------------------------**
P GetKeyPos B Export
D Pi 6a
**
D MMTR_0168_T Ds Qualified
D BytPrv 10i 0 Inz( %Size( MMTR_0168_T ))
D BytAvl 10i 0
D CurIplTyp 1a
D BitMap 1a
D 6a
D PrvIplTyp 1a
**
D MMTR_PANEL_STATUS...
D c x'0168'
/Free
MatMatr( MMTR_0168_T: MMTR_PANEL_STATUS );
Select;
When tstbts( %Addr( MMTR_0168_T.BitMap ): 4 ) = 1;
Return 'Auto';
When tstbts( %Addr( MMTR_0168_T.BitMap ): 5 ) = 1;
Return 'Normal';
When tstbts( %Addr( MMTR_0168_T.BitMap ): 6 ) = 1;
Return 'Manual';
When tstbts( %Addr( MMTR_0168_T.BitMap ): 7 ) = 1;
Return 'Secure';
Other;
Return *Blanks;
EndSl;
/End-Free
P GetKeyPos E
**-- Get IPL type: -----------------------------------------------------**
P GetIplTyp B Export
D Pi 1a
**
D MMTR_0168_T Ds Qualified
D BytPrv 10i 0 Inz( %Size( MMTR_0168_T ))
D BytAvl 10i 0
D CurIplTyp 1a
D BitMap 1a
D 6a
D PrvIplTyp 1a
**
D MMTR_PANEL_STATUS...
D c x'0168'
/Free
MatMatr( MMTR_0168_T: MMTR_PANEL_STATUS );
Return MMTR_0168_T.CurIplTyp;
/End-Free
P GetIplTyp E
阅读(2329) | 评论(0) | 转发(0) |
