Re: AW: More on RPG style

Here's a new version, which works with both IN (for numeric *and* character)
and also with LIKE for character (by including leading or trailing
percent-signs):

@IN copybook

/IF DEFINED(@IN)
/EOF
/ENDIF
/DEFINE @IN

D inc PR N Extproc('@in') Opdesc
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 inn PR N Extproc('@in') OpDesc
D pSearch 30P 9 Const
D pScan1 30P 9 Const
D pScan2 30P 9 Const Options(*Nopass)
D pScan3 30P 9 Const Options(*Nopass)
D pScan4 30P 9 Const Options(*Nopass)
D pScan5 30P 9 Const Options(*Nopass)
D pScan6 30P 9 Const Options(*Nopass)
D pScan7 30P 9 Const Options(*Nopass)
D pScan8 30P 9 Const Options(*Nopass)
D pScan9 30P 9 Const Options(*Nopass)
D pScan10 30P 9 Const Options(*Nopass)

@IN member

H DEBUG(*YES) NOMAIN
T* @IN
X* QCMPSRC,CRTRPGMOD
*=============================================================================================

/COPY QRPGLECPY,@IN ‚

*---------------------------------------------------------------------------------------------
*‚Program identification
*---------------------------------------------------------------------------------------------

D ThisProgram C '@IN'

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

D @in PR N Extproc('@in') OpDesc
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)

*---------------------------------------------------------------------------------------------
*‚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)

*=============================================================================================
*‚@in(): Scan for a string in a series of other strings
*=============================================================================================
P @in B Export
D PI N OpDesc
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_nbr S 30P 9 Based(parmptr)
D Search S 512A Inz Varying
D Search_nbr S 30P 9
D Scan S 512A Varying
D lead S 10I 0 Inz
D trail S 10I 0 Inz
D pos S 10I 0 Inz
*---------------------------------------------------------------------------------------------
/free

//‚Load parameters
plistptr = Npm_ParmList_Addr();
dlistptr = plist.desclistptr;
if dlist.descptr(1) = *null; //‚Numeric
parmptr = plist.parmptr(1);
Search_nbr = parm_nbr;
else; //‚Character
Search = pSearch;
if %subst( Search : %len( Search ) : 1 ) = '%';
trail = 1;
%len( Search ) = %len( Search ) - 1;
endif;
if %subst( Search : 1 : 1 ) = '%';
lead = 1;
Search = %subst( Search : 2 );
endif;
endif;

//‚Check parms
for parmnbr = 2 to dlist.argc;
parmptr = plist.parmptr(parmnbr);
if parmptr <> *null;
if dlist.descptr(1) = *null;
if Search_nbr = parm_nbr;
return *on;
endif;
else;
if lead = 0 and trail = 0 and Search = parm;
return *on;
endif;
pos = %scan( Search : parm : 1 + lead );
if pos > 0 and pos <= %len( parm ) - %len( Search ) - trail;
return *on;
endif;
endif;
else;
leave;
endif;
endfor;

return *off;

begsr *pssr;
return *off;
endsr;

/end-free
P E

TESTIN member

H DEBUG(*YES)
T* Test shell program (&Z)
X* QCMPSRC,CRTBNDRPG
Z* BNDDIR(QC2LE HEWRO01) ACTGRP(TEST)
*=============================================================================================
*‚Program identification
*---------------------------------------------------------------------------------------------

D ThisProgram C 'TESTIN'

*---------------------------------------------------------------------------------------------
*‚Copybooks
*---------------------------------------------------------------------------------------------

/copy qrpglecpy,@in ‚

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

D checkfield S 512A Varying
D checknbr S 30P 9


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

D main PR Extpgm(ThisProgram)

D main PI

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

checkfield = '%oh'; // Should return true
if inc( checkfield : 'carl' : 'mike' : 'john' : 'seth' );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;

checkfield = '%jo'; // Should return false
if inc( checkfield : 'carl' : 'mike' : 'john' : 'seth' );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;


checknbr = 12.735;
if inn( checknbr : 1.2 : 14.79273 : 72.01 : 12.735 );
dsply 'Yup, it''s there!';
else;
dsply 'Nope, it''s not there!';
endif;

return;

begsr *pssr;
return;
endsr;

/end-free

Compiled & tested for V5R2.

No necessarily pretty, but it seems to work.

Rory