This sample access program reads the volume record of volume V00001 from the Media Database using high level API, and issues a message about the status of this volume (that is, SCRATCH, ACTIVE, or NOT FOUND IN MDB). This sample also includes an example for the Media Database error handling routine.
Note: The code shown below is only an example. Do not use it without appropriate modification.
Figure 94 Example of Macro Usage and JCL for High Level API
**********************************************************************
* CTTSAM2 *
* *
* *
* FUNCTION: SAMPLE PROGRAM TO DEMONSTRATE ACCESS TO Control‑M/TAPE *
* MEDIA DATABASE (MDB) USING THE HIGH LEVEL API. *
* THIS PROGRAM READS THE MDB VOLUME RECORD OF A CERTAIN *
* VOLUME, (IN THIS SAMPLE: V00001) AND ISSUES A MESSAGE *
* ABOUT THE VOLUME'S STATUS: ACTIVE OR SCRATCH. *
* IN THIS CODE YOU WILL ALSO FIND AN EXAMPLE FOR AN *
* MDB ERROR HANDLING ROUTINE THAT SHOULD BE CALLED BY *
* ANY PROGRAM THAT USES THE HIGH LEVEL API. *
* *
* DD CARDS: NONE (THE HIGH LEVEL API USES THE Control‑M/TAPE REAL *
* TIME ENVIRONMENT FILES). *
* *
* DISCLAIMER: THIS SAMPLE PROGRAM IS PROVIDED ON AN AS IS BASIS, *
* WITHOUT ANY WARRANTY, EITHER EXPRESS OR IMPLIED *
* *
* REGISTERS: R13 ‑ BASE *
* R4 ‑ MDB VOLUME RECORD (MAPPED BY CTTDVL) *
* R9 ‑ CTTACCDB PARMS (MAPPED BY CTTADBP) *
* *
* ATTRIBUTES: AMODE 31 *
* RMODE 24 *
* *
* TO COMPILE, LINK AND RUN THE PROGRAM : *
* *
* //CTTSAM2 JOB ... *
* // JCLLIB ORDER=IOA.PROCLIB <<<----- CHANGE *
* // INCLUDE MEMBER=IOASET *
* //ASM EXEC IOAASM *
* //C.SYSIN DD DISP=SHR,DSN=&ILPREFA..SAMPLE(CTTSAM2) *
* //L.SYSLMOD DD DISP=SHR,DSN=YOUR.LOAD.LIBRARY <<<----- CHANGE *
* //L.SYSIN DD * *
* MODE RMODE(24),AMODE(31) *
* ENTRY CTTSAM2 *
* NAME CTTSAM2(R) *
* //* *
* //RUN EXEC PGM=CTTSAM2,COND=(0,NE),REGION=60M *
* //STEPLIB DD DISP=SHR,DSN=YOUR.LOAD.LIBRARY <<<----- CHANGE *
* // DD DISP=SHR,DSN=&STEPLIB *
* //DARPTVOL DD SYSOUT=* *
* //DARPTDSN DD SYSOUT=* *
* // *
* *
**********************************************************************
EJECT ,
CTTSAM2 AMODE 31
CTTSAM2 RMODE 24
CTTSAM2 CSECT HIGH LEVEL API SAMPLE
BEGIN *,EQUR=YES
SPACE 1
LA R9,ADBPARMS R9‑>> CTTADB PARMS
USING ADBP,R9
XC FLAG,FLAG INIT INTERNAL FLAG
SPACE 1
*********************************************************************
* PERFORM INITIALIZATION REQUIRED usingusing HIGH LEVEL API: START COMMAND *
*********************************************************************
SPACE 1
CTTACCDB START,PARMS=ADBPARMS INITIALIZATION
CTTCHKDB ERR=ADBERROR,PARMS=ADBPARMS CHECK START OPERATION
SPACE 1
OI FLAG,$OPENED MARK: MDB IS OPENED
SPACE 1
*********************************************************************
* READ MDB VOLUME RECORD OF VOLUME: V00001 usingusing READVOL COMMAND *
*********************************************************************
SPACE 1
MVC VOL(6),=CL6'V00001' VOLSER TO READ
SPACE 1
CTTACCDB READVOL,REC=VOLREC,VOL=VOL,PARMS=ADBPARMS
CTTCHKDB ERR=RVOLERR,PARMS=ADBPARMS
SPACE 1
NI FLAG,X'FF'‑$OPENED MARK: MDB IS NOT OPENED
SPACE 1
*********************************************************************
* PERFORM CLEANUP REQUIRED using HIGH LEVEL API: END COMMAND *
*********************************************************************
SPACE 1
CTTACCDB END,PARMS=ADBPARMS
CTTCHKDB ERR=ADBERROR,PARMS=ADBPARMS
SPACE 1
*********************************************************************
* ISSUE A MESSAGE ACCORDING TO VOLUME'S STATUS: ACTIVE OR SCRATCH *
*********************************************************************
SPACE 1
LA R4,VOLREC R4‑>>MDB VOL RECORD
USING DVL,R4
TM DVLSTAT,DVLSACT AN ACTIVE VOLUME ?
BNO WTOSCR ..N, GO ISSUE: SCRATCH
SPACE 1
WTO 'VOLUME V00001 IS ACTIVE' VOLUME IS ACTIVE
B EXIT
SPACE 1
WTOSCR DS 0H VOLUME IS SCRATCH
WTO 'VOLUME V00001 IS SCRATCH'
SPACE 1
B EXIT
DROP R4 WAS MDB VOL RECORD
SPACE 1
*********************************************************************
* MDB ERROR HANDLING ROUTINE ‑ FOR READVOL FUNCTION *
*********************************************************************
SPACE 1
RVOLERR DS 0H READVOL ERROR
L R15,ADBPRC R15 ‑ CTTADB RC
C R15,=F'16' A CTTIOS FAILURE ?
BNE ADBERROR ..N, GO ISSUE ERROR MSG
SPACE 1
L R15,ADBPIRC R15 ‑ RC OF CTTIOS
C R15,=F'4' VOLUME NOT FOUND ?
BNE ADBERROR ..N, GO ISSUE ERROR MSG
SPACE 1
WTO 'VOLUME V00001 NOT FOUND IN MEDIA DATABASE'
SPACE 1
NI FLAG,X'FF'‑$OPENED
CTTACCDB END,PARMS=ADBPARMS TRY TO PERFORM CLEANUP
CTTCHKDB ERR=ADBERROR,PARMS=ADBPARMS
SPACE 1
B EXIT NO OTHER UPDATES
SPACE 1
*********************************************************************
* MDB ERROR HANDLING ROUTINE ‑ FOR START/END FUNCTIONS *
*********************************************************************
ADBERROR DS 0H
MVC MSG1FUNC(8),ADBPFUNC CTTACCDB FUNCTION FOR MESSAGE
MVC MSG1VOL(6),=CL6'V00001' VOLSER FOR MESSAGE
L R3,ADBPRC CONVERT
CVD R3,DW ..CTTACCDB
UNPK MSG1RC(3),DW+6(2) ..RETURN‑CODE
OI MSG1RC+2,X'F0' ..FOR MESSAGE
SPACE 1
MVC WTO1+10(MSG1LEN),MSG1 MOVE MESSAGE TO BE WTO'ED
WTO1 WTO ' +
',ROUTCDE=11
MVC MSG2FUNC(8),ADBPIOPR LAST CTTIOS FUNCTION FOR MSG
L R3,ADBPIRC CONVERT
CVD R3,DW ..LAST CTTIOS
UNPK MSG2RC(3),DW+6(2) .. RETURN‑CODE
OI MSG2RC+2,X'F0' .. FOR MESSAGE
SPACE 1
L R3,ADBPIRSN CONVERT
CVD R3,DW ..LAST CTTIOS
UNPK MSG2RSN(5),DW+5(3) .. REASON‑CODE
OI MSG2RSN+4,X'F0' .. FOR MESSAGE
SPACE 1
MVC WTO2+10(MSG2LEN),MSG2 MOVE MESSAGE TO BE WTO'ED
WTO2 WTO ' +
',ROUTCDE=11
SPACE 1
B EXIT
SPACE 1
EXIT DS 0H
TM FLAG,$OPENED IS MDB STILL OPENED ?
BNO SKIPEND ..N, SKIP END
SPACE 1
CTTACCDB END,PARMS=ADBPARMS
SPACE 1
SKIPEND DS 0H
BRTRN 0
SPACE 1
*********************************************************************
* WORK AREAS *
*********************************************************************
DW DS D DOUBLE WORD
*
FLAG DS X INTERNAL FLAG
$OPENED EQU X'80' MARK: MDB IS OPENED
*
MSG1 DS 0C 1ST ERROR MESSAGE
DC C'CTTACCDB FUNCTION: '
MSG1FUNC DS CL8
DC C' FOR VOLUME: 'MSG1VOL DS CL6
DC C' FAILED. RC: '
MSG1RC DS CL3
MSG1LEN EQU *‑MSG1
*
MSG2 DS 0C 2ND ERROR MESSAGE
DC C'LAST CTTIOS FUNCTION: '
MSG2FUNC DS CL8
DC C' RC: '
MSG2RC DS CL3
DC C' REASON: '
MSG2RSN DS CL5
MSG2LEN EQU *‑MSG2
*
VOL DS CL6 VOLUME SERIAL NUMEBR TO READ
VOLREC DS (DVLLEN)X MDB RECORD BUFFER
*
ADBPARMS DS (ADBPLEN)X CTTACCDB WORK PARMS
*********************************************************************
* MAPPING DSECTS *
*********************************************************************
CTTDBTP , CTTIOS PARMS
CTTADBP , CTTACCDB PARMS
CTTDVL , MDB VOLUME RECORD MAP
END
Rule Search API
Parent Topic |