Code: |
//BBBBSPR1 JOB 6,'CICS COBOL',NOTIFY=BBBB,CLASS=2,MSGCLASS=Y //* 114,8 SUPPLIER ID //* BOH-SELECTION-PR S9(9) COMP 361,4 //SORT1 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SORTIN DD DSN=BBBB.XYFILE.OUT,DISP=SHR //SORTOUT DD DSN=BBBB.XYFILE.OUT1,DISP=OLD //SYSIN DD * SORT FIELDS=(114,8,ZD,A,361,4,BI,A) OPTION EQUALS OUTREC FIELDS=(1,685) /* //SORT2 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SORTIN DD DSN=BBBB.XYFILE.OUT,DISP=SHR //SORTOUT DD DSN=BBBB.XYFILE.OUT2,DISP=OLD //SYSIN DD * SORT FIELDS=(114,8,ZD,A) OPTION EQUALS OUTREC FIELDS=(1,685) /* //SORT3 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SORTIN DD DSN=BBBB.XYFILE.OUT2,DISP=SHR //SORTOUT DD DSN=BBBB.XYFILE.OUT3,DISP=OLD //SYSIN DD * SORT FIELDS=(361,4,BI,A) OPTION EQUALS OUTREC FIELDS=(1,685) /* |
deepa12 wrote: |
The 1st step is a composite Sort of 2 fields This sorts say FLD1,FLD2 This is followed by SORT2, which sorts the last field i.e FLD2 |
deepa12 wrote: |
//SORT1 EXEC PGM=SORT //SYSIN DD * SORT FIELDS=(114,8,ZD,A,361,4,BI,A) /* //SORT2 EXEC PGM=SORT //SYSIN DD * SORT FIELDS=(114,8,ZD,A) |
deepa12 wrote: |
So is it always true that if i want to sort by FLD1,FLD2,FLD3 Then it will produce same result when i sort in reverse way successively i.e sort by FLD3. Use the o/p of this to sort by FLD2 Use the o/p of this to sort by FLD1 |
Code: |
{ABCDEFGHI}JKLMNOPQR CCCCCCCCCCDDDDDDDDDD 01234567890123456789 |
Code: |
//*************************************************************** //* Sort on 2 fields * //* Field-1: Position 01 for a length of 8 in ZD format * //* Field-2: Position 30 for a length of 4 in BI format * //*************************************************************** //STEP0100 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD * 0000000G = +7 BI=10 0000000N = -5 BI=50 0000000A = +1 BI=02 //SORTOUT DD SYSOUT=* //SYSIN DD * INREC OVERLAY=(30:20,02,ZD,BI,LENGTH=4) SORT FIELDS=(01,08,ZD,A, 30,04,BI,A),EQUALS /* //*************************************************************** //* Sort on 1 field * //* Field-1: Position 01 for a length of 8 in ZD format * //*************************************************************** //STEP0200 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD * 0000000G = +7 BI=10 0000000N = -5 BI=50 0000000A = +1 BI=02 //SORTOUT DD DSN=&&T,DISP=(,PASS),SPACE=(TRK,(1,1),RLSE) //SYSIN DD * INREC OVERLAY=(30:20,02,ZD,BI,LENGTH=4) SORT FIELDS=(01,08,ZD,A),EQUALS /* //*************************************************************** //* Sort on 1 field * //* Field-2: Position 30 for a length of 4 in BI format * //*************************************************************** //STEP0300 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD DISP=(OLD,DELETE),DSN=&&T //SORTOUT DD SYSOUT=* //SYSIN DD * SORT FIELDS=(30,04,BI,A),EQUALS /* |
Code: |
SORT FIELDS=(361,4,BI,A,114,8,ZD,A) |
Code: |
SORT FIELDS=(01,08,ZD,A,
30,04,BI,A),EQUALS |
deepa12 wrote: |
need to develop a generic sort algorithm in Cobol to sort records based on any field for say maximum of 100 records
so am using SORT verb of Cobol in the sort module So i wanted to check if individual field resultant table sort from minor to major sort will yield same result as a composite sort , so that algorithm can be developed using the later |
Code: |
05 BIOUT-NO-RECORDS PIC 9(03) VALUE ZEROS. 05 BIOUT-REQ-DATA OCCURS 100 TIMES. 10 BIOUT-DATA PIC X(20000) VALUE SPACES. * * PIC FOR ZONE DECIMAL 05 WS-ZONE-DEC-X1 PIC X. 05 WS-ZONE-DEC-9-1 REDEFINES WS-ZONE-DEC-X1 PIC S9. 05 WS-ZONE-DEC-X2 PIC XX. 05 WS-ZONE-DEC-9-2 REDEFINES WS-ZONE-DEC-X2 PIC S9(2). 05 WS-ZONE-DEC-X3 PIC XXX. 05 WS-ZONE-DEC-9-3 REDEFINES WS-ZONE-DEC-X3 PIC S9(3). 05 WS-ZONE-DEC-X4 PIC X(4). 05 WS-ZONE-DEC-9-4 REDEFINES WS-ZONE-DEC-X4 PIC S9(4). 05 WS-ZONE-DEC-X5 PIC X(5). 05 WS-ZONE-DEC-9-5 REDEFINES WS-ZONE-DEC-X5 PIC S9(5). 05 WS-ZONE-DEC-X6 PIC X(6). 05 WS-ZONE-DEC-9-6 REDEFINES WS-ZONE-DEC-X6 PIC S9(6). 05 WS-ZONE-DEC-X7 PIC X(7). 05 WS-ZONE-DEC-9-7 REDEFINES WS-ZONE-DEC-X7 PIC S9(7). 05 WS-ZONE-DEC-X8 PIC X(8). 05 WS-ZONE-DEC-9-8 REDEFINES WS-ZONE-DEC-X8 PIC S9(8). 05 WS-ZONE-DEC-X9 PIC X(9). 05 WS-ZONE-DEC-9-9 REDEFINES WS-ZONE-DEC-X9 PIC S9(9). 05 WS-ZONE-DEC-X10 PIC X(10). 05 WS-ZONE-DEC-9-10 REDEFINES WS-ZONE-DEC-X10 PIC S9(10). 05 WS-ZONE-DEC-X11 PIC X(11). 05 WS-ZONE-DEC-9-11 REDEFINES WS-ZONE-DEC-X11 PIC S9(11). 05 WS-ZONE-DEC-X12 PIC X(12). 05 WS-ZONE-DEC-9-12 REDEFINES WS-ZONE-DEC-X12 PIC S9(12). 05 WS-ZONE-DEC-X13 PIC X(13). 05 WS-ZONE-DEC-9-13 REDEFINES WS-ZONE-DEC-X13 PIC S9(13). 05 WS-ZONE-DEC-X14 PIC X(14). 05 WS-ZONE-DEC-9-14 REDEFINES WS-ZONE-DEC-X14 PIC S9(14). 05 WS-ZONE-DEC-X15 PIC X(15). 05 WS-ZONE-DEC-9-15 REDEFINES WS-ZONE-DEC-X15 PIC S9(15). 05 WS-ZONE-DEC-X16 PIC X(16). 05 WS-ZONE-DEC-9-16 REDEFINES WS-ZONE-DEC-X16 PIC S9(16). 05 WS-ZONE-DEC-X17 PIC X(17). 05 WS-ZONE-DEC-9-17 REDEFINES WS-ZONE-DEC-X17 PIC S9(17). 05 WS-ZONE-DEC-X18 PIC X(118). 05 WS-ZONE-DEC-9-18 REDEFINES WS-ZONE-DEC-X18 PIC S9(18). 01 WS-SORT-GRP2. * CATER FOR INSYNC FIELD TYPES G,X 10 WS-ALPHANUM-TBL OCCURS 100 TIMES DEPENDING ON WS-TBL-SIZE. 15 WS-ALPHANUM-POSN PIC S9(4) COMP. 15 WS-ALPHANUM-KEY PIC X(500). * CATER FOR INSYNC FIELD TYPE BINARY OR COMP ARITH(COMPAT) 01 WS-SORT-GRP3. 10 WS-BINARY-TBL OCCURS 100 TIMES DEPENDING ON WS-TBL-SIZE. 15 WS-BINARY-POSN PIC S9(4) COMP. 15 WS-BINARY-KEY PIC S9(18) COMP. * CATER FOR INSYNC FIELD TYPE P -PACKED DECIMAL ARITH(COMPAT) 01 WS-SORT-GRP4. 10 WS-PACKED-DEC-TBL OCCURS 100 TIMES DEPENDING ON WS-NBR-OF-RECS. 15 WS-PACKED-DEC-POSN PIC S9(4) COMP. 15 WS-PACKED-DEC-KEY PIC S9(18) COMP-3. 01 WS-SORT-GRP5. 10 WS-ZONE-DEC-TBL OCCURS 100 TIMES DEPENDING ON WS-TBL-SIZE. 15 WS-ZONE-DEC-POSN PIC S9(4) COMP. 15 WS-ZONE-DEC-KEY PIC S9(18). *CLEARED & REFORMED FOR EVERY SORT 01 WS-TEMP-SORT-GRP2. 10 WS-TEMP-SRTD-TBL OCCURS 100 TIMES DEPENDING ON WS-TBL-SIZE. 15 WS-TEMP-SRTD-DATA PIC X(20000). 15 WS-TEMP-SRTD-CURR-POSN PIC S9(4) COMP. ... PROCEDURE DIVISION. PERFORM D2000-SORT VARYING WS-SUB FROM WS-NO-OF-ORD-FLDS BY -1 UNTIL WS-SUB <= 0 ..... * D2000-SORT SECTION. ****************************************************************** *START FROM MINOR SORT FIELD TO MAJOR SORT FIELD IN REVERSE DIRN * *CONSIDER EACH SORT FIELD * *1. INITIALIZE FIELD TYPEWISE ARRAY * *2. POPULATE FIELD TYPEWISE ARRAY DEPENDING ON THE TYPE AND LENGTH * FIELD BEING SORTED, FROM TEMP-SRTD ARRAY *3. SORT ASC/DESC OF RESPECTIVE FIELD TYPE ARRAY *4. INITIALIZE TEMP-SRTD ARRAY TO *5. FORM THE RESULT SRTD TABLE FROM FIELD TYPE,LEN FOR WS-SUB FIELD * THAT HAS BEEN SORTED *6. THIS WILL BE INPUT TO NEXT STEP ****************************************************************** MOVE "D2000-SORT" TO DERR-PARM-SECTION-CHAIN MOVE 0 TO WS-FLD-LEN WS-FLD-POS WS-CURR-FLD-LEN MOVE WS-NBR-OF-RECS TO WS-TBL-SIZE * MOVE WS-NBR-OF-RECS TO WS-SORT-END-POS DISPLAY "TEMP-SRTD BEF D2000" PERFORM VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS MOVE WS-TEMP-SRTD-CURR-POSN(WS-SUB1) TO WS-REC-POSN DISPLAY "POSN DATA " BIOUT-DATA(WS-REC-POSN)(1:WS-RECLEN) ":" WS-TEMP-SRTD-DATA(WS-SUB1) (1:WS-RECLEN) ":" WS-TEMP-SRTD-CURR-POSN(WS-SUB1) END-PERFORM . PERFORM D2400-INIT-SORT-SUB-TBLS VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS PERFORM D2100-POPLAT-FLD-TYPE-SORT-TBL PERFORM D2500-SORT-BY-FLD-TYPE *INITIALIZE TEMP SRTD ARRAY * PERFORM D2600-INIT-TEMP-SRT-TBL VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS PERFORM D2900-REFORM-SRTABL4NEXT-ITER VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS DISPLAY "AFTER D2900- SORT " WS-SUB ":" BIIN-ORD-FIELD-NAME(WS-SUB) PERFORM VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS MOVE WS-TEMP-SRTD-CURR-POSN(WS-SUB1) TO WS-REC-POSN DISPLAY "POSN DATA " BIOUT-DATA(WS-REC-POSN)(1:WS-RECLEN) ":" WS-TEMP-SRTD-DATA(WS-SUB1) (1:WS-RECLEN) ":" WS-TEMP-SRTD-CURR-POSN(WS-SUB1) END-PERFORM . D2000-EXIT. EXIT. D2100-POPLAT-FLD-TYPE-SORT-TBL SECTION. *----------------------------------------------------------------* *BASED ON FIELD TYPE POPULATE INDVIDUAL FIELD ARRAY WHICH WILL * *BE SORTED * *----------------------------------------------------------------* MOVE "D2100-POPLAT-FLD-TYPE-SORT-TBL" TO DERR-PARM-SECTION-CHAIN DISPLAY "IN D2100 FLD TYPE " BIIN-FIELD-TYPE(WS-SUB) MOVE 0 TO WS-FLD-LEN WS-FLD-POS MOVE BIIN-FIELD-LEN(WS-SUB) TO WS-FLD-LEN WS-CURR-FLD-LEN MOVE BIIN-FIELD-SEL-DATA-POS(WS-SUB) TO WS-FLD-POS EVALUATE TRUE WHEN BIIN-FIELD-TYPE-ALPHA(WS-SUB) PERFORM D2320-POPLAT-FOR-ALPHANUM-SORT VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS OR WS-TEMP-SRTD-DATA(WS-SUB1) <= SPACES WHEN BIIN-FIELD-TYPE-BINARY(WS-SUB) PERFORM D2200-POPLAT-FOR-BINARY-SORT VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS OR WS-TEMP-SRTD-DATA(WS-SUB1) <= SPACES WHEN BIIN-FIELD-TYPE-PACKED(WS-SUB) PERFORM D2300-POPLAT-FOR-PKD-DEC-SORT VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS OR WS-TEMP-SRTD-DATA(WS-SUB1) <= SPACES WHEN BIIN-FIELD-TYPE-ZONE(WS-SUB) PERFORM D2310-POPLAT-FOR-ZON-DEC-SORT VARYING WS-SUB1 FROM 1 BY 1 UNTIL WS-SUB1 > WS-NBR-OF-RECS OR WS-TEMP-SRTD-DATA(WS-SUB1) <= SPACES END-EVALUATE . * D2100-EXIT. EXIT. D2200-POPLAT-FOR-BINARY-SORT SECTION. *----------------------------------------------------------------------- * BASED ON FIELD POSITION AND LENGTH, POPULATE KEY AND ITS POSITION IN * TEMP-SRTD ARRAY I.E FOR BINARY FIELDS COMP OR COMP-4 * SAY CASE-COUNT-WP IN WPRECORD * THIS IS S9(4) COMP 2 BYTES SO IT IS A HEX MOVE * FOLLOWED BY ACCESSING THE CORRECT HALF WORD & STORING INA MAX SIZE * FIELD OF THAT TYPE ARRAY FIELD IS MAX SIZE *----------------------------------------------------------------------- MOVE "D2200-POPLAT-FOR-BINARY-SORT" TO DERR-PARM-SECTION-CHAIN * * MOVE 0 TO WS-FLD-LEN * WS-FLD-POS * MOVE BIIN-FIELD-LEN(WS-SUB) TO WS-FLD-LEN * WS-CURR-FLD-LEN * MOVE BIIN-FIELD-SEL-DATA-POS(WS-SUB) TO WS-FLD-POS MOVE WS-TEMP-SRTD-CURR-POSN(WS-SUB1) TO WS-BINARY-POSN (WS-SUB1) EVALUATE TRUE WHEN BIIN-FIELD-LEN(WS-SUB) = 2 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-HALF-WRD-X MOVE WS-HALF-WRD-9 TO WS-BINARY-KEY (WS-SUB1) WHEN BIIN-FIELD-LEN(WS-SUB) = 4 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-FULL-WRD-X MOVE WS-FULL-WRD-9 TO WS-BINARY-KEY (WS-SUB1) WHEN BIIN-FIELD-LEN(WS-SUB) = 8 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-DBL-WRD-X MOVE WS-DBL-WRD-9 TO WS-BINARY-KEY (WS-SUB1) END-EVALUATE. D2200-EXIT. EXIT. D2300-POPLAT-FOR-PKD-DEC-SORT SECTION. *----------------------------------------------------------------------- * BASED ON FIELD POSITION AND LENGTH, POPULATE KEY AND ITS POSITION IN * TEMP-SRTD ARRAY I.E FOR COMP-3 OR PACKED DECIMAL * E..G LAST-MEASUREMENT-DATE-UPR IN PRUSER S9(08) COMP-3 * THIS IS 5 BYTES SO IT WILL BE HEX MOVE TO 5 BYTE FIELD & THEN MOVED * INTO SORT ARRAY WHICH IS ALWAYS DECLARED AS S9(18) MAX SIZE * S9(6)V99 ASSUMED DECIMALSAY 000456.78 IS STORED IN HEX AS * X'000000000045678C' *-456.78 IS STORED AS X'000000000045678D' *----------------------------------------------------------------------- MOVE "D2300-POPLAT-FOR-PKD-DEC-SORT" TO DERR-PARM-SECTION-CHAIN * * MOVE 0 TO WS-FLD-LEN * WS-FLD-POS * MOVE BIIN-FIELD-LEN(WS-SUB) TO WS-FLD-LEN * WS-CURR-FLD-LEN * MOVE BIIN-FIELD-SEL-DATA-POS(WS-SUB) TO WS-FLD-POS MOVE WS-TEMP-SRTD-CURR-POSN(WS-SUB1) TO WS-PACKED-DEC-POSN (WS-SUB1) EVALUATE WS-FLD-LEN WHEN 1 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X1 MOVE WS-PKD-DEC-9-1 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 2 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X2 MOVE WS-PKD-DEC-9-2 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 3 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X3 MOVE WS-PKD-DEC-9-3 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 4 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X4 MOVE WS-PKD-DEC-9-4 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 5 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X5 MOVE WS-PKD-DEC-9-5 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 6 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X6 MOVE WS-PKD-DEC-9-6 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 7 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X7 MOVE WS-PKD-DEC-9-7 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 8 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X8 MOVE WS-PKD-DEC-9-8 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 9 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X9 MOVE WS-PKD-DEC-9-9 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 10 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X10 MOVE WS-PKD-DEC-9-10 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 11 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X11 MOVE WS-PKD-DEC-9-11 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 12 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X12 MOVE WS-PKD-DEC-9-12 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 13 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X13 MOVE WS-PKD-DEC-9-13 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 14 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X14 MOVE WS-PKD-DEC-9-14 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 15 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X15 MOVE WS-PKD-DEC-9-15 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 16 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X16 MOVE WS-PKD-DEC-9-16 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 17 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X17 MOVE WS-PKD-DEC-9-17 TO WS-PACKED-DEC-KEY (WS-SUB1) WHEN 18 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-PKD-DEC-X18 MOVE WS-PKD-DEC-9-18 TO WS-PACKED-DEC-KEY (WS-SUB1) END-EVALUATE . D2300-EXIT. EXIT. * D2310-POPLAT-FOR-ZON-DEC-SORT SECTION. *----------------------------------------------------------------------- * BASED ON FIELD POSITION AND LENGTH, POPULATE KEY AND ITS POSITION IN * TEMP-SRTD ARRAY I.E FOR COMP-3 OR PACKED DECIMAL * E..G LAST-MEASUREMENT-DATE-UPR IN PRUSER S9(08) COMP-3 * THIS IS 5 BYTES SO IT WILL BE HEX MOVE TO 5 BYTE FIELD & THEN MOVED * INTO SORT ARRAY WHICH IS ALWAYS DECLARED AS S9(18) MAX SIZE * S9(6)V99 ASSUMED DECIMALSAY 000456.78 IS STORED IN HEX AS * X'000000000045678C' *-456.78 IS STORED AS X'000000000045678D' *----------------------------------------------------------------------- MOVE "D2310-POPLAT-FOR-ZON-DEC-SORT" TO DERR-PARM-SECTION-CHAIN * MOVE 0 TO WS-FLD-LEN * WS-FLD-POS * MOVE BIIN-FIELD-LEN(WS-SUB) TO WS-FLD-LEN * WS-CURR-FLD-LEN * MOVE BIIN-FIELD-SEL-DATA-POS(WS-SUB) TO WS-FLD-POS MOVE WS-TEMP-SRTD-CURR-POSN(WS-SUB1) TO WS-ZONE-DEC-POSN (WS-SUB1) EVALUATE WS-FLD-LEN WHEN 1 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X1 MOVE WS-ZONE-DEC-9-1 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 2 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X2 MOVE WS-ZONE-DEC-9-2 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 3 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X3 MOVE WS-ZONE-DEC-9-3 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 4 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X4 MOVE WS-ZONE-DEC-9-4 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 5 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X5 MOVE WS-ZONE-DEC-9-5 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 6 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X6 MOVE WS-ZONE-DEC-9-6 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 7 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X7 MOVE WS-ZONE-DEC-9-7 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 8 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X8 MOVE WS-ZONE-DEC-9-8 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 9 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X9 MOVE WS-ZONE-DEC-9-9 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 10 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X10 MOVE WS-ZONE-DEC-9-10 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 11 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X11 MOVE WS-ZONE-DEC-9-11 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 12 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X12 MOVE WS-ZONE-DEC-9-12 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 13 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X13 MOVE WS-ZONE-DEC-9-13 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 14 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X14 MOVE WS-ZONE-DEC-9-14 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 15 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X15 MOVE WS-ZONE-DEC-9-15 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 16 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X16 MOVE WS-ZONE-DEC-9-16 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 17 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X17 MOVE WS-ZONE-DEC-9-17 TO WS-ZONE-DEC-KEY (WS-SUB1) WHEN 18 MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ZONE-DEC-X18 MOVE WS-ZONE-DEC-9-18 TO WS-ZONE-DEC-KEY (WS-SUB1) END-EVALUATE . D2310-EXIT. EXIT. * D2320-POPLAT-FOR-ALPHANUM-SORT SECTION. *----------------------------------------------------------------------- * BASED ON FIELD POSITION AND LENGTH, POPULATE KEY AND ITS POSITION IN * TEMP-SRTD ARRAY I.E FOR ALPHANUMERIC PIC A-X,GROUP FLDS * SAY NNDX1-KEY-LA OR LONG-DESCRIPTION-PR SORT *----------------------------------------------------------------------- MOVE "D2320-POPLAT-FOR-ALPHANUM-SORT" TO DERR-PARM-SECTION-CHAIN * * MOVE 0 TO WS-FLD-LEN * WS-FLD-POS * MOVE BIIN-FIELD-LEN(WS-SUB) TO WS-FLD-LEN * WS-CURR-FLD-LEN * MOVE BIIN-FIELD-SEL-DATA-POS(WS-SUB) TO WS-FLD-POS MOVE WS-TEMP-SRTD-CURR-POSN(WS-SUB1) TO WS-ALPHANUM-POSN(WS-SUB1) MOVE WS-TEMP-SRTD-DATA(WS-SUB1) (WS-FLD-POS:WS-FLD-LEN) TO WS-ALPHANUM-KEY(WS-SUB1). D2320-EXIT. EXIT. D2400-INIT-SORT-SUB-TBLS SECTION. ****************************************************************** *INITIALIZE SORT TABLE WHICH WILL BE REALLY SORTED * ****************************************************************** MOVE "D2400-INIT-SORT-SUB-TBLS" TO DERR-PARM-SECTION-CHAIN MOVE SPACES TO WS-ALPHANUM-KEY (WS-SUB1) MOVE 0 TO WS-ALPHANUM-POSN (WS-SUB1) WS-BINARY-POSN(WS-SUB1) WS-BINARY-KEY(WS-SUB1) WS-PACKED-DEC-POSN (WS-SUB1) WS-PACKED-DEC-KEY (WS-SUB1) WS-ZONE-DEC-POSN (WS-SUB1) WS-ZONE-DEC-KEY (WS-SUB1). D2400-EXIT. EXIT. D2500-SORT-BY-FLD-TYPE SECTION. ****************************************************************** *DEPENDING ON FIELD TYPE - COMP/COMP-3/ALPHANUM * * AND ORDER OF SORT I.E ASC/DESC * * PERFORM COBOL TABLE SORT FOR THIS FIELD SAY FLD1 * * INSTEAD OF DATA DATA POSITION IS SORTED * * IN CASE OF ASCENDING SORT SAY WE HAVE 50 RECODS ONLY 1ST * * 150 RECORDS WILL BE BLANK SINCE IT IS STATIC ARRAY * ****************************************************************** MOVE "D2500-SORT-BY-FLD-TYPE" TO DERR-PARM-SECTION-CHAIN DISPLAY " IN D2500- " BIIN-FIELD-TYPE(WS-SUB) ":" WS-SUB EVALUATE TRUE WHEN BIIN-FIELD-TYPE-ALPHA(WS-SUB) IF BIIN-ORD-TYPE-ASC(WS-SUB) SORT WS-ALPHANUM-TBL ASCENDING KEY WS-ALPHANUM-KEY WITH DUPLICATES IN ORDER ELSE SORT WS-ALPHANUM-TBL DESCENDING KEY WS-ALPHANUM-KEY WITH DUPLICATES IN ORDER END-IF WHEN BIIN-FIELD-TYPE-BINARY(WS-SUB) IF BIIN-ORD-TYPE-ASC(WS-SUB) SORT WS-BINARY-TBL ASCENDING KEY WS-BINARY-KEY WITH DUPLICATES IN ORDER ELSE SORT WS-BINARY-TBL DESCENDING KEY WS-BINARY-KEY WITH DUPLICATES IN ORDER END-IF WHEN BIIN-FIELD-TYPE-PACKED(WS-SUB) IF BIIN-ORD-TYPE-ASC(WS-SUB) SORT WS-PACKED-DEC-TBL ASCENDING KEY WS-PACKED-DEC-KEY WITH DUPLICATES IN ORDER ELSE SORT WS-PACKED-DEC-TBL DESCENDING KEY WS-PACKED-DEC-KEY WITH DUPLICATES IN ORDER END-IF WHEN BIIN-FIELD-TYPE-ZONE(WS-SUB) IF BIIN-ORD-TYPE-ASC(WS-SUB) SORT WS-ZONE-DEC-TBL ASCENDING KEY WS-ZONE-DEC-KEY WITH DUPLICATES IN ORDER ELSE SORT WS-ZONE-DEC-TBL DESCENDING KEY WS-ZONE-DEC-KEY WITH DUPLICATES IN ORDER END-IF END-EVALUATE. * D2500-EXIT. EXIT. * D2600-INIT-TEMP-SRT-TBL SECTION. *----------------------------------------------------------------* *BASED ON FIELD TYPE POPULATE INDVIDUAL FIELD ARRAY WHICH WILL * *----------------------------------------------------------------* MOVE "D2600-INIT-TEMP-SRT-TBL " TO DERR-PARM-SECTION-CHAIN MOVE SPACES TO WS-TEMP-SRTD-DATA (WS-SUB1). MOVE 0 TO WS-TEMP-SRTD-CURR-POSN (WS-SUB1). * D2600-EXIT. EXIT. * D2900-REFORM-SRTABL4NEXT-ITER SECTION. *----------------------------------------------------------------* *FROM FIELD TYPEWISE SORTED TABLE FORM THE SRTD TABLE * *----------------------------------------------------------------* MOVE "D2900-REFORM-SRTABL4NEXT-ITER " TO DERR-PARM-SECTION-CHAIN EVALUATE TRUE WHEN BIIN-FIELD-TYPE-ALPHA(WS-SUB) MOVE WS-ALPHANUM-POSN(WS-SUB1) TO WS-REC-POSN WHEN BIIN-FIELD-TYPE-BINARY(WS-SUB) MOVE WS-BINARY-POSN(WS-SUB1) TO WS-REC-POSN WHEN BIIN-FIELD-TYPE-PACKED(WS-SUB) MOVE WS-PACKED-DEC-POSN(WS-SUB1) TO WS-REC-POSN WHEN BIIN-FIELD-TYPE-ZONE(WS-SUB) MOVE WS-ZONE-DEC-POSN(WS-SUB1) TO WS-REC-POSN END-EVALUATE. MOVE BIOUT-DATA(WS-REC-POSN)(1:WS-RECLEN) TO WS-TEMP-SRTD-DATA(WS-SUB1) (1:WS-RECLEN). MOVE WS-REC-POSN TO WS-TEMP-SRTD-CURR-POSN(WS-SUB1). * D2900-EXIT. EXIT. |
Quote: |
+456.78 in hex is X'000000000045678C' -456.78 in hex is X'000000000045678D' |
output generated using printer-friendly topic mod. All times are GMT - 5 Hours