sponsored links

Collapse

Announcement

Collapse
No announcement yet.

CSV file with double quotes

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • CSV file with double quotes

    Hi,
    I have a tedious problem at hand:
    A user drops a .csv file into a network folder that is mapped to the IFS. My task is to get this data into a PF so a program can parse it out to another file for processing.

    I tried CPYFRMSTMF - many attempts and many issues and after some research here, then tried CPYFRMIMPF which is also giving me issues.

    The data is formatted like this: "data","data","data"," data","data","data","......

    Now, before I redo everything I've tried to get the errors I received so I can list them here, is there anything unusual about this data format that could be wrong or causing issues?

    Red.


    Last edited by jamief; December 14th, 2018, 08:32 AM.
    Everyday's a school day, what grade are you in?

  • #2
    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
    (*NOBNDDIR('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 parameterused 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 *bufsize_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 datathe 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:upFilename)) > *zeros and                            
                         %
    scan('PRGLB': %xlate(lo:up:filename)) > *zeros;                              
                     
    exsr $GLB;                                                                        

                    
    // Ceridian/GL file                                                                
                    
    when %scan('.TXT' :%xlate(lo:upFilename)) > *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) + ') ' +                                            
                                
    ' 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 (keydatesqldata2.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(' + %trim(filename) + +                              
                                   
    ') NEWOBJ(' + %trim(newname) + ')';                          
                       
    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) + ') ' +                                            
                               
    ' 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'))) > 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);                                                                
                     
    = %scan(' ':hfuser1);                                                            
                     if 
    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.jobtitlehrujbtla;                                                
                     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(' + %trim(filename) + +                                  
                               
    ') NEWOBJ(' + %trim(newname) + ')';                              
                   
    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) + ') ' +                                            
                               
    ' 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(' + %trim(filename) + +                                  
                                
    ') NEWOBJ(' + %trim(newname) + ')';                            
                    
    cmdlength = %len(%trim(cmdstring));                                                
                    
    monitor;                                                                            
                     
    $command(cmdstring:cmdlength);                                                    
                    
    on-error;                                                                          
                    
    endmon;                                                                            

                    
    cmdstring 'SNDDST TYPE(*LMSG) +                                                  
                                 TOINTNET((cgarner@liebovich.com)) +                                    
                                 DSTD(''General Ledger'') +                                            
                                 MSG(' 
    'General Ledger Download complete '                        
                                           
    + %TRIM(FILENAME) + ') +                                
                                 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(' 
    'General Ledger Download complete '                        
                                           
    + %TRIM(FILENAME) + ') +                                
                                 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) + ') ' +                                            
                               
    ' 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(' + %trim(filename) + +                                  
                                
    ') NEWOBJ(' + %trim(newname) + ')';                            
                    
    cmdlength = %len(%trim(cmdstring));                                                
                    
    monitor;                                                                            
                     
    $command(cmdstring:cmdlength);                                                    
                    
    on-error;                                                                          
                    
    endmon;                                                                            

                    
    cmdstring 'SNDDST TYPE(*LMSG) +                                                  
                                 TOINTNET((cgarner@liebovich.com)) +                                    
                                 DSTD(''General Ledger'') +                                            
                                 MSG(' 
    'Gen Ledger Bonus Download complete '                      
                                           
    + %TRIM(FILENAME) + ') +                                
                             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(' 
    'Gen Ledger Bonus Download complete '                      
                                           
    + %TRIM(FILENAME) + ') +                                
                             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) + ') ' +                                            
                               
    ' 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(' + %trim(filename) + +                                  
                                
    ') NEWOBJ(' + %trim(newname) + ')';                            
                    
    cmdlength = %len(%trim(cmdstring));                                                
                    
    monitor;                                                                            
                     
    $command(cmdstring:cmdlength);                                                    
                    
    on-error;                                                                          
                    
    endmon;                                                                            

                    
    cmdstring 'SNDDST TYPE(*LMSG) +                                                  
                                 TOINTNET((cgarner@liebovich.com)) +                                    
                                 DSTD(''Vacation'') +                                                  
                                 MSG(' 
    'Vacation Download complete '                              
                                           
    + %TRIM(FILENAME) + ') +                                
                                 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(' 
    'Vacation Download complete '                              
                                           
    + %TRIM(FILENAME) + ') +                                
                                 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) + ') ' +                                            
                               
    ' 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(' + %trim(filename) + +                                  
                                
    ') NEWOBJ(' + %trim(newname) + ')';                            
                    
    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(' 'Download Error' +                                  
                                
    ') MSG(' +                                                          
                                %
    trim(emperror) +                                                      
                                
    ')  LONGMSG(' +                                                
                                %
    trim(emperror) + ')';                                              

                    
    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
    Last edited by jamief; December 14th, 2018, 08:05 AM.
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com

    Comment


    • #3
      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.
      Everyday's a school day, what grade are you in?

      Comment


      • #4
        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(' 'Never Ending Subsystem' ')';                                          
                
        exsr $processCommand;                                                                      

                
        // create the class into QGPL                                                              
                
        cmdstring 'CRTCLS CLS(' + %trim(CreateLibrary) +                                          
                 
        '/NEPS) ' +                                                                                
                 
        'TEXT(' 'Never Ending Subsystem Class' ')';                                    
                
        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(' 'QIGC' ') PGM(QSYS/QCMD)';                                
                
        exsr $processCommand;                                                                      

                
        // create jobqueue                                                                          
                
        cmdstring 'CRTJOBQ JOBQ(' + %trim(CreateLibrary) +                                        
                 
        '/NEPS) ' +                                                                                
                 
        'TEXT(' 'Neps JobQueue' ')';                                                  
                
        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                                                          

                
        $RtvObjDObjectDS                                                                          
                          
        : %SizeObjectDS )                                                              
                          : 
        '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)' +                                
                
        ') USER(QUSER) RQSDTA(' 'Call EDLDQI02R' ') ' +                                
                
        ' INLLIBL(' + %trim(ProductionLibrary) + ')';                                              
                
        exsr $processCommand;                                                                      

                
        // add the auto start job for ACOM dataq monitor                                            
                
        cmdstring =&