|
midrange.com
Here is a quickie that you can use for a template:
/***************************************************************************
***/
/*'MONITOR FOR POWER FAILURE MESSAGES
EUR*/
/*
*/
/*By Chris BipesEUR 08/28/97
*/
/*'© CrossCheck, Inc., 6119 State Farm Drive, Rohnert Park, CA 94928EUR
*/
/***************************************************************************
***/
PGM
DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&ENDSTS) TYPE(*CHAR) LEN(1)
DCL VAR(&SYS) TYPE(*CHAR) LEN(8)
DCL VAR(&ONBAT) TYPE(*CHAR) LEN(1) VALUE('N')
DCL VAR(&QUPSMSGQ) TYPE(*CHAR) LEN(20)
DCL VAR(&UPSMSGQ) TYPE(*CHAR) LEN(10)
DCL VAR(&UPSMSGQL) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGTXT1) TYPE(*CHAR) LEN(256)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&READKEY) TYPE(*CHAR) LEN(4) VALUE(*TOP)
DCL VAR(&PRVMSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&LENGTH ) TYPE(*DEC ) LEN(5 0) VALUE(0)
DCL VAR(&A5 ) TYPE(*CHAR) LEN(5)
/*' Monitor for Errors and Send to Concepts
EUR*/
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERREXIT))
/*' DETERMINE IF BATCH OR INTERACTIVE JOB
EUR*/
RTVJOBA TYPE(&JOBTYPE)
IF COND(&JOBTYPE = '1') THEN(DO)
/*'SUBMIT BATCH PROCESSING
EUR*/
SBMJOB CMD(CALL PGM(GBCUPS)) JOB(UPSMONITOR) +
JOBQ(*LIBL/SERVER) USER(QPGMR) +
PRTTXT('UPS Monitor Job') DSPSBMJOB(*NO) +
MSGQ(*LIBL/QSYSOPR)
GOTO CMDLBL(ENDPGM)
ENDDO
BATCH:
/*'SET ENVIRONMENT
EUR*/
CHGJOB LOG(0 99 *NOLIST) LOGCLPGM(*NO)
/*'RETRIEVE UPS MESSAGE QUEUE NAME AND LIBRARY
EUR*/
RTVSYSVAL SYSVAL(QUPSMSGQ) RTNVAR(&QUPSMSGQ)
CHGVAR &UPSMSGQ %SST(&QUPSMSGQ 1 10)
CHGVAR &UPSMSGQL %SST(&QUPSMSGQ 11 10)
/*'RETRIEVE SYSTEM NAME
EUR*/
RTVNETA SYSNAME(&SYS)
/*'ALOCATE UPS MESSAGE QUEUE
EUR*/
ALCOBJ OBJ((&UPSMSGQL/&UPSMSGQ *MSGQ *SHRRD))
/*'SEND STARTUP MESSAGE TO OPS/CONCEPTS
EUR*/
SNDNETMSG MSG('UPS Monitor program Started on system' +
*BCAT &SYS) TOUSRID((OPS CONCEPTS))
/*'RECEIVE ALL MESSAGES & PROCESS AS NECESSARY
EUR*/
LOOP1:
/*'SAVE PREVIOUS MESSAGE KEY
EUR*/
CHGVAR VAR(&PRVMSGKEY) VALUE(&READKEY)
RCVMSG MSGQ(&UPSMSGQL/&UPSMSGQ) MSGTYPE(*NEXT) +
MSGKEY(&READKEY) WAIT(60) RMV(*NO) +
KEYVAR(&MSGKEY) MSG(&MSGTXT1) MSGID(&MSGID)
/*'RESET RECEIVE MESSAGE KEY IN CASE OF TIME OUT
EUR*/
CHGVAR VAR(&READKEY) VALUE(&PRVMSGKEY)
/*'CHECK FOR PREVIOUS POWER FAILURE - IF NOT RESTORED IN 30 MINUTES
EUR*/
/*' START A CONTROLLED POWER DOWN OF SYSTEM
EUR*/
IF COND(&ONBAT *EQ 'Y') THEN(DO)
CALL PGM(GBRUPS) PARM('TIMECHK' &LENGTH)
IF COND(&LENGTH < 300) THEN(DO)
SNDNETMSG MSG('UPS Duration =' *BCAT &A5 *TCAT ',' +
*BCAT &SYS *BCAT 'system is powering +
down') TOUSRID((OPS CONCEPTS))
/* PWRDWNSYS OPTION(*CNTRLD) DELAY(300) */
ENDDO
ENDDO
/*'FORWARD ALL MESSAGES TO OPS/CONCEPTS
EUR*/
IF COND((&MSGTXT1 *NE ' ') +
*OR (&MSGID *NE ' ')) THEN(DO)
SNDNETMSG MSG(&MSGTXT1) TOUSRID((OPS CONCEPTS))
/*'CHECK FOR POWER FAILURE - SAVE DATE/TIME
EUR*/
IF COND(&MSGID *EQ 'CPF1816') THEN(DO)
CALL PGM(GBRUPS) PARM(&MSGID &LENGTH)
CHGVAR VAR(&ONBAT) VALUE('Y')
ENDDO
/*'CHECK FOR POWER RESTORED
EUR*/
IF COND(&MSGID *EQ 'CPF1817') THEN(DO)
CALL PGM(GBRUPS) PARM(&MSGID &LENGTH)
CHGVAR VAR(&ONBAT) VALUE('N')
ENDDO
/*'CHECK FOR BATTERY LOW MESSAGE - CONTROLLED POWER DOWN SYSTEM
EUR*/
IF COND(&MSGID *EQ 'CPI0964') THEN(DO)
/* PWRDWNSYS OPTION(*CNTRLD) DELAY(600) */
GOTO ENDPGM
ENDDO
/*'SET KEY FOR NEXT MESSAGE
EUR*/
CHGVAR VAR(&READKEY) VALUE(&MSGKEY)
ENDDO
/*'CHECK FOR ENDJOB
EUR*/
RTVJOBA ENDSTS(&ENDSTS)
IF COND(&ENDSTS *EQ '1') THEN(GOTO CMDLBL(EXITPGM))
/*'LOOP BACK FOR NEXT MESSAGE
EUR*/
GOTO CMDLBL(LOOP1)
/*'SEND ENDING STATUS MESSAGE TO OPS/CONCEPTS
EUR*/
EXITPGM:
SNDNETMSG MSG('UPS Monitor is ending as requested on system' +
*BCAT &SYS) TOUSRID((OPS CONCEPTS))
GOTO CMDLBL(ENDPGM)
/*'Error Exit
EUR*/
ERREXIT:
SNDNETMSG MSG('UPS Monitor is ending IN ERROR on +
system' *BCAT &SYS *BCAT 'Please check +
JOBLOGS and DUMP') TOUSRID((OPS CONCEPTS))
DMPCLPGM
DSPJOBLOG OUTPUT(*PRINT)
/*'END PROGRAM
EUR*/
ENDPGM: ENDPGM
RPGLE:
---------------------------------------------------------------------------
H DATEDIT(*YMD)
**************************************************************************
*'CALCULATE LENGTH UPS HAS BEEN ON BATTERY
*
* PURPOSE OF PROGRAM: EUR
* WHEN POWER FAILS - SET FAILUE TIME STAMP - SAVE IN DATA AREA
* WHEN POWER IS RESTORED - SET RESTORED TIME STAMP - SAVE IN DATA
AREA
* WHEN TIME CHECK - CALCULATE DIFFENENCE BETWEEN CURRENT TIME STAMP
AND
* FAILURE
*
* By Chris BipesEUR
09/19/97
*' © CrossCheck, Inc., 6119 State Farm Drive, Rohnert Park, CA
94928EUR
**************************************************************************
* COMPILE TIME ARRAY(S)
D CMD S 100 DIM(1) CTDATA
* EXTERNAL DATA AREA
D UPSDATA DS 160 DTAARA(UPSMONITOR) INZ
D TMFAIL 1 26Z
TIME POWER FAILED
D TMRSTD 27 52Z
TIME POWER RESTORED
D TMCHCK 53 78Z
TIME CHECK
D TMELAP 79 93S 0
TIME ELAPSED
D TMDUR 94 98S 0
UPS DURATION 1 HOUR
D CALCDUR 99 103S 0
CALC UPS DURATION
* BREAK OUT SYSTEM TIME
D DS
D TIME14 1 14S 0
D TMHMS 1 6S 0
D TMMDCY 7 14S 0
* DEFINE WORK FIELDS
D WORKDT S D
D WORKTM S T
D WORKTS S Z
*
**************************************************************************
* MAIN LINE
**************************************************************************
C *ENTRY PLIST
C MSGID PARM @MSGID 7
C PARM UPSDUR @LEN 5 0
* DEFILE VARIABLES
C *LIKE DEFINE @LEN UPSDUR
C *LIKE DEFINE TMELAP TMRCHRG
C *LIKE DEFINE @MSGID MSGID
* RETRIEVE SAVED VALUES
C *IN19 DOUEQ *OFF
C *LOCK IN UPSDATA 19
C *IN19 IFEQ *ON
C EXSR $CRTUPS
C ENDIF
C ENDDO
* PROCESS RECEIVED MESSAGE
C SELECT
* POWER FAILURE
C MSGID WHENEQ 'CPF1816'
C EXSR $TIME
C MOVE WORKTS TMFAIL
C TMFAIL SUBDUR TMRSTD TMRCHRG:*S
* CALC TIME FROM PREVIOUS RESTORE TO CURRENT FAILURE
** IF LESS THAN 4 HOURS - PRORATE UPS DURATION
C TMRCHRG IFLT 14400
C TMRCHRG ANDGT *ZERO
C EVAL CALCDUR = TMDUR - (TMELAP - (TMRCHRG /
4))
C ELSE
C EVAL CALCDUR = TMDUR
C ENDIF
* POWER RESTORED
C MSGID WHENEQ 'CPF1817'
C EXSR $TIME
C MOVE WORKTS TMRSTD
C TMRSTD SUBDUR TMFAIL TMELAP:*S
* TIME CHECK
C MSGID WHENEQ 'TIMECHK'
C EXSR $TIME
C MOVE WORKTS TMCHCK
C TMCHCK SUBDUR TMFAIL TMELAP:*S
C EVAL UPSDUR = CALCDUR - TMELAP
C UPSDUR IFLT *ZERO
C CLEAR UPSDUR
C ENDIF
*
C ENDSL
*
C OUT UPSDATA
*
C SETON LR
**************************************************************************
* BUILD CURRENT TIME STAMP
**************************************************************************
CSR $TIME BEGSR
*
C TIME TIME14
C *USA MOVE TMMDCY WORKDT
C MOVE TMHMS WORKTM
C MOVE WORKDT WORKTS
C MOVE WORKTM WORKTS
*
CSR #TIME ENDSR
*
**************************************************************************
* CREATE UPS MONITOR DATA AREA
**************************************************************************
CSR $CRTUPS BEGSR
*
C MOVEL(P) CMD(1) @CMD
C ' ' CHECKR @CMD LEN 5 0
C Z-ADD LEN @CMDLEN
C CALL 'QCMDEXC'
C PARM @CMD 100
C PARM @CMDLEN 15 5
* INIT FIELDS
C *LOCK IN UPSDATA
C CLEAR UPSDATA
C Z-ADD 3600 TMDUR
DEFAULT 1 HOUR
C OUT UPSDATA
*
CSR #CRTUPS ENDSR
** CMD
CRTDTAARA QUSRSYS/UPSMONITOR *CHAR 160 TEXT('UPS MONITOR - TIME VALUES')
---------------------------------------------------------------------------
End RPGLE
-----Original Message-----
From: joberhol@compures.com [mailto:joberhol@compures.com]
Sent: Thursday, July 29, 1999 12:39 PM
To: MIDRANGE-L@midrange.com
Subject: UPS Power Control Program
Has anyone written a power control program they like? I have never written
one and am curious about what folks think the best way to handle one is.
How is the best way to determine how much battery is really there?
TIA
Jim Oberholtzer
joberholtzer@compures.com
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator:
david@midrange.com
+---
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
