DA$MPF02 TITLE '                  Answer WTOR with "W" '
***********************************************************************
***                                                                 ***
**                                                                   **
**    Module Name       = DA$MPF02                                   **
**                                                                   **
**    Descriptive Name  = Communications task user exit to answer    **
**                        WTORs with "W"                             **
**                                                                   **
**    Reference         = GC28-1147 MVS-XA SPL: User Exits           **
**                                                                   **
**    Activated by      = SET MFP=XX  (MVS operator command)         **
**                        - Where XX is a member in 'SYS1.PARMLIB':  **
**                          'SYS1.PARMLIB(MPFLSTXX)'                 **
**                        - REFERENCE IN MPFLSTXX:                   **
**                       ERB306D,SUP(NO),USEREXIT(DA$MPF02)          **
**                       CICS...,SUP(NO),USEREXIT(DA$MPF02)          **
***                                                                 ***
***********************************************************************
         EJECT
DA$MPF02 DA#ENTER 'WTO EXIT: REPLY W TO A WTOR',                       @
               AMODE=31,RMODE=ANY,                                     @
               RENT=YES,LV=WORKDSL,SP=230,GMTYPE=RU,LOC=BELOW
         USING WORKDS,R13
*
         L     R2,0(R1)                   Get CTXT Address
         L     R3,CTXTTXPJ-CTXT(R2)       Find Message attributes
         TM    CTXTTFB1-CTXTATTR(R3),CTXTTFWR  WTOR?
         BNO   EXIT                       No, ignore it
         EJECT
***********************************************************************
***                                                                 ***
**       Reply to the WTOR with a "W"                                **
***                                                                 ***
***********************************************************************
         SPACE 2
*
** Issue WTO message for an Audit Trail
*
         LA    R15,WTO                    Locate WTO work area
         MVC   0(C_WTOL,R15),C_WTO        Copy in WTO
         LA    R15,4(R15)                 Bump past header
         MVC   0(MSG1L,R15),MSG1          Move in message
         LA    R15,MSG1L(R15)             Bump past it
         MVC   0(2,R15),CTXTRPID-CTXT(R2) Get reply number
         WTO   ,MF=(E,WTO)                Issue the WTO
*
** Answer the WTOR: "R xx,W"
*
         LA    R14,REPLY                 Locate reply area
         XC    0(MGCRLTH,R14),0(R14)     Clear it to binary zeros
*
         LA    R15,MGCRTEXT-MGCRPL(R14)  Locate reply area
         MVC   0(2,R15),=C'R '           Move in Text
         LA    R15,2(R15)                Bump past it
         MVC   0(2,R15),CTXTRPID-CTXT(R2) Get reply number
         LA    R15,2(R15)                Bump past the number
         MVC   0(2,R15),=C',W'           Complete the message
         LA    R15,2(R15)                Bump past the suffix
*
         SR    R15,R14                   Length = end - Beginning
         STC   R15,MGCRLGTH-MGCRPL(R14)  Save length
*
         SLR   R0,R0                     Clear register
         MGCR  REPLY                     Issue reply
         EJECT
***********************************************************************
***                                                                 ***
**       Termination section                                         **
***                                                                 ***
***********************************************************************
         SPACE 2
EXIT     EQU   *
         DA#LEAVE SP=230,FMTYPE=RU
         EJECT
***********************************************************************
***                                                                 ***
**       Constants                                                   **
***                                                                 ***
***********************************************************************
         SPACE 2
MSG1     DC    C'DA$202I WTOR Answered with W, Reply='
MSG1L    EQU   *-MSG1
         DS    0D
C_WTO    WTO   '                                                       @
                                                                       @
                       ',                                              @
               ROUTCDE=(11,14),DESC=7,MCSFLAG=HRDCPY,MF=L
C_WTOL   EQU   *-C_WTO
*
** Literals
*
         LTORG ,
         DS    0D
         EJECT
***********************************************************************
***                                                                 ***
**       Getmained work area                                         **
***                                                                 ***
***********************************************************************
         SPACE 2
         DS    0D
WORKDS   DSECT ,
         DS    18F                    Register Save Area
REPLY    DS    XL(MGCRLTH)            Reply (operator command)
WTO      DS    XL(C_WTOL)             Write to operator
         DS    0D
WORKDSL  EQU   *-WORKDS
         EJECT
***********************************************************************
***                                                                 ***
**       Equates and DSECTs                                          **
***                                                                 ***
***********************************************************************
         SPACE 2
         REQUATE ,                    Equate our registers
         IEZVX100 ,                   WTO User WTO exit parm list
         IEZMGCR  DSECT=NO            SVC 34 Parameter List
         END