code

Name
Astradyne (UK) Ltd
Scriptlanguage
Plain Text
Tabwidth
4
Date
Sun, 12 May 2013 14:00:26 +0000
IP
192.168.0.1

Sub-procedure to retrieve the contents of a data area.

  1. *****************
  2. *** Prototype ***
  3. *****************
  4.  
  5. D QwcRdtAA        pr                  ExtPgm('QWCRDTAA')
  6. D  aRcvVar                            Like(DtaAraRcv)   
  7. D  aRcvVarLen                  10i 0 Const             
  8. D  aDtaAra                      20a  Const             
  9. D  aStrPos                      10i 0 Const             
  10. D  aDtaLen                      10i 0 Const             
  11. D  aApiError                          Like(ApiError)   
  12.                                                        
  13. D DtaAraRcv      ds                                   
  14. D  AraBytes                    10i 0                   
  15. D  AraBytesOut                  10i 0                   
  16. D  AraDtaType                  10a                     
  17. D  AraLibrary                  10a                     
  18. D  AraLength                    10i 0                   
  19. D  AraDecimals                  10i 0                   
  20. D  AraValue                  2000a                     
  21.                                                        
  22. D RtvDtaAra      pr          2000a  Varying               
  23. D  iDtaAra                      10a  Const                 
  24. D  iDtaAraLib                  10a  Const Options(*NoPass)
  25. D  iStrPos                      5p 0 Const Options(*NoPass)
  26. D  iDtaLen                      5p 0 Const Options(*NoPass)
  27.  
  28.  
  29. *****************
  30. *** Procedure ***
  31. *****************
  32.  
  33. P RtvDtaAra      b                  Export               
  34.                                                            
  35. D RtvDtaAra      pi          2000a  Varying               
  36. D  iDtaAra                      10a  Const                 
  37. D  iDtaAraLib                  10a  Const Options(*NoPass)
  38. D  iStrPos                      5p 0 Const Options(*NoPass)
  39. D  iDtaLen                      5p 0 Const Options(*NoPass)
  40.                                                            
  41. D wDtaAra        s            10a                         
  42. D wDtaAraLib      s            10a                         
  43. D wStrPos        s              5p 0                       
  44. D wDtaLen        s              5p 0                       
  45.                                                            
  46. D qDtaAra        s            20a                         
  47.                                                            
  48. C* Prepare all input parameters...                         
  49. C                  Eval      wDtaAra = iDtaAra             
  50.                                                      
  51. C                  If        %Parms < 2             
  52. C                  Eval      wDtaAraLib = '*LIBL'   
  53. C                  Else                             
  54. C                  Eval      wDtaAraLib = iDtaAraLib
  55. C                  EndIf                           
  56.                                                      
  57. C                  If        %Parms < 3             
  58. C                  Eval      wStrPos = 1           
  59. C                  Else                             
  60. C                  Eval      wStrPos = iStrPos     
  61. C                  EndIf                           
  62.                                                      
  63. C* Prepare API parameters...                         
  64. C                  If        wDtaAra = '*LDA' or   
  65. C                            wDtaAra = '*GDA' or   
  66. C                            wDtaAra = '*PDA'       
  67. C                  Eval      wDtaAraLib = *Blanks   
  68. C                  EndIf                           
  69.                                                                
  70. C                  Eval      qDtaAra = wDtaAra + wDtaAraLib   
  71.                                                                
  72. C* Call the API to retrieve the data area...                         
  73. C                  Reset                  ApiError           
  74. C                  CallP    QwcRdtAA(DtaAraRcv      :       
  75. C                                      %Size(DtaAraRcv):       
  76. C                                      qDtaAra        :       
  77. C                                      -1              :       
  78. C                                      2000            :       
  79. C                                      ApiError        )       
  80.                                                                
  81. C* If any errors were detected then return an error flag...   
  82. C                  If        ApiBytesOut <> 0                 
  83. C                  Return    '*ERROR'                         
  84. C                  EndIf                                     
  85.                                                                
  86. C* Return the data area value...                               
  87. C                  If        %Parms < 4                       
  88. C                  Eval      wDtaLen = araLength - wStrPos + 1
  89. C                  Else                                         
  90. C                  Eval      wDtaLen = iDtaLen                   
  91. C                  EndIf                                         
  92.                                                                  
  93. C                  Return    %Subst(AraValue : wStrPos : wDtaLen)
  94.                                                                  
  95. P RtvDtaAra      e                                             
  96.