code

Name
Astradyne (UK) Ltd
Scriptlanguage
Plain Text
Tabwidth
4
Date
Mon, 05 Feb 2007 00:29:33 +0000
IP
192.168.0.34

Contolling CL routine for a UPS handling suite. The program is written in CLP and could form a basis for the development of your own in-house power management routines. UPSPREPARE, UPSCLNUP and UPSRESET also form a part of this suite.

  1.             PGM                                                               
  2.                                                                                
  3.             DCL        VAR(&UPSMSGQ) TYPE(*CHAR) LEN(20)                       
  4.             DCL        VAR(&LIB)    TYPE(*CHAR) LEN(20)                       
  5.             DCL        VAR(&MSGQ)    TYPE(*CHAR) LEN(20)                       
  6.             DCL        VAR(&MSGID)  TYPE(*CHAR) LEN(7)                       
  7.             DCL        VAR(&ENDSTS)  TYPE(*CHAR) LEN(1)                       
  8.             DCL        VAR(&WAIT)    TYPE(*DEC)  LEN(6) VALUE(1200)           
  9.             DCL        VAR(&HOUR)    TYPE(*DEC)  LEN(6)                       
  10.             DCL        VAR(&MIN)    TYPE(*DEC)  LEN(6)                       
  11.             DCL        VAR(&SEC)    TYPE(*DEC)  LEN(6)                       
  12.             DCL        VAR(&TIME)    TYPE(*CHAR) LEN(6)                       
  13.             DCL        VAR(&START)  TYPE(*DEC)  LEN(6)                       
  14.             DCL        VAR(&END)    TYPE(*DEC)  LEN(6)                       
  15.             DCL        VAR(&RESULT)  TYPE(*DEC)  LEN(6)                       
  16.                                                                                
  17.             MONMSG    MSGID(CPF0000)                                         
  18.                                                                                
  19. /* 0010 - Identify the UPS Message Queue and Library.  This will be monitored */
  20. /*      - for messages relating to the availability (or lack of) power to the */
  21. /*      - AS/400.  The message queue is deleted and recreated by this program */
  22. /*      - each time the program starts.  This ensures that messages are not  */
  23. /*      - left hanging around following power failures...                    */
  24.                                                                                
  25.             RTVSYSVAL  SYSVAL(QUPSMSGQ) RTNVAR(&UPSMSGQ)                       
  26.                                                                                
  27.             CHGVAR    VAR(&MSGQ) VALUE(%SST(&UPSMSGQ 1 10))                   
  28.             CHGVAR    VAR(&LIB) VALUE(%SST(&UPSMSGQ 11 10))                   
  29.                                                                                
  30.             DLTMSGQ    MSGQ(&LIB/&MSGQ)                                       
  31.             MONMSG    MSGID(CPF2105)                                         
  32.                                                                                
  33.             CRTMSGQ    MSGQ(&LIB/&MSGQ) TEXT('UPS Power handling +             
  34.                           program message queue') AUT(*EXCLUDE)                 
  35.                                                                                
  36. /* 0020 - Ensure the message queue is allocated exclusively to the message    */
  37. /*      - handling program...                                                */
  38.                                                                                
  39.             ALCOBJ    OBJ((&LIB/&MSGQ *MSGQ *EXCL))                           
  40.                                                                                
  41. /* 0030 - Every 10 minutes, poll the message queue to see if there are any    */
  42. /*      - messages waiting to be processed or not...                          */
  43.                                                                                
  44. A:          RCVMSG    MSGQ(&LIB/&MSGQ) WAIT(600) RMV(*YES) MSGID(&MSGID)     
  45.                                                                                
  46. /* 0040 - Check to see if the power has failed (CPF1816).  If not then repeat */
  47. /*      - the loop (check for the next message), but also test to see if an  */
  48. /*      - end request has been generated and cancel the program if necessary. */
  49.                                                                                
  50.             IF        COND(&MSGID *NE CPF1816) THEN(DO)                       
  51.               RTVJOBA    ENDSTS(&ENDSTS)                                       
  52.               IF        COND(&ENDSTS *EQ '1') THEN(GOTO CMDLBL(ENDPGM))       
  53.               GOTO      CMDLBL(A)                                             
  54.             ENDDO                                                             
  55.                                                                                
  56. /* 0050 - Check to see if this is a short power outage (less than 10 secs).  */
  57. /*      - If it is, then we close the loop and wait for the next message...  */
  58.  
  59.             IF        COND(&MSGID *EQ CPF1816) THEN(DO)                       
  60.               RCVMSG    MSGQ(&LIB/&MSGQ) WAIT(10) RMV(*YES) MSGID(&MSGID)     
  61.               IF        COND(&MSGID *EQ CPF1817) THEN(GOTO CMDLBL(A))         
  62.             ENDDO                                                             
  63.                                                                                
  64. /* 0060 - Power was out for more than 10 seconds, so prepare the system for a */
  65. /*      - clean shutdown...                                                  */
  66.                                                                                
  67.             CALL      PGM(UPSPREPARE)                                         
  68.                                                                                
  69. /* 0070 - Check to see if this is a long power outage (20 mins or more).  If  */
  70. /*      - so then we should start shutting down the system...                */
  71.                                                                                
  72.             CHGVAR    VAR(&WAIT) VALUE(01200)                                 
  73.                                                                                
  74. B:          RTVSYSVAL  SYSVAL(QTIME) RTNVAR(&TIME)                             
  75.                                                                                
  76.             CHGVAR    VAR(&HOUR) VALUE(%SST(&TIME 1 2))                       
  77.             CHGVAR    VAR(&MIN)  VALUE(%SST(&TIME 3 2))                       
  78.             CHGVAR    VAR(&SEC)  VALUE(%SST(&TIME 5 2))                       
  79.             CHGVAR    VAR(&START) VALUE((&SEC) + (&MIN * 60) + +             
  80.                           (&HOUR * 3600))                                       
  81.                                                                                
  82. /* 0080 - Retrieve the next message from the message queue, after waiting the */
  83. /*      - requisite amount of time...                                        */
  84.                                                                                
  85.             RCVMSG    MSGQ(&LIB/&MSGQ) WAIT(&WAIT) RMV(*YES) MSGID(&MSGID)   
  86.                                                                                
  87. /* 0090 - If power has been restored then return the system back to a running */
  88. /*      - state...                                                            */
  89.                                                                                
  90.             IF        COND(&MSGID *EQ CPF1817) THEN(DO)                       
  91.               CALL      PGM(UPSRESET)                                         
  92.               GOTO      CMDLBL(A)                                             
  93.             ENDDO                                                             
  94.                                                                                
  95. /* 0100 - If power has not been restored in the 20 minutes, then              */
  96. /*      -                                                                    */
  97. /*      -                                                                    */
  98.                                                                                
  99.             IF        COND(&MSGID *NE CPF1817) THEN(DO)                       
  100.                                                                                
  101.               RTVSYSVAL  SYSVAL(QTIME) RTNVAR(&TIME)                           
  102.                                                                                
  103.               CHGVAR    VAR(&HOUR) VALUE(%SST(&TIME 1 2))                     
  104.               CHGVAR    VAR(&MIN) VALUE(%SST(&TIME 3 2))                     
  105.               CHGVAR    VAR(&SEC) VALUE(%SST(&TIME 5 2))                     
  106.               CHGVAR    VAR(&END) VALUE((&SEC) + (&MIN * 60) + +             
  107.                             (&HOUR * 3600))                                     
  108.                                                                                
  109.               CHGVAR    VAR(&RESULT) VALUE(&END - &START)                     
  110.                                                                                
  111. /* 0110 - Determine how long the interval has been between messages.  If it  */
  112. /*      - is longer than 20 minutes then power down the system...            */
  113.                                                                                
  114.               IF        COND(&RESULT < 0) THEN(CHGVAR VAR(&RESULT) +         
  115.                             VALUE(86400 + &RESULT))                             
  116.                                                                                
  117.               IF        COND(&RESULT *GE &WAIT) THEN(DO)                     
  118.                                                                                
  119.                 RBASNDMSG  MSG('AS/400 Utility power has not been +           
  120.                               restored.  System will begin shutdown and +       
  121.                               require an attended IPL once power has +         
  122.                               been returned...') TOPG(AS400TEAM) +             
  123.                               RSP(*NO) TRUNCATE(*YES)                           
  124.                                                                                
  125.                 CHGDTAARA  DTAARA(UPSSTS) VALUE('*SHUTDWN')                   
  126.                                                                                
  127.                 DLYJOB    DLY(120)                                           
  128.                                                                                
  129.                 ENDSYS    OPTION(*IMMED)                                     
  130.                                                                                
  131.                 DLYJOB    DLY(300)                                           
  132.                                                                                
  133.                 LOCKOUT    USRTYP(*ALL)                                       
  134.                                                                                
  135.                 PWRDWNSYS  OPTION(*IMMED)                                     
  136.                                                                                
  137.               ENDDO                                                           
  138.                                                                                
  139. /* 0120 - Calculate the amount of battery reserve time left...                */
  140.                                                                                
  141.               CHGVAR    VAR(&WAIT) VALUE(&WAIT - &RESULT)                     
  142.               GOTO      CMDLBL(B)                                             
  143.             ENDDO                                                             
  144.                                                                                
  145.   ENDPGM:    DLCOBJ    OBJ((&LIB/&MSGQ *MSGQ *EXCL))                           
  146.             ENDPGM                                                             
  147.