OUTREC: Inserting data


OUTREC can be used to insert the below data types between the fields in the output file. Those are -

  • Binary Zeroes
  • Blanks
  • Strings

Inserting Binary Zeros -


  • Insert binary zeros as place holders for the new field.
  • The new field may get to be filled in with data at a later date.
  • Z or 1Z used to specify a single binary zero.
  • nZ used to specify n binary zeros.

Syntax -


OUTREC FIELDS=(starting position of field1, length of field1,
		starting position of new field, new field length, nZ….. )
Starting position of field1Specifies field1 starting position in the input file after sorting.
Length of feild1 Field1 physical length in input file.
Starting position of new fieldStarting position of new field which needs to filled with zeroes
New field lengthNumber of positions that needs to filled with zeroes
nZn is number of zeroes.
n can be from 1 to 4095.
If n ignored, n can be treated as 1
Note! "n" and new field length should always match for the accurate results.

Example -


Scenario - Add 5 binary zeroes before std-number and the current record should start from 6th byte. The new output record layout would be

01 OUTPUT-REC.
	05 SEQ-NBR			PIC X(05).
  	05 STD-ID			PIC X(05).
	05 FILLER			PIC X(05).
	05 STD-NAME		PIC X(15).
	05 FILLER			PIC X(05).
	05 STD-DEPT	 	PIC X(10).
	05 FILLER			PIC X(05).
	05 STD-MARKS		PIC 9(03).    
	05 FILLER			PIC X(27).

Input File - MTHUSER.SORT.INPUT01 - FB file of 80 length

----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* Top of Data **********************************
00001     student1           dept1          560                                 
00003     student3           dept2          520                                 
00004     student4           dept1          540                                 
00005     student5           dept2          500                                 
00002     student2           dept3          510                                 
******************************** Bottom of Data ********************************

Input Record Layout -

01 INPUT-REC.
  	05 STD-ID			PIC X(05).
	05 FILLER			PIC X(05).
	05 STD-NAME		PIC X(15).
	05 FILLER			PIC X(05).
	05 STD-DEPT	 	PIC X(10).
	05 FILLER			PIC X(05).
	05 STD-MARKS		PIC 9(03).    
	05 FILLER			PIC X(32).

JCL -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
***************************** Top of Data ******************************
//Job-card 
//*                                                                     
//**********************************************************************
//*                                                                     
//* SORT FOR OUTREC STATEMENT                                           
//*                                                                     
//**********************************************************************
//STEP01   EXEC PGM=SORT                                                
//SORTIN   DD DSN=MTHUSER.SORT.INPUT01,DISP=SHR                    
//SORTOUT  DD SYSOUT=*                                                  
//SYSOUT   DD SYSOUT=*                                                  
//SYSIN    DD *                                                         
     SORT FIELDS=(1,5,CH,A)                                             
     OUTREC FIELDS=(5Z,1,75)                                            
/*                                                                      
**************************** Bottom of Data ****************************

Output -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* TOP OF DATA **********************************
0000000001     student1           dept1          560                            
0000000002     student2           dept3          510                            
0000000003     student3           dept2          520                            
0000000004     student4           dept1          540                            
0000000005     student5           dept2          500                            
******************************** BOTTOM OF DATA ********************************

Explaining Example -

  • OUTREC FIELDS=(5Z,…) will add 5 zeroes to the output record from the byte 1.
  • OUTREC FIELDS=(..,1,75) copies the input file data(1-75 positions) to the output file (starting from 6th byte).

Inserting Blanks -


OUTREC statement used to separate the fields with blanks and to create margins. A blank can insert before, between, or after fields.

X or 1X used to specify a single blank. nX used to specify n blanks.

Syntax -


OUTREC FIELDS=(starting position of field1, length of field1,nX….. )
Starting position of field1Specifies field1starting position in the input file after sorting.
Length of feild1 Field1 physical length in input file.
nXn is number of spaces.
n can be from 1 to 4095.
If n ignored, n can be treated as 1

Example -


Scenario - Insert 5 blanks before std-dept. The new output record layout would be

01 OUTPUT-REC.
  	05 STD-ID			PIC X(05).
	05 FILLER			PIC X(05).
	05 STD-NAME		PIC X(15).
	05 FILLER			PIC X(05).
	05 FILLER-1		PIC X(05).
	05 STD-DEPT	 	PIC X(10).
	05 FILLER			PIC X(05).
	05 STD-MARKS		PIC 9(03).    
	05 FILLER			PIC X(27).

Input File - MTHUSER.SORT.INPUT01 - FB file of 80 length

----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* Top of Data **********************************
00001     student1           dept1          560                                 
00003     student3           dept2          520                                 
00004     student4           dept1          540                                 
00005     student5           dept2          500                                 
00002     student2           dept3          510                                 
******************************** Bottom of Data ********************************

Input Record Layout -

01 INPUT-REC.
  	05 STD-ID			PIC X(05).
	05 FILLER			PIC X(05).
	05 STD-NAME		PIC X(15).
	05 FILLER			PIC X(05).
	05 STD-DEPT	 	PIC X(10).
	05 FILLER			PIC X(05).
	05 STD-MARKS		PIC 9(03).    
	05 FILLER			PIC X(32).

JCL -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
***************************** Top of Data ******************************
//Job-card 
//*                                                                     
//**********************************************************************
//*                                                                     
//* SORT FOR OUTREC STATEMENT                                           
//*                                                                     
//**********************************************************************
//STEP01   EXEC PGM=SORT                                                
//SORTIN   DD DSN=MTHUSER.SORT.INPUT01,DISP=SHR                    
//SORTOUT  DD SYSOUT=*                                                  
//SYSOUT   DD SYSOUT=*                                                  
//SYSIN    DD *                                                         
     SORT FIELDS=(1,5,CH,A)                                             
     OUTREC FIELDS=(5X,1,75)                                            
/*                                                                      
**************************** Bottom of Data ****************************

Output -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* TOP OF DATA **********************************
     00001     student1           dept1          560                            
     00002     student2           dept3          510                            
     00003     student3           dept2          520                            
     00004     student4           dept1          540                            
     00005     student5           dept2          500                            
******************************** BOTTOM OF DATA ********************************

Explaining Example -

  1. OUTREC FIELDS=(5X,…) will add 5 spaces to the output record from the byte 1.
  2. OUTREC FIELDS=(..,1,75) copies the input file data(1-75 positions) to the output file (starting from 6th byte).

Inserting Strings -


OUTREC can be used to setup a very basic report format by inserting strings. Normally the OUTFIL control statement can be used to create complex reports.

Character strings -

The format for writing a character string is: C’x...x’ where x is an EBCDIC character.

Syntax-1: Character strings


OUTREC FIELDS=(starting position of field1, length of field1, C’xx..xx’,….. )

Syntax-2: Repeating character strings


OUTREC FIELDS=(starting position of field1, length of field1,n:C’xx..xx’,….. )

Hexadecimal strings -

The format for writing a hexadecimal string is: X’yy...yy’where yyis a pair of hexadecimal digits.

Syntax-3: Hexa Deciamal strings


OUTREC FIELDS=(starting position of field1, length of field1,X’yy..yy’,….. )
Starting position of field1Specifies field1starting position in the input file after sorting.
Length of feild1 Field1 physical length in input file.
C’xx..xx’Character string that needs to be insert.
OUTREC will insert the string for the specific length
n:C’xx..xx’ n is the number of times character string repeats
X’yy..yy’ Hexa decimal string

Example -


Scenario - Insert "STUDENT NUMBER IS :" string before std-dept. The new output record layout would be

01 OUTPUT-REC.
	05 FILLER		PIC X(19).
  	05 STD-ID		PIC X(05).
	05 FILLER		PIC X(05).
	05 STD-NAME		PIC X(15).
	05 FILLER		PIC X(05).
	05 STD-DEPT	 	PIC X(10).
	05 FILLER		PIC X(05).
	05 STD-MARKS		PIC 9(03).    
	05 FILLER		PIC X(13).

Input File - MTHUSER.SORT.INPUT01 - FB file of 80 length

----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* Top of Data **********************************
00001     student1           dept1          560                                 
00003     student3           dept2          520                                 
00004     student4           dept1          540                                 
00005     student5           dept2          500                                 
00002     student2           dept3          510                                 
******************************** Bottom of Data ********************************

Input Record Layout -

01 INPUT-REC.
  	05 STD-ID		PIC X(05).
	05 FILLER		PIC X(05).
	05 STD-NAME		PIC X(15).
	05 FILLER		PIC X(05).
	05 STD-DEPT	 	PIC X(10).
	05 FILLER		PIC X(05).
	05 STD-MARKS	PIC 9(03).    
	05 FILLER		PIC X(32).

JCL -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
***************************** Top of Data ******************************
//Job-card 
//*                                                                     
//**********************************************************************
//*                                                                     
//* SORT FOR OUTREC STATEMENT                                           
//*                                                                     
//**********************************************************************
//STEP01   EXEC PGM=SORT                                                
//SORTIN   DD DSN=MTHUSER.SORT.INPUT01,DISP=SHR                    
//SORTOUT  DD SYSOUT=*                                                  
//SYSOUT   DD SYSOUT=*                                                  
//SYSIN    DD *                                                         
     SORT FIELDS=(1,5,CH,A)                                             
     OUTREC FIELDS=(1:C'STUDENT NUMBER IS :',1,61)                      
/*                                                                      
**************************** Bottom of Data ****************************

Output -

----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* TOP OF DATA **********************************
STUDENT NUMBER IS :00001     student1           dept1          560              
STUDENT NUMBER IS :00002     student2           dept3          510              
STUDENT NUMBER IS :00003     student3           dept2          520              
STUDENT NUMBER IS :00004     student4           dept1          540              
STUDENT NUMBER IS :00005     student5           dept2          500              
******************************** BOTTOM OF DATA ********************************

Explaining Example -

  1. OUTREC FIELDS=(1:C'STUDENT NUMBER IS :',1,61) will add 'STUDENT NUMBER IS :' to the output record from the byte 1.
  2. OUTREC FIELDS=(..,1,75) copies the input file data(1-75 positions) to the output file (starting from 6th byte).