IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

SORT - Multiple Conditions


IBM Mainframe Forums -> DFSORT/ICETOOL
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
john.mathew

New User


Joined: 22 Apr 2021
Posts: 7
Location: United States

PostPosted: Wed May 26, 2021 4:00 am
Reply with quote

Dear Sir,

I am trying to pull or extract data using multiple 'AND'/'OR' condition in single INCLUDE condition in SORT for the below requirement, but not getting the expected out come.

Please find below details.

Input file Structure:
Code:
01 A10-HEADER.
   05 RECORD-TYPE PIC X(03).
   05 SNAME       PIC X(06).
   05 SNO         PIC 9(04).
   05 DATE        PIC X(08).
01 A11-DETAIL.
   05 RECORD-TYPE PIC X(03).
   05 SUBJECT     PIC X(07).
   05 MARKS       PIC 9(03).
   05 STATUS      PIC X(01).


Input file:
Code:
A10JOHNNY100120200520
A11MATHS  080P
A11SCIENCE030F
A11ENGLISH085P
A10TOHNNY200120200420
A11SCIENCE030F
A11ENGLISH085P
A10POHNNY100220200520
A11MATHS  030F
A11SCIENCE030F
A11ENGLISH085P
A11SOCIAL 090P
A11CMPTERS080P
A10ROHNNY200220200420
A11SCIENCE030F
A11ENGLISH085P

The data in Input file formed such a way that, for each 'A10' record there would be 1 or multiple 'A11' records with 'Pass' (P) or 'Fail' (F) indicator on subjects. Requirement is, I need to find out, how many 'A11' records are having 'P' status for specific 'SNO'.

As per the sample input data provided above, there are 4 'A10' records with one or more 'A11' records under it. I wanted to pull out data of all 'A11' records that are having 'P' status for only Students (SNO) being '1001' & '1002'. Just to minimize number of input records as an example purpose, i have provided only two SNO's, but actually I need to pull this data for around 20 students in the volume of 1500 students.

Please advise.

What have been tried:
Code:

//STEP01 EXEC PGM=SORT
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SORTIN    DD DSN=INPUT.FILE1,DISP=SHR
//SORTOUT DD DSN=OUTPUT.FILE12,
// DISP=(NEW,CATLG,DELETE),
// SPACE=(CYL,(10,20),RLSE),
// DCB=(RECFM=FB,BLKSIZE=0,LRECL=80)
//SYSIN DD *
   SORT FIELDS=COPY
   INCLUDE COND=(((01,03,CH,EQ,C'A10',AND,10,04,CH,EQ,C'1001'),OR,
             (01,03,CH,EQ,C'A11',AND,14,01,CH,EQ,C'P')),OR,
            ((01,03,CH,EQ,C'A10',AND,10,04,CH,EQ,C'1002'),OR,
             (01,03,CH,EQ,C'A11',AND,14,01,CH,EQ,C'P')))
/*


As 'OR' condition for 'A11' not proper here its pulling 'A11' records for SNOs 2001 & 2002 as well which is not needed. Please provide some light on this.

Thank you
John
Back to top
View user's profile Send private message
Joerg.Findeisen

Senior Member


Joined: 15 Aug 2015
Posts: 1231
Location: Bamberg, Germany

PostPosted: Wed May 26, 2021 7:17 am
Reply with quote

You need to propagate the A10 records first and then compare with A11's. Sample:
Code:
OPTION COPY                                 
INREC IFTHEN=(WHEN=GROUP,                   
  BEGIN=(1,3,CH,EQ,C'A10'),PUSH=(40:1,21)) 
OUTFIL FNAMES=(SORTOUT),                   
  INCLUDE=(49,4,SS,EQ,C'1001,1002',AND,     
           1,3,CH,EQ,C'A11',AND,           
           14,1,CH,EQ,C'P'),               
  REMOVECC,                                 
  SECTIONS=(40,21,                         
    HEADER3=(40,21)),                       
  BUILD=(1,21)

Output:
Code:
A10JOHNNY100120200520
A11MATHS  080P       
A11ENGLISH085P       
A10POHNNY100220200520
A11ENGLISH085P       
A11SOCIAL 090P       
A11CMPTERS080P
Back to top
View user's profile Send private message
john.mathew

New User


Joined: 22 Apr 2021
Posts: 7
Location: United States

PostPosted: Wed May 26, 2021 7:15 pm
Reply with quote

Dear Joerge,

Thank you for your help providing information on this.

Could you please clarify me on reason for using starting position as '49' in INCLUDE condition. Because our SNO starts in position '10' in 'A10' record. Just trying to understand for any specific purpose to have as '49'. When I run it, getting empty output file. Please advise.

Code:
INCLUDE=(49,4,SS,EQ,C'1001,1002',AND,     
           1,3,CH,EQ,C'A11',AND,           
           14,1,CH,EQ,C'P')


Thank you
John
Back to top
View user's profile Send private message
Joerg.Findeisen

Senior Member


Joined: 15 Aug 2015
Posts: 1231
Location: Bamberg, Germany

PostPosted: Wed May 26, 2021 10:03 pm
Reply with quote

Let it run as follows to see what is happening:
Code:
//WHATEVER EXEC PGM=ICEMAN                   
//SORTIN   DD *                             
A10JOHNNY100120200520                       
A11MATHS  080P                               
A11SCIENCE030F                               
A11ENGLISH085P                               
A10TOHNNY200120200420                       
A11SCIENCE030F                               
A11ENGLISH085P                               
A10POHNNY100220200520                       
A11MATHS  030F                               
A11SCIENCE030F                               
A11ENGLISH085P                               
A11SOCIAL 090P                               
A11CMPTERS080P                               
A10ROHNNY200220200420                       
A11SCIENCE030F                               
A11ENGLISH085P                               
/*                                           
//SYSOUT   DD SYSOUT=*                       
//SORTOUT  DD SYSOUT=*                       
//SYSIN    DD *                             
  OPTION COPY                               
  INREC IFTHEN=(WHEN=GROUP,                 
    BEGIN=(1,3,CH,EQ,C'A10'),PUSH=(40:1,21))
  END                                       
  OUTFIL FNAMES=(SORTOUT),                   
    INCLUDE=(49,4,SS,EQ,C'1001,1002',AND,   
             1,3,CH,EQ,C'A11',AND,           
             14,1,CH,EQ,C'P'),               
    REMOVECC,                               
    SECTIONS=(40,21,                         
      HEADER3=(40,21)),                     
    BUILD=(1,21)                             
/*

Remove the END when the logic has been understood.
Back to top
View user's profile Send private message
john.mathew

New User


Joined: 22 Apr 2021
Posts: 7
Location: United States

PostPosted: Wed May 26, 2021 10:30 pm
Reply with quote

Thank you again for your help Joerg. It worked.
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> DFSORT/ICETOOL

 


Similar Topics
Topic Forum Replies
No new posts How to split large record length file... DFSORT/ICETOOL 7
No new posts INCLUDE OMIT COND for Multiple values... DFSORT/ICETOOL 5
No new posts Replace Multiple Field values to Othe... DFSORT/ICETOOL 12
No new posts JCL sort card - get first day and las... JCL & VSAM 9
No new posts How to load to DB2 with column level ... DB2 6
Search our Forums:

Back to Top