CICS VSAM Transparency for z/OS, Version 1.2


Using a nullable column in DB2

The classic definition of a null value is a value that is not known at this time. There is no standard concept of a null value in VSAM and from a CICS® VT perspective every VSAM field has a value. Using a nullable column in DB2® is a common way to manage VSAM fields with default values that are inconsistent with the field attribute, such as SPACES in a packed decimal field.

Null values are controlled in DB2 using null indicator variables. CICS VT provides mapping support for nullable columns for fields with repeating predefined characters. You should note that DB2 columns that correspond to either the whole or part of the VSAM file key or an alternate index path cannot be nullable.

There may be situations when the mapping support for nullable columns is inadequate. In these cases, the solution is to write an FBE. An example of a COBOL FBE called CNULLCL follows:

COBOL code

 CBL LIB RMODE(ANY)
 IDENTIFICATION DIVISION.
 PROGRAM-ID. CNULLCL.
*
* THIS FBE PROCESSES A 2-BYTES PACKED DECIMAL COLUMN THAT IS
* NULLABLE. IF THE VSAM FIELD VALUE IS SPACES, THE EXIT SETS
* THE COLUMN VALUE TO NULL. THE REVERSE IS PERFORMED.
*
* WHEN THE VSAM FIELD VALUE IS SPACES, THE NULL-INDICATOR VARIABLE
* IS SET TO ON AND A VALUE OF '@@' IS MOVED TO THE DB2 COLUMN.
* THE DB2 LOAD CONTROL CARD SPECIFIES NULLIF POS1:POS1 = '@'
* SO THAT THE INITIAL DATA LOAD SETS THE VALUE IN DB2 TO NULL.
*
 ENVIRONMENT DIVISION.
 DATA DIVISION.
 WORKING-STORAGE SECTION                .
 01 ADDR-OF-NULL               POINTER.
 01 ADDR-OF-NULL2    REDEFINES ADDR-OF-NULL PIC S9(8) COMP-5.
 LINKAGE SECTION                       .
 01 VSAM-FIELD                 PIC S9(3) COMP-3.
 01 VSAM-FIELD-NULL  REDEFINES VSAM-FIELD PIC X(2)          .
 01 DB2-FIELD                  PIC S9(3) COMP-3.
 01 DB2-FIELD-NULL   REDEFINES DB2-FIELD PIC X(2)           .
 COPY VIDFBEC                             .
 01 NULL-IND                   PIC S9(5) COMP-5.
*
 PROCEDURE DIVISION USING VSAM-FIELD, DB2-FIELD, EXITPARMS.
 MAIN-SECTION.
     SET ADDRESS OF VSAM-FIELD  TO EXVSAFLD.
     SET ADDRESS OF DB2-FIELD   TO EXDB2FLD.
     SET ADDR-OF-NULL           TO EXNULLS .
     COMPUTE ADDR-OF-NULL2  =
             ADDR-OF-NULL2 + EXNULOFF .
     SET ADDRESS OF NULL-IND    TO ADDR-OF-NULL.
         EVALUATE EXFUNCT
       WHEN 'D'     PERFORM BUILD-DB2-FIELD
       WHEN 'V'     PERFORM BUILD-VSAM-FIELD
    END-EVALUATE .
     MAIN-SECTION-END.
    GOBACK.
    EXIT.
 BUILD-VSAM-FIELD SECTION.
 10-BUILD-VSAM-FIELD.
     IF   NULL-IND NOT   = 0 MOVE SPACES TO VSAM-FIELD-NULL
     ELSE MOVE DB2-FIELD                 TO VSAM-FIELD.
 10-BUILD-VSAM-FIELD-END.
     EXIT.
 BUILD-DB2-FIELD SECTION.
 10-BUILD-DB2-FIELD.
     IF   VSAM-FIELD NOT NUMERIC THEN
          MOVE -1         TO NULL-IND
          MOVE '@@'       TO DB2-FIELD-NULL
     ELSE MOVE VSAM-FIELD TO DB2-FIELD.
 10-BUILD-DB2-FIELD-END.
     EXIT.

Notes for CNULLCL

CICS VT maintains a pool of null indicators with an entry for every column in the table that is mapped to the VSAM file. The address of the null pool is in the parameter EXNULLS. For each field, the NULLOFF parameter is the offset in the null pool for a specific field. The exit calculates the address of the null pool variable for the DB2 column by adding the null pool offset to the null pool address.

CNULLCL depends on the column name being specified in the mapping of the field. Use the mapping example in Figure 1 for field F07.

The statement MOVE '@@' TO DB2-FIELD-NULL in 10-BUILD-DB2-FIELD is specifically to handle initial data migration with the VIDLOAD utility. When the exit detects a non-numeric VSAM field value, it sets the null indicator on and moves @@' to the DB2 column. For a PUT/REWRITE/CALL, the null indicator is on so the column value is disregarded. For the initial data load, you add the following in the input statement for the DB2 LOAD utility:

NULLIF (start_pos:end-pos) = '@'
				

The test performed by the exit to establish if the VSAM field value is null is the statement IF VSAM-FIELD NOT NUMERIC. The values SPACES, low-values, and high-values will become a null value in DB2. On retrieval, if the DB2 column is null, the value built in the field is SPACES. Ensure you don't have any program logic that tests this field for a specific field value such as LOW-VALUES.



Concept topic


Last updated: November 9, 2012 20:43:57