Problem solve Get help with specific problems with your technologies, process and projects.

Retrieve subsystem status

Problem: How can a program running on an AS/400 tell if another subsystem is active?

Answer: RTVSBSSTS (Retrieve Subsystem Status) provides a way for a program running on the AS/400 to tell if a subsystem is active and if so, how many jobs are active in that subsystem.


/***********************************************************************/
/*                                                                             */
/* Demonstration program for RTVSBSSTS                                         */
/*                                                                             */
/* Call this program and pass it the name of the subsystem and libary.         */
/* It sends a message showing whether the subsystem is active and if so        */
/* how many active jobs are running in it.                                     */           /*                                                                             
*/
/***********************************************************************/
	    PGM        PARM(&NAME &LIB)                               
            DCL        VAR(&NAME) TYPE(*CHAR) LEN(10)                 
            DCL        VAR(&LIB) TYPE(*CHAR) LEN(10)                  
            DCL        VAR(&STATUS) TYPE(*CHAR) LEN(10)               
            DCL        VAR(&JOBSN)  TYPE(*DEC) LEN(7 0)               
            DCL        VAR(&JOBSC)  TYPE(*CHAR) LEN(7)                
            RTVSBSSTS  SBSNAME(&LIB/&NAME) STATUS(&STATUS) +          
                         #ACTJOBS(&JOBSN)                             
            CHGVAR     VAR(&JOBSC) VALUE(&JOBSN)                      
            SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) +                 
                         MSGDTA('Subsystem: ' *CAT &NAME *BCAT ' +    
                         Library: ' *BCAT &LIB *BCAT ' Status: ' +    
                         *BCAT &STATUS *BCAT ' #ActiveJobs:' +        
                         *BCAT &JOBSC) TOMSGQ(*TOPGMQ) MSGTYPE(*COMP) 
            ENDPGM                                                     



 *=============================================================== 
 *                                                                      
 * Program:    RTVSBSSTSR - CPP for Retrieve Subsystem Status           
 *                                                                      
 * Purpose:    When passed the name of a subsystem, return parms        
 *             showing *ACTIVE/*INACTIVE and the number of jobs         
 *                                                                      
 *                                                                      
 * Copyright 2001 by Dan Casey
 * 
 *=============================================================== 
                                                                        
 *---------------------------------------------------------------------  
 * Parameters                                                           
 *--------------------------------------------------------------------- 
d PSbsLib         s             20                                      
d PStatus         s             10                                      
d P#jobs          s              7  0                                   
                                                                        
 *--------------------------------------------------------------------- 
 * Miscellaneous variables and structures                               
 *--------------------------------------------------------------------- 
d arcvr           ds            80                                      
d   aStatus              29     38                                      
d   a#jobs               73     76B 0                                   
d arcvrlen        s              4b 0 inz(80)                           
d aformat         s              8    inz('SBSI0100')                   
d aqualname       s             20                                      
d aerror          s             10                                      
d NotFound        c                   Const('*NOTFOUND')                
                                                                         
 *--------------------------------------------------------------------- 
 *                                                                      
 * Parameter List                                                       
 *                                                                      
 *--------------------------------------------------------------------- 
c     *Entry        PList                                               
c                   Parm                    PSbsLib                     
c                   Parm                    PStatus                     
c                   Parm                    P#Jobs                      
                                                                        
 *--------------------------------------------------------------------- 
 *                                                                      
 * Mainline                                                             
 *                                                                      
 *--------------------------------------------------------------------- 
c                   eval      aqualname = PsbsLib                       
c                   CALL      'QWDRSBSD'                                
c                   PARM                    arcvr                       
c                   PARM                    arcvrlen                    
c                   PARM                    aformat                     
c                   PARM                    aqualname                   
c                   PARM                    aerror                      
c                   if        aStatus = *blanks                         
c                   eval      PStatus   = NotFound                      
c                   eval      P#Jobs    = *zero                         
c                   else                                                
c                                                                       
c                   eval      PStatus   = AStatus            
c                   eval      P#Jobs    = A#jobs             
c                   endif                                    
c                   eval      *inlr = *on                    
c                   return                                   

/*==============================================================*
/  
/*                                                                  */  
/* Command:    RTVSBSSTS -- RETRIEVE SUBSYSTEM STATUS               */  
/*                                                                  */  
/*                                                                  */  
/* Copyright 2001 by Dan Casey                                      */  
/*                                                                  */  
/*==============================================================*
/  
 RTVSBSSTS:  CMD        PROMPT('Retrieve Subsystem Status')             
             PARM       KWD(SBSNAME) TYPE(SBSNAMLIB) MIN(1) +           
                          PROMPT('Subsystem')                           
             PARM       KWD(STATUS) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +  
                          PROMPT('Subsystem Status (Char 10)')          
                          PROMPT('Subsystem Status (Char 10)')          
             PARM       KWD(#ACTJOBS) TYPE(*DEC) LEN(7 0) +             
                          RTNVAL(*YES) PROMPT('# Active jobs (Dec 7 +   
                          0)')                                          
  SBSNAMLIB:  QUAL       TYPE(*NAME) LEN(10) MIN(1)                      
                                                                        
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +                
                          SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')   
****************** End of data ************************

Dig Deeper on RPG iSeries programming

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close