midrange.com code scratchpad
Name:
TESTSTUFF
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
09/24/2012 02:18:44 pm
IP:
Logged
Description:
Calling program.
*Module created with CRTSQLRPGI;
*PGM created with CRTPGM PGM(MKOESTER/TESTSTUFF)
BNDSRVPGM((MKOESTER/TFSORDERSIMMED))
ACTGRP(*NEW)
Code:
  1. 0001.00      h option(*srcstmt : *nounref : *nodebugio )                              
  2. 0003.00                                                                               
  3. 0005.00       *--------------------------------------------------                     
  4. 0006.00       * Program:        TestStuff                                             
  5. 0007.00       *                                                                       
  6. 0008.00       * Notes:          stub testing: LOCKS module                            
  7. 0009.00       *                 No SQL needed in this test, but the production caller 
  8. 0009.01       *                 will have, so this module is compiled with CRTSQLRPGI.
  9. 0010.00       *--------------------------------------------------                     
  10. 0013.00                                                                               
  11. 0014.00       * Program Prototype  (*Entry parms)                                     
  12. 0015.00      d TESTSTUFF       PR                  EXTPGM('TESTSTUFF')                
  13. 0017.00      d TESTSTUFF       PI                                                     
  14. 0018.00                                                                               
  15. 0019.00 _____ * Private subprocedures                                                 
  16. 0020.00 vvvvv *                                                                       
  17. 0021.00       * (none)                                                                
  18. 0022.00 ^^^^^ * 
  19.                                                                       
  20. 0023.00 _____ * Global definitions                                                    
  21. 0024.00                                                                               
  22. 0025.00 ____                                                                          
  23. 0026.00 vvvvv * Called functions and procedure                                        
  24. 0024.00       *  Generic Service Order Lock management using SVLOCK file.
  25. 0025.00      D ManageLocks...                                            
  26. 0026.00      D                 PR                  Extproc('LOCKS')      
  27. 0027.00      D                                     likeds(SOlocks_ds)    
  28. 0028.00      D Action                         6a   const                 
  29. 0029.00      D Order                          6a   const options(*nopass)
  30. 0031.00                                                                  
  31. 0032.00       *  Data returned from ManageLocks                          
  32. 0033.00      d SOlocks_ds...                                             
  33. 0034.00      d                 DS                  qualified             
  34. 0035.00      d  Locked                         n                         
  35. 0036.00      d  MessageText                 128a   varying               
  36. 0031.00 ^^^^^ *                                                      
  37. 0032.00 ____                                                         
  38. 0033.00       * Global variables, constants, arrays                  
  39. 0034.00      d  DisplayThis    s             52a                     
  40. 0035.00                                                              
  41. 0036.00       * mnemonic constants                                   
  42. 0037.00      d FALSE           c                   const('0')        
  43. 0038.00      d NO              c                   const('0')        
  44. 0039.00      d TRUE            c                   const('1')        
  45. 0040.00      d YES             c                   const('1')        
  46. 0041.00      d error           c                   const('[error]')  
  47. 0042.00      d out             c                   const('O')        
  48. 0043.00 ^^^^^ *                                                      
  49. 0044.00                                                              
  50. 0045.00 _____ * Begin Mainline Logic                                 
  51. 0046.00       /free                                                  
  52. 0047.00        // set standard sql options.                          
  53. 0048.00        exec sql                                              
  54. 0049.00        set option  closqlcsr = *endmod,                      
  55. 0050.00                       commit = *none,                        
  56. 0051.00                       datfmt = *iso;                         
  57. 0050.00                       commit = *none,                                            
  58. 0051.00                       datfmt = *iso;                                             
  59. 0052.00                                                                                  
  60. 0053.00 vvvvv  // ~~~~~~~~~~~~~~~~THE STUFF TO TEST GOES BETWEEN HERE... ~~~~~~~~~~~~~~~ 
  61. 0054.00        // testing LOCKS                                                          
  62. 0055.00        SOlocks_ds  = ManageLocks('LOCKIT' : '096659');                           
  63. 0056.00        if %len(SOlocks_ds.MessageText) > 52;                                     
  64. 0057.00           DisplayThis = %subst(SOlocks_ds.MessageText : 1 : 52);                 
  65. 0058.00        else;                                                                     
  66. 0059.00           DisplayThis = SOlocks_ds.MessageText;                                  
  67. 0060.00        endif;                                                                    
  68. 0061.00        DSPLY (DisplayThis);                                                      
  69. 0062.00                                                                                  
  70. 0063.00        if SOlocks_ds.Locked;                                                     
  71. 0064.00           SOlocks_ds  = ManageLocks('UNLOCK' : '096659');                        
  72. 0065.00           if %len(SOlocks_ds.MessageText) > 52;                                  
  73. 0066.00              DisplayThis = %subst(SOlocks_ds.MessageText : 1 : 52);              
  74. 0067.00           else;                                                                  
  75. 0068.00             DisplayThis = SOlocks_ds.MessageText;                                
  76. 0069.00           endif;                                                                 
  77. 0070.00           DSPLY (DisplayThis);                                                   
  78. 0071.00        endif;                                                                    
  79. 0072.00                                                                                  
  80. 0073.00        if not SOlocks_ds.Locked;                                                 
  81. 0074.00           SOlocks_ds  = ManageLocks('CLOSE');                                   
  82. 0075.00           if %len(SOlocks_ds.MessageText) > 52;                                 
  83. 0076.00              DisplayThis = %subst(SOlocks_ds.MessageText : 1 : 52);             
  84. 0077.00           else;                                                                 
  85. 0078.00              DisplayThis = SOlocks_ds.MessageText;                              
  86. 0079.00           endif;                                                                
  87. 0080.00           DSPLY (DisplayThis);                                                  
  88. 0081.00        endif;                                                                   
  89. 0082.00 ^^^^^  // ~~~~~~~~~~~~~~~~   ... and HERE ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  90. 0083.00        *inLR = *ON;                                                             
  91. 0084.00        return;                                                                  
  92. 0085.00       /end-free                                                                 
  93.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css