An assembler program that calls DFSMS callable services

*ASM XOPTS(CICS,NOEPILOG,SP)
*
*   A program that can be run as a CICS transaction to Read and Set
*   the BWO Indicators and BWO Recovery Point via DFSMS Callable
*   Services (IGWABWO).
*
*   Invoke the program via a CICS transaction as follows:
*
*   Rxxx 'data_set_name'
*   Sxxx 100 'data_set_name'
*
*   Where:
*    Rxxx and Sxxx are the names of the transactions that will invoke
*    this program. Specify Rxxx to read and Sxxx to set the BWO
*    attributes.
*    'data_set_name' is the fully-qualified name of your data set
*    100 is the value the BWO indicators will be set to.
*   The BWO Recovery Point time will be set to the current date and
*   time returned from the CICS ASKTIME function.
*
DFHEISTG DSECT
INDATA   DS   0CL53    Input data stream
*
* First character of tran id indicates transaction function
*
TRANFUNC DS   C        First char of tran id - S=SET R=READ
         DS   4C       Remainder of tran id and space
BWOC1    DS   C        First BWO indicator
BWOC2    DS   C        Second BWO indicator
BWOC3    DS   C        Third BWO indicator
         DS   C        Space
DSNAMES  DS   44C      Target data set name 1-44 chars
*
* 2 possible formats of input line, so overlay the definitions
*
         ORG  INDATA
         DS   5C       Tran id and space
DSNAMER  DS   44C      Target data set name 1-44 chars
         DS   4C       Filler
*
INLENGTH DS   H        Length of input data stream
*
* Parmlist for IGWABWO call
*
PARMLST  DS 10A
RETCODE  DS   F        Return code
REASON   DS   F        Reason
PROBDET  DS   D        Problem determination code
FUNC     DS   F        Function
READ     EQU  0           Read
SET      EQU  1           Set
DSNLEN   DS   F        Data set name length
DSN      DS   44C      Data set name
BWOFLAGS DS   03F      BWO indicator flags
         ORG  BWOFLAGS
BWOF1    DS   F           BWO indicator 1
BWOF2    DS   F           BWO indicator 2
BWOF3    DS   F           BWO indicator 3
BWOTIME  DS   D           BWO recovery point time
RESERVED DS   2D          Reserved
*
* Success message
*
SUCMSG   DS 0CL66         Define storage for success message
         DS 30C
DATEVAL  DS 8C            Date value from BWO recovery point
SUCMSG1  DS 8C            Message text
TIMEVAL  DS 8C            Time value from BWO recovery point
SUCMSG2  DS C             Message text
READMSG  DS 0CL11         If function = READ put out BWO flags
         DS 7C            Message text
BWOVAL1  DS C             BWO indicator 1
BWOVAL2  DS C             BWO indicator 2
BWOVAL3  DS C             BWO indicator 3
         DS C             Message text
*
DATETIME DS D             Current date and time value
*
RECOVPT  DS 0D            BWO recovery point
DTZERO   DS B                Date dword
DTCENTRY DS B
DTDATE   DS 5B
DTSIGN1  DS B
*
DTTIME   DS 6B               Time dword
DTTENTHS DS B
DTSIGN2  DS B
*
RECOVPTP DS 0D            Packed recovery point
DATEPACK DS F             Packed version of date
TIMEPACK DS F             Packed version of time
*
         DFHREGS
PROG     CSECT
PROG     AMODE 31
*
* Initialise INTO field for RECEIVE
*
         MVC  DSNAMER(48),BLANKS
         MVC  INLENGTH(2),INMAXLEN
*
         EXEC CICS RECEIVE INTO(INDATA) LENGTH(INLENGTH)
*
         CLI  TRANFUNC,C'S'       Set or Read call?
         BNE  PRGREAD
*
* Set up the parameters for a SET call
*
         SR   R4,R4
         LA   R4,SET(0)
         ST   R4,FUNC             Set function
         MVC  DSN(44),DSNAMES     Set data set name
         LH   R4,INLENGTH
         S    R4,PRELENS          Subtract tran id + space + BWO ind
         ST   R4,DSNLEN           Set data set name length
*
         EXEC CICS ASKTIME ABSTIME(DATETIME)
         EXEC CICS FORMATTIME ABSTIME(DATETIME) YYDDD(DTDATE)          *
              TIME(DTTIME)
*
         PACK KEYWORK(5),RECOVPT(9)   Packed date field
         MVC  DATEPACK(4),KEYWORK
         PACK KEYWORK(5),RECOVPT+8(9) Packed time field
         MVC  TIMEPACK(4),KEYWORK
         XC   RECOVPTP(1),RECOVPTP    Set century 0=1900, 1=2000
         OI   RECOVPTP+3,X'0F'        Set +ve sign for date
         OI   RECOVPTP+7,X'0F'        Set +ve sign for time
         MVC  BWOTIME(8),RECOVPTP     Set BWO recovery point time
*
         EXEC CICS SYNCPOINT
*
         MVC  BWOFLAGS(12),ZEROES
         LA   R4,1(0)
         CLI  BWOC1,C'0'
         BE   PRGBIT2
         ST   R4,BWOF1            Set BWO indicator 1 if required
PRGBIT2  DS   0H
         CLI  BWOC2,C'0'
         BE   PRGBIT3
         ST   R4,BWOF2            Set BWO indicator 2 if required
PRGBIT3  DS   0H
         CLI  BWOC3,C'0'
         BE   PRGCONT
         ST   R4,BWOF3            Set BWO indicator 3 if required
         B    PRGCONT
PRGREAD  DS   0H
         CLI  TRANFUNC,C'R'
         BNE  PRGABORT            If tran id not R or S then abort
*
* Set up the parameters for a read call
*
         SR   R4,R4
         LA   R4,READ(0)
         ST   R4,FUNC             Set function
         MVC  DSN(44),DSNAMER     Set data set name
         LH   R4,INLENGTH
         S    R4,PRELENR          Subtract tran id + space
         ST   R4,DSNLEN           Set data set name length
PRGCONT  DS   0H
*
* OK, our parameters are set up, so create the address list, and make
* the call
*
         LOAD EP=IGWABWO,ERRET=PRGABORT
         LR   R15,R0
         LA   R1,PARMLST          R1 -> parmlist
         LA   R4,RETCODE
         ST   R4,0(R1)            Pass addr of return code
         LA   R4,REASON
         ST   R4,4(R1)            Pass addr of reason code
         LA   R4,PROBDET
         ST   R4,8(R1)            Pass addr of problem determination
         LA   R4,FUNC
         ST   R4,12(R1)           Pass addr of function required
         LA   R4,DSNLEN
         ST   R4,16(R1)           Pass addr of data set name length
         LA   R4,DSN
         ST   R4,20(R1)           Pass addr of data set name
         LA   R4,SEL
         ST   R4,24(R1)           Pass addr of selection mask
         LA   R4,BWOFLAGS
         ST   R4,28(R1)           Pass addr of BWO flags
         LA   R4,BWOTIME
         ST   R4,32(R1)           Pass addr of BWO recovery point
         LA   R4,RESERVED
         ST   R4,36(R1)           Pass addr of reserved field
         BALR 14,15               Call IGWABWO
*
* Back from the call, check return code
*
         SR   R4,R4
         CL   R4,RETCODE          Check return code
         BNE  PRGABORT
*
* All OK, set up minimum success message, decide if we need more
*
         MVC  SUCMSG(38),SUCTXT       Set up message text
         MVC  SUCMSG1(8),SUCTXT1
         MVC  SUCMSG2(1),SUCTXT2
         UNPK KEYWORK(9),BWOTIME(5)   Make date printable
         TR   KEYWORK(8),HEXTAB-C'0'
         MVC  DATEVAL(8),KEYWORK
         UNPK KEYWORK(9),BWOTIME+4(5) Make time printable
         TR   KEYWORK(8),HEXTAB-C'0'
         MVC  TIMEVAL(8),KEYWORK
         CLI  TRANFUNC,C'S'           If READ then print BWO flags
         BNE  PRGREADO
*
* Got all the info we need, so put it out and exit
*
         EXEC CICS SEND TEXT FROM(SUCMSG) LENGTH(55) ERASE WAIT
*
         B    PRGEXIT
*
* It's a read so we also need the BWO flags for output
*
PRGREADO DS   0H
         MVC  READMSG(11),READTXT     Set up message text
         MVC  BWOVAL1,BWOF1+3
         OI   BWOVAL1,X'F0'           Set BWO indicator 1
         MVC  BWOVAL2,BWOF2+3
         OI   BWOVAL2,X'F0'           Set BWO indicator 2
         MVC  BWOVAL3,BWOF3+3
         OI   BWOVAL3,X'F0'           Set BWO indicator 3
*
* Now send the message
*
         EXEC CICS SEND TEXT FROM(SUCMSG) LENGTH(66) ERASE WAIT
*
PRGEXIT  DS 0H
         EXEC CICS RETURN
*
PRGABORT DS  0D
         EXEC CICS SEND TEXT FROM(FAILMSG) LENGTH(19) ERASE WAIT
*
         EXEC CICS RETURN
*
* Constant declarations
BLANKS   DC   48C' '
INMAXLEN DC   H'53'
ZEROES   DC   3F'0'
PRELENS  DC   F'9'
PRELENR  DC   F'5'
SUCTXT   DC   C'IGWABWO call completed Date = '
SUCTXT1  DC   C' Time = '
SUCTXT2  DC   C'.'
READTXT  DC   C' BWO =    .'
FAILMSG  DC   C'IGWABWO call failed'
KEYWORK  DC   CL9' '
HEXTAB   DC   C'0123456789ABCDEF'
*
* Constant for IGWABWO SELECT parameter
*
SEL      DC   F'3'        Interested in BWO flags & recov point
*             F'1'        Interested in BWO flags
*             F'2'        Interested in BWO recovery point
*             F'3'        Interested in BWO flags & recov point
         END PROG
[[ Contents Previous Page | Next Page Index ]]