DA$MPF01 TITLE '                     Append the date to some messages'
***********************************************************************
***                                                                 ***
**                                                                   **
**    Module Name       = DA$MPF01                                   **
**                                                                   **
**    Descriptive Name  = Append the current date to some messages.  **
**                                                                   **
**    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:                   **
**                       IEF403I,SUP(NO),USEREXIT(DA$MPF01)          **
**                       IEF404I,SUP(NO),USEREXIT(DA$MPF01)          **
**                      $HASP373,SUP(NO),USEREXIT(DA$MPF01)          **
**                      $HASP395,SUP(NO),USEREXIT(DA$MPF01)          **
**                                                                   **
** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - **
**                                                                   **
**    Change:                                                        **
**                                                                   **
**      IEF403I IBMUSERP - STARTED - TIME=16.38.17                   **
**      IEF404I IBMUSERP - ENDED - TIME=16.38.23                     **
**                                                                   **
**    To:                                                            **
**                                                                   **
**      IEF403I IBMUSERP - STARTED - TIME=16.38.17 - 25-FEB-1997     **
**      IEF404I IBMUSERP - ENDED - TIME=16.38.23 - 25-FEB-1997       **
**                                                                   **
** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - **
**                                                                   **
**  If "MONITOR JOBNAMES" is not active, then we update these as     **
**  well:                                                            **
**                                                                   **
**      $HASP373 IBMUSERZ STARTED - INIT    1 - CLASS U - SYS DA$5   **
**      $HASP395 IBMUSERZ ENDED                                      **
**                                                                   **
***                                                                 ***
***********************************************************************
         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$MPF01 CSECT ,
DA$MPF01 AMODE 31
DA$MPF01 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$MPF01 &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$MPF01,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
*
** See we want to touch these guys
*
         TM    CTXTMTY1-CTXT(R2),CTXTMTYA  Monitor jobnames active?
         BNO   TEST$X                   No, hit the JES2 start/stop
         CLC   CTXTTMSG-CTXTATTR(7,R3),=C'$HASP373'
         BE    EXIT
         CLC   CTXTTMSG-CTXTATTR(7,R3),=C'$HASP395'
         BE    EXIT
TEST$X   DS    0H
*
** Append the current date onto the end of the message
*
         TIME  BIN                      Get current time and date
         STM   R0,R1,DOUBLE             Save time and date
         LA    R15,CTXTTMSG-CTXTATTR(R3) Locate to start of message
         SLR   R14,R14                  Clear register
         ICM   R14,B'0011',CTXTTLEN-CTXTATTR(R3) Get length
         AR    R15,R14
         MVC   0(3,R15),=C' - '
         LA    R15,3(R15)
         LM    R0,R1,DOUBLE             Save time and date
         BAS   R14,CONVERT_TO_TODSTRING Convert the time and date
         LA    R14,CTXTTMSG-CTXTATTR(R3) Locate to start of message
         SR    R15,R14
         STCM  R15,B'0011',CTXTTLEN-CTXTATTR(R3) Set new length
         OI    CTXTRFB1-CTXT(R2),CTXTRCMT  Say we changed it
*
** 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
***********************************************************************
***                                                                 ***
** Convert input binary time and packed decimal julian date to a     **
** fancy output string of "dd-mmm-ccyy hh:mm:ss pm"                  **
**                                                                   **
** Input: R0 - Time in binary                                        **
**        R1 - Date in packed decimal                                **
**        R15 - points to the output area                            **
**                                                                   **
** Output: the area in R15 will be filled in and R15 updated with    **
**         address just past the filled in area.                     **
***                                                                 ***
***********************************************************************
         SPACE 2
CONVERT_TO_TODSTRING DS 0H
         ST    R15,CTT_OUT                Save output area address
         ST    R14,CTT_RA                 Save return address
*
** Get the input time (binary) and date (packed decimal) and convert
** it to a STCK TOD format
*
         LA    R14,CTT_CIN                Locate routine Time/Date area
         XC    0(CTAREAL,R14),0(R14)      Clear to binary zeros
         STCM  R0,B'1111',CTAREA_TIME-CTAREA(R14) Save Time
         STCM  R1,B'1111',CTAREA_DATE-CTAREA(R14) Save Date
*
         CONVTOD CONVVAL=CTT_CIN,         Convert this Time/Date       @
               TODVAL=CTT_TOD,            ..To TOD format              @
               TIMETYPE=BIN,              ..Time is binary format      @
               DATETYPE=YYDDD,            ..Date is julian 0CYYDDDf    @
               MF=(E,PARMLIST)
         LTR   R15,R15                    CONVTOD worked?
         BNZ   CTT$JUL                    Failed, do primitive way
*
** Convert the TOD stamp into time and date formats
*
         STCKCONV STCKVAL=CTT_TOD,        Convert this TOD Stamp       @
               CONVVAL=CTT_SOUT,          ..Into these date/time areas @
               TIMETYPE=DEC,              ..Output time format         @
               DATETYPE=DDMMYYYY,         ..Output Date format         @
               MF=(E,PARMLIST)
         LTR   R15,R15                    CONVTOD worked?
         BNZ   CTT$JUL                    Failed, do primitive way
*
** Format the date
*
         L     R15,CTT_OUT                Locate output area
*                               D  D  -  M  M  -  C  C  Y  Y
         MVC   0(11,R15),=X'40,20,20,60,20,20,60,20,20,20,20'
         ED    0(11,R15),CTT_SOUT+8       Edit it to " dd-mm-ccyy"
         MVC   0(3,R15),1(R15)            Move "dd-" over "dd-...-ccyy"
         PACK  DOUBLE(8),4(2,R15)         Get month in decimal
         CVB   R14,DOUBLE                 Convert to binary
         BCTR  R14,0                      Make relative to zero
         MH    R14,=H'3'                  Multiply for month offset
         LA    R1,=C'JanFebMarAprMayJunJulAugSepOctNovDec'
         AR    R1,R14                     Locate month entry
         MVC   3(3,R15),0(R1)             Move "mmm" to "dd-mmm-ccyy"
         OI    0(R15),X'F0'               Ensure leading zero
         LA    R15,11(R15)                Bump past date
*
         MVC   0(3,R15),=C' - '
         LA    R15,3(R15)
CTT$JUL  DS    0H
         UNPK  DOUBLE2(9),#CTTPMD(5)           *
         MVZ   DOUBLE2(8),=8X'00'              ** Hex convert
         TR    DOUBLE2(8),=C'0123456789ABCDEF' *
*
         CLI   #CTTPMD,0                  Century = 19xx?
         BE    CTT$Y19
         CLI   #CTTPMD,1                  Century = 20xx?
         BE    CTT$Y20
         CLI   #CTTPMD,2                  Century = 21xx?
         BNE   CTT$YX
         MVC   0(2,R15),=C'22'
         LA    R15,2(R15)
         B     CTT$YX
CTT$Y19  DS    0H
         MVC   0(2,R15),=C'19'
         LA    R15,2(R15)
         B     CTT$YX
CTT$Y20  DS    0H
         MVC   0(2,R15),=C'20'
         LA    R15,2(R15)
CTT$YX   DS    0H
         MVC   0(2,R15),DOUBLE2+2         Get yy from "0cyydddf"
         MVI   2(R15),C'.'                Insert dot
         MVC   3(3,R15),DOUBLE2+4         Get ddd from "0cyydddf"
         LA    R15,6(R15)                 Locate past "yy.ddd'
         L     R14,CTT_RA                 Get return address
         BSM   0,R14                      Return to caller
#CTTPMD  EQU   CTT_CIN+(CTAREA_DATE-CTAREA)    Generate offset
         EJECT
***********************************************************************
***                                                                 ***
**       Constants                                                   **
***                                                                 ***
***********************************************************************
         SPACE 2
         LTORG ,
         EJECT
***********************************************************************
***                                                                 ***
**       GETMAINed work area                                         **
***                                                                 ***
***********************************************************************
         SPACE 2
         DS    0D
WORKDS   DSECT ,
         DS    18F                    Register Save Area
DOUBLE   DS    D
DOUBLE2  DS    2D
PARMLIST DS    10F
         DS    0D
CTT_TOD  DS    D                        ..TOD (STCK) area
CTT_OUT  DS    F                        ..Output area address
CTT_RA   DS    F                        ..Return address
CTT_CIN  DS    XL(CTAREAL)              ..CONVTOD input area
CTT_SOUT DS    XL16                     ..STCKCON output area
         DS    0D
WORKDSL  EQU   *-WORKDS
*
** Map CONVTOD area
*
CTAREA          DSECT ,
CTAREA_TIME     DS    XL4
                DS    XL4
CTAREA_DATE     DS    XL4
                DS    XL4
CTAREAL         EQU   *-CTAREA
         END
