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