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?
Continue Reading This Article
Enjoy this article as well as all of our content, including E-Guides, news, tips and more.
Step 2 of 2:
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 ************************
