         PRINT NOGEN                                                            
MQVER    TITLE 'MQVER - Display MQ subsystems'                                  
MQVER    AMODE 31                                                               
MQVER    RMODE ANY                                                              
MQVER    CSECT                                                                  
         BAKR  R14,R0                 Linkage stack                             
         LAE   R12,0(R15,0)           Set R12 as base register ...              
         USING MQVER,R12              ... and address it                        
         STM   14,12,12(13)           Save callers registers                    
         LR    15,13                  Load R15 with there area                  
         BAS   13,PRGMSAVE+END_EYECATCHER Skip around eyecatcher                
PRGMSAVE DC    18F'0'                                                           
*                                                                               
**       Assembly Information Follows                                           
*                                                                               
ASLCSECT DC    CL8'MQVER   '          ****  CSECT name   ****                   
ASLMODV  DC    CL8'2.1'               ****  Version Info ****                   
         DC    CL24'WRITTEN BY K E FERGUSON '                                   
         DC    CL24'COPYRIGHT - Freeware    '                                   
ASLASMD  DC    CL8'&sysdate'          **** Assemble date ****                   
ASLASMT  DC    CL6'&systime'          **** Assembly time ****                   
END_EYECATCHER EQU *-PRGMSAVE                                                   
         ST    13,8(15)               Setup save area crossing                  
         ST    15,4(13)               Setup save area crossing                  
         L     R5,CVTPTR              Point to CVT ...                          
         USING CVT,R5                 ... and establish addressability          
         L     R11,CVTJESCT           Get CVT entry for JESCT ...               
         USING JESCT,R11              ... and address it                        
         DROP  R5                     Finished with CVT                         
         L     R5,JESSSCT             Get SSCT address ...                      
         USING SSCT,R5                ... and establish addressability          
         WTO   '  Status Name - Type Version PTF Lvl Level'                     
SSCT_Loop DS   0H                                                               
         CLC   SSCTID,=C'SSCT'        Make sure we point to SSCT                
         BNE   Logic_error            Error out if we don't                     
         L     R6,SSCTSUSE            Load user area                            
         LTR   R6,R6                  Do we have one?                           
         BZ    Next_SSCT              No - branch to step up SSCT               
         TM    SSCTSUSE,b'10000000'   Is the SSCTSUSE usable?                   
         BO    Next_SSCT              No - branch to step up SSCT               
         CLC   4(4,R6),=C'ERLY'       Is it early load code?                    
         BNE   Next_SSCT              No - branch to step up SSCT               
         CLC   84(8,R6),=C'CSQ3EPX '  Is it MQ Series early load?               
         BNE   Next_SSCT              No - branch to step up SSCT               
         MVC   Wtp_MSQ+17(4),SSCTSNAM Move name to Write to Op                  
         MVC   Wtp_MSQ+8(8),=C'  Active'                                        
         L     R7,SSCTSSVT            Get the SSVT address                      
         L     R3,4(R7)                                                         
         LTR   R3,R3                  Do we have one?                           
         BNZ   SubSys_Active          Yes - Subsystem is active                 
         MVC   Wtp_MSQ+8(8),=C'Inactive'                                        
SubSys_Active DS  0H                                                            
         L     R7,128(R6)             Get the RIB address                       
         MVC   Wtp_MSQ+35(8),25(R7)   Move version number to WTO                
         MVC   Wtp_MSQ+37(7),60(R7)   Move last PTF to WTO                      
         XR    R8,R8                  Clear R8                                  
         ICM   R8,b'0001',33(R7)      Load first byte                           
         BAS   R10,Convert            Convert it to printable ...               
         MVC   Wtp_MSQ+45(3),ASLSAV2+5 ... and move it to WTO                   
         XR    R8,R8                  Clear R8                                  
         ICM   R8,b'0001',34(R7)      Load second byte                          
         BAS   R10,Convert            Convert it to printable ...               
         MVC   Wtp_MSQ+49(3),ASLSAV2+5 ... and move it to WTO                   
Wtp_MSQ  WTO   '  Active xxxx -  MQ         xxxxxxxx 111.222      '             
Next_SSCT DS   0H                                                               
         L     R5,SSCTSCTA            Next SSCT                                 
         LTR   R5,R5                  Do we have one?                           
         BNZ   SSCT_Loop              Yes - Process it                          
         XR    R15,R15                Set condition code to 0 ...               
         PR                           ... and exit program                      
Logic_Error DS  0H                                                              
         MVC   Wtp_Logic+8(4),SSCTID  Put what we found into WTO ...            
Wtp_Logic WTO  'xxxx found where SSCT should be'  ... issue WTO ...             
DUMPER   EX    R15,DUMPER             ...and then ABEND S0C3                    
Convert  Equ   *                                                                
         ST    R8,ASLSAV1             Save passed number in R8                  
         LA    R8,ASLSAV1             Get the save area address                 
         UNPK  ASLSAV2+0(9),0(5,R8)   Convert it to printable                   
         NC    ASLSAV2+0(8),=8X'0F'   Force in pack digit...                    
         TR    ASLSAV2+0(8),=CL16'0123456789ABCDEF' ..and convert it            
         BR    R10                                                              
ASLSAV1  DS    F                      Save area for supplied number             
ASLSAV2  DS    CL9                    Temporary save area for convert           
***********************************************************************         
*                         REGISTER EQUATES                            *         
***********************************************************************         
R0       EQU   0                                                      *         
R1       EQU   1                                                      *         
R2       EQU   2                                                      *         
R3       EQU   3                                                      *         
R4       EQU   4                                                      *         
R5       EQU   5                                                      *         
R6       EQU   6                                                      *         
R7       EQU   7                                                      *         
R8       EQU   8                       R E G E Q S                    *         
R9       EQU   9                                                      *         
R10      EQU   10      EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER      *         
R11      EQU   11       TO MAKE THE USE OF REGISTER OPERANDS IN       *         
R12      EQU   12       INSTRUCTIONS SELF EXPLANITORY.THIS ALSO       *         
R13      EQU   13         CREATES ENTRIES IN CROSS REFERENCE.         *         
R14      EQU   14                                                     *         
R15      EQU   15                                                     *         
***********************************************************************         
         LTORG                                                                  
         IEFJSCVT                                                               
         CVT   DSECT=YES                                                        
         IEFJESCT TYPE=DSECT                                                    
         END MQVER                                                              
         PUNCH ' MODE AMODE(31)'   Binder AMODE statement.                      
         PUNCH ' MODE RMODE(ANY)'  Binder RMODE statement.                      
         PUNCH ' ENTRY MQVER'      Binder Module entry point.                   
         PUNCH ' NAME MQVER(R)'    BINDER MODULE NAME.                          
         END ,                     END OF BINDER INPUT.                         

