-------------------------------------------------------------------------------------------------------
A string field has 2 or more consecutive characters.
The PICTURE clause of a string field is either -------------------------------------------------------------------------------------------------------
The STRING statement.
  STRING || sending-field-1 | DELIMITED BY | field-with-stop-image    ||
       || send-literal-1  |              | literal-of-stop-image    ||
                                         | SIZE (full-sending-field)||

        ( more than one sending field possible)
 
 INTO receiving-field
 
    | WITH POINTER position-in-receiving-field |

    | OVERFLOW     error-procedure    |

    | NOT OVERFLOW no-error-procedure    |

END-STRING
-----------------------------------------------------------------------
sending-field-1  --  (-2, -3, etc.) should be USAGE DISPLAY
 
DELIMITED BY  --  sets the limits of the sending field / literal
 
Field-with-stop-image -- contains a character string that defines the boundary of the sending-field.  If the sending field contains the boundary string, it will not be transmitted to the receiving field

literal-with-stop-image -- a literal string defining the boundary.

SIZE --  send the entire field.

receiving-field --  an external display field, not edited, not JUSTIFIED, will contain the data from the sending field(s).

position-in-receiving-field -- integer data field whose content points to the first character position that will receive data from the sending field(s).  Initialize this item before the STRING.  Upon completion of the STRING, this field is always one greater than the last character transferred.
 
error-procedure  --  statements that execute when attempting to move data to invalid receiving field positions (pointer is less than 1 or greater than the receiving field's length).

no-error-procedure  -- statements that execute when data is moved to valid receiving field character positions.

-------------------------------------------------------------------------------------------------------
 IDENTIFICATION DIVISION.
       PROGRAM-ID. STRINGER.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FIELD-1   PIC X(04) VALUE 'ABCD'.
       01  FIELD-2   PIC X(07) VALUE 'EFGHIJK'.
       01  FIELD-3   PIC X(20) VALUE 'LMNOPQRSTUVWXYZ'.
       01  FIELD-4   PIC X(20) VALUE 'STRING SAMPLER'.
       01  DELIM-1   PIC X     VALUE 'I'.
       01  DELIM-2   PIC XX    VALUE 'QR'.
       01  CATCH-ALL PIC X(60).
       01  PTR-FIELD PIC 99.
       PROCEDURE DIVISION.
      *
      *    STRING CAH ASSEMBLE DIFFERENT FIELDS INTO ONE FIELD.

           STRING FIELD-3 DELIMITED BY DELIM-2
                  ' '     DELIMITED BY SIZE
                  FIELD-2 DELIMITED BY DELIM-1
                  ' '     DELIMITED BY SIZE
                  FIELD-1 DELIMITED BY 'B'
                  INTO    CATCH-ALL.
           DISPLAY CATCH-ALL.
      *
      *    'LMNOP EFGH A'
      *
      *    STRING CAN APPEND DATA ONTO EXISTING FIELD CONTENTS

           MOVE 14 TO PTR-FIELD
           STRING FIELD-4 DELIMITED BY SIZE
                  INTO CATCH-ALL
                  WITH POINTER PTR-FIELD
           DISPLAY CATCH-ALL.
      *
      *    'LMNOP EFGH A STRING SAMPLER'
      *
           DISPLAY PTR-FIELD

      *    34

      *    STRING IS DIFFERENT FROM MOVE BECAUSE IT DOES NOT
      *    ERASE CONTENTS AFTER THE DATA COPIED TO A FIELD

           STRING FIELD-4 DELIMITED BY SIZE
                  INTO CATCH-ALL

           DISPLAY CATCH-ALL.

      *    'STRING SAMPLER      SAMPLER'
 

           GOBACK
           .
-------------------------------------------------------------------------------------------------------
The UNSTRING statement.

-------------------------------------------------------------------------------------------------------
UNSTRING sending-field
 
  DELIMITED BY  |ALL|  [boundary-1]
                       [literal-boundary-1]
           |OR| |ALL|  [boundary-2]
                       [literal-boundary-2]

  INTO receive-field-1 DELIMITER IN delim-receive-1 COUNT IN counter-1

       ( more than one receiving field possible)

  WITH POINTER position-in-send-field

  TALLYING receiving-field-count

  ON  OVERFLOW error-procedure

  NOT OVERFLOW no-error-procedure
 
END-UNSTRING
------------------------------------------------------------------------
sending-field  --  an alphanumeric or alphabetic data item
 
ALL  --  contiguous occurrences of a delimiter are treated as if
         it was one occurrence.

boundary-1 --   (-2,-3, etc.) the fields that contain the delimiter
                that stops copy to a receiving field

literal-boundary-1  -- (-2,-3, etc.) literal image of the delimiter
                       that stops copy to a receiving field

receive-field-1 --  a USAGE DISPLAY field which does not contain
                    editing symbols.

delim-receive-1 --  field which will contain the boundary delimiter
                    found in the sending-field.

counter-1  --  an integer field which will contain the character count
               of the data transferred to the receive-field-1

position-in-send-field -- integer field containing start position
                          for examining characters in the sending field.
                          Initialize prior to STRING.  When the UNSTRING is done,
                          this field will contain a value equal to the next
                          position that will be examined in the sending-field.

receiving-field-count -- the initial value plus the number of data
                         receiving fields given data by the UNSTRING.
-------------------------------------------------------------------------------------------------------
ON  OVERFLOW --  an overflow condition exists when:
 

-------------------------------------------------------------------------------------------------------
       IDENTIFICATION DIVISION.
         PROGRAM-ID. UNSTR.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FULL-NAME-1     PIC X(30) VALUE 'JOHN M SMITH'.
       01  FULL-NAME-2     PIC X(30) VALUE 'NANCY  B      SMITH'.
       01  CITY-STATE-ZIP  PIC X(20) VALUE 'CHICAGO, IL 60076'.
       01  FIRST-NAME      PIC X(10).
       01  MIDDLE-INITIAL  PIC X.
       01  LAST-NAME       PIC X(10).
       01  CITY            PIC X(10).
       01  STATE           PIC XX.
       01  ZIP-CODE        PIC 9(5).
       01  DELIM-1         PIC X     VALUE ' '.
       01  DELIM-2         PIC XX    VALUE ', '.
       01  WORD-COUNT      PIC 999   VALUE ZEROS.
       01  OVERFLOW-SWITCH PIC XXX   VALUE 'YES'.
       01  BIG-FIELD-WITH-MANY-WORDS PIC X(60) VALUE
          'BEHIND   FAR BE SPRING    CAN COMES   WINTER   IF'.
       01  WORD-GROUPING.
           05  A-WORD  PIC X(20) OCCURS 20 TIMES INDEXED BY W.
       01  PTR-FIELD       PIC 99.
 
       PROCEDURE DIVISION.
           UNSTRING FULL-NAME-1
              DELIMITED BY DELIM-1
              INTO FIRST-NAME
                   MIDDLE-INITIAL
                   LAST-NAME
           END-UNSTRING
           DISPLAY FIRST-NAME ' ' MIDDLE-INITIAL ' ' LAST-NAME.
           UNSTRING FULL-NAME-2
              DELIMITED BY DELIM-1
              INTO FIRST-NAME
                   MIDDLE-INITIAL
                   LAST-NAME
           END-UNSTRING
           DISPLAY FIRST-NAME ' ' MIDDLE-INITIAL ' ' LAST-NAME.
           UNSTRING FULL-NAME-2
              DELIMITED BY ALL DELIM-1
              INTO FIRST-NAME
                   MIDDLE-INITIAL
                   LAST-NAME
           END-UNSTRING
           DISPLAY FIRST-NAME ' ' MIDDLE-INITIAL ' ' LAST-NAME.
 
*            JOHN       M SMITH
*            NANCY        B
*            NANCY      B SMITH
 

           UNSTRING CITY-STATE-ZIP
              DELIMITED BY ALL ' ' OR ', '
              INTO CITY
                   STATE
                   ZIP-CODE
           END-UNSTRING
           DISPLAY CITY ' ' STATE ' ' ZIP-CODE.
 
 *            CHICAGO    IL 60076

           MOVE 1 TO PTR-FIELD
           MOVE ZEROS TO WORD-COUNT
           MOVE 'YES' TO OVERFLOW-SWITCH
           PERFORM  VARYING W FROM 1 BY 1
                    UNTIL OVERFLOW-SWITCH = 'NO'
               UNSTRING BIG-FIELD-WITH-MANY-WORDS
                   DELIMITED BY ALL SPACES
                   INTO A-WORD (W)
                   WITH POINTER PTR-FIELD
                   TALLYING WORD-COUNT
                   ON  OVERFLOW MOVE 'YES' TO OVERFLOW-SWITCH
                   NOT OVERFLOW MOVE 'NO'  TO OVERFLOW-SWITCH
               END-UNSTRING
           END-PERFORM
           DISPLAY PTR-FIELD ' ' WORD-COUNT

 *         61            008

           MOVE 1 TO PTR-FIELD
           MOVE SPACES TO BIG-FIELD-WITH-MANY-WORDS
           PERFORM VARYING W FROM WORD-COUNT BY -1
                   UNTIL W = 0
               STRING A-WORD (W) DELIMITED BY ' '
                      SPACES     DELIMITED BY SIZE
                 INTO BIG-FIELD-WITH-MANY-WORDS
                 POINTER PTR-FIELD
               END-STRING
           END-PERFORM

           DISPLAY BIG-FIELD-WITH-MANY-WORDS
           GOBACK
           .
-------------------------------------------------------------------------------------------------------

A COBOL SORT VERB is useful for

-------------------------------------------------------------------------------------------------------
COBOL SORT JCL Requirements  -- include the following DD references in the same step as a program that has a COBOL SORT verb.

//SORTWK01   DD UNIT=SYSDA,SPACE=(TRK,(1,1))
//SORTWK02   DD UNIT=SYSDA,SPACE=(TRK,(1,1))
//SORTWK03   DD UNIT=SYSDA,SPACE=(TRK,(1,1))
//SYSOUT     DD SYSOUT=*
//SORTMSGS   DD SYSOUT=*

The COBOL DISPLAY verb and the COBOL SORT both put messages to the //SYSOUT DD statement.  Since COBOL SORT messages will overwrite COBOL DISPLAY, issue the following code prior to using the SORT verb.

     MOVE 'SORTMSGS' TO SORT-MESSAGE.

-------------------------------------------------------------------------------------------------------
SIMPLE SORT

 SORT sort-file
   ASCENDING  sort-rec-field-1 sort-rec-field-2 ….
   DESCENDING sort-rec-field-3 sort-rec-field-4  …..
   USING      input-file1 input-file2 input-file3
   GIVING     sorted-output-file
-------------------------------------------------------------------------------------------------------
soft-file   -- Name of an SD entry which describes the records being sorted.

ASCENDING sort-rec-field-1 -- sort records from low to high according to field names that match the record description found in the sort-file --- sort-rec-field-1 -2 -3 etc., should be a field in the sort file record description (SD) and a SELECT … ASSIGN TO statement.

DESCENDING sort-rec-field-3 -- sort records from high to low according to field named in the sort-file record description

USING input-file --   a FD entry for an input file.  Code this as you would any other file description.   The input-file should NOT be OPEN at the same time as this option.  This sort option OPENs the input-file, READs each record, RELEASEs the record to sort, and CLOSEs the file.

GIVING output-file  -- a FD entry for a sorted output-file.  When the SORT verb finishes processing, this file will contain the same records as the input-file but in the sort order of the ASCENDING and DESCENDING statements.  The output-file should NOT be OPEN at the same time as the SORT.  This SORT option OPENs the output-file, RETURNs all the sort records, WRITEs them all to the output-file, and CLOSEs the output-file.
------------------------------------------------------------------------------------------------------------------------------
 SORT with Procedures

 SORT sort-file
   ASCENDING  sort-rec-field-1 sort-rec-field-2 ….
   DESCENDING sort-rec-field-3 sort-rec-field-4  …..
   INPUT PROCEDURE  100-SORT-INPUT
   OUTPUT PROCEDURE 200-SORT-OUTPUT
 
------------------------------------------------------------------------------------------------------------------------------
INPUT PROCEDURE --   use when the procedure modifies or selects input records to be
  sorted operation.
 

The following sample does not modify or select the input-records.

100-SORT-INPUT.
    OPEN INPUT input-file
    MOVE SPACES TO EOF-SWITCH
    PERFORM UNTIL EOF-SWITCH = 'EOF'
        READ input-file
            AT END MOVE 'EOF' TO EOF-SWITCH
            NOT AT END RELEASE sort-rec FROM input-rec
        END-READ
    END-PERFORM
------------------------------------------------------------------------------------------------------------------------------
RELEASE is the verb for writing records to sort-file.

 RELEASE sort-rec
 or
 RELEASE sort-rec FROM record-source

------------------------------------------------------------------------------------------------------------------------------
OUTPUT PROCEDURE --  Use when the sorted output is needed for

------------------------------------------------------------------------------------------------------------------------------
RETURN is the verb for reading records from sort-file.

RETURN sort-file |  INTO record-identifier |
   AT END  imperative-statement-1
   NOT AT END imperative-statement-2
END-RETURN
-----------------------------------------------------------------------------------------------------------------------------
COBOL SORT Special Registers  -- are equivalent to option control statement key words in the sort control file.

SORT-CORE-SIZE  -- to specify the number of bytes of storage available to the SORT.

SORT-FILE-SIZE  -- to specify the estimated number of records that will be sorted.
 
SORT-MESSAGE    -- to specify which ddname will be used for sort message output.
                   Default for SORT messages is "SYSOUT".
 
SORT-RETURN     -- will contain a return code at the end of the sort which indicates
                   whether the sort was successful (0) or failed (16).

-----------------------------------------------------------------------------------------------------------------------------
Example of special register usage:

 MOVE 64000 TO SORT-CORE-SIZE
 MOVE 100000 TO SORT-FILE-SIZE
 MOVE 'SORTMSGS' TO SORT-MESSAGE
 SORT sort-file
     ASCENDING  sort-key
     USING  input-file
     GIVING sorted-output-file.
 IF  SORT-RETURN = 16
     DISPLAY 'SORT DID NOT WORK CORRECTLY'
 END-IF

-----------------------------------------------------------------------------------------------------------------------------