CBL LIB,QUOTE
*Module/File Name: IGZTSCOL
*************************************************
* Example for callable service CEESCOL *
* COBSCOL - Compare two character strings *
* and print the result. *
* Valid only for COBOL for MVS & VM Release 2 *
* or later. *
*************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. COBSCOL.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 String1.
02 Str1-Length PIC S9(4) BINARY.
02 Str1-String.
03 Str1-Char PIC X
OCCURS 0 TO 256 TIMES
DEPENDING ON Str1-Length.
01 String2.
02 Str2-Length PIC S9(4) BINARY.
02 Str2-String.
03 Str2-Char PIC X
OCCURS 0 TO 256 TIMES
DEPENDING ON Str2-Length.
01 Result 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.
*
PROCEDURE DIVISION.
*************************************************
* Set up two strings for comparison
*************************************************
MOVE 9 TO Str1-Length.
MOVE "12345a789"
TO Str1-String (1:Str1-Length)
MOVE 9 TO Str2-Length.
MOVE "12346$789"
TO Str2-String (1:Str2-Length)
*************************************************
* Call CEESCOL to compare the strings
*************************************************
CALL "CEESCOL" USING OMITTED, String1,
String2, Result, FC.
*************************************************
* Check feedback code
*************************************************
IF Severity > 0
DISPLAY "Call to CEESCOL failed. " Msg-No
STOP RUN
END-IF.
*************************************************
* Check result of compare
*************************************************
EVALUATE TRUE
WHEN Result < 0
DISPLAY "1st string < 2nd string."
WHEN Result > 0
DISPLAY "1st string > 2nd string."
WHEN OTHER
DISPLAY "Strings are identical."
END-EVALUATE.
STOP RUN.
END PROGRAM COBSCOL.