Sorting and Input Procedures

[Mingo]

New programmer. PC platform. RM/COBOL-85.

Grateful if anyone could advise how to sort a file on a calculated field using an input procedure. That is, field is not part of the input file, but is calculated using one of the fields in input file. File needs to be sorted on this key. Not sure how this 'new' field is treated when releasing to sort record. [sig][/sig]

 

[Crox]

I think you can use the usual code, there is nothing special to that calculated field.

Here I have a sort example in CA-REALIA COBOL. The input is any file, the output records are selected data which looks a little bit like identifiers as we know them in COBOL and PL/1. Identical records are not written. I sort on the complete sortrecord. You just put your field inside the SORTREC.

I hope this answer is of any value to you!


000100*$CALL
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. COBWORDS.
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION.
000600 SOURCE-COMPUTER. IBM-4381.
000700 OBJECT-COMPUTER. IBM-4381.
000800 SPECIAL-NAMES.
000900 CONSOLE IS CONSOLE
001000 DECIMAL-POINT IS COMMA.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 SELECT INVOER ASSIGN TO VARYING INVOER-NAAM
001400 FILE STATUS FILE-STATUS-INVOER.
001500 SELECT UITVOER ASSIGN TO VARYING UITVOER-NAAM
001600 FILE STATUS FILE-STATUS-UITVOER.
001700 SELECT SORTFILE ASSIGN TO ')SORT(.)X([B99]'.
001800 DATA DIVISION.
001900 FILE SECTION.
002000 FD INVOER
002100 RECORDING MODE IS F
002200 BLOCK CONTAINS 0
002300 LABEL RECORDS IS STANDARD
002400 DATA RECORD IS INVOER-REC.
002500 01 INVOER-REC PIC X.
002600
002700 FD UITVOER
002800 RECORDING MODE IS F
002900 BLOCK CONTAINS 0
003000 LABEL RECORDS ARE STANDARD.
003100 01 UITVOER-REC PIC X(33).
003200
003300 SD SORTFILE.
003400 01 SORTREC.
003500 03 SORT-TEKEN OCCURS 33 PIC X.
003600
003700 WORKING-STORAGE SECTION.
003800 01 ASCII-ALF.
003900 03 ASCII-TEKEN PIC X.
004000 03 FILLER PIC X VALUE LOW-VALUE.
004100 01 ASCII-NUM REDEFINES ASCII-ALF
004200 PIC S9(4) COMP-5.
004300 01 INVOER-NAAM PIC X(79).
004400 01 UITVOER-NAAM PIC X(79).
004500 01 FILE-STATUSSEN.
004600 03 FILE-STATUS-INVOER PIC XX VALUE ZERO.
004700 03 FILE-STATUS-UITVOER PIC XX VALUE ZERO.
004800 01 SUB-LENGTE-SORTREC PIC S9(4) COMP-5.
004900 01 MREAD-GEBIED.
005000 03 MREAD-OUDST PIC X(33).
005100 03 MREAD-NIEUWST PIC X(33) VALUE SPACE.
005200 01 SYSTEEMTIJD-KWESTIES.
005300 03 TIJD PIC 9(8).
005400 03 DISP-TIJD PIC 99.99.99.99.
005500 03 INVOER-RECORDS PIC S9(9) COMP-5 VALUE ZERO.
005600 03 UITVOER-RECORDS PIC S9(9) COMP-5 VALUE ZERO.
005700 03 VERSCHIL-RECORDS PIC S9(9) COMP-5 VALUE ZERO.
005800 03 DISP-INVOER PIC ZZZ.ZZZ.ZZZ.
005900 03 DISP-UITVOER PIC ZZZ.ZZZ.ZZZ.
006000 03 DISP-VERSCHIL PIC ZZZ.ZZZ.ZZZ.
006100 01 JA-OF-NEE PIC X VALUE SPACE.
006200 01 ASCII-MET-ACCENT.
006300 03 FILLER PIC X VALUE 'a'.
006400 03 FILLER PIC X VALUE 'b'.
006500 03 FILLER PIC X VALUE 'c'.
006600 03 FILLER PIC X VALUE 'd'.
006700 03 FILLER PIC X VALUE 'e'.
006800 03 FILLER PIC X VALUE 'f'.
006900 03 FILLER PIC X VALUE 'g'.
007000 03 FILLER PIC X VALUE 'h'.
007100 03 FILLER PIC X VALUE 'i'.
007200 03 FILLER PIC X VALUE 'j'.
007300 03 FILLER PIC X VALUE 'k'.
007400 03 FILLER PIC X VALUE 'l'.
007500 03 FILLER PIC X VALUE 'm'.
007600 03 FILLER PIC X VALUE 'n'.
007700 03 FILLER PIC X VALUE 'o'.
007800 03 FILLER PIC X VALUE 'p'.
007900 03 FILLER PIC X VALUE 'q'.
008000 03 FILLER PIC X VALUE 'r'.
008100 03 FILLER PIC X VALUE 's'.
008200 03 FILLER PIC X VALUE 't'.
008300 03 FILLER PIC X VALUE 'u'.
008400 03 FILLER PIC X VALUE 'v'.
008500 03 FILLER PIC X VALUE 'w'.
008600 03 FILLER PIC X VALUE 'x'.
008700 03 FILLER PIC X VALUE 'y'.
008800 03 FILLER PIC X VALUE 'z'.
008900 01 ASCII-ZONDER-ACCENT.
009000 03 FILLER PIC X VALUE 'A'.
009100 03 FILLER PIC X VALUE 'B'.
009200 03 FILLER PIC X VALUE 'C'.
009300 03 FILLER PIC X VALUE 'D'.
009400 03 FILLER PIC X VALUE 'E'.
009500 03 FILLER PIC X VALUE 'F'.
009600 03 FILLER PIC X VALUE 'G'.
009700 03 FILLER PIC X VALUE 'H'.
009800 03 FILLER PIC X VALUE 'I'.
009900 03 FILLER PIC X VALUE 'J'.
010000 03 FILLER PIC X VALUE 'K'.
010100 03 FILLER PIC X VALUE 'L'.
010200 03 FILLER PIC X VALUE 'M'.
010300 03 FILLER PIC X VALUE 'N'.
010400 03 FILLER PIC X VALUE 'O'.
010500 03 FILLER PIC X VALUE 'P'.
010600 03 FILLER PIC X VALUE 'Q'.
010700 03 FILLER PIC X VALUE 'R'.
010800 03 FILLER PIC X VALUE 'S'.
010900 03 FILLER PIC X VALUE 'T'.
011000 03 FILLER PIC X VALUE 'U'.
011100 03 FILLER PIC X VALUE 'V'.
011200 03 FILLER PIC X VALUE 'W'.
011300 03 FILLER PIC X VALUE 'X'.
011400 03 FILLER PIC X VALUE 'Y'.
011500 03 FILLER PIC X VALUE 'Z'.
011600 PROCEDURE DIVISION.
011700 MAIN SECTION.
011800 MAIN-000.
011900 DISPLAY 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍSTART»'.
012000 DISPLAY 'º COBWORDS º'.
012100 DISPLAY 'º TEKST->KEY''S->SORT->QUITDOUB->TEKST º'.
012200 DISPLAY 'º COPYRIGHT(C) R.G. WOUTERSON º'.
012300 DISPLAY 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'.
012400 MOVE SPACE TO INVOER-NAAM.
012500 DISPLAY 'TOETS IN TEKSTFILE INPUT : ' WITH NO ADVANCING.
012600 ACCEPT INVOER-NAAM FROM CONSOLE.
012700 STRING INVOER-NAAM DELIMITED BY SPACE
012800 '[B:63]' DELIMITED BY SIZE INTO INVOER-NAAM.
012900 OPEN INPUT INVOER.
013000 IF FILE-STATUS-INVOER NOT = ZERO
013100 DISPLAY '* FOUTIEF OPGEGEVEN, DOE ''T NOG EENS *'
013200 GO TO MAIN-000.
013300 READ INVOER INTO ASCII-TEKEN
013400 AT END DISPLAY '* LEEG BESTAND *'
013500 STOP RUN.
013600 MAIN-005.
013700 MOVE SPACE TO UITVOER-NAAM.
013800 DISPLAY 'TOETS IN TEKSTFILE OUTPUT: ' WITH NO ADVANCING.
013900 ACCEPT UITVOER-NAAM FROM CONSOLE.
014000 STRING UITVOER-NAAM DELIMITED BY SPACE
014100 '[N:63]' DELIMITED BY SIZE INTO UITVOER-NAAM.
014200 OPEN INPUT UITVOER.
014300 IF FILE-STATUS-UITVOER = ZERO
014400 DISPLAY 'DIT BESTAND BESTAAT REEDS. DOORGAAN (J/N)?'
014500 ACCEPT JA-OF-NEE FROM CONSOLE
014600 IF NOT (JA-OF-NEE = 'J' OR 'j')
014700 GO TO MAIN-005.
014800 CLOSE UITVOER.
014900 OPEN OUTPUT UITVOER.
015000 IF FILE-STATUS-UITVOER NOT = ZERO
015100 DISPLAY '* FOUTIEF OPGEGEVEN, DOE ''T NOG EENS *'
015200 GO TO MAIN-005.
015300 MAIN-010.
015400 PERFORM DISPLAY-TIJD.
015500 MAIN-015.
015600 SORT SORTFILE ON ASCENDING KEY SORTREC
015700 INPUT PROCEDURE INPUT-SORT
015800 OUTPUT PROCEDURE OUTPUT-SORT.
015900 MAIN-999.
016000 MOVE INVOER-RECORDS TO DISP-INVOER.
016100 DISPLAY 'AANTAL INVOER COBWORDS: ' DISP-INVOER.
016200 CLOSE INVOER UITVOER.
016300 MOVE UITVOER-RECORDS TO DISP-UITVOER.
016400 DISPLAY 'AANTAL UITVOER COBWORDS: ' DISP-UITVOER.
016500 COMPUTE VERSCHIL-RECORDS = INVOER-RECORDS - UITVOER-RECORDS.
016600 MOVE VERSCHIL-RECORDS TO DISP-VERSCHIL.
016700 DISPLAY ' VERSCHIL: ' DISP-VERSCHIL.
016800 PERFORM DISPLAY-TIJD.
016900 DISPLAY 'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'.
017000 DISPLAY 'º COBWORDS º'.
017100 DISPLAY 'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍEINDE¼'.
017200 GOBACK.
017300
017400 INPUT-SORT SECTION.
017500 PERFORM UNTIL FILE-STATUS-INVOER NOT = ZERO
017600 IF ASCII-TEKEN NOT NUMERIC
017700 TRANSFORM ASCII-TEKEN FROM
017800 ASCII-MET-ACCENT TO ASCII-ZONDER-ACCENT
017900 IF ASCII-NUM > 64 AND < 91
018000 PERFORM WOORD
018100 ELSE
018200 READ INVOER INTO ASCII-TEKEN
018300 END-IF
018400 ELSE
018500 PERFORM WOORD
018600 END-IF
018700 END-PERFORM.
018800 CLOSE INVOER.
018900 WOORD SECTION.
019000 MOVE SPACE TO SORTREC.
019100 PERFORM VARYING SUB-LENGTE-SORTREC
019200 FROM +1 BY +1 UNTIL SUB-LENGTE-SORTREC >
019300 32 OR NOT (ASCII-NUM > 64 AND < 91 OR
019400 ASCII-NUM = 45 OR 95 OR
019500 ASCII-TEKEN NUMERIC)
019600 OR FILE-STATUS-INVOER NOT = ZERO
019700 MOVE ASCII-TEKEN TO SORT-TEKEN (SUB-LENGTE-SORTREC)
019800 READ INVOER INTO ASCII-TEKEN
019900 IF ASCII-TEKEN NOT NUMERIC
020000 TRANSFORM ASCII-TEKEN FROM
020100 ASCII-MET-ACCENT TO ASCII-ZONDER-ACCENT
020200 END-IF
020300 END-PERFORM.
020400******************************************************************
020500* WOORDEN > +32 KRIJGEN EEN ~ ALS ACHTERVOEGSEL *
020600******************************************************************
020700 IF SUB-LENGTE-SORTREC > +32
020800 MOVE '~' TO SORT-TEKEN (+33)
020900 PERFORM UNTIL NOT (ASCII-NUM > 64 AND < 91 OR
021000 ASCII-NUM = 45 OR 95 OR
021100 ASCII-TEKEN NUMERIC)
021200 OR FILE-STATUS-INVOER NOT = ZERO
021300 READ INVOER INTO ASCII-TEKEN
021400 IF ASCII-TEKEN NOT NUMERIC
021500 TRANSFORM ASCII-TEKEN FROM
021600 ASCII-MET-ACCENT TO ASCII-ZONDER-ACCENT
021700 END-IF
021800 END-PERFORM
021900 ELSE
022000 IF SORT-TEKEN (SUB-LENGTE-SORTREC - 1) = '-'
022100 MOVE SPACE TO SORT-TEKEN (SUB-LENGTE-SORTREC - 1)
022200 END-IF
022300 END-IF.
022400 RELEASE SORTREC.
022500
022600 OUTPUT-SORT SECTION.
022700 OUTP-000.
022800 RETURN SORTFILE AT END GO TO OUTP-999.
022900 ADD +1 TO INVOER-RECORDS.
023000 MOVE SORTREC TO MREAD-NIEUWST.
023100 WRITE UITVOER-REC FROM SORTREC.
023200 ADD +1 TO UITVOER-RECORDS.
023300 OUTP-005.
023400 MOVE MREAD-NIEUWST TO MREAD-GEBIED.
023500 RETURN SORTFILE AT END GO TO OUTP-999.
023600 ADD +1 TO INVOER-RECORDS.
023700 MOVE SORTREC TO MREAD-NIEUWST.
023800 IF MREAD-NIEUWST NOT = MREAD-OUDST
023900 WRITE UITVOER-REC FROM MREAD-NIEUWST
024000 ADD +1 TO UITVOER-RECORDS.
024100 GO TO OUTP-005.
024200 OUTP-999.
024300 EXIT.
024400
024500 DISPLAY-TIJD SECTION.
024600 DISP-000.
024700 ACCEPT TIJD FROM TIME.
024800 MOVE TIJD TO DISP-TIJD.
024900 DISPLAY 'TIJD: ' DISP-TIJD.
025000 DISP-999.
025100 EXIT.
[sig][/sig]

 

[Mingo]

Thanks for the info CROX.

Do I understand correctly that you would define calc field in WS and move calculated field to sort-rec? Still a bit confused about FD's and SD in this situation. As I understand it, records in FD's and SD all need to be the same size. How is it possible to add this calculated field to the sort rec, when it would make it different size to input rec? I have also read that you can remove unwanted fields from input record prior to sorting. Again how is this possible if input, sort and sorted records need to be the same size. [sig][/sig]

 

[Crox]

Hi Mingo,

Yes, you understand this correctly.

It is not necessary to do anything with an input or output file at all when you do a sort.

The sort is done with the SD file. It has only a relation with in- or output when you create this in your statement.

Look at the syntax of the SORT statement:

3.32 SORT Statement
Ü Copyright IBM Corp. 1984, 1993

The SORT statement accepts records from one or more files, sorts them
according to the specified key(s), and makes the sorted records available
either through an OUTPUT PROCEDURE or in an output file. See also &quot;MERGE
Statement&quot; in topic 3.21. The SORT statement can appear anywhere in the
| Procedure Division except in the declarative portion or within the scope
| of a SORT or MERGE input or output procedure.


|--- Format -----------------------------------------------------------------------------------|
| |
| <--------------------------------------------------| |
| <-------------| | |
| >>--SORT--file-name-1----|----|--|-ASCENDING--|--|-----|----data-name-1-|-|----------------> |
| |-ON-| |-DESCENDING-| |-KEY-| |
| |
| >--|-----------------------------------------|---------------------------------------------> |
| |-|------|--DUPLICATES--|----|--|-------|-| |
| | |-WITH-| |-IN-| |-ORDER-| |
| |
| >--|--------------------------------------------------|------------------------------------> |
| |-|-----------|--SEQUENCE--|----|--alphabet-name-1-| |
| |-COLLATING-| |-IS-| |
| |
| <-------------| |
| >--|-USING----file-name-2-|-------------------------------------------------------|--------> |
| |-INPUT PROCEDURE--|----|--procedure-name-1--|-------------------------------|-| |
| |-IS-| |-|-THROUGH-|--procedure-name-2-| |
| |-THRU----| |
| |
| <-------------| |
| >--|-GIVING----file-name-3-|-------------------------------------------------------|------>< |
| |-OUTPUT PROCEDURE--|----|--procedure-name-3--|-------------------------------|-| |
| |-IS-| |-|-THROUGH-|--procedure-name-4-| |
| |-THRU----| |
| |
|----------------------------------------------------------------------------------------------|
file-name-1
The name given in the SD entry that describes the records to be
sorted.

No pair of file-names in a SORT statement can be specified in the same
SAME SORT AREA, or SAME SORT-MERGE AREA clause. File-names associated with
the GIVING clause (file-name-3) cannot be specified in the SAME AREA
clause.

x File-names associated with the GIVING clause (file-name-3) can be
x specified in the SAME AREA clause.

This is clipped out of a IBM manual.

You can use the given example to sort things your own way.
You can put any keyfield and others too of course inside the record to sort.


[sig][/sig]

 

[BettyScherber]

Mingo-
I believe I can resolve your confusion about the record lengths and field sizes.

If you code a USING instead of an INPUT PROCEDURE, then the format of the USING (FD) file must be the same as the format of the SORT (SD) file.

If you code a GIVING instead of an OUTPUT PROCEDURE, then the format of the GIVING (FD) file must be the same as the format of the SORT (SD) file.
[sig][/sig]

 

[BettyScherber]

Mingo-
I believe I can resolve your confusion about the record lengths and field sizes.

If you code a USING instead of an INPUT PROCEDURE, then the format of the USING (FD) file must be the same as the format of the SORT (SD) file.

If you code a GIVING instead of an OUTPUT PROCEDURE, then the format of the GIVING (FD) file must be the same as the format of the SORT (SD) file.

Betty Scherber
Brainbench MVP for COBOL II

http://www.brainbench.com

[sig][/sig]