Announcement

**jamief** · December 14, 2018, 08:02 AM

start with placing a NEP (Never ending program) in a subsystem -- I would make sure that the subsystem autostarts the job...

Look to program below (I have attached ) for code on reading IFS document.
Look Specifically @ $GetFileName

PHP Code:



     H DFTACTGRP(*NO) BNDDIR('QC2LE')                                                              
      *================================================================                            
      *                                                                                            
      *   Add CERIDIAN to library list to compile                                                  
      *                                                                                            
      *  This program reads a directory:                                                            
      *  pathname ==> '/home/HR/ceridian/xxxxxxx.csv'                                              
      *                                                                                            
      *================================================================                            
     fhreempma  uf a e           k disk                                                            
     fhrfempda  uf a e           k disk                                                            
     fhrgemppa  uf a e           k disk                                                            
     fhriwkpra  uf   e           k disk    usropn                                                  
     fhrrwkpra  if a e           k disk                                                            
     fhrujbtla  if   e           k disk                                                            
     fhrvtitla  uf a e           k disk                                                            
     fceridianp o    e             printer oflind(*in70)  usropn                                    
     femployees o    e           k disk    usropn                                                  
      *                                                                                            
      **************************************************************************                    
    * * Prototypes and definitions for working with the IFS                                        
      **************************************************************************                    
      *                                                                                            
      *  open -- open an IFS file                                                                  
      *                                                                                            
     D open            pr            10i 0   ExtProc('open')                                        
     D   filename                      *     value options(*string)                                
     D   openflags                   10i 0   value                                                  
     D   mode                        10u 0   value options(*nopass)                                
     D   codepage                    10u 0   value options(*nopass)                                
      * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =                                
      *  read -- read an IFS file                                                                  
      *                                                                                            
     D read            pr            10i 0   ExtProc('read')                                        
     D   filehandle                  10i 0   value                                                  
     D   datareceived                  *     value                                                  
     D   nbytes                      10u 0   value                                                  
      * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =                                
      * values for oflag parameter, used by open()                                                  
     D O_RDONLY        s             10i 0   inz(1)                                                
     D O_TEXTDATA      s             10i 0   inz(16777216)                                          

      * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =                                
     d opendir         PR              *   EXTPROC('opendir')                                      
     d  dirname                        *   VALUE                                                    

     D readdir         PR              *   EXTPROC('readdir')                                      
     D  dirp                           *   VALUE                                                    

     D CloseDir        PR              *   ExtProc('closedir')                                      
     D  pdirectory                     *   Value                                                    

     D rename          PR            10I 0 ExtProc('Qp0lRenameUnlink')                              
     D   old                           *   Value options(*string)                                  
     D   new                           *   Value options(*string)                                  

     d altx            s              5  0                                                          
     d bighunkdata     s          65535a                                                            
     d changedrecorde  s               n                                                            
     d changedrecordf  s               n                                                            
     d changedrecordg  s               n                                                            
     d chr5            s              5                                                            
     d cmdstring       s            512                                                            
     d cmdlength       s             15  5                                                          
     d count           s              3  0                                                          
     d cr              C                   Const(x'0D')                                            
     d CRLF            c                   x'0d25'                                                  
     d data            s          65535A                                                            
     d Data_Rec        S          65535A                                                            
     d day             s              2                                                            
     d dh              S               *                                                            
     d emperror        s            256                                                            
     d end             s              3  0                                                          
     d Eol             C                   Const(x'0D25')                                          
     d Error_Flag      S              1A   INZ('0')                                                
     d errortotal      s              5  0                                                          
     d File            S             50                                                            
     d FileName        S             50                                                            
     d firstname       s             30                                                            
     d foundprimary    s               n                                                            
     d fnd             s              3  0                                                          
     d Fp              S             10i 0                                                          
     d isobirthday     s               d                                                            
     d isodatechar     s             10                                                            
     d keydate         s              7  0                                                          
     d lastname        s             30                                                            
     d len             s              5  0                                                          
     d LenStr          s              4  0                                                          
     d lf              C                   Const(x'25')                                            
     d Lo              c                   CONST('abcdefghijklmnopqrstuvwxyz')                      
     d month           s              2                                                            
     d mymessage       s            256A   varying                                                  
     d N               S              5  0                                                          
     d Name            S           2000A                                                            
     d newemployee     s               n                                                            
     d newname         S             50                                                            
     d Numberoffields  s              5  0                                                          
     d Oflag           S             10i 0                                                          
     d outstamp        s             26                                                            
     d PathName        S           2000A                                                            
     d ProgramEnd      s               n                                                            
     d Q               s              1    inz('''')                                                
     d R               S              5  0                                                          
     d reserve         s              9  2                                                          
     d retired         s               n                                                            
     d saving          s              9  2                                                          
     d sqldata3        s           2000                                                            
     d sqlstmt         s          23000    varying                                                  
     d sqlstmt2        s          23000    varying                                                  
     d sqlstmt3        s          23000    varying                                                  
     d str             s              5  0                                                          
     d tdat6           s              6  0                                                          
     d Terminated      s               n                                                            
     d Up              c                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')                      
     d UpperRace       s             15                                                            
     d workdate        s             10                                                            
     d workiso         s               d                                                            
     d workparttime    s              1    inz('N')                                                
     d workphone       s             10  0                                                          
     d workstamp       s               z                                                            
     d workrace        s              1                                                            
     d Worktitle       s             40                                                            
     d writeheader     s               n   inz('1')                                                
     d x               s              3  0                                                          
     d year            s              4                                                            
      *                                                                                            
      * 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                                                            

      *--------------------------------------------------------------------                        
      * Write to a file                                                                            
      *                                                                                            
      * ssize_t write(int fildes, const void *buf, size_t bytes)                                    
      *--------------------------------------------------------------------                        
     D write           PR            10I 0 ExtProc('write')                                        
     D  fildes                       10i 0 value                                                    
     D  buf                            *   value                                                    
     D  bytes                        10U 0 value                                                    

      *--------------------------------------------------------------------                        
      * Remove Link to File.  (Deletes Directory Entry for File, and if                            
      *    this was the last link to the file data, the file itself is                              
      *    also deleted)                                                                            
      *                                                                                            
      * int unlink(const char *path)                                                                
      *--------------------------------------------------------------------                        
     D unlink          PR            10I 0 ExtProc('unlink')                                        
     D   path                          *   Value options(*string)                                  

      **********************************************************************                        
      *  Flags for use in open()                                                                    
      *                                                                                            
      * More than one can be used -- add them together.                                            
      **********************************************************************                        
     D O_WRONLY        C                   2                                                        
     D O_RDWR          C                   4                                                        
     D O_CREAT         C                   8                                                        
     D O_EXCL          C                   16                                                      
     D O_CCSID         C                   32                                                      
     D O_TRUNC         C                   64                                                      
     D O_APPEND        C                   256                                                      
     D O_SYNC          C                   1024                                                    
     D O_DSYNC         C                   2048                                                    
     D O_RSYNC         C                   4096                                                    
     D O_NOCTTY        C                   32768                                                    
     D O_SHARE_RDONLY  C                   65536                                                    
     D O_SHARE_WRONLY  C                   131072                                                  
     D O_SHARE_RDWR    C                   262144                                                  
     D O_SHARE_NONE    C                   524288                                                  
     D O_CODEPAGE      C                   8388608                                                  
      **********************************************************************                        
      * My own special MODE shortcuts for open() (instead of those above)                          
      **********************************************************************                        
     D M_RDONLY        C                   const(292)                                              
     D M_RDWR          C                   const(438)                                              
     D M_RWX           C                   const(511)                                              
      *                                                                                            
      * Program Info                                                                                
      *                                                                                            
     d                SDS                                                                          
     d  @PGM                   1     10                                                            
     d  @PARMS                37     39  0                                                          
     d  @MSGDTA               91    170                                                            
     d  @MSGID               171    174                                                            
     d  @JOB                 244    253                                                            
     d  @USER                254    263                                                            
     d  @JOB#                264    269  0                                                          
     D  PDSDAT               276    281  0                                                          
     D  PDSDATC              276    281                                                            

     D                 ds                                                                          
     D mmddyy                  1      6  0                                                          
     d mmdd                    1      4  0                                                          
     d yy                      5      6  0                                                          
     d today                  11     17  0                                                          
     d xcyy                   11     13  0                                                          
     d xmmdd                  14     17  0                                                          

     d sqldata       e ds                  extname(employees)  inz qualified                        
     d sqldata2      e ds                  extname(savings)  inz qualified                          
      *                                                                                            
     d openList        pr                                                                          
     d FetchNext       pr              n                                                            
     d closeList       pr                                                                          
      *                                                                                            
     d openList2       pr                                                                          
     d FetchNext2      pr              n                                                            
     d closeList2      pr                                                                          
      *                                                                                            
     d openList3       pr                                                                          
     d FetchNext3      pr              n                                                            
     d closeList3      pr                                                                          

     d CeridianDS      ds                  dtaara('CERIDIAN')                                      
     d  CeridianStamp                26                                                            

      //                                                                                            
      //  external called programs                                                                  
      //                                                                                            

     d $command        pr                  extpgm('QCMDEXC')                                        
     d   command                    512                                                            
     d   Length                      15  5                                                          

     d sleep           pr            10i 0 ExtProc( 'sleep' )                                      
     d  seconds                      10u 0 Value                                                    

     d chgdept         pr                  extpgm('HRS09C8')                                        
     d   pmemp#                       5  0                                                          
     d   pmname                      24                                                            
     d   pdsdatc                      6                                                            

     d termed          pr                  extpgm('HRS09C9')                                        
     d   pmemp#                       5  0                                                          
     d   pmname                      24                                                            
     d   tdat6                        6  0                                                          

      /free                                                                                        

              exsr Hskpg;                                                                          
              cmdstring = 'ADDLIBLE CERIDIAN';                                                      
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

       //---------------------------------------------------------                                  
       // MAIN  LINE                                                                                
       //---------------------------------------------------------                                  

            dou ProgramEnd = *On;                                                                  

             // close the directory...                                                              
             pathname =  '/home/HR/ceridian/'  + %trim(x'00') ;                                    
             dh = closedir(%addr(PathName));                                                        

             if  %diff(%timestamp():workstamp:*hours) < 1;                                          
              exsr $GetFileName;                                                                    
              sleep(120);                                                                          

             else;                                                                                  
              In *Lock ceridianDS;                                                                  
              ceridianstamp = %char(%timestamp);                                                    
              Out ceridianDS;                                                                      
              Unlock ceridianDS;                                                                    
              exsr $resubmit;                                                                      
              leave;                                                                                

             endif;                                                                                

            enddo;                                                                                  

            *inlr = *on;                                                                            

        //---------------------------------------------                                            
        // $checkfile - check for qualified file names                                              
        //---------------------------------------------                                            
             begsr $checkfile;                                                                      

             // If user entered an IFS path into the screen field, read that file                  
             If FileName > *blanks;                                                                

              if Error_Flag =  '1';                                                                
            // Then Error                                                                          
              else;                                                                                
               select;                                                                              
                // Expects that savings/reserve file is .csv                                        
                when %scan('.CSV' : %xlate(lo:up:Filename)) > *zeros and                            
                     %scan('SAVING': %xlate(lo:up:filename)) > *zeros;                              
                 exsr $savings;                                                                    

                // LBI Nightly file is .csv                                                        
                // This is a dump of *ALL employees and can be run every time                      
                // and for that matter many times over...                                          
                // current file employees in library ceridian is cleared                            
                // temperary file is created/cleared in QTEMP                                      
                // text file is processed and data is validated                                    
                // against HREEMPM and only *CHANGED data will be written to                        
                // Ceridian/employees table.                                                        
                when %scan('.CSV' :%xlate(lo:up:Filename)) > *zeros and                            
                     %scan('NIGHT': %xlate(lo:up:filename)) > *zeros;                              
                 exsr $employees;                                                                  

                // Ceridian/GL Bonus file                                                          
                when %scan('.TXT' :%xlate(lo:up: Filename)) > *zeros and                            
                     %scan('PRGLB': %xlate(lo:up:filename)) > *zeros;                              
                 exsr $GLB;                                                                        

                // Ceridian/GL file                                                                
                when %scan('.TXT' :%xlate(lo:up: Filename)) > *zeros and                            
                     %scan('PRGL': %xlate(lo:up:filename)) > *zeros;                                
                 exsr $GL;                                                                          

                // Expects that vacation is .csv                                                    
                when %scan('.CSV' : %xlate(lo:up:Filename)) > *zeros and                            
                     %scan('VACATION': %xlate(lo:up:filename)) > *zeros;                            
                 exsr $vacation;                                                                    

                // Expects that QTR Bonus information is .csv                                      
                when %scan('.CSV' : %xlate(lo:up:Filename)) > *zeros and                            
                     %scan('BONUS': %xlate(lo:up:filename)) > *zeros;                              
                 exsr $bonus;                                                                      

               endsl;                                                                              
              endif;                                                                                

             endif;                                                                                

             endsr;                                                                                

        //---------------------------------------------                                            
        // $savings - process savings & reserve                                                    
        //---------------------------------------------                                            
             begsr $savings;                                                                        

               if %open(ceridianp);                                                                
                close ceridianp;                                                                    
               endif;                                                                              

               cmdstring = 'OVRPRTF FILE(CERIDIANP) OUTQ(PDFEMAIL)' ;                              
               cmdlength = %len(%trim(cmdstring));                                                  
               monitor;                                                                            
                $command(cmdstring:cmdlength);                                                      
               on-error;                                                                            
               endmon;                                                                              

               if not%open(ceridianp);                                                              
                open ceridianp;                                                                    
               endif;                                                                              

               workTitle = 'Savings &  Reserve';                                                    
               LenStr =                                                                            
               ((%len(workTitle) - %len(%trim(workTitle))) / 2) + 1;                                
               %subst(P1TITLE:LenStr) = %trim(workTitle);                                          
               p1program = @pgm;                                                                    

              //                                                                                    
              // CPYFRMIMPF FROMSTMF('/home/HR/ceridian/Savings-Reserve 070210.csv')                
              // TOFILE(CERIDIAN/SAVINGS) RCDDLM(*CRLF)                                            
              //                                                                                    

                 exsr $ErrorSetup;                                                                  
                 cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q  +                                          
                            %trim(filename) + Q + ') ' +                                            
                            ' TOFILE(CERIDIAN/SAVINGS) RCDDLM(*CRLF) ' +                            
                            ' MBROPT(*REPLACE) ERRRCDFILE(QTEMP/SOURCE ERRORS)';                    
                  cmdlength = %len(%trim(cmdstring));                                              
                  monitor;                                                                          
                   $command(cmdstring:cmdlength);                                                  
                  on-error;                                                                        
                   exsr $CheckErrors;                                                              
                  endmon;                                                                          

                  reset writeheader;                                                                
                  clear t1savings;                                                                  
                  clear t1reserve;                                                                  

                   // write records to table hrrwkpra                                              
                   // check for duplicates                                                          

                  sqlstmt2 = 'select * from savings ';                                              
                  openList2();                                                                      
                  dow fetchNext2();                                                                
                   //                                                                              
                   // setup report                                                                  
                   //                                                                              
                   if p1fdate = *zeros;                                                            
                    p1fdate = %dec(sqldata2.date:*mdy);                                            
                   endif;                                                                          

                   select;                                                                          
                    when sqldata2.code = 'SAVE';                                                    
                     clear reserve;                                                                
                     saving = sqldata2.amount;                                                      
                    when sqldata2.code = 'EQUIP' or                                                
                         sqldata2.code = 'RESER' or                                                
                         sqldata2.code = 'OFFST';                                                  
                     clear saving;                                                                  
                     reserve = sqldata2.amount;                                                    
                    other;                                                                          
                     clear saving;                                                                  
                     clear reserve;                                                                
                    endsl;                                                                          
                   keydate = %dec(sqldata2.date:*cymd);                                            
                   clear P1Note;                                                                    
                   chain (keydate: sqldata2.clock#: saving : reserve) hrrwkpra;                    
                   if not%found(hrrwkpra);                                                          
                    HREMP# = sqldata2.clock#;                                                      
                    HRTDAT = keydate;                                                              
                    HRSAV  = saving;                                                                
                    HRRES  = reserve;                                                              
                    HRIMP  = *zeros;                                                                
                    write hrrwkprr;                                                                
                   else;                                                                            
                    p1note = '***duplicate record -  not added***';                                
                   endif;                                                                          

                   if *in70 or writeheader = *on;                                                  
                    write header;                                                                  
                    writeheader = *off;                                                            
                    *in70 = *off;                                                                  
                   endif;                                                                          

                   // populate the detail record                                                    
                   p1clock# = sqldata2.clock#;                                                      
                   p1code = sqldata2.code;                                                          
                   p1savings = saving;                                                              
                   p1reserve = reserve;                                                            

                   write detail;                                                                    
                   t1savings += p1savings;                                                          
                   t1reserve += p1reserve;                                                          

                  enddo;                                                                            
                  closeList2();                                                                    
                  write total;                                                                      
                  write endrpt;                                                                    
                  if %open(ceridianp);                                                              
                   close ceridianp;                                                                
                  endif;                                                                            

                   //                                                                              
                   // rename to CMP. (complete) This will cause it not to  be reprocessed          
                   //                                                                              
                   newname =                                                                        
                   %replace('.cmp' : name:                                                          
                   %scan('.CSV':%xlate(lo:up:name)) :4);                                            

                   cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q +                              
                               ') NEWOBJ(' + Q + %trim(newname) + Q + ')';                          
                   cmdlength = %len(%trim(cmdstring));                                              
                   monitor;                                                                        
                    $command(cmdstring:cmdlength);                                                  
                   on-error;                                                                        
                  endmon;                                                                          

             endsr;                                                                                

        //---------------------------------------------                                            
        // $employees - process ceridian employee file                                              
        //---------------------------------------------                                            
             begsr $employees;                                                                      

              if %open(ceridianp);                                                                  
               close ceridianp;                                                                    
              endif;                                                                                

              if %open(employees);                                                                  
               close employees;                                                                    
              endif;                                                                                

              if %open(hriwkpra);                                                                  
               close hriwkpra;                                                                      
              endif;                                                                                

              cmdstring = 'OVRPRTF FILE(CERIDIANP) OUTQ(PDFEMAIL)' ;                                
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

              if not%open(ceridianp);                                                              
               open ceridianp;                                                                      
              endif;                                                                                

              cmdstring = 'OVRDBF FILE(HRIWKPRA) MBR(LBI_SALARY)' ;                                
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

              if not%open(hriwkpra);                                                                
               open hriwkpra;                                                                      
              endif;                                                                                

              workTitle = 'Changed Employees  - ' + %char(%date());                                
              LenStr =                                                                              
              ((%len(workTitle) - %len(%trim(workTitle))) / 2) + 1;                                
              %subst(P1TITLE:LenStr) = %trim(workTitle);                                            

              //                                                                                    
              //  CRTDUPOBJ OBJ(EMPLOYEES) FROMLIB(CERIDIAN) OBJTYPE(*FILE) TOLIB(QTEMP)            
              //                                                                                    

              cmdstring = 'CRTDUPOBJ OBJ(EMPLOYEES) FROMLIB(CERIDIAN)' +                            
                          ' OBJTYPE(*FILE) TOLIB(QTEMP)';                                          
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

              // clear the file it is already in QTEMP                                              
              cmdstring = 'CLRPFM QTEMP/EMPLOYEES';                                                
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

              if not%open(employees);                                                              
               open employees;                                                                      
              endif;                                                                                

              //                                                                                    
              // CPYFRMIMPF FROMSTMF('/home/HR/ceridian/LBI Nightly 0630.csv')                      
              // TOFILE(QTEMP/EMPLOYEES) RCDDLM(*CRLF)                                              
              //                                                                                    

              exsr $ErrorSetup;                                                                    
              cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q  +                                            
                           %trim(filename) + Q + ') ' +                                            
                           ' TOFILE(QTEMP/EMPLOYEES) RCDDLM(*CRLF)' +                              
                           ' RPLNULLVAL(*FLDDFT)  MBROPT(*REPLACE) ' +                              
                           '  ERRRCDFILE(QTEMP/SOURCE ERRORS)';                                    
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
               exsr $CheckErrors;                                                                  
              endmon;                                                                              

              sqlstmt = 'select * from qtemp/employees ' +                                          
              ' ORDER BY EMP#' ;                                                                    

              reset writeheader;                                                                    
              openList();                                                                          
              dow fetchNext();                                                                      

               // knock off the plus 4                                                              
               if %len(%trim(%editc(sqldata.zipcode:'X'))) > 5 and                                  
                  %subst(%editc(sqldata.zipcode:'X'):1:4) <> '0000';                                
                sqldata.zipcode =                                                                  
                %dec(%subst(%editc(sqldata.zipcode:'X'):1:5):5:0);                                  
               endif;                                                                              

               if sqldata.emp# < 90000;                                                            
                reset changedrecorde;                                                              
                reset newemployee;                                                                  
                reset terminated;                                                                  
                reset retired;                                                                      
                clear hreempmr;                                                                    

                // Clear fields in printfile to indicate *changes                                  
                clear p1namec;                                                                      
                clear p1addressc;                                                                  
                clear p1hired;                                                                      
                clear p1termed;                                                                    
                clear p1paytype;                                                                    
                clear p1statusc;                                                                    
                clear p1phonec;                                                                    
                clear p1ss#c;                                                                      
                clear p1deptc;                                                                      
                clear p1suprc;                                                                      
                clear p1user1c;                                                                    
                clear p1shiftc;                                                                    
                clear p1typec;                                                                      
                clear p1gender;                                                                    
                clear p1mstatus;                                                                    
                clear p1mstatusc;                                                                  
                clear p1race;                                                                      
                clear p1bdate;                                                                      
                clear p1jtitlec;                                                                    
                clear p1jtitle;                                                                    
                clear p1partimc;                                                                    
                clear p1partim;                                                                    

              // converting ceridian character birthdate to iso                                    

                workdate = sqldata.birthdate;                                                      

                clear month;                                                                        
                clear day;                                                                          
                str = 1;                                                                            
                clear fnd;                                                                          
                clear end;                                                                          

                fnd = %scan('/':workdate:str);                                                      
                dow fnd > *zeros;                                                                  
                 select;                                                                            
                  when month = *blanks;                                                            
                   end = fnd-1;                                                                    
                   month = %subst(workdate:1:end);                                                  
                    if %len(%trim(month)) = 1;                                                      
                     month = '0' + %trim(month);                                                    
                   endif;                                                                          
                  when day = *blanks;                                                              
                   len = (fnd - str);                                                              
                   day = %subst(workdate:str:len);                                                  
                   if %len(%trim(day)) = 1;                                                        
                    day = '0' + %trim(day);                                                        
                   endif;                                                                          
                 endsl;                                                                            
                 str = fnd+1;                                                                      
                 fnd = %scan('/':workdate:str);                                                    
                enddo;                                                                              
                year = %subst(workdate:str:4);                                                      
                isodatechar = year + '-' + month + '-' + day;                                      
                isobirthday = %date(isodatechar);                                                  

               // shift can only be 1,2 or 3 if anything else make '1'                              
                if sqldata.shift <> '1' and                                                        
                   sqldata.shift <> '2' and                                                        
                   sqldata.shift <> '3';                                                            
                 sqldata.shift = '1';                                                              
                endif;                                                                              

                chain(n) (sqldata.emp#) hreempma;                                                  
                if %found(hreempma);                                                                
                 // record already exists check for changes                                        

                 // check last name only  ex.. Jamie, Flanary J.                                    
                 lastname = %subst(hename:1:%scan(',':hename)-1);                                  
                 monitor;                                                                          
                  firstname =  %trimL(%subst(hename:%scan(',':hename)+1));                          
                 on-error;                                                                          
                  clear firstname;                                                                  
                 endmon;                                                                            
                 if %trim(sqldata.suffix) <> '(none)';                                              
                  sqldata.lastname = %trim(sqldata.lastname) +                                      
                             ' ' + %trim(%xlate('.':' ':                                            
                             sqldata.suffix));                                                      
                 endif;                                                                            
                 if %xlate(lo:up:lastname) <> %xlate(lo:up:sqldata.lastname) or                    
                  (%xlate(lo:up:firstname) <> %xlate(lo:up:sqldata.firstname)                      
                  and firstname <> *blanks and %subst(hename:24:1) = ' ');                          
                  changedrecorde = *on;                                                            
                  p1namec = '*';                                                                    
                 endif;                                                                            
                 // address #1                                                                      
                 if %xlate(lo:up:headd1) <> %xlate(lo:up:sqldata.street1);                          
                  changedrecorde = *on;                                                            
                  p1addressc = '*';                                                                
                 endif;                                                                            
                 // address #2                                                                      
                 if %xlate(lo:up:headd2) <> %xlate(lo:up:sqldata.street2);                          
                  changedrecorde = *on;                                                            
                  p1addressc = '*';                                                                
                 endif;                                                                            
                 // city                                                                            
                 if %xlate(lo:up:hecity) <> %xlate(lo:up:sqldata.city);                            
                  changedrecorde = *on;                                                            
                  p1addressc = '*';                                                                
                 endif;                                                                            
                 // state                                                                          
                 if %xlate(lo:up:hest) <> %xlate(lo:up:sqldata.state);                              
                  changedrecorde = *on;                                                            
                  p1addressc = '*';                                                                
                 endif;                                                                            
                 // zipcode                                                                        
                 if hezip <> sqldata.zipcode;                                                      
                  changedrecorde = *on;                                                            
                  p1addressc = '*';                                                                
                 endif;                                                                            
                 // phone                                                                          
                 workphone = %dec(%char(hearea) + %char(hephon):10:0);                              
                 if workphone <>  sqldata.phone;                                                    
                  changedrecorde = *on;                                                            
                  p1phonec = '*';                                                                  
                 endif;                                                                            
                 // ss#                                                                            
                 if hess# <>  sqldata.ss#;                                                          
                  changedrecorde = *on;                                                            
                  p1ss#c = '*';                                                                    
                 endif;                                                                            

                else;     // new employee                                                          
                 newemployee = *on;                                                                
                 p1hired = '$';                                                                    
                endif;                                                                              

                // if new employee --or-- record changed then write record to HREEMPM              
                if changedrecorde or newemployee;                                                  
                 clear hreempmr;                                                                    
                 chain (sqldata.emp#) hreempma;                                                    
                 HENAME     =  %trim(sqldata.lastname) + ', ' +                                    
                               %trim(sqldata.firstname);                                            
                 HEADD1     =  sqldata.street1;                                                    
                 HEADD2     =  sqldata.street2;                                                    
                 HECITY     =  sqldata.city;                                                        
                 HEST       =  sqldata.state;                                                      
                 HEZIP      =  sqldata.zipcode;                                                    
                 HEAREA     =  %dec(%subst(%editc(sqldata.phone:'X'):1:3):3:0);                    
                 HEPHON     =  %dec(%subst(%editc(sqldata.phone:'X'):4:7):7:0);                    
                 HESS#      =  sqldata.ss#;                                                        

                 select;                                                                            
                  when  newemployee;                                                                
                   HEEMP# =  sqldata.emp#;                                                          
                   HEEMPT = 'E';                                                                    
                   write HREEMPMR;                                                                  
                  other;   // changedrecord                                                        
                   update HREEMPMR;                                                                
                 endsl;                                                                            

                endif;                                                                              

                // status, hire date, term date, department                                        
                // supervisor, leadman and shift must be checked                                    
                // rate type must be checked  (Sex, Race, Marital Status)                          
                reset changedrecordf;                                                              
                reset changedrecordg;                                                              
                chain (sqldata.emp#) hrgemppa;                                                      
                if %found(hrgemppa);                                                                
                  // part time - y or n                                                            
                  reset workparttime;                                                              
                  if sqldata.ptstatus <> 'F';                                                      
                   workparttime = 'Y';                                                              
                  endif;                                                                            
                  if workparttime <> hgpttm;                                                        
                   hgpttm = workparttime;                                                          
                   p1partimc = '*';                                                                
                   changedrecordG = *on;                                                            
                  endif;                                                                            

                 if sqldata.paytype <> *blanks and                                                  
                    sqldata.paytype <> hgratt;                                                      
                  HGRATT = sqldata.paytype;                                                        
                  changedrecordG = *on;                                                            
                  p1typec = '*';                                                                    
                  if HGRATT = 'H';                                                                  
                   chain (sqldata.emp#) hriwkpra;                                                  
                   if %found(hriwkpra);                                                            
                    delete hriwkprr;                                                                
                   endif;                                                                          
                  endif;                                                                            
                 endif;                                                                            

                 if changedrecordG = *on;                                                          
                  update hrgemppr;                                                                  
                 endif;                                                                            
                endif;                                                                              

                // race - ceridian sends full description we keep code                              
                clear workrace;                                                                    
                upperRace = %xlate(lo:up:sqldata.race);                                            
                select;                                                                            
                 when %scan('ASIAN':UpperRace) > *zeros;                                            
                  workrace = 'A';                                                                  
                 when %scan('BLACK':UpperRace) > *zeros;                                            
                  workrace = 'B';                                                                  
                 when %scan('WHITE':UpperRace) > *zeros;                                            
                  workrace = 'W';                                                                  
                 when %scan('HISPANIC':UpperRace) > *zeros;                                        
                  workrace = 'H';                                                                  
                 when %scan('INDIAN':UpperRace) > *zeros;                                          
                  workrace = 'I';                                                                  
                 when %scan('HAWAIIAN':UpperRace) > *zeros;                                        
                  workrace = 'P';                                                                  
                 when %scan('TWO':UpperRace) > *zeros;                                              
                  workrace = 'T';                                                                  
                 other;                                                                            
                  workrace = 'U';                                                                  
                endsl;                                                                              

                chain(n) (sqldata.emp#) hrfempda;                                                  
                if %found(hrfempda);                                                                
                 x = %scan(' ':hfuser1);                                                            
                 if x = 1;                                                                          
                  altx = 0;                                                                        
                 else;                                                                              
                  altx = %dec(%subst(hfuser1:1:X-1):5:0);                                          
                 endif;                                                                            
                 if HFDPT1 <> sqldata.department;                                                  
                  changedrecordf = *on;                                                            
                  p1deptc = '*';                                                                    
                  chain (hfemp#) hriwkpra;                                                          
                  if %found(hriwkpra);                                                              
                   eval hidpt1 = sqldata.department;                                                
                   update hriwkprr;                                                                
                  endif;                                                                            
                 endif;                                                                            
                 if HFSUPRNMBR <> sqldata.supervisor;                                              
                  changedrecordf = *on;                                                            
                  p1suprc = '*';                                                                    
                 endif;                                                                            
                 if HFHDAT <> %dec(sqldata.hiredate:*cymd);                                        
                  changedrecordf = *on;                                                            
                  p1hired = '*';                                                                    
                 endif;                                                                            
                 if HFTDAT <> %dec(sqldata.termdate:*cymd) and                                      
                    %dec(sqldata.termdate:*cymd) <> 0650824;                                        
                  changedrecordf = *on;                                                            
                  p1termed = '*';                                                                  
                 endif;                                                                            
                 if (HFACTS = 'N' and                                                              
                     %xlate(lo:up:sqldata.status) = 'ACTIVE') or                                    
                    (HFACTS = 'Y' and                                                              
                     %xlate(lo:up:sqldata.status) = 'TERMINATED') or                                
                    (HFACTS = 'Y' and                                                              
                     %xlate(lo:up:sqldata.status) = 'DISABLED') or                                  
                    (HFACTS = 'Y' and                                                              
                     %xlate(lo:up:sqldata.status) = 'RETIRED');                                    
                  changedrecordf = *on;                                                            
                  p1statusc = '*';                                                                  
                 endif;                                                                            
                 if altx <> sqldata.alternant;                                                      
                  p1user1c = '*';                                                                  
                  changedrecordf = *on;                                                            
                 endif;                                                                            
                 if hfshift <> sqldata.shift;                                                      
                  p1shiftc = '*';                                                                  
                  changedrecordf = *on;                                                            
                 endif;                                                                            
                 // additional fields                                                              
                 if hfsex <> sqldata.gender;                                                        
                  changedrecordf = *on;                                                            
                 endif;                                                                            

                 if hfmsts <> %subst(sqldata.mstatus:1:1);                                          
                  p1mstatusc = '*';                                                                
                  changedrecordf = *on;                                                            
                 endif;                                                                            
                 if hfrace <> workrace;                                                            
                  changedrecordf = *on;                                                            
                 endif;                                                                            
                 if HFBDAT <> %dec(isobirthday:*cymd) ;                                            
                  changedrecordf = *on;                                                            
                 endif;                                                                            

                endif;                                                                              

                // Terminated/Retired employees                                                    
                 if %found(hrfempda);                                                              
                  if %xlate(lo:up:sqldata.status) = 'TERMINATED' and                                
                             hfacts = 'Y' or                                                        
                     %xlate(lo:up:sqldata.status) = 'RETIRED' and                                  
                             hfacts = 'Y' OR                                                        
                     %xlate(lo:up:sqldata.status) = 'DISABLED' and                                  
                             hfacts = 'Y';                                                          
                   Terminated = *on;                                                                
                  endif;                                                                            
                  if %xlate(lo:up:sqldata.status) = 'LOA' and                                      
                             hfests <> 'I' or                                                      
                     %xlate(lo:up:sqldata.status) = 'LOA PAID' and                                  
                             hfests <> 'I' or                                                      
                     %xlate(lo:up:sqldata.status) = 'LOA UNPAID' and                                
                             hfests <> 'I';                                                        
                   changedrecordf = *on;                                                            
                  endif;                                                                            
                 endif;                                                                            

                 // if employee changed or *new                                                    
                 // write/update record to hrfempda                                                
                 // fields for HRF file                                                            
                 //                                                                                
                 // sqldata.status;                                                                
                 // sqldata.hiredate;                                                              
                 // sqldata.termdate;                                                              
                 // sqldata.department;                                                            
                 // sqldata.supervisor;                                                            
                 // sqldata.shift;                                                                  
                 // sqldata.alternant;                                                              

                 if changedrecordf or newemployee;                                                  
                  clear hrfempdr;                                                                  
                  chain (sqldata.emp#) hrfempda;                                                    

                  HFHDAT = %dec(sqldata.hiredate:*cymd);                                            
                  HFDPT1 = sqldata.department;                                                      
                  HFSUPRNMBR = sqldata.supervisor;                                                  
                  HFUSER1 = %char(sqldata.alternant);                                              
                  HFSHIFT = sqldata.shift;                                                          
                  HFSEX = sqldata.gender;                                                          
                  HFMSTS = sqldata.mstatus;                                                        
                  HFRACE = workrace;                                                                
                  HFBDAT = %dec(isobirthday:*cymd);                                                

                  if %found(hrfempda);                                                              

                   select;                                                                          
                   when %xlate(lo:up:sqldata.status) = 'TERMINATED' or                              
                        %xlate(lo:up:sqldata.status) = 'RETIRED' or                                
                        %xlate(lo:up:sqldata.status) = 'DISABLED';                                  
                    HFACTS = 'N';                                                                  
                    HFTDAT = %dec(sqldata.termdate:*cymd);                                          
                    if %xlate(lo:up:sqldata.status) = 'TERMINATED';                                
                     HFESTS = 'T';                                                                  
                    endif;                                                                          
                    if %xlate(lo:up:sqldata.status) = 'RETIRED';                                    
                     HFESTS = 'R';                                                                  
                    endif;                                                                          
                    if %xlate(lo:up:sqldata.status) = 'DISABLED';                                  
                     HFESTS = 'P';                                                                  
                    endif;                                                                          
                   when %xlate(lo:up:sqldata.status) = 'LOA' or                                    
                        %xlate(lo:up:sqldata.status) = 'LOA PAID' or                                
                        %xlate(lo:up:sqldata.status) = 'LOA UNPAID';                                
                    HFACTS = 'Y';                                                                  
                    HFESTS = 'I';                                                                  
                    clear HFTDAT;                                                                  
                   other;                                                                          
                    HFACTS = 'Y';                                                                  
                    clear HFESTS;                                                                  
                    clear HFTDAT;                                                                  
                   endsl;                                                                          

                   update hrfempdr;                                                                
                  else;                                                                            
                   HFEMP# = sqldata.emp#;                                                          
                   HFACTS = 'Y';                                                                    
                   HFAlc1 = 1.00;                                                                  
                   write hrfempdr;                                                                  

                   clear hrgemppr;                                                                  
                   HGEMP# = sqldata.emp#;                                                          
                   if sqldata.paytype = *blanks;                                                    
                    HGRATT = 'H';                                                                  
                   else;                                                                            
                    HGRATT = sqldata.paytype;                                                      
                   endif;                                                                          
                   write hrgemppr;                                                                  
                  endif;                                                                            
                 endif;                                                                            

                p1fdate = %dec(%date():*mdy);                                                      
                if *in70 or writeheader = *on;                                                      
                 write header2;                                                                    
                 writeheader = *off;                                                                
                 *in70 = *off;                                                                      
                endif;                                                                              

               // job title  - only one on ceridian and its primary                                
                if sqldata.jobtitle <> *blanks;                                                    
                 if %subst(sqldata.jobtitle:2:2) = '  ';                                            
                  sqldata.jobtitle = '00' + %subst(sqldata.jobtitle:1:1);                          
                 endif;                                                                            
                 if %subst(sqldata.jobtitle:3:1) = ' ';                                            
                  sqldata.jobtitle = '0' + %subst(sqldata.jobtitle:1:2);                            
                 endif;                                                                            
                 setll (sqldata.emp#) hrvtitla;                                                    
                 if not%equal(hrvtitla);                                                            
                  hvemp# = sqldata.emp#;                                                            
                  hvjtcd = sqldata.jobtitle;                                                        
                  hvpri = 'Y';                                                                      
                  write hrvtitlr;                                                                  
                  p1jtitlec = '*';                                                                  
                  changedrecordf = *on;                                                            
                 else;                                                                              
                  // title exists but not primary                                                  
                  chain (sqldata.emp#: sqldata.jobtitle) hrvtitla;                                  
                  if %found(hrvtitla) and hvpri <> 'Y';                                            
                    hvpri = 'Y';                                                                    
                    // if more than 1 job title set the rest to "N"                                
                    update hrvtitlr %fields(hvpri);                                                
                    p1jtitlec = '*';                                                                
                    changedrecordf = *on;                                                          
                    exec sql                                                                        
                     update hrvtitl set hvpri = 'N' where                                          
                     hvemp# = :sqldata.emp# and hvjtcd <> :sqldata.jobtitle;                        
                  else;                                                                            
                  // title doesnt exist                                                            
                   if not%found(hrvtitla);                                                          
                    hvemp# = sqldata.emp#;                                                          
                    hvjtcd = sqldata.jobtitle;                                                      
                    hvpri = 'Y';                                                                    
                    write hrvtitlr;                                                                
                    p1jtitlec = '*';                                                                
                    changedrecordf = *on;                                                          
                    // if more than 1 job title set the rest to "N"                                
                    exec sql                                                                        
                     update hrvtitl set hvpri = 'N' where                                          
                     hvemp# = :sqldata.emp# and hvjtcd <> :sqldata.jobtitle;                        
                   endif;                                                                          
                  endif;                                                                            
                 endif;                                                                            

                 chain (sqldata.jobtitle) hrujbtla;                                                
                 if not %found(hrujbtla);                                                          
                  p1jtitlec = '$';                                                                  
                 endif;                                                                            
                endif;                                                                              

                  // only print changed records                                                    
                if changedrecorde or changedrecordf or changedrecordg or                            
                     newemployee;                                                                  
                 P1EMP# = sqldata.emp#;                                                            
                 P1NAME = %trim(sqldata.lastname) + ', ' +                                          
                              %trim(sqldata.firstname);                                            
                 P1ADDR1 = sqldata.street1;                                                        
                 P1ADDR2 = sqldata.street2;                                                        
                 P1CITY = sqldata.city;                                                            
                 P1STATE = sqldata.state;                                                          
                 P1ZIPCODE = sqldata.zipcode;                                                      
                 P1PHONE = sqldata.phone;                                                          
                 P1SS# = sqldata.ss#;                                                              
                 P1STATUS = sqldata.status;                                                        
                 P1HIREDT = %dec(sqldata.hiredate:*mdy);                                            
                 if %xlate(lo:up:sqldata.status) = 'TERMINATED'                                    
                    or %xlate(lo:up:sqldata.status) = 'RETIRED'                                    
                    or %xlate(lo:up:sqldata.status) = 'DISABLED';                                  
                  P1TERMDT = %dec(sqldata.termdate:*mdy);                                          
                 else;                                                                              
                  clear p1termdt;                                                                  
                 endif;                                                                            
                 P1DEPT = sqldata.department;                                                      
                 P1SUPR = sqldata.supervisor;                                                      
                 P1USER1 = sqldata.alternant;                                                      
                 P1SHIFT = sqldata.shift;                                                          
                 P1PAYTYPE = sqldata.paytype;                                                      
                 //                                                                                
                 p1gender = sqldata.gender;                                                        
                 p1mstatus = sqldata.mstatus;                                                      
                 p1race = workrace;                                                                
                 monitor;                                                                          
                 p1bdate = %dec(isobirthday:*mdy);                                                  
                 on-error;                                                                          
                  p1bdate = %dec(month + day + %subst(year:3:2):6:0);                              
                 endmon;                                                                            
                 p1jtitle = sqldata.jobtitle;                                                      
                 p1partim = workparttime;                                                          

                 write detail2;                                                                    
                endif;                                                                              

                // need to notify IT about change in employee                                      
                if Terminated or p1deptc = '*';                                                    
                 exsr $SendNotifications;                                                          
                endif;                                                                              
               endif;                                                                              
              enddo;                                                                                
              closeList();                                                                          

               write endrpt;                                                                        
               if %open(employees);                                                                
                close employees;                                                                    
               endif;                                                                              
               if %open(ceridianp);                                                                
                close ceridianp;                                                                    
               endif;                                                                              

               //                                                                                  
               // rename to CMP. (complete) This will cause it not to  be reprocessed              
               //                                                                                  
               newname =                                                                            
               %replace('.cmp' : name:                                                              
               %scan('.CSV':%xlate(lo:up:name)) :4);                                                

               cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q +                                  
                           ') NEWOBJ(' + Q + %trim(newname) + Q + ')';                              
               cmdlength = %len(%trim(cmdstring));                                                  
               monitor;                                                                            
                $command(cmdstring:cmdlength);                                                      
               on-error;                                                                            
               endmon;                                                                              

             endsr;                                                                                

        //---------------------------------------------                                            
        // $GL - process the GL files                                                              
        //---------------------------------------------                                            
             begsr $GL;                                                                            

              exsr $ErrorSetup;                                                                    
              cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q  +                                            
                           %trim(filename) + Q + ') ' +                                            
                           ' TOFILE(CERIDIAN/CERIDIANGL) RCDDLM(*CRLF)' +                          
                           ' RPLNULLVAL(*FLDDFT)  MBROPT(*REPLACE) ' +                              
                           '  ERRRCDFILE(QTEMP/SOURCE ERRORS)';                                    
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

                //                                                                                  
                // rename to CMP. (complete) This will cause it not to  be reprocessed              
                //                                                                                  
                newname =                                                                          
                %replace('.cmp' : name:                                                            
                %scan('.TXT':%xlate(lo:up:name)) :4);                                              


                cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q +                                  
                            ') NEWOBJ(' + Q + %trim(newname) + Q + ')';                            
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((cgarner@liebovich.com)) +                                    
                             DSTD(''General Ledger'') +                                            
                             MSG(' + Q + 'General Ledger Download complete '                        
                                       + %TRIM(FILENAME) + Q + ') +                                
                             LONGMSG(''General Ledger Download complete'')';                        
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            
                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((denisep@liebovich.com)) +                                    
                             DSTD(''General Ledger'') +                                            
                             MSG(' + Q + 'General Ledger Download complete '                        
                                       + %TRIM(FILENAME) + Q + ') +                                
                             LONGMSG(''General Ledger Download complete'')';                        
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

             endsr;                                                                                

        //---------------------------------------------                                            
        // $GLB - process the GL files for Bonus                                                    
        //---------------------------------------------                                            
             begsr $GLB;                                                                            

              exsr $ErrorSetup;                                                                    
              cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q  +                                            
                           %trim(filename) + Q + ') ' +                                            
                           ' TOFILE(CERIDIAN/CERIDIANGL BONUS) RCDDLM(*CRLF)' +                    
                           ' RPLNULLVAL(*FLDDFT)  MBROPT(*REPLACE) ' +                              
                           '  ERRRCDFILE(QTEMP/SOURCE ERRORS)';                                    
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

                //                                                                                  
                // rename to CMP. (complete) This will cause it not to  be reprocessed              
                //                                                                                  
                newname =                                                                          
                %replace('.cmp' : name:                                                            
                %scan('.TXT':%xlate(lo:up:name)) :4);                                              


                cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q +                                  
                            ') NEWOBJ(' + Q + %trim(newname) + Q + ')';                            
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((cgarner@liebovich.com)) +                                    
                             DSTD(''General Ledger'') +                                            
                             MSG(' + Q + 'Gen Ledger Bonus Download complete '                      
                                       + %TRIM(FILENAME) + Q + ') +                                
                         LONGMSG(''General Ledger Bonus Download complete'')';                      
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            
                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((denisep@liebovich.com)) +                                    
                             DSTD(''General Ledger'') +                                            
                             MSG(' + Q + 'Gen Ledger Bonus Download complete '                      
                                       + %TRIM(FILENAME) + Q + ') +                                
                         LONGMSG(''General Ledger Bonus Download complete'')';                      
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

             endsr;                                                                                

        //---------------------------------------------                                            
        // $vacation - process vacation                                                            
        //---------------------------------------------                                            
             begsr $vacation;                                                                      

              exsr $ErrorSetup;                                                                    
              cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q  +                                            
                           %trim(filename) + Q + ') ' +                                            
                           ' TOFILE(CERIDIAN/CERIDIANVA) RCDDLM(*CRLF)' +                          
                           ' RPLNULLVAL(*FLDDFT)  MBROPT(*REPLACE) ' +                              
                           '  ERRRCDFILE(QTEMP/SOURCE ERRORS)';                                    
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

                //                                                                                  
                // rename to CMP. (complete) This will cause it not to  be reprocessed              
                //                                                                                  
                newname =                                                                          
                %replace('.cmp' : name:                                                            
                %scan('.CSV':%xlate(lo:up:name)) :4);                                              


                cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q +                                  
                            ') NEWOBJ(' + Q + %trim(newname) + Q + ')';                            
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((cgarner@liebovich.com)) +                                    
                             DSTD(''Vacation'') +                                                  
                             MSG(' + Q + 'Vacation Download complete '                              
                                       + %TRIM(FILENAME) + Q + ') +                                
                             LONGMSG(''Vacation Download complete'')';                              
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            
                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((denisep@liebovich.com)) +                                    
                             DSTD(''Vacation'') +                                                  
                             MSG(' + Q + 'Vacation Download complete '                              
                                       + %TRIM(FILENAME) + Q + ') +                                
                             LONGMSG(''Vacation Download complete'')';                              
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

             endsr;                                                                                

        //---------------------------------------------                                            
        // $bonus - QTR bonus information                                                          
        //---------------------------------------------                                            
             begsr $bonus;                                                                          

              exsr $ErrorSetup;                                                                    
              cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q  +                                            
                           %trim(filename) + Q + ') ' +                                            
                           ' TOFILE(CERIDIAN/CERIDIANBN) RCDDLM(*CRLF)' +                          
                           ' RPLNULLVAL(*FLDDFT)  MBROPT(*REPLACE) ' +                              
                           '  ERRRCDFILE(QTEMP/SOURCE ERRORS)';                                    
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

                //                                                                                  
                // rename to CMP. (complete) This will cause it not to  be reprocessed              
                //                                                                                  
                newname =                                                                          
                %replace('.cmp' : name:                                                            
                %scan('.CSV':%xlate(lo:up:name)) :4);                                              


                cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q +                                  
                            ') NEWOBJ(' + Q + %trim(newname) + Q + ')';                            
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

                cmdstring = 'SNDDST TYPE(*LMSG) +                                                  
                             TOINTNET((cgarner@liebovich.com)) +                                    
                             DSTD(''QTR Bonus'') +                                                  
                             MSG(''QTR Bonus Download complete'') +                                
                             LONGMSG(''QTR Bonus Download complete'')';                            
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

             endsr;                                                                                

        //---------------------------------------------                                            
        // $SendNotifications - send notifications of                                              
        //                      profile changes.                                                    
        //---------------------------------------------                                            
             begsr $SendNotifications;                                                              

             if p1deptc = '*';                                                                      
              chgdept(heemp#:hename:pdsdatc);                                                      
             endif;                                                                                
             if Terminated;                                                                        
              tdat6 = %dec(sqldata.termdate:*mdy);                                                  
              termed(heemp#:hename:tdat6);                                                          
             endif;                                                                                

             endsr;                                                                                

        //---------------------------------------------                                            
        // $resubmit - resubmit itself                                                              
        //---------------------------------------------                                            
             begsr $resubmit;                                                                      

              //                                                                                    
              // SBMJOB     CMD(CALL PGM(LBIOBJ/CERIDIANR)) JOB(CERIDIAN)                          
              //                JOBQ(MONITOR) OUTQ(LBIIT) USER(DAILYCHECK)                          
              //                                                                                    
              cmdstring = 'SBMJOB     CMD(CALL PGM(LBIOBJ/CERIDIANR))' +                            
                          '  JOB(CERIDIAN) ' +                                                      
                          '  JOBQ(NEPS) OUTQ(LBIIT) USER(DAILYCHECK)';                              
                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

             endsr;                                                                                

        //-----------------------------------------------------                                    
        // $GetFileName - read thru directory and get filename                                      
        //-----------------------------------------------------                                    
             begsr $GetFileName;                                                                    

              filename = *blanks;                                                                  
              name = *blanks;                                                                      
              pathname =  '/home/HR/ceridian/'  + %trim(x'00') ;                                    
              // Step1: Open up the directory root and list all directories                        
              dh = closedir(%addr(PathName));                                                      
              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;                                                              

                // FIXME: This code can only handle file/dir names 256 bytes long                  
                // because thats the size of "Name"                                                

                if  d_namelen < 256  and  %subst(d_name:1:1) <> 'Q';                                
                 Name = %subst(d_name:1:d_namelen);                                                

                 // skip directory . and .. only processes .csv documents                          

                 if Name <> '.'                                                                    
                    and name <> '..'                                                                
                    and name <> *Blanks                                                            
                    and (%scan('.CSV':%xlate(lo:up:name)) > *zeros or                              
                        %scan('.TXT':%xlate(lo:up:name)) > *zeros);                                

                  filename =  '/home/HR/ceridian/' +  %trim(name);                                  
                  exsr $checkfile;                                                                  

                 endif;                                                                            
                endif;                                                                              

                p_dirent = readdir(dh);                                                            
               enddo;                                                                              
              endif;                                                                                

             endsr;                                                                                

        //---------------------------------------------                                            
        // $ErrorSetup - error setup                                                                
        //---------------------------------------------                                            
             begsr $ErrorSetup;                                                                    

              //                                                                                    
              // Just delete the error source file in QTEMP                                        
              //                                                                                    

              cmdstring = 'DLTF QTEMP/SOURCE';                                                      
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

              //                                                                                    
              // CRTSRCPF FILE(QTEMP/SOURCE) RCDLEN(2000) MBR(ERRORS)                              
              //                                                                                    

              cmdstring = 'CRTSRCPF FILE(QTEMP/SOURCE) RCDLEN(2000)' +                              
                          ' MBR(ERRORS)';                                                          
              cmdlength = %len(%trim(cmdstring));                                                  
              monitor;                                                                              
               $command(cmdstring:cmdlength);                                                      
              on-error;                                                                            
              endmon;                                                                              

             endsr;                                                                                

        //--------------------------------------------------------                                  
        // $CheckErrors - check to see if there are errors                                          
        //--------------------------------------------------------                                  
             begsr $checkErrors;                                                                    

              clear errortotal;                                                                    
              exec sql                                                                              
               select coalesce(count(*),0)                                                          
               into : errortotal from qtemp/source ;                                                
               // files are always sent with headers                                                
               // The headers are all *CHAR so when CPYRFMIMPF attempts                            
               // to process - an error is generated EVERY Time... so assume & ignore!              
               //                                                                                  
               if errortotal > 1;   // read the file send messages                                  
                emperror = 'Employees in Error: ';                                                  
                sqlstmt3 = 'select srcdta from qtemp/source';                                      
                openList3();                                                                        
                dow fetchNext3();                                                                  
                 // first field is the employee number build string of employees for the            
                 // email.                                                                          
                 str = %scan(',':sqldata3);                                                        
                 if str > *zeros;                                                                  
                  len = (str - 1);                                                                  
                  chr5 = %subst(sqldata3:1:len);                                                    
                  if %check('0123456789 ': chr5) = *zeros ;  // all decimal data  must be employee#
                   if %len(%trim(emperror)) > 19;                                                  
                    emperror = %trim(emperror) + ', ';                                              
                   endif;                                                                          
                    emperror = %trim(emperror) + '  ' + %trim(chr5);                                
                  endif;                                                                            
                 endif;                                                                            
                enddo;                                                                              
                closeList3();                                                                      

                cmdstring = 'SNDDST TYPE(*LMSG) ' +                                                
                            ' TOINTNET((profilechange@liebovich.com))' +                            
                            ' DSTD(' + Q + 'Download Error' + Q +                                  
                            ') MSG(' + Q +                                                          
                            %trim(emperror) +                                                      
                            Q + ')  LONGMSG(' + Q +                                                
                            %trim(emperror) + Q + ')';                                              

                cmdlength = %len(%trim(cmdstring));                                                
                monitor;                                                                            
                 $command(cmdstring:cmdlength);                                                    
                on-error;                                                                          
                endmon;                                                                            

               endif;                                                                              

             endsr;                                                                                

        //--------------------------------------------------------                                  
        // Hskpg - one time run subroutine                                                          
        //--------------------------------------------------------                                  
             begsr Hskpg;                                                                          

             mmddyy = pdsdat;                                                                      
             xcyy = 100 + yy;                                                                      
             xmmdd = mmdd;                                                                          

             In *lock ceridianDS;                                                                  
             workstamp = %timestamp(ceridianstamp);                                                
             Unlock ceridianDS;                                                                    

             endsr;                                                                                

      /end-free                                                                                    
      *--------------------------------------------------------                                    
      *  openList  - Open a cursor to read file                                                    
      *--------------------------------------------------------                                    
     p openList        b                                                                            

     d openList        pi                                                                          

      /Free                                                                                        

       exec sql                                                                                    
        declare MyCursor cursor for statement;                                                      

       exec sql                                                                                    
        prepare statement from :sqlstmt;                                                            

       exec sql                                                                                    
        open mycursor;                                                                              

      /End-Free                                                                                    

     p openList        e                                                                            
      *--------------------------------------------------------                                    
      *  fetchNext  - read one record at a time                                                    
      *--------------------------------------------------------                                    
     p fetchNext       b                                                                            

     d fetchNext       pi              n                                                            

      /free                                                                                        

       exec sql                                                                                    
        fetch next from mycursor into : sqldata;                                                    
         if sqlstt < '02000';                                                                      
           return *on;                                                                              
         else;                                                                                      
           return *off;                                                                            
         endif;                                                                                    

      /end-free                                                                                    

     p fetchNext       e                                                                            
      *--------------------------------------------------------                                    
      *  closeOrderList  - Close the OrderHdr cursor                                                
      *--------------------------------------------------------                                    
     p closeList       b                                                                            

     d closeList       pi                                                                          

      /free                                                                                        

       exec sql                                                                                    
        close MyCursor;                                                                            

      /end-free                                                                                    

     p closeList       e                                                                            
      *--------------------------------------------------------                                    
      *  openList2  - Open a cursor to read file                                                    
      *--------------------------------------------------------                                    
     p openList2       b                                                                            

     d openList2       pi                                                                          

      /Free                                                                                        

       exec sql                                                                                    
        declare MyCursor2 cursor for statement2;                                                    

       exec sql                                                                                    
        prepare statement2 from :sqlstmt2;                                                          

       exec sql                                                                                    
        open Mycursor2;                                                                            

      /End-Free                                                                                    

     p openList2       e                                                                            
      *--------------------------------------------------------                                    
      *  fetchNext2  - read one record at a time                                                    
      *--------------------------------------------------------                                    
     p fetchNext2      b                                                                            

     d fetchNext2      pi              n                                                            

      /free                                                                                        

       exec sql                                                                                    
        fetch next from mycursor2 into : sqldata2;                                                  
         if sqlstt < '02000';                                                                      
           return *on;                                                                              
         else;                                                                                      
           return *off;                                                                            
         endif;                                                                                    

      /end-free                                                                                    

     p fetchNext2      e                                                                            
      *--------------------------------------------------------                                    
      *  closeList2 - Close the OrderHdr cursor                                                    
      *--------------------------------------------------------                                    
     p closeList2      b                                                                            

     d closeList2      pi                                                                          

      /free                                                                                        

       exec sql                                                                                    
        close MyCursor2;                                                                            

      /end-free                                                                                    

     p closeList2      e                                                                            
      *--------------------------------------------------------                                    
      *  openList3  - Open a cursor to read file                                                    
      *--------------------------------------------------------                                    
     p openList3       b                                                                            

     d openList3       pi                                                                          

      /Free                                                                                        

       exec sql                                                                                    
        declare MyCursor3 cursor for statement3;                                                    

       exec sql                                                                                    
        prepare statement3 from :sqlstmt3;                                                          

       exec sql                                                                                    
        open Mycursor3;                                                                            

      /End-Free                                                                                    

     p openList3       e                                                                            
      *--------------------------------------------------------                                    
      *  fetchNext3  - read one record at a time                                                    
      *--------------------------------------------------------                                    
     p fetchNext3      b                                                                            

     d fetchNext3      pi              n                                                            

      /free                                                                                        

       exec sql                                                                                    
        fetch next from mycursor3 into : sqldata3;                                                  
         if sqlstt < '02000';                                                                      
           return *on;                                                                              
         else;                                                                                      
           return *off;                                                                            
         endif;                                                                                    

      /end-free                                                                                    

     p fetchNext3      e                                                                            
      *--------------------------------------------------------                                    
      *  closeList3 - Close the OrderHdr cursor                                                    
      *--------------------------------------------------------                                    
     p closeList3      b                                                                            

     d closeList3      pi                                                                          

      /free                                                                                        

       exec sql                                                                                    
        close MyCursor3;                                                                            

      /end-free                                                                                    

     p closeList3      e

I would then use %scanrpl to remove all the '"'

then -- take a look here: https://www.code400.com/2018/12/01/s...-by-delimiter/

You could if the fields on DB2 table match perfectly copy directly using cpytoimpf or cpyfrmstmf -- but I would read table count fields and verify data prior to writing
to table -- you can do this if you piece all this "junk" together.

Please post when you get it running.

Attached Files

CERIDIANR.txt (164.6 KB, 220 views)

**redvan** · December 14, 2018, 08:06 AM

WOW Jainmef,
That is some program. Going to take a while just to decipher it all.
Thanks and I will let you know the outcome.

Red.

**jamief** · December 14, 2018, 08:09 AM

its hideous

written in 2010 -- @#%@#%@#%@#% im old.... To start please just focus on the subroutine $GetFileName this is what reads the directory.

digging around I found this program that creates subsystem NEPS and adds an auto start job..
again pull out what you need

PHP Code:



     H Option(*SrcStmt:*NoDebugIO)                                                                  
     H DftActGrp(*No)                                                                              

     fsyscontroluf a e           k disk                                                            
      //********************************************************************                        

      //                                                                

      //********************************************************************                        
      // Program Name -- AMIU01                                                                    
      // Written By   -- J.J.F.     Date Written  -- 07/14/2014                                    
      // Modified By  -- X.X.X.     Last Revision -- XX/XX/XXXX                                    
      //********************************************************************                        
      // List all modifications to this program below in the                                        
      // format of initials, date & description of your change.                                    

      // Initials    Date    Description                                                            
      //  X.X.X.   XX/XX/XX  Xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.                                    
      //********************************************************************                        
      //                  *-* Program Description *-*                                              

      // Build the subsytem NEPS for the system monitor program(s)                                  
      //  will also populate default table entries required for                                    
      //  programs to correctly run.                                                                

      //********************************************************************                        
      // --------------------- Prototypes -----------------------                                  
     d $qcmdexc        pr                  extpgm( 'QCMDEXC' )                                      
     d   cmdString_                5000A   options( *varsize ) const                                
     d   cmdlength_                  15P 5                     const                                

     **-- Retrieve object description:  -------------------------------                            
     d $RtvObjD        Pr                  ExtPgm( 'QUSROBJD' )                                    
     d  RoRcvVar_                 32767a         Options( *VarSize )                                
     d  RoRcvVarLen_                 10i 0 Const                                                    
     d  RoFmtNam_                     8a   Const                                                    
     d  RoObjNamQ_                   20a   Const                                                    
     d  RoObjTyp_                    10a   Const                                                    
     d  RoError_                  32767a         Options( *VarSize )                                

      // ---------------- data structures ------------------                                        
     **-- Object description structure OBJD0400:  ----------------------------**                    
     d ObjectDs        ds                  qualified  inz                                          
     d  ObjDscLen                    10i 0                                                          
     d  ObjDscSiz                    10i 0                                                          
     d  ObjNam                       10                                                            
     d  ObjLib                       10                                                            
     d  ObjTyp                       10                                                            
     d  ObjRtnLib                    10                                                            
     d  ObjAsp                       10i 0                                                          
     d  ObjOwnr                      10                                                            
     d  ObjDmn                        2                                                            
     d  ObjCrtDat                    13                                                            
     d  ObjChgDat                    13                                                            
      *                                                                                            
     d  ObjAtr                       10                                                            
     d  ObjTxt                       50                                                            
     d  ObjSrcFil                    10                                                            
     d  ObjSrcLib                    10                                                            
     d  ObjSrcMbr                    10                                                            
      *                                                                                            
     d  ObjSrcChgDat                 13                                                            
     d  ObjSrcSavDat                 13                                                            
     d  ObjSrcRstDat                 13                                                            
     d  ObjCrtUsr                    10                                                            
     d  ObjCrtSys                     8                                                            
     d  ObjResDat                     7                                                            
     d  ObjSavSiz                    10i 0                                                          
     d  ObjSavSeq                    10i 0                                                          
     d  ObjStg                       10                                                            
     d  ObjSavCmd                    10                                                            
     d  ObjSavVolId                  71                                                            
     d  ObjSavDvc                    10                                                            
     d  ObjSavFil                    10                                                            
     d  ObjSavLib                    10                                                            
     d  ObjSavLvl                     9                                                            
     d  ObjCompiler                  16                                                            
     d  ObjLvl                        8                                                            
     d  ObjUsrChg                     1                                                            
     d  ObjLicPgm                    16                                                            
     d  ObjPtf                       10                                                            
     d  ObjApar                      10                                                            
      *  start of four                                                                              
     d  ObjUseDat                     7                                                            
     d  ObjUsgInf                     1                                                            
     d  ObjUseDay                    10i 0                                                          
     d  ObjSiz                       10i 0                                                          
     d  ObjSizMlt                    10i 0                                                          
     d  ObjCprSts                     1                                                            
     d  ObjAlwChg                     1                                                            
     d  ObjChgByPgm                   1                                                            
     d  ObjUsrAtr                    10                                                            
     d  ObjOvrflwAsp                  1                                                            
     d  ObjSavActDat                  7                                                            
     d  ObjSavActTim                  6                                                            
     d  ObjAudVal                    10                                                            
     d  ObjPrmGrp                    10                                                            

      * Data structure to pass parameters into API                                                  
     d ListProgram     ds                  qualified                                                
     d  Object                       10    inz('EDLDQI01R')                                        
     d  Library                      10    inz('*LIBL')                                            
     d  ObjectType                   10    inz('*PGM')                                              

     d APIErrorDS      ds                  Qualified                                                
     d  BytesP                       10I 0 inz(%size(apiErrorDS))                                  
     d  BytesA                       10I 0 inz(0)                                                  
     d  Messageid                     7                                                            
     d  Reserved                      1                                                            
     d  messagedta                  128                                                            

      // ---------------- Standalone Variables ------------------                                  
     d Cmdlength       s             15  5 inz                                                      
     d CmdString       s           5000a   varying                                                  
     d CreateLibrary   s             10a   inz                                                      
     d DefaultEmail    s            512a   inz('jamie.flanary@abcsupply.com')                      
     d ProductionLibrary...                                                                        
     d                 s             10a   inz                                                      
     d Q               s              1a   inz('''')                                                

      // ---------------------- Constants -----------------------                                  
     D False           C                   '0'                                                      
     D True            C                   '1'                                                      


      //********************************************************************                        
      /free                                                                                        

       exsr $buildSubsystem;                                                                        
       exsr $writeRecords;                                                                          
       *INLR = True;                                                                                

      /end-free                                                                                    
       //********************************************************************                      
      /free                                                                                        
       BegSR $buildSubsystem;                                                                      

        createlibrary = 'NEPSTEST';                                                                

        // create the subsytem into QGPL                                                            
        cmdstring = 'CRTSBSD SBSD(' + %trim(CreateLibrary) +                                        
         '/NEPS) POOLS((1 *BASE)) ' +                                                              
         'TEXT(' + Q + 'Never Ending Subsystem' + Q + ')';                                          
        exsr $processCommand;                                                                      

        // create the class into QGPL                                                              
        cmdstring = 'CRTCLS CLS(' + %trim(CreateLibrary) +                                          
         '/NEPS) ' +                                                                                
         'TEXT(' + Q + 'Never Ending Subsystem Class' + Q + ')';                                    
        exsr $processCommand;                                                                      

        // add routing entries                                                                      
        cmdstring = 'ADDRTGE SBSD(' + %trim(CreateLibrary) +                                        
         '/NEPS) ' +                                                                                
         'SEQNBR(9999) CMPVAL(*ANY) PGM(QSYS/QCMD)';                                                
        exsr $processCommand;                                                                      

        // add routing entries                                                                      
        cmdstring = 'ADDRTGE SBSD(' + %trim(CreateLibrary) +                                        
         '/NEPS) ' +                                                                                
         'SEQNBR(20) CMPVAL(' + Q + 'QIGC' + Q + ') PGM(QSYS/QCMD)';                                
        exsr $processCommand;                                                                      

        // create jobqueue                                                                          
        cmdstring = 'CRTJOBQ JOBQ(' + %trim(CreateLibrary) +                                        
         '/NEPS) ' +                                                                                
         'TEXT(' + Q + 'Neps JobQueue' + Q + ')';                                                  
        exsr $processCommand;                                                                      


        // add JobQueue Entry                                                                      
        cmdstring = 'ADDJOBQE  SBSD(' + %trim(CreateLibrary) +                                      
         '/NEPS) JOBQ(' +  %trim(CreateLibrary) + '/NEPS)';                                        
        exsr $processCommand;                                                                      

        // determine which library program EDLDQI01R is located in                                  
        // retrieve the device description                                                          

        $RtvObjD( ObjectDS                                                                          
                  : %Size( ObjectDS )                                                              
                  : 'OBJD0400'                                                                      
                  : ListProgram.Object + ListProgram.library                                        
                  : ListProgram.ObjectType                                                          
                  : ApiErrorDS                                                                      
                               );                                                                  
        // populate the production library                                                          
        productionLibrary = objectds.objrtnlib;                                                    

        // create the job description                                                              
        cmdstring = 'CRTJOBD JOBD(' + %trim(CreateLibrary) +                                        
         '/NEPS) TEXT(' + 'Neps (Never Ending Programs jobd)' + Q +                                
        ') USER(QUSER) RQSDTA(' + Q + 'Call EDLDQI02R' + Q + ') ' +                                
        ' INLLIBL(' + %trim(ProductionLibrary) + ')';                                              
        exsr $processCommand;                                                                      

        // add the auto start job for ACOM dataq monitor                                            
        cmdstring = 'ADDAJE SBSD(' + %trim(CreateLibrary) +                                        
         '/NEPS) JOB(MONACOM) JOBD(' + %trim(CreateLibrary) + '/NEPS)';                            
        exsr $processCommand;                                                                      

        // add the auto start job for System monitor                                                
        cmdstring = 'ADDAJE SBSD(' + %trim(CreateLibrary) +                                        
         '/NEPS) JOB(MONERR) JOBD(' + %trim(CreateLibrary) + '/NEPS)';                              
        exsr $processCommand;                                                                      


        // Start the subsystem                                                                      
        cmdstring = 'STRSBS SBSD(' + %trim(CreateLibrary) +                                        
         '/NEPS) ';                                                                                
        exsr $processCommand;                                                                      


       EndSR;                                                                                      
      /end-free                                                                                    
       //********************************************************************                      
      /free                                                                                        
       // -- write all the records out to the system control table                                  
       BegSR $writerecords;                                                                        

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI01R';                                                                    
        SYKEY     = 'DATAQ';                                                                        
        SYCHEAD   = 'DataQ';                                                                        
        SYVALUEC  = 'POPRINTQ  *LIBL';                                                              
        SYDHEAD   = 'Max Entries';                                                                  
        SYVALUED  = 30;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI01R';                                                                    
        SYKEY     = 'DATAQ';                                                                        
        SYCHEAD   = 'DataQ';                                                                        
        SYVALUEC  = 'ACKNPRINTQ*LIBL' ;                                                            
        SYDHEAD   = 'Max Entries';                                                                  
        SYVALUED  = 30;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI01R';                                                                    
        SYKEY     = 'DATAQ';                                                                        
        SYCHEAD   = 'DataQ';                                                                        
        SYVALUEC  = 'QUOTPRINTQ*LIBL' ;                                                            
        SYDHEAD   = 'Max Entries';                                                                  
        SYVALUED  = 30;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI02R';                                                                    
        SYKEY     = 'EMAIL';                                                                        
        SYCHEAD   = 'Email';                                                                        
        SYVALUEC  = %trim(DefaultEmail);                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI02R';                                                                    
        SYKEY     = 'JOBQ';                                                                        
        SYCHEAD   = 'JobQ Name';                                                                    
        SYVALUEC  = 'QGPL/QINTER';                                                                  
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI02R';                                                                    
        SYKEY     = 'NEXTERROR';                                                                    
        SYDHEAD   = 'Error Delay';                                                                  
        SYVALUED  = 15;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLDQI02R';                                                                    
        SYKEY     = 'SLEEP';                                                                        
        SYDHEAD   = 'Wait Seconds';                                                                
        SYVALUED  = 60;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'CONTACTIT';                                                                    
        SYCHEAD   = 'Contacts';                                                                    
        SYVALUEC  = 'Scott Holmbeck  Primary: 608-322-4791 '                                        
                  + 'Secondary: 608-368-8056';                                                      
        SYDHEAD   = 'Call Seq';                                                                    
        SYVALUED  = 1;                                                                              
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'CONTACTIT';                                                                    
        SYCHEAD   = 'Contacts';                                                                    
        SYVALUEC  = 'John Homer      Primary: 262-749-0232 '                                        
                  + 'Secondary: 262-427-2238';                                                      
        SYDHEAD   = 'Call Seq';                                                                    
        SYVALUED  = 2;                                                                              
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'CONTACTIT';                                                                    
        SYCHEAD   = 'Contacts';                                                                    
        SYVALUEC  = 'Dan White       Primary: 262-215-5502 '                                        
                  + 'Secondary: 262-724-5487';                                                      
        SYDHEAD   = 'Call Seq';                                                                    
        SYVALUED  = 3;                                                                              
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'CONTACTIT';                                                                    
        SYCHEAD   = 'Contacts';                                                                    
        SYVALUEC  = 'Darrell Cleaver Primary: 262-215-5502 '                                        
                  + 'Secondary: 262-724-5487';                                                      
        SYDHEAD   = 'Call Seq';                                                                    
        SYVALUED  = 4;                                                                              
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'DEFAULTUSR';                                                                  
        SYCHEAD   = 'User Name';                                                                    
        SYVALUEC  = 'QUSER';                                                                        
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'EOD';                                                                          
        SYCHEAD   = 'End of Day';                                                                  
        SYVALUEC  = 'AUTEOD';                                                                      
        SYEMAIL   = 'jamie.flanary@abcsupply.com';                                                  
        SYTHEAD1  = 'Start Time';                                                                  
        SYTIME1   =  140000;                                                                        
        SYTHEAD2  = 'End Time';                                                                    
        SYTIME2   = 141500;                                                                        
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'EOM';                                                                          
        SYCHEAD   = 'End of Month';                                                                
        SYVALUEC  = 'AUTEOD';                                                                      
        SYEMAIL   = 'jamie.flanary@abcsupply.com';                                                  
        SYTHEAD1  = 'Start Time';                                                                  
        SYTIME1   =  210000;                                                                        
        SYTHEAD2  = 'End Time';                                                                    
        SYTIME2   = 211500;                                                                        
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'EOY';                                                                          
        SYCHEAD   = 'End of Year';                                                                  
        SYVALUEC  = 'AUTEOY';                                                                      
        SYEMAIL   = 'jamie.flanary@abcsupply.com';                                                  
        SYTHEAD1  = 'Start Time';                                                                  
        SYTIME1   =  210000;                                                                        
        SYTHEAD2  = 'End Time';                                                                    
        SYTIME2   = 211500;                                                                        
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'EXTEMAIL';                                                                    
        SYEMAIL   = 'POSMonitor@abcsupply.com';                                                    
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'IGNOREJOB';                                                                    
        SYCHEAD   = 'Ignore Job';                                                                  
        SYVALUEC  = 'EXAMPLE1';                                                                    
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'IGNOREJOB';                                                                    
        SYCHEAD   = 'Ignore Job';                                                                  
        SYVALUEC  = 'EXAMPLE2';                                                                    
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'IGNOREJOBQ';                                                                  
        SYCHEAD   = 'Ignore JobQ';                                                                  
        SYVALUEC  = 'EXAMPLE1';                                                                    
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'INTEMAIL';                                                                    
        SYEMAIL   = 'jamie.flanary@abcsupply.com';                                                  
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'MAXSPOOLS';                                                                    
        SYDHEAD   = 'Max Spools';                                                                  
        SYVALUED  = 1000;                                                                          
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'MESSAGES';                                                                    
        SYCHEAD   = 'Log Messages';                                                                
        SYVALUEC  = 'CPF1124 CPF1164 CPC2402';                                                      
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'NEXTERROR';                                                                    
        SYDHEAD   = 'Minutes Dly';                                                                  
        SYVALUED  = 15;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'OVRMAXSPL';                                                                    
        SYCHEAD   = 'OutQ Name';                                                                    
        SYVALUEC  = 'BRMSOUTQ';                                                                    
        SYDHEAD   = 'Max Spools';                                                                  
        SYVALUED  = 100;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'OVRMAXSPL';                                                                    
        SYCHEAD   = 'OutQ Name';                                                                    
        SYVALUEC  = 'JHOMER';                                                                      
        SYDHEAD   = 'Max Spools';                                                                  
        SYVALUED  = 100;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'SBMJOBQ';                                                                      
        SYCHEAD   = 'SbmJob JOBQ';                                                                  
        SYVALUEC  = 'QGPL/QINTER';                                                                  
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'SLEEP';                                                                        
        SYDHEAD   = 'Wait Seconds';                                                                
        SYVALUED  = 60;                                                                            
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'WATCHJOB';                                                                    
        SYCHEAD   = 'Remove Hist';                                                                  
        SYVALUEC  = 'RMVHSTJS';                                                                    
        SYEMAIL   = 'jamie.flanary@abcsupply.com';                                                  
        SYDHEAD1  = 'From Date';                                                                    
        SYDATE1   = 20140701;                                                                      
        SYTHEAD1  = 'Start Time';                                                                  
        SYTIME1   =  110000;                                                                        
        SYDHEAD2  = 'To Date';                                                                      
        SYDATE2   = 20140725;                                                                      
        SYTHEAD2  = 'Message Time';                                                                
        SYTIME2   = 110200;                                                                        
        write sysrec;                                                                              

        clear sysrec;                                                                              
        SYPROGRAM = 'EDLMONSYS';                                                                    
        SYKEY     = 'WORKHOURS';                                                                    
        SYTHEAD1  = 'Start of Day';                                                                
        SYTIME1   = 073000;                                                                        
        SYTHEAD2  = 'End of Day';                                                                  
        SYTIME2   = 173000;                                                                        
        write sysrec;                                                                              

       EndSR;                                                                                      

       //********************************************************************                      
      /end-free                                                                                    

       //********************************************************************                      
      /free                                                                                        
       BegSR $processCommand;                                                                      

        monitor;                                                                                    
        $qcmdexc (cmdstring: %len(%trim(cmdstring)) );                                              
         on-error;                                                                                  
        endmon;                                                                                    

       EndSR;                                                                                      

       //********************************************************************                      
      /end-free

%scanprl

PHP Code:


d MyStringAfter   s            100    varying inz                                      
d MyStringBefore  s            100    varying inz                                      

         //--------------------------------------------------------                    
         *inlr = *on;                                                                  

          MyStringBefore = '"dog","cat","horse","pig","tree","pizza"';                 
          MystringAfter = %scanrpl('"':'':MyStringBefore);

Attached Files

BUILDNEPS.txt (48.4 KB, 236 views)

**JonBoy** · December 14, 2018, 09:32 AM

I think it is about time we started suggesting that people mention their release level in questions like this. I can offer you two solutions that I think you will find take less understanding on your part that Jamie's (all due respect to the noble gentleman).

If you are on V7.3 then take a look at this article http://ibmsystemsmag.com/ibmi/develo...ook-data-into/ it uses DATA-INTO to handle the reading of the file and you end up with everything in a DS.

Alternatively, you could use a variant of the Open Access handler for reading CSVs that I wrote a couple of years back. That you could just plug in to the program that currently reads the disk file you ar trying to generate. You can find that program here: http://ibmsystemsmag.com/ibmi/develo...nput_handlers/ - that article also references an earlier one that is much more basic and may be enough for your needs.

**jamief** · December 14, 2018, 12:10 PM

I'm gonna play with some of that --- right after Christmas break

Announcement

CSV file with double quotes

CSV file with double quotes

Comment

Comment

Comment

Comment

Comment