midrange.com -- source code scratchpad

midrange.com code scratchpad
Name:
Anonymous
Scriptlanguage:
Plain Text
Tabwidth:
Date:
12/29/2011 06:54:44 pm
IP:
Logged
Description:
Service Program COUNTWORDS.

(See inline documentation)
Code:

         H/Title Service program for text processing                                                            

         H OPTION(*SRCSTMT: *NODEBUGIO: *SHOWCPY :*XREF)                                                        

         H DEBUG(*YES)                                                                                          

                                                                                                                

            //======================================================================                            

            // Author:  Steve Landess                                                                           

            //   Date:  12/19/2011                                                                              

            //======================================================================                            

            //                                                                                                  

            // In subprocedure prCntWords, for the purposes of counting words,                                  

            // a "word" is a value which is delimited by spaces.                                                

            //                                                                                                  

            // Since spaces are considered delimiters, all "words" will be                                      

            // left-justified into the Words array.  Extra spaces between words                                 

            // are ignored.                                                                                     

            //                                                                                                  

            //  Examples:                                                                                       

            //                                                                                                  

            //   ' and/or ' contains one word.                                                                  

            //   ' A and/or B ' contains three words.                                                           

            //   ' A and/ or B ' contains four words.                                                           

            //   ' A and / or B ' contains five words.                                                          

            //                                                                                                  

            //======================================================================                            

            // To recreate the Service program COUNTWORDS:                                                      

            //                                                                                                  

            //  1) DLTSRVPGM MYOBJLIB/COUNTWORDS                                                                 

            //  2) DLTMOD    MYOBJLIB/COUNTWORDS                                                                 

            //  3) CRTRPGMOD MODULE(MYOBJLIB/COUNTWORDS) SRCFILE(MYOBJLIB/QRPGLESRC) DBGVIEW(*ALL)                

            //  4) CRTSRVPGM SRVPGM(MYOBJLIB/COUNTWORDS) EXPORT(*ALL)                                            

            //                                                                                                  

            //======================================================================                            

            // To recreate the SQL UDF (User-Defined Function) COUNTWORDS,                                      

            // use RUNSQLSTM or execute the following SQL commands via STRSQL:                                  

            //                                                                                                  

            //  1) DROP FUNCTION QGPL/COUNTWORDS ( VARCHAR(180))                                                

            //                                                                                                  

            //  2) CREATE FUNCTION QGPL/COUNTWORDS ( VARCHAR(180) )                                             

            //     RETURNS NUMERIC(8,0)                                                                         

            //     EXTERNAL NAME 'MYOBJLIB/COUNTWORDS(PRCNTWORDS)'                                               

            //     LANGUAGE RPGLE                                                                               

            //     NO SQL                                                                                       

            //     NOT DETERMINISTIC                                                                            

            //     NOT FENCED                                                                                   

            //     RETURNS NULL ON NULL INPUT                                                                   

            //                                                                                                  

            //--------------------------                                                                        

            // Example of usage:                                                                                

            //                                                                                                  

            //     Select                                                                                       

            //       countwords( FULL_NAME ) as NbrWords                                                        

            //     , FULL_NAME                                                                                  

            //     From addresses                                                                                

            //                                                                                                  

            //  Output:                                                                                         

            //                                                                                                  

            // NBRWORDS   FULL NAME                                                                             

            // ---------  --------------------------------------------------------------                        

            //        3   Compass Bank ISAOA/ATIMA                                                              

            //        6   Great Western Financial Services Inc ISAOA/ATIMA                                      

            //        5   Chase Home Finance LLC ISAOA                                                          

            //        9   Wells Fargo Bank NA #xxx its Successors and/or Assigns                                

            //        3   Central Mortgage Company                                                              

            //        7   Flagstar Bank FSB Its Successors and/or Assigns                                       

            //       10   BAC Home Loans Servicing, LP ISAOA ATIMA Insurance Department TXxxxxxxxxxxx           

            //                                                                                                  

            //======================================================================                            

            // To recreate the SQL UDF (User-Defined Function) DUPEWORDS,                                       

            // use RUNSQLSTM or execute the following SQL commands via STRSQL:                                  

            //                                                                                                  

            //  1) DROP FUNCTION QGPL/DUPEWORDS ( VARCHAR(180))                                                 

            //                                                                                                  

            //  2) CREATE FUNCTION QGPL/DUPEWORDS ( VARCHAR(180) )                                              

            //     RETURNS NUMERIC(8,0)                                                                         

            //     EXTERNAL NAME 'MYOBJLIB/COUNTWORDS(PRDUPWORDS)'                                               

            //     LANGUAGE RPGLE                                                                               

            //     NO SQL                                                                                       

            //     NOT DETERMINISTIC                                                                            

            //     NOT FENCED                                                                                   

            //     RETURNS NULL ON NULL INPUT                                                                   

            //                                                                                                  

            //--------------------------                                                                        

            // Example of usage:                                                                                

            //                                                                                                  

            //     Select                                                                                       

            //        dupewords( full_name )                                                                    

            //      , substr( full_name,1,90 )  as full_name                                                    

            //      , substr( lastname,1,90 )  as lastname                                                      

            //      , groupcode                                                                                 

            //      , entitycode                                                                                

            //     From addresses                                                                                

            //     Where groupcode = 'INSURED'                                                                  

            //       and lastname is not null                                                                   

            //       and dupewords( full_name ) > 1                                                             

            //                                                                                                  

            //  Output:                                                                                         

            //                                                                                                  

            //    DUPEWORDS  FULL_NAME                                                                          

            //    ---------  --------------------------------------------------------------                     

            //           2   Xxxxxx E Xxxxxx Bbbbbb & Carolyn Bbbbbb                                            

            //           3   Rrrrrrr E Rrrrrrr E Brrrrrr & Rebecca L Brrrrrr                                    

            //           2   Larry W Larry Wwwww Oooooooooo & Melissa J Oooooooooo                              

            //                                                                                                  

            //======================================================================                            

            // To recreate the SQL UDF (User-Defined Function) NEXTWORD,                                        

            // use RUNSQLSTM or execute the following SQL commands via STRSQL:                                  

            //                                                                                                  

            //  1) DROP FUNCTION QGPL/NEXTWORD ( VARCHAR(60) , VARCHAR(180) )                                   

            //                                                                                                  

            //  2) CREATE FUNCTION QGPL/NEXTWORD (VARCHAR(60) , VARCHAR(180) )                                  

            //     RETURNS CHAR(60)                                                                             

            //     EXTERNAL NAME 'MYOBJLIB/COUNTWORDS(PRNXTWORD)'                                                

            //     LANGUAGE RPGLE                                                                               

            //     NO SQL                                                                                       

            //     NOT DETERMINISTIC                                                                            

            //     NOT FENCED                                                                                   

            //     RETURNS NULL ON NULL INPUT                                                                   

            //                                                                                                  

            //--------------------------                                                                        

            // Example of usage:                                                                                

            //                                                                                                  

            //     Select                                                                                       

            //       substr( nextword( 'Box',address1 ),1,10 ) as nextword                                      

            //     , address1                                                                                   

            //      from addresses                                                                               

            //     where upper( address1 ) like '%BOX%'                                                         

            //                                                                                                  

            //  Output:                                                                                         

            //                                                                                                  

            //   NEXTWORD    ADDRESS1                                                                           

            //    ---------  --------------------------------------------------------------                     

            //   200017      PO Box 200017                                                                      

            //   47020       PO Box 47020                                                                       

            //   23000       PO Box 23000                                                                       

            //   7026        PO Box 7026                                                                        

            //   961206      PO Box 961206                                                                      

            //   1367        PO Box 1367                                                                        

            //   5708        PO Box 5708                                                                        

            //   961291      P.O. Box 961291                                                                    

            //                                                                                                  

            //======================================================================                            

                                                                                                                

           //--------------------------------------                                                             

           // Global variables                                                                                  

           //--------------------------------------                                                             

                                                                                                                

         d Blank           s              1A   Inz(*blanks)                                                     

         d Word            s             60A   Inz(*blanks)                                                     

         d WordVar         s             60A   Inz(*blanks) varying                                             

         d NameVar         s            180A   varying                                                          

         d NbrWords        s              8s 0                                                                  

         d NbrDupes        s              8s 0                                                                  

                                                                                                                

         d WordsDS         ds                                                                                   

                                                                                                                

         d Words                               Like(WordVar)                                                    

         d                                     Dim(50)                                                          

         d                                     Inz(*HIVAL)                                                      

                                                                                                                

         D  WordsAscend                        Like(WordVar)                                                    

         d                                     Dim(%elem(Words))                                                

         d                                     Overlay(WordsDS)                                                 

         D                                     Ascend                                                           

                                                                                                                

           // Constants                                                                                         

                                                                                                                

         D lo              C                   'abcdefghijklmnopqrstuvwxyz'         Lower Case alphabet         

         D up              C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'         Lower Case alphabet         

                                                                                                                

           //======================================                                                             

           // Prototypes                                                                                        

           //======================================                                                             

                                                                                                                

         d prCntWords...                                                                                        

         d                 pr                  Like(NbrWords)                                                   

         D  pName                              Like(NameVar)                                                    

                                                                                                                

         d prDupWords...                                                                                        

         d                 pr                  Like(NbrWords)                                                   

         D  pName                              Like(NameVar)                                                    

                                                                                                                

         d prNxtWord...                                                                                         

         d                 pr                  Like(Word)                                                       

         D  pFindWord                          Like(WordVar)                                                    

         D  pName                              Like(NameVar)                                                    

                                                                                                                

           //======================================                                                             

           // Subprocedures                                                                                     

           //======================================                                                             

                                                                                                                

           //--------------------------------------                                                             

           // Count number of words in string.                                                                  

           //--------------------------------------                                                             

                                                                                                                

         p prCntWords...                                                                                        

         p                 b                   export                                                           

         d prCntWords...                                                                                        

         d                 pi                  Like(NbrWords)                                                   

         D  pName                              Like(NameVar)                                                    

                                                                                                                

         D NameDs          DS           180    Inz                                                              

         D   Char                         1    Dim(180) Overlay(NameDS)                                         

                                                                                                                

         D Pos             s             10i 0 Inz(*zeros)                                                      

         D EndPos          s             10i 0 Inz(*zeros)                                                      

         D Index1          s             10i 0 Inz(*zeros)                          Index for Word field        

         D Index2          s             10i 0 Inz(*zeros)                          Index for Words arry        

         D Index3          s             10i 0 Inz(*zeros)                          Index for Words arry        

         D Index4          s             10i 0 Inz(*zeros)                          Index for                   

         D Index5          s             10i 0 Inz(*zeros)                          Index for                   

                                                                                                                

          /Free                                                                                                 

                                                                                                                

            Clear NbrWords;                                                                                     

                                                                                                                

            If pName = *blanks;                                                                                 

               *InLR = *On;                                                                                     

               Return NbrWords;                                                                                 

            EndIf;                                                                                              

                                                                                                                

            Exsr SrWords1;                                                                                      

            Return NbrWords;                                                                                    

            *InLr = *Off;                                                                                       

                                                                                                                

           //--------------------------------------------------------------------                               

           // srWords1 - Count number of words in string                                                        

           //--------------------------------------------------------------------                               

                                                                                                                

           Begsr srWords1;                                                                                      

                                                                                                                

               Clear Word;                                                                                      

               Reset Words;                                                                                     

               Clear Index1;                                                                                    

               Clear Index2;                                                                                    

                                                                                                                

               NameDS  =  %trim( pName );                                                                       

               EndPos  = %checkr(Blank : NameDS);                                                               

                                                                                                                

               For Pos = 1 to EndPos;                                                                           

                                                                                                                

                   If Char(Pos) <> *blanks;                            // Build up the word value               

                      Index1 += 1;                                     //  into the field 'word'                

                      %subst(Word: Index1 : 1) = Char(Pos);                                                     

                   EndIf;                                                                                       

                                                                                                                

                   If (Word <> *blanks) and (Char(Pos) = *blanks)      // When a blank is encountered           

                   Or (Pos = EndPos);                                  // Or end of NameDS string is rea        

                      Index2 += 1;                                     // Words array index                     

                      Words(Index2) = Word;                            // Load Words Array                      

                      Clear Word;                                                                               

                      Index1 = *zeros;                                                                          

                   EndIf;                                                                                       

                                                                                                                

               EndFor;                                                                                          

                                                                                                                

               NbrWords = Index2;                                                                               

                                                                                                                

            Endsr;                                                                                              

                                                                                                                

          /End-Free                                                                                             

                                                                                                                

         P prCntWords...                                                                                        

         P                 E                                                                                    

                                                                                                                

          //---------------------------------------------------                                                 

          // Count number of duplicate words in a string                                                        

          //---------------------------------------------------                                                 

                                                                                                                

         p prDupWords...                                                                                        

         p                 b                   export                                                           

         d prDupWords...                                                                                        

         d                 pi                  Like(NbrWords)                                                   

         D  pName                              Like(NameVar)                                                    

                                                                                                                

         D Index1          s             10i 0 Inz(*zeros)                                                      

         D Index2          s             10i 0 Inz(*zeros)                                                      

         D Index3          s             10i 0 Inz(*zeros)                                                      

         D NbrWords        s              8S 0 Inz(*zeros)                                                      

                                                                                                                

         d DupWords        s                   Like(WordVar)                                                    

         d                                     Dim(%Elem(Words))                                                

         d                                     Inz(*HIVAL)                                                      

         d                                     Ascend                                                           

                                                                                                                

          /Free                                                                                                 

                                                                                                                

            Reset Words;                                        // Global array Words                           

            Reset Dupwords;                                     // Local array Dupewords                        

            Clear NbrDupes;                                                                                     

                                                                                                                

            NbrWords = prCntWords(pName);                       // loads Words array                            

            Index3 = %Elem(Words);                                                                              

                                                                                                                

            If NbrWords > 1;                                                                                    

               SortA WordsAscend;                                                                               

               For Index1 = 1 to NbrWords;                                                                      

                   Index2 = %lookup( WordsAscend( Index1 ) : DupWords );                                        

                   If Index2 <> *zeros;                                                                         

                      NbrDupes += 1;                                                                            

                   Else;                                                                                        

                      Index2 = %lookup ( *HIVAL : DupWords );                                                   

                      If Index2 > *zeros;                                                                       

                         DupWords ( Index2 ) = WordsAscend( Index1 ) ;                                          

                      EndIf;                                                                                    

                   EndIf;                                                                                       

               EndFor;                                                                                          

            EndIf;                                                                                              

                                                                                                                

            Return NbrDupes;                                                                                    

                                                                                                                

          /End-Free                                                                                             

                                                                                                                

         P prDupWords...                                                                                        

         P                 E                                                                                    

                                                                                                                

          //---------------------------------------------------                                                 

          // Find and return next word                                                                          

          //---------------------------------------------------                                                 

                                                                                                                

         p prNxtWord...                                                                                         

         p                 b                   export                                                           

         d prNxtWord...                                                                                         

         d                 pi                  Like(Word)                                                       

         D  pFindWord                          Like(WordVar)                                                    

         D  pName                              Like(NameVar)                                                    

                                                                                                                

         D Index1          s             10i 0 Inz(*zeros)                                                      

         D Index2          s             10i 0 Inz(*zeros)                                                      

                                                                                                                

         D NextWord        s             60A   Inz(*blanks)                                                     

                                                                                                                

          /Free                                                                                                 

                                                                                                                

            Reset Words;                                        // Global array Words                           

            Clear NextWord;                                                                                     

                                                                                                                

            NbrWords = prCntWords(pName);                      // loads Words array                             

                                                                                                                

            // Cannot use %LOOKUP on unsequenced array...                                                       

                                                                                                                

            If NbrWords > *zeros;                                                                               

               For Index1 = 1 to NbrWords;                                                                      

                   If pFindWord = Words( Index1 );                                                              

                      If Index1 < NbrWords;                                                                     

                         NextWord = Words( Index1 + 1 );                                                        

                         Leave;                                                                                 

                      EndIf;                                                                                    

                   EndIf;                                                                                       

               EndFor;                                                                                          

            EndIf;                                                                                              

                                                                                                                

            Return NextWord;                                                                                    

                                                                                                                

          /End-Free                                                                                             

                                                                                                                

         P prNxtword...                                                                                         

         P                 E
generated in 0.015s
valid xhtml & css