*************************************************************
* A program to select from 3 different files *
* 6/00 Booth Martin *
* *
* *
*************************************************************
FSFL3ColFM CF E WORKSTN
F SFILE(SFLA:RRN)
FFilters1P IF E DISK
FFilters2P IF E DISK
FFilters3P IF E DISK
D ReadFilters1P S 3 INZ('Yes')
D ReadFilters2P S 3 INZ('Yes')
D ReadFilters3P S 3 INZ('Yes')
* Arrays of Selected Items
D Inx S 3S 0
D Inx1 S 3S 0
D AR1 S 2 DIM(60)
D Inx2 S 3S 0
D AR2 S 2 DIM(60)
D Inx3 S 3S 0
D AR3 S 2 DIM(60)
* ..................................................
C Z-ADD 1 RRN 4 0
* Clear subfile & screen, prepare to re-fill or fill:
C Eval *IN90=*OFF
C Clear SFLA
C Write FOOTer
C Write FMT01
C EXSR FillSubfileSR
**
C RRN IFLT 11
C MOVE *ON *IN91
C END
C MOVE *ON *IN90
C WRITE FOOTer
C DoW *INLR = *Off
C EXFMT FMT01
C Read Footer
C Select
* Footer Push button Choices:
* Refresh Subfile:
C When PB1 = 1 Or *INKE = *On
C Eval ReadFilters1P = 'Yes'
C Eval ReadFilters2P = 'Yes'
C Eval ReadFilters3P = 'Yes'
C GOTO RefreshTag
* Run the job
C When PB1 = 2 Or *INKJ
C Exsr AcceptSR
C Eval *INLR = *ON
* end the job
C When PB1 = 3 or *INKC Or *INKL
C Eval *INLR = *ON
* Mouse clicked in Column 1, toggle the field
* (Note: The DDS has a mouse button click = F11. The reason for this is
* so that a regular Enter while the cursor is in a Filter field
* won't toggle the field's value. F11=*INKK)
C When FLD = 'COL1O' And *INKK
C Relrcd Chain SFLA
C If Col1o = 'Y'
C Eval Col1o = ' '
C Else
C Eval Col1o = 'Y'
C End
C Update Sfla
* Mouse clicked in Column 2, toggle the field
C When FLD = 'COL2O' And *INKK
C Relrcd Chain SFLA
C If Col2o = 'Y'
C Eval Col2o = ' '
C Else
C Eval Col2o = 'Y'
C End
C Update Sfla
* Mouse clicked in Column 3, toggle the field
C When FLD = 'COL3O' And *INKK
C Relrcd Chain SFLA
C If Col3o = 'Y'
C Eval Col3o = ' '
C Else
C Eval Col3o = 'Y'
C End
C Update Sfla
C EndSL
C END
C RefreshTag Tag
* _________________________________________________________________
C AcceptSR BegSR
* If a choice was made, then do the required action:
C Eval Inx = 1
C Eval Inx1 = 1
C Eval Inx2 = 1
C Eval Inx3 = 1
C Inx Chain SFLA
C If %Found
C DoU %EOF or Not %Found
C If Col1o = 'Y'
C Eval Ar1(Inx1) = Col1H
C Eval Inx1 = Inx1 + 1
C End
C If Col2o = 'Y'
C Eval Ar2(Inx2) = Col2H
C Eval Inx2 = Inx2 + 1
C End
C If Col3o = 'Y'
C Eval Ar3(Inx3) = Col3H
C Eval Inx3 = Inx3 + 1
C End
C Eval Inx = Inx + 1
C Inx Chain SFLA
C EndDo
C EndIf
* Sort the arrays so we can do look ups:
C Sorta AR1
C Sorta AR2
C Sorta AR3
* Write a file of records for printing the report(s):
C Exsr WriteRecordSR
C EndSR
* _________________________________________________________________
C WriteRecordSR BegSR
* This sub routine is blank. It is trivial to add whatever code is
* needed to make the filters selected be useful. The purpose of this
* exercise is to show the 3-column subfile and the toggling of the values
C EndSR
* _________________________________________________________________
C FillSubfileSR BegSR
C 1 Setll Filters1P
C 1 Setll Filters2P
C 1 Setll Filters3P
C DoW ReadFilters1P = 'Yes' Or
C ReadFilters2P = 'Yes' Or
C ReadFilters3P = 'Yes'
C Exsr WriteLineSR
C Write SFLA
C Eval RRN = RRN + 1
C End
C Eval NBRREC = RRN
C EndSR
* _________________________________________________________________
* Write the line in the subfile:
C WriteLineSR BegSR
* Column 1: Status
C Eval Col1O = ' '
C Eval Col2O = ' '
C Eval Col3O = ' '
* Column 1: Filters 1
C Eval Col1 =*Blanks
C Eval Col1H =' '
C If ReadFilters1P = 'Yes'
C Read Filters1P
C If Not %EOF
C Eval Col1 = TypeID + ' ' + TYPEDS
C Eval Col1H = TypeID
C Eval Col1O = 'Y'
C Else
C Eval ReadFilters1P = 'No '
C End
C End
* Column 2: Filters2P
C Eval Col2 =*Blanks
C Eval Col2H =' '
C If ReadFilters2P = 'Yes'
C Read Filters2P
C If Not %EOF
C Eval Col2 = ST + ' ' + STATE
C Eval Col2H = ST
C Eval Col2O = 'Y'
C Else
C Eval ReadFilters2P = 'No '
C End
C End
* Column 3: FiltersP
C Eval Col3 =*Blanks
C Eval Col3H =' '
C If ReadFilters3P = 'Yes'
C Read Filters3P
C If Not %EOF
C Eval Col3 = CNTRY + ' ' + COUNTRY
C Eval Col3H = CNTRY
C Eval Col3O = 'Y'
C Else
C Eval ReadFilters3P = 'No '
C End
C End
C EndSR
* _____________________________________________________
The DSPF code of 3-Column Subfile
A DSPSIZ(24 80 *DS3)
A CHGINPDFT(HI UL)
A CSRINPONLY
A ERRSFL
A CF03(03 'Exit')
A CF05(05 'Refresh')
A CF10(10 'Run')
A CF11(11 'Toggle field')
A CF12(12 'Exit')
A MOUBTN(*ULD CF11)
A R SFLA SFL
A*
A COL1O 1A B 11 4SFLCSRPRG
A COL1 20A O 11 6DSPATR(HI)
A COL2O 1A B 11 29SFLCSRPRG
A COL2 20A O 11 31DSPATR(HI)
A COL3O 1A B 11 54SFLCSRPRG
A COL3 20A O 11 56DSPATR(HI)
A COL1H 2A H
A COL2H 2A H
A COL3H 2A H
A*
A R FMT01 SFLCTL(SFLA)
A SFLPAG(0011)
A SFLSIZ(&NBRREC)
A OVERLAY
A RTNCSRLOC(&REC &FLD)
A SFLCSRRRN(&RELRCD)
A 90 SFLDSP
A 90 SFLDSPCTL
A N90 SFLCLR
A 91 SFLEND(*SCRBAR *MORE)
A RELRCD 5S 0H
A NBRREC 5S 0P
A REC 10A H
A FLD 10A H
A 1 69DATE
A EDTCDE(Y)
A 2 69TIME
A 3 69SYSNAME
A 4 69'Filter'
A 5 69USER
A 7 4'Filter by these fields'
A DSPATR(HI)
A 10 4' Type '
A DSPATR(UL)
A COLOR(BLU)
A 10 29' State '
A DSPATR(UL)
A COLOR(BLU)
A 10 54' Country '
A DSPATR(UL)
A COLOR(BLU)
A 7 49'Select for printing = "Y"'
A 8 49'Print report = Run, or F10'
A DSPATR(BL)
A COLOR(GRN)
A 1 3' ____ _____ __ -
A ____ __ ____ __ '
A 2 3' _ /___/ ___/__ / /_ ____ _ _-
A __ / __/_ __/ / / _(_) /__ '
A 3 3' _/_ <___/ /__/ _ \/ / // / \/ -
A _ \ _\ \/ // / _ \/ _/ / / -_)'
A 4 3'/____/ \___/\___/_/\_,_/_/_/_/_/-
A /_/ /___/\_,_/_.__/_//_/_/\__/ '
A R FOOTER
A PB1 2Y 0B 23 3PSHBTNFLD
A PSHBTNCHC(1 'Refresh (F5) ' CF05)
A PSHBTNCHC(2 'Run (F10) ' CF10)
A PSHBTNCHC(3 'Cancel (F12) ' CF12)
reference from Booth Martin
Read more!
