× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  1.  Home
  2. RPG400-L
  3. March 2010

Re: AW: More on RPG style

OK, so here it is. I *could* have gone with the simple routine for the
in_int() procedure (just comparing passed parameters, as with the basic
character version), but I figured "why not make it complicated"! So I
thought I'd add some MI stuff...

So as you can see, in(), in_upper() and in_int() all call @in() under the
covers (although in_int() calls it by its 'alternate' name of @in2(), which
uses a different parameter list). @in() uses the _NPMPARMLISTADDR MI builtin
to check all the parameters. This is a really useful technique where you
have lots of repeated parameters.

Only in(), in_upper() and in_int() would be exported from the module/service
program (which I created as a program for ease of testing). I could probably
have been even fancier and simply called @in() directly (without the first
parameter) and simply determined what kind of value was passed by checking
the opdesc bit. But I'd still not be able to check for the ignore case'
flag.

I'll add a like() and like_upper() procedure as well, so you can do
something like

checkfield = '%abc%';
flag = like( checkfield : field1 : field2 : field3 : field4 );

or something like that.

Anyway, here's the code. Nothing's in copybooks for this sample code.

H DEBUG(*YES)
T* @IN
X* QCMPSRC,CRTBNDRPG
Z* BNDDIR(QC2LE) ACTGRP(TEST)
*=============================================================================================
*‚Program identification
*---------------------------------------------------------------------------------------------

D ThisProgram C '@IN'

*---------------------------------------------------------------------------------------------
*‚Internal procedure prototypes
*---------------------------------------------------------------------------------------------

D in PR N Extproc('in')
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)

D in_upper PR N Extproc('in_upper')
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)

D in_int PR N Extproc('in_int')
D pSearch 10I 0 Const
D pScan1 10I 0 Const
D pScan2 10I 0 Const Options(*Nopass)
D pScan3 10I 0 Const Options(*Nopass)
D pScan4 10I 0 Const Options(*Nopass)
D pScan5 10I 0 Const Options(*Nopass)
D pScan6 10I 0 Const Options(*Nopass)
D pScan7 10I 0 Const Options(*Nopass)
D pScan8 10I 0 Const Options(*Nopass)
D pScan9 10I 0 Const Options(*Nopass)
D pScan10 10I 0 Const Options(*Nopass)

D @in PR N Extproc('@in')
D pOpt 1A Const
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)

D @in2 PR N Extproc('@in')
D pOpt 1A Const
D pSearch 10I 0 Const
D pScan1 10I 0 Const
D pScan2 10I 0 Const Options(*Nopass)
D pScan3 10I 0 Const Options(*Nopass)
D pScan4 10I 0 Const Options(*Nopass)
D pScan5 10I 0 Const Options(*Nopass)
D pScan6 10I 0 Const Options(*Nopass)
D pScan7 10I 0 Const Options(*Nopass)
D pScan8 10I 0 Const Options(*Nopass)
D pScan9 10I 0 Const Options(*Nopass)
D pScan10 10I 0 Const Options(*Nopass)

*---------------------------------------------------------------------------------------------
*‚Global variables
*---------------------------------------------------------------------------------------------

D Npm_ParmList_Addr...
D PR * Extproc('_NPMPARMLISTADDR')

D Npm_ParmList_t DS Based(TEMPLATE) Qualified
D desclistptr *
D 16A
D parmptr * Dim(400)

D Npm_DescList_t DS Based(TEMPLATE) Qualified
D argc 10I 0
D 8A
D opdesc 10I 0
D 16A
D descptr * Dim(400)

D Npm_Desc_t DS Based(TEMPLATE) Qualified
D type 3I 0
D datatype 3I 0
D inf1 3I 0
D inf2 3I 0
D len 10I 0

D Npm_ParmNbr_t S 10I 0 Based(TEMPLATE)
D Npm_DataPtr_t S * Based(TEMPLATE)

D rc S 10I 0 Inz
D LOWER C 'abcdefghijklmnopqrstuvwxyz'
D UPPER C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
D checkfield S 512A Varying
D checkint S 10I 0

*---------------------------------------------------------------------------------------------
*‚Main procedure interface
*---------------------------------------------------------------------------------------------

D main PR Extpgm(ThisProgram)

D main PI

*=============================================================================================
*‚MAINLINE
*=============================================================================================
/free

//‚Do stuff here
checkfield = 'john';
if in( checkfield : 'carl' : 'mike' : 'john' : 'seth' );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;

if in_upper( checkfield : 'CARL' : 'mIKe' : 'john' : 'Seth' );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;

checkint = 12;
if in_int( checkint : 1 : 14 : 72 : 12 );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;

return;

begsr *pssr;
return;
endsr;

/end-free
*=============================================================================================
*‚in(): Scan for a string in a series of other strings
*=============================================================================================
P in B Export
D PI N
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)
*---------------------------------------------------------------------------------------------
/free

select;
when %parms = 2;
return @in( ' ' : pSearch : pScan1 );
when %parms = 3;
return @in( ' ' : pSearch : pScan1 : pScan2 );
when %parms = 4;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 );
when %parms = 5;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 );
when %parms = 6;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 );
when %parms = 7;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 );
when %parms = 8;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 );
when %parms = 9;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 );
when %parms = 10;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 : pScan9 );
when %parms = 11;
return @in( ' ' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 : pScan9 :
pScan10 );
endsl;

begsr *pssr;
return *off;
endsr;

/end-free
P E
*=============================================================================================
*‚in_upper(): Scan for a string in a series of other strings
*=============================================================================================
P in_upper B Export
D PI N
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)
*---------------------------------------------------------------------------------------------
/free

select;
when %parms = 2;
return @in( 'U' : pSearch : pScan1 );
when %parms = 3;
return @in( 'U' : pSearch : pScan1 : pScan2 );
when %parms = 4;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 );
when %parms = 5;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 );
when %parms = 6;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 );
when %parms = 7;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 );
when %parms = 8;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 );
when %parms = 9;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 );
when %parms = 10;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 : pScan9 );
when %parms = 11;
return @in( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 : pScan9 :
pScan10 );
endsl;

begsr *pssr;
return *off;
endsr;

/end-free
P E
*=============================================================================================
*‚in_int(): Scan for an integer in a series of other integers
*=============================================================================================
P in_int B Export
D PI N
D pSearch 10I 0 Const
D pScan1 10I 0 Const
D pScan2 10I 0 Const Options(*Nopass)
D pScan3 10I 0 Const Options(*Nopass)
D pScan4 10I 0 Const Options(*Nopass)
D pScan5 10I 0 Const Options(*Nopass)
D pScan6 10I 0 Const Options(*Nopass)
D pScan7 10I 0 Const Options(*Nopass)
D pScan8 10I 0 Const Options(*Nopass)
D pScan9 10I 0 Const Options(*Nopass)
D pScan10 10I 0 Const Options(*Nopass)
*---------------------------------------------------------------------------------------------
/free

select;
when %parms = 2;
return @in2( 'U' : pSearch : pScan1 );
when %parms = 3;
return @in2( 'U' : pSearch : pScan1 : pScan2 );
when %parms = 4;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 );
when %parms = 5;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 );
when %parms = 6;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 );
when %parms = 7;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 );
when %parms = 8;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 );
when %parms = 9;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 );
when %parms = 10;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 : pScan9 );
when %parms = 11;
return @in2( 'U' : pSearch : pScan1 : pScan2 : pScan3 : pScan4 :
pScan5 : pScan6 : pScan7 : pScan8 : pScan9 :
pScan10 );
endsl;

begsr *pssr;
return *off;
endsr;

/end-free
P E
*=============================================================================================
*‚@in(): Scan for a string in a series of other strings
*=============================================================================================
P @in B
D PI N
D pOpt 1A Const
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)
*---------------------------------------------------------------------------------------------
D plist DS Likeds(Npm_ParmList_t)
D Based(plistptr)
D dlist DS Likeds(Npm_DescList_t)
D Based(dlistptr)
D parmnbr S Like(Npm_ParmNbr_t)
D parmptr S *
D parm S 512A Varying Based(parmptr)
D parm_int S 10I 0 Based(parmptr)
D Search S 512A Varying
D Search_int S 10I 0
D Scan S 512A Varying
*---------------------------------------------------------------------------------------------
/free

//‚Load parameters
plistptr = Npm_ParmList_Addr();
dlistptr = plist.desclistptr;

select;
when pOpt = 'I';
parmptr = plist.parmptr(2);
Search_int = parm_int;
when pOpt = 'U';
Search = %xlate( LOWER : UPPER : pSearch );
other;
Search = pSearch;
endsl;

//‚Check parms
for parmnbr = 3 to dlist.argc;
parmptr = plist.parmptr(parmnbr);
if parmptr <> *null;
select;
when pOpt = 'I';
if Search_int = parm_int;
return *on;
endif;
when pOpt = 'U';
Scan = %xlate( LOWER : UPPER : parm );
if Search = Scan;
return *on;
endif;
other;
if Search = parm;
return *on;
endif;
endsl;
else;
leave;
endif;
endfor;

return *off;

begsr *pssr;
return *off;
endsr;

/end-free
P E



Enjoy!

Rory

On Fri, Mar 5, 2010 at 2:53 PM, Harman, Roger <Roger.Harman@xxxxxxxxxx>wrote:

And... to add to Vern's mission assignment... a flag to indicate case
(in)sensitivity.

This email will self destruct in 5 seconds......
Good Luck, Jim (oops... Rory)


-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of Vern Hamberg
Sent: Friday, March 05, 2010 2:29 PM
To: RPG programming on the IBM i / System i
Subject: Re: AW: More on RPG style

LOL Rory - I knew someone would take the bait - nice!

I'm assuming that the first parameter would usually be a variable,
otherwise, you'd know whether it was in the list already!

Now a similar function for numerics! Your mission, if you choose to
accept it!

Vern

Rory Hewitt wrote:
OK, that was actually the code for my (unfinshed) @LIKE function - silly
me!
It should be:

*=====================================================================
* @in(): Check for a string in a series of other strings
*=====================================================================
P @in B Export
D PI N
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)
*---------------------------------------------------------------------
/free

if ( pSearch = pScan1 ) or
( %parms > 2 and pSearch = pScan2 ) or
( %parms > 3 and pSearch = pScan3 ) or
( %parms > 4 and pSearch = pScan4 ) or
( %parms > 5 and pSearch = pScan5 ) or
( %parms > 6 and pSearch = pScan6 ) or
( %parms > 7 and pSearch = pScan7 ) or
( %parms > 8 and pSearch = pScan8 ) or
( %parms > 9 and pSearch = pScan9 ) or
( %parms > 10 and pSearch = pScan10 );
return *on;
else;
return *off;
endif;

begsr *pssr;
return *off;
endsr;

/end-free
P E

Rory

On Fri, Mar 5, 2010 at 2:08 PM, Rory Hewitt <rory.hewitt@xxxxxxxxx>
wrote:


Like this?

if @in( 'me' : 'john' : 'mike' : 'home' : 'seth' );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;


*=====================================================================
* @in(): Scan for a string in a series of other strings
*=====================================================================
P @in B Export
D PI N
D pSearch 512A Const Varying
D pScan1 512A Const Varying
D pScan2 512A Const Varying Options(*Nopass)
D pScan3 512A Const Varying Options(*Nopass)
D pScan4 512A Const Varying Options(*Nopass)
D pScan5 512A Const Varying Options(*Nopass)
D pScan6 512A Const Varying Options(*Nopass)
D pScan7 512A Const Varying Options(*Nopass)
D pScan8 512A Const Varying Options(*Nopass)
D pScan9 512A Const Varying Options(*Nopass)
D pScan10 512A Const Varying Options(*Nopass)
*---------------------------------------------------------------------
D qusec DS Likeds(qusec_t) Inz(*Likeds)
*---------------------------------------------------------------------
/free

lead = %subst( pSearch : 1 : 1 ) = '%';
trail = %subst( pSearch : %len( pSearch ) : 1 ) = '%';

if ( %scan( pSearch : pScan1 ) > 0 ) or
( %parms > 2 and %scan( pSearch : pScan2 ) > 0 ) or
( %parms > 3 and %scan( pSearch : pScan3 ) > 0 ) or
( %parms > 4 and %scan( pSearch : pScan4 ) > 0 ) or
( %parms > 5 and %scan( pSearch : pScan5 ) > 0 ) or
( %parms > 6 and %scan( pSearch : pScan6 ) > 0 ) or
( %parms > 7 and %scan( pSearch : pScan7 ) > 0 ) or
( %parms > 8 and %scan( pSearch : pScan8 ) > 0 ) or
( %parms > 9 and %scan( pSearch : pScan9 ) > 0 ) or
( %parms > 10 and %scan( pSearch : pScan10 ) > 0 );
return *on;
else;
return *off;
endif;

begsr *pssr;
return *off;
endsr;

/end-free
P E

This one only works with strings and it's pretty basic, but you get the
idea...

Rory

On Fri, Mar 5, 2010 at 1:22 PM, Vern Hamberg <vhamberg@xxxxxxxxxxx>
wrote:


[...]But you could have it so

that only the value to test and the first comparison value are required
- the rest could be *NOPASS.

OK - time for real work!!

Vern





--
This is the RPG programming on the IBM i / System i (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.

This message contains confidential information and is intended only for the
individual named. If you are not the named addressee you should not
disseminate, distribute or copy this e-mail. Please notify the sender
immediately by e-mail if you have received this e-mail by mistake and delete
this e-mail from your system. (Knotts Berry Farm - Cedar Fair L.P.)
--
This is the RPG programming on the IBM i / System i (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.





As an Amazon Associate we earn from qualifying purchases.

This thread ...
Follow-Ups:
Replies:
Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.