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;
  // 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
    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

Popular posts from this blog

IBMi (AS400) fans only ‘ Memories (IBM Coding Forms)

IBM i (AS400) fans only ' How to read a TXT file in the IFS with SQL