Logo2
SFL Sort
[Home] [Subfiles] [SFL Sort]

The RPG for the Subfile Column Sorting program
      ****************************************************************
      *   ___             _    _     __ __             _    _        *
      *  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _   *
      *  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |  *
      *  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|  *
      *                                                              *
      *  A program to  show a sortable subfile  (Version II)         *
      *                                                              *
      *   4/2014                                 booth@martinvt.com  *
      ****************************************************************
      * COMMENTS   Subfile can be sorted by                          *
      *            columns (ascending & descending). Click an        *
      *            underlined column heading or place the cursor     *
      *            on an underlined column heading and press enter.  *
      *            Choosing the same column heading again reverses   *
      *            the sorting order.                                *
      *--------------------------------------------------------------*
     h COPYRIGHT(' Booth Martin, 2010, 2015. All rights reserved.')
     h option(*nodebugio) dftactgrp(*no) actgrp(*new)

     fSFLSORTD  cf   e             workstn sfile(SFL1: RRN)
     fSFLSORTP  if   e             disk

      *  ASCII art panel for heading. (Use a Figlet generator.)
     d FIGLET          ds
     d Figar                         60    dim(6) ctdata perrcd(1)

      * Constants
     d cTRQ            c                   x'30'
     d cTRQu           c                   x'34'
     d cBLUu           c                   x'3E'

      * Data structures.
     d ScreenFields    ds
     d  PRESIDENT
     d  COLOR
     d  NUMBER
     d  OCEAN
     d  CONTINENT

      * Set the subfile for sorting - ascending & descending
     d                 ds
     d SflArrayUp                          dim(200) Ascend
     d  APRESIDENT                         overlay(SflArrayUp)
     d                                     like(PRESIDENT)
     d  ACOLOR                             overlay(SflArrayUp: *next)
     d                                     like(COLOR    )
     d  ANUMBER                            overlay(SflArrayUp: *next)
     d                                     like(NUMBER   )
     d  AOCEAN                             overlay(SflArrayUp: *next)
     d                                     like(OCEAN    )
     d  ACONTINENT                         overlay(SflArrayUp: *next)
     d                                     like(CONTINENT)
     d SflArrayDown                        dim(200) Descend
     d  DPRESIDENT                         overlay(SflArrayDown)
     d                                     like(PRESIDENT)
     d  DCOLOR                             overlay(SflArrayDown: *next)
     d                                     like(COLOR    )
     d  DNUMBER                            overlay(SflArrayDown: *next)
     d                                     like(NUMBER   )
     d  DOCEAN                             overlay(SflArrayDown: *next)
     d                                     like(OCEAN    )
     d  DCONTINENT                         overlay(SflArrayDown: *next)
     d                                     like(CONTINENT)

     d wCol1           s               n
     d wCol2           s               n
     d wCol3           s               n
     d wCol4           s               n
     d wCol5           s               n
     d wAscendingFlag  s               n
     d wNdx            s             10i 0

      //====================================================================*
      // MAINLINE-BEGIN                                                     *
      //====================================================================*
      /FREE
       // Display screen.
       exsr S1Main;
       // Exit.
       exsr ExitPgm;
       //====================================================================*
       // MAINLINE-END                                                       *
       //====================================================================*
       //-------------------------------*  Sub-Routine  *
       // *inzsr()                      *---------------*
       // Initializing sub routine                      *
       //-----------------------------------------------*
       begsr *inzsr;
         exsr FillArray;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // ExitPgm()                     *---------------*
       // end of processing                             *
       //-----------------------------------------------*
       begsr ExitPgm;
         *inlr = *on;
         return;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // S1Main()                      *---------------*
       // Screen - Main processing.                     *
       //-----------------------------------------------*
       begsr S1Main;
         // Loop until exit.
         dow *inkc = *off;
           //   Display screen.
           exfmt S1;
           select;
           when *inkc = *on;   // F3=Exit.
             leave;
           when %subst(pm_fld: 1: 6) = 'SF1HDG';    // Cursor located in a
             exsr SFL1Resort;                       // column heading field.
           endsl;
         enddo;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // S1Fill()                      *---------------*
       // Screen - Fill screen.                         *
       //-----------------------------------------------*
       begsr S1Fill;
         TIMEUSA = %char(%time(): *usa);
         DATEMDY = %char(%date(): *mdy);
         write S1CMD;

         // Clear subfile.
         *in50 = *on;
         write S1;
         *in50 = *off;

         // Fill SFL.
         RRN = *zero;
         // Fill the subfile.
         if wAscendingFlag = *off;  // Sort descending.
           for wNdx = 1 to %elem(SflArrayDown);
             if SflArrayDown(wNdx) > *blanks;
               ScreenFields = SflArrayDown(wNdx);  // Move array to data structure.
               RRN = RRN + 1;
               write SFL1;
             endif;
           endfor;
         else;
           for wNdx = 1 to %elem(SflArrayUp); // Sort ascending.
             if SflArrayUp(wNdx) > *blanks;
               ScreenFields = SflArrayUp(wNdx);  // Move array to data structure.
               RRN = RRN + 1;
               write SFL1;
             endif;
           endfor;
         endif;
         // No records?
         if RRN = *zero;
           RRN = 1;
           write(e) SFL1;
         endif;

         // Save values.
         SF1RECS = RRN;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // FillArray()                   *---------------*
       // Fill the sortable array & fill subfile.       *
       //-----------------------------------------------*
       begsr FillArray;
         wNdx = 0;
         clear SflArrayUp;
         clear SflArrayDown;
         // Read the file.
         setll *start SFLSORTP;
         read(e) SFLSORTP;
         dow %eof = *off and wNdx < 200;    // (Limited for demo at 200 records.)
           wNdx = wNdx + 1;
           SflArrayUp(wNdx)   = ScreenFields;
           SflArrayDown(wNdx) = ScreenFields;
           read(e) SFLSORTP;
         enddo;
         wCol1 = *on;  // always start with column 1-ascending when filling array
         exsr SFL1Resort;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // SFL1Resort()                  *---------------*
       // Sort subfile by column heading chosen.        *
       //-----------------------------------------------*
       begsr SFL1Resort;
           SF1HDG1 = cBLUu + 'President';  // Set all headings to BLU
           SF1HDG2 = cBLUu + 'Color';
           SF1HDG3 = cBLUu + 'Number';
           SF1HDG4 = cBLUu + 'Ocean';
           SF1HDG5 = cBLUu + 'Continent';
       // Select prompted column to sort by.
       select;
         // if columm1, see "other"  (for first cycle.)
         when pm_fld = 'SF1HDG2';
           SF1HDG2 = cTRQu + 'Color';
           wCol1 = *off;
           wCol3 = *off;
           wCol4 = *off;
           wCol5 = *off;
           if wCol2 = *off;
             wAscendingFlag = *off;
             wCol2 = *on;
           endif;
           if wAscendingFlag;
             wAscendingFlag = *off;
             sorta DCOLOR;
           else;
             wAscendingFlag = *on;
             sorta ACOLOR;
           endif;

         when pm_fld = 'SF1HDG3';
           SF1HDG3 = cTRQu + 'Number';
           wCol2 = *off;
           wCol1 = *off;
           wCol4 = *off;
           wCol5 = *off;
           if wCol3 = *off;
             wAscendingFlag = *on;
             wCol3 = *on;
           endif;
           if wAscendingFlag;
             wAscendingFlag = *off;
             sorta DPRESIDENT;
           else;
             wAscendingFlag = *on;
             sorta APRESIDENT;
           endif;

         when pm_fld = 'SF1HDG4';
           SF1HDG4 = cTRQu + 'Ocean';
           wCol2 = *off;
           wCol3 = *off;
           wCol1 = *off;
           wCol5 = *off;
           if wCol4 = *off;
             wAscendingFlag = *on;
             wCol4 = *on;
           endif;
           if wAscendingFlag;
             wAscendingFlag = *off;
             sorta DOCEAN;
           else;
             wAscendingFlag = *on;
             sorta AOCEAN;
           endif;

         when pm_fld = 'SF1HDG5';
           SF1HDG5 = cTRQu + 'Continent';
           wCol2 = *off;
           wCol3 = *off;
           wCol4 = *off;
           wCol1 = *off;
           if wCol5 = *off;
             wAscendingFlag = *on;
             wCol5 = *on;
           endif;
           if wAscendingFlag;
             wAscendingFlag = *off;
             sorta DCONTINENT;
           else;
             wAscendingFlag = *on;
             sorta ACONTINENT;
           endif;

         other;    // Column 1 or *inzsr
           SF1HDG1 = cTRQu + 'President';
           wCol2 = *off;
           wCol3 = *off;
           wCol4 = *off;
           wCol5 = *off;
           if wCol1 = *off;
             wAscendingFlag = *on;
             wCol1 = *on;
           endif;
           if wAscendingFlag;
             wAscendingFlag = *off;
             sorta DPRESIDENT;
           else;
             wAscendingFlag = *on;
             sorta APRESIDENT;
           endif;
         endsl;
         exsr S1Fill;   // fill subfile
       endsr;
      /END-FREE
** FIGAR 1....+....2....+,,,,3,,,,+,,,,4,,,,+....5....+....6....+
  ___          _     _                  _
 / __| ___ _ _| |_  | |__ _  _   __ ___| |_  _ _ __  _ _
 \__ \/ _ \ '_|  _| | '_ \ || | / _/ _ \ | || | '  \| ' \
 |___/\___/_|  \__| |_.__/\_, | \__\___/_|\_,_|_|_|_|_||_|
                          |__/
 
 







The DDS for the Screen

      ****************************************************************
      *   ___             _    _     __ __             _    _        *
      *  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _   *
      *  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |  *
      *  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|  *
      *                                                              *
      *  A program to show a sortable subfile, by mouse click.       *
      *                                                              *
      *                                                              *
      *    4/2014                                booth@martinvt.com  *
      ****************************************************************
                                            DSPSIZ(24 80 *DS3)
                                            REF(SFLSORTP)
                                            ERRSFL
                                            CA03
                                            MOUBTN(*ULD ENTER)
      *****************************************************************
                R SFL1                      SFL
                  PRESIDENT R        O  9  4
                  COLOR     R        O   + 1
                  NUMBER    R        O   + 1
                  OCEAN     R        O   + 1
                  CONTINENT R        O   + 1
      *****************************************************************
                R S1                        SFLCTL(SFL1)
                                            SFLPAG(0011)
                                            SFLSIZ(&SF1RECS)
                                            OVERLAY
       N50                                  SFLDSP SFLDSPCTL
        50                                  SFLCLR
       N91                                  SFLEND(*SCRBAR)
                                            RTNCSRLOC(&PM_RCD &PM_FLD)
                  PM_RCD        10A  H
                  PM_FLD        10A  H
                  RRN            4S 0H
                  SF1RECS        5S 0P

                  FIGLET       360   B  2  3CNTFLD(60) CHGINPDFT
                                            DSPATR(PR) COLOR(YLW)
                  DATEMDY        8      2 70
                  TIMEUSA        8      3 70
                                        4 70'system i'
                                        5 70USER
                  SF1HDG1   R        B  8  3REFFLD(PRESIDENT)
                                            DSPATR(PR)
                  SF1HDG2   R        B   + 1REFFLD(COLOR)
                                            DSPATR(PR)
                  SF1HDG3   R        B   + 1REFFLD(NUMBER)
                                            DSPATR(PR)
                  SF1HDG4   R        B   + 1REFFLD(OCEAN)
                                            DSPATR(PR)
                  SF1HDG5   R        B   + 1REFFLD(CONTINENT)
                                            DSPATR(PR)
      *****************************************************************
                R S1CMD
                                       24 73'F3=Exit'
                                            COLOR(BLU)
                                       22  2'These subfile columns may be sorte-
                                            d by clicking a column heading or b-
                                            y placing  the cursor on the column-
                                             heading and press Enter.  A second-
                                             click will reverse  the ascending/-
                                            descending order of the column.'
                                            COLOR(TRQ)
                                       21  2'                                  -
                                                                               -
                                                     '
                                            DSPATR(UL)
                                            COLOR(BLU) 







The DDS for the Data File


      ****************************************************************
      *   ___             _    _     __ __             _    _        *
      *  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _   *
      *  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |  *
      *  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|  *
      *                                                              *
      *  A file for the sortable subfile demo program.               *
      *                                                              *
      *  10/2010                                 booth@martinvt.com  *
      ****************************************************************

                R RSFLSORTP
                  PRESIDENT     12
                  COLOR          8
                  NUMBER         8
                  OCEAN         10
                  CONTINENT     20 
                  

Please contact our Webmaster with questions or comments.

© Copyright 2010-2019, Contract Programming  All rights reserved.