DA$MPF08 TITLE '                   Real time User notification of WTO'
***********************************************************************
***                                                                 ***
**                                                                   **
**    Module Name       = DA$MPF08                                   **
**                                                                   **
**    Descriptive Name  = Notify user in real time of a critical     **
**                        WTO message from a batch job that he       **
**                        submitted.                                 **
**                                                                   **
**    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:                   **
**                       IEF861I,SUP(NO),USEREXIT(DA$MPF08)          **
**                       IEF863I,SUP(NO),USEREXIT(DA$MPF08)          **
**                       IEF099I,SUP(NO),USEREXIT(DA$MPF08)          **
***                                                                 ***
***********************************************************************
         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
*
** Using the official ASMH/HLASM distinction trick, simulate the
** SYSVER and SYSDATEC variables of HLASM when assembled under
** ASMH...Taken from Gilbert Saint-flour's SHOWMVS.
*
         LCLA  &ASMH_HLASM
         AIF   (T'&ASMH_HLASM EQ 'N').ASMH1X
&SYSVER  SETC  'ASMH'
&SYSDATC SETC  '20'.'&SYSDATE'(7,2)'&SYSDATE'(1,2)'&SYSDATE'(4,2)
         AIF   ('&SYSDATC' LT '20500000').ASMH1X
&SYSDATC SETC  '19'.'&SYSDATE'(7,2)'&SYSDATE'(1,2)'&SYSDATE'(4,2)
.ASMH1X  ANOP
*-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$MPF08 CSECT ,
DA$MPF08 AMODE 31
DA$MPF08 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$MPF08 &ASMDATE &SYSTIME - Echo message to 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$MPF08,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 to the TSO
** user:
**
** - Find the JSAB, there will be none for non-JES managed addr spaces
** - Ensure that we are being invoked for a batch job
** - If we have a userid, save it for later else leave
*
         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
*
         CLC   JSABJBID-JSAB(3,R4),=C'JOB' Is this a batch job?
         BNE   EXIT
         CLI   JSABUSID-JSAB(R4),C' '   Looks valid?
         BE    EXIT
         CLI   JSABUSID-JSAB(R4),0      Looks valid?
         BE    EXIT
*
         MVC   USERID(8),JSABUSID-JSAB(R4) Get notify user
*
** For some messages, skip the warning and blank line
**
** For example, I've always seen these three messages come together,
** so we will only print our warning message and blank line for IEF861I
**
**  IEF861I FOLLOWING RESERVED DATA SET NAMES UNAVAILABLE TO IBMUSERZ
**  IEF863I DSN = IBMUSER.DAVE.LOAD IBMUSERZ
** *IEF099I JOB IBMUSERZ WAITING FOR DATA SETS
*
         CLC   CTXTTMSG-CTXTATTR(7,R3),=C'IEF863I'
         BE    ECHO
         CLC   CTXTTMSG-CTXTATTR(7,R3),=C'IEF099I'
         BE    ECHO
*
** Tell user whats comming
*
         LA    R15,MESSAGE              Locate message start
         MVC   0(MSG1L,R15),MSG1        Get message start
         MVC   MSG1NAME-MSG1(L'JSABJBNM,R15),JSABJBNM-JSAB(R4)
         MVC   MSG1ID-MSG1(L'JSABJBID,R15),JSABJBID-JSAB(R4)
         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
         LTR   R15,R15                    Maybe not logged on...
         BNZ   EXIT
*
** 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
*
ECHO     DS    0H
         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$M81I Batch job '
MSG1NAME DC    CL8'jobname ',C' '
MSG1ID   DC    CL8'JOBxxxxx',C' has the following action message:'
MSG1L    EQU   *-MSG1
         LTORG ,
         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
