     H NOMAIN EXPROPTS(*RESDECPOS)                                                                  
     H BNDDIR('QC2LE')                                                                              
      * PROGRAM - CHKIFS                                                                            
      * PURPOSE - verify that a full path table on iFS exists                                       
      * WRITTEN - 03/19/2020                                                                        
      * AUTHOR  - Jamie Flanary                                                                     
                                                                                                    
      /copy qprcsrc,COMMAND_CP                                                                      
      /copy qprcsrc,CHKIFS_CP                                                                       
                                                                                                    
     d DoesTableExist...                                                                            
     d                 s             10i 0 inz                                                      
     d ERROR_FLAG      s               n   inz                                                      
     d File_Exists...                                                                               
     d                 c                   Const(0)                                                 
     d MyUser          s             10    inz                                                      
     d MyPassword      s             10    inz                                                      
     d MySQlString     s            256    inz varying                                              
     d pointer         s               *                                                            
     d ProcessFlag     s              1    inz                                                      
     d Q               s              1    inz('''')                                                
     d Read_Authority...                                                                            
     d                 c                   Const(4)                                                 
     d RecordsInError  s             10i 0 inz                                                      
     d serverIp        s             15    inz('10.0.0.0')                                         
     d ThisFolder      s            100a   varying                                                  
     d ThisDrawing     s            100a   varying                                                  
     d  token          S            160A   varying                                                  
     d Write_Authority...                                                                           
     d                 c                   Const(2)                                                 
      *                                                                                             
     d access          pr            10i 0 ExtProc('access')                                        
     d  szIFSFile                      *   Value options(*STRING)                                   
     d  nAccessMode                  10i 0 value                                                    
                                                                                                    
      *                                                                                             
      * Begin Procedure                                                                             
      *                                                                                             
     p DoesThisTableExist...                                                                        
     P                 B                   export                                                   
      * Procedure Interface                                                                         
     d DoesThisTableExist...                                                                        
     d                 pi              n                                                            
     d Infullpath                  1000    varying                                                  
      *                                                                                             
     d RunSQLInsert    pr              n                                                            
     d  String                      256a   varying const                                            
      *                                                                                             
                                                                                                    
     dstrtok           PR              *   ExtProc('strtok')                                        
     d string                          *   value options(*string)                                   
     d delim                           *   Value Options(*string)                                   
      /free                                                                                         
                                                                                                    
              Exec Sql Set Option --Naming    = *Sys,                                               
                                    Commit    = *None,                                              
                                    SRTSEQ    = *LANGIDUNQ;                                         
                                                                                                    
                                                                                                    
              reset ProcessFlag;                                                                    
              // check the server first                                                             
              if %subst(infullpath:1:2) = '\\';                                                     
               //\\rbsc-dc02 remove the server                                                      
               infullpath = %subst(Infullpath:12);                                                  
               // delete overrides to FTP tables                                                    
               OneThousandLong = 'DLTOVR FILE(INPUT) LVL(*JOB)';                                    
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
               OneThousandLong = 'DLTOVR FILE(OUTPUT) LVL(*JOB)';                                   
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // delete the FTP tables                                                             
               OneThousandLong = 'DLTF FILE(QTEMP/INPUT)';                                          
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               OneThousandLong = 'DLTF FILE(QTEMP/OUTPUT)';                                         
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // create the ftp files                                                              
               OneThousandLong = 'CRTPF FILE(QTEMP/INPUT) ' +                                       
                                 ' RCDLEN(256)';                                                    
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // CRTDUPOBJ OBJ(OUTPUT) FROMLIB(*LIBL)                                              
               // OBJTYPE(*FILE) TOLIB(QTEMP) CST(*NO) TRG(*NO)                                     
               OneThousandLong = 'CRTDUPOBJ OBJ(OUTPUT) FROMLIB(*LIBL) ' +                          
                         'OBJTYPE(*FILE) TOLIB(QTEMP) CST(*NO) TRG(*NO)';                           
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // override  the input table                                                         
               OneThousandLong =                                                                    
                'OVRDBF FILE(INPUT) TOFILE(INPUT) OVRSCOPE(*JOB)';                                  
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // override  the output table                                                        
               OneThousandLong =                                                                    
                'OVRDBF FILE(OUTPUT) TOFILE(QTEMP/OUTPUT) OVRSCOPE(*JOB)';                          
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // populate the input file                                                           
               MySqlString = 'MyServerID   MyServerPassword';                                          
               RunSQLInsert(MYSqlString);                                                           
                                                                                                    
               // need to CD down to the table                                                      
               //seperate out the folders from the table                                            
               // finish in morning                                                                 
               pointer = strtok(%trim(InFullpath) : '\');                                           
               dow (pointer <> *null);                                                              
                token = %trim(%str(pointer));                                                       
                pointer = strtok(*null: '\');                                                       
                ThisFolder = %trim(token);                                                          
                // write to input here if we dont find a "." in the name                            
                if %scan('.':ThisFolder) = *zeros;                                                  
                 MySqlString = 'CD ' + ThisFolder;                                                  
                 RunSQLInsert(MYSqlString);                                                         
                endif;                                                                              
               enddo;                                                                               
               ThisDrawing = ThisFolder;                                                            
                                                                                                    
                                                                                                    
               // rename to itself as a test                                                        
               MySqlString = 'rename ' +Q+ThisDrawing+Q+'  ' +Q+ThisDrawing+Q;                      
               RunSQLInsert(MYSqlString);                                                           
                                                                                                    
               // rename to itself as a test                                                        
               MySQlString = 'quit';                                                                
               RunSQLInsert(MySqlString);                                                           
                                                                                                    
               // start FTP                                                                         
                                                                                                    
               OneThousandLong = 'FTP ' +Q + %trim(ServerIP) + Q;                                   
               monitor;                                                                             
                runcommand(OneThousandLong);                                                        
               on-error;                                                                            
               endmon;                                                                              
                                                                                                    
               // sql the output table looking for total failure                                    
               // 550 The system cannot find the file specified.                                    
               reset RecordsInError;                                                                
               exec sql                                                                             
               select coalesce(count(*),0)                                                          
                 into :RecordsInError                                                               
                 FROM output                                                                        
                 where substr(outputtext,1,3) = '550' ;                                             
                                                                                                    
               // set error flag if error found                                                     
               if recordsInError > *zeros;                                                          
                DoesTableExist = 999;                                                               
               else;                                                                                
                DoesTableExist = 0;                                                                 
               endif;                                                                               
                                                                                                    
              else;                                                                                 
               // validate the IFS                                                                  
               DoesTableExist =                                                                     
                access(infullpath : File_Exists);                                                   
              endif;                                                                                
                                                                                                    
              //                                                                                    
              //       *   F_OK = File Exists                                                       
              //       *   R_OK = Read Access                                                       
              //       *   W_OK = Write Access                                                      
              //       *   X_OK = Execute or Search                                                 
              //       **********************************************************************       
              //      D F_OK            C                   0                                       
              //      D R_OK            C                   4                                       
              //      D W_OK            C                   2                                       
              //      D X_OK            C                   1                                       
              //                                                                                    
                                                                                                    
              if DoesTableExist = *zeros;                                                           
                ProcessFlag = *off;                                                                 
               else;                                                                                
                ProcessFlag = *on;                                                                  
              endif;                                                                                
                                                                                                    
              return  ProcessFlag;                                                                  
      /end-free                                                                                     
     p DoesThisTableExist...                                                                        
     p                 e                                                                            
      *-------------------------------------------------------------                                
      *    ReadIFSTable - Subprocedure To Read The IFS File                                         
      *-------------------------------------------------------------                                
     p RunSQLInsert    b                   export                                                   
     d RunSQLInsert    pi              n                                                            
     d  InputString                 256a   varying const                                            
                                                                                                    
     d Erro_Flag       s               n   inz                                                      
                                                                                                    
           reset Error_Flag;                                                                        
                                                                                                    
           exec sql                                                                                 
            insert into input                                                                       
            values(:MySQLString);                                                                   
                                                                                                    
           Return  Error_Flag;                                                                      
                                                                                                    
      *---------------------------------------------------------                                    
     p RunSQLInsert    E                                                                            
