Title : Utility to check if IMS subsystem is active Submitter : Paul Wells TNT Express Worldwide Abeles Way Atherstone Warwickshire CV9 2RY Phone : 01827 710642 Release Submitter Details - Y Text :- TITLE 'ROUTINE TO CHECK IF IMS SUBSYSTEM IS ACTIVE' * * AUTHOR PAUL WELLS 29/10/90 FOR TESCO * 01/08/96 FOR TNT EXPRESS WORLDWIDE * ATTRIBUTES - REENTRANT/AMODE 31/RMODE ANY * ENTRY - INVOKED WITH PARM=XXXX * WHERE XXXX IS THE IMSID OF THE SUBSYSTEM TO BE DETECTED * RETURNS - RC0 FOR ACTIVE, RC1 FOR INACTIVE * IMSACTIV CSECT 00002400 IMSACTIV AMODE 31 00002500 IMSACTIV RMODE ANY 00002600 USING IMSACTIV,R15 00002700 BAKR R14,0 Save REGs on stack 00002800 B IDEND Around ID 00002900 DC AL1(IDEND-ID) 00003000 ID DC C'IMSACTIV &SYSDATE Paul Wells (ECSOFT)' 00003100 IDEND DS 0H 00003200 DROP R15 00003300 LR R12,R15 Set base reg 00003400 USING IMSACTIV,R12 Map base reg 00003500 L R2,0(,R1) GET PARAMETER STORAGE OBTAIN,LENGTH=WORKL getmain work area 00003800 LR R13,R1 SET WORK AREA REG 00003900 USING WORKA,R13 MAP WORK AREA 00004000 MVC 4(4,R13),=CL4'F1SA' indicate linkage stack 00004200 SR R3,R3 CLEAR ICM R3,B'0011',0(R2) GET LENGTH BZ ERRPARM ZERO FOR NO PARM CH R3,=H'4' LEN > 4 BH ERRPARM YES SO ERROR MVC WTOE(WTOML),WTOM MVC IMSID,=4C' ' INTIALISE BCTR R3,0 DECREMENT FOR EX EX R3,*+8 MOVE IN PARAMETER B *+10 BRANCH ROUND NEXT INS MVC IMSID(0),2(R2) *EXECUTED* * L R7,CVTPTR ---> CVT USING CVT,R7 MAP CVT L R7,CVTJESCT ---> JESCT USING JESCT,R7 MAP JESCT L R7,JESSSCT ---> FIRST SSCVT USING SSCT,R7 MAP SSCVT CHKIMS DS 0H CLC SSCTSNAM,IMSID OUR IMS ? BE GOTCHA YES ICM R7,15,SSCTSCTA NEXT SSCVT BZ NOLUCK THERE ISN'T ONE B CHKIMS LOOP GOTCHA DS 0H ST R7,R15SAVE UNPK UNPKR15,R15SAVE(5) TR R15HEX,HEXTAB-C'0' ICM R15,15,SSCTSSVT ACTIVE IMS INITIALISES BZ NOTACT IMS NOT ACTIVE MVC MSG1(MSG1L),MSG1M MVC MSG1IMS,IMSID MVC MSG1SSCT,R15HEX WTO TEXT=MSG1, * ROUTCDE=(11),DESC=(7), * MF=(E,WTOE) OI FLAGS,IMSACTIVE B RETURN DROP R7 NOLUCK DS 0H MVC MSG2(MSG2L),MSG2M MVC MSG2IMS,IMSID WTO TEXT=MSG2, * ROUTCDE=(11),DESC=(7), * MF=(E,WTOE) B RETURN NOTACT DS 0H MVC MSG3(MSG3L),MSG3M MVC MSG3IMS,IMSID MVC MSG3SSCT,R15HEX WTO TEXT=MSG3, * ROUTCDE=(11),DESC=(7), * MF=(E,WTOE) * RETURN DS 0H TM FLAGS,IMSACTIVE BO RET2 LA R15,1 B RET3 RET2 DS 0H SR R15,R15 RET3 DS 0H LR R2,R15 STORAGE RELEASE,LENGTH=WORKL,ADDR=(R13) FREE WORK AREA 00013600 DROP R13 00013700 LR R15,R2 PR * ERRPARM DS 0H WTO MF=(E,WTO1) ABEND 999,DUMP * LTORG HEXTAB DC C'0123456789ABCDEF' WTO1 WTO 'IMSACTIV-01E Erroneous or missing IMSID parameter', * ROUTCDE=(11),DESC=(7),MF=L WTOM WTO TEXT=0,ROUTCDE=(11),DESC=(7),MF=L WTOML EQU *-WTOM * MSG1M DC AL2(MSG1L-2) MSG1T DC C'IMSACTIV-00I IMS subsystem ' DS CL4 DC C' is active, SSCT=' DS CL8 MSG1L EQU *-MSG1M MSG2M DC AL2(MSG2L-2) MSG2T DC C'IMSACTIV-02I IMS subsystem ' DS CL4 DC C' inactive - not started since last IPL of OS/390' MSG2L EQU *-MSG2M MSG3M DC AL2(MSG3L-2) MSG3T DC C'IMSACTIV-03I IMS subsystem ' DS CL4 DC C' is not active, SSCT=' DS CL8 MSG3L EQU *-MSG3M * WORKA DSECT DS 18F R15SAVE DS F UNPKR15 DS 0XL9 R15HEX DS XL8,X FLAGS DS X IMSACTIVE EQU 1 IMSID DS CL4 WTOE WTO TEXT=0,ROUTCDE=(11),DESC=(7),MF=L * MSG1 DS AL2 DC C'IMSACTIV-00I IMS subsystem ' MSG1IMS DS CL4 DC C' is active, SSCT=' MSG1SSCT DS CL8 MSG2 DS AL2 DC C'IMSACTIV-02I IMS subsystem ' MSG2IMS DS CL4 DC C' inactive - not started since last IPL of OS/390' MSG3 DS AL2 DC C'IMSACTIV-03I IMS subsystem ' MSG3IMS DS CL4 DC C' is not active, SSCT=' MSG3SSCT DS CL8 * WORKL EQU *-WORKA * CVT DSECT=YES IEFJESCT IEFJSCVT YREGS END