contact image

Integrated File System (IFS)

The integrated file system is a part of OS/400© that lets you support stream input/output and storage management similar to personal computer and UNIX© operating systems, while providing you with an integrating structure over all information stored in the server.


Post Your Example

Changing the CCSID of an IFS table.


Sample from Jamie Flanary posted at 2011-12-29 17:34:01

From time to time, you'll find a stream file in your IFS 
that's marked with the wrong CCSID. I recently had a problem 
where a file in my IFS was full of ASCII data but was marked 
as CCSID 37 (US EBCDIC). This was a problem because the 
IBM-supplied commands didn't convert the data, since they 
thought it was already in EBCDIC.

The CHGATR command can be used to change the CCSID of a 
stream file. Here's an example:

[code]
CHGATR OBJ('/path/to/myfile.txt') ATR(*CCSID) VALUE(819)
[/code]

Another way to do the same thing is with the SETCCSID command 
in QShell. Here's an example of that command:
[code]
STRQSH CMD('setccsid 819 /path/to/myfile.txt')
[/code]

If the data in the stream file also needs to be converted, you 
can use QShell's ICONV command to convert it. This does not 
set the CCSID of the resulting file properly, but we 
already know how to fix that!

The following command converts the data in MYFILE.TXT from 
CCSID 37 to CCSID 819 and writes the output to YOURFILE.TXT:

[code]
STRQSH CMD('iconv -f 37 -t 819 /path/to/myfile.txt > /path/to/yourfile.txt 
&& setccsid 819 /path/to/yourfile.txt')
[/code]

Another way to convert the data in the file is with the CPY CL command. 
Here's an example of that:

[code]
CPY OBJ('/path/to/myfile.txt') TOOBJ('/path/to/yourfile.txt') +
      FROMCCSID(37) TOCCSID(819) DTAFMT(*TEXT)
[/code]

Place this in a subsystem and point it at a directory and it will process .csv files one at a time.


Sample from Jamie Flanary posted at 2011-12-18 18:59:10

     H Option( *SrcStmt: *NoDebugIo )  BndDir( 'QC2LE' ) DFTACTGRP(*No)                             
     ‚**********************************************************************                        
     ‚* Project ID     Date  Pgmr ID  Rev  Description                                              
     ‚*                                                                                             
     ‚*            11/16/11  JJF       00  program written                                          
     ‚*              ** pulls .csv tables from directory:                                           
     ‚*                 /home/Reserve_Adjustments/                                                  
     ‚*                                                                                             
     ‚**********************************************************************                        
      *                                                                                             
      * Directory Entry Structure (dirent)                                                          
      *                                                                                             
     d p_dirent        s               *                                                            
     d dirent          ds                  based(p_dirent)                                          
     d   d_reserv1                   16A                                                            
     d   d_reserv2                   10U 0                                                          
     d   d_fileno                    10U 0                                                          
     d   d_reclen                    10U 0                                                          
     d   d_reserv3                   10I 0                                                          
     d   d_reserv4                    8A                                                            
     d   d_nlsinfo                   12A                                                            
     d     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)                                     
     d     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)                                     
     d     nls_lang                   3A   OVERLAY(d_nlsinfo:7)                                     
     d     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)                                    
     d   d_namelen                   10U 0                                                          
     d   d_name                     640A                                                            
                                                                                                    
      *------------------------------------------------------------                                 
      * Open a Directory                                                                            
      *------------------------------------------------------------                                 
     d opendir         pr              *   EXTPROC('opendir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Read Directory Entry                                                                        
      *------------------------------------------------------------                                 
     d readdir         pr              *   EXTPROC('readdir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Close Directory                                                                             
      *------------------------------------------------------------                                 
     d closedir        pr              *   EXTPROC('closedir')                                      
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Open IFs table                                                                              
      *------------------------------------------------------------                                 
     d open            pr            10i 0   ExtProc('open')                                        
     d   filename                      *     value                                                  
     d   openflags                   10i 0   value                                                  
     d   mode                        10u 0   value options(*nopass)                                 
     d   codepage                    10u 0   value options(*nopass)                                 
      *------------------------------------------------------------                                 
      * Read IFS table                                                                              
      *------------------------------------------------------------                                 
     d read            pr            10i 0   ExtProc('read')                                        
     d   filehandle                  10i 0   value                                                  
     d   datareceived                  *     value                                                  
     d   nbytes                      10u 0   value                                                  
      *------------------------------------------------------------                                 
      * Close IFs table                                                                             
      *------------------------------------------------------------                                 
     d close           pr            10i 0   ExtProc('close')                                       
     d   filehandle                  10i 0   value                                                  
      *------------------------------------------------------------                                 
      * read ifs table  - internal procedure                                                        
      *------------------------------------------------------------                                 
     d RdIfsFil        pr           256a                                                            
     d  FileName                    256a   const                                                    
      *------------------------------------------------------------                                 
      * Delay - sleep function                                                                      
      *------------------------------------------------------------                                 
     d sleep           pr            10i 0 ExtProc( 'sleep' )                                       
     d  seconds                      10u 0 Value                                                    
      *------------------------------------------------------------                                 
      * Command - run a command                                                                     
      *------------------------------------------------------------                                 
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    256                                                             
     d   length                      15  5                                                          
      *------------------------------------------------------------                                 
      * Grab the date in LongFormat                                                                 
      *------------------------------------------------------------                                 
     d CEEDATE         pr                  opdesc                                                   
     d   Lilian                      10i 0                                                          
     d   picture                  65535A   const options(*varsize)                                  
     d   OutputDate               65535A   const options(*varsize)                                  
     d   Feedback                    12a   options(*omit)                                           
      *------------------------------------------------------------                                 
      * a few local variables...                                                                    
                                                                                                    
     d BaseDate        s               d   inz(D'1582-10-14')                                       
     d cmdlength       s             15  5                                                          
     d cmdstring       s            256                                                             
     d count           s              3  0                                                          
     d cr              c                   Const(x'0D')                                             
     d data            s          65535A                                                            
     d Data_Rec        s          65535A                                                            
     d datasize        s              5  0                                                          
     d dh              s               *                                                            
     d Eol             c                   Const(x'0D25')                                           
     d Error_Flag      s              1A   INZ('0')                                                 
     d File            s            256                                                             
     d FileName        s            256    varying                                                  
     d FolderNames     s            256    dim(50)                                                  
     d Fp              s             10i 0                                                          
     d KeepLooping     s               n   inz('1')                                                 
     d lf              C                   Const(x'25')                                             
     d MyNewName       s            265    varying                                                  
     d N               s              5  0                                                          
     d nDays           s             10i 0                                                          
      * values for oflag parameter, used by open()                                                  
     d O_RDONLY        s             10i 0   inz(1)                                                 
     d O_TEXTDATA      s             10i 0   inz(16777216)                                          
                                                                                                    
     d Oflag           s             10i 0                                                          
     d Omode           s             10u 0                                                          
     d PathName        s             26                                                             
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d Rc              S             10i 0                                                          
     d ReturnData      s             12                                                             
     d SleepSeconds    s             10i 0 inz(1)                                                   
     d ta              s              3  0                                                          
     d Today           s               d   inz(*SYS)                                                
                                                                                                    
         // entire document stored in here                                                          
     d MyData          ds                  qualified  inz                                           
     d  bighunkdata               65535                                                             
     d   OneSlice                    60    dim(1000) overlay(bighunkdata:*next)                     
      *------------------------------------------------------                                       
      * MAIN LINE                                                                                   
      *------------------------------------------------------                                       
                                                                                                    
      /free                                                                                         
                                                                                                    
                // program will loop until outside force                                            
                // stops it.                                                                        
              dow KeepLooping;                                                                      
                                                                                                    
               exsr $GetFileName;                                                                   
               if ta > *zeros;                                                                      
                // read the tables one at a time                                                    
                for count = 1 to ta;                                                                
                 filename = foldernames(count);                                                     
                 Error_flag = rdifsfil(Filename);                                                   
                 //exsr $MoveToHistory;                                                             
                endfor;                                                                             
               endif;                                                                               
                                                                                                    
               // Delay job for a number of seconds then start                                      
               // the process all over again.                                                       
               sleep(SleepSeconds);                                                                 
                                                                                                    
              enddo;                                                                                
                                                                                                    
           *inlr = *on;                                                                             
                                                                                                    
           //-------------------------------------------                                            
           // $GetFileName - get the next csv table                                                 
           //-------------------------------------------                                            
             begsr $GetFileName;                                                                    
                                                                                                    
               clear filename;                                                                      
                // tables will hold all the names of the tables                                     
               clear TA;                                                                            
               clear folderNames;                                                                   
                                                                                                    
                // loop on the directory                                                            
                // Step1: Open up the directory.                                                    
               PathName = '/home/Reserve_Adjustments/';                                             
               dh = opendir(%addr(PathName));                                                       
               if dh <> *NULL;                                                                      
                                                                                                    
                // Step2: Read each entry from the directory (in a loop)                            
                p_dirent = readdir(dh);                                                             
                                                                                                    
                dow p_dirent <> *NULL;                                                              
                 if d_namelen < 256;                                                                
                  FileName = %subst(d_name:1:d_namelen);                                            
                  // process only csv files                                                         
                  // even MT directory contains folders:                                            
                  // o .                                                                            
                  // o ..                                                                           
                  if %scan('.csv':Filename) > *zeros;                                               
                   ta+=1;                                                                           
                   foldernames(ta) = %trim(pathname) + %trim(filename);                             
                  endif;                                                                            
                 endif;                                                                             
                  p_dirent = readdir(dh);                                                           
                enddo;                                                                              
               endif;                                                                               
                                                                                                    
               // Step3: Close the directory to reprocess                                           
               closedir(dh);                                                                        
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
           // $MoveToHistory - move processed table to                                              
           //                  history                                                              
           //-------------------------------------------                                            
                                                                                                    
             begsr $MoveToHistory;                                                                  
                                                                                                    
              //  *****  Rename the file  *****                                                     
              // RNM OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              // NEWOBJ('SomeNewName.csv')                                                          
              // *like: November16_2011_114547.csv                                                  
                                                                                                    
                                                                                                    
                 nDays = %diff(today : baseDate : *days);                                           
                 ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);                                      
                                                                                                    
                 MyNewName = %trim(ReturnData)  +                                                   
                 %char(%subdt(Today:*days)) + '_' +                                                 
                 %char(%subdt(Today:*years)) + '_' +                                                
                 %ScanRpl('.' : '' :                                                                
                 %char(%time())) + '.csv';                                                          
                                                                                                    
                 cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +                                     
                             %trim(filename) + Q + ')' +                                            
                             ' NEWOBJ(' + Q + %trim(MyNewName) +                                    
                             Q + ')';                                                               
                                                                                                    
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
                                                                                                    
              //  *****  Move file to history  *****                                                
              // MOV OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              //  TODIR('/home/Reserve_Adjustments/history/')                                       
                                                                                                    
                 cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +                                     
                             %trim(MyNewName) + Q + ')' +                                           
                             ' TODIR(' + Q + %trim(PathName) + 'History/' +                         
                             Q + ')';                                                               
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
                                                                                                    
      /end-free                                                                                     
                                                                                                    
      *-------------------------------------------------------------                                
      *    RdIfsFil - Subprocedure To Read The IFS File                                             
      *-------------------------------------------------------------                                
     p RdIfsFil        B                   Export                                                   
     d RdIfsFil        PI           256A                                                            
     d  FileName                    256A   Const                                                    
     d CharsRead       S             10i 0                                                          
     d CurChar         S              1                                                             
     d Eof             C                   const(x'00')                                             
                                                                                                    
      /free                                                                                         
             Oflag = O_Rdonly + O_Textdata;                                                         
             // need whole path here                                                                
             File = %trim(FileName) + x'00';                                                        
             Fp = open(%addr(File): Oflag);                                                         
                                                                                                    
             if  Fp < 0;                                                                            
              Error_Flag = *On;                                                                     
              Return  Error_Flag;                                                                   
             Endif;                                                                                 
                                                                                                    
             R = 0;                                                                                 
             N = 0;                                                                                 
             dou  CurChar = Eof;                                                                    
              exsr getChar;                                                                         
              R+=1;                                                                                 
              %Subst(Data: R: 1) = CurChar;                                                         
                                                                                                    
              if CurChar = X'25';                                                                   
               %Subst(Data: R: 1)  = *blanks;                                                       
              endif;                                                                                
                                                                                                    
              select;                                                                               
               when  R = 256 or CurChar = X'25';                                                    
                                                                                                    
           // if you find the  code then we still have more data in                                 
           // memory  and we need to process that remaining data.                                   
                                                                                                    
                if  CurChar = X'25';                                                                
                 %Subst(Data: R: 1)  = *blanks;                                                     
                endif;                                                                              
                                                                                                    
            // one record is here                                                                   
                clear  R;                                                                           
                clear  Data;                                                                        
                                                                                                    
              endsl;                                                                                
             enddo;                                                                                 
                                                                                                    
             Return    Error_Flag;                                                                  
                                                                                                    
          //---------------------------------------------------------                               
          //  GetChar - Process IFS Record, One Character At A Time                                 
          //---------------------------------------------------------                               
             begsr GetChar;                                                                         
                                                                                                    
               //  If input buffer is empty, or all characters have been                            
               //    processed, refill the input buffer.                                            
              if N = CharsRead;                                                                     
               CharsRead = Read(Fp:%Addr(Data_Rec): 2560);                                          
               N = *Zero;                                                                           
              endif;                                                                                
                                                                                                    
               // Get the next character in the input buffer.                                       
              if CharsRead <= 0;                                                                    
               CurChar = Eof;                                                                       
              else;                                                                                 
               N+=1;                                                                                
               CurChar = %Subst(Data_Rec: N: 1);                                                    
               select;                                                                              
                when  CurChar = *blanks or CurChar = cr  or  CurChar = lf;                          
                 mydata.bighunkdata = %trim(mydata.bighunkdata) + '|';                              
                other;                                                                              
                 mydata.Bighunkdata = %trim(mydata.bighunkdata) +                                   
                 %trim(Curchar);                                                                    
                endsl;                                                                              
              endif;                                                                                
                                                                                                    
             endsr;                                                                                 
                                                                                                    
         //---------------------------------------------------------                                
      /end-free                                                                                     
                                                                                                    
     p RdIfsFil        E                                                                            
     H Option( *SrcStmt: *NoDebugIo )  BndDir( 'QC2LE' ) DFTACTGRP(*No)                             
     ‚**********************************************************************                        
     ‚* Project ID     Date  Pgmr ID  Rev  Description                                              
     ‚*                                                                                             
     ‚*            11/16/11  JJF       00  program written                                          
     ‚*              ** pulls .csv tables from directory:                                           
     ‚*                 /home/Reserve_Adjustments/                                                  
     ‚*                                                                                             
     ‚**********************************************************************                        
      *                                                                                             
      * Directory Entry Structure (dirent)                                                          
      *                                                                                             
     d p_dirent        s               *                                                            
     d dirent          ds                  based(p_dirent)                                          
     d   d_reserv1                   16A                                                            
     d   d_reserv2                   10U 0                                                          
     d   d_fileno                    10U 0                                                          
     d   d_reclen                    10U 0                                                          
     d   d_reserv3                   10I 0                                                          
     d   d_reserv4                    8A                                                            
     d   d_nlsinfo                   12A                                                            
     d     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)                                     
     d     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)                                     
     d     nls_lang                   3A   OVERLAY(d_nlsinfo:7)                                     
     d     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)                                    
     d   d_namelen                   10U 0                                                          
     d   d_name                     640A                                                            
                                                                                                    
      *------------------------------------------------------------                                 
      * Open a Directory                                                                            
      *------------------------------------------------------------                                 
     d opendir         pr              *   EXTPROC('opendir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Read Directory Entry                                                                        
      *------------------------------------------------------------                                 
     d readdir         pr              *   EXTPROC('readdir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Close Directory                                                                             
      *------------------------------------------------------------                                 
     d closedir        pr              *   EXTPROC('closedir')                                      
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Open IFs table                                                                              
      *------------------------------------------------------------                                 
     d open            pr            10i 0   ExtProc('open')                                        
     d   filename                      *     value                                                  
     d   openflags                   10i 0   value                                                  
     d   mode                        10u 0   value options(*nopass)                                 
     d   codepage                    10u 0   value options(*nopass)                                 
      *------------------------------------------------------------                                 
      * Read IFS table                                                                              
      *------------------------------------------------------------                                 
     d read            pr            10i 0   ExtProc('read')                                        
     d   filehandle                  10i 0   value                                                  
     d   datareceived                  *     value                                                  
     d   nbytes                      10u 0   value                                                  
      *------------------------------------------------------------                                 
      * Close IFs table                                                                             
      *------------------------------------------------------------                                 
     d close           pr            10i 0   ExtProc('close')                                       
     d   filehandle                  10i 0   value                                                  
      *------------------------------------------------------------                                 
      * read ifs table  - internal procedure                                                        
      *------------------------------------------------------------                                 
     d RdIfsFil        pr           256a                                                            
     d  FileName                    256a   const                                                    
      *------------------------------------------------------------                                 
      * Delay - sleep function                                                                      
      *------------------------------------------------------------                                 
     d sleep           pr            10i 0 ExtProc( 'sleep' )                                       
     d  seconds                      10u 0 Value                                                    
      *------------------------------------------------------------                                 
      * Command - run a command                                                                     
      *------------------------------------------------------------                                 
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    256                                                             
     d   length                      15  5                                                          
      *------------------------------------------------------------                                 
      * Grab the date in LongFormat                                                                 
      *------------------------------------------------------------                                 
     d CEEDATE         pr                  opdesc                                                   
     d   Lilian                      10i 0                                                          
     d   picture                  65535A   const options(*varsize)                                  
     d   OutputDate               65535A   const options(*varsize)                                  
     d   Feedback                    12a   options(*omit)                                           
      *------------------------------------------------------------                                 
      * a few local variables...                                                                    
                                                                                                    
     d BaseDate        s               d   inz(D'1582-10-14')                                       
     d cmdlength       s             15  5                                                          
     d cmdstring       s            256                                                             
     d count           s              3  0                                                          
     d cr              c                   Const(x'0D')                                             
     d data            s          65535A                                                            
     d Data_Rec        s          65535A                                                            
     d datasize        s              5  0                                                          
     d dh              s               *                                                            
     d Eol             c                   Const(x'0D25')                                           
     d Error_Flag      s              1A   INZ('0')                                                 
     d File            s            256                                                             
     d FileName        s            256    varying                                                  
     d FolderNames     s            256    dim(50)                                                  
     d Fp              s             10i 0                                                          
     d KeepLooping     s               n   inz('1')                                                 
     d lf              C                   Const(x'25')                                             
     d MyNewName       s            265    varying                                                  
     d N               s              5  0                                                          
     d nDays           s             10i 0                                                          
      * values for oflag parameter, used by open()                                                  
     d O_RDONLY        s             10i 0   inz(1)                                                 
     d O_TEXTDATA      s             10i 0   inz(16777216)                                          
                                                                                                    
     d Oflag           s             10i 0                                                          
     d Omode           s             10u 0                                                          
     d PathName        s             26                                                             
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d Rc              S             10i 0                                                          
     d ReturnData      s             12                                                             
     d SleepSeconds    s             10i 0 inz(1)                                                   
     d ta              s              3  0                                                          
     d Today           s               d   inz(*SYS)                                                
                                                                                                    
         // entire document stored in here                                                          
     d MyData          ds                  qualified  inz                                           
     d  bighunkdata               65535                                                             
     d   OneSlice                    60    dim(1000) overlay(bighunkdata:*next)                     
      *------------------------------------------------------                                       
      * MAIN LINE                                                                                   
      *------------------------------------------------------                                       
                                                                                                    
      /free                                                                                         
                                                                                                    
                // program will loop until outside force                                            
                // stops it.                                                                        
              dow KeepLooping;                                                                      
                                                                                                    
               exsr $GetFileName;                                                                   
               if ta > *zeros;                                                                      
                // read the tables one at a time                                                    
                for count = 1 to ta;                                                                
                 filename = foldernames(count);                                                     
                 Error_flag = rdifsfil(Filename);                                                   
                 //exsr $MoveToHistory;                                                             
                endfor;                                                                             
               endif;                                                                               
                                                                                                    
               // Delay job for a number of seconds then start                                      
               // the process all over again.                                                       
               sleep(SleepSeconds);                                                                 
                                                                                                    
              enddo;                                                                                
                                                                                                    
           *inlr = *on;                                                                             
                                                                                                    
           //-------------------------------------------                                            
           // $GetFileName - get the next csv table                                                 
           //-------------------------------------------                                            
             begsr $GetFileName;                                                                    
                                                                                                    
               clear filename;                                                                      
                // tables will hold all the names of the tables                                     
               clear TA;                                                                            
               clear folderNames;                                                                   
                                                                                                    
                // loop on the directory                                                            
                // Step1: Open up the directory.                                                    
               PathName = '/home/Reserve_Adjustments/';                                             
               dh = opendir(%addr(PathName));                                                       
               if dh <> *NULL;                                                                      
                                                                                                    
                // Step2: Read each entry from the directory (in a loop)                            
                p_dirent = readdir(dh);                                                             
                                                                                                    
                dow p_dirent <> *NULL;                                                              
                 if d_namelen < 256;                                                                
                  FileName = %subst(d_name:1:d_namelen);                                            
                  // process only csv files                                                         
                  // even MT directory contains folders:                                            
                  // o .                                                                            
                  // o ..                                                                           
                  if %scan('.csv':Filename) > *zeros;                                               
                   ta+=1;                                                                           
                   foldernames(ta) = %trim(pathname) + %trim(filename);                             
                  endif;                                                                            
                 endif;                                                                             
                  p_dirent = readdir(dh);                                                           
                enddo;                                                                              
               endif;                                                                               
                                                                                                    
               // Step3: Close the directory to reprocess                                           
               closedir(dh);                                                                        
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
           // $MoveToHistory - move processed table to                                              
           //                  history                                                              
           //-------------------------------------------                                            
                                                                                                    
             begsr $MoveToHistory;                                                                  
                                                                                                    
              //  *****  Rename the file  *****                                                     
              // RNM OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              // NEWOBJ('SomeNewName.csv')                                                          
              // *like: November16_2011_114547.csv                                                  
                                                                                                    
                                                                                                    
                 nDays = %diff(today : baseDate : *days);                                           
                 ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);                                      
                                                                                                    
                 MyNewName = %trim(ReturnData)  +                                                   
                 %char(%subdt(Today:*days)) + '_' +                                                 
                 %char(%subdt(Today:*years)) + '_' +                                                
                 %ScanRpl('.' : '' :                                                                
                 %char(%time())) + '.csv';                                                          
                                                                                                    
                 cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +                                     
                             %trim(filename) + Q + ')' +                                            
                             ' NEWOBJ(' + Q + %trim(MyNewName) +                                    
                             Q + ')';                                                               
                                                                                                    
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
                                                                                                    
              //  *****  Move file to history  *****                                                
              // MOV OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              //  TODIR('/home/Reserve_Adjustments/history/')                                       
                                                                                                    
                 cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +                                     
                             %trim(MyNewName) + Q + ')' +                                           
                             ' TODIR(' + Q + %trim(PathName) + 'History/' +                         
                             Q + ')';                                                               
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
                                                                                                    
      /end-free                                                                                     
                                                                                                    
      *-------------------------------------------------------------                                
      *    RdIfsFil - Subprocedure To Read The IFS File                                             
      *-------------------------------------------------------------                                
     p RdIfsFil        B                   Export                                                   
     d RdIfsFil        PI           256A                                                            
     d  FileName                    256A   Const                                                    
     d CharsRead       S             10i 0                                                          
     d CurChar         S              1                                                             
     d Eof             C                   const(x'00')                                             
                                                                                                    
      /free                                                                                         
             Oflag = O_Rdonly + O_Textdata;                                                         
             // need whole path here                                                                
             File = %trim(FileName) + x'00';                                                        
             Fp = open(%addr(File): Oflag);                                                         
                                                                                                    
             if  Fp < 0;                                                                            
              Error_Flag = *On;                                                                     
              Return  Error_Flag;                                                                   
             Endif;                                                                                 
                                                                                                    
             R = 0;                                                                                 
             N = 0;                                                                                 
             dou  CurChar = Eof;                                                                    
              exsr getChar;                                                                         
              R+=1;                                                                                 
              %Subst(Data: R: 1) = CurChar;                                                         
                                                                                                    
              if CurChar = X'25';                                                                   
               %Subst(Data: R: 1)  = *blanks;                                                       
              endif;                                                                                
                                                                                                    
              select;                                                                               
               when  R = 256 or CurChar = X'25';                                                    
                                                                                                    
           // if you find the  code then we still have more data in                                 
           // memory  and we need to process that remaining data.                                   
                                                                                                    
                if  CurChar = X'25';                                                                
                 %Subst(Data: R: 1)  = *blanks;                                                     
                endif;                                                                              
                                                                                                    
            // one record is here                                                                   
                clear  R;                                                                           
                clear  Data;                                                                        
                                                                                                    
              endsl;                                                                                
             enddo;                                                                                 
                                                                                                    
             Return    Error_Flag;                                                                  
                                                                                                    
          //---------------------------------------------

Create share on IFS folder then map to local drive on PC.


Sample from Jamie Flanary posted at 2011-12-12 18:44:54

      *---------------------------------------------------------------------
      *
      *
      *---------------------------------------------------------------------
     d CmdLength       s             15  5
     d CmdString       s            256
     d InAddRemove     s              1
     d InNetDrive      s              1
     d InShareName     s             12
     d InSharePath     s             25
     d InShareText     s             25
     d MaxUsers        s             10i 0
     d PathLength      s             10i 0
     d PathCCSID       s             10i 0
     d Permission      s             10i 0
     d Q               s              1    inz('''')
     d Remove          s             10i 0
     d ShareName       s             12
     d SharePath       s           1024
     d ShareText       s             50
      *
     d APIError        ds
     d  BytesProvided                10i 0 Inz( 272 )
     d  BytesAvail                   10i 0 Inz( 0 )                              9 b
     d  MsgID                         7    Inz( *Blanks )
     d  Reserved                      1    Inz( *Blanks )
     d  MsgDta                      256    Inz( *Blanks )
      *
      * entry parameters
      *
     c     *entry        plist
     c                   parm                    InShareName
     c                   parm                    InSharePath
     c                   parm                    InShareText
     c                   parm                    InAddRemove
     c                   parm                    InNetDrive
      *
     c                   eval      PathLength = %len(%trim(InSharePath))
      *
     c                   select
     c                   when      inAddRemove = 'A'
      *
     c                   call(e)   'QZLSADFS'
     c                   parm      InShareName   ShareName
     c                   parm      InsharePath   SharePath
     c                   parm                    PathLength
     c                   parm      0             PathCCSID
     c                   parm      InShareText   ShareText
     c                   parm      2             Permission
     c                   parm      100           MaxUsers
     c                   parm                    APIError
      *
     c                   exsr      $MapNetDrive
      *
     c                   when      inAddRemove = 'R'
     c                   call(e)   'QZLSRMS'
     c                   parm      InShareName   ShareName
     c                   parm                    Remove
      *
     c                   endsl
      *
     c                   eval      *inlr = *on
      *-----------------------------------------------------
      * $MapNetDrive - Map a networkdrive
      *-----------------------------------------------------
     c     $MapNetDrive  begsr
      *
     c                   eval      cmdstring = 'STRPCO pcta(*NO)'
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
      *
      * strpccmd 'net use Z: \lbi-nt1SharedDocsProcessSchedule'
      *
     c                   eval      cmdstring = 'strpccmd ' + Q +
     c                             'net use '
     c                             + %trim(InNetDrive)
     c                             + ': \qrockford'
     c                             + %trim(InShareName)
     c                             + Q + ' pause(*NO)'
      *
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
     c                   endsr
      *-----------------------------------------------------

Using RPGLE to write directly to a document on the IFS.


Sample from Jamie Flanary posted at 2011-12-12 18:32:07

     H dftactgrp( *no ) bnddir( 'QC2LE':'WRITEIFS' ) OPTION(*NODEBUGIO)
      * --------------------------------------------------
      * Program - WRITEIFS
      * Purpose - write csv table to Server for Process Scheduling
      * Written - 
      * Author  - 
      *
      * PROGRAM DESCRIPTION
      *   this program reads open orders and customized releases
      *   and writes them to the IFS.  Then copies the file back to
      *   the server. (Network share)
      *
      *
      * INPUT PARAMETERS
      *   Description        Type  Size    How Used
      *   -----------        ----  ----    --------
      *
      *
      * INDICATOR USAGE
      *   xx - xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
      *---------------------------------------------------
     foehdordg  if   e           k disk
     foeidordb  if   e           k disk
     foeiadlba  if   e           k disk
     faracustd  if   e           k disk
     findesca   if   e           k disk
     foeqopdsa  if   e           k disk
     fcsarlabg  if   e           k disk
     fcihreleasaif   e           k disk
     fcibcustomcif   e           k disk
     fcibcustomdif   e           k disk    rename(CIBCUSTOMR:CIBCUSTOD)
     f                                     prefix(D_)
     fcicadlbd  if   e           k disk
      *
      * strpccmd 'net use Z: \lbi-nt1SharedDocsProcesses'
      *
     d AllComplete     S              1
     d CmdString       S            512
     d CmdLength       S             15  5
     d count           S              5  0
     d cp              S             10U 0 INZ(819)
     d CRLF            C                   CONST(X'0d25')
     d Complete        S              1
     d Current         S              1
     d Data            S            500
     d DQ              C                   CONST('"')
     d FileNam         S             24A   inz('/Processes/Processes.csv')
     d FileNamP        S               *   inz(%ADDR(FileNam))
     d FileDescr       S             10I 0
     d FirstNew        S              1
     d ISODate         S               D
     d LC#             S              3  0
     d LaborCodes      S              3    dim(100)
     d LaborCodeCu     S              1    dim(100)
     d LaborCodeCo     S              1    dim(100)
     d LaborCodePd     S              7  0 dim(100)
     d Len             S              3  0
     d Length          s              9
     d Produced        S              7  0
     d Buf             S            500A
     d BufP            S               *   INZ(%ADDR(Buf))
     d BufLen          S             10U 0
     d deleted         S               n
     d NLZero          S              2A   INZ(X'1500')
     d O_CREAT         S             10I 0 INZ(8)
     d O_RDWR          S             10I 0 INZ(4)
     d O_TEXTDATA      S             10I 0 INZ(16777216)
     d O_CODEPAGE      S             10I 0 INZ(8388608)
     d Oflag           S             10I 0 INZ(0)
     d Omode           S             10U 0 INZ(511)
     d Q               C                   CONST('''')
     d Pos             S              4  0
     d ReadOneRecord   S              1
     d RC              S             10I 0
     d SI_Fmt          S             50A   INZ('n')
     d SI_FmtP         S               *   INZ(%ADDR(SI_Fmt))
     d SI_Msg          S             50A
     d SI_MsgP         S               *   INZ(%ADDR(SI_Msg))
     d Str             S              3  0
     d Width           s              7
     d WKSDES          s             30
     d WkLenInch       s              9  0
     d WkWidInch       s              7  0
     d WorkBracket     s              5  0
     d WorkUnique      s             28
     d WorkVersion     s              3  0
     d ZeroBin         S              1A   INZ(*ALLX'00')
      *
      * Program Info
      *
     d                SDS
     d  @PGM                 001    010
     d  @PARMS               037    039  0
     d  @JOB                 244    253
     d  @USER                254    263
     d  @JOB#                264    269  0
      *
      *
      *
     d Num_DS          DS
     d Num_Hex                        4A   INZ(X'00000000')
     d Num                           10I 0 OVERLAY(Num_Hex)

     dperror           PR            10I 0 EXTPROC('perror')
     dconst                            *   VALUE

     dsprintf          PR            10I 0 EXTPROC('sprintf')
     d                                 *   VALUE
     d                                 *   VALUE
     d                               10I 0 VALUE OPTIONS(*NOPASS)
     d                                 *   VALUE OPTIONS(*NOPASS)
      * Open Operations
      * value returned = file descriptor 0 (OK), -1 (Error)

     dopen             PR            10I 0 EXTPROC('open')
     d                                 *   VALUE
     d                               10I 0 VALUE
     d                               10U 0 VALUE OPTIONS(*NOPASS)
     d                               10U 0 VALUE OPTIONS(*NOPASS)

      * Read Operations
      * value returned = number of bytes read or , -1 (Error)

     Dread             PR            10I 0 EXTPROC('read')
     d                               10I 0 VALUE
     d                                 *   Value
     d                               10U 0 VALUE

      * Write Operations
      * value returned = number of bytes Written or , -1 (Error)

     dwrite            PR            10I 0 EXTPROC('write')
     d                               10I 0 VALUE
     d                                 *   VALUE
     d                               10U 0 VALUE

      * Close Operations
      * value returned = 0 (OK) or , -1 (Error)

     dclose            PR            10I 0 EXTPROC('close')
     d                               10I 0 VALUE

      * Open Directory Operation
      * value returned = file descriptor 0 (OK), -1 (Error)

     dopendir          PR              *   EXTPROC('opendir')
     d                                 *   VALUE

      * Read Directory Operation
      *


     dreaddir          PR              *   EXTPROC('readdir')
     d                                 *   VALUE

      * Open Directory Operation
      * value returned = 0 (OK) or , -1 (Error)

     dclosedir         PR            10I 0 EXTPROC('closedir')
     d                                 *   VALUE

      * Unlink a File from system... Delete File
      * value returned = 0 (OK) or , -1 (Error)

     dunlink           PR            10I 0 EXTPROC('unlink')
     d path                            *   Value options(*string)

      *
      /copy qprcsrc,FMTITM2_CP
      *
     c                   exsr      $BuildFile
      *
      * Shut down the IFS file and prepare to email.
      *
     c                   exsr      $TheEnd
     c                   exsr      $copy2Z
      *
      * delete the IFS file we just created
      *
     c*******>           if        unlink('/Processes/Processes.csv') < 0
      *
      * send some error message !!!!  Cannot delete file
      *
     c*******>           endif
      *
     c                   eval      *INLR = *On
      *
      *----------------------------------------------------------------
      *  $BuildFile
      *----------------------------------------------------------------
     CSR   $BuildFile    Begsr
      *
     c                   z-add     O_CREAT       Oflag
     c                   add       O_RDWR        Oflag
     c                   add       O_CODEPAGE    Oflag
     c                   eval      FileDescr=open(FileNamP:Oflag:Omode:cp)

     c                   if        FileDescr = -1
     c                   eval      RC = perror(FileNamP)
     c                   return
     c                   endif

     c                   eval      RC = close(FileDescr)

     c                   if        RC = -1
     c                   eval      RC = perror(FileNamP)
     c                   return
     c                   endif

     c                   z-add     O_RDWR        Oflag
     c                   add       O_TEXTDATA    Oflag

     c                   eval      FileDescr=open(FileNamP:Oflag)

     c                   if        FileDescr = -1
     c                   eval      RC = perror(FileNamP)
     c                   Return
     c                   endif
      *
      *----------------------------------------
      * This is where the writting takes place
      *----------------------------------------
      *
      *  write the column names first
      *
     c                   clear                   Data
     c                   clear                   Buf
      *
     c                   eval      Data = 'ProNumber'       + ',' +
     c                                    'Counter'         + ',' +
     c                                    'Sold-To'         + ',' +
     c                                    'Sold-To Name'    + ',' +
     c                                    'Date Requested'  + ',' +
     c                                    'Start Date'      + ',' +
     c                                    'Description'     + ',' +
     c                                    'Size Desc'       + ',' +
     c                                    'Part'            + ',' +
     c                                    'Material'        + ',' +
     c                                    'Analysis'        + ',' +
     c                                    'Size'            + ',' +
     c                                    'Width'           + ',' +
     c                                    'Length'          + ',' +
     c                                    'Decimal'         + ',' +
     c                                    'Actual Weight'   + ',' +
     c                                    'Billed Weight'   + ',' +
     c                                    'labor Code'      + ',' +
     c                                    'labor Desc'      + ',' +
     c                                    'labor Loc'       + ',' +
     c                                    'Complete'        + ',' +
     c                                    'Current'         + ',' +
     c                                    'Process Time'    + ',' +
     c                                    'Qty Ordered'     + ',' +
     c                                    'Qty Produced'    + ',' +
     c                                    'Order Type'      + ',' +
     c                                    'Customer PO'           +
     c                                     CRLF

     c                   eval      Buf = %trim(Data)
     c                   eval      BufLen = %scan(CRLF:Buf)
     c                   eval      RC = write(FileDescr: BufP: BufLen)
      *
     c                   read      OEHDORDG
     c                   dow       not%eof(OEHDORDG)
      *
     c                   if        OHPRO7  > *zeros
      *
     c     OHPRO7        setll     OEIDORDB
     c     OHPRO7        reade     OEIDORDB
     c                   dow       not%eof(OEIDORDB)
      *
     c     OHSL#         chain     ARACUSTD
     c                   if        %found(ARACUSTD)
      *
      * write the indi records
      *
      *
      *
     c     INDKY1        chain     indesca
     c                   if        %found(indesca)
      *
     c                   exsr      $laborCodes
      *
      *  read all additional labor codes
      *
     c     OEIKY1        setll     oeiadlba
     c     OEIKY1        reade     oeiadlba
     c                   dow       not%eof(oeiadlba)
      *
     c     OIALCO        chain     OEQOPDSA
     c                   if        %found(OEQOPDSA)
      *
     c                   clear                   Data
     c                   clear                   Buf
      *
     c                   eval      pos = %lookup(OIALCO : LaborCodes)
     c                   if        pos > *zeros
     c                   eval      Complete = LaborCodeCo(pos)
     c                   eval      Current  = laborCodeCu(pos)
     c                   eval      Produced = laborCodePd(pos)
     c                   endif
      *
     c                   eval      Data = %trim(%char(OHPRO7))   + ',' +
     c                                    %trim(%char(Oicnt3))   + ',' +
     c                                    %trim(%char(OHSL#))    + ',' +
     c                                    %trim(%xlate(',':'-':AASLNM)) + ',' +
     c                                    %trim(%char(OHDTRQST)) + ',' +
     c                                    %trim(%char(0)) + ',' +
     c                                    %trim(%xlate(',':'-':IDMDES)) + ',' +
     c                                    %trim(%xlate(',':'-':OISDES)) + ',' +
     c                                    'Part:' +
     c                                    %trim(%xlate(',':'-':OIPART)) + ',' +
     c                                    %trimr(Oimat)          + ',' +
     c                                    'Anal:' +
     c                                    %trimr(Oianal)         + ',' +
     c                                    %trimr(Oisize)         + ',' +
     c                                    %trim(%char(Oicwid))   + ',' +
     c                                    %trim(%char(Oiclgt))   + ',' +
     c                                    %trim(OIDEC)           + ',' +
     c                                    %trim(%char(Oipewt))   + ',' +
     c                                    %trim(%char(OIWGT ))   + ',' +
     c                                    %trim(OIALCO)          + ',' +
     c                                    %trim(%xlate(',':'-':OQLDES))+ ',' +
     c                                    %trim(%xlate(',':'-':OIALLC))+ ',' +
     c                                    %trim(Complete)        + ',' +
     c                                    %trim(Current)         + ',' +
     c                                    '0'                    + ',' +
     c                                    %trim(%char(OIQT07))   + ',' +
     c                                    %trim(%char(Produced)) + ',' +
     c                                    %trim(OHORTP)          + ',' +
     c                                    %trim(OHPONM)                +
     c                                    CRLF

     c                   eval      Buf = %trim(Data)
     c                   eval      BufLen = %scan(CRLF:Buf)
     c                   eval      RC = write(FileDescr: BufP: BufLen)
      *
     c                   endif
      *
     c     OEIKY1        reade     oeiadlba
     c                   enddo
      *
     c                   endif
     c                   endif
      *
     c     OHPRO7        reade     OEIDORDB
     c                   enddo
      *
     c                   endif
      *
     c                   read      OEHDORDG
     c                   enddo
      *
      * now read customized releases
      *
     c     *start        setll     CIHRELEASA
     c                   read      CIHRELEASA
     c                   dow       not%eof(CIHRELEASA)
      *
     c                   clear                   Data
     c                   clear                   Buf
      *
     c     CHACCT        chain     ARACUSTD
     c                   if        %found(ARACUSTD)
      *
     c     CHPART        chain     CIBCUSTOMC
     c                   if        %found(CIBCUSTOMC)
      *
     c                   eval      WkWidInch =
     c                                       %dec(%editc(CBFWDIN:'X') +
     c                                       %editc(CBFWDFR:'X'):7:0)
     c                   eval      Width     = %editc(WkWidInch:'X')
     c                   eval      WkLenInch =
     c                                       %dec(%editc(CBFLDFT:'X') +
     c                                       %editc(CBFLDIN:'X') +
     c                                       %editc(CBFLDFR:'X'):9:0)
     c                   eval      Length    = %editc(WkLenInch:'X')
      *
     c                   eval      WkSDES =
     c                             FmtItm2(cbrMat:cbrAnal:cbrSize:Width:Length:
     c                                     CBRNUMFMT : CBRCIRC)
      *
     c     INDKY2        chain     indesca
     c                   if        %found(indesca)
      *
      * need to figure out which bracket we are in to know selling Price
      *
     c                   clear                   WorkUnique
     c                   clear                   WorkVersion
      *
     c     CHPART        chain     cibcustomc
     c                   if        %found(cibcustomc)
     c                   eval      WorkUnique  = CBUNQKEY
     c                   eval      WorkVersion = CBVERSION
     c                   endif
      *
     c                   clear                   WorkBracket
     c     CICKY1        setll     CIBCUSTOMD
     c                   read      CIBCUSTOMD
     c                   eval      WorkBracket = D_CBBRCK#
     c                   dow       not%eof(CIBCUSTOMD)
      *
     c                   if        CHRELPCS  >= D_CBBRCK#
     c                   eval      WorkBracket = D_CBBRCK#
     c                   leave
     c                   endif
      *
     c                   read      CIBCUSTOMD
     c                   enddo
      *
     c     CICKY2        setll     cicadlbd
     c     CICKY2        reade     cicadlbd
     c                   dow       not%eof(cicadlbd)
      *
     c     CCLABCOD      chain     OEQOPDSA
     c                   if        %found(OEQOPDSA)
      *
     c                   clear                   Complete
     c                   clear                   Current
      *
     c                   eval      Data = %trim(%char(0))   + ',' +
     c                                    %trim(%char(0))   + ',' +
     c                                    %trim(%char(CHACCT))   + ',' +
     c                                    %trim(%xlate(',':'-':AASLNM)) + ',' +
     c                                    %trim(%editc(CHDUEDAT:'X')) + ',' +
     c                                    %trim(%editc(CHSTRDAT:'X')) + ',' +
     c                                    %trim(%xlate(',':'-':IDMDES)) + ',' +
     c                                    %trim(%xlate(',':'-':WkSDES)) + ',' +
     c                                    'Part:' +
     c                                    %trim(%xlate(',':'-':CHPART)) + ',' +
     c                                    %trimr(cbrmat)          + ',' +
     c                                    %trimr(cbranal)         + ',' +
     c                                    %trimr(cbrsize)         + ',' +
     c                                    %trim(Width)     + ',' +
     c                                    %trim(Length)    + ',' +
     c                                    %trim(CBRNUMFMT) + ',' +
     c                                    %char(cbaweight * CHRELPCS) + ',' +
     c                                    %char(cbbweight * CHRELPCS) + ',' +
     c                                    %trim(CCLABCOD)        + ',' +
     c                                    %trim(%xlate(',':'-':OQLDES))+ ',' +
     c                                    %trim(%xlate(',':'-':OIALLC))+ ',' +
     c                                    %trim(Complete   )     + ',' +
     c                                    %trim(Current)         + ',' +
     c                                    %trim(%char(CCTOTLTM))       +
     c                                    %trim(%char(CHRELPCS)) + ',' +
     c                                    %trim('0')             + ',' +
     c                                    %trim(' ')             + ',' +
     c                                    %trim(' ')                   +
     c                                    CRLF

     c                   eval      Buf = %trim(Data)
     c                   eval      BufLen = %scan(CRLF:Buf)
     c                   eval      RC = write(FileDescr: BufP: BufLen)
      *
     c                   endif
      *
     c     CICKY2        reade     cicadlbd
     c                   enddo
      *
     c                   endif
     c                   endif
     c                   endif
      *
     c                   read      CIHRELEASA
     c                   enddo
     c                   endsr
      *----------------------------------------------------------------
      *  $laborCodes - status and Active codes for each labor code
      *----------------------------------------------------------------
     CSR   $LaborCodes   begsr
      *
     c                   clear                   Complete
     c                   clear                   Current
      *
     c                   clear                   LC#
     c                   clear                   LaborCodes
     c                   clear                   LaborCodeCu
     c                   clear                   LaborCodeCo
     c                   clear                   LaborCodePd
      *
     c                   clear                   FirstNew
     c                   eval      AllComplete = 'Y'
      *
      *  read all additional labor codes
      *
     c     OEIKY1        setll     oeiadlba
     c     OEIKY1        reade     oeiadlba
     c                   dow       not%eof(oeiadlba)
      *
     c                   eval      LC# +=1
     c                   eval      LaborCodes(LC#) = OIALCO
      *
     c                   clear                   ReadOneRecord
      *
     c     CSAKY1        setll     CSARLABG
     c     CSAKY1        reade     CSARLABG
      *
     c                   if        %eof(CSARLABG)
     c                   eval      AllComplete = 'N'
     c                   endif
      *
     c                   dow       not%eof(CSARLABG)
      *
     c                   eval      ReadOneRecord = 'Y'
     c                   if        CAESTAMP > *loval
     c                   eval      LaborCodeCo(LC#) = 'Y'
     c                   else
     c                   eval      AllComplete = 'N'
     c                   endif
      *
     c                   eval      LaborCodePd(LC#) += CACPCS
      *
     c     CSAKY1        reade     CSARLABG
     c                   enddo
     c
      *
     c                   if        FirstNew = *blanks
     c                   if        LaborCodeCo(LC#) <> 'Y' and
     c                             ReadOneRecord = 'Y' or
     c                             ReadOneRecord = *blanks
     c                   clear                   LaborCodeCu
     c                   eval      LaborCodeCu(LC#) = 'Y'
     c                   if        ReadOneRecord = *blanks
     c                   eval      FirstNew = 'Y'
     c                   endif
     c                   endif
     c                   endif
      *
      *  If all complete then clear the current flag
      *
     c                   if        AllComplete = 'Y'
     c                   clear                   LaborCodeCu
     c                   endif
      *
     c     OEIKY1        reade     oeiadlba
     c                   enddo
      *
     c                   endsr
      *----------------------------------------------------------------
      *  T H E   E N D
      *----------------------------------------------------------------
     CSR   $TheEnd       Begsr
      *
      * Close the File
      *
     c                   EVAL      RC = close(FileDescr)
     c                   IF        FileDescr = -1
     c                   EVAL      RC = perror(FileNamP)
     c                   Return
     c                   ENDIF
      *
     c                   Endsr
      *----------------------------------------------------------------
      * $Copy2Z - Copy from IFS to the Z: drive the new file
      *----------------------------------------------------------------
     CSR   $Copy2Z       begsr
      *
     c                   eval      cmdstring = 'STRPCO'
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
      *
      * strpccmd 'net use Z: \lbi-nt1SharedDocsProcessSchedule'
      *
     c                   eval      cmdstring = 'strpccmd ' + Q +
     c                             'net use Z: \lbi-nt1SharedDocs' +
     c                             'Processes' + Q
      *
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
      *
      *  copy command   X = IFS networkshare
      *  copy X:tst.csv   Z: STRPCCMD PCCMD('dir') PAUSE(*NO)
      *
     c                   eval      cmdstring = 'strpccmd PCCMD(' + Q +
     c                             'copy X:Processes.csv   Z:' + Q  +
     c                             ') PAUSE(*NO)'
      *
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
     c                   endsr
      *----------------------------------------------------------------
      *  Hskpg - HouseKeeping one time run subroutine
      *----------------------------------------------------------------
     c     Hskpg         begsr
      *
      * klist
      *
     c     CICKY1        klist
     c                   kfld                    WorkUnique
     c                   kfld                    WorkVersion
      *
     c     CICKY2        klist
     c                   kfld                    WorkUnique
     c                   kfld                    WorkVersion
     c                   kfld                    WorkBracket
      *
     c     CSAKY1        klist
     c                   kfld                    OIPRO7
     c                   kfld                    OICNT3
     c                   kfld                    OIALCO
      *
     c     INDKY1        klist
     c                   kfld                    OIMAT
     c                   kfld                    OIANAL
      *
     c     INDKY2        klist
     c                   kfld                    CBRMAT
     c                   kfld                    CBRANAL
      *
     c     OEIKY1        klist
     c                   kfld                    OIPRO7
     c                   kfld                    OICNT3
      *
     c                   endsr
      *----------------------------------------------------------------


Using RPGLE to rename tables on the IFS.


Sample from Larry Powers posted at 2011-12-12 18:22:55

      //******************************************************************************
      //*                                                                            *
      //*   Module Name: UTIFS2RI                                                    *
      //*        Author: Larry Powers                                                *
      //*  Date Created: 04/04/2006                                                  *
      //*                                                                            *
      //*       Purpose: Delete File on IFS                                          *
      //*                                                                            *
      //*       ***   Must use BNDDIR('QC2LE')                                       *
      //*  It contains a list of modules and service programs needed for the C       *
      //*  language runtime environment.                                             *
      //******************************************************************************
      //*  Parameter Descriptions........                                            *
      //*  60  A  &PathI - Path where to find file excluding file name               *
      //*                  Must be 60 characters in the cl - (add blanks on end)     *
      //*            ex: '/larrypifs/test/input/FileIn.txt'                          *
      //*  60  A  &PathO - backup folder path and starting characters of name        *
      //*                  Must be 60 characters in the cl - (add blanks on end)     *
      //*            ex: '/larrypifs/test/input/backup/FI_'                          *
      //*   4  A  &Extension - file extension                                        *
      //*                  Must be  4 characters in the cl - (add blanks on end)     *
      //*            ex: 'txt '                                                      *
      //*   1  A  &Error - Error flag / if folder already exist it returns "1"       *
      //*            ex: /larrysifs/test/input/backup/                               *
      //******************************************************************************
      //    Modifications:                                                           *
      //    Date Modified, Programmer Initials, and Desc Of Mod.                     *
      //******************************************************************************
      //    04/04/06 L Powers    Initial Routine
      //******************************************************************************
      //******************************************************************************
     H DFTACTGRP(*NO) BNDDIR('QC2LE')

      *--------------------------------------------------------------------
      * Directory to process
      *--------------------------------------------------------------------
     D renamef         PR                  extpgm('UTIFS2RI')
     D  PathI                        60a
     D  PathO                        60a
     D  extension                     4a
     D  ErrorFlag                     1n
      *--------------------------------------------------------------------
      *
      *--------------------------------------------------------------------
     D renamef         PI
     D  PathI                        60a
     D  PathO                        60a
     D  extension                     4a
     D  ErrorFlag                     1n
      *--------------------------------------------------------------------
      *
      *--------------------------------------------------------------------
     D NewPath         s             60A
     D typepos         s              3  0
     D dotext          s              4A
     D ODate           s              8a
     D OTime           s              6a
     D dot             c                   Const('.')

     D msg             s             51A
     D ChrAry          s                   Like( PathI  ) Dim( 55 )
     D Blank           s              1a
     D position        S              3  0

      *--------------------------------------------------------------------
      * Rename File or Directory
      *
      * int rename(const char *old, const char *new)
      *
      *  Note: By defailt, if a file with the new name already exists,
      *        rename will fail with an error.  If you define
      *        RENAMEUNLINK and a file with the new name already exists
      *        it will be unlinked prior to renaming.
      *--------------------------------------------------------------------
      /if defined(RENAMEUNLINK)
     D rename          PR            10I 0 ExtProc('Qp0lRenameUnlink')
     D   old                           *   Value options(*string)
     D   new                           *   Value options(*string)
      /else
     D rename          PR            10I 0 ExtProc('Qp0lRenameKeep')
     D   old                           *   Value options(*string)
     D   new                           *   Value options(*string)
      /endif

      /free

          //
          // Rename a file
          //

          clear newpath ;
          errorFlag = *off ;
          ODate = %Char(%Date():*ISO0)   ;
          OTime = %char( %time : *HMS0 ) ;
        //NewPath = %trim(PathO) + ODate + OTime ;
          NewPath = %trimR(PathO) + ODATE + OTIME + dot + EXTENSION ;


          If  rename(%trimr(PathI ): %trimr(NewPath))<0 ;
             errorFlag = *on ;
          Endif ;

          *inlr = *on;
      /end-free


Create an IFS share on local PC to move data.


Sample from Jamie Flanary posted at 2011-12-10 14:57:14

      *---------------------------------------------------------------------
      *
      *
      *---------------------------------------------------------------------
     d CmdLength       s             15  5
     d CmdString       s            256
     d InAddRemove     s              1
     d InNetDrive      s              1
     d InShareName     s             12
     d InSharePath     s             25
     d InShareText     s             25
     d MaxUsers        s             10i 0
     d PathLength      s             10i 0
     d PathCCSID       s             10i 0
     d Permission      s             10i 0
     d Q               s              1    inz('''')
     d Remove          s             10i 0
     d ShareName       s             12
     d SharePath       s           1024
     d ShareText       s             50
      *
     d APIError        ds
     d  BytesProvided                10i 0 Inz( 272 )
     d  BytesAvail                   10i 0 Inz( 0 )                              9 b
     d  MsgID                         7    Inz( *Blanks )
     d  Reserved                      1    Inz( *Blanks )
     d  MsgDta                      256    Inz( *Blanks )
      *
      * entry parameters
      *
     c     *entry        plist
     c                   parm                    InShareName
     c                   parm                    InSharePath
     c                   parm                    InShareText
     c                   parm                    InAddRemove
     c                   parm                    InNetDrive
      *
     c                   eval      PathLength = %len(%trim(InSharePath))
      *
     c                   select
     c                   when      inAddRemove = 'A'
      *
     c                   call(e)   'QZLSADFS'
     c                   parm      InShareName   ShareName
     c                   parm      InsharePath   SharePath
     c                   parm                    PathLength
     c                   parm      0             PathCCSID
     c                   parm      InShareText   ShareText
     c                   parm      2             Permission
     c                   parm      100           MaxUsers
     c                   parm                    APIError
      *
     c                   exsr      $MapNetDrive
      *
     c                   when      inAddRemove = 'R'
     c                   call(e)   'QZLSRMS'
     c                   parm      InShareName   ShareName
     c                   parm                    Remove
      *
     c                   endsl
      *
     c                   eval      *inlr = *on
      *-----------------------------------------------------
      * $MapNetDrive - Map a networkdrive
      *-----------------------------------------------------
     c     $MapNetDrive  begsr
      *
     c                   eval      cmdstring = 'STRPCO pcta(*NO)'
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
      *
      * strpccmd 'net use Z: \lbi-nt1SharedDocsProcessSchedule'
      * QS103NLAM
      *
     c                   eval      cmdstring = 'strpccmd ' + Q +
     c                             'net use '
     c                             + %trim(InNetDrive)
     c                             + ': \Qrockford'
     c                             + %trim(InShareName)
     c                             + Q + ' pause(*NO)'
      *
     c                   eval      cmdlength = %len(%trim(cmdstring))
     c                   call(e)   'QCMDEXC'
     c                   parm                    cmdstring
     c                   parm                    cmdlength
     c                   endsr
      *-----------------------------------------------------

To use:
A = add R = Remove
call ifsshare parm('IROCK' '/home/jamie' 'jamie is cool' 'A' 'P')  

call ifsshare parm('IROCK' '/home/jamie' 'jamie is cool' 'R' 'P')  




Read a directory for .CSV table, then read & process.


Sample from Jamie Flanary posted at 2011-12-10 10:47:44

     H Option( *SrcStmt: *NoDebugIo )  BndDir( 'QC2LE' ) DFTACTGRP(*No)                             
     ‚**********************************************************************                        
     ‚* Project ID     Date  Pgmr ID  Rev  Description                                              
     ‚*                                                                                             
     ‚*            11/16/11  JJF       00  program written                                          
     ‚*              ** pulls .csv tables from directory:                                           
     ‚*                 /home/Reserve_Adjustments/                                                  
     ‚*                                                                                             
     ‚**********************************************************************                        
      *                                                                                             
      * Directory Entry Structure (dirent)                                                          
      *                                                                                             
     d p_dirent        s               *                                                            
     d dirent          ds                  based(p_dirent)                                          
     d   d_reserv1                   16A                                                            
     d   d_reserv2                   10U 0                                                          
     d   d_fileno                    10U 0                                                          
     d   d_reclen                    10U 0                                                          
     d   d_reserv3                   10I 0                                                          
     d   d_reserv4                    8A                                                            
     d   d_nlsinfo                   12A                                                            
     d     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)                                     
     d     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)                                     
     d     nls_lang                   3A   OVERLAY(d_nlsinfo:7)                                     
     d     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)                                    
     d   d_namelen                   10U 0                                                          
     d   d_name                     640A                                                            
                                                                                                    
      *------------------------------------------------------------                                 
      * Open a Directory                                                                            
      *------------------------------------------------------------                                 
     d opendir         pr              *   EXTPROC('opendir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Read Directory Entry                                                                        
      *------------------------------------------------------------                                 
     d readdir         pr              *   EXTPROC('readdir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Close Directory                                                                             
      *------------------------------------------------------------                                 
     d closedir        pr              *   EXTPROC('closedir')                                      
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Open IFs table                                                                              
      *------------------------------------------------------------                                 
     d open            pr            10i 0   ExtProc('open')                                        
     d   filename                      *     value                                                  
     d   openflags                   10i 0   value                                                  
     d   mode                        10u 0   value options(*nopass)                                 
     d   codepage                    10u 0   value options(*nopass)                                 
      *------------------------------------------------------------                                 
      * Read IFS table                                                                              
      *------------------------------------------------------------                                 
     d read            pr            10i 0   ExtProc('read')                                        
     d   filehandle                  10i 0   value                                                  
     d   datareceived                  *     value                                                  
     d   nbytes                      10u 0   value                                                  
      *------------------------------------------------------------                                 
      * Close IFs table                                                                             
      *------------------------------------------------------------                                 
     d close           pr            10i 0   ExtProc('close')                                       
     d   filehandle                  10i 0   value                                                  
      *------------------------------------------------------------                                 
      * read ifs table  - internal procedure                                                        
      *------------------------------------------------------------                                 
     d RdIfsFil        pr           256a                                                            
     d  FileName                    256a   const                                                    
      *------------------------------------------------------------                                 
      * Delay - sleep function                                                                      
      *------------------------------------------------------------                                 
     d sleep           pr            10i 0 ExtProc( 'sleep' )                                       
     d  seconds                      10u 0 Value                                                    
      *------------------------------------------------------------                                 
      * Command - run a command                                                                     
      *------------------------------------------------------------                                 
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    256                                                             
     d   length                      15  5                                                          
      *------------------------------------------------------------                                 
      * Grab the date in LongFormat                                                                 
      *------------------------------------------------------------                                 
     d CEEDATE         pr                  opdesc                                                   
     d   Lilian                      10i 0                                                          
     d   picture                  65535A   const options(*varsize)                                  
     d   OutputDate               65535A   const options(*varsize)                                  
     d   Feedback                    12a   options(*omit)                                           
      *------------------------------------------------------------                                 
      * a few local variables...                                                                    
                                                                                                    
     d BaseDate        s               d   inz(D'1582-10-14')                                       
     d cmdlength       s             15  5                                                          
     d cmdstring       s            256                                                             
     d count           s              3  0                                                          
     d cr              c                   Const(x'0D')                                             
     d data            s          65535A                                                            
     d Data_Rec        s          65535A                                                            
     d datasize        s              5  0                                                          
     d dh              s               *                                                            
     d Eol             c                   Const(x'0D25')                                           
     d Error_Flag      s              1A   INZ('0')                                                 
     d File            s            256                                                             
     d FileName        s            256    varying                                                  
     d FolderNames     s            256    dim(50)                                                  
     d Fp              s             10i 0                                                          
     d KeepLooping     s               n   inz('1')                                                 
     d lf              C                   Const(x'25')                                             
     d MyNewName       s            265    varying                                                  
     d N               s              5  0                                                          
     d nDays           s             10i 0                                                          
      * values for oflag parameter, used by open()                                                  
     d O_RDONLY        s             10i 0   inz(1)                                                 
     d O_TEXTDATA      s             10i 0   inz(16777216)                                          
                                                                                                    
     d Oflag           s             10i 0                                                          
     d Omode           s             10u 0                                                          
     d PathName        s             26                                                             
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d Rc              S             10i 0                                                          
     d ReturnData      s             12                                                             
     d SleepSeconds    s             10i 0 inz(1)                                                   
     d ta              s              3  0                                                          
     d Today           s               d   inz(*SYS)                                                
                                                                                                    
         // entire document stored in here                                                          
     d MyData          ds                  qualified  inz                                           
     d  bighunkdata               65535                                                             
     d   OneSlice                    60    dim(1000) overlay(bighunkdata:*next)                     
      *------------------------------------------------------                                       
      * MAIN LINE                                                                                   
      *------------------------------------------------------                                       
                                                                                                    
      /free                                                                                         
                                                                                                    
                // program will loop until outside force                                            
                // stops it.                                                                        
              dow KeepLooping;                                                                      
                                                                                                    
               exsr $GetFileName;                                                                   
               if ta > *zeros;                                                                      
                // read the tables one at a time                                                    
                for count = 1 to ta;                                                                
                 filename = foldernames(count);                                                     
                 Error_flag = rdifsfil(Filename);                                                   
                 //exsr $MoveToHistory;                                                             
                endfor;                                                                             
               endif;                                                                               
                                                                                                    
               // Delay job for a number of seconds then start                                      
               // the process all over again.                                                       
               sleep(SleepSeconds);                                                                 
                                                                                                    
              enddo;                                                                                
                                                                                                    
           *inlr = *on;                                                                             
                                                                                                    
           //-------------------------------------------                                            
           // $GetFileName - get the next csv table                                                 
           //-------------------------------------------                                            
             begsr $GetFileName;                                                                    
                                                                                                    
               clear filename;                                                                      
                // tables will hold all the names of the tables                                     
               clear TA;                                                                            
               clear folderNames;                                                                   
                                                                                                    
                // loop on the directory                                                            
                // Step1: Open up the directory.                                                    
               PathName = '/home/Reserve_Adjustments/';                                             
               dh = opendir(%addr(PathName));                                                       
               if dh <> *NULL;                                                                      
                                                                                                    
                // Step2: Read each entry from the directory (in a loop)                            
                p_dirent = readdir(dh);                                                             
                                                                                                    
                dow p_dirent <> *NULL;                                                              
                 if d_namelen < 256;                                                                
                  FileName = %subst(d_name:1:d_namelen);                                            
                  // process only csv files                                                         
                  // even MT directory contains folders:                                            
                  // o .                                                                            
                  // o ..                                                                           
                  if %scan('.csv':Filename) > *zeros;                                               
                   ta+=1;                                                                           
                   foldernames(ta) = %trim(pathname) + %trim(filename);                             
                  endif;                                                                            
                 endif;                                                                             
                  p_dirent = readdir(dh);                                                           
                enddo;                                                                              
               endif;                                                                               
                                                                                                    
               // Step3: Close the directory to reprocess                                           
               closedir(dh);                                                                        
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
           // $MoveToHistory - move processed table to                                              
           //                  history                                                              
           //-------------------------------------------                                            
                                                                                                    
             begsr $MoveToHistory;                                                                  
                                                                                                    
              //  *****  Rename the file  *****                                                     
              // RNM OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              // NEWOBJ('SomeNewName.csv')                                                          
              // *like: November16_2011_114547.csv                                                  
                                                                                                    
                                                                                                    
                 nDays = %diff(today : baseDate : *days);                                           
                 ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);                                      
                                                                                                    
                 MyNewName = %trim(ReturnData)  +                                                   
                 %char(%subdt(Today:*days)) + '_' +                                                 
                 %char(%subdt(Today:*years)) + '_' +                                                
                 %ScanRpl('.' : '' :                                                                
                 %char(%time())) + '.csv';                                                          
                                                                                                    
                 cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +                                     
                             %trim(filename) + Q + ')' +                                            
                             ' NEWOBJ(' + Q + %trim(MyNewName) +                                    
                             Q + ')';                                                               
                                                                                                    
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
                                                                                                    
              //  *****  Move file to history  *****                                                
              // MOV OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              //  TODIR('/home/Reserve_Adjustments/history/')                                       
                                                                                                    
                 cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +                                     
                             %trim(MyNewName) + Q + ')' +                                           
                             ' TODIR(' + Q + %trim(PathName) + 'History/' +                         
                             Q + ')';                                                               
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
                                                                                                    
      /end-free                                                                                     
                                                                                                    
      *-------------------------------------------------------------                                
      *    RdIfsFil - Subprocedure To Read The IFS File                                             
      *-------------------------------------------------------------                                
     p RdIfsFil        B                   Export                                                   
     d RdIfsFil        PI           256A                                                            
     d  FileName                    256A   Const                                                    
     d CharsRead       S             10i 0                                                          
     d CurChar         S              1                                                             
     d Eof             C                   const(x'00')                                             
                                                                                                    
      /free                                                                                         
             Oflag = O_Rdonly + O_Textdata;                                                         
             // need whole path here                                                                
             File = %trim(FileName) + x'00';                                                        
             Fp = open(%addr(File): Oflag);                                                         
                                                                                                    
             if  Fp < 0;                                                                            
              Error_Flag = *On;                                                                     
              Return  Error_Flag;                                                                   
             Endif;                                                                                 
                                                                                                    
             R = 0;                                                                                 
             N = 0;                                                                                 
             dou  CurChar = Eof;                                                                    
              exsr getChar;                                                                         
              R+=1;                                                                                 
              %Subst(Data: R: 1) = CurChar;                                                         
                                                                                                    
              if CurChar = X'25';                                                                   
               %Subst(Data: R: 1)  = *blanks;                                                       
              endif;                                                                                
                                                                                                    
              select;                                                                               
               when  R = 256 or CurChar = X'25';                                                    
                                                                                                    
           // if you find the  code then we still have more data in                                 
           // memory  and we need to process that remaining data.                                   
                                                                                                    
                if  CurChar = X'25';                                                                
                 %Subst(Data: R: 1)  = *blanks;                                                     
                endif;                                                                              
                                                                                                    
            // one record is here                                                                   
                clear  R;                                                                           
                clear  Data;                                                                        
                                                                                                    
              endsl;                                                                                
             enddo;                                                                                 
                                                                                                    
             Return    Error_Flag;                                                                  
                                                                                                    
          //---------------------------------------------------------                               
          //  GetChar - Process IFS Record, One Character At A Time                                 
          //---------------------------------------------------------                               
             begsr GetChar;                                                                         
                                                                                                    
               //  If input buffer is empty, or all characters have been                            
               //    processed, refill the input buffer.                                            
              if N = CharsRead;                                                                     
               CharsRead = Read(Fp:%Addr(Data_Rec): 2560);                                          
               N = *Zero;                                                                           
              endif;                                                                                
                                                                                                    
               // Get the next character in the input buffer.                                       
              if CharsRead <= 0;                                                                    
               CurChar = Eof;                                                                       
              else;                                                                                 
               N+=1;                                                                                
               CurChar = %Subst(Data_Rec: N: 1);                                                    
               select;                                                                              
                when  CurChar = *blanks or CurChar = cr  or  CurChar = lf;                          
                 mydata.bighunkdata = %trim(mydata.bighunkdata) + '|';                              
                other;                                                                              
                 mydata.Bighunkdata = %trim(mydata.bighunkdata) +                                   
                 %trim(Curchar);                                                                    
                endsl;                                                                              
              endif;                                                                                
                                                                                                    
             endsr;                                                                                 
                                                                                                    
         //---------------------------------------------------------                                
      /end-free                                                                                     
                                                                                                    
     p RdIfsFil        E                                                                            
     H Option( *SrcStmt: *NoDebugIo )  BndDir( 'QC2LE' ) DFTACTGRP(*No)                             
     ‚**********************************************************************                        
     ‚* Project ID     Date  Pgmr ID  Rev  Description                                              
     ‚*                                                                                             
     ‚*            11/16/11  JJF       00  program written                                          
     ‚*              ** pulls .csv tables from directory:                                           
     ‚*                 /home/Reserve_Adjustments/                                                  
     ‚*                                                                                             
     ‚**********************************************************************                        
      *                                                                                             
      * Directory Entry Structure (dirent)                                                          
      *                                                                                             
     d p_dirent        s               *                                                            
     d dirent          ds                  based(p_dirent)                                          
     d   d_reserv1                   16A                                                            
     d   d_reserv2                   10U 0                                                          
     d   d_fileno                    10U 0                                                          
     d   d_reclen                    10U 0                                                          
     d   d_reserv3                   10I 0                                                          
     d   d_reserv4                    8A                                                            
     d   d_nlsinfo                   12A                                                            
     d     nls_ccsid                 10I 0 OVERLAY(d_nlsinfo:1)                                     
     d     nls_cntry                  2A   OVERLAY(d_nlsinfo:5)                                     
     d     nls_lang                   3A   OVERLAY(d_nlsinfo:7)                                     
     d     nls_reserv                 3A   OVERLAY(d_nlsinfo:10)                                    
     d   d_namelen                   10U 0                                                          
     d   d_name                     640A                                                            
                                                                                                    
      *------------------------------------------------------------                                 
      * Open a Directory                                                                            
      *------------------------------------------------------------                                 
     d opendir         pr              *   EXTPROC('opendir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Read Directory Entry                                                                        
      *------------------------------------------------------------                                 
     d readdir         pr              *   EXTPROC('readdir')                                       
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Close Directory                                                                             
      *------------------------------------------------------------                                 
     d closedir        pr              *   EXTPROC('closedir')                                      
     d  dirname                        *   VALUE                                                    
      *------------------------------------------------------------                                 
      * Open IFs table                                                                              
      *------------------------------------------------------------                                 
     d open            pr            10i 0   ExtProc('open')                                        
     d   filename                      *     value                                                  
     d   openflags                   10i 0   value                                                  
     d   mode                        10u 0   value options(*nopass)                                 
     d   codepage                    10u 0   value options(*nopass)                                 
      *------------------------------------------------------------                                 
      * Read IFS table                                                                              
      *------------------------------------------------------------                                 
     d read            pr            10i 0   ExtProc('read')                                        
     d   filehandle                  10i 0   value                                                  
     d   datareceived                  *     value                                                  
     d   nbytes                      10u 0   value                                                  
      *------------------------------------------------------------                                 
      * Close IFs table                                                                             
      *------------------------------------------------------------                                 
     d close           pr            10i 0   ExtProc('close')                                       
     d   filehandle                  10i 0   value                                                  
      *------------------------------------------------------------                                 
      * read ifs table  - internal procedure                                                        
      *------------------------------------------------------------                                 
     d RdIfsFil        pr           256a                                                            
     d  FileName                    256a   const                                                    
      *------------------------------------------------------------                                 
      * Delay - sleep function                                                                      
      *------------------------------------------------------------                                 
     d sleep           pr            10i 0 ExtProc( 'sleep' )                                       
     d  seconds                      10u 0 Value                                                    
      *------------------------------------------------------------                                 
      * Command - run a command                                                                     
      *------------------------------------------------------------                                 
     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    256                                                             
     d   length                      15  5                                                          
      *------------------------------------------------------------                                 
      * Grab the date in LongFormat                                                                 
      *------------------------------------------------------------                                 
     d CEEDATE         pr                  opdesc                                                   
     d   Lilian                      10i 0                                                          
     d   picture                  65535A   const options(*varsize)                                  
     d   OutputDate               65535A   const options(*varsize)                                  
     d   Feedback                    12a   options(*omit)                                           
      *------------------------------------------------------------                                 
      * a few local variables...                                                                    
                                                                                                    
     d BaseDate        s               d   inz(D'1582-10-14')                                       
     d cmdlength       s             15  5                                                          
     d cmdstring       s            256                                                             
     d count           s              3  0                                                          
     d cr              c                   Const(x'0D')                                             
     d data            s          65535A                                                            
     d Data_Rec        s          65535A                                                            
     d datasize        s              5  0                                                          
     d dh              s               *                                                            
     d Eol             c                   Const(x'0D25')                                           
     d Error_Flag      s              1A   INZ('0')                                                 
     d File            s            256                                                             
     d FileName        s            256    varying                                                  
     d FolderNames     s            256    dim(50)                                                  
     d Fp              s             10i 0                                                          
     d KeepLooping     s               n   inz('1')                                                 
     d lf              C                   Const(x'25')                                             
     d MyNewName       s            265    varying                                                  
     d N               s              5  0                                                          
     d nDays           s             10i 0                                                          
      * values for oflag parameter, used by open()                                                  
     d O_RDONLY        s             10i 0   inz(1)                                                 
     d O_TEXTDATA      s             10i 0   inz(16777216)                                          
                                                                                                    
     d Oflag           s             10i 0                                                          
     d Omode           s             10u 0                                                          
     d PathName        s             26                                                             
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d Rc              S             10i 0                                                          
     d ReturnData      s             12                                                             
     d SleepSeconds    s             10i 0 inz(1)                                                   
     d ta              s              3  0                                                          
     d Today           s               d   inz(*SYS)                                                
                                                                                                    
         // entire document stored in here                                                          
     d MyData          ds                  qualified  inz                                           
     d  bighunkdata               65535                                                             
     d   OneSlice                    60    dim(1000) overlay(bighunkdata:*next)                     
      *------------------------------------------------------                                       
      * MAIN LINE                                                                                   
      *------------------------------------------------------                                       
                                                                                                    
      /free                                                                                         
                                                                                                    
                // program will loop until outside force                                            
                // stops it.                                                                        
              dow KeepLooping;                                                                      
                                                                                                    
               exsr $GetFileName;                                                                   
               if ta > *zeros;                                                                      
                // read the tables one at a time                                                    
                for count = 1 to ta;                                                                
                 filename = foldernames(count);                                                     
                 Error_flag = rdifsfil(Filename);                                                   
                 //exsr $MoveToHistory;                                                             
                endfor;                                                                             
               endif;                                                                               
                                                                                                    
               // Delay job for a number of seconds then start                                      
               // the process all over again.                                                       
               sleep(SleepSeconds);                                                                 
                                                                                                    
              enddo;                                                                                
                                                                                                    
           *inlr = *on;                                                                             
                                                                                                    
           //-------------------------------------------                                            
           // $GetFileName - get the next csv table                                                 
           //-------------------------------------------                                            
             begsr $GetFileName;                                                                    
                                                                                                    
               clear filename;                                                                      
                // tables will hold all the names of the tables                                     
               clear TA;                                                                            
               clear folderNames;                                                                   
                                                                                                    
                // loop on the directory                                                            
                // Step1: Open up the directory.                                                    
               PathName = '/home/Reserve_Adjustments/';                                             
               dh = opendir(%addr(PathName));                                                       
               if dh <> *NULL;                                                                      
                                                                                                    
                // Step2: Read each entry from the directory (in a loop)                            
                p_dirent = readdir(dh);                                                             
                                                                                                    
                dow p_dirent <> *NULL;                                                              
                 if d_namelen < 256;                                                                
                  FileName = %subst(d_name:1:d_namelen);                                            
                  // process only csv files                                                         
                  // even MT directory contains folders:                                            
                  // o .                                                                            
                  // o ..                                                                           
                  if %scan('.csv':Filename) > *zeros;                                               
                   ta+=1;                                                                           
                   foldernames(ta) = %trim(pathname) + %trim(filename);                             
                  endif;                                                                            
                 endif;                                                                             
                  p_dirent = readdir(dh);                                                           
                enddo;                                                                              
               endif;                                                                               
                                                                                                    
               // Step3: Close the directory to reprocess                                           
               closedir(dh);                                                                        
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
           // $MoveToHistory - move processed table to                                              
           //                  history                                                              
           //-------------------------------------------                                            
                                                                                                    
             begsr $MoveToHistory;                                                                  
                                                                                                    
              //  *****  Rename the file  *****                                                     
              // RNM OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              // NEWOBJ('SomeNewName.csv')                                                          
              // *like: November16_2011_114547.csv                                                  
                                                                                                    
                                                                                                    
                 nDays = %diff(today : baseDate : *days);                                           
                 ceedate(nDays:'Mmmmmmmmmm':ReturnData:*OMIT);                                      
                                                                                                    
                 MyNewName = %trim(ReturnData)  +                                                   
                 %char(%subdt(Today:*days)) + '_' +                                                 
                 %char(%subdt(Today:*years)) + '_' +                                                
                 %ScanRpl('.' : '' :                                                                
                 %char(%time())) + '.csv';                                                          
                                                                                                    
                 cmdstring = 'RNM OBJ(' + Q + %trim(PathName) +                                     
                             %trim(filename) + Q + ')' +                                            
                             ' NEWOBJ(' + Q + %trim(MyNewName) +                                    
                             Q + ')';                                                               
                                                                                                    
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
                                                                                                    
              //  *****  Move file to history  *****                                                
              // MOV OBJ('/home/Reserve_Adjustments/May Claim Fees.csv')                            
              //  TODIR('/home/Reserve_Adjustments/history/')                                       
                                                                                                    
                 cmdstring = 'MOV OBJ(' + Q + %trim(PathName) +                                     
                             %trim(MyNewName) + Q + ')' +                                           
                             ' TODIR(' + Q + %trim(PathName) + 'History/' +                         
                             Q + ')';                                                               
                 cmdlength = %len(%trim(cmdstring));                                                
                 monitor;                                                                           
                  $command(cmdstring:cmdlength);                                                    
                 on-error;                                                                          
                  // process for errors                                                             
                 endmon;                                                                            
                                                                                                    
             endsr;                                                                                 
                                                                                                    
           //-------------------------------------------                                            
                                                                                                    
      /end-free                                                                                     
                                                                                                    
      *-------------------------------------------------------------                                
      *    RdIfsFil - Subprocedure To Read The IFS File                                             
      *-------------------------------------------------------------                                
     p RdIfsFil        B                   Export                                                   
     d RdIfsFil        PI           256A                                                            
     d  FileName                    256A   Const                                                    
     d CharsRead       S             10i 0                                                          
     d CurChar         S              1                                                             
     d Eof             C                   const(x'00')                                             
                                                                                                    
      /free                                                                                         
             Oflag = O_Rdonly + O_Textdata;                                                         
             // need whole path here                                                                
             File = %trim(FileName) + x'00';                                                        
             Fp = open(%addr(File): Oflag);                                                         
                                                                                                    
             if  Fp < 0;                                                                            
              Error_Flag = *On;                                                                     
              Return  Error_Flag;                                                                   
             Endif;                                                                                 
                                                                                                    
             R = 0;                                                                                 
             N = 0;                                                                                 
             dou  CurChar = Eof;                                                                    
              exsr getChar;                                                                         
              R+=1;                                                                                 
              %Subst(Data: R: 1) = CurChar;                                                         
                                                                                                    
              if CurChar = X'25';                                                                   
               %Subst(Data: R: 1)  = *blanks;                                                       
              endif;                                                                                
                                                                                                    
              select;                                                                               
               when  R = 256 or CurChar = X'25';                                                    
                                                                                                    
           // if you find the  code then we still have more data in                                 
           // memory  and we need to process that remaining data.                                   
                                                                                                    
                if  CurChar = X'25';                                                                
                 %Subst(Data: R: 1)  = *blanks;                                                     
                endif;                                                                              
                                                                                                    
            // one record is here                                                                   
                clear  R;                                                                           
                clear  Data;                                                                        
                                                                                                    
              endsl;                                                                                
             enddo;                                                                                 
                                                                                                    
             Return    Error_Flag;                                                                  
                                                                                                    
          //---------------------------------------------