DA$MPF10 TITLE '                   Real time User notification of WTO'          
***********************************************************************         
***                                                                             
**                                                                              
**    Module Name       = DA$MPF10                                              
**                                                                              
**    Descriptive Name  = Notify user in real time message that will            
**                        hang up his TSO session.                              
**                                                                              
**                        For example, IEF244I is nasty:                        
**                                                                              
**  IEF244I IBMUSER ISPFPROC TSOPROD - UNABLE TO ALLOCATE 1 UNIT(S              
**          AT LEAST 1 OFFLINE UNIT(S) NEEDED.                                  
**  IEF877E IBMUSER NEEDS 1 UNIT(S) 010                                         
**  FOR ISPFPROC TSOPROD ISP21100                                               
**  FOR VOLUME XYZ001                                                           
**  OFFLINE, NOT ACCESSIBLE                                                     
**  0120-0121 0123 0126-015F 0240-025F                                          
**  :                                                                           
**  IEF878I END OF IEF877E FOR IBMUSER ISPFPROC TSOPROD ISP21100                
**  03 IEF238D IBMUSER - REPLY DEVICE NAME OR 'CANCEL'.                         
**                                                                              
**    Reference         = GC28-1147 MVS-XA SPL: User Exits                      
**                                                                              
**    Activated by      = Specifed in active MPF member of Parmlib:             
**                        - SET MPF=xx                                          
**                        - WHERE xx IS A MEMBER IN PARMLIB:                    
**                          'SYS1.PARMLIB(MPFLSTxx)'                            
**                        - REFERENCE IN MPFLSTxx:                              
**                       IEF244I,SUP(NO),USEREXIT(DA$MPF10)                     
***                                                                             
***********************************************************************         
         EJECT                                                                  
         IEZVX100 ,                       WTO exit parameter list               
         PRINT NOGEN                                                            
         IHAPSA ,                         Prefixed Save Area                    
         IHAASCB ,                        Address Space Control Block           
         IHAASSB ,                        ASCB Secondard block                  
         IAZJSAB ,                        Job Schedular Address spc             
         YREGS ,                          Equate registers to R0-R15            
         PRINT GEN                                                              
*-Convert assembly date from SYSDATC format "YYYYMMDD" to "YYYY/MM/DD"          
         LCLC  &ASMDATE                                                         
&ASMDATE SETC  '&SYSDATC'(1,4).'/'.'&SYSDATC'(5,2).'/'.'&SYSDATC'(7,2)          
         EJECT                                                                  
***********************************************************************         
***                                                                             
**       Intialization                                                          
***                                                                             
***********************************************************************         
         SPACE 2                                                                
DA$MPF10 CSECT ,                                                                
DA$MPF10 AMODE 31                                                               
DA$MPF10 RMODE ANY                                                              
*                                                                               
** Create a standard O/S eyecatcher                                             
*                                                                               
EC       B     ECL(0,R15)               Bump past Eyecatcher                    
         DC    AL1(L'ECLIT)             Length of eyecatcher                    
ECLIT    DC    C'DA$MPF10 &ASMDATE &SYSTIME - Echo hang msg 2 TSO user'         
         DS    0H                       Ensure halfword alignment               
ECL      EQU   *-EC                                                             
*                                                                               
** Standard ESA entry housekeeping                                              
*                                                                               
         BAKR R14,0                     Save regs                               
         LAE   R12,0(R15,0)             Get base register                       
         USING DA$MPF10,R12             Get addressibility                      
         SAC  0                                                                 
         SYSSTATE ASCENV=P                                                      
         STORAGE OBTAIN,LENGTH=WORKDSL,LOC=BELOW Obtain storage                 
         LR   R13,R1                    Point to Save Area                      
         MVC  4(4,R13),=C'F1SA'         Indicate stack SA                       
         USING WORKDS,R13               Get addressibility to area              
*                                                                               
** Locate MPF exit parameter list and message area                              
*                                                                               
         EREG  R0,R1                    Restore regs 0 and 1                    
         L     R2,0(R1)                 Get CTXT Address                        
         ICM   R3,B'1111',CTXTTXPJ-CTXT(R2) Locate Major                        
         BZ    EXIT                     Shouldn't happen, but leave             
*                                                                               
** Determine if we should be trying to echo the message if this is              
** for a TSO user.                                                              
*                                                                               
         L     R4,PSAAOLD-PSA           -> ASCB                                 
         ICM   R4,B'1111',ASCBASSB-ASCB(R4) -> ASSB                             
         BZ    EXIT                                                             
         ICM   R4,B'1111',ASSBJSAB-ASSB(R4) -> JSAB                             
         BZ    EXIT                                                             
*                                                                               
         CLI   JSABJBID-JSAB(R4),C'T'   Is this for a TSO user?                 
         BNE   EXIT                                                             
         MVC   USERID(8),JSABUSID-JSAB(R4) Get userid                           
*                                                                               
** Tell user whats comming                                                      
*                                                                               
         LA    R15,MESSAGE              Locate message start                    
         MVC   0(MSG1L,R15),MSG1        Get message start                       
         LA    R0,MSG1L                 Set message length                      
         TPUT  MESSAGE,                 Issue message to user          @        
               (0),                       ..Length of message          @        
               EDIT,                      ..Remove extra stuff         @        
               NOWAIT,                    ..Return control immed.      @        
               NOHOLD,                    ..Return control immed.      @        
               NOBREAK,                   ..No precedence over input   @        
               HIGHP,                     ..This guy must get through  @        
               USERIDL=USERID             ..To this userid                      
*                                                                               
** Print a blank line, Remember that ALL parameters to TPUT must reside         
** below the line or your WILL get a S15D ABEND.                                
*                                                                               
         LA    R0,1                     Set message length                      
         MVI   MESSAGE,C' '             Insert a blank                          
         TPUT  MESSAGE,                 Issue message to user          @        
               (0),                       ..Length of message          @        
               EDIT,                      ..Remove extra stuff         @        
               NOWAIT,                    ..Return control immed.      @        
               NOHOLD,                    ..Return control immed.      @        
               NOBREAK,                   ..No precedence over input   @        
               HIGHP,                     ..This guy must get through  @        
               USERIDL=USERID             ..To this userid                      
*                                                                               
** Now echo the actual message                                                  
*                                                                               
         LA    R15,MESSAGE                Locate message start                  
         SLR   R14,R14                    Clear register                        
         ICM   R14,B'0011',CTXTTLEN-CTXTATTR(R3) Get length                     
         CH    R14,=H'128'                Larger than we want?                  
         BL    ECHO$LX                    No, continue                          
         LA    R14,128                    Yes, truncate to 128                  
ECHO$LX  DS    0H                                                               
         BCTR  R14,0                      Decrement for EX                      
         EX    R14,X$MSGM                 Move message to TPUT area             
         LA    R15,1(R14,R15)             Locate end                            
         LA    R1,MESSAGE                 Locate message start                  
         LR    R0,R15                     Locate message end                    
         SR    R0,R1                      Length = End - Begin                  
*                                                                               
         TPUT  MESSAGE,                   Send message                 @        
               (0),                       ..Length of message          @        
               EDIT,                      ..Remove extra stuff         @        
               NOWAIT,                    ..Return control immed.      @        
               NOHOLD,                    ..Return control immed.      @        
               NOBREAK,                   ..No precedence over input   @        
               HIGHP,                     ..This guy must get through  @        
               USERIDL=USERID             ..To this userid                      
*                                                                               
** Release resources and return to caller                                       
*                                                                               
EXIT     DS    0H                                                               
         LR    R2,R13                     Get storage address                   
         STORAGE RELEASE,LENGTH=WORKDSL,ADDR=(R2) Release storage               
         SLR   R15,R15                    Set return code                       
         PR                               Return to caller                      
         EJECT                                                                  
***********************************************************************         
***                                                                 ***         
**       Constants and executed instructions                         **         
***                                                                 ***         
***********************************************************************         
         SPACE 2                                                                
X$MSGM   MVC   0(0,R15),CTXTTMSG-CTXTATTR(R3)                                   
*                                                                               
MSG1     DC    C'DA$M101I Your TSO session '                                    
         DC    C'has the following action message:'                             
MSG1L    EQU   *-MSG1                                                           
*                                                                               
         LTORG ,                                                                
         DS    0D                                                               
*                                                                               
DA$MPF10_Length equ *-DA$MPF10             Trivia: length of pgm                
         EJECT                                                                  
***********************************************************************         
***                                                                 ***         
**       GETMAINed work area                                         **         
***                                                                 ***         
***********************************************************************         
         SPACE 2                                                                
         DS    0D                                                               
WORKDS   DSECT ,                                                                
         DS    18F                    Register Save Area                        
USERID   DS    CL8                    Userid to send message to                 
MESSAGE  DS    CL256                  Message to issue                          
         DS    0D                                                               
WORKDSL  EQU   *-WORKDS                                                         
         END                                                                    
