midrange.com code scratchpad
Name:
Kevin Bucknum
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
02/23/2010 10:15:03 pm
IP:
Logged
Description:
Sample SQLRPGLE report program - I just clone and go.
Code:
  1. Fqsysct    if   e           k disk                             
  2. Fqsysprt   o    f  132        printer oflind(*inof)            
  3. d pgmsts        esds                  extname(ppgmsts)         
  4. D  @Sql           s           1000                             
  5. D @MtrmDs       e ds                  Extname(Mtrm)            
  6.  /free                                                         
  7.    Except #Head;                                               
  8.    Read Rqsysct;                                               
  9.    Dow Not %Eof(Qsysct);                                       
  10.      If Scdlcd = *Blanks and scprac <> '9S'                    
  11.         and scprac <> 'SL';                                    
  12.        @Sql =                                                  
  13.         'select * from mpms' + scprac + '/mtrm where tmtrty = '
  14.         + '''' + 'C'                                           
  15.         + '''' + ' and '                                       
  16.         + ' tmtrcd not in'                                     
  17.         + ' (select hrtrcd from mpms' + scprac + '/mhtr)'      
  18.         + ' and tmdlcd = ' + '''' + ' ' + '''';                
  19.         exec sql prepare badqry from :@Sql;                    
  20.         exec sql Declare BadCsr scroll cursor for BadQry;    
  21.         exec sql Open BadCsr;                                
  22.         exec sql Fetch Next from BadCsr into :@Mtrmds;       
  23.         If Sqlcod = 0;                                       
  24.           Dow Sqlcod = 0;                                    
  25.             Except #Bad;                                     
  26.             exec sql Fetch Next from BadCsr into :@Mtrmds;   
  27.           EndDo;                                             
  28.         EndIf;                                               
  29.         exec sql Close BadCsr;                               
  30.      EndIf;                                                  
  31.      Read Rqsysct;                                           
  32.    EndDo;                                                    
  33.    *Inlr = *On;                                              
  34.    Return;                                                   
  35.  /End-Free                                                   
  36. Oqsysprt   e            #Head          3 03                  
  37. o         or    of                     3 03                  
  38. O                       $RDATE               8 '  -  -  '    
  39. O                       $TIMEX              20 '  :  :  '    
  40. O                                           67 'Never Billed'  
  41. O                                          115 'Page'          
  42. O                       PAGE               120                 
  43. O                       $PGM               132                 
  44. O          e            #Head          1                       
  45. o         or    of                     1                       
  46. O                                            2 'PR'            
  47. O                                           +2 'TRCD '         
  48. O                                           +2 'CPT  '         
  49. O                                           +2 'Description'   
  50. O          ef           #Bad           1                       
  51. O                       scprac               2                 
  52. O                       tmtrcd              +2                 
  53. O                       tmcpt1              +2                 
  54. O                       tmtrds              +2                 
  55.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css