QGYRHRL & QGYRHRI - Retrieve the Interactive Featu

Retrieve the Interactive Feature Code *=============================================================== * GetProcFeat + *=============================================================== PGetProcFeat B DGetProcFeat PI 1n *--------------------------------------------------------------- D SysProc 4A D Proc 4A D Int 4A D wxdebug 1N const *--------------------------------------------------------------- *--------------------------------------------------------------------- * Local work areas * *--------------------------------------------------------------------- D***************************************************************** D*Field definitions for RHRL0100 format. D***************************************************************** DQGYL0100 DS D* Qgy RHRL0100 D QGYBR 1 4U 0 D* number of bytes returned D QGYBA 5 8U 0 D* number of bytes available D QGYNBRRR 9 12U 0 D* num of resources returned D QGYREL 13 16U 0 D* length of resource entry D Qvadsomhelst 17 2016a DRESDTL DS D QGYCAT 1 4U 0 D* category D QGYFL 5 8U 0 D* family level D QGYLT 9 12B 0 D* LAN line type D QGYNAME 13 22 D* name D QGYTYPE 23 26 D* type D QGYMODL 27 29 D* model D QGYSTAT 30 30 D* status D QGYSYS 31 38 D* system connected to D QGYADDR 39 50 D* LAN adapter address D QGYDES 51 100 D* description D QGYKIND 101 124 D* resource kind D***************************************************************** D*Field definitions for RHRI0410 format. D***************************************************************** DRcvVar DS D QRHBRTN 1 4B 0 D* Bytes Returned D QRHBAVL 5 8B 0 D* Bytes Available D QRHSBUS 9 12B 0 D* System Bus number D QRHSBOA 13 16B 0 D* System Board number D QRHSCAR 17 20B 0 D* System Card number D QRHSSRL 21 30a D* System serial number D QRHPART 31 42 D* Part number D QRHFRAM 43 46a D* Frame id D QRHCARP 47 51a D* Card position D QRHSPRC 52 55a D* Sys. processor feature code D QRHPRC 56 59a D* Processor feature code D QRHPRCI 60 63a D* Interactive feature code D ListFormat S 8 INZ('RHRI0410') D ListFormat2 S 8 INZ('RHRL0100') D Resource S 10 INZ(' ') D RcvSiz S 10i 0 INZ(%size(RCVVAR)) D RcvSiz2 S 10i 0 INZ(%size(QGYL0100)) D ResourceCat S 10i 0 INZ(4) D strpos S 10i 0 INZ(1) D DtlSiz S 10i 0 INZ(%size(RESDTL)) D wxlog S 256a *=============================================================== * Error Information Data Structure + *=============================================================== *Error Code DQUSBN DS * Qus EC DQUSBNB 1 4B 0 inz(%size(QUSBN)) * Bytes Provided DQUSBNC 5 8B 0 * Bytes Available DQUSBND 9 15 * Exception Id DQUSBNF 16 256 C eval wxlog = *blanks C CALL 'QGYRHRL' C PARM QGYL0100 C PARM RcvSiz2 C PARM ListFormat2 C PARM ResourceCat C PARM QUSBN C if QUSBNC > 0 error occured C callp SndDbgMsg( GetTime + C ' Error on QGYRHRI program ' + C 'call: ' + C QUSBND) C return *on C endif C if QGYNBRRR > 0 C do QGYNBRRR C eval %subst(RESDTL:1:DTLSIZ) = C %subst(Qvadsomhelst:strpos:DTLSIZ) C if %subst(QGYKIND:17:8) = C x'0000000000080000' C eval Resource = QGYNAME C leave C endif C eval StrPos = StrPos + QGYREL C enddo C endif C CALL 'QGYRHRI' C PARM RcvVar C PARM RcvSiz C PARM ListFormat C PARM Resource C PARM QUSBN C if QUSBNC > 0 error occured C callp SndDbgMsg( GetTime + C ' Error on QGYRHRI program ' + C 'call: ' + C QUSBND) C return *on C endif C if wxdebug debug C callp SndDbgMsg( GetTime + C ' System Proc#: ' + C %trim(QRHSPRC) + ' ' + C ' Processor#: ' + C %trim(QRHPRC) + ' ' + C ' Interactive#: ' + C %trim(QRHPRCI) + ' ' + C ' Serial#: ' + QRHSSRL + C ' system board: ' + C %trim(%editc(QRHSBOA:'Z')) ) C endif C eval SysProc = QRHSPRC C eval Proc = QRHPRC C eval Int = QRHPRCI C return *off PGetProcFeat E Thanks to Stefan Tageson