In 1995, while at GE Capital TIP/Space, I was the lead developer in the implementation of PeopleSoft HRMS/Payroll 4.0 (and Payroll Interface to ADP). Our existing HRMS System was a network database called Repertoire (also referred to as Advanced Revelation) which used R/Basic scripting. Database, network access & reporting was very slow. For the data conversion I decided to create very simple R/Basic extracts from Repertoire & transfer them to the mainframe for processing (Assembler). From there they could be loaded into PeopleSoft via Import Manager.
PeopleSoft HRMS/Payroll 4.0 Conversion
The TDHRxxxx R/Basic Scripts create the initial extracts. TDPSxxx 370 Assembler processes manipulate the data. Import Manager loads the transformed data into PeopleSoft.
Additional Assembler Subroutines for Common Data Transformations:
PROGRAM DESCRIPTION PROGRAM DESCRIPTION
******** *********************************** ******** ***********************************
TDPSAMT ORACLE AMOUNT CONVERSION TDPSLST LAST NAME ISOLATION
TDPSCMP COMPANY CODE CONVERSION TDPSNAM EMPLOYEE NAME CONVERSION
TDPSCON CONTACT RELATION CONVERSION TDPSPLN BENEFIT PLAN CONVERSION
TDPSDAT ORACLE DATE CONVERSION TDPSPOL POLICY# PLAN TYPE CONVERSION
TDPSDEP DEPENDENT NAME CONVERSION TDPSREG REG/TEMP CONVERSION
TDPSEDU EDUCATION CODE CONVERSION TDPSREL DEPENDENT RELATION CONVERSION
TDPSEMP EMPLOYEE NUMBER CONVERSION TDPSSTT STATE/PROVINCE VALIDATION
TDPSEST ESTABLISHMENT ID CONVERSION TDPSTTL POSITION TITLE CONVERSION
TDPSGRP PAY GROUP CONVERSION TDPSTYP TYPE/STATUS CONVERSION
TDPSHIR HIREDATE CONVERSION
******** *********************************** ******** ***********************************
I always build common re-useable libraries to eliminate redundancy & maintain integrity.
Job History Conversion - TDHR007 / TDPS007
Job History is probably the most interesting since it requires the most manipulation.
An employee can have multiple extract records that reflects their history with the company. Each record may contain a segment representing Salary, Job Position, Department and Status history. The multi-value history fields are not sorted & are spread out randomly within the employees extract records. Organizing the data within Revelation via R/Basic is counter productive - the language is inferior & runs very slow. For me, developing on the mainframe with ASM370 is simple & very fast.
Below is the Employee Control Break Routine. All data is stored in a table & manipulated once all records for an employee have been read. I construct the matrix very precisely by untangling the unrelated segments & placing them in logical positions. Then I sort all data at once, fixing positions, error checking & adjusting same day segment activity. When all is well the records are formatted for use by Import Manager & written to the output file.
***********************************************************************
* EMPLOYEE BREAK *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
CBREAK EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CLI PEMP,C'$' 1ST TIME THROUGH ???
BE CBREAK1 YES - BYPASS BREAK
*
BAL 6,SRTTAB SORT HISTORY TABLE
BAL 6,FIXTAB FIX SEQ#/POSITIONS
BAL 6,FRSTLN ADJUST FIRST ENTRY
BAL 6,ERRCHK ERROR CHECK ROUTINE
BAL 6,ADJTAB ADJUST SAME-DAY SEGMENTS
BAL 6,HIRFIX PRIOR HISTORY TEST
BAL 6,STATIC CONVERT STATIC DATA
*
LA 9,TABLE LOAD TABLE ADDRESS
CBREAKO EQU *
CLI 0(9),X'FF' END OF TABLE ???
BE CBREAK1 YES - EXIT ROUTINE
CLC TDATE,EMPTY END OF ENTRIES ???
BE CBREAK1 YES - EXIT ROUTINE
*
BAL 6,CLEAR CLEAR RECORD AREA(S)
BAL 6,CNVREC BUILD CONVERSION RECORD
BAL 6,AUDREC BUILD AUDIT RECORD
*
LA 9,TLEN(,9) BUMP TABLE POINTER
B CBREAKO PROCESS NEXT ENTRY
CBREAK1 EQU *
BAL 6,CLRTAB CLEAR HISTORY TABLE
*
LA 5,ISALARY LOAD SALARY AMOUNT
BAL 6,PAYFRQ VALIDATE PAY FREQUENCY
*
CLC IPOSPSP,ZEROES PS POS NBR-P ZEROES ???
BNE *+10 NO - CONTINUE PLEASE
MVC IPOSPSP,BLANKS YES - REPLACE WITH BLANKS
*
CLC IPOSPSE,ZEROES PS POS NBR-E ZEROES ???
BNE *+10 NO - CONTINUE PLEASE
MVC IPOSPSE,BLANKS YES - REPLACE WITH BLANKS
*
CLC IRECENT,BLANKS RECENT HIRE MISSING ???
BNE *+10 NO - CONTINUE PLEASE
MVC IRECENT,IHIRE YES - SET TO HIRE DATE
*
MVC PDATA,IDATA RESET EMPLOYEE DATA
*
OC ISALMAX,ZEROES TURN ON ALL ZONE BITS
OC IJOBMAX,ZEROES TURN ON ALL ZONE BITS
OC IDEPMAX,ZEROES TURN ON ALL ZONE BITS
OC ISTAMAX,ZEROES TURN ON ALL ZONE BITS
PACK PSALMAX,ISALMAX SALARY - MAXIMUM SEQUENCE
PACK PJOBMAX,IJOBMAX JOB - MAXIMUM SEQUENCE
PACK PDEPMAX,IDEPMAX DEPT - MAXIMUM SEQUENCE
PACK PSTAMAX,ISTAMAX STATUS - MAXIMUM SEQUENCE
CBREAKX EQU *
L 6,CBREAK-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
Below is my sort routine for the array. Just a simple Bubble Sort...
***********************************************************************
* SORT HISTORY TABLE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
SRTTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC TRACE(6),=C'START ' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
*
LA 4,TABLE INIT LO PTR - 1ST ENTRY
LA 5,TLEN(,4) INIT HI PTR - 2ND ENTRY
SORTIT EQU *
CLC 0(12,4),0(5) IS LO ENTRY > HI ENTRY ??
BNH BUMPHI NO - BUMP HI PTR
XC 0(TLEN,4),0(5) YES - ISOLATE UNIQUE BITS
XC 0(TLEN,5),0(4) REPLACE LO WITH HI ENTRY
XC 0(TLEN,4),0(5) REPLACE HI WITH LO ENTRY
BUMPHI EQU *
LA 5,TLEN(,5) BUMP HI POINTER
C 5,TLAST HI POINTER PAST LIMIT ??
BNH SORTIT NO - COMPARE AGAIN
BUMPLO EQU *
LA 4,TLEN(,4) YES - BUMP LO POINTER
LA 5,TLEN(,4) RESET HI PTR = LO + 1
C 4,TLAST LO POINTER PAST LIMIT ??
BL SORTIT NO - KEEP SORTING
*
MVC TRACE(6),=C'SRTTAB' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
SRTTABX EQU *
L 6,SRTTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
Repertoire Human Resource System - Job History Extract
Repertoire is a DOS-based HR System that uses an Advanced Revelation Database & the R/Basic language to access data. Running processes, even simple ones, can be very slow on the network (circa 1995). This is a portion of the Job History Extract Module. The data uses a combination of Single Value & Multi Value fields to formulate the output records. The history data for various segments - Salary, Job, Department & Status - is not sorted properly within the system. That's fine. All complex manipulation, validation & sorting is performed afterwards by the Assembler module. R/Basic is used stricty for extracting raw data - nothing more.
***********************************************************************
* *
* MODULE: TDHR007.CONV *
* AUTHOR: TONY DELIA. *
* DATE: 06/09/95. *
* DESC: H/R PEOPLE-SOFT CONVERSION PROGRAM 007. *
* CONV: HISTORY DATA. *
* *
***********************************************************************
<SNIP>...
***********************************************************************
* BUILD CONVERSION RECORD - SINGLE VALUES *
***********************************************************************
CONV.INIT:
MV = 1
CONV.REC(1) = XLATE('EMP',ID,'EMP.NO','X') 'L#8'
CONV.REC(2) = EMP.REC<POS.EMP.COMPANY.NO> 'L#3'
CONV.REC(3) = MV 'R#3'
CONV.REC(4) = MV.MAX 'R#3'
CONV.REC(5) = EMP.REC<POS.EMP.REG.TEMP> 'L#1'
CONV.REC(6) = EMP.REC<POS.EMP.EMP.TYPE> 'L#1'
CONV.REC(7) = EMP.REC<POS.EMP.DEPT.NO> 'L#6'
CONV.REC(8) = OCONV(EMP.REC<POS.EMP.NEXT.SAL.DATE>,"D/J") 'L#10'
CONV.REC(9) = EMP.REC<POS.EMP.GE.POSITION> 'L#5'
CONV.REC(10) = EMP.REC<POS.EMP.POSITION.NO> 'L#10'
POS.KEY = EMP.REC<POS.EMP.POSITION.NO>
CONV.REC(11) = XLATE('EMP',ID,'PS.POSITION.NBR','X') 'R(0)#8'
CONV.REC(12) = XLATE('POS.TABLE',POS.KEY,'PS.POSITION.NBR','X') 'R(0)#8'
CONV.REC(13) = EMP.REC<POS.EMP.STATUS> 'L#1'
CONV.REC(14) = EMP.REC<POS.EMP.SALARY> 'R#10'
CONV.REC(15) = XLATE('EMP',ID,'RATE','X') 'L#1'
CONV.REC(16) = EMP.REC<POS.EMP.JOB.NO> 'L#6'
CONV.REC(17) = XLATE('EMP',ID,'JOB1','X') 'L#10'
GE.KEY = EMP.REC<POS.EMP.GE.POSITION>
CONV.REC(18) = XLATE('USER.TABLE1',GE.KEY,'CUSTOM1','X') 'L#25'
CONV.REC(19) = OCONV(EMP.REC<POS.EMP.HIRE.DATE>,"D/J") 'L#10'
CONV.REC(20) = OCONV(EMP.REC<POS.EMP.MOST.RECENT.HIRE>,"D/J") 'L#10'
RETURN
***********************************************************************
* BUILD CONVERSION RECORD - MULTI VALUES *
***********************************************************************
CONV.LINE:
CONV.REC(3) = MV 'R#3'
CONV.REC(21) = MV.MX1 'R#3'
CONV.REC(22) = OCONV(EMP.REC<POS.EMP.SALARY.DATES,MV>,"D/J") 'L#10'
CONV.REC(23) = EMP.REC<POS.EMP.SALARIES,MV> 'R#10'
CONV.REC(24) = EMP.REC<POS.EMP.RATES,MV> 'L#2'
CONV.REC(25) = EMP.REC<POS.EMP.INC.AMTS,MV> 'R#10'
CONV.REC(26) = EMP.REC<POS.EMP.INC.PERCENTS,MV> 'R#10'
CONV.REC(27) = EMP.REC<POS.EMP.INC.CODES,MV> 'L#3'
CONV.REC(28) = MV.MX2 'R#3'
CONV.REC(29) = OCONV(EMP.REC<POS.EMP.JOB.DATES,MV>,"D/J") 'L#10'
CONV.REC(30) = EMP.REC<POS.EMP.JOB.NOS,MV> 'L#8'
CONV.REC(31) = EMP.REC<POS.EMP.JOB.TITLES,MV> 'L#25'
JOB.KEY = EMP.REC<POS.EMP.JOB.NOS,MV>
CONV.REC(32) = XLATE('JOB.TABLE',JOB.KEY,'GRADE','X') 'R(0)#4'
CONV.REC(33) = EMP.REC<POS.EMP.JOB.CODES,MV> 'L#3'
CONV.REC(34) = XLATE('JOB.TABLE',JOB.KEY,'JOB1','X') 'L#10'
CONV.REC(35) = EMP.REC<POS.EMP.GE.POSITIONS,MV> 'L#4'
GE.KEY = EMP.REC<POS.EMP.GE.POSITIONS,MV>
CONV.REC(36) = XLATE('USER.TABLE1',GE.KEY,'CUSTOM1','X') 'L#25'
CONV.REC(37) = MV.MX3 'R#3'
CONV.REC(38) = OCONV(EMP.REC<POS.EMP.DEPT.DATES,MV>,"D/J") 'L#10'
CONV.REC(39) = EMP.REC<POS.EMP.DEPT.NOS,MV> 'L#8'
CONV.REC(40) = EMP.REC<POS.EMP.DEPT.NAMES,MV> 'L#20'
DEP.KEY = EMP.REC<POS.EMP.DEPT.NOS,MV>
CONV.REC(41) = XLATE('DEPT.TABLE',DEP.KEY,'PS.DEPT.NO','X') 'R(0)#6'
CONV.REC(42) = XLATE('DEPT.TABLE',DEP.KEY,'LOCATION','X') 'L#6'
CONV.REC(43) = MV.MX4 'R#3'
CONV.REC(44) = OCONV(EMP.REC<POS.EMP.STATUS.DATES,MV>,"D/J") 'L#10'
CONV.REC(45) = EMP.REC<POS.EMP.STATUS.CODES,MV> 'L#3'
CONV.REC(46) = EMP.REC<POS.EMP.REASON.CODES,MV> 'R#3'
DOS.LINE = ''
FOR X = 1 TO CONV.MAX
DOS.LINE := CONV.REC(X)
NEXT X
DOS.REC<-1> = DOS.LINE
RETURN
***********************************************************************
<SNIP>
Back to the TDPS007 Assembler Program - this is the Input Record Layout.
***********************************************************************
* H/R CONVERSION RECORD - INPUT *
***********************************************************************
IREC DS 0CL400 H/R CONVERSION RECORD
IDATA DS 0CL(IDATAX-IEMP) DATA - START SEGMENT
IEMP DC CL8'000000' EMPLOYEE ID NUMBER
ICO DC CL3' ' COMPANY CODE
ISEQ DC CL3' ' SEQUENCE
IMAX DC CL3' ' MAXIMUM SEQUENCE
IREG DC CL1' ' REG/TEMP/FULL/PART
ITYPE DC CL1' ' TYPE (EXEMPT/NON-EXEMPT)
IDEPT DC CL6' ' DEPARTMENT
INXTPRF DC CL10'YYYY-MM-DD' NEXT REVIEW DATE
IPOSGE DC CL5' ' GE POSITION NUMBER
IPOSNO DC CL10' ' POSITION NUMBER
IPOSPSE DC CL8' ' PS POSITION NUMBER-E (EMP)
IPOSPSP DC CL8' ' PS POSITION NUMBER-P (POS)
ISTAT DC CL1' ' CURRENT STATUS CODE
ISALARY DC CL10'-ZZZZZZZ99' CURRENT SALARY AMOUNT
IRATE DC CL1' ' CURRENT RATE CODE (A/H)
IJOB# DC CL6' ' CURRENT JOB NUMBER
IJOB#1 DC CL10' ' CURRENT JOB 1
ICUSTOM DC CL25' ' CURRENT CUSTOM USER.TAB1
IHIRE DC CL10'YYYY-MM-DD' HIRE DATE
IRECENT DC CL10'YYYY-MM-DD' MOST RECENT HIRE DATE
IDATAX EQU * DATA - END SEGMENT
*
ISALSEG DS 0CL(ISALX-ISALMAX) SALARY - START SEGMENT
ISALMAX DC CL3' ' SALARY - MAXIMUM SEQUENCE
ISALDATE DC CL10'YYYY-MM-DD' SALARY - DATE
ISALAMT DC CL10'-ZZZZZZZ99' SALARY - AMOUNT
ISALRATE DC CL2' ' SALARY - RATES
ISALINCR DC CL10'-ZZZZZZZ99' SALARY - INCR.AMOUNT
ISALPCTG DC CL10'-ZZZZZZZ99' SALARY - INCR.PERCENT
ISALCODE DC CL3' ' SALARY - INCR.CODE
ISALX EQU * SALARY - END SEGMENT
*
IJOBSEG DS 0CL(IJOBX-IJOBMAX) JOB - START SEGMENT
IJOBMAX DC CL3' ' JOB - MAXIMUM SEQUENCE
IJOBDATE DC CL10'YYYY-MM-DD' JOB - DATE
IJOBNO DC CL8' ' JOB - NUMBER
IJOBTTL DC CL25' ' JOB - TITLE
IJOBGRD DC CL4' ' JOB - GRADES
IJOBCODE DC CL3' ' JOB - CODE
IJOB1 DC CL10' ' JOB - JOB1
IJOBGE DC CL4' ' JOB - GE POSITION
IJOBCUS DC CL25' ' JOB - CUSTOM USER.TAB1
IJOBX EQU * JOB - END SEGMENT
*
IDEPSEG DS 0CL(IDEPX-IDEPMAX) DEPT - START SEGMENT
IDEPMAX DC CL3' ' DEPT - MAXIMUM SEQUENCE
IDEPDATE DC CL10'YYYY-MM-DD' DEPT - DATE
IDEPNO DC CL8' ' DEPT - NUMBER
IDEPNAME DC CL20' ' DEPT - NAME
IDEPPS DC CL6' ' DEPT - PS DEPT NO
IDEPLOC DC CL6' ' DEPT - LOCATION
IDEPX EQU * DEPT - END SEGMENT
*
ISTASEG DS 0CL(ISTAX-ISTAMAX) STATUS - START SEGMENT
ISTAMAX DC CL3' ' STATUS - MAXIMUM SEQUENCE
ISTADATE DC CL10'YYYY-MM-DD' STATUS - DATE
ISTACODE DC CL3' ' STATUS - CODE
ISTAREAS DC CL3' ' STATUS - REASON
ISTAX EQU * STATUS - END SEGMENT
*
IFILL DS CL(L'IREC-(*-IREC)) FILLER
***********************************************************************
All the conversion programs follow the same high coding standards despite developing these rapidly. I was committed to many other projects during this time including company acquisitions.
JCL - Running the Conversion Jobs
//*********************************************************************
//* PEOPLESOFT CONVERSION 007 *
//*********************************************************************
//TDPS007 EXEC PGM=TDPS007,PARM='YYYY/MM/DD'
//STEPLIB DD DISP=SHR,DSN=G1TT00AT.LOAD.LIB
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//PRINTER DD SYSOUT=*
//CARDIN DD DISP=SHR,DSN=G1TTTDT.HR00.EMPNO
//STDWKI DD DISP=OLD,DSN=G1TTTDT.HR07.INPUT
//STDWKO DD DISP=OLD,DSN=G1TTTDT.HR07.OUTPUT,
// DCB=(RECFM=FB,LRECL=400,BLKSIZE=24000)
//STDWKA DD DISP=OLD,DSN=G1TTTDT.HR07.AUDIT,
// DCB=(RECFM=FB,LRECL=400,BLKSIZE=24000)
//STDWKT DD DUMMY,DCB=BLKSIZE=300
//*********************************************************************
The JCL Step to run the TDPS007 Job History Conversion is above. It's a portion of several JCL streams ($STEP1 thru $STEP5) that handle all the conversion, import & reporting functions. When one stream completes it kicks off the next one. All conversion functionality is performed by a single SUBMIT job command - with the exception of PeopleSoft Import Manager.
Complete Assembler Program - TDPS007 - Job History Conversion
TITLE 'TDPS007 - H/R PEOPLESOFT CONVERSION 007 // DELIA'
***********************************************************************
* *
* MODULE: TDPS007. *
* AUTHOR: TONY DELIA. *
* DATE: 07/25/95. *
* DESC: H/R PEOPLESOFT CONVERSION 007. *
* CONV: HISTORY DATA. *
* *
***********************************************************************
EJECT
***********************************************************************
* T D P S 0 0 7 P R O G R A M *
***********************************************************************
TDPS007 SETUP REGS=(12,11,10) BEGIN PROGRAM
***********************************************************************
* MAINLINE PROCEDURE *
***********************************************************************
PRINT NOGEN
USING TDSECT,9 USING TABLE DSECT
BAL 6,GETPARM GET PARM INFORMATION
OPEN (STDWKI,(INPUT)) OPEN INPUT FILE
OPEN (STDWKA,(OUTPUT)) OPEN AUDIT FILE
OPEN (STDWKO,(OUTPUT)) OPEN OUTPUT FILE
OPEN (STDWKT,(OUTPUT)) OPEN TRACE FILE
GETI EQU *
GET STDWKI,IREC READ INPUT RECORD
*
CLC IEMP,PEMP EMPLOYEE BREAK ???
BE *+8 NO - ENTER TABLE ENTRY
BAL 6,CBREAK YES - PROCESS BREAK
ACCUM EQU *
BAL 6,UPDTAB UPDATE HISTORY TABLE
B GETI READ NEXT RECORD
EOFI EQU *
BAL 6,CBREAK PROCESS FINAL BREAK
CLOSE STDWKI CLOSE INPUT FILE
CLOSE STDWKA CLOSE AUDIT FILE
CLOSE STDWKO CLOSE OUTPUT FILE
CLOSE STDWKT CLOSE TRACE FILE
B RETURN EXIT PROGRAM PLEASE
***********************************************************************
EJECT
***********************************************************************
* UPDATE HISTORY TABLE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
UPDTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CLC IJOBGRD,ZEROES JOB GRADE ZEROES ???
BNE *+10 NO - CONTINUE PLEASE
MVC IJOBGRD,BLANKS YES - REPLACE WITH BLANKS
*
CLC IDEPPS,ZEROES PS DEPT# ZEROES ???
BNE *+10 NO - CONTINUE PLEASE
MVC IDEPPS,BLANKS YES - REPLACE WITH BLANKS
*
PACK WSEQ,ISEQ PACK SEQUENCE NUMBER
UPDSAL EQU *
CP PSALMAX,WSEQ PAST MAXIMUM ENTRIES ???
BL UPDJOB YES - TEST NEXT SEGMENT
CLC ISALDATE,BLANKS SEGMENT DATE BLANK ???
BE UPDJOB YES - TEST NEXT SEGMENT
LA 5,ISALAMT LOAD SALARY AMOUNT
BAL 6,PAYFRQ VALIDATE PAY FREQUENCY
MVI WBITS,@SAL SET SEGMENT BITS
MVC WDATE,ISALDATE SET DATE FIELD
BAL 6,FNDTAB FIND TABLE POSITION
MVC TSALSEG,ISALSEG MOVE SEGMENT TO TABLE
UPDJOB EQU *
CP PJOBMAX,WSEQ PAST MAXIMUM ENTRIES ???
BL UPDDEP YES - TEST NEXT SEGMENT
CLC IJOBDATE,BLANKS SEGMENT DATE BLANK ???
BE UPDDEP YES - TEST NEXT SEGMENT
MVI WBITS,@JOB SET SEGMENT BITS
MVC WDATE,IJOBDATE SET DATE FIELD
BAL 6,FNDTAB FIND TABLE POSITION
MVC TJOBSEG,IJOBSEG MOVE SEGMENT TO TABLE
UPDDEP EQU *
CP PDEPMAX,WSEQ PAST MAXIMUM ENTRIES ???
BL UPDSTA YES - TEST NEXT SEGMENT
CLC IDEPDATE,BLANKS SEGMENT DATE BLANK ???
BE UPDSTA YES - TEST NEXT SEGMENT
MVI WBITS,@DEP SET SEGMENT BITS
MVC WDATE,IDEPDATE SET DATE FIELD
BAL 6,FNDTAB FIND TABLE POSITION
MVC TDEPSEG,IDEPSEG MOVE SEGMENT TO TABLE
UPDSTA EQU *
CP PSTAMAX,WSEQ PAST MAXIMUM ENTRIES ???
BL UPDTABX YES - EXIT ROUTINE PLEASE
CLC ISTADATE,BLANKS SEGMENT DATE BLANK ???
BE UPDTABX YES - TEST NEXT SEGMENT
MVI WBITS,@STA SET SEGMENT BITS
MVC WDATE,ISTADATE SET DATE FIELD
BAL 6,FNDTAB FIND TABLE POSITION
MVC TSTASEG,ISTASEG MOVE SEGMENT TO TABLE
UPDTABX EQU *
L 6,UPDTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* FIND/CREATE TABLE ENTRY *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
FNDTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
ZAP WCTR,=P'99' INIT SEQUENCE COUNTER
XC HALF,HALF INIT HALF-WORD
MVC HALF+1(1),WBITS MOVE SEGMENT BITS
*
LA 9,TABLE LOAD TABLE ADDRESS
FNDLOOP EQU *
CLI 0(9),X'FF' END OF TABLE ???
BE ABEND1 YES - ABEND PLEASE
*
CLC TDATE,EMPTY EMPTY POSITION ???
BE FNDNEW YES - CREATE ENTRY
CLC TDATE,WDATE DATE MATCH ???
BNE FNDNXT NO - BUMP TABLE POINTER
*
LH 2,HALF LOAD SEGMENT BITS
EX 2,FNDMSK SEGMENT LOADED ???
BNO FNDHIT NO - CREATE NEW ENTRY
ZAP WCTR,TSEQ YES - SAVE SEQUENCE NUMBER
SP WCTR,=P'1' DECREMENT SEQUENCE COUNTER
FNDNXT EQU *
LA 9,TLEN(,9) BUMP TABLE POINTER
B FNDLOOP TEST NEXT ENTRY
FNDNEW EQU *
MVC TDATE,WDATE CREATE NEW ENTRY
ZAP TSEQ,WCTR SET SEQUENCE NUMBER
FNDHIT EQU *
OC TBITS,WBITS SET SEGMENT BITS
FNDTABX EQU *
L 6,FNDTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
FNDMSK TM TBITS,X'00' SEGMENT BITS (TM INSTR)
***********************************************************************
EJECT
***********************************************************************
* EMPLOYEE BREAK *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
CBREAK EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CLI PEMP,C'$' 1ST TIME THROUGH ???
BE CBREAK1 YES - BYPASS BREAK
*
BAL 6,SRTTAB SORT HISTORY TABLE
BAL 6,FIXTAB FIX SEQ#/POSITIONS
BAL 6,FRSTLN ADJUST FIRST ENTRY
BAL 6,ERRCHK ERROR CHECK ROUTINE
BAL 6,ADJTAB ADJUST SAME-DAY SEGMENTS
BAL 6,HIRFIX PRIOR HISTORY TEST
BAL 6,STATIC CONVERT STATIC DATA
*
LA 9,TABLE LOAD TABLE ADDRESS
CBREAKO EQU *
CLI 0(9),X'FF' END OF TABLE ???
BE CBREAK1 YES - EXIT ROUTINE
CLC TDATE,EMPTY END OF ENTRIES ???
BE CBREAK1 YES - EXIT ROUTINE
*
BAL 6,CLEAR CLEAR RECORD AREA(S)
BAL 6,CNVREC BUILD CONVERSION RECORD
BAL 6,AUDREC BUILD AUDIT RECORD
*
LA 9,TLEN(,9) BUMP TABLE POINTER
B CBREAKO PROCESS NEXT ENTRY
CBREAK1 EQU *
BAL 6,CLRTAB CLEAR HISTORY TABLE
*
LA 5,ISALARY LOAD SALARY AMOUNT
BAL 6,PAYFRQ VALIDATE PAY FREQUENCY
*
CLC IPOSPSP,ZEROES PS POS NBR-P ZEROES ???
BNE *+10 NO - CONTINUE PLEASE
MVC IPOSPSP,BLANKS YES - REPLACE WITH BLANKS
*
CLC IPOSPSE,ZEROES PS POS NBR-E ZEROES ???
BNE *+10 NO - CONTINUE PLEASE
MVC IPOSPSE,BLANKS YES - REPLACE WITH BLANKS
*
CLC IRECENT,BLANKS RECENT HIRE MISSING ???
BNE *+10 NO - CONTINUE PLEASE
MVC IRECENT,IHIRE YES - SET TO HIRE DATE
*
MVC PDATA,IDATA RESET EMPLOYEE DATA
*
OC ISALMAX,ZEROES TURN ON ALL ZONE BITS
OC IJOBMAX,ZEROES TURN ON ALL ZONE BITS
OC IDEPMAX,ZEROES TURN ON ALL ZONE BITS
OC ISTAMAX,ZEROES TURN ON ALL ZONE BITS
PACK PSALMAX,ISALMAX SALARY - MAXIMUM SEQUENCE
PACK PJOBMAX,IJOBMAX JOB - MAXIMUM SEQUENCE
PACK PDEPMAX,IDEPMAX DEPT - MAXIMUM SEQUENCE
PACK PSTAMAX,ISTAMAX STATUS - MAXIMUM SEQUENCE
CBREAKX EQU *
L 6,CBREAK-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* SORT HISTORY TABLE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
SRTTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC TRACE(6),=C'START ' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
*
LA 4,TABLE INIT LO PTR - 1ST ENTRY
LA 5,TLEN(,4) INIT HI PTR - 2ND ENTRY
SORTIT EQU *
CLC 0(12,4),0(5) IS LO ENTRY > HI ENTRY ??
BNH BUMPHI NO - BUMP HI PTR
XC 0(TLEN,4),0(5) YES - ISOLATE UNIQUE BITS
XC 0(TLEN,5),0(4) REPLACE LO WITH HI ENTRY
XC 0(TLEN,4),0(5) REPLACE HI WITH LO ENTRY
BUMPHI EQU *
LA 5,TLEN(,5) BUMP HI POINTER
C 5,TLAST HI POINTER PAST LIMIT ??
BNH SORTIT NO - COMPARE AGAIN
BUMPLO EQU *
LA 4,TLEN(,4) YES - BUMP LO POINTER
LA 5,TLEN(,4) RESET HI PTR = LO + 1
C 4,TLAST LO POINTER PAST LIMIT ??
BL SORTIT NO - KEEP SORTING
*
MVC TRACE(6),=C'SRTTAB' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
SRTTABX EQU *
L 6,SRTTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* FIX SEQUENCE NUMBERS/JOB POSITIONS *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
FIXTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
ZAP WCTR,=P'0' INIT ADJUSTMENT COUNT
LA 9,TABLE LOAD TABLE ADDRESS
LA 8,POSTAB LOAD POSITION ADDRESS
FIXLP1 EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE FIXLP2 YES - MAKE ADJUSTMENTS
CLC TDATE,EMPTY EMPTY TABLE SLOT ???
BE FIXLP2 YES - MAKE ADJUSTMENTS
TM TBITS,@JOB JOB SEGMENT ???
BNO FIXBP1 NO - CONTINUE PLEASE
*
CLC TJOBGE,BLANKS MISSING POSITION ???
BE FIXBP1 YES - BYPASS POSITION
AP WCTR,=P'1' INCREMENT POSITIONS
MVC 0(4,8),TJOBGE MOVE POSITION NUMBER
MVI 4(8),C' ' INIT POSITION SOURCE
MVC 5(25,8),TJOBCUS MOVE POSITION TITLE
LA 8,30(,8) BUMP POSITION POINTER
FIXBP1 EQU *
LA 9,TLEN(,9) BUMP TABLE POINTER
B FIXLP1 TEST NEXT TABLE ENTRY
FIXLP2 EQU *
CP WCTR,PJOBMAX MAXIMUM JOB SEGMENTS ???
BNL FIXGO3 YES - REALIGN POSITIONS
AP WCTR,=P'1' INCREMENT POSITIONS
MVC 0(4,8),PPOSGE MOVE CURRENT POSITION
MVI 4(8),C'*' MOVE POSITION SOURCE
MVC 5(25,8),PCUSTOM MOVE CURRENT TITLE
LA 8,30(,8) BUMP POSITION POINTER
B FIXLP2 ADJUST NEXT POSITION
FIXGO3 EQU *
ZAP WCTR,=P'0' INIT EFFECTIVE SEQUENCE
MVC WDATE,=10X'AA' INIT PREVIOUS DATE
LA 9,TABLE LOAD TABLE ADDRESS
LA 8,POSTAB LOAD POSITION ADDRESS
FIXLP3 EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE FIXTABT YES - EXIT ROUTINE
CLC TDATE,EMPTY EMPTY TABLE SLOT ???
BE FIXTABT YES - EXIT ROUTINE
TM TBITS,@JOB JOB SEGMENT ???
BNO FIXBP3 NO - CONTINUE PLEASE
*
MVC TJOBGE,0(8) MOVE POSITION NUMBER
MVC TJOBCUS,5(8) MOVE POSITION TITLE
CLI 4(8),C'*' CURRENT POSITION ???
BNE *+10 NO - CONTINUE PLEASE
OC TERRS,SET14 YES - SET ERROR BITS
*
LA 8,30(,8) BUMP POSITION POINTER
FIXBP3 EQU *
AP WCTR,=P'1' INCREMENT EFF.SEQUENCE
CLC WDATE,TDATE DUPLICATE DATE ???
BE *+10 YES - CONTINUE PLEASE
ZAP WCTR,=P'0' NO - RESET EFF.SEQUENCE
*
ZAP TSEQ,WCTR RESET EFFECTIVE SEQ#
MVC WDATE,TDATE RESET EFFECTIVE DATE
LA 9,TLEN(,9) BUMP TABLE POINTER
B FIXLP3 TEST NEXT TABLE ENTRY
FIXTABT EQU *
MVC TRACE(6),=C'FIXTAB' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
FIXTABX EQU *
L 6,FIXTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* ADJUST FIRST TABLE ENTRY (SAME-DAY SEGMENT ACTIVITY) *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
FRSTLN EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
LA 9,TABLE LOAD TABLE ADDRESS
*
MVI FRSSAL+1,X'00' INIT SALARY TEST SWITCH
MVI FRSJOB+1,X'00' INIT JOB TEST SWITCH
MVI FRSDEP+1,X'00' INIT DEPT TEST SWITCH
MVI FRSSTA+1,X'00' INIT STATUS TEST SWITCH
*
MVC HSALSEG,TSALSEG INIT FIRST SAL SEGMENT
MVC HJOBSEG,TJOBSEG INIT FIRST JOB SEGMENT
MVC HDEPSEG,TDEPSEG INIT FIRST DEP SEGMENT
MVC HSTASEG,TSTASEG INIT FIRST STA SEGMENT
FRSTLP EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE FRSTST YES - MAKE ADJUSTMENTS
CLC TDATE,EMPTY EMPTY TABLE SLOT ???
BE FRSTST YES - MAKE ADJUSTMENTS
CLC TDATE,TABLE 1ST ENTRY DATE ???
BH FRSTST NO - SET 1ST ENTRY LINE
FRSSAL BC 0,FRSJOB
TM TBITS,@SAL SALARY SEGMENT ???
BNO FRSJOB NO - CONTINUE PLEASE
OI FRSSAL+1,X'F0' RESET TEST SWITCH
MVC HSALSEG,TSALSEG REPLACE FIRST SEGMENT
FRSJOB BC 0,FRSDEP
TM TBITS,@JOB JOB SEGMENT ???
BNO FRSDEP NO - CONTINUE PLEASE
OI FRSJOB+1,X'F0' RESET TEST SWITCH
MVC HJOBSEG,TJOBSEG REPLACE FIRST SEGMENT
FRSDEP BC 0,FRSSTA
TM TBITS,@DEP DEPT SEGMENT ???
BNO FRSSTA NO - CONTINUE PLEASE
OI FRSDEP+1,X'F0' RESET TEST SWITCH
MVC HDEPSEG,TDEPSEG REPLACE FIRST SEGMENT
FRSSTA BC 0,FRSBMP
TM TBITS,@STA STATUS SEGMENT ???
BNO FRSBMP NO - CONTINUE PLEASE
OI FRSSTA+1,X'F0' RESET TEST SWITCH
MVC HSTASEG,TSTASEG REPLACE FIRST SEGMENT
FRSBMP EQU *
LA 9,TLEN(,9) BUMP TABLE POINTER
B FRSTLP TEST NEXT TABLE ENTRY
FRSTST EQU *
LA 9,TABLE LOAD TABLE ADDRESS
CLI FRSSAL+1,X'00' REPLACE SEGMENT ???
BE *+22 NO - CONTINUE PLEASE
TM TBITS,@SAL SEGMENT PRESENT ???
BO *+14 YES - CONTINUE PLEASE
OI TBITS,@SAL SET SEGMENT BITS
MVC TSALSEG,HSALSEG MOVE FIRST OCCURRANCE
*
CLI FRSJOB+1,X'00' REPLACE SEGMENT ???
BE *+22 NO - CONTINUE PLEASE
TM TBITS,@JOB SEGMENT PRESENT ???
BO *+14 YES - CONTINUE PLEASE
OI TBITS,@JOB SET SEGMENT BITS
MVC TJOBSEG,HJOBSEG MOVE FIRST OCCURRANCE
*
CLI FRSDEP+1,X'00' REPLACE SEGMENT ???
BE *+22 NO - CONTINUE PLEASE
TM TBITS,@DEP SEGMENT PRESENT ???
BO *+14 YES - CONTINUE PLEASE
OI TBITS,@DEP SET SEGMENT BITS
MVC TDEPSEG,HDEPSEG MOVE FIRST OCCURRANCE
*
CLI FRSSTA+1,X'00' REPLACE SEGMENT ???
BE *+22 NO - CONTINUE PLEASE
TM TBITS,@STA SEGMENT PRESENT ???
BO *+14 YES - CONTINUE PLEASE
OI TBITS,@STA SET SEGMENT BITS
MVC TSTASEG,HSTASEG MOVE FIRST OCCURRANCE
*
MVC TRACE(6),=C'FRSTLN' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
FRSTLNX EQU *
L 6,FRSTLN-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* ERROR CHECK *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
ERRCHK EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC PERRS,=X'0000' INIT ERROR BITS
MVI PBITS,X'00' INIT SEGMENT BITS
MVC WJOB,BLANKS INIT EARLIEST JOB DATE
MVI ERRBIT+1,X'00' INIT SEGMENT BIT TEST
MVI ERRSAL2+1,X'00' INIT HIRE DATE TEST
MVI ERRJOB2+1,X'00' INIT HIRE DATE TEST
MVI ERRDEP2+1,X'00' INIT HIRE DATE TEST
MVI ERRSTA2+1,X'00' INIT HIRE DATE TEST
*
CLC PPOSPSE,BLANKS PS POS NBR-E BLANK ???
BNE *+20 NO - CONTINUE PLEASE
CLC PPOSPSP,BLANKS PS POS NBR-P BLANK ???
BNE *+10 NO - CONTINUE PLEASE
OC PERRS,SET16 YES - SET ERROR BIT
*
LA 9,TABLE LOAD TABLE ADDRESS
ERRLP1 EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE ERRHIRE YES - ERROR DETECTED
CLC TDATE,EMPTY END OF ENTRIES ???
BE ERRHIRE YES - ERROR DETECTED
TM TBITS,@JOB JOB SEGMENT ???
BO ERRTST1 YES - EARLIEST JOB DATE
LA 9,TLEN(,9) BUMP TABLE POINTER
B ERRLP1 TEST NEXT TABLE ENTRY
ERRTST1 EQU *
MVC WJOB,TDATE MOVE EARLIEST JOB DATE
BAL 6,SETDATE DETERMINE HIRE DATE
CLI WERR,C'E' ERROR DETECTED ???
BNE ERREND1 NO - END OF TEST 1
ERRHIRE EQU *
OC TERRS,SET02 SET ERROR BITS
MVI ERRSAL2+1,X'F0' SKIP HIRE DATE TEST
MVI ERRJOB2+1,X'F0' SKIP HIRE DATE TEST
MVI ERRDEP2+1,X'F0' SKIP HIRE DATE TEST
MVI ERRSTA2+1,X'F0' SKIP HIRE DATE TEST
ERREND1 EQU *
LA 9,TABLE LOAD TABLE ADDRESS
ERRLP2 EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE ERRSEG YES - TEST SEGMENT BITS
CLC TDATE,EMPTY END OF ENTRIES ???
BE ERRSEG YES - TEST SEGMENT BITS
ERRBIT BC 0,*+22
OI *-3,X'F0' INITIAL RECORD ONLY
CLI TBITS,X'F0' ALL SEGMENTS PRESENT ???
BE *+10 YES - CONTINUE PLEASE
OC TERRS,SET13 NO - SET ERROR BITS
*
CLC CDATE,TDATE CURRENT < ENTRY DATE ???
BNL *+10 NO - CONTINUE PLEASE
OC TERRS,SET15 YES - SET ERROR BITS
ERRSAL1 EQU *
TM TBITS,@SAL SEGMENT PRESENT ???
BNO ERRJOB1 NO - NEXT SEGMENT
ERRSAL2 BC 0,ERRJOB1
MVI *-3,X'F0' TEST FIRST DATE ONLY
CLC TDATE,WHIRE EARLIEST DATE = HIRE ???
BE ERRJOB1 YES - NEXT SEGMENT
CLC TDATE,WREHIRED EARLIEST DATE = REHIRE ???
BE ERRJOB1 YES - NEXT SEGMENT
CLC TDATE,PHIRE EARLIEST DATE = HIRE ???
BE ERRJOB1 YES - NEXT SEGMENT
CLC TDATE,PRECENT EARLIEST DATE = RECENT ???
BE ERRJOB1 YES - NEXT SEGMENT
OC TERRS,SET05 NO - SET ERROR BITS
ERRJOB1 EQU *
TM TBITS,@JOB SEGMENT PRESENT ???
BNO ERRDEP1 NO - NEXT SEGMENT
*
CLC TJOB1,BLANK JOB1 MISSING ???
BNE *+10 NO - CONTINUE PLEASE
OC TERRS,SET09 YES - SET ERROR BITS
ERRJOB2 BC 0,ERRDEP1
MVI *-3,X'F0' TEST FIRST DATE ONLY
CLC TDATE,WHIRE EARLIEST DATE = HIRE ???
BE ERRDEP1 YES - NEXT SEGMENT
CLC TDATE,WREHIRED EARLIEST DATE = REHIRE ???
BE ERRDEP1 YES - NEXT SEGMENT
CLC TDATE,PHIRE EARLIEST DATE = HIRE ???
BE ERRDEP1 YES - NEXT SEGMENT
CLC TDATE,PRECENT EARLIEST DATE = RECENT ???
BE ERRDEP1 YES - NEXT SEGMENT
OC TERRS,SET06 NO - SET ERROR BITS
ERRDEP1 EQU *
TM TBITS,@DEP SEGMENT PRESENT ???
BNO ERRSTA1 NO - NEXT SEGMENT
*
CLC TDEPPS,BLANK P.S.DEPT# MISSING ???
BNE *+10 NO - CONTINUE PLEASE
OC TERRS,SET10 YES - SET ERROR BITS
*
CLC TDEPLOC,BLANK LOCATION MISSING ???
BNE *+10 NO - CONTINUE PLEASE
OC TERRS,SET11 YES - SET ERROR BITS
ERRDEP2 BC 0,ERRSTA1
MVI *-3,X'F0' TEST FIRST DATE ONLY
CLC TDATE,WHIRE EARLIEST DATE = HIRE ???
BE ERRSTA1 YES - NEXT SEGMENT
CLC TDATE,WREHIRED EARLIEST DATE = REHIRE ???
BE ERRSTA1 YES - NEXT SEGMENT
CLC TDATE,PHIRE EARLIEST DATE = HIRE ???
BE ERRSTA1 YES - NEXT SEGMENT
CLC TDATE,PRECENT EARLIEST DATE = RECENT ???
BE ERRSTA1 YES - NEXT SEGMENT
OC TERRS,SET07 NO - SET ERROR BITS
ERRSTA1 EQU *
TM TBITS,@STA SEGMENT PRESENT ???
BNO ERRBMP NO - BUMP POINTER
ERRSTA2 BC 0,ERRBMP
MVI *-3,X'F0' TEST FIRST DATE ONLY
CLC TDATE,WHIRE EARLIEST DATE = HIRE ???
BE ERRBMP YES - BUMP POINTER
CLC TDATE,WREHIRED EARLIEST DATE = REHIRE ???
BE ERRBMP YES - NEXT SEGMENT
CLC TDATE,PHIRE EARLIEST DATE = HIRE ???
BE ERRBMP YES - NEXT SEGMENT
CLC TDATE,PRECENT EARLIEST DATE = RECENT ???
BE ERRBMP YES - NEXT SEGMENT
OC TERRS,SET08 NO - SET ERROR BITS
ERRBMP EQU *
OC PERRS,TERRS SET MAIN ERROR BITS
OC PBITS,TBITS SET MAIN SEGMENT BITS
LA 9,TLEN(,9) BUMP TABLE POINTER
B ERRLP2 TEST NEXT TABLE ENTRY
ERRSEG EQU *
CLI PBITS,X'F0' ALL SEGMENTS PRESENT ???
BE *+10 YES - CONTINUE PLEASE
OC PERRS,SET13 NO - SET ERROR BITS
*
MVC TRACE(6),=C'ERRCHK' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
ERRCHKX EQU *
L 6,ERRCHK-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* SET CONVERSION DATES (TDPS-HIR) *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
SETDATE EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CNOP 0,4 FULLWORD ALLIGNMENT
BAL 1,SETLOAD LOAD PARMLIST ADDRESS
*
DC A(PHIRE) INPUT PARAMETER NO.1
DC A(PRECENT) INPUT PARAMETER NO.2
DC A(WJOB) INPUT PARAMETER NO.3
DC A(WHIRE) OUTPUT PARAMETER NO.1
DC A(WSERVICD) OUTPUT PARAMETER NO.2
DC A(WREHIRED) OUTPUT PARAMETER NO.3
DC A(WERR) OUTPUT PARAMETER NO.4
*
DC V(TDPSHIR) EXTERNAL SUBROUTINE
SETLOAD EQU *
L 15,*-4 LOAD SUBROUTINE ADDRESS
BALR 14,15 EXECUTE EXTERNAL ROUTINE
SETDATEX EQU *
L 6,SETDATE-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* ADJUST SAME-DAY SEGMENT ACTIVITY (PROPAGATE THRU TABLE) *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
ADJTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVI HSALSEG,C' ' INIT SALARY SEGMENT BYTE
MVC HSALSEG+1(@SALL-1),HSALSEG INIT SALARY SEGMENT AREA
MVI HJOBSEG,C' ' INIT JOB SEGMENT BYTE
MVC HJOBSEG+1(@JOBL-1),HJOBSEG INIT JOB SEGMENT AREA
MVI HDEPSEG,C' ' INIT DEPT SEGMENT BYTE
MVC HDEPSEG+1(@DEPL-1),HDEPSEG INIT DEPT SEGMENT AREA
MVI HSTASEG,C' ' INIT STATUS SEGMENT BYTE
MVC HSTASEG+1(@STAL-1),HSTASEG INIT STATUS SEGMENT AREA
*
MVI ADJ1SAL+1,X'00' INIT SALARY TEST SWITCH
MVI ADJ1JOB+1,X'00' INIT JOB TEST SWITCH
MVI ADJ1DEP+1,X'00' INIT DEPT TEST SWITCH
MVI ADJ1STA+1,X'00' INIT STATUS TEST SWITCH
*
LA 9,TABLE LOAD TABLE ADDRESS
ADJ1LP EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE ADJUST YES - MAKE ADJUSTMENTS
CLC TDATE,EMPTY EMPTY TABLE SLOT ???
BE ADJUST YES - MAKE ADJUSTMENTS
ADJ1SAL BC 0,ADJ1JOB
TM TBITS,@SAL SALARY SEGMENT ???
BNO ADJ1JOB NO - CONTINUE PLEASE
OI ADJ1SAL+1,X'F0' RESET SEGMENT TEST SWITCH
MVC HSALSEG,TSALSEG MOVE TABLE SEGMENT
ADJ1JOB BC 0,ADJ1DEP
TM TBITS,@JOB JOB SEGMENT ???
BNO ADJ1DEP NO - CONTINUE PLEASE
OI ADJ1JOB+1,X'F0' RESET SEGMENT TEST SWITCH
MVC HJOBSEG,TJOBSEG MOVE TABLE SEGMENT
ADJ1DEP BC 0,ADJ1STA
TM TBITS,@DEP DEPT SEGMENT ???
BNO ADJ1STA NO - CONTINUE PLEASE
OI ADJ1DEP+1,X'F0' RESET SEGMENT TEST SWITCH
MVC HDEPSEG,TDEPSEG MOVE TABLE SEGMENT
ADJ1STA BC 0,ADJ1BMP
TM TBITS,@STA STATUS SEGMENT ???
BNO ADJ1BMP NO - CONTINUE PLEASE
OI ADJ1STA+1,X'F0' RESET SEGMENT TEST SWITCH
MVC HSTASEG,TSTASEG MOVE TABLE SEGMENT
ADJ1BMP EQU *
LA 9,TLEN(,9) BUMP TABLE POINTER
B ADJ1LP TEST NEXT ENTRY
ADJUST EQU *
LA 9,TABLE LOAD TABLE ADDRESS
ADJ2LP EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE ADJTABT YES - EXIT ROUTINE PLEASE
CLC TDATE,EMPTY EMPTY TABLE SLOT ???
BE ADJTABT YES - EXIT ROUTINE PLEASE
ADJ2SAL EQU *
TM TBITS,@SAL SALARY SEGMENT ???
BO *+24 YES - RESET SEGMENT DATA
CLC TDATE,HSALSEG+3 SAME DAY SEGMENT ???
BL ADJ2JOB NO - CONTINUE PLEASE
MVC TSALSEG,HSALSEG YES - MOVE SEGMENT DATA
OI TBITS,@SAL SET SEGMENT BITS
*
MVC HSALSEG,TSALSEG RESET SEGMENT DATA
ADJ2JOB EQU *
TM TBITS,@JOB JOB SEGMENT ???
BO *+24 YES - RESET SEGMENT DATA
CLC TDATE,HJOBSEG+3 SAME DAY SEGMENT ???
BL ADJ2DEP NO - CONTINUE PLEASE
MVC TJOBSEG,HJOBSEG YES - MOVE SEGMENT DATA
OI TBITS,@JOB SET SEGMENT BITS
*
MVC HJOBSEG,TJOBSEG RESET SEGMENT DATA
ADJ2DEP EQU *
TM TBITS,@DEP DEPT SEGMENT ???
BO *+24 YES - RESET SEGMENT DATA
CLC TDATE,HDEPSEG+3 SAME DAY SEGMENT ???
BL ADJ2STA NO - CONTINUE PLEASE
MVC TDEPSEG,HDEPSEG YES - MOVE SEGMENT DATA
OI TBITS,@DEP SET SEGMENT BITS
*
MVC HDEPSEG,TDEPSEG RESET SEGMENT DATA
ADJ2STA EQU *
TM TBITS,@STA STATUS SEGMENT ???
BO *+24 YES - RESET SEGMENT DATA
CLC TDATE,HSTASEG+3 SAME DAY SEGMENT ???
BL ADJ2BMP NO - CONTINUE PLEASE
MVC TSTASEG,HSTASEG YES - MOVE SEGMENT DATA
OI TBITS,@STA SET SEGMENT BITS
*
MVC HSTASEG,TSTASEG RESET SEGMENT DATA
ADJ2BMP EQU *
LA 9,TLEN(,9) BUMP TABLE POINTER
B ADJ2LP TEST NEXT ENTRY
ADJTABT EQU *
MVC TRACE(6),=C'ADJTAB' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
ADJTABX EQU *
L 6,ADJTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* HIRE DATE HISTORY ADJUSTMENT *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
HIRFIX EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CLC PRECENT,PHIRE MULTIPLE HIRE DATES ???
BNH HIRFIXX NO - EXIT ROUTINE NOW
*
MVC HERRS,=X'0000' INIT ERROR SWITCH
MVI HIRCUR+1,X'00' INIT CURRENT HISTORY
MVI HIRPRI+1,X'00' INIT PRIOR HISTORY
MVI HIRSUB+1,X'00' INIT PRIOR SUBSEQUENT
*
LA 9,TABLE LOAD TABLE ADDRESS
HIRLOOP EQU *
CLI TDATE,X'FF' END OF TABLE ???
BE HIRSET YES - APPLY CHANGES
CLC TDATE,EMPTY EMPTY TABLE SLOT ???
BE HIRSET YES - APPLY CHANGES
*
CLC TDATE,PRECENT CURRENT HISTORY ???
BL HIRPRI NO - PRIOR HISTORY
*
HIRCUR BC 0,HIRBMP 1ST RECORD (CURRENT) ???
OI *-3,X'F0' NO - CONTINUE PLEASE
TM HERRS+1,X'10' BYPASS PRIOR HISTORY ???
BNO HIRBMP NO - CONTINUE PLEASE
CLI TBITS,X'F0' ALL SEGMENTS PRESENT ???
BE HIRBMP YES - CONTINUE PLEASE
OC TERRS,SET13 NO - SET ERROR BITS
B HIRBMP BUMP TABLE POINTER
*
HIRPRI BC 0,HIRSUB 1ST RECORD (PRIOR) ???
OI *-3,X'F0' NO - CONTINUE PLEASE
*
TM TERRS,X'80' CRITICAL ERROR ???
BNO HIRBMP NO - CONTINUE PLEASE
MVI HIRSUB+1,X'F0' YES - SET REJECT SWITCH
B HIRREJ REJECT PRIOR HISTORY
HIRSUB BC 0,HIRREJ
TM TERRS,X'80' CRITICAL ERROR ???
BNO HIRBMP NO - CONTINUE PLEASE
HIRREJ EQU *
OC TERRS,SET12 SET ERROR BITS
NI TERRS,X'7F' SET NON-CRITICAL BIT
HIRBMP EQU *
OC HERRS,TERRS SET MAIN ERROR BITS
LA 9,TLEN(,9) BUMP TABLE POINTER
B HIRLOOP TEST NEXT ENTRY
HIRSET EQU *
MVC PERRS,HERRS RESET MAIN ERROR BITS
*
MVC TRACE(6),=C'HIRFIX' SET TRACE DESCRIPTION
BAL 6,TRCTAB WRITE TRACE TABLE
HIRFIXX EQU *
L 6,HIRFIX-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* TRACE TABLE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
TRCTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CLC TREMP,PEMP EMPLOYEE MATCH ???
BNE TRCTABX NO - EXIT ROUTINE PLEASE
*
LA 9,TABLE LOAD TABLE ADDRESS
TRCLKP EQU *
CLI 0(9),X'FF' END OF TABLE ???
BE TRCTABX YES - EXIT ROUTINE
CLC TDATE,EMPTY END OF ENTRIES ???
BE TRCTABX YES - EXIT ROUTINE
*
MVC TRACE+16(TLEN),0(9) MOVE TABLE ENTRY
PUT STDWKT,TRACE WRITE TRACE RECORD
*
LA 9,TLEN(,9) BUMP TABLE POINTER
B TRCLKP PROCESS NEXT ENTRY
TRCTABX EQU *
L 6,TRCTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* BUILD STATIC DATA *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
STATIC EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
BAL 6,EMPNUM CONVERT EMPLOYEE NUMBER
*
PACK WORK(4),EMPNO PACK PS EMPLOYEE NUMBER
AP WORK(4),=P'2000' ADD 2000 TO PS EMP#
OI WORK+3,X'0F' TURN ON ALL SIGN BITS
UNPK PPOSPSE,WORK(4) REPLACE PS POS NBR-E
*
CLI PSTAT,C'A' STATUS = ACTIVE ???
BE *+24 YES - CONTINUE PLEASE
CLI PSTAT,C'L' STATUS = ON-LEAVE ???
BE *+16 YES - CONTINUE PLEASE
MVC PPOSPSP,BLANKS CLEAR PS POSITION-P
MVC PPOSPSE,BLANKS CLEAR PS POSITION-E
*
CALL TDPSGRP,(PCO,PDEPT,STGRP) CONVERT PAY GROUP
CALL TDPSCMP,(PDEPT,STCO) CONVERT COMPANY
CALL TDPSREG,(PREG,STFL,STRG,STHR) CONVERT FULL/REG/HRS
CALL TDPSTYP,(PTYPE,STTYPE,STFLSA) CONVERT TYPE/FLSA
*
MVI HDATA,C' ' MOVE BLANK TO HOLD DATA
MVC HDATA+1(HDATAX-HDATA-1),HDATA CLEAR HOLD DATA AREA
*
MVC WACT,=C'HIR' INIT ACTION CODE
STATICX EQU *
L 6,STATIC-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* BUILD CONVERSION RECORD *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
CNVREC EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
TM PERRS,X'80' CRITICAL ERROR ???
BO CNVRECX YES - BYPASS ROUTINE
TM TERRS+1,X'10' BYPASS PRIOR HISTORY ???
BO CNVRECX YES - BYPASS ROUTINE
*
TM TBITS,@SAL SALARY SEGMENT ???
BNO *+16 NO - CONTINUE PLEASE
MVC HSALAMT,TSALAMT HOLD SALARY AMOUNT
MVC HSALRATE,TSALRATE HOLD SALARY RATE
*
TM TBITS,@JOB JOB SEGMENT ???
BNO *+22 NO - CONTINUE PLEASE
MVC HJOBGRD,TJOBGRD HOLD JOB GRADE
MVC HJOB1,TJOB1 HOLD JOB CODE
MVC HJOBGE,TJOBGE HOLD JOB GE POSITION
*
TM TBITS,@DEP DEPT SEGMENT ???
BNO *+22 NO - CONTINUE PLEASE
MVC HDEPNO,TDEPNO HOLD DEPT NUMBER
MVC HDEPPS,TDEPPS HOLD DEPT PS NUMBER
MVC HDEPLOC,TDEPLOC HOLD DEPT LOCATION
*
TM TBITS,@STA STATUS SEGMENT ???
BNO *+10 NO - CONTINUE PLEASE
MVC HSTACODE,TSTACODE HOLD DEPT LOCATION
*
BAL 6,ENTRY DETERMINE ENTRY DATES
*
CLI TDATE+TLEN,X'FF' LAST TABLE ENTRY ???
BE *+14 YES - MOVE CURRENT DATA
CLC TDATE+TLEN,EMPTY LAST TABLE ENTRY ???
BNE CNVBLD NO - BUILD CONV RECORD
*
MVC EPOSDATE,TDATE POSITION ENTRY DATE
*
MVC HPOSPS,PPOSPSP INIT PS POSITION-P
CLC PPOSPSP,BLANKS PS POSITION-P BLANK ???
BNE *+10 NO - CONTINUE PLEASE
MVC HPOSPS,PPOSPSE MOVE PS POSITION-E
*
CLC WACT,=C'HIR' 1ST AND LAST RECORD ???
BE *+18 YES - CONTINUE PLEASE
CLI HSTACODE,C'T' STATUS = TERMINATED ???
BNE *+10 NO - CONTINUE PLEASE
MVC WACT,=C'TER' YES - RESET ACTION CODE
*
CLC PNXTPRF,BLANKS NEXT REVIEW BLANKS ???
BE CNVBLD YES - CONTINUE PLEASE
MVC HNXTPRF,PNXTPRF NEXT PERFORMANCE REVIEW
PACK WORK(3),HNXTPRF(4) PACK NEXT REVIEW YEAR
SP WORK(3),=P'1' DEDUCT 1 YEAR FROM DATE
UNPK HNXTPRF(4),WORK(3) REPLACE NEXT REVIEW YEAR
OI HNXTPRF+3,X'F0' TURN ON ALL ZONE BITS
CNVBLD EQU *
PACK WORK(4),EMPNO PACK EMPLOYEE ID
OI WORK+3,X'0F' TURN ON ALL SIGN BITS
UNPK OEMP(6),WORK(4) EMPLOYEE ID NUMBER
*
CALL TDPSGRP,(PCO,HDEPNO,HTGRP) CONVERT PAY GROUP
CALL TDPSCMP,(HDEPNO,HTCO) CONVERT COMPANY
*
MVC OACT,WACT ACTION
MVC OACTD,CDATE ACTION DATE
MVC OACTR,=C'CNV' ACTION REASON
MVC OSALRT,HSALRATE SALARY RATE
MVC OCO,HTCO COMPANY
MVC OSALAMT,HSALAMT SALARY AMOUNT
MVC OCUR,=C'USD' CURRENCY CODE
MVC ODEPDATE,EDEPDATE DEPT - ENTRY DATE
MVC ODEPPS(L'HDEPPS),HDEPPS DEPT - PS NUMBER
MVC OEFFDT,TDATE EFFECTIVE DATE
OI TSEQ+1,X'0F' TURN ON ALL SIGN BITS
UNPK OEFFSEQ,TSEQ EFFECTIVE SEQUENCE
MVC OPOSPS,HPOSPS PS POSITION NUMBER
MVC OSTACODE,HSTACODE STATUS - CODE
MVC OTYPE,STTYPE EMPLOYEE TYPE
MVC OFLSA,STFLSA FLSA STATUS
MVC OFULL,STFL FULL/PART TIME
MVC OGRADE,HJOBGRD+1 JOB GRADE
MVC OGRADATE,EGRADATE JOB GRADE - ENTRY DATE
MVC OJOBDATE,EJOBDATE JOB - ENTRY DATE
MVC OJOB1,HJOB1 JOB - CODE
MVC ODEPTAG,HTCO DEPT - LOCATION TAG
MVC ODEPLOC,HDEPLOC DEPT - LOCATION
MVC OPAYGRP,HTGRP PAY GROUP
MVC OREG,STRG REG/TEMP
MVC OSTDHRS,STHR STANDARD HOURS
MVC ONXTPRF,HNXTPRF NEXT PERFORMANCE REVIEW
MVC OPOSGE,HJOBGE JOB - GE POSITION
MVC OPOSDATE,EPOSDATE POS - ENTRY DATE
*
CALL TDPSDAT,(OACTD) ORACLE DATE CONVERSION
CALL TDPSDAT,(ODEPDATE) ORACLE DATE CONVERSION
CALL TDPSDAT,(OEFFDT) ORACLE DATE CONVERSION
CALL TDPSDAT,(OGRADATE) ORACLE DATE CONVERSION
CALL TDPSDAT,(OJOBDATE) ORACLE DATE CONVERSION
CALL TDPSDAT,(ONXTPRF) ORACLE DATE CONVERSION
CALL TDPSDAT,(OPOSDATE) ORACLE DATE CONVERSION
*
PUT STDWKO,OREC WRITE OUTPUT RECORD
*
MVC WACT,=C'DTA' RESET ACTION CODE
CNVRECX EQU *
L 6,CNVREC-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* DETERMINE ENTRY DATES *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
ENTRY EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
C 9,=A(TABLE) 1ST TABLE ENTRY ???
BNE ENTRY2 NO - CONTINUE PLEASE
*
MVC EGRADATE,TDATE INIT GRADE ENTRY DATE
MVC EDEPDATE,TDATE INIT DEPT ENTRY DATE
MVC EJOBDATE,TDATE INIT JOB ENTRY DATE
MVC EPOSDATE,BLANKS INIT POS ENTRY DATE
*
MVC EJOBGRD,HJOBGRD INIT GRADE ENTRY
MVC EDEPPS,HDEPPS INIT DEPT ENTRY
MVC EDEPLOC,HDEPLOC INIT DEPT ENTRY
MVC EJOB1,HJOB1 INIT JOB ENTRY
MVC EJOBGE,HJOBGE INIT JOB ENTRY
ENTRY2 EQU *
CLC EJOBGRD,HJOBGRD SAME ENTRY DATA ???
BE *+16 YES - CONTINUE PLEASE
MVC EJOBGRD,HJOBGRD RESET ENTRY DATA
MVC EGRADATE,TDATE RESET ENTRY DATE
*
CLC EDEPLOC,HDEPLOC SAME ENTRY DATA ???
BNE *+14 NO - NEW ENTRY DATA
CLC EDEPPS,HDEPPS SAME ENTRY DATA ???
BE *+22 YES - CONTINUE PLEASE
MVC EDEPLOC,HDEPLOC RESET ENTRY DATA
MVC EDEPPS,HDEPPS RESET ENTRY DATA
MVC EDEPDATE,TDATE RESET ENTRY DATE
*
CLC EJOBGE,HJOBGE SAME ENTRY DATA ???
BNE *+14 NO - NEW ENTRY DATA
CLC EJOB1,HJOB1 SAME ENTRY DATA ???
BE *+22 YES - CONTINUE PLEASE
MVC EJOBGE,HJOBGE RESET ENTRY DATA
MVC EJOB1,HJOB1 RESET ENTRY DATA
MVC EJOBDATE,TDATE RESET ENTRY DATE
ENTRYX EQU *
L 6,ENTRY-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* BUILD AUDIT RECORD *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
AUDREC EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
PACK WORK(4),EMPNO PACK EMPLOYEE ID
OI WORK+3,X'0F' TURN ON ALL SIGN BITS
UNPK AEMP(6),WORK(4) EMPLOYEE ID NUMBER
*
MVC ADATA,PDATA MOVE INPUT DATA
MVC ATEST,TENTRY MOVE TABLE ENTRY
MVC AERRS,PERRS MOVE ERROR CODES
MVC ABITS,PBITS MOVE SEGMENT CODES
MVC ACO,STCO MOVE COMPANY CODE
*
PUT STDWKA,AREC WRITE OUTPUT RECORD
AUDRECX EQU *
L 6,AUDREC-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* CLEAR HISTORY TABLE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
CLRTAB EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
LA 9,TABLE LOAD TABLE ADDRESS
CLRLOOP EQU *
CLI 0(9),X'FF' END OF TABLE ???
BE CLRTABX YES - EXIT ROUTINE
*
MVI TENTRY,C' ' MOVE BLANK TO ENTRY
MVC TENTRY+1(TLEN-1),TENTRY PROPAGATE THRU ENTRY
MVC TDATE,EMPTY MOVE EMPTY INDICATOR
ZAP TSEQ,=P'0' INIT SEQUENCE COUNT
MVI TBITS,X'00' INIT SEGMENT BITS
MVC TERRS,=X'0000' INIT ERROR BITS
*
LA 9,TLEN(,9) BUMP TABLE POINTER
B CLRLOOP TEST NEXT ENTRY
CLRTABX EQU *
L 6,CLRTAB-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* CLEAR OUTPUT RECORD AREA *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
CLEAR EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
LA 2,BLANK LOAD SOURCE ADDRESS
LA 3,1 LOAD SOURCE LENGTH
LA 4,OREC LOAD TARGET ADDRESS
LA 5,ORECX-OREC LOAD TARGET LENGTH
ICM 3,B'1000',BLANK LOAD PAD CHARACTER
MVCL 4,2 INIT RECORD AREA
*
LA 2,BLANK LOAD SOURCE ADDRESS
LA 3,1 LOAD SOURCE LENGTH
LA 4,AREC LOAD TARGET ADDRESS
LA 5,ARECX-AREC LOAD TARGET LENGTH
ICM 3,B'1000',BLANK LOAD PAD CHARACTER
MVCL 4,2 INIT RECORD AREA
CLEARX EQU *
L 6,CLEAR-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* CONVERT EMPLOYEE NUMBER *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
EMPNUM EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CALL TDPSEMP,(PEMP,EMPNO) CONVERT EMPLOYEE NUMBER
EMPNUMX EQU *
L 6,EMPNUM-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* PAY FREQUENCY (IF MISSING) R5=ADDRESS SALARY/RATE *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
PAYFRQ EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
CLC 0(10,5),BLANKS SALARY MISSING ???
BE PAYFRQX YES - EXIT ROUTINE NOW
*
BAL 6,AMTCNV AMOUNT CONVERSION
*
MVI 10(5),C'H' INIT RATE = HOURLY
CP WAMTP,=P'10000' SALARY UNDER $100.00 ???
BL PAYFRQX YES - EXIT ROUTINE NOW
MVI 10(5),C'A' SET RATE = ANNUAL
PAYFRQX EQU *
L 6,PAYFRQ-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* AMOUNT CONVERSION R5=ADDRESS *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
AMTCNV EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
MVC WAMTI(8),0(5) MOVE INTEGER PORTION
MVI WAMTI+8,C'.' MOVE DECIMAL POINT
MVC WAMTI+9(2),8(5) MOVE DECIMAL PORTION
*
CALL TDPSAMT,(WAMT@) CONVERT AMOUNT
AMTCNVX EQU *
L 6,AMTCNV-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* GET INPUT PARAMETERS *
***********************************************************************
DC F'0' RETURN ADDRESS SAVE AREA
GETPARM EQU *
ST 6,*-4 SAVE RETURN ADDRESS
*
L 2,0(1) LOAD EXEC PARM ADDRESS
CLC 13(6,2),=C'TRACE=' TRACE EMPLOYEE ???
BNE *+16 NO - CONTINUE PLEASE
MVC TREMP,19(2) YES - MOVE EMPLOYEE
MVC TRACE+8(6),TREMP MOVE TRACE EMPLOYEE
*
MVC CDATE,2(2) MOVE CURRENT DATE
CLC CDATE(2),=C'19' DATE ENTERED ???
BE GETPARMX YES - EXIT ROUTINE
*
COMRG OBTAIN SYSTEM DATE
*
MVC CDATE,=CL10'19YY/MM/DD' INIT CURRENT DATE
MVC CDATE+2(2),6(1) MOVE CURRENT DATE - YY
MVC CDATE+5(2),0(1) MOVE CURRENT DATE - MM
MVC CDATE+8(2),3(1) MOVE CURRENT DATE - DD
GETPARMX EQU *
L 6,GETPARM-4 RESTORE LINK REGISTER
BR 6 BRANCH ON LINK REGISTER
***********************************************************************
EJECT
***********************************************************************
* ABEND ROUTINES *
***********************************************************************
ABEND1 EQU *
LA 0,111 LOAD R0 WITH ABEND CODE
MVC ABMSG,AB111 MOVE ABEND MESSAGE
ABENDIT EQU *
MVC PRT,PRT-1 CLEAR PRINT LINE
BAL 6,W8B PRINT - PAGE EJECT
MVC PRT+1(26),ABTITLE MOVE TITLE LINE
BAL 6,W19 PRINT - SPACE 3 LINES
MVC PRT+1(26),ABMSG MOVE ABEND MESSAGE
MVC PRT+28(6),PEMP MOVE EMPLOYEE NUMBER
BAL 6,W09 PRINT - SPACE 1 LINE
BAL 6,WXX CLOSE PRINT FILE
ABEND (0) ISSUE ABEND REGISTER 0
***********************************************************************
ABMSG DC CL26' '
AB111 DC CL26'HISTORY TABLE FULL - EMP#:'
ABTITLE DC CL26'TD-PS-007 PROGRAM ABEND '
***********************************************************************
EJECT
***********************************************************************
* WORKING STORAGE *
***********************************************************************
STDWKI DCB DDNAME=STDWKI,DSORG=PS,MACRF=(GM),EODAD=EOFI
STDWKO DCB DDNAME=STDWKO,DSORG=PS,MACRF=(PM)
STDWKA DCB DDNAME=STDWKA,DSORG=PS,MACRF=(PM)
STDWKT DCB DDNAME=STDWKT,DSORG=PS,MACRF=(PM)
***********************************************************************
TREMP DC CL6'$$$$$$' TRACE TABLE EMPLOYEE
TRACE DC CL(TLEN+20)' ' TRACE TABLE DATA
***********************************************************************
WAMT@ DS 0CL27 AMOUNT CONVERSION PARMS
WAMTI DC CL11'-ZZZZZZZ.99' WORK AMOUNT INPUT
WAMTO DC CL10'-ZZZZZZZ99' WORK AMOUNT OUTPUT
WAMTP DC PL6'0' WORK AMOUNT PACKED
***********************************************************************
WJOB DC CL10'YYYY/MM/DD' EARLIEST JOB DATE
WHIRE DC CL10'YYYY/MM/DD' HIRE DATE
WSERVICD DC CL10'YYYY/MM/DD' SERVICE DATE
WREHIRED DC CL10'YYYY/MM/DD' REHIRE DATE
WERR DC CL1' ' ERROR CODE
***********************************************************************
CDATE DC CL10'YYYY/MM/DD' CURRENT DATE
HALF DC H'0' HALF-WORD
EMPTY DC XL10'FEFFFFFFFFFFFFFFFFFF' EMPTY TABLE POSITION
HEAD DC CL1'N' HEADING SWITCH
PGCT DC PL2'0' PAGE COUNTER
ED1 DC XL4'40202120' EDIT PATTERN - FZZ9
WORK DC XL20'00' WORK FIELD
WACT DC CL3'HIR' ACTION CODE
ZEROES DC 10CL1'0' ZEROES
BLANKS DC 35CL1' ' BLANKS
BLANK EQU BLANKS BLANKS
@ZERO DC CL10' 00' ZERO INIT OUTPUT FIELD
***********************************************************************
@CRIT EQU 32768 CRITICAL ERROR BIT X'8000'
@BIT01 EQU 32768 ERROR 01 SETTING X'8000'
@BIT02 EQU 16384 ERROR 02 SETTING X'4000'
@BIT03 EQU 8192 ERROR 03 SETTING X'2000'
@BIT04 EQU 4096 ERROR 04 SETTING X'1000'
@BIT05 EQU 2048 ERROR 05 SETTING X'0800'
@BIT06 EQU 1024 ERROR 06 SETTING X'0400'
@BIT07 EQU 512 ERROR 07 SETTING X'0200'
@BIT08 EQU 256 ERROR 08 SETTING X'0100'
@BIT09 EQU 128 ERROR 09 SETTING X'0080'
@BIT10 EQU 64 ERROR 10 SETTING X'0040'
@BIT11 EQU 32 ERROR 11 SETTING X'0020'
@BIT12 EQU 16 ERROR 12 SETTING X'0010'
@BIT13 EQU 8 ERROR 13 SETTING X'0008'
@BIT14 EQU 4 ERROR 14 SETTING X'0004'
@BIT15 EQU 2 ERROR 15 SETTING X'0002'
@BIT16 EQU 1 ERROR 16 SETTING X'0001'
***********************************************************************
SET01 DC AL2(@BIT01) CRITICAL ERROR
SET02 DC AL2(@BIT02+@CRIT) HIRE DATE ERROR
SET03 DC AL2(@BIT03) --UNDEFINED--
SET04 DC AL2(@BIT04) --UNDEFINED--
SET05 DC AL2(@BIT05+@CRIT) EARLIEST.SAL <> HIRE.DT
SET06 DC AL2(@BIT06+@CRIT) EARLIEST.JOB <> HIRE.DT
SET07 DC AL2(@BIT07+@CRIT) EARLIEST.DEP <> HIRE.DT
SET08 DC AL2(@BIT08+@CRIT) EARLIEST.STA <> HIRE.DT
SET09 DC AL2(@BIT09+@CRIT) MISSING JOB1
SET10 DC AL2(@BIT10+@CRIT) MISSING PS.DEPT#
SET11 DC AL2(@BIT11+@CRIT) MISSING DEPT.LOC
SET12 DC AL2(@BIT12) BYPASS PRIOR HISTORY
SET13 DC AL2(@BIT13+@CRIT) MISSING SEGMENTS
SET14 DC AL2(@BIT14) POS# ALIGNMENT (FIXTAB)
SET15 DC AL2(@BIT15) HISTORY.DATE > CURR.DATE
SET16 DC AL2(@BIT16) MISSING PS.POS#
***********************************************************************
EDATA EQU * ENTRY DATA
EGRADATE DC CL10'YYYY-MM-DD' GRADE - ENTRY DATE
EJOBDATE DC CL10'YYYY-MM-DD' JOB - ENTRY DATE
EDEPDATE DC CL10'YYYY-MM-DD' DEPT - ENTRY DATE
EPOSDATE DC CL10'YYYY-MM-DD' POS - ENTRY DATE
EJOBGRD DS CL4 JOB - GRADES
EJOB1 DS CL10 JOB - JOB1
EJOBGE DS CL4 JOB - GE POSITION
EDEPPS DS CL6 DEPT - PS DEPT NO
EDEPLOC DS CL6 DEPT - LOCATION
EDATAX EQU * END ENTRY DATA
***********************************************************************
HTGRP DC CL3' ' PAY GROUP - HISTORY
HTCO DC CL3' ' COMPANY - HISTORY
***********************************************************************
STDATA EQU * STATIC CONVERSION DATA
STGRP DC CL3' ' PAY GROUP
STCO DC CL3' ' COMPANY
STFL DC CL1' ' FULL/PART TIME
STRG DC CL1' ' REG/TEMP
STHR DC CL4'0000' STANDARD HOURS
STTYPE DC CL1' ' EMPLOYEE TYPE
STFLSA DC CL1' ' FLSA STATUS
STDATAX EQU * END STATIC CONVERSION DATA
***********************************************************************
HDATA EQU * TABLE CONVERSION DATA
HNXTPRF DC CL10'YYYY-MM-DD' NEXT REVIEW DATE
HPOSPS DC CL8' ' PS POSITION NUMBER
HSALAMT DS CL10 SALARY - AMOUNT
HSALRATE DS CL2 SALARY - RATES
HJOBGRD DS CL4 JOB - GRADES
HJOB1 DS CL10 JOB - JOB1
HJOBGE DS CL4 JOB - GE POSITION
HDEPNO DS CL6 DEPT - DEPT NO
HDEPPS DS CL6 DEPT - PS DEPT NO
HDEPLOC DS CL6 DEPT - LOCATION
HSTACODE DS CL1 STATUS - CODE
HDATAX EQU * END TABLE CONVERSION DATA
***********************************************************************
HSALSEG DS CL(L'ISALSEG) SALARY SEGMENT
HJOBSEG DS CL(L'IJOBSEG) JOB SEGMENT
HDEPSEG DS CL(L'IDEPSEG) DEPT SEGMENT
HSTASEG DS CL(L'ISTASEG) STATUS SEGMENT
***********************************************************************
EJECT
***********************************************************************
* H/R CONVERSION RECORD - INPUT *
***********************************************************************
IREC DS 0CL400 H/R CONVERSION RECORD
IDATA DS 0CL(IDATAX-IEMP) DATA - START SEGMENT
IEMP DC CL8'000000' EMPLOYEE ID NUMBER
ICO DC CL3' ' COMPANY CODE
ISEQ DC CL3' ' SEQUENCE
IMAX DC CL3' ' MAXIMUM SEQUENCE
IREG DC CL1' ' REG/TEMP/FULL/PART
ITYPE DC CL1' ' TYPE (EXEMPT/NON-EXEMPT)
IDEPT DC CL6' ' DEPARTMENT
INXTPRF DC CL10'YYYY-MM-DD' NEXT REVIEW DATE
IPOSGE DC CL5' ' GE POSITION NUMBER
IPOSNO DC CL10' ' POSITION NUMBER
IPOSPSE DC CL8' ' PS POSITION NUMBER-E (EMP)
IPOSPSP DC CL8' ' PS POSITION NUMBER-P (POS)
ISTAT DC CL1' ' CURRENT STATUS CODE
ISALARY DC CL10'-ZZZZZZZ99' CURRENT SALARY AMOUNT
IRATE DC CL1' ' CURRENT RATE CODE (A/H)
IJOB# DC CL6' ' CURRENT JOB NUMBER
IJOB#1 DC CL10' ' CURRENT JOB 1
ICUSTOM DC CL25' ' CURRENT CUSTOM USER.TAB1
IHIRE DC CL10'YYYY-MM-DD' HIRE DATE
IRECENT DC CL10'YYYY-MM-DD' MOST RECENT HIRE DATE
IDATAX EQU * DATA - END SEGMENT
*
ISALSEG DS 0CL(ISALX-ISALMAX) SALARY - START SEGMENT
ISALMAX DC CL3' ' SALARY - MAXIMUM SEQUENCE
ISALDATE DC CL10'YYYY-MM-DD' SALARY - DATE
ISALAMT DC CL10'-ZZZZZZZ99' SALARY - AMOUNT
ISALRATE DC CL2' ' SALARY - RATES
ISALINCR DC CL10'-ZZZZZZZ99' SALARY - INCR.AMOUNT
ISALPCTG DC CL10'-ZZZZZZZ99' SALARY - INCR.PERCENT
ISALCODE DC CL3' ' SALARY - INCR.CODE
ISALX EQU * SALARY - END SEGMENT
*
IJOBSEG DS 0CL(IJOBX-IJOBMAX) JOB - START SEGMENT
IJOBMAX DC CL3' ' JOB - MAXIMUM SEQUENCE
IJOBDATE DC CL10'YYYY-MM-DD' JOB - DATE
IJOBNO DC CL8' ' JOB - NUMBER
IJOBTTL DC CL25' ' JOB - TITLE
IJOBGRD DC CL4' ' JOB - GRADES
IJOBCODE DC CL3' ' JOB - CODE
IJOB1 DC CL10' ' JOB - JOB1
IJOBGE DC CL4' ' JOB - GE POSITION
IJOBCUS DC CL25' ' JOB - CUSTOM USER.TAB1
IJOBX EQU * JOB - END SEGMENT
*
IDEPSEG DS 0CL(IDEPX-IDEPMAX) DEPT - START SEGMENT
IDEPMAX DC CL3' ' DEPT - MAXIMUM SEQUENCE
IDEPDATE DC CL10'YYYY-MM-DD' DEPT - DATE
IDEPNO DC CL8' ' DEPT - NUMBER
IDEPNAME DC CL20' ' DEPT - NAME
IDEPPS DC CL6' ' DEPT - PS DEPT NO
IDEPLOC DC CL6' ' DEPT - LOCATION
IDEPX EQU * DEPT - END SEGMENT
*
ISTASEG DS 0CL(ISTAX-ISTAMAX) STATUS - START SEGMENT
ISTAMAX DC CL3' ' STATUS - MAXIMUM SEQUENCE
ISTADATE DC CL10'YYYY-MM-DD' STATUS - DATE
ISTACODE DC CL3' ' STATUS - CODE
ISTAREAS DC CL3' ' STATUS - REASON
ISTAX EQU * STATUS - END SEGMENT
*
IFILL DS CL(L'IREC-(*-IREC)) FILLER
***********************************************************************
* H/R CONVERSION RECORD - AUDIT *
***********************************************************************
AREC DS 0CL400 PEOPLESOFT CONVERSION
AEMP DC CL11'000000' EMPLOYEE ID NUMBER
ADATA DS CL(L'IDATA) INPUT RECORD DATA
ATEST DS CL(TLEN) INPUT TABLE ENTRY
AERRS DC XL2'0000' INPUT AUDIT ERRORS
ABITS DC XL1'00' INPUT AUDIT SEGMENTS
ACO DC CL3' ' COMPANY (TIP/SPC)
AFILL DS CL(L'AREC-(*-AREC)) FILLER
ARECX EQU * END OF RECORD
***********************************************************************
* H/R CONVERSION RECORD - OUTPUT *
***********************************************************************
OREC DS 0CL400 PEOPLESOFT CONVERSION
OEMP DC CL11'000000' EMPLOYEE ID NUMBER
OACT DC CL3' ' ACTION
OACTD DC CL10'YYYY/MM/DD' ACTION DATE
OACTR DC CL3'CNV' ACTION REASON
OSALRT DC CL1' ' SALARY RATE
OCO DC CL3' ' COMPANY
OSALAMT DC CL10'-ZZZZZZZZ99' SALARY AMOUNT
OCUR DC CL3'USD' CURRENCY CODE
ODEPDATE DC CL10'YYYY/MM/DD' DEPT - ENTRY DATE
ODEPPS DC CL10' ' DEPT - PS NUMBER
OEFFDT DC CL10'YYYY/MM/DD' EFFECTIVE DATE
OEFFSEQ DC CL3'ZZ9' EFFECTIVE SEQUENCE
OPOSPS DC CL8' ' PS POSITION NUMBER
OSTACODE DC CL1' ' STATUS - CODE
OTYPE DC CL1' ' EMPLOYEE TYPE
OFLSA DC CL1' ' FLSA STATUS
OFULL DC CL1' ' FULL/PART TIME
OGRADE DC CL3' ' JOB GRADE
OGRADATE DC CL10'YYYY/MM/DD' JOB GRADE - ENTRY DATE
OJOBDATE DC CL10'YYYY/MM/DD' JOB - ENTRY DATE
OJOB1 DC CL6' ' JOB - CODE
ODEPLOC# DS 0CL5 DEPT - LOCATION KEY
ODEPTAG DC CL1' ' DEPT - LOCATION TAG
ODEPLOC DC CL4' ' DEPT - LOCATION
OPAYGRP DC CL3' ' PAY GROUP
OREG DC CL1' ' REG/TEMP
OSTDHRS DC CL4'ZZ99' STANDARD HOURS
ONXTPRF DC CL10'YYYY/MM/DD' NEXT PERFORMANCE REVIEW
OPOSGE DC CL4' ' JOB - GE POSITION
OPOSDATE DC CL10'YYYY/MM/DD' POS - ENTRY DATE
OFILL DS CL(L'OREC-(*-OREC)) FILLER
ORECX EQU * END OF RECORD
***********************************************************************
TPRNT TPRINTER UTILITY
LTORG LITERAL POOL
***********************************************************************
EMPNO DC CL6'000000' NEW EMPLOYEE NUMBER
***********************************************************************
PDATA DS 0CL(L'IDATA) DATA SEGMENT
PEMP DC CL8'$$$$$$$$' EMPLOYEE ID NUMBER
PCO DC CL3' ' COMPANY CODE
PSEQ DC CL3' ' SEQUENCE
PMAX DC CL3' ' MAXIMUM SEQUENCE
PREG DC CL1' ' REG/TEMP/FULL/PART
PTYPE DC CL1' ' TYPE (EXEMPT/NON-EXEMPT)
PDEPT DC CL6' ' DEPARTMENT
PNXTPRF DC CL10'YYYY-MM-DD' NEXT REVIEW DATE
PPOSGE DC CL5' ' GE POSITION NUMBER
PPOSNO DC CL10' ' POSITION NUMBER
PPOSPSE DC CL8' ' PS POSITION NUMBER-E (EMP)
PPOSPSP DC CL8' ' PS POSITION NUMBER-P (POS)
PSTAT DC CL1' ' CURRENT STATUS CODE
PSALARY DC CL10'-ZZZZZZZ99' CURRENT SALARY AMOUNT
PRATE DC CL1' ' CURRENT RATE CODE (A/H)
PJOB# DC CL6' ' CURRENT JOB NUMBER
PJOB#1 DC CL10' ' CURRENT JOB 1
PCUSTOM DC CL25' ' CURRENT CUSTOM USER.TAB1
PHIRE DC CL10'YYYY-MM-DD' HIRE DATE
PRECENT DC CL10'YYYY-MM-DD' MOST RECENT HIRE DATE
*
HERRS DC XL2'0000' ERROR BITS (HIRFIX)
PERRS DC XL2'0000' ERROR BITS
PBITS DC XL1'00' SEGMENT BITS
PSALMAX DC PL2'0' SALARY - MAXIMUM SEQUENCE
PJOBMAX DC PL2'0' JOB - MAXIMUM SEQUENCE
PDEPMAX DC PL2'0' DEPT - MAXIMUM SEQUENCE
PSTAMAX DC PL2'0' STATUS - MAXIMUM SEQUENCE
*
WSEQ DC PL2'0' PACKED SEQUENCE NUMBER
WDATE DC CL10'YYYY-MM-DD' FIND DATE ARGUMENT
WBITS DC XL1'00' TABLE SEGMENT BITS
WCTR DC PL2'0' TABLE SEQUENCE COUNTER
***********************************************************************
POSTAB DS 35CL30 POSITION/TITLE TABLE
***********************************************************************
TLEN EQU (IFILL-IDATAX)+15 TABLE - ELEMENT LENGTH
TLAST DC A(TABLEX-TLEN) LAST ENTRY ADDRESS
TABLE DS 35CL(TLEN) HISTORY TABLE
TABLEX DC XL1'FF' END OF TABLE
***********************************************************************
@SAL EQU X'80' SALARY SEGMENT BIT
@JOB EQU X'40' JOB SEGMENT BIT
@DEP EQU X'20' DEPT SEGMENT BIT
@STA EQU X'10' STATUS SEGMENT BIT
***********************************************************************
@SALL EQU L'ISALSEG SALARY SEGMENT LENGTH
@JOBL EQU L'IJOBSEG JOB SEGMENT LENGTH
@DEPL EQU L'IDEPSEG DEPT SEGMENT LENGTH
@STAL EQU L'ISTASEG STATUS SEGMENT LENGTH
***********************************************************************
TDSECT DSECT HISTORY DSECT
TENTRY DS 0CL(TLEN) HISTORY ENTRY
TDATE DS CL10 EFFECTIVE DATE
TSEQ DS PL2 EFFECTIVE SEQUENCE
TBITS DS XL1 SEGMENT BITS
TERRS DS XL2 ERROR BITS
*
TSALSEG DS 0CL(L'ISALSEG) SALARY SEGMENT
TSALMAX DS CL3 SALARY - MAXIMUM SEQUENCE
TSALDATE DS CL10 SALARY - DATE
TSALAMT DS CL10 SALARY - AMOUNT
TSALRATE DS CL2 SALARY - RATES
TSALINCR DS CL10 SALARY - INCR.AMOUNT
TSALPCTG DS CL10 SALARY - INCR.PERCENT
TSALCODE DS CL3 SALARY - INCR.CODE
*
TJOBSEG DS 0CL(L'IJOBSEG) JOB SEGMENT
TJOBMAX DS CL3 JOB - MAXIMUM SEQUENCE
TJOBDATE DS CL10 JOB - DATE
TJOBNO DS CL8 JOB - NUMBER
TJOBTTL DS CL25 JOB - TITLE
TJOBGRD DS CL4 JOB - GRADES
TJOBCODE DS CL3 JOB - CODE
TJOB1 DS CL10 JOB - JOB1
TJOBGE DS CL4 JOB - GE POSITION
TJOBCUS DS CL25 JOB - CUSTOM USER.TAB1
*
TDEPSEG DS 0CL(L'IDEPSEG) DEPT SEGMENT
TDEPMAX DS CL3 DEPT - MAXIMUM SEQUENCE
TDEPDATE DS CL10 DEPT - DATE
TDEPNO DS CL8 DEPT - NUMBER
TDEPNAME DS CL20 DEPT - NAME
TDEPPS DS CL6 DEPT - PS DEPT NO
TDEPLOC DS CL6 DEPT - LOCATION
*
TSTASEG DS 0CL(L'ISTASEG) STATUS SEGMENT
TSTAMAX DS CL3 STATUS - MAXIMUM SEQUENCE
TSTADATE DS CL10 STATUS - DATE
TSTACODE DS CL3 STATUS - CODE
TSTAREAS DS CL3 STATUS - REASON
***********************************************************************
END TDPS007
Keep in mind this is just a small sampling of the overall project.
