The following description applies to both file and table sorting.
To specify the character set of alphanumeric sort keys, a SORT special register SORT-CCSN ("Coded Character Set Name“) is defined. It is made available in COBOL programs that contain a SORT statement and described implicitly by the compiler with PIC X(8). This SORT special register is supplied with the name of the selected character set before the call of the SORT statement (e.g. MOVE "EDF041" TO SORT-CCSN).
If this option is not to apply to a subsequent SORT statement, the value of the new SORT special register SORT-CCSN must be filled with spaces before this SORT statement is executed (e.g. MOVE SPACES TO SORT-CCSN).
The specifications for the sort sequence apply in the following order:
specification of the SORT COLLATING SEQUENCE in the SORT statement or PROGRAM COLLATING SEQUENCE in the program
value in the SORT special register SORT-CCSN
COMOPT SORT-EBCDIC-DIN or SDF option SORTING-ORDER
Example 12-10
SORT with extended character sets (XHCS)
IDENTIFICATION DIVISION. PROGRAM-ID. SORTX. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT INPUT ASSIGN TO "INPUT". SELECT OUTPUT ASSIGN TO "OUTPUT". SELECT SORT ASSIGN TO "SORTWK". DATA DIVISION. FILE SECTION. FD INPUT LABEL RECORD STANDARD. 01 INPUT-RECORD. 02 I0 PIC X. 02 NAME PIC X(30). 02 FORENAME PIC X(30). 02 PLACE PIC X(30). FD OUTPUT- LABEL RECORD STANDARD. 01 OUTPUT-RECORD 02 O0 PIC X. 02 NAME PIC X(30). 02 FORENAME PIC X(30). 02 PLACE PIC X(30). SD SORT LABEL RECORD STANDARD. 01 S-RECORD. 02 S0 PIC X. 02 NAME PIC X(30). 02 FORENAME PIC X(30). 02 PLACE PIC X(30). PROCEDURE DIVISION. P1 SECTION. SORT. MOVE "EDF03IRV" TO SORT-CCSN. (1) SORT SORT ASCENDING NAME FORENAME PLACE USING INPUT GIVING OUTPUT. STOP RUN.
(1) Supplies the SORT special register SORT-CCSN with the name of the Extended Character Code Set; this code is used to specify the sort sequence.