IBMi (AS400) fans only ' Minimalist Subfile with filter fields
#IBMiSample
First of all look at this post and compile and populate these files to use this example.
Then compile the two following soures, OT08SF displayfile, OT08SF sqlrpg file.
OT08SFV.DSPF
CHGINPDFT(CS UL HI)
INDARA
CA03(03 'F3=EXIT')
REF(OTORD00F)
*--------------------------------------------------------------
R SFL1 SFL
*--------------------------------------------------------------
S1OPT 1A B 6 2
S1ANN0 R +3REFFLD(OTANN0)
S1COR0 R + 1REFFLD(OTCOR0) EDTCDE(Z)
S1NOM0 R + 1REFFLD(CLANA/CLNOM0 CLANA00F)
*--------------------------------------------------------------
R FMT01 SFLCTL(SFL1)
*--------------------------------------------------------------
SFLPAG(0015)
SFLSIZ(&NBRRECS)
OVERLAY
N50 SFLDSP SFLDSPCTL
50 SFLCLR
91 SFLEND(*MORE)
RTNCSRLOC(&PM_RCD &PM_FLD)
PM_RCD 10A H
PM_FLD 10A H
SF1NUM 4S 0H
NBRRECS 5S 0P
1 26'SUBFILE WITH FILTERS EXAMPLE'
F1ANN0 R B 4 6REFFLD(OTANN0)
F1COR0 R B + 1REFFLD(OTCOR0) EDTCDE(Z)
F1NOM0 R B + 1REFFLD(CLANA/CLNOM0 CLANA00F)
+ 1'<--FILTERS'
5 2'OPT'
+1'A'
+1'ORD.NMB'
+1'CUSTOMER NAME'
*--------------------------------------------------------------
R S1CMD
*--------------------------------------------------------------
S1MSG 78A 23 2
24 2'F3=EXIT'
OT08SF.SQLRPGLE
**FREE
ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no);
dcl-f OT08SFV workstn indds(Dspf) sfile(SFL1 : SF1NUM);
// constant
dcl-c MaxSFLrec 9999 ;
dcl-s ReLoadSFL ind inz(*on) ;
// alfanumeric filter fields
dcl-s F1ANN0lke varchar(35) inz('%') ;
dcl-s F1ANN0prv varchar(35) inz(*blanks);
dcl-s F1NOM0lke varchar(35) inz('%') ;
dcl-s F1NOM0prv varchar(35) inz(*blanks);
// numeric filter fields
dcl-s F1COR0str zoned(07) inz(*zeros);
dcl-s F1COR0end zoned(07) inz(*hival);
dcl-s F1COR0prv zoned(09) inz(*zeros);
dcl-ds Dspf qualified ;
Exit ind pos(03) inz(*off);
DoForF6 ind pos(06) inz(*off);
SflClr ind pos(50) inz(*off);
SflEnd ind pos(91) inz(*off);
end-ds ;
dcl-ds RecordDs;
OTANN0 char(1);
OTCOR0 zoned(7);
CLNOM0 char(50);
end-ds;
// Both "exec sql" is not executed but needed at compile time.
// It must be placed just after the last "dcl" declaration.
// LANGIDSHR defines the sort sequence as a "shared-weight sort table",
// upper/lower insensitive, special characters are treated
// "à" as "A"
// "é" as "E" and so on.
exec sql set option Commit = *None;
exec sql set option SRTSEQ = *LANGIDSHR;
// preapre the data recordset
exec sql declare C1 cursor for
select OTORD00F.OTANN0,
OTORD00F.OTCOR0,
CLANA00F.CLNOM0
from OTORD00F
inner join CLANA00F on OTCCL0 = CLCCL0
where OTANN0 like :F1ANN0lke
and OTCOR0 between :F1COR0str and :F1COR0end
and CLNOM0 like :F1NOM0lke
order by OTCOR0
for read only;
//*******************************************************************
// Start working...
//*******************************************************************
ReLoadSFL = *on;
dow Dspf.Exit = *off;
if ReLoadSFL;
LoadSFL();
endif;
write S1CMD;
exfmt FMT01;
select;
when Dspf.Exit; // F3=Exit
leave;
when Dspf.DoForF6; // F6=do something
// call a program or a subroutine
other; // Read user options
dow 1 = 1;
readc SFL1;
if Not %eof;
if S1OPT = '1';
// call a program or a subroutine
endif;
if S1OPT = '2';
// call a program or a subroutine
endif;
S1OPT = '>';
update SFL1;
S1OPT = ' ';
else;
leave;
endif;
enddo;
endsl;
SetFilters();
enddo;
exec sql close C1;
*inlr = *on;
//******************************************************************
// Load subfile //******************************************************************
dcl-proc LoadSFL;
ReLoadSFL = *off;
ReLoadSFL = *off;
// Clear subfile
Dspf.SflClr = *on;
write FMT01;
Dspf.SflClr = *off;
// Load SFL
SF1NUM = *zero;
exec sql close C1;
exec sql open C1;
// Read recordset
dow Sqlcode = 0 and SF1NUM < MaxSFLrec;
exec sql fetch C1 into :RecordDS;
if sqlcode = 0;
S1ANN0 = OTANN0;
S1COR0 = OTCOR0;
S1NOM0 = CLNOM0;
SF1NUM += 1;
write SFL1;
else;
Dspf.SflEnd = *on; // SFLEND *END
endif;
enddo;
NBRRECS = SF1NUM;
S1MSG = %Editc(NBRRECS:'X') + ' record loaded. No more records +
to load';
if sqlcode = 0 and NBRRECS >= MaxSFLrec; // MaxSFLrec reached
S1MSG = %Editc(NBRRECS:'X') + ' records loaded. Use filters field +
to limit the records to be loaded.';
endif;
if NBRRECS = 0;
clear SFL1;
SF1NUM += 1;
S1ANN0 = '*';
S1MSG = 'No records loaded';
write SFL1;
endif;
end-proc;
//*****************************************************************
// Set filters filed //*****************************************************************
dcl-proc SetFilters;
if (F1ANN0 <> F1ANN0prv); // char filter
if (F1ANN0 <> F1ANN0prv); // char filter
F1ANN0prv = F1ANN0;
F1ANN0lke = '%' + %trim(F1ANN0) + '%';
ReLoadSFL = *on;
endif;
if (F1COR0 <> F1COR0prv); // numeric filter need str & end
F1COR0prv = F1COR0;
F1COR0str = F1COR0;
F1COR0end = F1COR0;
ReLoadSFL = *on;
endif;
if (F1COR0 = 0); // numeric filter: if 0 set from 0 to HiVal
F1COR0prv = F1COR0;
F1COR0str = *zeros;
F1COR0end = *HiVal;
endif;
if (F1NOM0 <> F1NOM0prv); // Name
F1NOM0prv = F1NOM0;
F1NOM0lke = '%' + %trim(F1NOM0) + '%';
ReLoadSFL = *on;
endif;
end-proc;
Don't forget to set the screen to 132 columns!
I appreciate all the comments made on this blog.
Comments
Post a Comment