CBL LIB,QUOTE
*Module/File Name: IGZTFTDS
*************************************************
* Example for callable service CEEFTDS *
* Function: Convert numeric time and date *
* values to a string using specified *
* format string and locale format *
* conversions. *
* Valid only for COBOL for MVS & VM Release 2 *
* or later. *
*************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. MAINFTDS.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Use TD-Struct for CEEFTDS calls
COPY CEEIGZTD.
*
PROCEDURE DIVISION.
* Subroutine needed for pointer addressing
CALL "COBFTDS" USING TD-Struct.
STOP RUN.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. COBFTDS.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Use Locale category constants
COPY CEEIGZLC.
*
01 Ptr-FTDS POINTER.
01 Output-FTDS.
02 O-Length PIC S9(4) BINARY.
02 O-String PIC X(72). 01 Format-FTDS.
02 F-Length PIC S9(4) BINARY.
02 F-String PIC X(64).
01 Max-Size PIC S9(9) BINARY.
01 FC.
02 Condition-Token-Value.
COPY CEEIGZCT.
03 Case-1-Condition-ID.
04 Severity PIC S9(4) BINARY.
04 Msg-No PIC S9(4) BINARY.
03 Case-2-Condition-ID
REDEFINES Case-1-Condition-ID.
04 Class-Code PIC S9(4) BINARY.
04 Cause-Code PIC S9(4) BINARY.
03 Case-Sev-Ctl PIC X.
03 Facility-ID PIC XXX.
02 I-S-Info PIC S9(9) BINARY.
LINKAGE SECTION.
* Use TD-Struct for calls to CEEFTDS
COPY CEEIGZTD.
*
PROCEDURE DIVISION USING TD-Struct.
* Set up time and date values
MOVE 1 TO TM-Sec.
MOVE 2 TO TM-Min.
MOVE 3 TO TM-Hour.
MOVE 9 TO TM-Day.
MOVE 11 TO TM-Mon.
MOVE 94 TO TM-Year.
MOVE 5 TO TM-Wday.
MOVE 344 TO TM-Yday.
MOVE 1 TO TM-Is-DLST.
* Set up format string for CEEFTDS call
MOVE 72 TO Max-Size.
MOVE 36 TO F-Length.
MOVE "Today is %A, %b %d Time: %I:%M %p"
TO F-String (1:F-Length).
* Set up pointer to structure for CEEFTDS call
SET Ptr-FTDS TO ADDRESS OF TD-Struct.
* Call CEEFTDS to convert numeric values
CALL "CEEFTDS" USING OMITTED, Ptr-FTDS,
Max-Size, Format-FTDS,
Output-FTDS, FC.
* Check feedback code and display result
IF Severity = 0
DISPLAY "Format " F-String (1:F-Length)
DISPLAY "Result " O-String (1:O-Length)
ELSE
DISPLAY "Call to CEEFTDS failed. " Msg-No
END-IF.
EXIT PROGRAM.
END PROGRAM COBFTDS.
*
END PROGRAM MAINFTDS.