I keep this in a service program, it is a selection list that pops up in a window. It returns the selected list item when called.
// -----------------------------
// Select Job Work Type
// Displays a selection window containing one line for each
// Work Type and allows the user to select one.
//
// Returns the selected work type. Blank if no work type is
// selected, or no work types to select.
// -----------------------------
dcl-proc SelectJobWorkType Export;
dcl-pi *n Like(jcwtmr_t.wktype) end-pi;
dcl-f @dspfcomfm workstn Include(jwtctl: jwtsfl: jwtft)
Sfile(jwtsfl: rrn)
Indds(Indicators);
dcl-ds jwtftout LikeRec(jwtft: *output) Inz;
dcl-ds jwtctlds LikeRec(jwtctl: *all) Inz;
dcl-ds jwtctlout LikeRec(jwtctl: *output) Inz;
dcl-ds jwtsflin LikeRec(jwtsfl: *input) Inz;
dcl-ds jwtsflout LikeRec(jwtsfl: *output) Inz;
dcl-ds jwtAry LikeDs(jcwtmr_t) Dim(LS_MAX_TYPE) Inz;
dcl-ds Indicators Len(99);
F2Pressed Ind Pos(02) Inz(*Off);
UseDS4 Ind Pos(30) Inz(*Off);
sflclr Ind Pos(50) Inz(*Off);
sflend Ind Pos(51) Inz(*Off);
end-ds;
dcl-s RecordSelected Ind Inz(*Off);
dcl-s rrn Int(10) Inz(0);
dcl-s ix Int(10) Inz(0);
dcl-s iy Int(10) Inz(0);
dcl-s jwtCount Int(10) Inz(0);
dcl-s result Char(7) Inz('');
// set screen size
UseDs4 = ScreenSizeIs27x132;
// write footer format
clear jwtftout;
jwtftout.title = 'Select Job Work Type';
write jwtft jwtftout;
// Retrieve predefined comment groups
WTC_OpenJwtCursor();
jwtCount = WTC_FetchJwtCursor(jwtAry);
WTC_CloseJwtCursor();
// initialize subfile
clear jwtctlout;
jwtctlout.sflsiz = jwtCount;
if jwtctlout.sflsiz = 0;
// No predefined comments to select from
return result;
endif;
sflclr = *On;
write jwtctl jwtctlout;
sflclr = *Off;
sflend = *On;
jwtctlds.sflsiz = jwtCount;
// Load predefined comment groups into subfile
jwtsflout.ctlfld = 0;
for ix = 1 to jwtCount;
rrn = ix;
jwtsflout.desc = jwtAry(ix).wktype;
write jwtsfl jwtsflout;
endfor;
// Process selection window
dou RecordSelected;
exfmt jwtctl jwtctlds;
if F2Pressed;
leave;
endif;
for ix = 1 to jwtCount;
chain ix jwtsfl jwtsflin;
if jwtsflin.ctlfld = 1;
result = jwtAry(ix).wktype;
RecordSelected = *On;
leave;
endif;
endfor;
enddo;
return result;
end-proc;
// -----------------------------
// Open Job Work Type Cursor
// Opens an SQL cursor populated with job work types
// -----------------------------
dcl-proc WTC_OpenJwtCursor;
exec sql
declare WTC cursor for
select *
from jcwtmf
order by wktype;
exec sql
open WTC;
if %subst(SqlState: 1: 2) > '02';
exec sql get diagnostics condition 1
:Message = message_text;
SndSqlMsg('WTC01: ' + Message);
endif;
end-proc;
// -----------------------------
// Close Job Work Type Cursor
// -----------------------------
dcl-proc WTC_CloseJwtCursor;
exec sql
close WTC;
end-proc;
// -----------------------------
// Fetch Job Work Types from Cursor
// Returns up to 15 job work types from the
// WTC cursor into provided array
// -----------------------------
dcl-proc WTC_FetchJwtCursor;
dcl-pi *n Int(10);
resultPrm LikeDs(jcwtmr_t) Dim(LS_MAX_TYPE);
end-pi;
dcl-s maxrows Int(10) Inz(%elem(resultPrm));
dcl-s rowCount Packed(31:0) Inz(0);
dcl-s result Int(10) Inz(0);
clear resultPrm;
exec sql
fetch from WTC for :maxrows rows
into :resultPrm;
if %subst(SqlState: 1: 2) > '02';
exec sql get diagnostics condition 1
:Message = message_text;
SndSqlMsg('WTC02: ' + Message);
else;
exec sql get diagnostics
:rowCount = row_count;
result = rowCount;
endif;
return result;
end-proc;
Here is the relevant display file code:
A DSPSIZ(*DS3 *DS4)
A *DS3 MSGLOC(24)
A *DS4 MSGLOC(27)
A INDARA
A* ---------------------------------------------------------------------------------
A* Dummy format to prevent OS400 from clearing display
A* - RPG program need not include this format on declaration
A* ---------------------------------------------------------------------------------
A R ASSUME
A ASSUME
A 1 3' '
A* =================================================================================
A* Select Job Work Type
A* ---------------------------------------------------------------------------------
A* -- Subfile
A* ---------------------------------------------------------------------------------
A R JWTSFL TEXT('Select JWT Subfile')
A SFL
A CTLFLD 1Y 0H SFLCHCCTL
A DESC 30A O 3 5
A* ---------------------------------------------------------------------------------
A* -- Subfile Control
A* ---------------------------------------------------------------------------------
A R JWTCTL TEXT('Select JWT Subfile Control')
A WINDOW(JWTFT)
A 30 DSPMOD(*DS4)
A SFLCTL(JWTSFL)
A SFLSNGCHC(*RSTCSR *SLTIND *AUTOSLT)
A 50 SFLCLR
A N50 SFLDSP SFLDSPCTL
A SFLPAG(5)
A SFLSIZ(&SFLSIZ)
A* 51 SFLEND(*SCRBAR)
A CF02(02)
A CF03(02)
A OVERLAY
A SFLSIZ 5S 0P
A 1 2'Double-click or place cursor on'
A COLOR(WHT)
A 2 2'type & press Enter to select'
A COLOR(WHT)
A* ---------------------------------------------------------------------------------
A* -- Footer
A* ---------------------------------------------------------------------------------
A R JWTFT TEXT('Select PDC Footer')
A WINDOW(6 15 10 40 *NOMSGLIN -
A *NORSTCSR)
A WDWBORDER((*COLOR BLU) (*DSPATR RI))
A WDWTITLE((*TEXT &TITLE) *TOP +
A *CENTER)
A 30 DSPMOD(*DS4)
A OVERLAY
A KEEP
A TITLE 35A P
A FKEY 2Y 0B 9 2PSHBTNFLD
A PSHBTNCHC(1 'Enter' ENTER)
A PSHBTNCHC(2 'F3=Exit' CF03)
A* =================================================================================
There are a few procedures called here that are in other service programs, so this won't compile directly for you, but you can see what is happening anyway.
Mark Murphy
STAR BASE Consulting, Inc.
mmurphy@xxxxxxxxxxxxxxx
-----"PAPWORTH Paul" <Paul.PAPWORTH@xxxxxxxx> wrote: -----
To: "rpg400-l@xxxxxxxxxxxx" <rpg400-l@xxxxxxxxxxxx>
From: "PAPWORTH Paul" <Paul.PAPWORTH@xxxxxxxx>
Date: 07/09/2015 11:52AM
Subject: SUB FILE 100%Free
Would anyone be willing to share a source I could use to help with a development I need to do ?
A simple list with an option box to display the detail would be fine
Thanks in advance
midrange.com
