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.