midrange.com code scratchpad
Name:
Retrieve Journal Receiver information via SQL
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/17/2021 08:29:38 pm
IP:
Logged
Description:
Using the QjoRtvJrnReceiverInformation API this will return detach date information from JRNRCV Objs.
Code:
  1. RPG:
  2.  
  3. **Free
  4.   Ctl-Opt Nomain
  5.         Option(*Srcstmt:*Nodebugio:*Noshowcpy) Debug(*yes);
  6.  
  7. // CRTRPGMOD MODULE(KEVIN/RTVJRNRCVI)
  8. // CRTSRVPGM SRVPGM(KEVIN/RTVJRNRCVI) EXPORT(*ALL)
  9. //
  10. // Create or Replace Function KEVIN.RTVJRNRCVI
  11. // (RcvLib Char(10),
  12. // RcvFile Char(10))
  13. // Returns Char(13)
  14. // Language RPGLE
  15. // No SQL
  16. // Not Fenced
  17. // External Name 'KEVIN/RTVJRNRCVI(GETDETACHDATE)'
  18. // Parameter Style General   ;
  19.  
  20.   Dcl-Pr RtvJrnRcvA ExtProc('QjoRtvJrnReceiverInformation');
  21.     *N Char(500); // Data coming back
  22.     *N Int(10) Const; // Length of data coming back
  23.     *N Char(20) Const; // Qualified name of the receiver
  24.     *N Char(8) Const; // Format name
  25.     // Q&D - no error handling.
  26.   End-Pr;
  27.  
  28.   Dcl-Pr GETDETACHDATE Char(13);
  29.     Library Char(10);
  30.     FileName Char(10);
  31.   End-Pr;
  32.  
  33. Dcl-Proc GETDETACHDATE Export;
  34.  
  35.   Dcl-Pi *N Char(13);
  36.     Library Char(10);
  37.     FileName Char(10);
  38.   End-Pi;
  39.  
  40.   Dcl-S ReturnValue Char(500);
  41.  
  42.   RtvJrnRcvA (ReturnValue
  43.              :500
  44.              :FileName + Library
  45.              :'RRCV0100');
  46.   Return %Subst(ReturnValue:109:13);
  47.  
  48.   End-Proc; 
  49.  
  50. SQL Example:
  51. with jrnrcv as (SELECT objname FROM TABLE (QSYS2.OBJECT_STATISTICS('MPMSAUDIT ','JRNRCV') ) )
  52.  
  53. select objname, kevin.rtvjrnrcvi('MPMSAUDIT',objname) from jrnrcv;
  54.  
  55. Returns:
  56. MPMSJR0214    1210816074112
  57. MPMSJR0215    1210816110921
  58. MPMSJR0216    1210817011129
  59. MPMSJR0217    1210817103202
  60. MPMSJR0218    0000000000000
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css