|
View previous topic :: View next topic
|
| Author |
Message |
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
I have an 381 LRECL input file. Each record starts with either 'ZZ' followed by one or more 'AA' records. So data looks like:
| Code: |
ZZlkwehlwhflwwhflhwflwfh..........
AAjlwehwhyeohfwfehfwefefe.......
AAweouwhyfowefyeofhwefoehf........
ZZwdlhfwflfhwlfwehfwlfwelfhwf........
AAwkjwehwejhwelfhwflfw...........
ZZoweyrwoyqpwebvbvorhwfbw.....
ZZkhwepiwehlfkhlfhlhq...........
AAweljhweleqyfoehq.................
AAeku2eipuriu4iupiuipuifhlwefnlfn......
AAwejhefehfelfhflhffff........ |
and so on..
the requirement is to compare each block of data starting from 'ZZ' of one record till before the next 'ZZ'(so each block willbe one ZZ record and one ore more AA records or no AA records at all) and discard all duplicate blocks (exact duplicate of entire block) and keep the first block only in the output file. No sorting should be done.
Please suggest on this. |
|
| Back to top |
|
 |
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
What should happen if duplicate blocks are not consecutive? Say block 3 and block 40 are duplicates? |
|
| Back to top |
|
|
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
| The first one should be retained and all subsequent blocks discarded. No sorting whatsoever should be done. |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
Then someone probably needs to reconsider this "requirement". . . |
|
| Back to top |
|
|
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
| This is beyond the scope of ICETOOL Sir? |
|
| Back to top |
|
|
sqlcode1
Active Member
Joined: 08 Apr 2010
Posts: 577
Location: USA
|
|
|
|
CICS fan,
Is there a limit to how many maximum AA records could follow ZZ records?
Thanks, |
|
| Back to top |
|
|
dbzTHEdinosauer
Global Moderator
Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne
|
|
|
|
| CICS fan wrote: |
| and keep the first block only in the output file |
nonsensical requirement: if the blocks are duplicate, how are you going to tell which was first.
can their be triplicate blocks? |
|
| Back to top |
|
|
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
| See, when we compare records only, we often ensure that only first record is kept and any subsequent is discared. Therecan be triplicate blocks..or more than that. |
|
| Back to top |
|
|
dbzTHEdinosauer
Global Moderator
Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne
|
|
|
|
| Quote: |
| See, when we compare records only, we often ensure that only first record is kept and any subsequent is discared. |
I realize that with Sort utility that distinction is easily made and adhered.
but, I think the DFSORT group will tell you to write a program,
or make multiple passes (if achievable).
you have two variables - size of blocks - number of AA records
- number of potential duplicate blocks
not only that, I assume you need to compare the complete 381 bytes.
nor did you answer the question, how many potential AA records can their be?
if it is less than 6 then there would be an obvious sort solution,
but if the number of AA records exceeded an amount that would require a very large record (ZZ AA AA AA AA AA) that could not be compared by sort,
the Sort team will have an interesting problem. |
|
| Back to top |
|
|
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
The number of AA records can be anything from equal to greater than zero.
And, yes, complete 381 bytes need to be considered. |
|
| Back to top |
|
|
dbzTHEdinosauer
Global Moderator
Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne
|
|
|
|
| Quote: |
| The number of AA records can be anything from equal to greater than zero. |
can there be 10, 15 AA records? |
|
| Back to top |
|
|
sqlcode1
Active Member
Joined: 08 Apr 2010
Posts: 577
Location: USA
|
|
|
|
CICS fan,
| Quote: |
| The number of AA records can be anything from equal to greater than zero. |
Is there a maximum number? AFAIK, currently there is no functionality in DFsort to compare block of data. So you will have trick your input file.
I was asking for maximum number of AA records under ZZ because, I was trying to develop a solution which would take all the AA record under a group and will align them horizontally. By doing this, you are playing with single record to remove duplicates. Later when you have removed duplicates, you can use OUTFIL BUILD to break them into multiple records.
I am still not sure if this method works or not but I will try if you could provide maximum number of detail records under a group.
Thanks, |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
I believe that a big issue is that the duplicate blocks can be anywhere in the file - not consecutive.
If the file only has 1,000,000 records and these are not in some kind of "group sequence", it i suspect it will be problematic to identify "all of the duplicate blocks" so that only the "first" block is retained. |
|
| Back to top |
|
|
dbzTHEdinosauer
Global Moderator
Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne
|
|
|
|
point is, how can anyone prove that the retained is the first duplicate.
as I said before,
it is nonsensical to insist on retaining the 'first' of a set of dups.
why???????????????? |
|
| Back to top |
|
|
enrico-sorichetti
Superior Member
Joined: 14 Mar 2007
Posts: 10873
Location: italy
|
|
|
|
Hi Dick!
I am trying to understand and explain
if the records are in sequence any duplicate will do,
but if the records are <unordered> and the undupped file must retain the
original <unordered> pseudo-sequence then asking to keep the first occurrence of the duplicate <thing> seems legitimate to me 
| Code: |
35
99
18
66
18
14
99
keeping the first would result in
35
99
18
66
14
|
|
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
Which may the reason for:
| Quote: |
| . . . discard all duplicate blocks (exact duplicate of entire block) and keep the first block only in the output file. No sorting should be done. |
The records/blocks are "in order" but not by something "code" might use.
It would help me (at least) to understand what this data really is (not the actual content, but what business process it is involved with). I never have done well with alphabet-soup. . .  |
|
| Back to top |
|
|
dbzTHEdinosauer
Global Moderator
Joined: 20 Oct 2006
Posts: 6966
Location: porcelain throne
|
|
|
|
Enrico,
thx! I understand. appreciate the 'insight'. |
|
| Back to top |
|
|
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
| Thanks enrico. couldnt have explained better. so the concensus is that ICETOOL/DFSORT cannot provide a solution here, is it? |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
I suspect that the concensus is that as stated, nothing can do what is wanted. . . This has nothng to do with the capabilities of the sort or some other utility or some custom-written code. This has to do with the way the requirement has been posted.
It is doubtful that the technical capability exists to do this (again, as stated) for hgh-volume data.
If this is really wanted, suggest consideration be given to getting the groups in sequence, identifying duplicates, and then putting the output back into the original order. . . |
|
| Back to top |
|
|
CICS fan
New User
Joined: 03 Apr 2008
Posts: 82
Location: United States
|
|
|
|
| Thanks Dick..I understand. |
|
| Back to top |
|
|
Skolusu
Senior Member
Joined: 07 Dec 2007
Posts: 2205
Location: San Jose
|
|
|
|
CICS fan,
Your requirement and rules to achieve the results are unrealistic. You posted a question in DFSORT and you don't want to SORT.
Since you came up with a unrealistic requirement , you concluded that it is beyond the scope of DFSORT? Aren't you judging here? As a developer of DFSORT , I do take offense on such judgments and conclusions.
Forget about DFSORT, can you write down a program any of the languages on mainframe to compare blocks of data with rules listed below?
1. The file has an LRECL of 32720 and RECFM = FB
2. There are 74 million records.
3. Each block can contain variable number of records.
4. The number of duplicate blocks can vary from 1 to 256 blocks
Last but not least , the most important rules .
a. The file should NOT be sorted
b. The file should ONLY be read ONCE.
Pick any programming language of choice on the mainframe and you don't even have to write the entire program , just give me a pseudo code which you think will work.
Thank you
Kolusu |
|
| Back to top |
|
|
Ronald Burr
Active User
Joined: 22 Oct 2009
Posts: 293
Location: U.S.A.
|
|
|
|
The OP originally stated that the LRECL was 381, not 32,720. So, with a "block" LRECL of 32,385 a "block" could handle up to 84 type 'AA' records in addition to the 'ZZ' block header record. Given that constraint and a suitably large VSAM KSDS, the job COULD be done in COBOL in a single pass - albeit not very efficiently.
First, One woud need to DEFINE and initialize a VSAM KSDS with KEYS(255 0) and a suitable CISIZE. After that, the pseudo code might look like this (assumes DYNAMIC VSAM file access):
| Code: |
OPEN OUTPUT OUTPUT-FILE
IF FILE-STATUS NOT EQUAL ZERO
DISPLAY 'OPEN OUTPUT FAILED WITH STATUS' FILE-STATUS
SET TIME-TO-ABEND TO TRUE
END-IF
IF NOT TIME-TO-ABEND
OPEN I-O VSAM-FILE
IF FILE-STATUS NOT EQUAL ZERO
DISPLAY 'OPEN VSAM FAILED WITH STATUS' FILE-STATUS
SET TIME-TO-ABEND TO TRUE
END-IF
IF NOT TIME-TO-ABEND
OPEN INPUT INPUT-FILE
IF FILE-STATUS NOT EQUAL ZERO
DISPLAY 'OPEN INPUT FAILED WITH STATUS' FILE-STATUS
SET TIME-TO-ABEND TO TRUE
END-IF
IF NOT TIME-TO-ABEND
SET TS-NDX1 TO 1
READ INPUT-FILE
MOVE INPUT-RECORD TO TEST-SEGMENT(TS-NDX1)
PERFORM
WITH TEST AFTER
UNTIL INPUT-FILE-EOF
PERFORM
WITH TEST AFTER
UNTIL INPUT-FILE-EOF OR
INPUT-TYPE = 'ZZ'
READ INPUT-FILE
AT END
SET INPUT-FILE-EOF TO TRUE
NOT AT END
IF INPUT-TYPE EQUAL 'AA'
SET TS-NDX UP BY 1
MOVE INPUT-RECORD TO TEST-SEGMENT(TS-NDX1)
END-PERFORM
MOVE TEST-RECORD-KEY TO VSAM-FILE-KEY
SET SEARCH-START TO TRUE
START VSAM-FILE KEY EQUAL TEST-RECORD-KEY
IF FILE-STATUS NOT EQUAL ZERO
SET SEARCH-FAILED TO TRUE
ELSE
PERFORM
WITH TEST BEFORE
UNTIL SEARCH-MATCHED OR
SEARCH-FAILED
IF TEST-RECORD = VSAM-RECORD
SET SEARCH-MATCHED TO TRUE
ELSE
READ VSAM-FILE NEXT
IF FILE-STATUS NOT EQUAL ZERO OR
VSAM-RECORD-KEY NOT EQUAL TEST-RECORD-KEY
SET SEARCH-FAILED TO TRUE
END-IF
END-IF
END-PERFORM
END-IF
IF SEARCH-FAILED
MOVE TEST-RECORD-KEY TO VSAM-RECORD-KEY
WRITE VSAM-FILE-RECORD FROM TEST-RECORD
PERFORM
WITH TEST BEFORE
VARYING TS-NDX2
FROM 1
BY 1
UNTIL TS-NDX2 GREATER THAN TS-NDX1
WRITE OUTPUT-FILE-RECORD FROM TEST-SEGMENT(TS-NDX2)
END-PERFORM
END-IF
IF NOT INPUT-FILE-EOF
SET TS-NDX1 TO 1
MOVE INPUT-RECORD TO TEST-SEGMENT(TS-NDX1)
END-IF
END-PERFORM
IF TIME-TO-ABEND
MOVE +16 TO RETURN-CODE
ELSE
MOVE ZERO TO RETURN-CODE
END-IF
GOBACK. |
|
|
| Back to top |
|
|
Skolusu
Senior Member
Joined: 07 Dec 2007
Posts: 2205
Location: San Jose
|
|
|
|
| Ronald Burr wrote: |
The OP originally stated that the LRECL was 381, not 32,720. So, with a "block" LRECL of 32,385 a "block" could handle up to 84 type 'AA' records in addition to the 'ZZ' block header record. Given that constraint and a suitably large VSAM KSDS, the job COULD be done in COBOL in a single pass - albeit not very efficiently.
First, One woud need to DEFINE and initialize a VSAM KSDS with KEYS(255 0) and a suitable CISIZE. After that, the pseudo code might look like this (assumes DYNAMIC VSAM file access) |
Ronald,
1. The LRECl is 381. OP considers entire 381 bytes as a key. (exact duplicate of entire block). Even if the key is 255 bytes you would still have problem with points 4 and 5.
2. There is ONLY 1 file.
3. Given that you based your code on dynamic access in COBOL, the only VSAM clusters that support that function are KSDS and RRDS
4. KSDS does NOT support duplicates on keys unless alternate index is used
5. RRDS cannot be searched on the key value as the records in an RRDS cluster may be accessed sequentially, in relative record number order, or directly, by supplying the relative record number of the desired record.
Thank you
Kolusu |
|
| Back to top |
|
|
Ronald Burr
Active User
Joined: 22 Oct 2009
Posts: 293
Location: U.S.A.
|
|
|
|
1. The Op does NOT consider the entire 381 bytes as a key. The OP never used the word 'key'. The 'KEY' specification was entirely your invention.
2. The OP never placed a constraint on the number of work files, and I have no idea what point you are trying to make with the "ONLY 1 file." comment. My code only uses one input file.
3. That is correct. And I AM using a KSDS, so there is no problem.
4. That is correct. So it would seem that a slight variation is needed to insure that the keys are unique - a rather simple modification.
5. That is correct - but I'm not using a RRDS, so there is no problem.
6. The code I provided was only pseudo code - I never represented it to be syntactically correct, compilable, and working as it was written. It only represented a STARTING POINT for building working-code. Here is REAL code..
Revised syntactically correct, compilable, working AND TESTED code:
| Code: |
IDENTIFICATION DIVISION.
PROGRAM-ID. DELDUPS.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO IPFILE
FILE STATUS IS WS-FILE-STATUS.
SELECT OUTPUT-FILE ASSIGN TO OPFILE
FILE STATUS IS WS-FILE-STATUS.
SELECT VSAM-FILE ASSIGN TO WORKFILE
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS VSAM-SEG1-KEY
FILE STATUS IS WS-FILE-STATUS
WS-VSAM-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD VSAM-FILE.
01 FD-VSAM-RECORD.
05 VSAM-SEGMENT-1.
10 VSAM-SEG1-KEY.
15 VSAM-SEG1-ID PIC X(251).
15 VSAM-SEG1-SEQ PIC S9(9) COMP-5.
10 VSAM-SEG1-BLKCNT PIC S9(9) COMP-5.
10 VSAM-SEG1-SEGCNT PIC S9(2) COMP-5.
05 VSAM-SEGS-2-85.
10 VSAM-SEGMENT PIC X(381) OCCURS 0 TO 85
DEPENDING ON VSAM-SEG1-SEGCNT
INDEXED BY VS-NDX1 VS-NDX2.
FD INPUT-FILE
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS.
01 FD-INPUT-RECORD.
05 INPUT-TYPE PIC XX.
05 INPUT-REST PIC X(379).
FD OUTPUT-FILE
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS.
01 FD-OUTPUT-RECORD.
05 OUTPUT-TYPE PIC XX.
05 OUTPUT-REST PIC X(379).
WORKING-STORAGE SECTION.
01 WS-FIELDS.
05 WS-PROGID PIC X(8) VALUE 'DELDUPS '.
05 WS-IPBLK-COUNT PIC 9(9) VALUE ZERO.
05 WS-IPREC-COUNT PIC 9(9) VALUE ZERO.
05 WS-OPBLK-COUNT PIC 9(9) VALUE ZERO.
05 WS-OPREC-COUNT PIC 9(9) VALUE ZERO.
05 WS-FILE-STATUS PIC XX.
88 WS-GOOD-IO VALUE '00'.
88 WS-WRONG-LENGTH-RECORD VALUE '04'.
88 WS-END-OF-FILE VALUE '10'.
88 WS-DUPLICATE-RECORD VALUE '22'.
88 WS-RECORD-NOT-FOUND VALUE '23'.
88 WS-IMPLICIT-VERIFY VALUE '97'.
05 WS-VSAM-FILE-STATUS.
10 WS-VS-RETURN-CODE PIC 9(4) COMP.
10 WS-VS-FUNCTION-CODE PIC 9(4) COMP.
10 WS-VS-FEEDBACK-CODE PIC 9(4) COMP.
05 WS-DISP-STATUS PIC 9(4).
05 WS-RETURN PIC X VALUE SPACE.
88 TIME-TO-ABEND VALUE 'Y'.
05 FILLER PIC X(12) VALUE 'I/P FILE IS '.
05 IPFILE-SWITCH PIC X(6) VALUE 'CLOSED'.
88 IPFILE-IS-CLOSED VALUE 'CLOSED'.
88 IPFILE-IS-AT-END VALUE 'AT END'.
88 IPFILE-IS-OPENED VALUE 'OPENED'.
05 FILLER PIC X(12) VALUE 'O/P FILE IS '.
05 OPFILE-SWITCH PIC X(6) VALUE 'CLOSED'.
88 OPFILE-IS-CLOSED VALUE 'CLOSED'.
88 OPFILE-IS-AT-END VALUE 'AT END'.
88 OPFILE-IS-OPENED VALUE 'OPENED'.
05 FILLER PIC X(12) VALUE 'WORKFILE IS '.
05 WORKFILE-SWITCH PIC X(6) VALUE 'CLOSED'.
88 WORKFILE-IS-CLOSED VALUE 'CLOSED'.
88 WORKFILE-IS-AT-END VALUE 'AT END'.
88 WORKFILE-IS-OPENED VALUE 'OPENED'.
05 WS-SEARCH-SWITCH PIC X VALUE 'N'.
88 SEARCH-STARTED VALUE 'S'.
88 SEARCH-FAILED VALUE 'F'.
88 SEARCH-MATCHED VALUE 'M'.
05 WS-DT-MSG.
10 WS-DT-PROGID PIC X(8).
10 FILLER PIC X(12) VALUE ' PROCESSING '.
10 WS-DT-STATUS PIC X(10).
10 FILLER PIC X(4) VALUE ' ON '.
10 WS-DATE.
15 WS-CC PIC XX VALUE '20'.
15 WS-YYMMDD PIC 9(6).
10 FILLER PIC X(4) VALUE ' AT '.
10 WS-TIME PIC 9(8).
01 WS-TEST-RECORD.
05 TEST-SEGMENT-1.
10 TEST-SEG1-KEY.
15 TEST-SEG1-ID PIC X(251).
15 TEST-SEG1-SEQ PIC S9(9) COMP-5.
10 TEST-SEG1-BLKCNT PIC S9(9) COMP-5.
10 TEST-SEG1-SEGCNT PIC S9(2) COMP-5.
05 TEST-SEGS-2-85.
10 TEST-SEGMENT PIC X(381) OCCURS 0 TO 85
DEPENDING ON TEST-SEG1-SEGCNT
INDEXED BY TS-NDX1 TS-NDX2.
PROCEDURE DIVISION.
PERFORM 1000-INITIALIZATION
IF NOT TIME-TO-ABEND
PERFORM 2000-MAIN-LINE
WITH TEST AFTER
UNTIL TIME-TO-ABEND OR
IPFILE-IS-AT-END
END-IF
PERFORM 3000-TERMINATION
IF TIME-TO-ABEND
MOVE +16 TO RETURN-CODE
ELSE
MOVE ZERO TO RETURN-CODE
END-IF
GOBACK.
1000-INITIALIZATION.
MOVE 'STARTED' TO WS-DT-STATUS
PERFORM 4000-DISPLAY-DATETIME
OPEN INPUT INPUT-FILE
IF WS-GOOD-IO
SET IPFILE-IS-OPENED TO TRUE
ELSE
DISPLAY 'IPFILE OPEN FAILED WITH STATUS: ' WS-FILE-STATUS
SET TIME-TO-ABEND TO TRUE
END-IF
IF NOT TIME-TO-ABEND
OPEN OUTPUT OUTPUT-FILE
IF WS-GOOD-IO
SET OPFILE-IS-OPENED TO TRUE
ELSE
DISPLAY 'OPFILE OPEN FAILED WITH STATUS: '
WS-FILE-STATUS
SET TIME-TO-ABEND TO TRUE
END-IF
END-IF
IF NOT TIME-TO-ABEND
OPEN I-O VSAM-FILE
IF WS-GOOD-IO OR
WS-IMPLICIT-VERIFY
SET WORKFILE-IS-OPENED TO TRUE
ELSE
DISPLAY 'WORKFILE OPEN FAILED WITH STATUS: '
WS-FILE-STATUS
PERFORM 4200-DISPLAY-VSAM-STATS
SET TIME-TO-ABEND TO TRUE
END-IF
END-IF
*
* WRITE HIGH-VALUES "TRAILER" TO VSAM FILE. THIS IS TO PREVENT
* A START ERROR FOR A KEY HIGHER THAN THE HIGHEST RECORD
*
MOVE HIGH-VALUES TO FD-VSAM-RECORD
MOVE ZERO TO VSAM-SEG1-SEGCNT
WRITE FD-VSAM-RECORD
IF WS-GOOD-IO
CONTINUE
ELSE
DISPLAY 'WORKFILE INITIALIZATION FAILED WITH STATUS: '
WS-FILE-STATUS
PERFORM 4200-DISPLAY-VSAM-STATS
SET TIME-TO-ABEND TO TRUE
END-IF
*
* READ FIRST INPUT RECORD AND INITIALIZE TEST-RECORD
*
IF NOT TIME-TO-ABEND
MOVE 1 TO WS-IPREC-COUNT
READ INPUT-FILE
AT END
MOVE ZERO TO WS-IPREC-COUNT
DISPLAY 'IPFILE IS EMPTY'
SET TIME-TO-ABEND TO TRUE
NOT AT END
IF WS-GOOD-IO
CONTINUE
ELSE
DISPLAY 'IPFILE READ FAILED WITH STATUS: '
WS-FILE-STATUS
' AT RECORD #: ' WS-IPBLK-COUNT
SET TIME-TO-ABEND TO TRUE
END-IF
END-READ
IF NOT TIME-TO-ABEND
SET TS-NDX1 TO 1
MOVE FD-INPUT-RECORD TO TEST-SEG1-ID
MOVE ZERO TO TEST-SEG1-SEQ
MOVE FD-INPUT-RECORD TO TEST-SEGMENT(TS-NDX1)
MOVE +1 TO TEST-SEG1-BLKCNT
MOVE +1 TO TEST-SEG1-SEGCNT
END-IF
CONTINUE.
2000-MAIN-LINE.
ADD 1 TO WS-IPBLK-COUNT
*
* THE FOLLOWING PERFORM BUILDS THE TEST RECORD (A 'ZZ' RECORD
* AND ALL OF THE SUBSEQUENT RELATED 'AA' RECORDS ). AT THE
* END OF THE PERFORM, TEST-SEGMENT WILL CONTAIN THE KEY
* (FIRST 247 BYTES OF THE 'ZZ' RECORD), TEST-SEG1-SEGCNT WILL
* CONTAIN THE TOTAL NUMBER OF SEGMENTS IN TEST-RECORD, AND
* FD-INPUT-RECORD WILL CONTAIN THE NEXT 'ZZ' RECORD, UNLESS
* THE FILE IS AT END-OF-FILE.
.
*
PERFORM
WITH TEST AFTER
UNTIL TIME-TO-ABEND OR
IPFILE-IS-AT-END OR
INPUT-TYPE = 'ZZ'
ADD 1 TO WS-IPREC-COUNT
READ INPUT-FILE
AT END
SUBTRACT 1 FROM WS-IPREC-COUNT
SET IPFILE-IS-AT-END TO TRUE
NOT AT END
IF WS-GOOD-IO
IF INPUT-TYPE EQUAL 'AA'
SET TS-NDX1 UP BY 1
IF TS-NDX1 > 85
DISPLAY 'RECORD # ' WS-IPREC-COUNT
' IS 85TH TYPE ''AA'' RECORD IN '
'BLOCK # ' WS-IPBLK-COUNT
SET TIME-TO-ABEND TO TRUE
ELSE
MOVE FD-INPUT-RECORD
TO TEST-SEGMENT(TS-NDX1)
END-IF
ELSE
CONTINUE
ELSE
DISPLAY 'IPFILE READ FAILED WITH STATUS: '
WS-FILE-STATUS
' AT RECORD #: ' WS-IPREC-COUNT
SET TIME-TO-ABEND TO TRUE
END-IF
END-READ
END-PERFORM
*
* WE WILL NOW ATTEMPT TO START THE VSAM FILE WITH A KEY EQUAL
* TO OR GREATE THAN THE TEST-RECORD KEY (USING A SEQ # OF ZERO)
*
IF NOT TIME-TO-ABEND
MOVE ZERO TO TEST-SEG1-SEQ
MOVE TEST-SEGMENT-1 TO VSAM-SEGMENT-1
SET TEST-SEG1-SEGCNT TO TS-NDX1
SET SEARCH-STARTED TO TRUE
START VSAM-FILE KEY NOT LESS THAN VSAM-SEG1-KEY
INVALID KEY
DISPLAY 'WORKFILE READ FAILED WITH STATUS: '
WS-FILE-STATUS
PERFORM 4200-DISPLAY-VSAM-STATS
SET TIME-TO-ABEND TO TRUE
END-START
END-IF
*
* IF THE START WAS SUCCESSFUL, WE WILL READ VSAM RECORDS UNTIL
* WE EITHER FIND A NON-MATCHING KEY, OR FIND A RECORD THAT
* FULLY MATCHES ALL SEGMENTS OF THE CURRENT TEST RECORD. A
* FLAG WILL BE SET TO INDICATE SUCCESS/FAILURE
*
IF NOT TIME-TO-ABEND
MOVE WS-IPBLK-COUNT TO TEST-SEG1-BLKCNT
PERFORM
WITH TEST BEFORE
UNTIL SEARCH-MATCHED OR
SEARCH-FAILED
READ VSAM-FILE NEXT RECORD
*
* IF THE KEYS (MINUS THE SEQ) MATCH, WE'LL SAVE THE
* VSAM KEY'S SEQ (+1) IN THE TEST RECORD (FOR LATER)
* IF THE KEYS (MINUS THE SEQ) DON'T MATCH, WE'RE DONE
*
IF WS-GOOD-IO
IF VSAM-SEG1-ID EQUAL TEST-SEG1-ID
COMPUTE TEST-SEG1-SEQ = VSAM-SEG1-SEQ + 1
ELSE
SET SEARCH-FAILED TO TRUE
END-IF
ELSE
DISPLAY 'WORKFILE READ FAILED WITH STATUS: '
WS-FILE-STATUS
PERFORM 4200-DISPLAY-VSAM-STATS
SET TIME-TO-ABEND TO TRUE
END-IF
*
* IF THE KEYS (MINUS THE SEQ) MATCH, BUT THE SEGMENT
* COUNTS DON'T, IT'S A MISS, AND WE HAVE TO KEEP LOOKING.
* IF THE COUNTS DO MATCH, WE NEED TO COMPARE EVERY VSAM
* SEGMENT TO ITS CORRESPONDING TEST SEGMENT. IF THERE
* IS ANY MISMATCH, THEN IT'S A MISS, AND WE HAVE TO KEEP
* LOOKING. IF ALL SEGMENTS DO MATCH, IT'S A HIT.
*
IF NOT TIME-TO-ABEND AND
NOT SEARCH-FAILED
IF VSAM-SEG1-SEGCNT NOT EQUAL TEST-SEG1-SEGCNT
CONTINUE
ELSE
MOVE 1 TO VSAM-SEG1-SEGCNT
PERFORM
WITH TEST BEFORE
UNTIL SEARCH-MATCHED OR
SEARCH-FAILED
IF TEST-SEGMENT(VSAM-SEG1-SEGCNT) EQUAL
VSAM-SEGMENT(VSAM-SEG1-SEGCNT)
ADD 1 TO VSAM-SEG1-SEGCNT
IF VSAM-SEG1-SEGCNT GREATER THAN
TEST-SEG1-SEGCNT
SET SEARCH-MATCHED TO TRUE
DISPLAY 'IPFILE BLOCK: '
TEST-SEG1-BLKCNT
' MATCHED BLOCK: '
VSAM-SEG1-BLKCNT
' AND WAS DISCARDED.'
END-IF
ELSE
SET SEARCH-FAILED TO TRUE
END-IF
END-PERFORM
IF SEARCH-FAILED
SET SEARCH-STARTED TO TRUE
END-IF
END-IF
END-IF
END-PERFORM
END-IF
*
* IF THE SEARCH FAILED, WE MUST DO TWO THINGS:
* 1. WRITE ALL OF THE TEST SEGMENTS TO THE OUTPUT FILE, AND
* 2. WRITE THE TEST RECORD TO THE VSAM FILE.
*
IF NOT TIME-TO-ABEND
IF SEARCH-FAILED
MOVE TEST-SEG1-SEGCNT TO VSAM-SEG1-SEGCNT
MOVE WS-TEST-RECORD TO FD-VSAM-RECORD
DISPLAY 'IPFILE BLOCK: ' TEST-SEG1-BLKCNT
' WAS UNIQUE AT SEGMENT '
VSAM-SEG1-SEGCNT
' AND WAS ACCEPTED.'
WRITE FD-VSAM-RECORD
IF NOT WS-GOOD-IO
DISPLAY 'WORKFILE WRITE FAILED WITH STATUS: '
WS-FILE-STATUS
PERFORM 4200-DISPLAY-VSAM-STATS
SET TIME-TO-ABEND TO TRUE
END-IF
END-IF
END-IF
IF NOT TIME-TO-ABEND
IF SEARCH-FAILED
ADD 1 TO WS-OPBLK-COUNT
PERFORM
WITH TEST BEFORE
VARYING TS-NDX2
FROM 1
BY 1
UNTIL TS-NDX2 GREATER THAN TS-NDX1
MOVE TEST-SEGMENT(TS-NDX2) TO FD-OUTPUT-RECORD
ADD 1 TO WS-OPREC-COUNT
WRITE FD-OUTPUT-RECORD
IF WS-GOOD-IO
CONTINUE
ELSE
DISPLAY 'OPFILE WRITE FAILED WITH STATUS: '
WS-FILE-STATUS
' AT RECORD NUMBER ' WS-OPREC-COUNT
SET TIME-TO-ABEND TO TRUE
END-IF
END-PERFORM
END-IF
END-IF
IF NOT TIME-TO-ABEND AND
NOT IPFILE-IS-AT-END
SET TS-NDX1 TO 1
MOVE FD-INPUT-RECORD TO TEST-SEG1-ID
MOVE ZERO TO TEST-SEG1-SEQ
MOVE FD-INPUT-RECORD TO TEST-SEGMENT(TS-NDX1)
MOVE +1 TO TEST-SEG1-BLKCNT
MOVE +1 TO TEST-SEG1-SEGCNT
END-IF
CONTINUE.
3000-TERMINATION.
MOVE 'ENDED ' TO WS-DT-STATUS
PERFORM 4000-DISPLAY-DATETIME
IF IPFILE-IS-OPENED
CLOSE INPUT-FILE
END-IF
IF OPFILE-IS-OPENED
CLOSE OUTPUT-FILE
END-IF
IF WORKFILE-IS-OPENED
CLOSE VSAM-FILE
END-IF
DISPLAY 'IPFILE BLOCK COUNT: ' WS-IPBLK-COUNT
' RECORD COUNT: ' WS-IPREC-COUNT
DISPLAY ' OPFILE BLOCK COUNT: ' WS-OPBLK-COUNT
' RECORD COUNT: ' WS-OPREC-COUNT
CONTINUE.
4000-DISPLAY-DATETIME.
ACCEPT WS-YYMMDD FROM DATE
ACCEPT WS-TIME FROM TIME
MOVE WS-PROGID TO WS-DT-PROGID
DISPLAY WS-DT-MSG
CONTINUE.
4200-DISPLAY-VSAM-STATS.
MOVE WS-VS-RETURN-CODE TO WS-DISP-STATUS
DISPLAY ' VSAM RETURN CODE WAS: ' WS-DISP-STATUS
MOVE WS-VS-FUNCTION-CODE TO WS-DISP-STATUS
DISPLAY ' VSAM FUNCTION CODE WAS: ' WS-DISP-STATUS
MOVE WS-VS-FEEDBACK-CODE TO WS-DISP-STATUS
DISPLAY ' VSAM FEEDBACK CODE WAS: ' WS-DISP-STATUS
CONTINUE. |
Input File (showing only first 80 bytes):
| Code: |
wZZBLOCK1whflwwhflhwflwfh..........
AABLOCK1hyeohfwfehfwefefe.......
AABLOCK1yfowefyeofhwefoehf........
ZZBLOCK2flfhwlfwehfwlfwelfhwf........
AABLOCK2wejhwelfhwflfw...........
ZZBLOCK3oyqpwebvbvorhwfbw.....
ZZBLOCK4wehlfkhlfhlhq...........
AABLOCK4eleqyfoehq.................
AABLOCK4puriu4iupiuipuifhlwefnlfn......
AABLOCK4ehfelfhflhffff........
ZZBLOCK5whflwwhflhwflwfh..........
AABLOCK5hyeohfwfehfwefefe.......
AABLOCK5yfowefyeofhwefoehf........
ZZBLOCK6flfhwlfwehfwlfwelfhwf........
AABLOCK6wejhwelfhwflfw...........
ZZBLOCK7oyqpwebvbvorhwfbw.....
ZZBLOCK8wehlfkhlfhlhq...........
AABLOCK8eleqyfoehq.................
AABLOCK8puriu4iupiuipuifhlwefnlfn......
AABLOCK8ehfelfhflhffff........
ZZBLOCK1whflwwhflhwflwfh..........
AABLOCK1hyeohfwfehfwefefe.......
AABLOCK1yfowefyeofhwefoehf........
ZZBLOCKAflfhwlfwehfwlfwelfhwf........
AABLOCKAwejhwelfhwflfw...........
ZZBLOCK3oyqpwebvbvorhwfbw.....
ZZBLOCKCwehlfkhlfhlhq...........
AABLOCKCeleqyfoehq.................
AABLOCKCpuriu4iupiuipuifhlwefnlfn......
AABLOCKCehfelfhflhffff........
ZZBLOCK5whflwwhflhwflwfh..........
AABLOCK5hyeohfwfehfwefefe.......
AABLOCK5yfowefyeofhwefoehf........
ZZBLOCKEflfhwlfwehfwlfwelfhwf........
AABLOCKEwejhwelfhwflfw...........
ZZBLOCK7oyqpwebvbvorhwfbw.....
ZZBLOCKFwehlfkhlfhlhq...........
AABLOCKFeleqyfoehq.................
AABLOCKFpuriu4iupiuipuifhlwefnlfn......
AABLOCKFehfelfhflhffff........ |
Output File (showing only the first 80 bytes):
| Code: |
ZZBLOCK1whflwwhflhwflwfh..........
AABLOCK1hyeohfwfehfwefefe.......
AABLOCK1yfowefyeofhwefoehf........
ZZBLOCK2flfhwlfwehfwlfwelfhwf........
AABLOCK2wejhwelfhwflfw...........
ZZBLOCK3oyqpwebvbvorhwfbw.....
ZZBLOCK4wehlfkhlfhlhq...........
AABLOCK4eleqyfoehq.................
AABLOCK4puriu4iupiuipuifhlwefnlfn......
AABLOCK4ehfelfhflhffff........
ZZBLOCK5whflwwhflhwflwfh..........
AABLOCK5hyeohfwfehfwefefe.......
AABLOCK5yfowefyeofhwefoehf........
ZZBLOCK6flfhwlfwehfwlfwelfhwf........
AABLOCK6wejhwelfhwflfw...........
ZZBLOCK7oyqpwebvbvorhwfbw.....
ZZBLOCK8wehlfkhlfhlhq...........
AABLOCK8eleqyfoehq.................
AABLOCK8puriu4iupiuipuifhlwefnlfn......
AABLOCK8ehfelfhflhffff........
ZZBLOCKAflfhwlfwehfwlfwelfhwf........
AABLOCKAwejhwelfhwflfw...........
ZZBLOCKCwehlfkhlfhlhq...........
AABLOCKCeleqyfoehq.................
AABLOCKCpuriu4iupiuipuifhlwefnlfn......
AABLOCKCehfelfhflhffff........
ZZBLOCKEflfhwlfwehfwlfwelfhwf........
AABLOCKEwejhwelfhwflfw...........
ZZBLOCKFwehlfkhlfhlhq...........
AABLOCKFeleqyfoehq.................
AABLOCKFpuriu4iupiuipuifhlwefnlfn......
AABLOCKFehfelfhflhffff........ |
Program Displays:
| Code: |
DELDUPS PROCESSING STARTED ON 20100826 AT 11385222
IPFILE BLOCK: 0000000001 WAS UNIQUE AT SEGMENT 00003 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000002 WAS UNIQUE AT SEGMENT 00002 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000003 WAS UNIQUE AT SEGMENT 00001 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000004 WAS UNIQUE AT SEGMENT 00004 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000005 WAS UNIQUE AT SEGMENT 00003 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000006 WAS UNIQUE AT SEGMENT 00002 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000007 WAS UNIQUE AT SEGMENT 00001 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000008 WAS UNIQUE AT SEGMENT 00004 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000009 MATCHED BLOCK: 0000000001 AND WAS DISCARDED.
IPFILE BLOCK: 0000000010 WAS UNIQUE AT SEGMENT 00002 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000011 MATCHED BLOCK: 0000000003 AND WAS DISCARDED.
IPFILE BLOCK: 0000000012 WAS UNIQUE AT SEGMENT 00004 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000013 MATCHED BLOCK: 0000000005 AND WAS DISCARDED.
IPFILE BLOCK: 0000000014 WAS UNIQUE AT SEGMENT 00002 AND WAS ACCEPTED.
IPFILE BLOCK: 0000000015 MATCHED BLOCK: 0000000007 AND WAS DISCARDED.
IPFILE BLOCK: 0000000016 WAS UNIQUE AT SEGMENT 00004 AND WAS ACCEPTED.
DELDUPS PROCESSING ENDED ON 20100826 AT 11385229
IPFILE BLOCK COUNT: 000000016 RECORD COUNT: 000000040
OPFILE BLOCK COUNT: 000000012 RECORD COUNT: 000000032 |
|
|
| Back to top |
|
|
Skolusu
Senior Member
Joined: 07 Dec 2007
Posts: 2205
Location: San Jose
|
|
|
|
Ronald Burr,
First props to you for writing that program
| Quote: |
1. The Op does NOT consider the entire 381 bytes as a key. The OP never used the word 'key'. The 'KEY' specification was entirely your invention. |
Just the way you interpreted 255 bytes as the key. Depends on how we perceive the requirements.
| Quote: |
2. The OP never placed a constraint on the number of work files, and I have no idea what point you are trying to make with the "ONLY 1 file." comment. My code only uses one input file.
|
OP posted in DFSORT forum but does NOT want to SORT. Hence I just gave an unrealistic restriction of 1 file. If loading to a VSAM File or DB2 table is an option then it is a more realistic approach. Had OP said , his final goal is to retain the original order of the records , then we wouldn't be here arguing about it. |
|
| Back to top |
|
|
|
|
