SORT FIELDS


  • DFSORT is used to sort the datasets.
  • Sorting can be done based on the specific position of the dataset
  • Sorting can also done based on the multiple positions of dataset (i.e. fields). But the sorting priority is from first field to last field.
  • If multiple positions of sorting specified, the order of priority is from left to right.
  • The sorting orders can be either Ascending or descending.

Syntax -


SORT FIELDS=(starting position, length, data format, A/D)
starting positionStarting position of field to be compared
Length Length of the field to be compared
data formatFormat of the field like CH, PD, BI etc,.
A/D Specifies the sorting order

Example -


Input File(PS) - MTHUSR1.SORTDATA.INPUT

-------------------------------------------------------------------------------
 BROWSE    MTHUSR1.SORTDATA.INPUT                     Line 00000000 Col 001 080 
 Command ===>                                                  Scroll ===> CSR  
----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* Top of Data **********************************
00001    PAWAN     KUMAR     Y         0000010000                               
00004    SRINIVASA RAO       C         0000020000                               
00003    SRIDHAR   R         G         0000030000                               
00002    KAMAL     K         S         0000040000                               
00006    RAJESH    KUMAR     Y         0000050000                               
00005    VENKAT    R         Y         0000060000                               
00004    GURU      R         N         0000010000                               
******************************** Bottom of Data ********************************

Input Layout -

01 EMP-REC.
	05 EMP-ID     			PIC X(5).
	05 FILLER      	 		PIC X(4).
	05 EMP-FIRST-NAME		PIC X(10).
	05 EMP-MIDDLE-NAME		PIC X(10).
	05 EMP-LAST-NAME		PIC X(10).
	05 EMP-SALARY			PIC 9(10).
	05 FILLER			PIC X(31).

Input layout mapping with file -

Sort Fields

Job -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
***************************** Top of Data ******************************
//JOB-CARD                                            
//STEP10  EXEC PGM=SORT                                                 
//SYSOUT    DD SYSOUT=*                                                 
//SORTIN    DD DSN=MTHUSR1.SORTDATA.INPUT,DISP=SHR                      
//SORTOUT   DD DSN=MTHUSR1.MULTISRT.OUTPUT,                             
//            DISP=(NEW,CATLG,DELETE),UNIT=SYSDA,                       
//            SPACE=(CYL,(1,4),RLSE),                                   
//            DCB=(RECFM=FB,LRECL=80,BLKSIZE=0)                         
//SYSIN     DD *                                                        
   SORT FIELDS=(1,5,CH,A,40,10,CH,A)                                    
/*                                                                      
**************************** Bottom of Data ****************************

Output -

--------------------------------------------------------------------------------
 BROWSE    MTHUSR1.MULTISRT.OUTPUT                    Line 00000000 Col 001 080 
 Command ===>                                                  Scroll ===> CSR  
----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* Top of Data **********************************
00001    PAWAN     KUMAR     Y         0000010000                               
00002    KAMAL     K         S         0000040000                               
00003    SRIDHAR   R         G         0000030000                               
00004    GURU      R         N         0000010000                               
00004    SRINIVASA RAO       C         0000020000                               
00005    VENKAT    R         Y         0000060000                               
00006    RAJESH    KUMAR     Y         0000050000                               
******************************** Bottom of Data ********************************

Explaning solution -

  1. SORT FIELDS=(1,5,CH,A,...) - Performs sort on the data in 1 to 5 positions to produce the result in ascending order.
  2. SORT FIELDS=(...,40,10,CH,A) - Performs sort on the result of the above step. Sort performed on the data in 40 to 50 positions to produce the result in ascending order.