|
The RPGIV for the Subfile Colum Sorting program
**--------------------------------------------------------------------*
** WRITTEN BY : Booth Martin *
** DATE WRITTEN : 07/2004 *
** COMMENTS Undocumented feature: 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. *
** *
**--------------------------------------------------------------------*
FSFLSORTFM cf e workstn
F sfile(SFL1 : SF1NUM)
FSFLSORTP if e disk
* 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 850 dim(200)
D SortUp 50 overlay(SflArrayUp)
D DataUp 800 overlay(SflArrayUp:*next)
D SflArrayDown 850 dim(200) Descend
D SortDown 50 overlay(SflArrayDown)
D DataDown 800 overlay(SflArrayDown:*next)
D UpDownFlag s 10i 0 inz(1)
D wNdx s 10i 0
**====================================================================*
** MAINLINE-BEGIN *
**====================================================================*
* Set initial indicators.
C eval *in81 = *on
C eval *in82 = *off
C eval *in83 = *off
C eval *in84 = *off
C eval *in85 = *off
C eval UpDownFlag = -1
C exsr S1Fill
* Display screen.
C exsr S1Main
* Exit.
C eval *inlr = *on
**====================================================================*
** MAINLINE-END *
**====================================================================*
C*-------------------------------* Sub-Routine *
C* S1Main() *---------------*
C* Screen - Main processing. *
C*-----------------------------------------------*
C S1Main begsr
* Loop until exit.
C dow *inkc = *off
* Display screen.
C write S1CMD
C exfmt S1
C select
* F3=Exit.
C when *inkc = *on
* Cursor located in a column heading field.
C when (pm_fld = 'SF1HDG1') or
C (pm_fld = 'SF1HDG2') or
C (pm_fld = 'SF1HDG3') or
C (pm_fld = 'SF1HDG4') or
C (pm_fld = 'SF1HDG5')
C exsr SFL1Resort
C endsl
C enddo
C endsr
C*-------------------------------* Sub-Routine *
C* S1Fill() *---------------*
C* Screen - Fill screen. *
C*-----------------------------------------------*
C S1Fill begsr
* Clear sorting arrays.
C clear SflArrayUp
C clear SflArrayDown
* Clear subfile.
C eval *in50 = *on
C write S1
C eval *in50 = *off
* Fill SFL.
C eval SF1NUM = *zero
C eval wNdx = *zero
* Read the file.
C *start setll SFLSORTP
C read(e) SFLSORTP
C dow NOT %eof
C exsr FillArray
C read(e) SFLSORTP
C enddo
* Sort the arrays.
C sorta SortUp
C sorta SortDown
* Fill the subfile.
C exsr SFL1Fill
C endsr
C*-------------------------------* Sub-Routine *
C* FillArray() *---------------*
C* Fill the sortable array. *
C*-----------------------------------------------*
C FillArray begsr
* Fill the arrays.
C eval wNdx = wNdx + 1
C eval DataUp(wNdx) = ScreenFields
C eval DataDown(wNdx) = ScreenFields
C select
C when *in81
C eval Sortup(wNdx) = PRESIDENT
C when *in82
C eval Sortup(wNdx) = COLOR
C when *in83
C eval Sortup(wNdx) = NUMBER
C when *in84
C eval Sortup(wNdx) = OCEAN
C when *in85
C eval Sortup(wNdx) = CONTINENT
C endsl
* Fill the SortDown array with the same data as SortUp.
C eval SortDown(wNdx) = SortUp(wNdx)
C endsr
C*-------------------------------* Sub-Routine *
C* SFL1Fill() *---------------*
C* Fill subfile 1. *
C*-----------------------------------------------*
C SFL1Fill begsr
* Clear SFL records.
C clear SFL1
C eval SF1NUM = *zero
* Fill the subfile.
C if UpDownFlag = 1
* Sort descending.
C for wNdx = 1 to %elem(SortDown)
C if DataDown(wNdx) > *blanks
* Move array data to data structure.
C eval ScreenFields = DataDown(wNdx)
C exsr WriteSFL1Line
C endif
C endfor
C else
* Sort ascending.
C for wNdx = 1 to %elem(SortUp)
C if DataUp(wNdx) > *blanks
* Move array data to data structure.
C eval ScreenFields = DataUp(wNdx)
C exsr WriteSFL1Line
C endif
C endfor
C endif
* No records?
C if SF1NUM = *zero
C eval SF1NUM = 1
C eval *in61 = *on
C write(e) SFL1
C endif
* Save values.
C eval SF1RECS = SF1NUM
C eval SF1TOP = 1
C endsr
C*-------------------------------* Sub-Routine *
C* WriteSFL1Line() *---------------*
C* Write a line to subfile 1. *
C*-----------------------------------------------*
C WriteSFL1Line begsr
C eval SF1NUM = SF1NUM + 1
C write(e) SFL1
C endsr
C*-------------------------------* Sub-Routine *
C* SFL1Resort() *---------------*
C* Sort subfile by column heading chosen. *
C*-----------------------------------------------*
C SFL1Resort begsr
* Select prompted column to sort by.
C select
C when pm_fld = 'SF1HDG1'
C if *in81
C eval UpDownFlag = UpDownFlag * -1
C else
C eval UpDownFlag = 1
C eval *in81 = *on
C eval *in82 = *off
C eval *in83 = *off
C eval *in84 = *off
C eval *in85 = *off
C endif
C when pm_fld = 'SF1HDG2'
C if *in82
C eval UpDownFlag = UpDownFlag * -1
C else
C eval UpDownFlag = 1
C eval *in81 = *off
C eval *in82 = *on
C eval *in83 = *off
C eval *in84 = *off
C eval *in85 = *off
C endif
C when pm_fld = 'SF1HDG3'
C if *in83
C eval UpDownFlag = UpDownFlag * -1
C else
C eval UpDownFlag = 1
C eval *in81 = *off
C eval *in82 = *off
C eval *in83 = *on
C eval *in84 = *off
C eval *in85 = *off
C endif
C when pm_fld = 'SF1HDG4'
C if *in84
C eval UpDownFlag = UpDownFlag * -1
C else
C eval UpDownFlag = 1
C eval *in81 = *off
C eval *in82 = *off
C eval *in83 = *off
C eval *in84 = *on
C eval *in85 = *off
C endif
C when pm_fld = 'SF1HDG5'
C if *in85
C eval UpDownFlag = UpDownFlag * -1
C else
C eval UpDownFlag = 1
C eval *in81 = *off
C eval *in82 = *off
C eval *in83 = *off
C eval *in84 = *off
C eval *in85 = *on
C endif
C endsl
C exsr S1Fill
C endsr
|
The DDS for the Screen
*****************************************************************
* WRITTEN BY : Booth Martin *
* DATE WRITTEN : 06-01-2004 *
* COMMENTS : Screen format for sortable columns. *
*****************************************************************
A DSPSIZ(24 80 *DS3)
A REF(*LIBL/SFLSORTP)
A PRINT
A ERRSFL
A CA03
*****************************************************************
A R SFL1 SFL
A PRESIDENT R O 9 2
A COLOR R O + 1
A NUMBER R O + 1
A OCEAN R O + 1
A CONTINENT R O + 1
*****************************************************************
A R S1 SFLCTL(SFL1)
A SFLPAG(0011)
A SFLSIZ(&SF1RECS)
A OVERLAY
A N50 SFLDSP
A N50 SFLDSPCTL
A 50 SFLCLR
A N50 SFLEND(*SCRBAR *MORE)
A RTNCSRLOC(&PM_RCD &PM_FLD)
A PM_RCD 10A H
A PM_FLD 10A H
A SF1NUM 4S 0H
A SF1RECS 5S 0P
A SF1TOP 4S 0H SFLRCDNBR(CURSOR *TOP)
*
A SF1HDG1 R B 8 2REFFLD(PRESIDENT)
A DFTVAL('President')
A DSPATR(UL)
A DSPATR(PR)
A N81 COLOR(BLU)
A 81 COLOR(WHT)
A SF1HDG2 R B 8 15REFFLD(COLOR)
A DFTVAL('Color')
A DSPATR(UL)
A DSPATR(PR)
A N82 COLOR(BLU)
A 82 COLOR(WHT)
A SF1HDG3 R B 8 24REFFLD(NUMBER)
A DFTVAL('Number')
A DSPATR(UL)
A DSPATR(PR)
A N83 COLOR(BLU)
A 83 COLOR(WHT)
A SF1HDG4 R B 8 33REFFLD(OCEAN)
A DFTVAL('Ocean')
A DSPATR(UL)
A DSPATR(PR)
A N84 COLOR(BLU)
A 84 COLOR(WHT)
A SF1HDG5 R B 8 44REFFLD(CONTINENT)
A DFTVAL('Continent')
A DSPATR(UL)
A DSPATR(PR)
A N85 COLOR(BLU)
A 85 COLOR(WHT)
A 2 4' _____ __ -
A ____ __ -
A / ___/___ / /__ __ __-
A _ ___ / __/___ ____ / / -
A / /__ / _ \ / -
A // // // \ / _ \ _\ \ / _ \ / -
A __// __/ \___-
A / \___//_/ \_,_//_/_/_//_//_/ /___-
A / \___//_/ \__/'
A COLOR(TRQ)
*****************************************************************
A R S1CMD
A 24 73'F3=Exit'
A COLOR(BLU)
A 22 2'These subfile columns may be sorte-
A d by clicking a column heading or b-
A y placing the cursor on the column-
A heading and press Enter. A second-
A click will reverse the ascending/-
A descending order of the column.'
A 21 2' -
A -
A '
A DSPATR(UL)
A COLOR(BLU)
|
The DDS for the Data File
A R RSFLSORTP
A PRESIDENT 12
A COLOR 8
A NUMBER 8
A OCEAN 10
A CONTINENT 20
|
| |
