TSTSRV.rpgle

**free                                                                                           
                                                                                                 
// Crt mod: CRTRPGMOD MODULE(HMFLMI/TSTSRV) SRCFILE(HMFLMI/QRPGLESRC)                             
// crt svc: CRTSRVPGM SRVPGM(HMFLMI/TSTSRV) EXPORT(*ALL) ACTGRP(TSTSRV)                           
                                                                                                 
//       ===================                                                                     
Ctl-Opt NOMAIN;                                                                                   
dcl-Proc four_columns_to_iso export;                                                             
//       ===================                                                                     
                                                                                                 
dcl-pi *n like(dateiso);                                                                         
    inCC char(2);                                                                                 
    inYY char(2);                                                                                 
    inMM char(2);                                                                                 
    inDD char(2);                                                                                 
end-pi;                                                                                           
                                                                                                 
dcl-ds dsDate;                                                                                   
       dsDateZoned Zoned(8:0) pos(1);                                                             
       dsDateChar  Char(8   ) pos(1);                                                             
end-Ds;                                                                                           
                                                                                                 
dcl-s dateiso date;                                                                               
                                                                                                 
dsDateChar = inCC + inYY + inMM + inDD;                                                           
dateiso = %DATE( dsDateZoned : *ISO );                                                           
return dateiso;                                                                                   
                                                                                                 
*inlr = *on;                                                                                     
//       ===================                                                                     
end-Proc four_columns_to_iso;                                                                     
dcl-Proc iso_to_four_columns export;                                                             
//       ===================                                                                     
                                                                                                 
dcl-pi *n like(dateChar);                                                                         
   inDate like(dateiso);                                                                         
end-pi;                                                                                           
                                                                                                 
dcl-s dateZoned Zoned(8:0);                                                                       
dcl-s dateChar  Char(8   );                                                                       
dcl-s dateiso date;                                                                               
                                                                                                 
dateZoned = %dec(%char(inDate : *ISO0):8:0);                                                     
dateChar = %editc(dateZoned:'X');                                                                 
return dateChar;                                                                                 
                                                                                                 
*inlr = *on;                                                                                     
//       ===================                                                                     
end-Proc iso_to_four_columns;