• Subject: RE: UPS Power Control Program
  • From: Chris Bipes <ChrisB@xxxxxxxxxxxxxxx>
  • Date: Thu, 29 Jul 1999 13:28:26 -0700

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
+---


This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2019 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 here. If you have questions about this, please contact [javascript protected email address].