*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 ]]