Joined: 07 Dec 2007 Posts: 2205 Location: San Jose
Bruno Oliveira,
The following DFSORT JCL will give you the desired results using a bunch of IFTHEN statements. However we don't code the IFTHEN statements but generate them and use them in the later step. I assumed your input to be FB recfm and LRECL=80
Code:
//STEP0100 EXEC PGM=SORT
//SYSOUT DD SYSOUT=*
//SORTIN DD *
DUMMY
//SORTOUT DD DSN=&&S1,DISP=(,PASS),SPACE=(CYL,(5,5),RLSE)
//SYSIN DD *
SORT FIELDS=COPY
OUTFIL REPEAT=276,IFOUTLEN=80,
IFTHEN=(WHEN=INIT,
OVERLAY=(81:SEQNUM,3,ZD,START=81,X,SEQNUM,3,ZD,START=23)),
IFTHEN=(WHEN=INIT,
OVERLAY=(85:81,3,ZD,SUB,(85,3,ZD,MOD,+23),EDIT=(TTT))),
IFTHEN=(WHEN=INIT,
BUILD=(3:C'IFTHEN=(WHEN=(',81,3,
C',1,CH,NE,C''',X,C'''',C'),OVERLAY=(',81,3,
C':',85,3,C',1),HIT=NEXT),',80:X))
//*
//STEP0200 EXEC PGM=SORT
//SYSOUT DD SYSOUT=*
//SORTIN DD *
IBM MAINFRAME FORUM |123|
DFSORT ICETOOL |123|
BRUNO GONCALO OLIVEIRA |123|
ABCDEFGHIJKLMNOPQRSTUVW|123|
A C E G I K M O Q S U W|123|
AB DE GH JK MN PQ ST VW|123|
//SORTOUT DD SYSOUT=*
//SYSIN DD *
SORT FIELDS=COPY
INREC IFOUTLEN=80,IFTHEN=(WHEN=INIT,OVERLAY=(81:1,23)),
IFTHEN=(WHEN=INIT,PARSE=(%01=(ABSPOS=81,ENDBEFR=C' ',FIXLEN=23),
%02=(ENDBEFR=C' ',FIXLEN=23),
%03=(ENDBEFR=C' ',FIXLEN=23),
%04=(ENDBEFR=C' ',FIXLEN=23),
%05=(ENDBEFR=C' ',FIXLEN=23),
%06=(ENDBEFR=C' ',FIXLEN=23),
%07=(ENDBEFR=C' ',FIXLEN=23),
%08=(ENDBEFR=C' ',FIXLEN=23),
%09=(ENDBEFR=C' ',FIXLEN=23),
%10=(ENDBEFR=C' ',FIXLEN=23),
%11=(ENDBEFR=C' ',FIXLEN=23),
%12=(ENDBEFR=C' ',FIXLEN=23)),
OVERLAY=(81:%01,%02,%03,%04,%05,%06,
%07,%08,%09,%10,%11,%12)),
// DD DSN=&&S1,DISP=SHR
// DD *
IFTHEN=(WHEN=(81,1,CH,NE,C' '),
OVERLAY=(81:81,276,SQZ=(SHIFT=LEFT,MID=C' '),01:81,23))
//*
The output from this job is
Code:
III MMMMMMMMM FFFFF |123|
DDDDDD IIIIIII |123|
BBBBB GGGGGGG OOOOOOOO |123|
AAAAAAAAAAAAAAAAAAAAAAA|123|
A C E G I K M O Q S U W|123|
AA DD GG JJ MM PP SS VV|123|
Joined: 09 Mar 2011 Posts: 7309 Location: Inside the Matrix
Ola Bruno,
It might seem strange to provide an answer in Cobol, but I "thought" someone said you needed an "EXIT" for it, and then Skolusu's code appeared :-) Short and uninteresting story.
First time only
MOVE LENGTH OF W-ATM-TABLE TO W-ATM-TABLE-LENGTH
MOVE LENGTH OF W-ATM-BYTE-BY-BYTE TO W-ATM-ENTRY-LENGTH
COMPUTE W-ATM-TEST-TABLE-SIZE = W-ATM-TABLE-LENGTH
/ W-ATM-ENTRY-LENGTH
IF W-ATM-TEST-TABLE-SIZE NOT EQUAL TO W-ATM-MAX-ENTRIES
collapse with appropriate diagnostic
END-IF
SET W-ATM-BYTE-INDEX TO W-ATM-MAX-ENTRIES
SET W-ATM-MAX-ENTRIES-INDEX TO W-ATM-BYTE-INDEX
Code:
SET W-NEW-MASK-BYTE-NEEDED TO TRUE
PERFORM
VARYING W-ATM-BYTE-INDEX
FROM 1 BY 1
UNTIL W-ATM-BYTE-INDEX > W-ATM-MAX-ENTRIES-INDEX
IF W-ATM-BYTE-IS-SPACE-SEPERATOR ( W-ATM-BYTE-INDEX )
SET W-NEW-MASK-BYTE-NEEDED TO TRUE
ELSE
IF W-NEW-MASK-BYTE-NEEDED
MOVE W-ATM-BYTE-BY-BYTE ( W-ATM-BYTE-INDEX ) TO W-BYTE-TO-USE-AS-MASK
* SET W-NEW-MASK-BYTE-NEEDED TO FALSE (which I can't do, so like the following)
MOVE SPACE TO W-NEW-MASK-BYTE-NEEDED-FLAG
ELSE
MOVE W-BYTE-TO-USE-AS-MASK TO W-ATM-BYTE-BY-BYTE ( W-ATM-BYTE-INDEX )
END-IF
END-IF
END-PERFORM
The first block of procedure is some "self-testing" stuff. Strictly the "maximum" stuff for the index is unnecessary to do like that, as the entry in the table is of length 1, but I prefer to have code which can be used in different situations.
The second block is doing the masking.
Unfortunately, no mainframe access so untested. If it works, it should work with single or multiple spaces, leading as well as trailing.
Yesterday I saw a reply saying that I should build an exit routine. I'll try to build and use my first exit routine testing Bill Woodger code (thank you).
Skolusu, as allways, your solution rocks! Many thanks!
LINKAGE SECTION.
01 RECORD-FLAGS PIC 9(8) BINARY.
88 FIRST-REC VALUE 00.
88 MIDDLE-REC VALUE 04.
88 END-REC VALUE 08.
01 IP-RECORD PIC X(80).
01 OP-RECORD PIC X(80).
PROCEDURE DIVISION USING RECORD-FLAGS
, IP-RECORD
, OP-RECORD.
IF END-REC
MOVE 8 TO RETURN-CODE
ELSE
MOVE IP-RECORD TO T-RECORD
MOVE 'N' TO WS-MASK-FLAG
PERFORM VARYING WS-SUB FROM 1 BY 1
UNTIL WS-SUB > 23
IF T-MASK-AREA(WS-SUB : 1) = ' '
MOVE 'Y' TO WS-MASK-FLAG
MOVE T-MASK-AREA(WS-SUB + 1 : 1)
TO WS-MASK-CHAR
MOVE T-MASK-AREA(WS-SUB : 1)
TO T-RECORD(WS-SUB : 1)
ELSE
IF WS-MASK-FLAG = 'N'
MOVE T-MASK-AREA(WS-SUB : 1)
TO WS-MASK-CHAR
MOVE 'Y' TO WS-MASK-FLAG
END-IF
MOVE WS-MASK-CHAR TO T-RECORD(WS-SUB : 1)
END-IF
END-PERFORM
MOVE T-RECORD TO OP-RECORD
MOVE 20 TO RETURN-CODE
END-IF
GOBACK.
And the sort step would be as follows
Code:
//STEP0100 EXEC PGM=SORT
//SYSOUT DD SYSOUT=*
//EXITC DD DSN=your cobol exit loadlib,DISP=SHR
//SORTIN DD *
IBM MAINFRAME FORUM |123|
DFSORT ICETOOL |123|
BRUNO GONCALO OLIVEIRA |123|
ABCDEFGHIJKLMNOPQRSTUVW|123|
A C E G I K M O Q S U W|123|
AB DE GH JK MN PQ ST VW|123|
ONESPCE1 BLAHBAH |123|
ONESPCE2 CIAO |123|
ONESPCE3 DADIDODAY |123|
ONESPCE4 EEEHAWWW |123|
//SORTOUT DD SYSOUT=*
//SYSIN DD *
SORT FIELDS=COPY
MODS E35=(MSKE35,800,EXITC,C)
//*