midrange.com code scratchpad
Name:
Multiple Column Qsort with Asc/Dsc Sorts
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
12/19/2019 10:57:08 pm
IP:
Logged
Description:
Demonstration of tracking the sort of multiple columns and then using QSORT for sorting.
Code:
  1.  
  2. EXAMPLE for THESCREEN
  3.      A          R SCNSFL
  4.      A                                      SFL
  5.      A            S0KEY1        10A  O  8 20
  6.      A            S0KEY2        10A  O  8 +1
  7.      A            S0KEY3        10A  O  8 +1
  8.      A            S0KEY4        10A  O  8 +1
  9.  
  10.      A          R SCNCTL
  11.      A                                      SFLCTL(SCNSFL)
  12.      A                                      RTNCSRLOC(*RECNAME &CSRREC &CSRFLD)
  13.      A            CSRREC        10A  H
  14.      A            CSRFLD        10A  H
  15.      ... All other screen control stuff...
  16.      A            H0KEY1        10A  O  7 20
  17.      A                                      DSPATR(HI)
  18.      A                                      DSPATR(UL)
  19.      A            H0KEY2        10A  O  7 +1
  20.      A                                      DSPATR(HI)
  21.      A                                      DSPATR(UL)
  22.      A            H0KEY3        10A  O  7 +1
  23.      A                                      DSPATR(HI)
  24.      A                                      DSPATR(UL)
  25.      A            H0KEY4        10A  O  7 +1
  26.      A                                      DSPATR(HI)
  27.      A                                      DSPATR(UL)
  28.  
  29.  
  30. **FREE
  31. Ctl-Opt OPENOPT(*NOINZOFL) OPTION(*NODEBUGIO:*SRCSTMT);
  32. Ctl-Opt DFTACTGRP(*NO) ACTGRP(*CALLER);
  33. DCL-F THESCREEN WORKSTN(*EXT) USAGE(*INPUT:*OUTPUT)
  34.              USROPN SFILE(Scnsfl:Rrn) INFDS(Dspfinfds);
  35.  
  36.  
  37. Dcl-Ds DSPFINFDS QUALIFIED;
  38.   Thisdspf Char(8);
  39.   //* Function Key pressed
  40.   FKey Char(1) Pos(369);
  41.   //* Max number of sfl recs after done loading
  42.   Maxsflrecs Int(5) Pos(376);
  43.   //* First sfl rec on visible screen
  44.   Lowrrn Int(5) Pos(378);
  45.   //* number of sfl records after SFLINZ
  46.   Inzmaxrecs Int(5) Pos(380);
  47. End-Ds;
  48. Dcl-C ENTER X'F1';
  49. DCL-S RRN PACKED(4);
  50.  
  51.  
  52. Dcl-c Order_Ascending 'A';
  53. Dcl-c Order_Descending 'D';
  54. Dcl-Ds Sorted Qualified Dim(5);
  55.   Key Char(10);
  56.   Order Char(1);
  57. End-ds;
  58. Dcl-s SortCount Int(10);
  59. Dcl-ds SortHeaderFields Qualified Dim(%Elem(Sorted));
  60.   Hdr Char(10);
  61.   Key Char(10);
  62. End-ds;
  63. Dcl-s SortHeaderCount Int(10);
  64.  
  65. Dcl-ds Dtl Qualified Template;
  66.   Key1 Char(1);
  67.   Key2 Char(1);
  68.   Key3 Char(1);
  69.   Key4 Char(1);
  70. End-ds;
  71. Dcl-ds DetailAry Likeds(Dtl) Dim(9999);
  72. Dcl-s DetailCount Int(10);
  73. Dcl-s rIdx Int(10);
  74. Dcl-s reload Ind;
  75.  
  76. Dcl-Pr Api_Qsort extproc('qsort');
  77.   data POINTER value;
  78.   size uns(10) value;
  79.   element_size uns(10) value;
  80.   sortprocedure Pointer(*PROC) Value;
  81. End-pr;
  82.  
  83.  
  84. Exsr Screen;
  85. Exsr Exit;
  86.  
  87. Begsr Screen;
  88.   Exsr InitSort;
  89.  
  90.   Reload = *On;
  91.   Dou *Inkc;
  92.  
  93.     If Reload;
  94.       Reload = *Off;
  95.       API_QSort(%ADDR(DetailAry) :DetailCount :%SIZE(DetailAry) :%Paddr(SortData));
  96.       Exsr LoadSfl;
  97.     Endif;
  98.     EXFMT SCNCTL;
  99.  
  100.     // How to trigger Sort.  One way is to put the cursor there and press enter.
  101.     If Dspfinfds.Fkey = Enter;
  102.       If CheckSortOrder( CSRFLD );
  103.         Reload = *ON;
  104.         Iter;
  105.       Endif;
  106.     Endif;
  107.  
  108.   Enddo;
  109. Endsr;
  110.  
  111. Begsr Exit;
  112.   *Inlr = *On;
  113.   Return;
  114. Endsr;
  115.  
  116. Begsr LoadSfl;
  117.  
  118.   For rIdx = 1 to DetailCount;
  119.  
  120.     S0key1 = DetailAry(ridx).Key1;
  121.     S0key2 = DetailAry(ridx).Key2;
  122.     S0key3 = DetailAry(ridx).Key3;
  123.     S0key4 = DetailAry(ridx).Key4;
  124.     Rrn += 1;
  125.     Write Scnsfl;
  126.  
  127.   Endfor;
  128.  
  129. Endsr;
  130.  
  131. Begsr InitSort;
  132. // Initalize Sort
  133.   Clear SortCount;
  134.   Clear SortHeaderCount;
  135.   SortCount += 1;
  136.   Sorted(SortCount).Key = 'S0KEY1';
  137.   Sorted(SortCount).Order = 'A';
  138.   SortHeaderCount += 1;
  139.   SortHeaderFields(SortHeaderCount).Hdr = 'H0KEY1';
  140.   SortHeaderFields(SortHeaderCount).Key = 'S0KEY1';
  141.   SortCount += 1;
  142.   Sorted(SortCount).Key = 'S0KEY2';
  143.   Sorted(SortCount).Order = 'A';
  144.   SortHeaderCount += 1;
  145.   SortHeaderFields(SortHeaderCount).Hdr = 'H0KEY2';
  146.   SortHeaderFields(SortHeaderCount).Key = 'S0KEY2';
  147.   SortCount += 1;
  148.   Sorted(SortCount).Key = 'S0KEY3';
  149.   Sorted(SortCount).Order = 'A';
  150.   SortHeaderCount += 1;
  151.   SortHeaderFields(SortHeaderCount).Hdr = 'H0KEY3';
  152.   SortHeaderFields(SortHeaderCount).Key = 'S0KEY3';
  153.   SortCount += 1;
  154.   Sorted(SortCount).Key = 'S0KEY4';
  155.   Sorted(SortCount).Order = 'A';
  156.   SortHeaderCount += 1;
  157.   SortHeaderFields(SortHeaderCount).Hdr = 'H0KEY4';
  158.   SortHeaderFields(SortHeaderCount).Key = 'S0KEY4';
  159. Endsr;
  160.  
  161. Dcl-Proc CheckSortOrder;
  162.   Dcl-Pi *N Ind;
  163.     SortField Char(10);
  164.   End-pi;
  165.   Dcl-ds CopyOfSorted Likeds(Sorted) Dim(%Elem(Sorted));
  166.   Dcl-s LastIdx Int(10);
  167.   Dcl-s NewCount Int(10);
  168.   Dcl-s AddCount Int(10);
  169.   Dcl-s Idx Int(10);
  170.  
  171.   LastIdx  = %Lookup( SortField : Sorted(*).Key : 1 : SortCount);
  172.   If LastIdx  = 0;
  173.     LastIdx  = %Lookup( SortField : SortHeaderFields(*).Hdr  : 1 : SortHeaderCount);
  174.     If LastIdx > 0;
  175.     // Locate the Key for the Header in the field list.
  176.       LastIdx  = %Lookup( SortHeaderFields(LastIdx).Key : Sorted(*).Key : 1 : SortCount);
  177.     Endif;
  178.     If LastIdx  = 0;
  179.     // Not In Sort.
  180.       Return *Off;
  181.     Endif;
  182.   Endif;
  183.   If LastIdx = 1;
  184.     If Sorted(LastIdx).Order = Order_Ascending;
  185.       Sorted(LastIdx).Order = Order_Descending;
  186.     Else;
  187.       Sorted(LastIdx).Order = Order_Ascending;
  188.     Endif;
  189.     Return *On;
  190.   Endif;
  191.  
  192.   NewCount = 1;
  193.   CopyOfSorted(NewCount).Key = SortField;
  194.   CopyOfSorted(NewCount).Order = Order_Ascending;
  195.  
  196.   If LastIdx = 1 And SortCount = 1;
  197.     Sorted = CopyOfSorted;
  198.     SortCount = NewCount;
  199.     Return *On;
  200.   Endif;
  201.   // Copy In Elements *Before* where the field *was*
  202.   If LastIdx > 1;
  203.     AddCount = LastIdx -1;
  204.     %Subarr( CopyOfSorted : NewCount+1 : AddCount) = %Subarr( Sorted : 1 : AddCount);
  205.     NewCount += AddCount;
  206.   Endif;
  207.  
  208.   // Copy in Elements *After* where the field *was*
  209.   If LastIdx < SortCount;
  210.     AddCount = SortCount-LastIdx;
  211.     %Subarr( CopyOfSorted : NewCount+1 : AddCount) = %Subarr( Sorted : LastIdx+1 : AddCount);
  212.     NewCount += AddCount;
  213.   Endif;
  214.   Sorted = CopyOfSorted;
  215.   SortCount = NewCount;
  216.   Return *On;
  217. End-proc;
  218.  
  219.  
  220.  
  221. Dcl-Proc SortData;
  222.   Dcl-Pi *n Int(10);
  223.     Record1 LIKEDS(Dtl) CONST;
  224.     Record2 LIKEDS(Dtl) CONST;
  225.   End-Pi;
  226.  
  227.   DCL-C S_After 1;
  228.   DCL-C S_Equal  0;
  229.   DCL-C S_Before -1;
  230.   Dcl-s RtnCde Int(10);
  231.   Dcl-s Idx Int(10);
  232.  
  233.   RtnCde = S_Equal;
  234.   For Idx = 1 to SortCount;
  235.     Select;
  236.     When Sorted(Idx).Key = 'S0KEY1';
  237.       RtnCde = Compare_Key1( Record1 : Record2 : Sorted(Idx).Order );
  238.     When Sorted(Idx).Key = 'S0KEY2';
  239.       RtnCde = Compare_Key2( Record1 : Record2 : Sorted(Idx).Order );
  240.     When Sorted(Idx).Key = 'S0KEY3';
  241.       RtnCde = Compare_Key3( Record1 : Record2 : Sorted(Idx).Order );
  242.     When Sorted(Idx).Key = 'S0KEY4';
  243.       RtnCde = Compare_Key4( Record1 : Record2 : Sorted(Idx).Order );
  244.     Other;
  245.     // default Key1
  246.       RtnCde = Compare_Key1( Record1 : Record2 : Sorted(Idx).Order );
  247.     Endsl;
  248.     // This check only continues if the current key is equal
  249.     If RtnCde <> S_Equal;
  250.       Return RtnCde;
  251.     Endif;
  252.   Endfor;
  253.   Return RtnCde;
  254. End-proc;
  255.  
  256.  
  257. // Here is a procedure for each sort key.
  258. DCL-PROC Compare_Key1;
  259.   DCL-PI *N Int(10);
  260.     Record1 LIKEDS(Dtl) CONST;
  261.     Record2 LIKEDS(Dtl) CONST;
  262.     Order Char(1) Const Options(*Nopass);
  263.   END-PI;
  264.   DCL-C S_After 1;
  265.   DCL-C S_Equal  0;
  266.   DCL-C S_Before -1;
  267.   If %Parms()>=%Parmnum(Order);
  268.     If Order <> Order_Ascending;
  269.       IF Record1.Key1 > Record2.Key1;
  270.         Return S_Before;
  271.       ELSEIF Record1.Key1 < Record2.Key1;
  272.         Return S_After;
  273.       ELSE;
  274.         Return S_Equal;
  275.       ENDIF;
  276.     Endif;
  277.   Endif;
  278.   IF Record1.Key1 < Record2.Key1;
  279.     Return S_Before;
  280.   ELSEIF Record1.Key1 > Record2.Key1;
  281.     Return S_After;
  282.   ELSE;
  283.     Return S_Equal;
  284.   ENDIF;
  285. END-PROC;
  286. DCL-PROC Compare_Key2;
  287.   DCL-PI *N Int(10);
  288.     Record1 LIKEDS(Dtl) CONST;
  289.     Record2 LIKEDS(Dtl) CONST;
  290.     Order Char(1) Const Options(*Nopass);
  291.   END-PI;
  292.   DCL-C S_After 1;
  293.   DCL-C S_Equal  0;
  294.   DCL-C S_Before -1;
  295.   If %Parms()>=%Parmnum(Order);
  296.     If Order <> Order_Ascending;
  297.       IF Record1.Key2 > Record2.Key2;
  298.         Return S_Before;
  299.       ELSEIF Record1.Key2 < Record2.Key2;
  300.         Return S_After;
  301.       ELSE;
  302.         Return S_Equal;
  303.       ENDIF;
  304.     Endif;
  305.   Endif;
  306.   IF Record1.Key2 < Record2.Key2;
  307.     Return S_Before;
  308.   ELSEIF Record1.Key2 > Record2.Key2;
  309.     Return S_After;
  310.   ELSE;
  311.     Return S_Equal;
  312.   ENDIF;
  313. END-PROC;
  314. DCL-PROC Compare_Key3;
  315.   DCL-PI *N Int(10);
  316.     Record1 LIKEDS(Dtl) CONST;
  317.     Record2 LIKEDS(Dtl) CONST;
  318.     Order Char(1) Const Options(*Nopass);
  319.   END-PI;
  320.   DCL-C S_After 1;
  321.   DCL-C S_Equal  0;
  322.   DCL-C S_Before -1;
  323.   If %Parms()>=%Parmnum(Order);
  324.     If Order <> Order_Ascending;
  325.       IF Record1.Key3 > Record2.Key3;
  326.         Return S_Before;
  327.       ELSEIF Record1.Key3 < Record2.Key3;
  328.         Return S_After;
  329.       ELSE;
  330.         Return S_Equal;
  331.       ENDIF;
  332.     Endif;
  333.   Endif;
  334.   IF Record1.Key3 < Record2.Key3;
  335.     Return S_Before;
  336.   ELSEIF Record1.Key3 > Record2.Key3;
  337.     Return S_After;
  338.   ELSE;
  339.     Return S_Equal;
  340.   ENDIF;
  341. END-PROC;
  342. DCL-PROC Compare_Key4;
  343.   DCL-PI *N Int(10);
  344.     Record1 LIKEDS(Dtl) CONST;
  345.     Record2 LIKEDS(Dtl) CONST;
  346.     Order Char(1) Const Options(*Nopass);
  347.   END-PI;
  348.   DCL-C S_After 1;
  349.   DCL-C S_Equal  0;
  350.   DCL-C S_Before -1;
  351.   If %Parms()>=%Parmnum(Order);
  352.     If Order <> Order_Ascending;
  353.       IF Record1.Key4 > Record2.Key4;
  354.         Return S_Before;
  355.       ELSEIF Record1.Key4 < Record2.Key4;
  356.         Return S_After;
  357.       ELSE;
  358.         Return S_Equal;
  359.       ENDIF;
  360.     Endif;
  361.   Endif;
  362.   IF Record1.Key4 < Record2.Key4;
  363.     Return S_Before;
  364.   ELSEIF Record1.Key4 > Record2.Key4;
  365.     Return S_After;
  366.   ELSE;
  367.     Return S_Equal;
  368.   ENDIF;
  369. END-PROC;
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css