Bill Woodger
Moderator Emeritus
Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix
|
|
|
|
For this topic the TS has taken a wander, so I'm putting what I prepared here:
| Code: |
OPTION COPY
INREC IFOUTLEN=80,IFTHEN=(WHEN=INIT,OVERLAY= (26:SEQNUM,1,ZD)),
IFTHEN=(WHEN=GROUP,BEGIN=(26,1,BI,EQ,B'.......1'),
RECORDS=2,PUSH=(38:1,2,32:SEQ=1)),
IFTHEN=(WHEN=GROUP,BEGIN=(26,1,BI,EQ,B'.......0'),
RECORDS=2,PUSH=(45:1,2)),
IFTHEN=(WHEN=(45,2,CH,EQ,C' '),OVERLAY=(20:C'W',4:C'00')),
IFTHEN=(WHEN=(32,1,CH,EQ,C'2'),
OVERLAY=(20:C'X',4:1,2,ZD,
SUB,38,2,ZD,TO=ZD,LENGTH=2)),
IFTHEN=(WHEN=NONE,
OVERLAY=(20:C'Y',4:1,2,ZD,
SUB,45,2,ZD,TO=ZD,LENGTH=2))
OUTFIL REMOVECC,
HEADER1=(20:C'TYPE',
26:C'SEQN',
32:C'OSEQ',
38:C'LNUM',
45:C'RNUM')
//SORTIN DD *
10
15
17
25
30
35
40
45
50
55
99
|
Which produces this output (or should, it is untested reformatting of the results of the symbol substitution carried out by DFSORT and could easily contain some typos):
| Code: |
TYPE SEQN OSEQ LNUM RNUM
10 00 W 1 1 10
15 05 X 2 2 10 15
17 02 Y 3 1 17 15
25 08 X 4 2 17 25
30 05 Y 5 1 30 25
35 05 X 6 2 30 35
40 05 Y 7 1 40 35
45 05 X 8 2 40 45
50 05 Y 9 1 50 45
55 05 X 0 2 50 55
99 44 Y 1 1 99 55
|
Now, I didn't write the code like that, I wrote it like this:
| Code: |
//STEP0100 EXEC PGM=SORT
//SYMNAMES DD *
* INPUT RECORD
INREC-NUMBER,1,2,ZD
SKIP,1
* NEW DATA FOR OUTPUT RECORD
OUTREC-DIFF-TO-PREV-REC,*,2,ZD
* OVERLAYED/PUSHED DATA
TPYE-FLAG,20,1,CH
SKIP,5
EXTEND-SEQNUM,*,1,ZD
EXTEND-SEQNUM-BI,=,=,BI
SKIP,5
EXTEND-ODD-SEQ,*,1,ZD
EXTEND-ODD-SEQ-CH,=,=,CH
SKIP,5
EXTEND-LEFT-NUMBER,*,2,ZD
SKIP,5
EXTEND-RIGHT-NUMBER,*,2,ZD
EXTEND-RIGHT-NUMBER-CH,=,=,CH
* CONSTANTS
* TESTS
AN-ODD-NUMBER,B'.......1'
AN-EVEN-NUMBER,B'.......0'
NUMBER-AT-LEFT,C'2'
FIRST-RECORD-ON-FILE,C' '
* VALUES
ZERO-FIRST-CALC,C'00'
* FLAGS
FIRST-TO-BE-ZERO,C'W'
VALUE-FROM-LEFT,C'X'
VALUE-FROM-RIGHT,C'Y'
//SYSOUT DD SYSOUT=*
//SORTOUT DD SYSOUT=*
//SYSIN DD *
OPTION COPY
INREC IFOUTLEN=80,
IFTHEN=(WHEN=INIT,
OVERLAY=(EXTEND-SEQNUM:SEQNUM,1,ZD)),
IFTHEN=(WHEN=GROUP,
BEGIN=(EXTEND-SEQNUM-BI,EQ,AN-ODD-NUMBER),
RECORDS=2,
PUSH=(EXTEND-LEFT-NUMBER:INREC-NUMBER,
EXTEND-ODD-SEQ:SEQ=1)),
IFTHEN=(WHEN=GROUP,
BEGIN=(EXTEND-SEQNUM-BI,EQ,AN-EVEN-NUMBER),
RECORDS=2,
PUSH=(EXTEND-RIGHT-NUMBER:INREC-NUMBER)),
IFTHEN=(WHEN=(EXTEND-RIGHT-NUMBER-CH,EQ,FIRST-RECORD-ON-FILE),
OVERLAY=(TPYE-FLAG:FIRST-TO-BE-ZERO,
OUTREC-DIFF-TO-PREV-REC:ZERO-FIRST-CALC)),
IFTHEN=(WHEN=(EXTEND-ODD-SEQ-CH,EQ,NUMBER-AT-LEFT),
OVERLAY=(TPYE-FLAG:VALUE-FROM-LEFT,
OUTREC-DIFF-TO-PREV-REC:INREC-NUMBER,
SUB,
EXTEND-LEFT-NUMBER,
TO=ZD,LENGTH=2)),
IFTHEN=(WHEN=NONE,
OVERLAY=(TPYE-FLAG:VALUE-FROM-RIGHT,
OUTREC-DIFF-TO-PREV-REC:INREC-NUMBER,
SUB,
EXTEND-RIGHT-NUMBER,
TO=ZD,LENGTH=2))
OUTFIL REMOVECC,
HEADER1=(TPYE-FLAG:C'TYPE',
EXTEND-SEQNUM:C'SEQN',
EXTEND-ODD-SEQ:C'OSEQ',
EXTEND-LEFT-NUMBER:C'LNUM',
EXTEND-RIGHT-NUMBER:C'RNUM')
//SORTIN DD *
10
15
17
25
30
35
40
45
50
55
99 |
The output is shown in that way to aid the understanding of the solution.
Using the symbols/SYMNAMES it was very easy to produce a report on OUTFIL with column headings.
The spacing would not be used for the end solution, but very simply all the SKIP,5s would be removed, the FLAG and references to it would disappear (the purpose of the flag is to indicate which IFTHEN did what) and the OUTFIL would be removed. Everything still works, nothing to change.
The requirement can also be satisfied by using JOINKEYS along the lines of either of these examples:
http://www.ibmmainframes.com/viewtopic.php?p=291631#291631
http://www.ibmmainframes.com/viewtopic.php?p=300686#300686
They provide a means to have the "current" and "previous" records together on the REFORMAT record. |
|
