CICS VSAM Transparency for z/OS, Version 1.2


COBOL code

 CBL SQL('HOST(COB2),APOSTSQL,SOURCE,XREF'),LIB,TEST(SYM)
 IDENTIFICATION DIVISION.
 PROGRAM-ID. CTLRECF.
****************************************************************
* *
* THIS IS A CICS/VT FBE EXIT TO MANAGE VSAM FILE THAT CONTAINS *
* A CONTROL RECORD WITH A 6-BYTE KEY OF LOW-VALUES, WHICH IS *
* STORED IN ITS OWN TABLE. THE FILE IS MAPPED IN CICS VT TO THE*
* TABLE THAT CONTAINS ALL POF THE OTHER FILE RECORDS. *
* *
* IN THE APPLICATION, THE CONTROL RECORD IS ALWAYS ACCESSED BY *
* A DIRECT READ SPECIFYING THE LOW-VALUES KEY. *
* *
* THE EXIT IS MAPPED ON THE KEY FIELD. IF A REGULAR RECORD IS *
* ACCESSED, THE EXIT BUILDS THE KEY VALUE AND ENDS. IF THE *
* CONTROL RECORD IS BEING ACCESSED, THE EXIT RETRIEVES IT FROM *
* THE CONTROL RECORD TABLE. *
* *
* IN THE APPLICATION, THE CONTROL RECORD IS NEVER DELETED. IT *
* IS ONLY RETRIEVED OR UPDATED. *
* *
* THE KEY IS 6-BYTES AND IS CHARACTER DATA IN BOTH VSAM AND DB2*
* *
* NOTE 1: *
* THE EXIT REQUIRES THAT A DUMMY CONTROL RECORD MUST EXIST IN *
* THE MAIN RECORD TABLE. THE EXIT BUILDS A DUMMY RECORD WHEN *
* THE FILE IS INTIALLY MIGRATED. *
* *
* NOTE 2: *
* THE CONTROL RECORD MUST BE MANUALLY INSERTED INTO THE CONTROL*
* RECORD TABLE AT INITIAL DATA MIGRATION. *
* *
****************************************************************
 ENVIRONMENT DIVISION.
*
 DATA DIVISION.
*
WORKING-STORAGE SECTION .
        01 WS-UPDATE-IN-PROGRESS       PIC X(3)  .
        01 WS-DB2-FIELD                PIC 9(8)  .
        01 WS-VSAM-FIELD               PIC 9(7)  .
        01 WS-DB2-TEMP-FIELD .
           02 TEMP-YYYY                PIC 9(4)  .
          02 TEMP-MM                   PIC 9(2)  .
          02 TEMP-DD                   PIC 9(2)  .
        01 WS-DB2-TEMP REDEFINES
                   WS-DB2-TEMP-FIELD  PIC 9(8)   .
        01 WS-FILE-LAST-UPDATE-DT-TEMP           .
           02 DB2-YYYY                PIC X(4)   .
           02 DASH1                   PIC X .
           02 DB2-MM                  PIC X(2)   .
           02 DASH2                   PIC X .
           02 DB2-DD                  PIC X(2)   .
        01 WS-FILE-LAST-UPDATE-DT           REDEFINES
              WS-FILE-LAST-UPDATE-DT-TEMP   PIC X(10).
       ****************************************************************
       * VARIABLES USED IN ERROR MESSAGES
       ****************************************************************
        01 WS-DATE.
           02 WS-CENTURY            PIC 99.
           02 WS-YEAR               PIC 99.
           02 WS-MONTH              PIC 99.
           02 WS-DAY                PIC 99.
        01 WS-TIME.
           02 WS-HOUR               PIC 99.
           02 WS-MINUTE             PIC 99.
           02 WS-SECOND             PIC 99.
           02 WS-HUNDREDTH          PIC 99.
        01 ER-DATE.
           02 ER-CENTURY            PIC 99.
           02 ER-YEAR               PIC 99.
           02 FILLER                PIC X    VALUE '/'.
           02 ER-MONTH              PIC 99.
           02 FILLER                PIC X    VALUE '/'.
           02 ER-DAY                PIC 99.
           02 FILLER                PIC X(4) VALUE ' '.
        01 ER-TIME.
           02 ER-HOUR               PIC 99.
           02 FILLER                PIC X    VALUE ':'.
           02 ER-MINUTE             PIC 99.
           02 FILLER                PIC X    VALUE ':'.
           02 ER-SECOND             PIC 99.
           02 FILLER                PIC X    VALUE ':'.
           02 ER-HUNDREDTH          PIC 99.
****************************************************************
* VIDCONV AND PARAMETER LIST VARIABLES
****************************************************************
 01 VIDCONV                    PIC X(8) VALUE 'VIDCONV ' .
 01 WS-FILE-LAST-UPDATE-TM     PIC X(10)                 .
 01 DB2-TO-VSAM-PARMLIST                 .
    02 DB2-ROUTINE-NO          PIC S9(8)  COMP VALUE 50.
    02 DB2-SOURCE-FIELD        PIC X(8)                .
    02 DB2-SOURCE-FIELD-LEN    PIC S9(8)  COMP VALUE  8.
    02 DB2-SOURCE-FIELD-PIC    PIC S9(8)  COMP VALUE  0.
    02 DB2-DEST-FIELD          PIC S9(7)  COMP-3       .
    02 DB2-DEST-FIELD-LEN      PIC S9(8)  COMP VALUE  4.
    02 DB2-DEST-FIELD-PIC      PIC X(6)  VALUE 'HHXXSS'.
    02 DB2-PIC-FIELD-LEN       PIC S9(8) COMP VALUE   6.
 01 VSAM-TO-DB2-PARMLIST .
    02 VS-ROUTINE-NO           PIC S9(8) COMP VALUE  20.
    02 VS-SOURCE-FIELD         PIC S9(7) COMP-3        .
    02 VS-SOURCE-FIELD-LEN     PIC S9(8) COMP VALUE   4.
    02 VS-SOURCE-FIELD-PIC     PIC X(6) VALUE 'HHXXSS' .
    02 VS-DEST-FIELD           PIC X(08)               .
    02 VS-DEST-FIELD-LEN       PIC S9(8) COMP VALUE   8.
    02 VS-DEST-FIELD-PIC       PIC S9(8) COMP VALUE   0.
    02 VS-PIC-FIELD-LEN        PIC S9(8) COMP VALUE   6.
*****************************************************************
* DB2 COMUNICATION AREA
*****************************************************************
   EXEC SQL
       INCLUDE SQLCA
   END-EXEC.
*****************************************************************
* DB2 TABLES GENERATED BY DCLGEN
*****************************************************************
     COPY ITEMFLTC .
 LINKAGE SECTION              .
 01 VSAM-FIELD       PIC X(6) .
 01 DB2-FIELD        PIC X(6) .
 COPY VIDFBEC                 .
 COPY ITEMFL .
 COPY ITEMFLTB .
 01 DB2-RECORD-KEY   PIC X(6) .
*
 PROCEDURE DIVISION USING VSAM-FIELD, DB2-FIELD, EXITPARMS.
 MAIN-SECTION.
     SET ADDRESS OF ITEM-FILE-RECORD TO EXVSAIO   .
     SET ADDRESS OF DB2-RECORD-KEY   TO EXDB2IO   .
     SET ADDRESS OF VSAM-FIELD       TO EXVSAFLD  .
     SET ADDRESS OF DCLHLL-ITEM      TO EXDB2IO   .
 
 EVALUATE EXFUNCT
    WHEN 'V' PERFORM BUILD-VSAM-FIELD
    WHEN 'D' PERFORM BUILD-DB2-FIELD
 END-EVALUATE .
 MAIN-SECTION-END.
     GOBACK.
     EXIT.

 BUILD-VSAM-FIELD SECTION.
 10-BUILD-VSAM-FIELD.
     IF DB2-FIELD NOT = LOW-VALUES    THEN
         MOVE DB2-FIELD TO VSAM-FIELD
         GO TO 10-BUILD-VSAM-FIELD-END
     END-IF.

     IF EXVSABLD NOT = 'Y'            THEN
         MOVE DB2-FIELD TO VSAM-FIELD
         GO TO 10-BUILD-VSAM-FIELD-END
     END-IF.
***************************************************************
* WE DROP THROUGH HERE IF WE ARE PROCESSING A GET TYPE CALL
* FOR THE CONTROL RECORD (EXFUNCT=V & EXVSABLD = Y).
***************************************************************
     EXEC SQL
          SELECT
                  ITEMUP_NUMBER
                 ,ITEMUP_COMPLETE
                 ,ITEMUP_PROGRAM
                 ,ITEMUP_JOBNAME
                 ,ITEMUP_LAST_DATE
                 ,ITEMUP_LAST_TIME
                 ,ITEMUP_REC_DELETES
                 ,ITEMUP_REC_INSERTS
                 ,ITEMUP_REC_UPDATES
                 ,ITEMUP_REMARKS
           INTO
                  :ITEMUP-NUMBER
                 ,:ITEMUP-COMPLETE
                 ,:ITEMUP-PROGRAM
                 ,:ITEMUP-JOBNAME
                 ,:WS-FILE-LAST-UPDATE-DT
                 ,:ITEMUP-LAST-TIME
                 ,:ITEMUP-REC-DELETES
                 ,:ITEMUP-REC-INSERTS
                 ,:ITEMUP-REC-UPDATES
                 ,:ITEMUP-REMARKS
              FROM    HLL_ITEM_CONTROL
             WHERE ITEMUP_NUMBER      = :DB2-FIELD
     END-EXEC.
     IF SQLCODE NOT = 0   THEN PERFORM SQL-ERROR            .

     MOVE ITEMUP-NUMBER         TO ITEM-FILE-KEY            .
     MOVE ITEMUP-PROGRAM        TO ITEM-FILE-UPDATE-PROG    .
     MOVE ITEMUP-JOBNAME        TO ITEM-FILE-UPDATE-JOB-NM  .
     MOVE ITEMUP-REC-DELETES    TO ITEM-FILE-RECORDS-DELETED.
     MOVE ITEMUP-REC-INSERTS    TO ITEM-FILE-RECORDS-INSERTD.
     MOVE ITEMUP-REC-UPDATES    TO ITEM-FILE-RECORDS-UPDATED.
     MOVE ITEMUP-REMARKS        TO ITEM-FILE-CONTROL-REMARKS.

     IF ITEMUP-COMPLETE      = 'YES' THEN
          MOVE '0'              TO ITEM-UPDATE-IN-PROGRESS
     ELSE MOVE '1'              TO ITEM-UPDATE-IN-PROGRESS
     END-IF.
***************************************************************
* CONVERT DB2 DATE FORMAT TO JULIAN DATE FORMAT YYYYDDD
***************************************************************
     MOVE DB2-YYYY               TO TEMP-YYYY       .
     MOVE DB2-MM                 TO TEMP-MM         .
     MOVE DB2-DD                 TO TEMP-DD         .
     COMPUTE WS-VSAM-FIELD   =
           FUNCTION INTEGER-OF-DATE(WS-DB2-TEMP)
     COMPUTE ITEM-FILE-LAST-UPDATE-DT   =
           FUNCTION DAY-OF-INTEGER(WS-VSAM-FIELD).
***************************************************************
* CONVERT DB2 TIME FORMAT TO PACKED DECIMAL
***************************************************************
      MOVE ITEMUP-LAST-TIME     TO DB2-SOURCE-FIELD.
      CALL VIDCONV        USING DB2-ROUTINE-NO
                                DB2-SOURCE-FIELD
                                DB2-SOURCE-FIELD-LEN
                                DB2-SOURCE-FIELD-PIC
                                DB2-DEST-FIELD
                                DB2-DEST-FIELD-LEN
                                DB2-DEST-FIELD-PIC
                                DB2-PIC-FIELD-LEN.
      MOVE DB2-DEST-FIELD       TO  ITEM-FILE-LAST-UPDATE-TM.
      MOVE 'Y'                  TO EXRET .
 10-BUILD-VSAM-FIELD-END.
      EXIT.
*
 BUILD-DB2-FIELD SECTION.
 10-BUILD-DB2-FIELD .

    IF VSAM-FIELD NOT = LOW-VALUES THEN
       MOVE VSAM-FIELD TO DB2-FIELD
       GO TO 10-BUILD-DB2-FIELD-END
    END-IF.

    IF EXDB2BLD     =  'N'  THEN
       MOVE VSAM-FIELD TO DB2-FIELD
       GO TO 10-BUILD-DB2-FIELD-END
    END-IF.
     IF EXCALL        = 'LOAD' GO TO DUMMY-CONTROL-RECORD.
***************************************************************
* WE CAN ONLY GET HERE IF WE ARE PROCESSING AN UPDATE CALL
* FOR THE CONTROL RECORD (EXFUNCT=D & EXDB2BLD = Y)
***************************************************************
    IF ITEM-UPDATE-IN-PROGRESS = '0' THEN
         MOVE 'YES'     TO WS-UPDATE-IN-PROGRESS
    ELSE MOVE 'NO '     TO WS-UPDATE-IN-PROGRESS
    END-IF.
***************************************************************
* CONVERT JULIAN DATE FORMAT YYYYDDD TO DB2 DATE FORMAT
***************************************************************
     COMPUTE WS-DB2-FIELD     =
             FUNCTION INTEGER-OF-DAY(ITEM-FILE-LAST-UPDATE-DT)
     COMPUTE WS-DB2-TEMP      =
             FUNCTION DATE-OF-INTEGER(WS-DB2-FIELD).
     MOVE    TEMP-YYYY      TO DB2-YYYY         .
     MOVE    TEMP-MM        TO DB2-MM           .
     MOVE    TEMP-DD        TO DB2-DD           .
     MOVE    '-'            TO DASH1 OF
                            WS-FILE-LAST-UPDATE-DT-TEMP.
     MOVE    '-'            TO DASH2 OF
                            WS-FILE-LAST-UPDATE-DT-TEMP.
***************************************************************
* CONVERT PACKED DECIMAL TIME VALUE TO DB2 TIME FORMAT
***************************************************************
    MOVE ITEM-FILE-LAST-UPDATE-TM TO VS-SOURCE-FIELD.
    CALL VIDCONV       USING VS-ROUTINE-NO
                             VS-SOURCE-FIELD
                             VS-SOURCE-FIELD-LEN
                             VS-SOURCE-FIELD-PIC
                             VS-DEST-FIELD
                             VS-DEST-FIELD-LEN
                             VS-DEST-FIELD-PIC
                             VS-PIC-FIELD-LEN .
    MOVE VS-DEST-FIELD TO    WS-FILE-LAST-UPDATE-TM.
    EXEC SQL
         UPDATE    HLL_ITEM_CONTROL
            SET
                 ITEMUP_COMPLETE    = :WS-UPDATE-IN-PROGRESS
                ,ITEMUP_PROGRAM     = :ITEM-FILE-UPDATE-PROG
                ,ITEMUP_JOBNAME     = :ITEM-FILE-UPDATE-JOB-NM
                ,ITEMUP_LAST_DATE   = :WS-FILE-LAST-UPDATE-DT
                ,ITEMUP_LAST_TIME   = :WS-FILE-LAST-UPDATE-TM
                ,ITEMUP_REC_DELETES = :ITEM-FILE-RECORDS-DELETED
                ,ITEMUP_REC_INSERTS = :ITEM-FILE-RECORDS-INSERTD
                ,ITEMUP_REC_UPDATES = :ITEM-FILE-RECORDS-UPDATED
                ,ITEMUP_REMARKS     = :ITEM-FILE-CONTROL-REMARKS
           WHERE ITEMUP_NUMBER      = :VSAM-FIELD
    END-EXEC.
    IF SQLCODE NOT = 0    THEN PERFORM SQL-ERROR
    ELSE                  MOVE 'Y'     TO EXRET
    END-IF .
 10-BUILD-DB2-FIELD-END .
     GOBACK .
     EXIT.
*
 DUMMY-CONTROL-RECORD    SECTION.
 10-DUMMY-CONTROL-RECORD.
***************************************************************
* THIS SECTION IS ONLY EXECUTED AT INITIAL DATA MIGRATION AND
* BUILDS THE DUMMY CONTROL RECORD WHICH MUST EXIST IN THE MAIN
* DB2 TABLE. (THE ACTUAL CONTROL RECORD MUST BE MANUALLY
* INSERTED INTO THE CONTROL TABLE).
***************************************************************
     INITIALIZE DCLHLL-ITEM    .
     MOVE LOW-VALUES                    TO DB2-FIELD       .
     MOVE '0001-01-01'                  TO ITEM-DATE-FSHIP .
     MOVE 'Y'                           TO EXRET.
 10-DUMMY-CONTROL-RECORD-END.
     GOBACK               .
    EXIT.
 SQL-ERROR    SECTION.
 99-SQL-ERROR   .
     ACCEPT WS-DATE             FROM DATE YYYYMMDD .
     ACCEPT WS-TIME             FROM TIME          .
     MOVE WS-CENTURY            TO    ER-CENTURY   .
     MOVE WS-YEAR               TO    ER-YEAR      .
     MOVE WS-MONTH              TO    ER-MONTH     .
     MOVE WS-DAY                TO    ER-DAY       .
     MOVE WS-HOUR               TO    ER-HOUR      .
     MOVE WS-MINUTE             TO    ER-MINUTE    .
     MOVE WS-SECOND             TO    ER-SECOND    .
     MOVE WS-HUNDREDTH          TO    ER-HUNDREDTH .
     DISPLAY '*************************************************'
     DISPLAY 'CICS VT: ' ER-DATE, '           ' ER-TIME
     DISPLAY 'CICS VT: INVALID SQL CODE FOR DIM ' EXDIMNAM
     DISPLAY 'CICS VT: PROCESSING ITEM CONTROL TABLE'
     DISPLAY 'CICS VT: SEE VIDDMPD DD STATEMENT FOR DETAILS'
     DISPLAY '*************************************************'
     MOVE     'E' TO EXRET.
     SET EXSQLCA TO ADDRESS OF SQLCA.
 99-SQL-ERROR-END .
     GOBACK               .
     EXIT.


Concept topic


Last updated: December 6, 2013 20:45:0

Concept Concept

Feedback


Timestamp icon Last updated: Friday, 6 December 2013


http://pic.dhe.ibm.com/infocenter/cicsts/v5r1/topic///topics/cvtdeccobolcode.html