z/OS DFSORT Application Programming Guide
Previous topic | Next topic | Contents | Contact z/OS | Library | PDF


DFSORT formats for COBOL data types

z/OS DFSORT Application Programming Guide
SC23-6878-00

Both DFSORT and COBOL support a large number of data types. COBOL describes these data types in one way, and DFSORT describes them in another way. If you SORT or MERGE with COBOL, the compiler automatically generates a SORT or MERGE control statement for you with the correct DFSORT descriptions for the COBOL fields you specify. But to take full advantage of DFSORT, you will often want to describe your fields in your own DFSORT control statements (for example, SORT, MERGE, INCLUDE, OMIT, INREC, OUTREC, OUTFIL, SUM) either outside of COBOL or in a DFSPARM data set used with COBOL. The table below will show you what DFSORT length and format to use for the various commonly used COBOL data types.

For example, say you want to separate out records in a very large file into two data sets based on the values in a PIC S9(4) COMP field starting in position 21. In the first data set, you want records with values in the field that are greater than or equal to +5000. In the second data set, you want records with values in the field that are less than -1000. You could use the table below to determine that a PIC S9(4) COMP field is equivalent to a DFSORT field with a length of 2 and a format of FI, allowing you to code your DFSORT statements as follows:

  OPTION COPY
  OUTFIL FNAMES=OUT1,INCLUDE=(21,2,FI,GE,+5000)
  OUTFIL FNAMES=OUT2,INCLUDE=(21,2,FI,LT,-1000) 
Table 1. Equivalent DFSORT formats for various COBOL data types
Equivalent DFSORT formats for various COBOL data typesCOBOL data type
DFSORT Length DFSORT Format
PIC X(n) USAGE DISPLAY n CH
GROUP DATA ITEMS with n bytes n CH
PIC 9(n) DISPLAY n ZD
PIC S9(n) DISPLAY <TRAILING> n ZD
PIC S9(n) DISPLAY LEADING n CLO
PIC S9(n) DISPLAY SEPARATE <TRAILING> n+1 CST
PIC S9(n) DISPLAY LEADING SEPARATE n+1 CSL or FS
PIC 9(n) COMP|BINARY|COMP-4|COMP-5    
   n = 1 to 4 2 BI
   n = 5 to 9 4 BI
   n >= 10 8 BI
PIC S9(n) COMP|BINARY|COMP-4|COMP-5    
   n = 1 to 4 2 FI
   n = 5 to 9 4 FI
   n >= 10 8 FI
PIC 9(n) COMP-3|PACKED-DECIMAL (n/2)+1 PD
PIC S9(n) COMP-3|PACKED-DECIMAL (n/2)+1 PD
COMP-1 4 FL
COMP-2 8 FL
Note:
  1. PIC 9(x)V9(y) can be treated like PIC 9(n) where n=x+y. (COBOL does NOT store the decimal point internally.)
  2. PIC S9(x)V9(y) can be treated like PIC S9(n) where n=x+y. (COBOL does NOT store the decimal point internally.)

Go to the previous page Go to the next page




Copyright IBM Corporation 1990, 2014