|
midrange.com
> Jeff, would you be willing to post this code or distribute a
> copy via email.
Here it is:
1) There's the UPSCHECK CLLE member that is executed via the job scheduler.
2) There's the SubSysAttr RPGLE service program. It's used by UPSCHECK so
it must be created first and available when UPSCHECK is created. (I use
binding directories).
3) There's the prototype for SubSysAttr.
*****
***** UPSCHECK CLLE member:
*****
/* Periodic wakeup and check for UPS attachment and status */
PGM
/* *** CONSTANTS *** */
/* Message file */
/* This is my own message file. Message IDs USR9895 and USR9897 are
*/
/* virtually identical to CPF9897 in QCPFMSG. USR9897 is severity 30 (break
*/
/* message in my shop) while USR9895 is severity 00 (meaning it won't break
*/
/* in my shop). Severity 00 messages won't disturb the user.
*/
DCL VAR(&MSGF) +
TYPE(*CHAR) +
LEN(10) +
VALUE('MSG')
DCL VAR(&MSGFLIB) +
TYPE(*CHAR) +
LEN(10) +
VALUE('DILGARD')
/* Message queue for sent messages. (I can change the queue here */
/* and then test to my heart's content without others seeing the */
/* messages.) */
DCL VAR(&MSGQ) +
TYPE(*CHAR) +
LEN(10) +
VALUE('QSYSOPR')
/* *** VARIABLES *** */
/* Received from the API */
DCL VAR(&UPSBATLOW) +
TYPE(*LGL)
DCL VAR(&UPSBPSACT) +
TYPE(*LGL)
DCL VAR(&UPSPWRRUN) +
TYPE(*LGL)
DCL VAR(&UPSINSRDY) +
TYPE(*LGL)
/* Converted to character so users don't have to interpret binary */
DCL VAR(&CUPSBATLOW) +
TYPE(*CHAR) +
LEN(1)
DCL VAR(&CUPSBPSACT) +
TYPE(*CHAR) +
LEN(1)
DCL VAR(&CUPSPWRRUN) +
TYPE(*CHAR) +
LEN(1)
DCL VAR(&CUPSINSRDY) +
TYPE(*CHAR) +
LEN(1)
DCL VAR(&MINUTE) +
TYPE(*CHAR) +
LEN(2)
/* UPS message queue */
DCL VAR(&UPSMSGD) +
TYPE(*CHAR) +
LEN(20)
DCL VAR(&UPSMSGQ) +
TYPE(*CHAR) +
LEN(10)
DCL VAR(&UPSMSGQLIB) +
TYPE(*CHAR) +
LEN(10)
/* Monitored status */
DCL VAR(&MONITORED) +
TYPE(*CHAR) +
LEN(1)
/* Message text */
DCL VAR(&EMLMSG) +
TYPE(*CHAR) +
LEN(132)
/* Get UPS message queue */
QSYS/RTVSYSVAL SYSVAL(QUPSMSGQ) +
RTNVAR(&UPSMSGD)
CHGVAR VAR(&UPSMSGQ) +
VALUE(%SST(&UPSMSGD 1 10))
CHGVAR VAR(&UPSMSGQLIB) +
VALUE(%SST(&UPSMSGD 11 10))
/* Test that it is being continually monitored by attempting to */
/* allocate it exclusively. */
CHGVAR VAR(&MONITORED) +
VALUE('N')
ALCOBJ OBJ((&UPSMSGQLIB/&UPSMSGQ *MSGQ *EXCL)) +
WAIT(0)
MONMSG MSGID(CPF0000) +
EXEC(DO)
CHGVAR VAR(&MONITORED) +
VALUE('Y')
ENDDO
DLCOBJ OBJ((&UPSMSGQLIB/&UPSMSGQ *MSGQ *EXCL))
MONMSG MSGID(CPF0000)
/* If it was available, it is not being monitored. Issue a message */
IF COND(&MONITORED *NE 'Y') +
THEN(DO)
CHGVAR VAR(&EMLMSG) +
VALUE('WARNING - the UPS is not being monitored for +
messages!')
SNDPGMMSG MSGID(USR9897) +
MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&EMLMSG) +
TOMSGQ(&MSGQ)
ENDDO
/* Test for UPS attachment */
CALLPRC PRC(GETUPSATTR) +
PARM((&UPSBATLOW) (&UPSBPSACT) (&UPSPWRRUN) (&UPSINSRDY)) +
RTNVAL(*NONE) /* SUBSYSATTR */
/* Set these attributes to character */
IF COND(&UPSINSRDY *EQ '1') +
THEN(CHGVAR &CUPSINSRDY 'Y')
ELSE CMD(CHGVAR VAR(&CUPSINSRDY) VALUE('N'))
IF COND(&UPSBPSACT *EQ '1') +
THEN(CHGVAR &CUPSBPSACT 'Y')
ELSE CMD(CHGVAR VAR(&CUPSBPSACT) VALUE('N'))
IF COND(&UPSPWRRUN *EQ '1') +
THEN(CHGVAR &CUPSPWRRUN 'Y')
ELSE CMD(CHGVAR VAR(&CUPSPWRRUN) VALUE('N'))
IF COND(&UPSBATLOW *EQ '1') +
THEN(CHGVAR &CUPSBATLOW 'Y')
ELSE CMD(CHGVAR VAR(&CUPSBATLOW) VALUE('N'))
/* Set message data */
CHGVAR &EMLMSG +
VALUE('UPS status: Attached=' *TCAT &CUPSINSRDY *TCAT ', On +
Bypass=' *TCAT &CUPSBPSACT *TCAT ', On Battery=' *TCAT +
&CUPSPWRRUN *TCAT ', Battery Low=' *TCAT &CUPSBATLOW)
/* If all is OK, send level 00 message and end. Once an hour to QSYSOPR, */
/* always to QHST. */
IF COND(&CUPSINSRDY *EQ 'Y' *AND &CUPSBPSACT *EQ 'N' *AND +
&CUPSPWRRUN *EQ 'N' *AND &CUPSBATLOW = 'N') +
THEN(DO)
RTVSYSVAL SYSVAL(QMINUTE) +
RTNVAR(&MINUTE)
IF COND(&MINUTE *LE '15') +
THEN(DO)
SNDPGMMSG MSGID(USR9895) +
MSGF(MSG) +
MSGDTA(&EMLMSG) +
TOMSGQ(&MSGQ)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(USR9895) +
MSGF(MSG) +
MSGDTA(&EMLMSG) +
TOMSGQ(QHST)
ENDDO
RETURN
ENDDO
/* If not attached, notify */
IF COND(&CUPSINSRDY *NE 'Y') +
THEN(DO)
CHGVAR VAR(&EMLMSG) +
VALUE('SEVERE WARNING - no UPS is attached to the system, +
no power failure protection exists!')
SNDPGMMSG MSGID(USR9897) +
MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&EMLMSG) +
TOMSGQ(&MSGQ)
ENDDO
/* If on bypass, notify */
IF COND(&CUPSBPSACT *NE 'N') +
THEN(DO)
CHGVAR VAR(&EMLMSG) +
VALUE('SEVERE WARNING - UPS is on bypass, no power +
failure protection exists!')
SNDPGMMSG MSGID(USR9897) +
MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&EMLMSG) +
TOMSGQ(&MSGQ)
ENDDO
/* If on battery, notify */
IF COND(&CUPSPWRRUN *NE 'N') +
THEN(DO)
CHGVAR VAR(&EMLMSG) +
VALUE('SEVERE WARNING - UPS is running on battery, not +
utility power!')
SNDPGMMSG MSGID(USR9897) +
MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&EMLMSG) +
TOMSGQ(&MSGQ)
ENDDO
/* If low battery, notify */
IF COND(&CUPSBATLOW *NE 'N') +
THEN(DO)
CHGVAR VAR(&EMLMSG) +
VALUE('SEVERE WARNING - UPS battery is low!')
SNDPGMMSG MSGID(USR9897) +
MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&EMLMSG) +
TOMSGQ(&MSGQ)
ENDDO
ENDPGM
*****
***** SUBSYSATTR RPGLE member:
*****
*===============================================================
*
* Service program : SubSysAttr
* Description : Get system Attributes via API
*
*===============================================================
H NoMain
H BndDir( 'QC2LE' )
/Include QCpySrc,HDefault
* Get prototype(s)
/Define CpyGetUPSAttr
/Include QProtoSrc,SubSysAttr
/UnDefine CpyGetUPSAttr
/Eject
**-- Global constants:
D MMTR_MISR c x'0108'
**-- Inz status record:
D MMTR_0108_T Ds Qualified
D BytPrv 10i 0 Inz( %Size( MMTR_0108_T ))
D BytAvl 10i 0
D MisrSts 6a
**-- 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
/Eject
*===============================================================
*
* Procedure : GetUPSAttr
* Description : Get UPS attributes
*
*===============================================================
P GetUPSAttr B Export
D GetUPSAttr PI
D pUPSBatLow N
D pUPSBpsAct N
D pUPSPwrRun N
D pUPSInsRdy N
/Free
MatMatr( MMTR_0108_T: MMTR_MISR );
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 5 ) = 1;
pUpsBatLow = *On;
Else;
pUpsBatLow = *Off;
EndIf;
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 6 ) = 1;
pUpsBpsAct = *On;
Else;
pUpsBpsAct = *Off;
EndIf;
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 7 ) = 1;
pUpsPwrRun = *On;
Else;
pUpsPwrRun = *Off;
EndIf;
If tstbts( %Addr( MMTR_0108_T.MisrSts ): 8 ) = 1;
pUpsInsRdy = *On;
Else;
pUpsInsRdy = *Off;
EndIf;
*InLr = *On;
Return;
/End-Free
P GetUPSAttr E
*****
***** SUBSYSATTR prototype:
*****
/If Defined( CpyGetUPSAttr )
*=====================================================================
*
* INPUT: None.
*
* OUTPUT: pUPSBatLow 1=battery low, 0=not low
* pUPSBpsAct 1=bypass active, 0=bypass not active
* pUPSPwrRun 1=running on UPS, 0=running on utility power
* pUPSInsRdy 1=UPS attached, 0=not attached
*
*=====================================================================
D GetUPSAttr PR
D pUPSBatLow N
D pUPSBpsAct N
D pUPSPwrRun N
D pUPSInsRdy N
/EndIf
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.
