I'm trying to figure out how to search multiple occurrences of an array for common values using RPGLE, and so far have been unsuccessful. What I'm trying to do, is find out how many arrays share the same common values. Each array is 1 long, with an array length up to 100. For example:
Array 1 = 'a' 'b' 'c' 'd' 'e' 'f' ' ' ' '.....
Array 2 = 'a' 'b' 'c' 'd' 'e' 'g' ' ' ' '.....
Array 3 = 'd' 'c' 'a' 'b' 'h' 'e' ' ' ' '.....
Array 4 = 'k' 'b' 'e' 'd' 'a' 'g' ' ' ' '.....
I'm trying to find an easy way to determine that the letters a, b, d, & e are all common between the arrays, or each of those letters are shared between the arrays.
Does anyone have any idea how to do this search easily, so I don't have to end up in nested do's and if's hell? It gets pretty hairy when all 100 elements of an array are filled out. However, some good news is that there are only 10 arrays that can be filled out.
Thanks in advance!
here is a procedure that is a little bit general purpose. It takes an array of 256 char varying strings and an array of patterns to match against that array. Returns '1' or '1' depending on if all the pattern items exist in the input array.
** ------------------------ arr_containsAllArr -------------------
** check that inArr contains all the items in inPatternArr.
parr_containsAllArr...
p b
darr_containsAllArr...
d pi 1a
d inArr 256a const varying dim(100)
d inPatternArr 256a const varying dim(100)
d ix s 10i 0
d fx s 10i 0
d mx s 10i 0
d doesContain s 1a
d patternItem s 256a varying
/free
doesContain = '1' ;
// for each patternArr item
for ix = 1 to 100 ;
patternItem = inPatternArr(ix) ;
if %len(patternItem) > 0 ;
fx = %lookup( patternItem: inArr ) ;
if fx = 0 ;
doesContain = '0' ;
leave ;
endif ;
endif ;
endfor ;
return doesContain ;
/end-free
p e
code shows how the procedure is use:
d arr s 256a varying dim(100)
d patternArr s 256a varying dim(100)
d doesContain s 1a
/free
clear arr ;
clear patternArr ;
arr(1) = 'z' ;
arr(2) = 'a' ;
arr(3) = 'w' ;
arr(4) = 'm' ;
patternArr(1) = 'w' ;
patternArr(2) = 'd' ;
patternArr(3) = 'z' ;
doesContain = arr_containsAllArr( arr: patternArr ) ;
if doesContain = '1' ;
sendInfoMsg( 'does contain all items': 1 ) ;
else ;
sendInfoMsg( 'does not contain all items': 1 ) ;
endif ;
// contains 'm', 'z' and 'a'
clear patternArr ;
patternArr(1) = 'm' ;
patternArr(2) = 'a' ;
patternArr(3) = 'z' ;
doesContain = arr_containsAllArr( arr: patternArr ) ;
if doesContain = '1' ;
sendInfoMsg( 'does contain all items': 1 ) ;
else ;
sendInfoMsg( 'does not contain all items': 1 ) ;
endif ;
/end-free
** ----------------------- pr_Qmhsndpm -------------------------------
dpr_Qmhsndpm pr extpgm('QMHSNDPM')
d InMsgid 7a const
d InMsgf 20a const
d InMsgData 32767a const options(*VarSize)
d InMsgDatal 10i 0 const
d InMsgType 10a const
d InCsEntry 256a const options(*VarSize)
d InCsCounter 10i 0 const
d OutMsgKey 4a
d OutError likeds(zApiError )
d InCsEntryLx 10i 0 const options(*NoPass)
d InCsQual 20a const options(*NoPass)
d InWaitTime 10i 0 const options(*NoPass)
** ---------------------- zApiError ----------------------------
** zApiError - the ERRC0100 struct filled by system api calls.
dzApiError ds qualified
d size 10i 0 inz(%size(zApiError))
d BytesNeeded 10i 0
d ExcpId 7a
d Rsv1 1a
d ExcpData 2048a
** ---------------------- sendInfoMsg ---------------------------
psendInfoMsg...
p b export
dsendInfoMsg...
d pi
D InText 2000 const varying
D InCallStackCx 10i 0 Value options(*nopass)
d err ds likeds(zApiError)
D Msgf S 20a
d msgid s 7a
d msgData s 2000a
d msgDataLx s 10i 0
D msgkey S 4a
d MsgText s 2000a
d msgType s 20a
d callStackCx s 10i 0
/free
Msgf = 'QCPFMSG *LIBL' ;
msgid = 'CPF9898' ;
msgdata = inText ;
msgdataLx = %len(%trimr(msgdata)) ;
msgType = '*INFO' ;
callStackCx = 2 ;
if %parms >= 2 ;
callStackCx += inCallStackCx ;
endif ;
msgkey = ' ' ;
err.size = %size(err) ;
err.BytesNeeded = 0 ;
pr_qmhsndpm( msgId: msgf: msgData: msgDataLx: msgType:
'*': callStackCx: MsgKey: err ) ;
/end-free
p e