*-----------------------------------------------------------------
* METHOD 1: COBOL INPUT AND OUTPUT PROCEDURES.
*-----------------------------------------------------------------
* 1. PRE-PROCESS:
* THE PROGRAM USES A SORT INPUT PROCEDURE TO DELETE RECORDS
* WITH A ZZZZZ OMIT FIELD BEFORE SORTING. THE OMIT FIELD IS
* IN COLUMNS 30-34.
* 2. SORT
* THE PROGRAM CALLS DFSORT TO SORT THE RECORDS IN DESCENDING
* ORDER. THE KEY IS IN COLUMNS 5-24.
* 3. POST-PROCESS:
* THE PROGRAM USES A SORT OUTPUT PROCEDURE TO WRITE ONE
* RECORD WITH EACH KEY AFTER SORTING.
*
* INPUT/OUTPUT: READS INDS AND WRITES OUTDS.
* DFSORT PASSES RECORDS TO THE PROCEDURES.
*-----------------------------------------------------------------
ID DIVISION.
PROGRAM-ID. CASE1.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INDS ASSIGN TO INDS.
SELECT OUTDS ASSIGN TO OUTDS.
SELECT SORT-FILE ASSIGN TO SORTFILE.
DATA DIVISION.
FILE SECTION.
FD INDS RECORD CONTAINS 160 CHARACTERS
LABEL RECORD STANDARD BLOCK 27840
DATA RECORDS ARE INDS-RECORD.
01 INDS-RECORD.
05 FILLER PIC X(4).
05 INDS-KEY PIC X(20).
05 FILLER PIC X(5).
05 INDS-OMIT PIC X(5).
05 FILLER PIC X(126).
FD OUTDS RECORD CONTAINS 160 CHARACTERS
LABEL RECORD STANDARD BLOCK 27840
DATA RECORDS ARE OUTDS-RECORD.
01 OUTDS-RECORD.
05 FILLER PIC X(160).
SD SORT-FILE RECORD CONTAINS 160 CHARACTERS
DATA RECORD SORT-RECORD.
01 SORT-RECORD.
05 FILLER PIC X(4).
05 SORT-KEY PIC X(20).
05 FILLER PIC X(136).
WORKING-STORAGE SECTION.
01 FLAGS.
05 INDS-EOF PIC X VALUE SPACE.
88 SFLAG VALUE "Y".
05 TEMP-EOF PIC X VALUE SPACE.
88 TFLAG VALUE "Y".
01 PSTART PIC 9(1) VALUE 0.
01 SAVE-KEY PIC X(20).
01 TEMP-RECORD.
05 FILLER PIC X(4).
05 TEMP-KEY PIC X(20).
05 FILLER PIC X(136).
PROCEDURE DIVISION.
MASTER SECTION.
*-----------------------------------------------------------------
* CALL DFSORT TO SORT THE RECORDS IN DESCENDING ORDER.
*-----------------------------------------------------------------
SORT SORT-FILE
ON DESCENDING KEY SORT-KEY
INPUT PROCEDURE INPUT-PROC
OUTPUT PROCEDURE OUTPUT-PROC.
IF SORT-RETURN > 0
DISPLAY "SORT FAILED".
STOP RUN.
*-----------------------------------------------------------------
* SORT INPUT PROCEDURE:
* READ INDS.
* DELETE ALL RECORDS WITH A 'ZZZZZ' OMIT FIELD.
* SEND ALL OTHER RECORDS TO DFSORT FOR SORTING.
*-----------------------------------------------------------------
INPUT-PROC SECTION.
OPEN INPUT INDS
READ INDS AT END SET SFLAG TO TRUE
END-READ
PERFORM UNTIL SFLAG
IF INDS-OMIT NOT = "ZZZZZ"
RELEASE SORT-RECORD FROM INDS-RECORD
END-IF
READ INDS AT END SET SFLAG TO TRUE
END-READ
END-PERFORM.
CLOSE INDS.
*-----------------------------------------------------------------
* SORT OUTPUT PROCEDURE:
* RECEIVE RECORDS FROM DFSORT INTO TEMP.
* WRITE ONE RECORD WITH EACH KEY TO OUTDS.
*-----------------------------------------------------------------
OUTPUT-PROC SECTION.
OPEN OUTPUT OUTDS
RETURN SORT-FILE INTO TEMP-RECORD AT END SET TFLAG TO TRUE
END-RETURN
PERFORM UNTIL TFLAG
IF PSTART = 0
*-----------------------------------------------------------------
* FIRST RECORD - SAVE KEY AND WRITE RECORD TO OUTDS.
*-----------------------------------------------------------------
MOVE TEMP-KEY TO SAVE-KEY
WRITE OUTDS-RECORD FROM TEMP-RECORD
MOVE 1 TO PSTART
ELSE
IF TEMP-KEY NOT = SAVE-KEY
*-----------------------------------------------------------------
* RECORD HAS NEW KEY - SAVE KEY AND WRITE RECORD TO OUTDS.
*-----------------------------------------------------------------
MOVE TEMP-KEY TO SAVE-KEY
WRITE OUTDS-RECORD FROM TEMP-RECORD
END-IF
END-IF
RETURN SORT-FILE INTO TEMP-RECORD
AT END SET TFLAG TO TRUE
END-RETURN
END-PERFORM.
CLOSE OUTDS.