H DFTACTGRP(*NO) BNDDIR('QC2LE') *================================================================ * * Add CERIDIAN to library list to compile * * This program reads a directory: * pathname ==> '/home/HR/ceridian/xxxxxxx.csv' * *================================================================ fhreempma uf a e k disk fhrfempda uf a e k disk fhrgemppa uf a e k disk fhriwkpra uf e k disk usropn fhrrwkpra if a e k disk fhrujbtla if e k disk fhrvtitla uf a e k disk fceridianp o e printer oflind(*in70) usropn femployees o e k disk usropn * ************************************************************************** * * Prototypes and definitions for working with the IFS ************************************************************************** * * open -- open an IFS file * D open pr 10i 0 ExtProc('open') D filename * value options(*string) D openflags 10i 0 value D mode 10u 0 value options(*nopass) D codepage 10u 0 value options(*nopass) * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = * read -- read an IFS file * D read pr 10i 0 ExtProc('read') D filehandle 10i 0 value D datareceived * value D nbytes 10u 0 value * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = * values for oflag parameter, used by open() D O_RDONLY s 10i 0 inz(1) D O_TEXTDATA s 10i 0 inz(16777216) * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = d opendir PR * EXTPROC('opendir') d dirname * VALUE D readdir PR * EXTPROC('readdir') D dirp * VALUE D CloseDir PR * ExtProc('closedir') D pdirectory * Value D rename PR 10I 0 ExtProc('Qp0lRenameUnlink') D old * Value options(*string) D new * Value options(*string) d altx s 5 0 d bighunkdata s 65535a d changedrecorde s n d changedrecordf s n d changedrecordg s n d chr5 s 5 d cmdstring s 512 d cmdlength s 15 5 d count s 3 0 d cr C Const(x'0D') d CRLF c x'0d25' d data s 65535A d Data_Rec S 65535A d day s 2 d dh S * d emperror s 256 d end s 3 0 d Eol C Const(x'0D25') d Error_Flag S 1A INZ('0') d errortotal s 5 0 d File S 50 d FileName S 50 d firstname s 30 d foundprimary s n d fnd s 3 0 d Fp S 10i 0 d isobirthday s d d isodatechar s 10 d keydate s 7 0 d lastname s 30 d len s 5 0 d LenStr s 4 0 d lf C Const(x'25') d Lo c CONST('abcdefghijklmnopqrstuvwxyz') d month s 2 d mymessage s 256A varying d N S 5 0 d Name S 2000A d newemployee s n d newname S 50 d Numberoffields s 5 0 d Oflag S 10i 0 d outstamp s 26 d PathName S 2000A d ProgramEnd s n d Q s 1 inz('''') d R S 5 0 d reserve s 9 2 d retired s n d saving s 9 2 d sqldata3 s 2000 d sqlstmt s 23000 varying d sqlstmt2 s 23000 varying d sqlstmt3 s 23000 varying d str s 5 0 d tdat6 s 6 0 d Terminated s n d Up c CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ') d UpperRace s 15 d workdate s 10 d workiso s d d workparttime s 1 inz('N') d workphone s 10 0 d workstamp s z d workrace s 1 d Worktitle s 40 d writeheader s n inz('1') d x s 3 0 d year s 4 * * Directory Entry Structure (dirent) * d p_dirent s * d dirent ds based(p_dirent) d d_reserv1 16A d d_reserv2 10U 0 d d_fileno 10U 0 d d_reclen 10U 0 d d_reserv3 10I 0 d d_reserv4 8A d d_nlsinfo 12A d nls_ccsid 10I 0 OVERLAY(d_nlsinfo:1) d nls_cntry 2A OVERLAY(d_nlsinfo:5) d nls_lang 3A OVERLAY(d_nlsinfo:7) d nls_reserv 3A OVERLAY(d_nlsinfo:10) d d_namelen 10U 0 d d_name 640A *-------------------------------------------------------------------- * Write to a file * * ssize_t write(int fildes, const void *buf, size_t bytes) *-------------------------------------------------------------------- D write PR 10I 0 ExtProc('write') D fildes 10i 0 value D buf * value D bytes 10U 0 value *-------------------------------------------------------------------- * Remove Link to File. (Deletes Directory Entry for File, and if * this was the last link to the file data, the file itself is * also deleted) * * int unlink(const char *path) *-------------------------------------------------------------------- D unlink PR 10I 0 ExtProc('unlink') D path * Value options(*string) ********************************************************************** * Flags for use in open() * * More than one can be used -- add them together. ********************************************************************** D O_WRONLY C 2 D O_RDWR C 4 D O_CREAT C 8 D O_EXCL C 16 D O_CCSID C 32 D O_TRUNC C 64 D O_APPEND C 256 D O_SYNC C 1024 D O_DSYNC C 2048 D O_RSYNC C 4096 D O_NOCTTY C 32768 D O_SHARE_RDONLY C 65536 D O_SHARE_WRONLY C 131072 D O_SHARE_RDWR C 262144 D O_SHARE_NONE C 524288 D O_CODEPAGE C 8388608 ********************************************************************** * My own special MODE shortcuts for open() (instead of those above) ********************************************************************** D M_RDONLY C const(292) D M_RDWR C const(438) D M_RWX C const(511) * * Program Info * d SDS d @PGM 1 10 d @PARMS 37 39 0 d @MSGDTA 91 170 d @MSGID 171 174 d @JOB 244 253 d @USER 254 263 d @JOB# 264 269 0 D PDSDAT 276 281 0 D PDSDATC 276 281 D ds D mmddyy 1 6 0 d mmdd 1 4 0 d yy 5 6 0 d today 11 17 0 d xcyy 11 13 0 d xmmdd 14 17 0 d sqldata e ds extname(employees) inz qualified d sqldata2 e ds extname(savings) inz qualified * d openList pr d FetchNext pr n d closeList pr * d openList2 pr d FetchNext2 pr n d closeList2 pr * d openList3 pr d FetchNext3 pr n d closeList3 pr d CeridianDS ds dtaara('CERIDIAN') d CeridianStamp 26 // // external called programs // d $command pr extpgm('QCMDEXC') d command 512 d Length 15 5 d sleep pr 10i 0 ExtProc( 'sleep' ) d seconds 10u 0 Value d chgdept pr extpgm('HRS09C8') d pmemp# 5 0 d pmname 24 d pdsdatc 6 d termed pr extpgm('HRS09C9') d pmemp# 5 0 d pmname 24 d tdat6 6 0 /free exsr Hskpg; cmdstring = 'ADDLIBLE CERIDIAN'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; //--------------------------------------------------------- // MAIN LINE //--------------------------------------------------------- dou ProgramEnd = *On; // close the directory... pathname = '/home/HR/ceridian/' + %trim(x'00') ; dh = closedir(%addr(PathName)); if %diff(%timestamp():workstamp:*hours) < 1; exsr $GetFileName; sleep(120); else; In *Lock ceridianDS; ceridianstamp = %char(%timestamp); Out ceridianDS; Unlock ceridianDS; exsr $resubmit; leave; endif; enddo; *inlr = *on; //--------------------------------------------- // $checkfile - check for qualified file names //--------------------------------------------- begsr $checkfile; // If user entered an IFS path into the screen field, read that file If FileName > *blanks; if Error_Flag = '1'; // Then Error else; select; // Expects that savings/reserve file is .csv when %scan('.CSV' : %xlate(lo:up:Filename)) > *zeros and %scan('SAVING': %xlate(lo:up:filename)) > *zeros; exsr $savings; // LBI Nightly file is .csv // This is a dump of *ALL employees and can be run every time // and for that matter many times over... // current file employees in library ceridian is cleared // temperary file is created/cleared in QTEMP // text file is processed and data is validated // against HREEMPM and only *CHANGED data will be written to // Ceridian/employees table. when %scan('.CSV' :%xlate(lo:up:Filename)) > *zeros and %scan('NIGHT': %xlate(lo:up:filename)) > *zeros; exsr $employees; // Ceridian/GL Bonus file when %scan('.TXT' :%xlate(lo:up: Filename)) > *zeros and %scan('PRGLB': %xlate(lo:up:filename)) > *zeros; exsr $GLB; // Ceridian/GL file when %scan('.TXT' :%xlate(lo:up: Filename)) > *zeros and %scan('PRGL': %xlate(lo:up:filename)) > *zeros; exsr $GL; // Expects that vacation is .csv when %scan('.CSV' : %xlate(lo:up:Filename)) > *zeros and %scan('VACATION': %xlate(lo:up:filename)) > *zeros; exsr $vacation; // Expects that QTR Bonus information is .csv when %scan('.CSV' : %xlate(lo:up:Filename)) > *zeros and %scan('BONUS': %xlate(lo:up:filename)) > *zeros; exsr $bonus; endsl; endif; endif; endsr; //--------------------------------------------- // $savings - process savings & reserve //--------------------------------------------- begsr $savings; if %open(ceridianp); close ceridianp; endif; cmdstring = 'OVRPRTF FILE(CERIDIANP) OUTQ(PDFEMAIL)' ; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; if not%open(ceridianp); open ceridianp; endif; workTitle = 'Savings & Reserve'; LenStr = ((%len(workTitle) - %len(%trim(workTitle))) / 2) + 1; %subst(P1TITLE:LenStr) = %trim(workTitle); p1program = @pgm; // // CPYFRMIMPF FROMSTMF('/home/HR/ceridian/Savings-Reserve 070210.csv') // TOFILE(CERIDIAN/SAVINGS) RCDDLM(*CRLF) // exsr $ErrorSetup; cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q + %trim(filename) + Q + ') ' + ' TOFILE(CERIDIAN/SAVINGS) RCDDLM(*CRLF) ' + ' MBROPT(*REPLACE) ERRRCDFILE(QTEMP/SOURCE ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; exsr $CheckErrors; endmon; reset writeheader; clear t1savings; clear t1reserve; // write records to table hrrwkpra // check for duplicates sqlstmt2 = 'select * from savings '; openList2(); dow fetchNext2(); // // setup report // if p1fdate = *zeros; p1fdate = %dec(sqldata2.date:*mdy); endif; select; when sqldata2.code = 'SAVE'; clear reserve; saving = sqldata2.amount; when sqldata2.code = 'EQUIP' or sqldata2.code = 'RESER' or sqldata2.code = 'OFFST'; clear saving; reserve = sqldata2.amount; other; clear saving; clear reserve; endsl; keydate = %dec(sqldata2.date:*cymd); clear P1Note; chain (keydate: sqldata2.clock#: saving : reserve) hrrwkpra; if not%found(hrrwkpra); HREMP# = sqldata2.clock#; HRTDAT = keydate; HRSAV = saving; HRRES = reserve; HRIMP = *zeros; write hrrwkprr; else; p1note = '***duplicate record - not added***'; endif; if *in70 or writeheader = *on; write header; writeheader = *off; *in70 = *off; endif; // populate the detail record p1clock# = sqldata2.clock#; p1code = sqldata2.code; p1savings = saving; p1reserve = reserve; write detail; t1savings += p1savings; t1reserve += p1reserve; enddo; closeList2(); write total; write endrpt; if %open(ceridianp); close ceridianp; endif; // // rename to CMP. (complete) This will cause it not to be reprocessed // newname = %replace('.cmp' : name: %scan('.CSV':%xlate(lo:up:name)) :4); cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q + ') NEWOBJ(' + Q + %trim(newname) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //--------------------------------------------- // $employees - process ceridian employee file //--------------------------------------------- begsr $employees; if %open(ceridianp); close ceridianp; endif; if %open(employees); close employees; endif; if %open(hriwkpra); close hriwkpra; endif; cmdstring = 'OVRPRTF FILE(CERIDIANP) OUTQ(PDFEMAIL)' ; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; if not%open(ceridianp); open ceridianp; endif; cmdstring = 'OVRDBF FILE(HRIWKPRA) MBR(LBI_SALARY)' ; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; if not%open(hriwkpra); open hriwkpra; endif; workTitle = 'Changed Employees - ' + %char(%date()); LenStr = ((%len(workTitle) - %len(%trim(workTitle))) / 2) + 1; %subst(P1TITLE:LenStr) = %trim(workTitle); // // CRTDUPOBJ OBJ(EMPLOYEES) FROMLIB(CERIDIAN) OBJTYPE(*FILE) TOLIB(QTEMP) // cmdstring = 'CRTDUPOBJ OBJ(EMPLOYEES) FROMLIB(CERIDIAN)' + ' OBJTYPE(*FILE) TOLIB(QTEMP)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; // clear the file it is already in QTEMP cmdstring = 'CLRPFM QTEMP/EMPLOYEES'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; if not%open(employees); open employees; endif; // // CPYFRMIMPF FROMSTMF('/home/HR/ceridian/LBI Nightly 0630.csv') // TOFILE(QTEMP/EMPLOYEES) RCDDLM(*CRLF) // exsr $ErrorSetup; cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q + %trim(filename) + Q + ') ' + ' TOFILE(QTEMP/EMPLOYEES) RCDDLM(*CRLF)' + ' RPLNULLVAL(*FLDDFT) MBROPT(*REPLACE) ' + ' ERRRCDFILE(QTEMP/SOURCE ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; exsr $CheckErrors; endmon; sqlstmt = 'select * from qtemp/employees ' + ' ORDER BY EMP#' ; reset writeheader; openList(); dow fetchNext(); // knock off the plus 4 if %len(%trim(%editc(sqldata.zipcode:'X'))) > 5 and %subst(%editc(sqldata.zipcode:'X'):1:4) <> '0000'; sqldata.zipcode = %dec(%subst(%editc(sqldata.zipcode:'X'):1:5):5:0); endif; if sqldata.emp# < 90000; reset changedrecorde; reset newemployee; reset terminated; reset retired; clear hreempmr; // Clear fields in printfile to indicate *changes clear p1namec; clear p1addressc; clear p1hired; clear p1termed; clear p1paytype; clear p1statusc; clear p1phonec; clear p1ss#c; clear p1deptc; clear p1suprc; clear p1user1c; clear p1shiftc; clear p1typec; clear p1gender; clear p1mstatus; clear p1mstatusc; clear p1race; clear p1bdate; clear p1jtitlec; clear p1jtitle; clear p1partimc; clear p1partim; // converting ceridian character birthdate to iso workdate = sqldata.birthdate; clear month; clear day; str = 1; clear fnd; clear end; fnd = %scan('/':workdate:str); dow fnd > *zeros; select; when month = *blanks; end = fnd-1; month = %subst(workdate:1:end); if %len(%trim(month)) = 1; month = '0' + %trim(month); endif; when day = *blanks; len = (fnd - str); day = %subst(workdate:str:len); if %len(%trim(day)) = 1; day = '0' + %trim(day); endif; endsl; str = fnd+1; fnd = %scan('/':workdate:str); enddo; year = %subst(workdate:str:4); isodatechar = year + '-' + month + '-' + day; isobirthday = %date(isodatechar); // shift can only be 1,2 or 3 if anything else make '1' if sqldata.shift <> '1' and sqldata.shift <> '2' and sqldata.shift <> '3'; sqldata.shift = '1'; endif; chain(n) (sqldata.emp#) hreempma; if %found(hreempma); // record already exists check for changes // check last name only ex.. Jamie, Flanary J. lastname = %subst(hename:1:%scan(',':hename)-1); monitor; firstname = %trimL(%subst(hename:%scan(',':hename)+1)); on-error; clear firstname; endmon; if %trim(sqldata.suffix) <> '(none)'; sqldata.lastname = %trim(sqldata.lastname) + ' ' + %trim(%xlate('.':' ': sqldata.suffix)); endif; if %xlate(lo:up:lastname) <> %xlate(lo:up:sqldata.lastname) or (%xlate(lo:up:firstname) <> %xlate(lo:up:sqldata.firstname) and firstname <> *blanks and %subst(hename:24:1) = ' '); changedrecorde = *on; p1namec = '*'; endif; // address #1 if %xlate(lo:up:headd1) <> %xlate(lo:up:sqldata.street1); changedrecorde = *on; p1addressc = '*'; endif; // address #2 if %xlate(lo:up:headd2) <> %xlate(lo:up:sqldata.street2); changedrecorde = *on; p1addressc = '*'; endif; // city if %xlate(lo:up:hecity) <> %xlate(lo:up:sqldata.city); changedrecorde = *on; p1addressc = '*'; endif; // state if %xlate(lo:up:hest) <> %xlate(lo:up:sqldata.state); changedrecorde = *on; p1addressc = '*'; endif; // zipcode if hezip <> sqldata.zipcode; changedrecorde = *on; p1addressc = '*'; endif; // phone workphone = %dec(%char(hearea) + %char(hephon):10:0); if workphone <> sqldata.phone; changedrecorde = *on; p1phonec = '*'; endif; // ss# if hess# <> sqldata.ss#; changedrecorde = *on; p1ss#c = '*'; endif; else; // new employee newemployee = *on; p1hired = '$'; endif; // if new employee --or-- record changed then write record to HREEMPM if changedrecorde or newemployee; clear hreempmr; chain (sqldata.emp#) hreempma; HENAME = %trim(sqldata.lastname) + ', ' + %trim(sqldata.firstname); HEADD1 = sqldata.street1; HEADD2 = sqldata.street2; HECITY = sqldata.city; HEST = sqldata.state; HEZIP = sqldata.zipcode; HEAREA = %dec(%subst(%editc(sqldata.phone:'X'):1:3):3:0); HEPHON = %dec(%subst(%editc(sqldata.phone:'X'):4:7):7:0); HESS# = sqldata.ss#; select; when newemployee; HEEMP# = sqldata.emp#; HEEMPT = 'E'; write HREEMPMR; other; // changedrecord update HREEMPMR; endsl; endif; // status, hire date, term date, department // supervisor, leadman and shift must be checked // rate type must be checked (Sex, Race, Marital Status) reset changedrecordf; reset changedrecordg; chain (sqldata.emp#) hrgemppa; if %found(hrgemppa); // part time - y or n reset workparttime; if sqldata.ptstatus <> 'F'; workparttime = 'Y'; endif; if workparttime <> hgpttm; hgpttm = workparttime; p1partimc = '*'; changedrecordG = *on; endif; if sqldata.paytype <> *blanks and sqldata.paytype <> hgratt; HGRATT = sqldata.paytype; changedrecordG = *on; p1typec = '*'; if HGRATT = 'H'; chain (sqldata.emp#) hriwkpra; if %found(hriwkpra); delete hriwkprr; endif; endif; endif; if changedrecordG = *on; update hrgemppr; endif; endif; // race - ceridian sends full description we keep code clear workrace; upperRace = %xlate(lo:up:sqldata.race); select; when %scan('ASIAN':UpperRace) > *zeros; workrace = 'A'; when %scan('BLACK':UpperRace) > *zeros; workrace = 'B'; when %scan('WHITE':UpperRace) > *zeros; workrace = 'W'; when %scan('HISPANIC':UpperRace) > *zeros; workrace = 'H'; when %scan('INDIAN':UpperRace) > *zeros; workrace = 'I'; when %scan('HAWAIIAN':UpperRace) > *zeros; workrace = 'P'; when %scan('TWO':UpperRace) > *zeros; workrace = 'T'; other; workrace = 'U'; endsl; chain(n) (sqldata.emp#) hrfempda; if %found(hrfempda); x = %scan(' ':hfuser1); if x = 1; altx = 0; else; altx = %dec(%subst(hfuser1:1:X-1):5:0); endif; if HFDPT1 <> sqldata.department; changedrecordf = *on; p1deptc = '*'; chain (hfemp#) hriwkpra; if %found(hriwkpra); eval hidpt1 = sqldata.department; update hriwkprr; endif; endif; if HFSUPRNMBR <> sqldata.supervisor; changedrecordf = *on; p1suprc = '*'; endif; if HFHDAT <> %dec(sqldata.hiredate:*cymd); changedrecordf = *on; p1hired = '*'; endif; if HFTDAT <> %dec(sqldata.termdate:*cymd) and %dec(sqldata.termdate:*cymd) <> 0650824; changedrecordf = *on; p1termed = '*'; endif; if (HFACTS = 'N' and %xlate(lo:up:sqldata.status) = 'ACTIVE') or (HFACTS = 'Y' and %xlate(lo:up:sqldata.status) = 'TERMINATED') or (HFACTS = 'Y' and %xlate(lo:up:sqldata.status) = 'DISABLED') or (HFACTS = 'Y' and %xlate(lo:up:sqldata.status) = 'RETIRED'); changedrecordf = *on; p1statusc = '*'; endif; if altx <> sqldata.alternant; p1user1c = '*'; changedrecordf = *on; endif; if hfshift <> sqldata.shift; p1shiftc = '*'; changedrecordf = *on; endif; // additional fields if hfsex <> sqldata.gender; changedrecordf = *on; endif; if hfmsts <> %subst(sqldata.mstatus:1:1); p1mstatusc = '*'; changedrecordf = *on; endif; if hfrace <> workrace; changedrecordf = *on; endif; if HFBDAT <> %dec(isobirthday:*cymd) ; changedrecordf = *on; endif; endif; // Terminated/Retired employees if %found(hrfempda); if %xlate(lo:up:sqldata.status) = 'TERMINATED' and hfacts = 'Y' or %xlate(lo:up:sqldata.status) = 'RETIRED' and hfacts = 'Y' OR %xlate(lo:up:sqldata.status) = 'DISABLED' and hfacts = 'Y'; Terminated = *on; endif; if %xlate(lo:up:sqldata.status) = 'LOA' and hfests <> 'I' or %xlate(lo:up:sqldata.status) = 'LOA PAID' and hfests <> 'I' or %xlate(lo:up:sqldata.status) = 'LOA UNPAID' and hfests <> 'I'; changedrecordf = *on; endif; endif; // if employee changed or *new // write/update record to hrfempda // fields for HRF file // // sqldata.status; // sqldata.hiredate; // sqldata.termdate; // sqldata.department; // sqldata.supervisor; // sqldata.shift; // sqldata.alternant; if changedrecordf or newemployee; clear hrfempdr; chain (sqldata.emp#) hrfempda; HFHDAT = %dec(sqldata.hiredate:*cymd); HFDPT1 = sqldata.department; HFSUPRNMBR = sqldata.supervisor; HFUSER1 = %char(sqldata.alternant); HFSHIFT = sqldata.shift; HFSEX = sqldata.gender; HFMSTS = sqldata.mstatus; HFRACE = workrace; HFBDAT = %dec(isobirthday:*cymd); if %found(hrfempda); select; when %xlate(lo:up:sqldata.status) = 'TERMINATED' or %xlate(lo:up:sqldata.status) = 'RETIRED' or %xlate(lo:up:sqldata.status) = 'DISABLED'; HFACTS = 'N'; HFTDAT = %dec(sqldata.termdate:*cymd); if %xlate(lo:up:sqldata.status) = 'TERMINATED'; HFESTS = 'T'; endif; if %xlate(lo:up:sqldata.status) = 'RETIRED'; HFESTS = 'R'; endif; if %xlate(lo:up:sqldata.status) = 'DISABLED'; HFESTS = 'P'; endif; when %xlate(lo:up:sqldata.status) = 'LOA' or %xlate(lo:up:sqldata.status) = 'LOA PAID' or %xlate(lo:up:sqldata.status) = 'LOA UNPAID'; HFACTS = 'Y'; HFESTS = 'I'; clear HFTDAT; other; HFACTS = 'Y'; clear HFESTS; clear HFTDAT; endsl; update hrfempdr; else; HFEMP# = sqldata.emp#; HFACTS = 'Y'; HFAlc1 = 1.00; write hrfempdr; clear hrgemppr; HGEMP# = sqldata.emp#; if sqldata.paytype = *blanks; HGRATT = 'H'; else; HGRATT = sqldata.paytype; endif; write hrgemppr; endif; endif; p1fdate = %dec(%date():*mdy); if *in70 or writeheader = *on; write header2; writeheader = *off; *in70 = *off; endif; // job title - only one on ceridian and its primary if sqldata.jobtitle <> *blanks; if %subst(sqldata.jobtitle:2:2) = ' '; sqldata.jobtitle = '00' + %subst(sqldata.jobtitle:1:1); endif; if %subst(sqldata.jobtitle:3:1) = ' '; sqldata.jobtitle = '0' + %subst(sqldata.jobtitle:1:2); endif; setll (sqldata.emp#) hrvtitla; if not%equal(hrvtitla); hvemp# = sqldata.emp#; hvjtcd = sqldata.jobtitle; hvpri = 'Y'; write hrvtitlr; p1jtitlec = '*'; changedrecordf = *on; else; // title exists but not primary chain (sqldata.emp#: sqldata.jobtitle) hrvtitla; if %found(hrvtitla) and hvpri <> 'Y'; hvpri = 'Y'; // if more than 1 job title set the rest to "N" update hrvtitlr %fields(hvpri); p1jtitlec = '*'; changedrecordf = *on; exec sql update hrvtitl set hvpri = 'N' where hvemp# = :sqldata.emp# and hvjtcd <> :sqldata.jobtitle; else; // title doesnt exist if not%found(hrvtitla); hvemp# = sqldata.emp#; hvjtcd = sqldata.jobtitle; hvpri = 'Y'; write hrvtitlr; p1jtitlec = '*'; changedrecordf = *on; // if more than 1 job title set the rest to "N" exec sql update hrvtitl set hvpri = 'N' where hvemp# = :sqldata.emp# and hvjtcd <> :sqldata.jobtitle; endif; endif; endif; chain (sqldata.jobtitle) hrujbtla; if not %found(hrujbtla); p1jtitlec = '$'; endif; endif; // only print changed records if changedrecorde or changedrecordf or changedrecordg or newemployee; P1EMP# = sqldata.emp#; P1NAME = %trim(sqldata.lastname) + ', ' + %trim(sqldata.firstname); P1ADDR1 = sqldata.street1; P1ADDR2 = sqldata.street2; P1CITY = sqldata.city; P1STATE = sqldata.state; P1ZIPCODE = sqldata.zipcode; P1PHONE = sqldata.phone; P1SS# = sqldata.ss#; P1STATUS = sqldata.status; P1HIREDT = %dec(sqldata.hiredate:*mdy); if %xlate(lo:up:sqldata.status) = 'TERMINATED' or %xlate(lo:up:sqldata.status) = 'RETIRED' or %xlate(lo:up:sqldata.status) = 'DISABLED'; P1TERMDT = %dec(sqldata.termdate:*mdy); else; clear p1termdt; endif; P1DEPT = sqldata.department; P1SUPR = sqldata.supervisor; P1USER1 = sqldata.alternant; P1SHIFT = sqldata.shift; P1PAYTYPE = sqldata.paytype; // p1gender = sqldata.gender; p1mstatus = sqldata.mstatus; p1race = workrace; monitor; p1bdate = %dec(isobirthday:*mdy); on-error; p1bdate = %dec(month + day + %subst(year:3:2):6:0); endmon; p1jtitle = sqldata.jobtitle; p1partim = workparttime; write detail2; endif; // need to notify IT about change in employee if Terminated or p1deptc = '*'; exsr $SendNotifications; endif; endif; enddo; closeList(); write endrpt; if %open(employees); close employees; endif; if %open(ceridianp); close ceridianp; endif; // // rename to CMP. (complete) This will cause it not to be reprocessed // newname = %replace('.cmp' : name: %scan('.CSV':%xlate(lo:up:name)) :4); cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q + ') NEWOBJ(' + Q + %trim(newname) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //--------------------------------------------- // $GL - process the GL files //--------------------------------------------- begsr $GL; exsr $ErrorSetup; cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q + %trim(filename) + Q + ') ' + ' TOFILE(CERIDIAN/CERIDIANGL) RCDDLM(*CRLF)' + ' RPLNULLVAL(*FLDDFT) MBROPT(*REPLACE) ' + ' ERRRCDFILE(QTEMP/SOURCE ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; // // rename to CMP. (complete) This will cause it not to be reprocessed // newname = %replace('.cmp' : name: %scan('.TXT':%xlate(lo:up:name)) :4); cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q + ') NEWOBJ(' + Q + %trim(newname) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((cgarner@liebovich.com)) + DSTD(''General Ledger'') + MSG(' + Q + 'General Ledger Download complete ' + %TRIM(FILENAME) + Q + ') + LONGMSG(''General Ledger Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((denisep@liebovich.com)) + DSTD(''General Ledger'') + MSG(' + Q + 'General Ledger Download complete ' + %TRIM(FILENAME) + Q + ') + LONGMSG(''General Ledger Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //--------------------------------------------- // $GLB - process the GL files for Bonus //--------------------------------------------- begsr $GLB; exsr $ErrorSetup; cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q + %trim(filename) + Q + ') ' + ' TOFILE(CERIDIAN/CERIDIANGL BONUS) RCDDLM(*CRLF)' + ' RPLNULLVAL(*FLDDFT) MBROPT(*REPLACE) ' + ' ERRRCDFILE(QTEMP/SOURCE ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; // // rename to CMP. (complete) This will cause it not to be reprocessed // newname = %replace('.cmp' : name: %scan('.TXT':%xlate(lo:up:name)) :4); cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q + ') NEWOBJ(' + Q + %trim(newname) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((cgarner@liebovich.com)) + DSTD(''General Ledger'') + MSG(' + Q + 'Gen Ledger Bonus Download complete ' + %TRIM(FILENAME) + Q + ') + LONGMSG(''General Ledger Bonus Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((denisep@liebovich.com)) + DSTD(''General Ledger'') + MSG(' + Q + 'Gen Ledger Bonus Download complete ' + %TRIM(FILENAME) + Q + ') + LONGMSG(''General Ledger Bonus Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //--------------------------------------------- // $vacation - process vacation //--------------------------------------------- begsr $vacation; exsr $ErrorSetup; cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q + %trim(filename) + Q + ') ' + ' TOFILE(CERIDIAN/CERIDIANVA) RCDDLM(*CRLF)' + ' RPLNULLVAL(*FLDDFT) MBROPT(*REPLACE) ' + ' ERRRCDFILE(QTEMP/SOURCE ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; // // rename to CMP. (complete) This will cause it not to be reprocessed // newname = %replace('.cmp' : name: %scan('.CSV':%xlate(lo:up:name)) :4); cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q + ') NEWOBJ(' + Q + %trim(newname) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((cgarner@liebovich.com)) + DSTD(''Vacation'') + MSG(' + Q + 'Vacation Download complete ' + %TRIM(FILENAME) + Q + ') + LONGMSG(''Vacation Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((denisep@liebovich.com)) + DSTD(''Vacation'') + MSG(' + Q + 'Vacation Download complete ' + %TRIM(FILENAME) + Q + ') + LONGMSG(''Vacation Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //--------------------------------------------- // $bonus - QTR bonus information //--------------------------------------------- begsr $bonus; exsr $ErrorSetup; cmdstring = 'CPYFRMIMPF FROMSTMF(' + Q + %trim(filename) + Q + ') ' + ' TOFILE(CERIDIAN/CERIDIANBN) RCDDLM(*CRLF)' + ' RPLNULLVAL(*FLDDFT) MBROPT(*REPLACE) ' + ' ERRRCDFILE(QTEMP/SOURCE ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; // // rename to CMP. (complete) This will cause it not to be reprocessed // newname = %replace('.cmp' : name: %scan('.CSV':%xlate(lo:up:name)) :4); cmdstring = 'RNM OBJ(' + Q + %trim(filename) + Q + ') NEWOBJ(' + Q + %trim(newname) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; cmdstring = 'SNDDST TYPE(*LMSG) + TOINTNET((cgarner@liebovich.com)) + DSTD(''QTR Bonus'') + MSG(''QTR Bonus Download complete'') + LONGMSG(''QTR Bonus Download complete'')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //--------------------------------------------- // $SendNotifications - send notifications of // profile changes. //--------------------------------------------- begsr $SendNotifications; if p1deptc = '*'; chgdept(heemp#:hename:pdsdatc); endif; if Terminated; tdat6 = %dec(sqldata.termdate:*mdy); termed(heemp#:hename:tdat6); endif; endsr; //--------------------------------------------- // $resubmit - resubmit itself //--------------------------------------------- begsr $resubmit; // // SBMJOB CMD(CALL PGM(LBIOBJ/CERIDIANR)) JOB(CERIDIAN) // JOBQ(MONITOR) OUTQ(LBIIT) USER(DAILYCHECK) // cmdstring = 'SBMJOB CMD(CALL PGM(LBIOBJ/CERIDIANR))' + ' JOB(CERIDIAN) ' + ' JOBQ(NEPS) OUTQ(LBIIT) USER(DAILYCHECK)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //----------------------------------------------------- // $GetFileName - read thru directory and get filename //----------------------------------------------------- begsr $GetFileName; filename = *blanks; name = *blanks; pathname = '/home/HR/ceridian/' + %trim(x'00') ; // Step1: Open up the directory root and list all directories dh = closedir(%addr(PathName)); dh = opendir(%addr(PathName)); if dh <> *NULL; // Step2: Read each entry from the directory (in a loop) p_dirent = readdir(dh); dow p_dirent <> *NULL; // FIXME: This code can only handle file/dir names 256 bytes long // because thats the size of "Name" if d_namelen < 256 and %subst(d_name:1:1) <> 'Q'; Name = %subst(d_name:1:d_namelen); // skip directory . and .. only processes .csv documents if Name <> '.' and name <> '..' and name <> *Blanks and (%scan('.CSV':%xlate(lo:up:name)) > *zeros or %scan('.TXT':%xlate(lo:up:name)) > *zeros); filename = '/home/HR/ceridian/' + %trim(name); exsr $checkfile; endif; endif; p_dirent = readdir(dh); enddo; endif; endsr; //--------------------------------------------- // $ErrorSetup - error setup //--------------------------------------------- begsr $ErrorSetup; // // Just delete the error source file in QTEMP // cmdstring = 'DLTF QTEMP/SOURCE'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; // // CRTSRCPF FILE(QTEMP/SOURCE) RCDLEN(2000) MBR(ERRORS) // cmdstring = 'CRTSRCPF FILE(QTEMP/SOURCE) RCDLEN(2000)' + ' MBR(ERRORS)'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endsr; //-------------------------------------------------------- // $CheckErrors - check to see if there are errors //-------------------------------------------------------- begsr $checkErrors; clear errortotal; exec sql select coalesce(count(*),0) into : errortotal from qtemp/source ; // files are always sent with headers // The headers are all *CHAR so when CPYRFMIMPF attempts // to process - an error is generated EVERY Time... so assume & ignore! // if errortotal > 1; // read the file send messages emperror = 'Employees in Error: '; sqlstmt3 = 'select srcdta from qtemp/source'; openList3(); dow fetchNext3(); // first field is the employee number build string of employees for the // email. str = %scan(',':sqldata3); if str > *zeros; len = (str - 1); chr5 = %subst(sqldata3:1:len); if %check('0123456789 ': chr5) = *zeros ; // all decimal data must be employee# if %len(%trim(emperror)) > 19; emperror = %trim(emperror) + ', '; endif; emperror = %trim(emperror) + ' ' + %trim(chr5); endif; endif; enddo; closeList3(); cmdstring = 'SNDDST TYPE(*LMSG) ' + ' TOINTNET((profilechange@liebovich.com))' + ' DSTD(' + Q + 'Download Error' + Q + ') MSG(' + Q + %trim(emperror) + Q + ') LONGMSG(' + Q + %trim(emperror) + Q + ')'; cmdlength = %len(%trim(cmdstring)); monitor; $command(cmdstring:cmdlength); on-error; endmon; endif; endsr; //-------------------------------------------------------- // Hskpg - one time run subroutine //-------------------------------------------------------- begsr Hskpg; mmddyy = pdsdat; xcyy = 100 + yy; xmmdd = mmdd; In *lock ceridianDS; workstamp = %timestamp(ceridianstamp); Unlock ceridianDS; endsr; /end-free *-------------------------------------------------------- * openList - Open a cursor to read file *-------------------------------------------------------- p openList b d openList pi /Free exec sql declare MyCursor cursor for statement; exec sql prepare statement from :sqlstmt; exec sql open mycursor; /End-Free p openList e *-------------------------------------------------------- * fetchNext - read one record at a time *-------------------------------------------------------- p fetchNext b d fetchNext pi n /free exec sql fetch next from mycursor into : sqldata; if sqlstt < '02000'; return *on; else; return *off; endif; /end-free p fetchNext e *-------------------------------------------------------- * closeOrderList - Close the OrderHdr cursor *-------------------------------------------------------- p closeList b d closeList pi /free exec sql close MyCursor; /end-free p closeList e *-------------------------------------------------------- * openList2 - Open a cursor to read file *-------------------------------------------------------- p openList2 b d openList2 pi /Free exec sql declare MyCursor2 cursor for statement2; exec sql prepare statement2 from :sqlstmt2; exec sql open Mycursor2; /End-Free p openList2 e *-------------------------------------------------------- * fetchNext2 - read one record at a time *-------------------------------------------------------- p fetchNext2 b d fetchNext2 pi n /free exec sql fetch next from mycursor2 into : sqldata2; if sqlstt < '02000'; return *on; else; return *off; endif; /end-free p fetchNext2 e *-------------------------------------------------------- * closeList2 - Close the OrderHdr cursor *-------------------------------------------------------- p closeList2 b d closeList2 pi /free exec sql close MyCursor2; /end-free p closeList2 e *-------------------------------------------------------- * openList3 - Open a cursor to read file *-------------------------------------------------------- p openList3 b d openList3 pi /Free exec sql declare MyCursor3 cursor for statement3; exec sql prepare statement3 from :sqlstmt3; exec sql open Mycursor3; /End-Free p openList3 e *-------------------------------------------------------- * fetchNext3 - read one record at a time *-------------------------------------------------------- p fetchNext3 b d fetchNext3 pi n /free exec sql fetch next from mycursor3 into : sqldata3; if sqlstt < '02000'; return *on; else; return *off; endif; /end-free p fetchNext3 e *-------------------------------------------------------- * closeList3 - Close the OrderHdr cursor *-------------------------------------------------------- p closeList3 b d closeList3 pi /free exec sql close MyCursor3; /end-free p closeList3 e