Functions
This is a sample CA IDMS VSAM Transparency user exit written in COBOL. It is functionally equivalent to the sample Assembler exit located later in this section. The source code for this program is provided on the installation media with CA IDMS VSAM Transparency (member name ESVSXITC).
This exit allows you to convert the VSAM structure into the CA IDMS/DB structure.
VSAM Structure (Variable Length KSDS Record)
CA IDMS Structure
The user exit must navigate the database and build the record that the VSAM application program is expecting.
Functions as a Before Exit
This exit is invoked both before and after any DML processing. As a before exit, it performs the following functions:
Functions as an After Exit
As an after exit, it performs the following functions:
Note: The POLICY record is the record defined in the FMT.
Sample COBOL Exit Program
IDENTIFICATION DIVISION.
PROGRAM-ID. ESVSXITC.
ENVIRONMENT DIVISION.
IDMS-CONTROL SECTION.
PROTOCOL. MODE IS BATCH DEBUG
IDMS-RECORDS MANUAL.
*
INPUT-OUTPUT SECTION.
*
DATA DIVISION.
*
SCHEMA SECTION.
DB EXITSUB WITHIN EXITCHEM.
*
WORKING-STORAGE SECTION.
*
01 FILLER PIC X(8) VALUE 'WS START'.
*
COPY IDMS SUBSCHEMA-NAMES.
COPY IDMS SUBSCHEMA-RECORDS.
*
01 INDEX-1 PIC 9(1) VALUE 0.
*
LINKAGE SECTION.
01 USER-EXIT-CONTROL-BLOCK.
05 EXB-ID PIC X(4).
05 EXB-USER PIC S9(8) COMP.
05 EXB-ADDR-RWA PIC S9(8) COMP.
05 EXB-ADDR-STACK PIC S9(8) COMP.
05 EXB-ADDR-SSC PIC S9(8) COMP.
05 FILLER PIC S9(8) COMP.
05 EXB-ADDR-RPL PIC S9(8) COMP.
05 EXB-ADDR-ARGUMENT PIC S9(8) COMP.
05 EXB-ADDR-RECORD-BUFFER PIC S9(8) COMP.
05 EXB-MAX-KEY-LENGTH PIC S9(4) COMP.
05 EXB-REC-BUFFER-LENGTH PIC S9(4) COMP.
05 EXB-VSAM-REC-LENGTH PIC S9(4) COMP.
05 EXB-VSAM-KEY-LENGTH PIC S9(4) COMP.
05 EXB-VSAM-KEY-POSITION PIC S9(4) COMP.
05 EXB-FMT-NAME PIC X(8).
05 EXB-DD-NAME PIC X(8).
05 EXB-IDMS-REC-NAME PIC X(16).
05 EXB-IDMS-SET-NAME PIC X(16).
05 EXB-RESERVED PIC S9(2) COMP.
05 EXB-FEEDBACK PIC X(4).
05 EXB-RPL-REQUEST-TYPE PIC X(6).
88 GET-REQUEST VALUE 'GET'.
88 PUT-REQUEST VALUE 'PUT'.
88 POINT-REQUEST VALUE 'POINT'.
88 ENDREQ-REQUEST VALUE 'ENDREQ'.
88 ERASE-REQUEST VALUE 'ERASE'.
05 EXB-RPL-OPTION-1.
10 EXB-DIRECT PIC X.
88 DIRECT-REQUEST VALUE 'X'.
10 EXB-SEQUENTIAL PIC X.
88 SEQUENTIAL-REQUEST VALUE 'X'.
10 EXB-SKIP PIC X.
88 SKIP-REQUEST VALUE 'X'.
10 EXB-KEY-GT-EQ PIC X.
88 KEY-GT-EQ-REQUEST VALUE 'X'.
10 EXB-GENERIC PIC X.
88 GENERIC-REQUEST VALUE 'X'.
10 FILLER PIC X(3).
05 EXB-RPL-OPTION-2.
10 EXB-KEYED-ACCESS PIC X.
88 KEYED-ACCESS VALUE 'X'.
10 EXB-ADDRESS-ACCESS PIC X.
88 ADDRESS-ACCESS VALUE 'X'.
10 EXB-BACKWARD-ACCESS PIC X.
88 BACKWARD-ACCESS VALUE 'X'.
10 EXB-LAST-REC-ACCESS PIC X.
88 LAST-REC-ACCESS VALUE 'X'.
10 EXB-UPDATE-ACCESS PIC X.
88 UPDATE-ACCESS VALUE 'X'.
10 EXB-SET-POSITION PIC X.
88 SET-POSITION VALUE 'X'.
10 FILLER PIC X(2).
05 EXB-VSAM-FILE-TYPE.
10 EXB-KSDS PIC X.
88 KSDS VALUE 'X'.
10 EXB-PATH PIC X.
88 PATH VALUE 'X'.
10 EXB-RRDS PIC X.
88 RRDS VALUE 'X'.
10 EXB-ESDS PIC X.
88 ESDS VALUE 'X'.
10 EXB-BASE-CLUS-ESDS PIC X.
88 BASE-CLUS-ESDS VALUE 'X'.
10 EXB-SET-DEFINED PIC X.
88 SET-DEFINED VALUE 'X'.
10 EXB-NATIVE-VSAM PIC X.
88 NATIVE-VSAM VALUE 'X'.
10 FILLER PIC X.
05 EXB-EXIT-FLAGS.
10 EXB-EXIT-TYPE PIC X.
88 BEFORE-EXIT VALUE 'B'.
88 AFTER-EXIT VALUE 'A'.
10 EXB-SKIP-TO-AFTER PIC X.
88 SKIP-TO-AFTER VALUE 'X'.
10 EXB-RETURN-IMMED PIC X.
88 RETURN-IMMED VALUE 'X'.
10 EXB-EXIT-SET-REC-LENGTH PIC X.
88 EXIT-SET-REC-LENGTH VALUE 'X'.
10 EXB-EXIT-SET-ARGUMENT PIC X.
88 EXIT-SET-ARGUMENT VALUE 'X'.
10 EXB-EXIT-SET-FEEDBACK PIC X.
88 EXIT-SET-FEEDBACK VALUE 'X'.
10 FILLER PIC X(2).
05 FILLER PIC X(8).
05 FILLER PIC X(2).
05 EXB-SAVE-AREA PIC X(72).
05 FILLER PIC X(12).
*
COPY IDMS SUBSCHEMA-CTRL.
*
01 IO-RECORD.
05 POLICY-HEADER.
10 POLICY-KEY1 PIC X(11).
10 POLICY-TYPE PIC 9(4).
05 POL-DATA-1 PIC X(10).
05 POLICY-OCCURS PIC S9(4) COMP.
05 COV-DATA PIC X(10)
OCCURS 4 TIMES.
PROCEDURE DIVISION
USING EXIT-DSECT, SUBSCHEMA-CTRL, IO-RECORD.
BEGIN SECTION.
IF BEFORE-EXIT AND PUT-REQUEST
PERFORM BEFORE-PUT-EXIT
ELSE
IF BEFORE-EXIT AND ERASE-REQUEST
PERFORM BEFORE-ERASE-EXIT
ELSE
IF AFTER-EXIT AND GET-REQUEST
PERFORM AFTER-GET-EXIT
ELSE
IF AFTER-EXIT AND PUT-REQUEST
PERFORM AFTER-PUT-EXIT.
GOBACK.
BEGIN-XIT.
EXIT.
BEFORE-PUT-EXIT SECTION.
MOVE 0 TO POLICY-OCCURS.
BEFORE-PUT-EXIT-XIT.
EXIT.
BEFORE-ERASE-EXIT SECTION.
BIND POLICY.
IF NOT DB-STATUS-OK
PERFORM SET-FEEDBACK.
MOVE POLICY-HEADER TO POLICY-KEY.
OBTAIN CALC POLICY.
IF NOT DB-STATUS-OK
PERFORM SET-FEEDBACK.
ERASE POLICY ALL.
IF NOT DB-STATUS-OK
PERFORM SET-FEEDBACK.
MOVE 'X' TO EXB-RETURN-IMMED.
BEFORE-ERASE-EXIT-XIT.
EXIT.
AFTER-GET-EXIT SECTION.
MOVE 0 TO INDEX-1.
MOVE SPACES TO COV-DATA (1).
MOVE SPACES TO COV-DATA (2).
MOVE SPACES TO COV-DATA (3).
MOVE SPACES TO COV-DATA (4).
BIND COVERAGE.
IF NOT DB-STATUS-OK
PERFORM SET-FEEDBACK.
IF POLICY-TYPE = '1040'
PERFORM OBTAIN-COVERAGE-RECORDS 4 TIMES
ELSE
IF POLICY-TYPE = '1041'
PERFORM OBTAIN-COVERAGE-RECORDS 3 TIMES.
MOVE 'X' TO EXB-EXIT-SET-REC-LENGTH.
AFTER-GET-EXIT-XIT.
EXIT.
OBTAIN-COVERAGE-RECORDS SECTION.
ADD 1 TO INDEX-1.
OBTAIN NEXT COVERAGE WITHIN POLICY-COVG.
IF DB-STATUS-OK
MOVE COVERAGE TO COV-DATA (INDEX-1)
ELSE
PERFORM SET-FEEDBACK.
OBTAIN-COVERAGE-RECORDS-EXIT.
EXIT.
AFTER-PUT-EXIT SECTION.
MOVE 0 TO INDEX-1.
BIND COVERAGE.
IF NOT DB-STATUS-OK
PERFORM SET-FEEDBACK.
IF POLICY-TYPE = '1040'
PERFORM PUT-COVERAGE-RECORDS 4 TIMES
ELSE
IF POLICY-TYPE = '1041'
PERFORM PUT-COVERAGE-RECORDS 3 TIMES.
AFTER-PUT-EXIT-XIT.
EXIT.
PUT-COVERAGE-RECORDS SECTION.
ADD 1 TO INDEX-1.
MOVE COV-DATA (INDEX-1) TO COVERAGE.
STORE COVERAGE.
IF NOT DB-STATUS-OK
PERFORM SET-FEEDBACK.
PUT-COVERAGE-RECORDS-EXIT.
EXIT.
SET-FEEDBACK SECTION.
MOVE ERROR-STATUS TO EXB-FEEDBACK.
MOVE 'X' TO EXB-EXIT-SET-FEEDBACK.
GOBACK.
SET-FEEDBACK-XIT.
EXIT.
|
Copyright © 2014 CA.
All rights reserved.
|
|