midrange.com code scratchpad
Name:
itmCount (Dennis Lovelady)
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
06/16/2010 05:57:18 pm
IP:
Logged
Description:
itmCount simply counts matching keys until a new key is
passed. Its only known use is to prove whether SQL data
SELECT itmCount(key)
...
FROM someFile ...
Code:
  1.      H OPTION(*NOSHOWCPY:*NOEXPDDS:*NODEBUGIO:*SRCSTMT)       
  2.      H DATFMT(*ISO) TIMFMT(*ISO) DEBUG                        
  3.      H CVTOPT(*VARCHAR:*NODATETIME)                           
  4.      H THREAD(*SERIALIZE)                                     
  5.      H BndDir('QC2LE') NoMain                                 
  6.                                                               
  7.        // CRTSQLRPGI OBJ(mylib/SQLTEST) SRCFILE(mylib/PGMSRC) 
  8.        //            SRCMBF(SQLTEST) OBJTYPE(*MODULE)         
  9.        //            REPLACE(*YES)                            
  10.                                                               
  11.        // CRTSRVPGM mylib/SQLTEST EXPORT(*ALL)                
  12.                                                               
  13.        //  -- in SQL --                                       
  14.        // CREATE FUNCTION mylib/ITMCOUNT(VARCHAR(10))         
  15.        // RETURNS DECIMAL(5,0)                                
  16.        // RETURNS NULL ON NULL INPUT                          
  17.        // LANGUAGE RPGLE                                      
  18.        // EXTERNAL NAME 'mylib/SQLTEST(itmCount)'             
  19.        // NOT DETERMINISTIC                                   
  20.        // NO EXTERNAL ACTION                                  
  21.        // PARAMETER STYLE GENERAL                             
  22.        // ALLOW PARALLEL                                             
  23.        // NOT FENCED                                                 
  24.                                                                      
  25.                                                                      
  26.      D itmCount        PR             5P 0 ExtProc('itmCount')       
  27.        // itmCount simply counts matching keys until a new key is    
  28.        // passed.  Its only known use is to prove whether SQL data   
  29.        //       SELECT itmCount(key)                                 
  30.        //              ...                                           
  31.        //       FROM someFile ...                                    
  32.      D  key                          10    Const Varying             
  33.                                                                      
  34.                                                                      
  35.                                                                      
  36.      P itmCount        B                   Export                    
  37.      D itmCount        PI             5P 0                           
  38.      D  key                          10    Const Varying             
  39.                                                                      
  40.      D statCount       S                   Static Inz Like(itmCount) 
  41.      D prevkey         S                   Static Inz Like(key)      
  42.                                                                      
  43.       /Free                                                          
  44.       If key = prevKey ;     
  45.          statCount += 1 ;    
  46.       Else ;                 
  47.          statCount = 1 ;     
  48.       EndIF ;                
  49.       prevKey = key ;        
  50.       Return statCount ;     
  51.                              
  52.      /End-free               
  53.                              
  54.     P itmCount        E      
  55.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css