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.




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;                                                                  
                                                                                                    
          //---------------------------------------------