000000* C:\tutorials\TstSQL\cbl\JSPG2.CBL 000010 IDENTIFICATION DIVISION. JSPG2 000020 PROGRAM-ID. JSPG2. JSPG2 000030 AUTHOR. JAZZUSR (Using Jazz from Visual Studio) JSPG2 000040 DATE-WRITTEN. 16/02/2024 10:23:06 AM JSPG2 000050 ENVIRONMENT DIVISION. JSPG2 000060*# Last Updated by JAZZUSR at 16/02/2024 10:23:06 AM JSPG2 000070*PROGRAM JSPG2 WEBSERVICE MyJSv CONTAINER DFHWS-DATA DATABASE JSPG2 000080* sample DB2 JSON; JSPG2 000090** Single Table Update JSPG2 000100*COPY JZTrim; JSPG2 000110*ACCEPT (IJSPG2.Function) MESSAGE OJSPG2.Error; JSPG2 000120*#052 W Item IJSPG2.Function will be validated, but not moved JSPG2 000130* from the input record JSPG2 000140*CASE (IJSPG2.Function); JSPG2 000150* WHEN (Enquiry); JSPG2 000160* ACCEPT (EMPLOYEE.EMPNO = IJSPG2.EMPNO OR JSPG2 000170* EMPLOYEE.WORKDEPT = IJSPG2.WORKDEPT) MESSAGE JSPG2 000180* OJSPG2.Error; JSPG2 000190* GET EMPLOYEE KEY(EMPLOYEE.EMPNO OR EMPLOYEE.WORKDEPT) JSPG2 000200* SAVESUM OJSPG2.JZ-EMPLOYEE.Checksum; JSPG2 000210* #628 W GENERIC assumed for WORKDEPT JSPG2 000220* END GET EMPLOYEE RESPOND OJSPG2; JSPG2 000230* WHEN (Update); JSPG2 000240* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE JSPG2 000250* OJSPG2.Error; JSPG2 000260* GET EMPLOYEE KEY(EMPLOYEE.EMPNO) UPDATE CHECKSUM JSPG2 000270* IJSPG2.JZ-EMPLOYEE.Checksum; JSPG2 000280* COPY JZMDays; JSPG2 000290* COPY JZDTVS; JSPG2 000300* COPY JZTMVS; JSPG2 000310* ACCEPT (IJSPG2.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) JSPG2 000320* MESSAGE OJSPG2.Error; JSPG2 000330* #207 I JZ-EMPLOYEE.FIRSTNME,JZ-EMPLOYEE.MIDINIT, JSPG2 000340* JZ-EMPLOYEE.LASTNAME,JZ-EMPLOYEE.WORKDEPT, JSPG2 000350* JZ-EMPLOYEE.PHONENO,JZ-EMPLOYEE.HIREDATE, JSPG2 000360* JZ-EMPLOYEE.JOB,JZ-EMPLOYEE.EDLEVEL, JSPG2 000370* JZ-EMPLOYEE.SEX,JZ-EMPLOYEE.BIRTHDATE, JSPG2 000380* JZ-EMPLOYEE.SALARY,JZ-EMPLOYEE.BONUS, JSPG2 000390* JZ-EMPLOYEE.COMM,JZ-EMPLOYEE.CURRENCY, JSPG2 000400* JZ-EMPLOYEE.DEPTMGR,JZ-EMPLOYEE.STARTTIME, JSPG2 000410* included in generic assignment JSPG2 000420* END GET EMPLOYEE UPDATE RESPOND OJSPG2; JSPG2 000430* WHEN (Add); JSPG2 000440* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE JSPG2 000450* OJSPG2.Error; JSPG2 000460* GET EMPLOYEE FREEKEY CREATE; JSPG2 000470* #221 E EMPLOYEE.EMPNO used as key field(s). It/they JSPG2 000480* will be set to next available value. JSPG2 000490* ACCEPT (IJSPG2.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) JSPG2 000500* MESSAGE OJSPG2.Error; JSPG2 000510* #207 I JZ-EMPLOYEE.FIRSTNME,JZ-EMPLOYEE.MIDINIT, JSPG2 000520* JZ-EMPLOYEE.LASTNAME,JZ-EMPLOYEE.WORKDEPT, JSPG2 000530* JZ-EMPLOYEE.PHONENO,JZ-EMPLOYEE.HIREDATE, JSPG2 000540* JZ-EMPLOYEE.JOB,JZ-EMPLOYEE.EDLEVEL, JSPG2 000550* JZ-EMPLOYEE.SEX,JZ-EMPLOYEE.BIRTHDATE, JSPG2 000560* JZ-EMPLOYEE.SALARY,JZ-EMPLOYEE.BONUS, JSPG2 000570* JZ-EMPLOYEE.COMM,JZ-EMPLOYEE.CURRENCY, JSPG2 000580* JZ-EMPLOYEE.DEPTMGR,JZ-EMPLOYEE.STARTTIME, JSPG2 000590* included in generic assignment JSPG2 000600* END GET EMPLOYEE CREATE RESPOND OJSPG2; JSPG2 000610* WHEN (Delete); JSPG2 000620* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE JSPG2 000630* OJSPG2.Error; JSPG2 000640* DELETE EMPLOYEE KEY(EMPLOYEE.EMPNO) CHECKSUM JSPG2 000650* IJSPG2.JZ-EMPLOYEE.Checksum; JSPG2 000660*END CASE; JSPG2 000670*REPLY; JSPG2 000680******************************************************************JSPG2 000690** **JSPG2 000700** Data Division **JSPG2 000710** **JSPG2 000720******************************************************************JSPG2 000730 DATA DIVISION. JSPG2 000740******************************************************************JSPG2 000750** **JSPG2 000760** Working Storage Section: General Program Data **JSPG2 000770** **JSPG2 000780******************************************************************JSPG2 000790* JSPG2 000800 WORKING-STORAGE SECTION. JSPG2 000810******************************************************************JSPG2 000820** **JSPG2 000830** General Program Information **JSPG2 000840** **JSPG2 000850******************************************************************JSPG2 000860* JSPG2 000870* Status Flags and control data JSPG2 000880 01 JZ-FILECONTROL. JSPG2 000890 03 SORTWORK-ENDFILE PIC X VALUE 'N'. JSPG2 000900 03 JZDB2Co-ENDFILE PIC X VALUE 'N'. JSPG2 000910 03 JZDB2Co-STATUS PIC S9(8) VALUE 0. JSPG2 000920 03 JZDB2Co-FOUND-FLAG PIC X VALUE 'Y'. JSPG2 000930 88 JZDB2Co-FOUND VALUE 'Y'. JSPG2 000940 03 JZDB2Co-UPDATEPENDING-FLAG PIC X VALUE 'N'. JSPG2 000950 88 JZDB2Co-UPDATEPENDING VALUE 'Y'. JSPG2 000960 03 JZDB2Co-GET4UPDATE-FLAG PIC X VALUE 'N'. JSPG2 000970 88 JZDB2Co-GET4UPDATE VALUE 'Y'. JSPG2 000980 03 DEPARTMENT-ENDFILE PIC X VALUE 'N'. JSPG2 000990 03 DEPARTMENT-STATUS PIC S9(8) VALUE 0. JSPG2 001000 03 DEPARTMENT-FOUND-FLAG PIC X VALUE 'Y'. JSPG2 001010 88 DEPARTMENT-FOUND VALUE 'Y'. JSPG2 001020 03 DEPARTMENT-UPDATEPENDING-FLAG PIC X VALUE 'N'. JSPG2 001030 88 DEPARTMENT-UPDATEPENDING VALUE 'Y'. JSPG2 001040 03 DEPARTMENT-GET4UPDATE-FLAG PIC X VALUE 'N'. JSPG2 001050 88 DEPARTMENT-GET4UPDATE VALUE 'Y'. JSPG2 001060 03 EMPLOYEE-ENDFILE PIC X VALUE 'N'. JSPG2 001070 03 EMPLOYEE-STATUS PIC S9(8) VALUE 0. JSPG2 001080 03 EMPLOYEE-FOUND-FLAG PIC X VALUE 'Y'. JSPG2 001090 88 EMPLOYEE-FOUND VALUE 'Y'. JSPG2 001100 03 EMPLOYEE-UPDATEPENDING-FLAG PIC X VALUE 'N'. JSPG2 001110 88 EMPLOYEE-UPDATEPENDING VALUE 'Y'. JSPG2 001120 03 EMPLOYEE-GET4UPDATE-FLAG PIC X VALUE 'N'. JSPG2 001130 88 EMPLOYEE-GET4UPDATE VALUE 'Y'. JSPG2 001140 01 EMPLOYEE-CheckCopy PIC X(113). JSPG2 001150* JSPG2 001160 LOCAL-STORAGE SECTION. JSPG2 001170******************************************************************JSPG2 001180** **JSPG2 001190** SQL Data **JSPG2 001200** **JSPG2 001210******************************************************************JSPG2 001220 EXEC SQL JSPG2 001230 INCLUDE SQLCA JSPG2 001240 END-EXEC. JSPG2 001250 EXEC SQL JSPG2 001260 INCLUDE JZDB2Co JSPG2 001270 END-EXEC. JSPG2 001280* JSPG2 001290 EXEC SQL DECLARE DEPARTMENT TABLE( JSPG2 001300 DEPTNO CHAR(3) NOT NULL, JSPG2 001310 DEPTNAME VARCHAR(36) NOT NULL, JSPG2 001320 MGRNO CHAR(6), JSPG2 001330 ADMRDEPT CHAR(3) NOT NULL, JSPG2 001340 LOCATION CHAR(16), JSPG2 001350 TTime TIME) END-EXEC. JSPG2 001360* JSPG2 001370 01 DEPARTMENT. JSPG2 001380 03 DEPTNO PIC XXX VALUE SPACES. JSPG2 001390 03 DEPTNAME. JSPG2 001400 49 JZL-DEPTNAME PIC S9999 COMP-5. JSPG2 001410 49 JZD-DEPTNAME PIC X(36). JSPG2 001420 03 MGRNO PIC X(6) VALUE '000000'. JSPG2 001430 03 JZB-MGRNO PIC S9(4) COMP VALUE -1. JSPG2 001440 03 ADMRDEPT PIC XXX VALUE SPACES. JSPG2 001450 03 LOCATION PIC X(16) VALUE SPACES. JSPG2 001460 03 JZB-LOCATION PIC S9(4) COMP VALUE -1. JSPG2 001470 03 TTime PIC S9(9) COMP VALUE ZERO. JSPG2 001480 03 JZB-TTime PIC S9(4) COMP VALUE -1. JSPG2 001490* JSPG2 001500 EXEC SQL DECLARE EMPLOYEE TABLE( JSPG2 001510 EMPNO CHAR(6) NOT NULL, JSPG2 001520 FIRSTNME VARCHAR(12) NOT NULL, JSPG2 001530 MIDINIT CHAR(1), JSPG2 001540 LASTNAME VARCHAR(15) NOT NULL, JSPG2 001550 WORKDEPT CHAR(3), JSPG2 001560 PHONENO CHAR(4), JSPG2 001570 HIREDATE DATE, JSPG2 001580 JOB CHAR(8), JSPG2 001590 EDLEVEL SMALLINT NOT NULL, JSPG2 001600 SEX CHAR(1), JSPG2 001610 BIRTHDATE DATE, JSPG2 001620 SALARY DECIMAL(9,2), JSPG2 001630 BONUS DECIMAL(9,2), JSPG2 001640 COMM DECIMAL(9,2), JSPG2 001650 CURRENCY CHAR(3), JSPG2 001660 DEPTMGR BOOLEAN, JSPG2 001670 STARTTIME TIME) END-EXEC. JSPG2 001680* JSPG2 001690 01 EMPLOYEE. JSPG2 001700 03 EMPNO PIC X(6) VALUE '000000'. JSPG2 001710 03 FIRSTNME. JSPG2 001720 49 JZL-FIRSTNME PIC S9999 COMP-5. JSPG2 001730 49 JZD-FIRSTNME PIC X(12). JSPG2 001740 03 MIDINIT PIC X VALUE SPACES. JSPG2 001750 03 JZB-MIDINIT PIC S9(4) COMP VALUE -1. JSPG2 001760 03 LASTNAME. JSPG2 001770 49 JZL-LASTNAME PIC S9999 COMP-5. JSPG2 001780 49 JZD-LASTNAME PIC X(15). JSPG2 001790 03 WORKDEPT PIC XXX VALUE SPACES. JSPG2 001800 03 JZB-WORKDEPT PIC S9(4) COMP VALUE -1. JSPG2 001810 03 PHONENO PIC XXXX VALUE '0000'. JSPG2 001820 03 JZB-PHONENO PIC S9(4) COMP VALUE -1. JSPG2 001830 03 HIREDATE PIC S9(9) COMP VALUE ZERO. JSPG2 001840 03 JZB-HIREDATE PIC S9(4) COMP VALUE -1. JSPG2 001850 03 JOB PIC X(8) VALUE SPACES. JSPG2 001860 03 JZB-JOB PIC S9(4) COMP VALUE -1. JSPG2 001870 03 EDLEVEL PIC S9(4) COMP VALUE ZERO. JSPG2 001880 03 SEX PIC X VALUE SPACES. JSPG2 001890 03 JZB-SEX PIC S9(4) COMP VALUE -1. JSPG2 001900 03 BIRTHDATE PIC S9(9) COMP VALUE ZERO. JSPG2 001910 03 JZB-BIRTHDATE PIC S9(4) COMP VALUE -1. JSPG2 001920 03 SALARY PIC S9(7)V9(2) COMP-3 VALUE ZERO. JSPG2 001930 03 JZB-SALARY PIC S9(4) COMP VALUE -1. JSPG2 001940 03 BONUS PIC S9(7)V9(2) COMP-3 VALUE ZERO. JSPG2 001950 03 JZB-BONUS PIC S9(4) COMP VALUE -1. JSPG2 001960 03 COMM PIC S9(7)V9(2) COMP-3 VALUE ZERO. JSPG2 001970 03 JZB-COMM PIC S9(4) COMP VALUE -1. JSPG2 001980 03 JZ-CURRENCY PIC XXX VALUE SPACES. JSPG2 001990 03 JZB-CURRENCY PIC S9(4) COMP VALUE -1. JSPG2 002000 03 DEPTMGR PIC X VALUE SPACES. JSPG2 002010 03 JZB-DEPTMGR PIC S9(4) COMP VALUE -1. JSPG2 002020 03 STARTTIME PIC S9(9) COMP VALUE ZERO. JSPG2 002030 03 JZB-STARTTIME PIC S9(4) COMP VALUE -1. JSPG2 002040******************************************************************JSPG2 002050** **JSPG2 002060** JZ - Jazz Sundry fields **JSPG2 002070** **JSPG2 002080******************************************************************JSPG2 002090* JSPG2 002100 01 JZ. JSPG2 002110 03 JZ-AL PIC S9(4) COMP VALUE 0. JSPG2 002120 03 JZ-ALIM PIC S9(4) COMP VALUE 0. JSPG2 002130 03 JZ-NOFML PIC S9(4) COMP VALUE 0. JSPG2 002140 03 JZ-INDEX PIC S9(4) COMP VALUE 0. JSPG2 002150 03 JZ-INDEX2 PIC S9(4) COMP VALUE 0. JSPG2 002160 03 JZ-IXMth PIC S9(4) COMP VALUE 0. JSPG2 002170 03 JZ-ST PIC S9(4) COMP VALUE 0. JSPG2 002180 03 JZ-SL PIC S9(4) COMP VALUE 0. JSPG2 002190 03 JZ-BLANK PIC XXXX VALUE SPACES. JSPG2 002200 03 JZ-CHAR80 PIC X(80) VALUE SPACES. JSPG2 002210 03 JZ-FNAME PIC X(30) VALUE SPACES. JSPG2 002220 03 JZ-KL PIC S9(4) COMP VALUE 0. JSPG2 002230 03 JZ-MLTH PIC S9(4) COMP VALUE 0. JSPG2 002240 03 JZ-INT PIC S9(9) COMP VALUE 0. JSPG2 002250 03 JZ-TRUEFALSE PIC XXXXX VALUE SPACES. JSPG2 002260 03 JZ-TinyNbr PIC S9(9) COMP VALUE ZERO. JSPG2 002270 03 JZ-TinyGr REDEFINES JZ-TinyNbr. JSPG2 002280 05 FILLER PIC XXX. JSPG2 002290 05 JZ-Tiny PIC X. JSPG2 002300 03 JZ-Error PIC X VALUE SPACES. JSPG2 002310 03 JZ-NBR1 PIC 9999 VALUE ZERO. JSPG2 002320 03 JZ-NBR1X REDEFINES JZ-NBR1 PIC XXXX. JSPG2 002330 03 JZ-NBR2 PIC 9999 VALUE ZERO. JSPG2 002340 03 JZ-NBR2X REDEFINES JZ-NBR2 PIC XXXX. JSPG2 002350 03 JZ-SUBVAL PIC ZZZZZ9 VALUE ZERO. JSPG2 002360 03 JZ-SUBVALR REDEFINES JZ-SUBVAL PIC X(6). JSPG2 002370 03 JZ-SUBDIGIT PIC S9(4) COMP VALUE ZERO. JSPG2 002380 03 JZ-INDEXES OCCURS 7 INDEXED BY JZIX1 PIC X(6) VALUE JSPG2 002390 SPACES. JSPG2 002400 03 JZ-INDEXPR PIC X(6) VALUE SPACES. JSPG2 002410 03 EMPNO PIC 999999 VALUE ZERO. JSPG2 002420 03 JZ-SQLCount PIC S9(9) COMP VALUE ZERO. JSPG2 002430 03 JZLIKE. JSPG2 002440 49 JZL-JZLIKE PIC S9999 COMP-5 Value 0. JSPG2 002450 49 JZD-JZLIKE PIC XXXX Value SPACE. JSPG2 002460 03 EMPLOYEE-WORKDEPT PIC XXX VALUE SPACES. JSPG2 002470 03 Checksum PIC X(40) VALUE SPACES. JSPG2 002480 03 JZSQLDate1 PIC X(10) VALUE SPACES. JSPG2 002490 03 JZSQLDate1N REDEFINES JZSQLDate1 PIC 9999B99B99. JSPG2 002500 03 JZSQLDate2 PIC X(10) VALUE SPACES. JSPG2 002510 03 JZSQLDate2N REDEFINES JZSQLDate2 PIC 9999B99B99. JSPG2 002520 03 PHONENO PIC 9999 VALUE ZERO. JSPG2 002530 03 IsDateArith PIC X VALUE SPACES. JSPG2 002540 03 LeapYear PIC X VALUE SPACES. JSPG2 002550 03 DateFormPic PIC 99999999 VALUE ZERO. JSPG2 002560 03 DateFormPicR REDEFINES DateFormPic. JSPG2 002570 05 DateFormCYear PIC 9999. JSPG2 002580 05 DateFormCYearR REDEFINES DateFormCYear. JSPG2 002590 07 FILLER PIC 99. JSPG2 002600 07 DateFormYear PIC 99. JSPG2 002610 05 DateFormMth PIC 99. JSPG2 002620 05 DateFormDay PIC 99. JSPG2 002630 03 JZ-DateDiff. JSPG2 002640 05 DFYears PIC S9(4) COMP VALUE ZERO. JSPG2 002650 05 DFMonths PIC S9(4) COMP VALUE ZERO. JSPG2 002660 05 DFDays PIC S9(4) COMP VALUE ZERO. JSPG2 002670 05 DFOrdDays PIC S9(4) COMP VALUE ZERO. JSPG2 002680 03 DateFormddbMMMbyy PIC X(9) VALUE SPACES. JSPG2 002690 03 DateFormddbMMMbyyR REDEFINES DateFormddbMMMbyy. JSPG2 002700 05 JZ-Day PIC 99. JSPG2 002710 05 FILLER PIC X. JSPG2 002720 05 SMth PIC XXX. JSPG2 002730 05 FILLER PIC X. JSPG2 002740 05 Year PIC 99. JSPG2 002750 03 JZNXTKY6. JSPG2 002760 49 JZL-JZNXTKY6 PIC S9999 COMP-5 Value 0. JSPG2 002770 49 JZD-JZNXTKY6 PIC X(6) Value SPACE. JSPG2 002780 03 SQLCodePic PIC -999 VALUE ZERO. JSPG2 002790 03 STARTTIME PIC X(8) VALUE SPACES. JSPG2 002800* Convert Unpacked to Decimal JSPG2 002810 03 UNSPCKD PIC 9(7) COMP-3 VALUE 0. JSPG2 002820 03 UNSPCKD3 REDEFINES UNSPCKD PIC X(3). JSPG2 002830 03 UNSPCKDG2 REDEFINES UNSPCKD. JSPG2 002840 05 FILLER PIC X(1). JSPG2 002850 05 UNSPCKD2 PIC X(2). JSPG2 002860 03 UNSPCKDG1 REDEFINES UNSPCKD. JSPG2 002870 05 FILLER PIC X(2). JSPG2 002880 05 UNSPCKD1 PIC X(1). JSPG2 002890******************************************************************JSPG2 002900** **JSPG2 002910** JZSMth **JSPG2 002920** **JSPG2 002930******************************************************************JSPG2 002940* JSPG2 002950 01 JZSMth. JSPG2 002960 03 SMth PIC S9(4) COMP VALUE ZERO. JSPG2 002970******************************************************************JSPG2 002980** **JSPG2 002990** JZ-Program-Info **JSPG2 003000** **JSPG2 003010******************************************************************JSPG2 003020* JSPG2 003030 01 JZ-Program-Info. JSPG2 003040 05 ABID PIC X(8) VALUE 'JZABNDW'. JSPG2 003050 05 Prog-id. JSPG2 003060 49 JZL-Prog-id PIC S9999 COMP-5 Value 0. JSPG2 003070 49 JZD-Prog-id PIC X(20) Value SPACE. JSPG2 003080 05 Auth. JSPG2 003090 49 JZL-Auth PIC S9999 COMP-5 Value 0. JSPG2 003100 49 JZD-Auth PIC X(40) Value SPACE. JSPG2 003110 05 DTE-Written. JSPG2 003120 49 JZL-DTE-Written PIC S9999 COMP-5 Value 0. JSPG2 003130 49 JZD-DTE-Written PIC X(24) Value SPACE. JSPG2 003140 05 JZ-Jazz-Stmt. JSPG2 003150 49 JZL-JZ-Jazz-Stmt PIC S9999 COMP-5 Value 0. JSPG2 003160 49 JZD-JZ-Jazz-Stmt PIC X(80) Value SPACE. JSPG2 003170 05 JZ-CICS-Stmt. JSPG2 003180 49 JZL-JZ-CICS-Stmt PIC S9999 COMP-5 Value 0. JSPG2 003190 49 JZD-JZ-CICS-Stmt PIC X(80) Value SPACE. JSPG2 003200 05 JZ-Response PIC S9(9) COMP VALUE ZERO. JSPG2 003210 05 Response2 PIC S9(9) COMP VALUE ZERO. JSPG2 003220 05 SQLIsUsed PIC X VALUE 'Y'. JSPG2 003230 05 IsWebService PIC X VALUE 'Y'. JSPG2 003240 05 SQL-Stmt. JSPG2 003250 49 JZL-SQL-Stmt PIC S9999 COMP-5 Value 0. JSPG2 003260 49 JZD-SQL-Stmt PIC X(80) Value SPACE. JSPG2 003270 05 JZ-SQLCA. JSPG2 003280 49 JZL-JZ-SQLCA PIC S9999 COMP-5 Value 0. JSPG2 003290 49 JZD-JZ-SQLCA PIC X(80) Value SPACE. JSPG2 003300 05 JZ-SQLCODE PIC S9(9) COMP VALUE ZERO. JSPG2 003310 05 WSType PIC XXXX VALUE SPACES. JSPG2 003320 05 WSTransportType PIC XXXX VALUE SPACES. JSPG2 003330 05 WSSourceType PIC XXXX VALUE SPACES. JSPG2 003340******************************************************************JSPG2 003350** **JSPG2 003360** Web Service Control data **JSPG2 003370** **JSPG2 003380******************************************************************JSPG2 003390* JSPG2 003400 01 JZSoap-Pipeline-Data. JSPG2 003410 03 JZServiceName PIC X(32) VALUE 'MYJSV '. JSPG2 003420 03 JZOperationName PIC X(255) VALUE 'JSPG2'. JSPG2 003430 03 JZContainerName PIC X(16) VALUE 'DFHWS-DATA'. JSPG2 003440 03 JZChannelName PIC X(16) VALUE 'JSPG2-CHANNEL'. JSPG2 003450 03 JZInputContainer PIC X(16) VALUE SPACES. JSPG2 003460 03 JZBrowseToken PIC 9(8) BINARY VALUE 0. JSPG2 003470* JSPG2 003480 01 JZURI-Structure. JSPG2 003490 03 FILLER PIC X(10) VALUE SPACES. JSPG2 003500 03 JZURI PIC X(255) VALUE SPACES. JSPG2 003510******************************************************************JSPG2 003520** **JSPG2 003530** IJSPG2 **JSPG2 003540** **JSPG2 003550******************************************************************JSPG2 003560* JSPG2 003570 01 IJSPG2. JSPG2 003580 03 JZ-Function PIC X VALUE 'E'. JSPG2 003590 03 JZ-EMPLOYEE-Skip PIC S9(4) COMP-5 VALUE 0. JSPG2 003600 03 JZ-EMPLOYEE. JSPG2 003610 05 EMPNO PIC X(6) VALUE SPACES. JSPG2 003620 05 FIRSTNME PIC X(12) VALUE SPACES. JSPG2 003630 05 MIDINIT PIC X VALUE SPACES. JSPG2 003640 05 LASTNAME PIC X(15) VALUE SPACES. JSPG2 003650 05 WORKDEPT PIC XXX VALUE SPACES. JSPG2 003660 05 PHONENO PIC XXXX VALUE SPACES. JSPG2 003670 05 HIREDATE PIC X(9) VALUE SPACES. JSPG2 003680 05 JOB PIC X(8) VALUE SPACES. JSPG2 003690 05 EDLEVEL PIC X(7) VALUE SPACES. JSPG2 003700 05 SEX PIC X VALUE SPACES. JSPG2 003710 05 BIRTHDATE PIC X(9) VALUE SPACES. JSPG2 003720 05 SALARY PIC X(15) VALUE SPACES. JSPG2 003730 05 BONUS PIC X(15) VALUE SPACES. JSPG2 003740 05 COMM PIC X(15) VALUE SPACES. JSPG2 003750 05 JZ-CURRENCY PIC XXX VALUE SPACES. JSPG2 003760 05 DEPTMGR PIC XXXXX VALUE SPACES. JSPG2 003770 05 STARTTIME PIC X(12) VALUE SPACES. JSPG2 003780 05 Checksum PIC X(40) VALUE SPACES. JSPG2 003790******************************************************************JSPG2 003800** **JSPG2 003810** OJSPG2 **JSPG2 003820** **JSPG2 003830******************************************************************JSPG2 003840* JSPG2 003850 01 OJSPG2. JSPG2 003860 03 JZ-Error. JSPG2 003870 49 JZL-Error PIC S9999 COMP-5. JSPG2 003880 49 JZD-Error PIC X(80). JSPG2 003890 03 JZ-EMPLOYEE-ReadTo PIC S9(4) COMP-5 VALUE 0. JSPG2 003900 03 JZ-EMPLOYEE-NbrReturned PIC S9(4) COMP-5 VALUE 0. JSPG2 003910 03 JZ-EMPLOYEE-BrowseCount PIC S9(4) COMP-5 VALUE 0. JSPG2 003920 03 JZ-EMPLOYEE OCCURS 6 INDEXED BY JZIX2. JSPG2 003930 05 JZ-EMPLOYEE-ReturnCode PIC X VALUE SPACES. JSPG2 003940 05 EMPNO PIC X(6) VALUE '000000'. JSPG2 003950 05 FIRSTNME. JSPG2 003960 49 JZL-FIRSTNME PIC S9999 COMP-5. JSPG2 003970 49 JZD-FIRSTNME PIC X(12). JSPG2 003980 05 MIDINIT PIC X VALUE SPACES. JSPG2 003990 05 LASTNAME. JSPG2 004000 49 JZL-LASTNAME PIC S9999 COMP-5. JSPG2 004010 49 JZD-LASTNAME PIC X(15). JSPG2 004020 05 WORKDEPT PIC XXX VALUE SPACES. JSPG2 004030 05 PHONENO PIC XXXX VALUE '0000'. JSPG2 004040 05 HIREDATE PIC S9(9) COMP-5 VALUE ZERO. JSPG2 004050 05 JOB PIC X(8) VALUE SPACES. JSPG2 004060 05 EDLEVEL PIC S9(4) COMP-5 VALUE ZERO. JSPG2 004070 05 SEX PIC X VALUE SPACES. JSPG2 004080 05 BIRTHDATE PIC S9(9) COMP-5 VALUE ZERO. JSPG2 004090 05 SALARY PIC S9(7)V9(2) COMP-3 VALUE ZERO. JSPG2 004100 05 BONUS PIC S9(7)V9(2) COMP-3 VALUE ZERO. JSPG2 004110 05 COMM PIC S9(7)V9(2) COMP-3 VALUE ZERO. JSPG2 004120 05 JZ-CURRENCY PIC XXX VALUE SPACES. JSPG2 004130 05 DEPTMGR PIC X VALUE SPACES. JSPG2 004140 05 STARTTIME PIC S9(9) COMP-5 VALUE ZERO. JSPG2 004150 05 Checksum PIC X(40) VALUE SPACES. JSPG2 004160 05 DEPTNAME. JSPG2 004170 49 JZL-DEPTNAME PIC S9999 COMP-5. JSPG2 004180 49 JZD-DEPTNAME PIC X(36). JSPG2 004190******************************************************************JSPG2 004200** **JSPG2 004210** JZTrim (Parameters) **JSPG2 004220** **JSPG2 004230******************************************************************JSPG2 004240* JSPG2 004250 01 JZTrim. JSPG2 004260* Indata CHAR(*) JSPG2 004270 03 Indata PIC X(15) VALUE SPACES. JSPG2 004280 03 IndataA REDEFINES Indata OCCURS 1 INDEXED BY JZIX3 PIC JSPG2 004290 X. JSPG2 004300 03 ParmIn. JSPG2 004310 05 InDataLth PIC S9(4) COMP VALUE ZERO. JSPG2 004320 05 OutDataLth PIC S9(4) COMP VALUE ZERO. JSPG2 004330 05 TrimType PIC XXXXX VALUE SPACES. JSPG2 004340 03 ParmOut. JSPG2 004350 05 JZ-Left PIC S9(4) COMP VALUE ZERO. JSPG2 004360 05 JZ-Right PIC S9(4) COMP VALUE ZERO. JSPG2 004370 05 JZ-Length PIC S9(4) COMP VALUE ZERO. JSPG2 004380 05 SpecialName PIC XXXXX VALUE SPACES. JSPG2 004390* Result VARCHAR(*) JSPG2 004400 03 Result. JSPG2 004410 49 JZL-Result PIC S9999 COMP-5. JSPG2 004420 49 JZD-Result PIC X(15). JSPG2 004430 03 ResultG REDEFINES Result. JSPG2 004440 05 ResultL PIC S9(4) COMP-5. JSPG2 004450 05 ResultA OCCURS 1 INDEXED BY JZIX4 PIC X. JSPG2 004460******************************************************************JSPG2 004470** **JSPG2 004480** JZMDays **JSPG2 004490** **JSPG2 004500******************************************************************JSPG2 004510* JSPG2 004520 01 JZMDays. JSPG2 004530 03 MDayG. JSPG2 004540 05 Jan PIC S9(4) COMP VALUE 31. JSPG2 004550 05 Feb PIC S9(4) COMP VALUE 28. JSPG2 004560 05 Mar PIC S9(4) COMP VALUE 31. JSPG2 004570 05 Apr PIC S9(4) COMP VALUE 30. JSPG2 004580 05 May PIC S9(4) COMP VALUE 31. JSPG2 004590 05 Jun PIC S9(4) COMP VALUE 30. JSPG2 004600 05 Jul PIC S9(4) COMP VALUE 31. JSPG2 004610 05 Aug PIC S9(4) COMP VALUE 31. JSPG2 004620 05 Sep PIC S9(4) COMP VALUE 30. JSPG2 004630 05 Oct PIC S9(4) COMP VALUE 31. JSPG2 004640 05 Nov PIC S9(4) COMP VALUE 30. JSPG2 004650 05 Dec PIC S9(4) COMP VALUE 31. JSPG2 004660 03 MDayR REDEFINES MDayG OCCURS 12 INDEXED BY JZIX5 PIC JSPG2 004670 S9(4) COMP. JSPG2 004680 03 CDayG. JSPG2 004690 05 Jan PIC S9(4) COMP VALUE 31. JSPG2 004700 05 Feb PIC S9(4) COMP VALUE 59. JSPG2 004710 05 Mar PIC S9(4) COMP VALUE 90. JSPG2 004720 05 Apr PIC S9(4) COMP VALUE 120. JSPG2 004730 05 May PIC S9(4) COMP VALUE 151. JSPG2 004740 05 Jun PIC S9(4) COMP VALUE 181. JSPG2 004750 05 Jul PIC S9(4) COMP VALUE 212. JSPG2 004760 05 Aug PIC S9(4) COMP VALUE 243. JSPG2 004770 05 Sep PIC S9(4) COMP VALUE 273. JSPG2 004780 05 Oct PIC S9(4) COMP VALUE 304. JSPG2 004790 05 Nov PIC S9(4) COMP VALUE 334. JSPG2 004800 05 Dec PIC S9(4) COMP VALUE 365. JSPG2 004810 03 CDayR REDEFINES CDayG OCCURS 12 INDEXED BY JZIX6 PIC JSPG2 004820 S9(4) COMP. JSPG2 004830******************************************************************JSPG2 004840** **JSPG2 004850** JZDTVS (Parameters) **JSPG2 004860** **JSPG2 004870******************************************************************JSPG2 004880* JSPG2 004890 01 JZ-JZDTVS. JSPG2 004900 03 InDate PIC X(16) VALUE SPACES. JSPG2 004910 03 DPic PIC X(16) VALUE SPACES. JSPG2 004920 03 DateOut. JSPG2 004930 05 Years PIC S9(4) COMP VALUE ZERO. JSPG2 004940 05 Months PIC S9(4) COMP VALUE ZERO. JSPG2 004950 05 Days PIC S9(4) COMP VALUE ZERO. JSPG2 004960 05 OrdDays PIC S9(4) COMP VALUE ZERO. JSPG2 004970 03 HasError PIC X VALUE 'N'. JSPG2 004980******************************************************************JSPG2 004990** **JSPG2 005000** JZTMVS (Parameters) **JSPG2 005010** **JSPG2 005020******************************************************************JSPG2 005030* JSPG2 005040 01 JZ-JZTMVS. JSPG2 005050 03 InTime PIC X(12) VALUE SPACES. JSPG2 005060 03 InTimeN REDEFINES InTime PIC 999999999BBB. JSPG2 005070 03 InTimeA REDEFINES InTime OCCURS 12 INDEXED BY JZIX7 PICJSPG2 005080 X. JSPG2 005090 03 InDPIC PIC X(12) VALUE SPACE. JSPG2 005100 03 InDPicA REDEFINES InDPIC OCCURS 12 INDEXED BY JZIX8 PICJSPG2 005110 X. JSPG2 005120 03 TimeOut PIC S9(9) COMP VALUE ZERO. JSPG2 005130 03 JZ-Invalid PIC X VALUE 'Y'. JSPG2 005140 03 Msg. JSPG2 005150 49 JZL-Msg PIC S9999 COMP-5 Value 3. JSPG2 005160 49 JZD-Msg PIC X(80) Value SPACE. JSPG2 005170******************************************************************JSPG2 005180** **JSPG2 005190** Code Tables **JSPG2 005200** **JSPG2 005210******************************************************************JSPG2 005220* JSPG2 005230* EMPLOYEE.SEX JSPG2 005240 01 JZCODES-EMPLOYEE-SEX. JSPG2 005250 03 JZVALUES. JSPG2 005260 05 FILLER PIC X(7) VALUE 'MMale '. JSPG2 005270 05 FILLER PIC X(7) VALUE 'FFemale'. JSPG2 005280 03 JZTABLE REDEFINES JZValues. JSPG2 005290 05 ITEM-VALUES OCCURS 2 INDEXED BY JZIX-EMPLOYEE-SEX. JSPG2 005300 07 JZCODE PIC X. JSPG2 005310 07 CODE-VALUE PIC X(6). JSPG2 005320 03 FILLER. JSPG2 005330 05 SEARCH-FOR PIC X. JSPG2 005340 05 FOUND-VALUE PIC X(6) VALUE '******'. JSPG2 005350* JSPG2 005360* JZSMth.SMth JSPG2 005370 01 JZCODES-JZSMth-SMth. JSPG2 005380 03 JZVALUES. JSPG2 005390 05 FILLER PIC X(3) VALUE 'Jan'. JSPG2 005400 05 FILLER PIC X(3) VALUE 'Feb'. JSPG2 005410 05 FILLER PIC X(3) VALUE 'Mar'. JSPG2 005420 05 FILLER PIC X(3) VALUE 'Apr'. JSPG2 005430 05 FILLER PIC X(3) VALUE 'May'. JSPG2 005440 05 FILLER PIC X(3) VALUE 'Jun'. JSPG2 005450 05 FILLER PIC X(3) VALUE 'Jul'. JSPG2 005460 05 FILLER PIC X(3) VALUE 'Aug'. JSPG2 005470 05 FILLER PIC X(3) VALUE 'Sep'. JSPG2 005480 05 FILLER PIC X(3) VALUE 'Oct'. JSPG2 005490 05 FILLER PIC X(3) VALUE 'Nov'. JSPG2 005500 05 FILLER PIC X(3) VALUE 'Dec'. JSPG2 005510 03 JZTABLE REDEFINES JZValues. JSPG2 005520 05 ITEM-VALUES OCCURS 12 INDEXED BY JZIX-JZSMth-SMth. JSPG2 005530 07 CODE-VALUE PIC X(3). JSPG2 005540 03 FILLER. JSPG2 005550 05 SEARCH-FOR PIC S9(4) COMP. JSPG2 005560 05 FOUND-VALUE PIC X(3) VALUE '***'. JSPG2 005570* JSPG2 005580* IJSPG2.Function JSPG2 005590 01 JZCODES-IJSPG2-Function. JSPG2 005600 03 JZVALUES. JSPG2 005610 05 FILLER PIC X(8) VALUE 'EEnquiry'. JSPG2 005620 05 FILLER PIC X(8) VALUE 'UUpdate '. JSPG2 005630 05 FILLER PIC X(8) VALUE 'AAdd '. JSPG2 005640 05 FILLER PIC X(8) VALUE 'DDelete '. JSPG2 005650 03 JZTABLE REDEFINES JZValues. JSPG2 005660 05 ITEM-VALUES OCCURS 4 INDEXED BY JZIX-IJSPG2-Function.JSPG2 005670 07 JZCODE PIC X. JSPG2 005680 07 CODE-VALUE PIC X(7). JSPG2 005690 03 FILLER. JSPG2 005700 05 SEARCH-FOR PIC X. JSPG2 005710 05 FOUND-VALUE PIC X(7) VALUE '*******'. JSPG2 005720******************************************************************JSPG2 005730** **JSPG2 005740** Procedure Division. **JSPG2 005750** **JSPG2 005760******************************************************************JSPG2 005770* JSPG2 005780 PROCEDURE DIVISION. JSPG2 005790 MOVE 'SAMPLE' TO JZC-DATABASE. JSPG2 005800 EXEC SQL JSPG2 005810 CONNECT TO :JZC-DATABASE JSPG2 005820 END-EXEC. JSPG2 005830 IF SQLCODE NOT = 0 JSPG2 005840* Try reset and connect again JSPG2 005850 EXEC SQL JSPG2 005860 ROLLBACK JSPG2 005870 END-EXEC JSPG2 005880 EXEC SQL JSPG2 005890 CONNECT TO :JZC-DATABASE JSPG2 005900 END-EXEC JSPG2 005910 IF SQLCODE NOT = 0 JSPG2 005920 GO TO JZ-Abend-Exit JSPG2 005930 END-IF JSPG2 005940 END-IF. JSPG2 005950* Find container name, and GET it JSPG2 005960 EXEC CICS JSPG2 005970 STARTBROWSE CONTAINER BROWSETOKEN(JZBrowseToken) JSPG2 005980 RESP(JZ-RESPONSE) JSPG2 005990 END-EXEC. JSPG2 006000 EXEC CICS JSPG2 006010 GETNEXT CONTAINER(JZInputContainer) JSPG2 006020 BROWSETOKEN(JZBrowseToken) RESP(JZ-RESPONSE) JSPG2 006030 END-EXEC. JSPG2 006040 EXEC CICS JSPG2 006050 ENDBROWSE CONTAINER BROWSETOKEN(JZBrowseToken) JSPG2 006060 RESP(JZ-RESPONSE) JSPG2 006070 END-EXEC. JSPG2 006080 EXEC CICS JSPG2 006090 GET CONTAINER(JZInputContainer) INTO(IJSPG2) JSPG2 006100 RESP(JZ-RESPONSE) JSPG2 006110 END-EXEC. JSPG2 006120 PERFORM CICS-CheckStatus. JSPG2 006130* Initialise output message(s) JSPG2 006140 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 006150 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 006160 Move 0 TO JZ-EMPLOYEE-ReadTo OF OJSPG2. JSPG2 006170 Move 0 TO JZ-EMPLOYEE-NbrReturned OF OJSPG2. JSPG2 006180 Move 0 TO JZ-EMPLOYEE-BrowseCount OF OJSPG2. JSPG2 006190 PERFORM VARYING JZIX2 FROM 1 BY 1 UNTIL JZIX2 > 6 JSPG2 006200 Move SPACES TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(JZIX2) JSPG2 006210 Move '000000' TO EMPNO OF OJSPG2(JZIX2) JSPG2 006220 Move SPACES TO JZD-FIRSTNME OF OJSPG2(JZIX2) JSPG2 006230 MOVE ZERO TO JZL-FIRSTNME OF OJSPG2(JZIX2) JSPG2 006240 Move SPACES TO MIDINIT OF OJSPG2(JZIX2) JSPG2 006250 Move SPACES TO JZD-LASTNAME OF OJSPG2(JZIX2) JSPG2 006260 MOVE ZERO TO JZL-LASTNAME OF OJSPG2(JZIX2) JSPG2 006270 Move SPACES TO WORKDEPT OF OJSPG2(JZIX2) JSPG2 006280 Move '0000' TO PHONENO OF OJSPG2(JZIX2) JSPG2 006290 Move ZERO TO HIREDATE OF OJSPG2(JZIX2) JSPG2 006300 Move SPACES TO JOB OF OJSPG2(JZIX2) JSPG2 006310 Move ZERO TO EDLEVEL OF OJSPG2(JZIX2) JSPG2 006320 Move SPACES TO SEX OF OJSPG2(JZIX2) JSPG2 006330 Move ZERO TO BIRTHDATE OF OJSPG2(JZIX2) JSPG2 006340 Move ZERO TO SALARY OF OJSPG2(JZIX2) JSPG2 006350 Move ZERO TO BONUS OF OJSPG2(JZIX2) JSPG2 006360 Move ZERO TO COMM OF OJSPG2(JZIX2) JSPG2 006370 Move SPACES TO JZ-CURRENCY OF OJSPG2(JZIX2) JSPG2 006380 Move SPACES TO DEPTMGR OF OJSPG2(JZIX2) JSPG2 006390 Move ZERO TO STARTTIME OF OJSPG2(JZIX2) JSPG2 006400 Move SPACES TO Checksum OF OJSPG2(JZIX2) JSPG2 006410 Move SPACES TO JZD-DEPTNAME OF OJSPG2(JZIX2) JSPG2 006420 MOVE ZERO TO JZL-DEPTNAME OF OJSPG2(JZIX2) JSPG2 006430 END-PERFORM. JSPG2 006440 PERFORM JZ-Main-Program-Logic. JSPG2 006450 JZ-Normal-Exit. JSPG2 006460 IF EMPLOYEE-UpdatePending-Flag = 'Y' JSPG2 006470* Update not done - probably because of Accept-detected JSPG2 006480* errorsJSPG2 006490 EXEC SQL ROLLBACK END-EXEC JSPG2 006500 ELSE JSPG2 006510 EXEC SQL COMMIT END-EXEC JSPG2 006520 END-IF. JSPG2 006530 PERFORM JZPutContainer. JSPG2 006540 EXEC CICS JSPG2 006550 RETURN RESP(JZ-RESPONSE) JSPG2 006560 END-EXEC. JSPG2 006570 GOBACK. JSPG2 006580 JZ-Abend-Exit. JSPG2 006590* BR14 does nothing, but is useful for CEDF/CEDX debugging JSPG2 006600 MOVE SQLCODE TO JZ-SQLCODE OF JZ-Program-Info. JSPG2 006610 IF SQLCODE NOT = ZERO JSPG2 006620 MOVE SQLERRM OF SQLCA TO JZ-SQLCA OF JZ-Program-Info JSPG2 006630 END-IF. JSPG2 006640 EXEC CICS LINK PROGRAM('JZBR14 ') COMMAREA(JZ-Program-Info) JSPG2 006650 END-EXEC. JSPG2 006660 EXEC SQL ROLLBACK END-EXEC. JSPG2 006670 MOVE 80 TO JZ-MLTH. JSPG2 006680 CALL 'JZABNDW' USING DFHEIBLK DFHCOMMAREA JZ-Program-Info JSPG2 006690 JZ-Error OF OJSPG2 JZ-MLTH. JSPG2 006700 PERFORM JZPutContainer. JSPG2 006710 EXEC CICS JSPG2 006720 RETURN RESP(JZ-RESPONSE) JSPG2 006730 END-EXEC. JSPG2 006740******************************************************************JSPG2 006750** **JSPG2 006760** Main Program Logic **JSPG2 006770** **JSPG2 006780******************************************************************JSPG2 006790* JSPG2 006800 JZ-Main-Program-Logic. JSPG2 006810* ACCEPT (IJSPG2.Function) MESSAGE OJSPG2.Error; JSPG2 006820 PERFORM JZ-40-ACCEPT. JSPG2 006830* CASE (IJSPG2.Function); JSPG2 006840 EVALUATE JZ-Function OF IJSPG2 JSPG2 006850* WHEN (Enquiry); JSPG2 006860 When 'E' JSPG2 006870 PERFORM JZ-42-WHEN JSPG2 006880* WHEN (Update); JSPG2 006890 When 'U' JSPG2 006900 PERFORM JZ-46-WHEN JSPG2 006910* WHEN (Add); JSPG2 006920 When 'A' JSPG2 006930 PERFORM JZ-60-WHEN JSPG2 006940* WHEN (Delete); JSPG2 006950 When 'D' JSPG2 006960 PERFORM JZ-65-WHEN JSPG2 006970 END-EVALUATE. JSPG2 006980* REPLY; JSPG2 006990 GO TO JZ-Normal-Exit. JSPG2 007000* JSPG2 007010 JZ-40-ACCEPT. JSPG2 007020* ACCEPT (IJSPG2.Function) MESSAGE OJSPG2.Error; JSPG2 007030 MOVE 'N' TO JZ-Error OF JZ. JSPG2 007040 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 007050 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 007060* Validate IJSPG2.Function JSPG2 007070 MOVE SPACES TO JZ-CHAR80. JSPG2 007080 MOVE 'Function' TO JZ-FNAME. JSPG2 007090 IF JZ-Function OF IJSPG2 NOT = SPACES AND JZ-Function OF JSPG2 007100 IJSPG2 NOT = LOW-VALUE JSPG2 007110 MOVE FUNCTION UPPER-CASE(JZ-Function OF IJSPG2) TO JSPG2 007120 JZ-Function OF IJSPG2 JSPG2 007130* Check Code Values JSPG2 007140 MOVE JZ-Function OF IJSPG2 TO SEARCH-FOR OF JSPG2 007150 JZCodes-IJSPG2-Function JSPG2 007160 PERFORM JZCvt-IJSPG2-Function JSPG2 007170 END-IF. JSPG2 007180 IF JZ-CHAR80 NOT = SPACE JSPG2 007190 MOVE 'Y' TO JZ-Error OF JZ JSPG2 007200 MOVE 80 TO JZ-MLTH JSPG2 007210 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 007220 END-IF. JSPG2 007230 IF JZ-Error OF JZ = 'Y' JSPG2 007240* Respond with error messages and exit program JSPG2 007250 GO TO JZ-Normal-Exit JSPG2 007260 END-IF. JSPG2 007270* JSPG2 007280* WHEN (Enquiry); JSPG2 007290 JZ-42-WHEN. JSPG2 007300* ACCEPT (EMPLOYEE.EMPNO = IJSPG2.EMPNO OR EMPLOYEE.WORKDEPT = JSPG2 007310* IJSPG2.WORKDEPT) MESSAGE OJSPG2.Error;JSPG2 007320 PERFORM JZ-43-ACCEPT. JSPG2 007330* GET EMPLOYEE KEY(EMPLOYEE.EMPNO OR EMPLOYEE.WORKDEPT) JSPG2 007340* SAVESUM OJSPG2.JZ-EMPLOYEE.Checksum;JSPG2 007350 PERFORM JZ-44-GET. JSPG2 007360* JSPG2 007370 JZ-43-ACCEPT. JSPG2 007380* ACCEPT (EMPLOYEE.EMPNO = IJSPG2.EMPNO OR EMPLOYEE.WORKDEPT = JSPG2 007390* IJSPG2.WORKDEPT) MESSAGE OJSPG2.Error;JSPG2 007400 MOVE 'N' TO JZ-Error OF JZ. JSPG2 007410 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 007420 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 007430* Validate IJSPG2.EMPNO, assign to EMPLOYEE.EMPNO JSPG2 007440 MOVE SPACES TO JZ-CHAR80. JSPG2 007450 MOVE 'EMPNO' TO JZ-FNAME. JSPG2 007460 IF EMPNO OF IJSPG2 NOT = SPACES AND EMPNO OF IJSPG2 NOT = JSPG2 007470 LOW-VALUE JSPG2 007480 MOVE 6 TO InDataLth OF JZTRIM JSPG2 007490 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 007500 CALL 'JZTrim' USING EMPNO OF IJSPG2 ParmIn OF JZTrim JSPG2 007510 ParmOut of JZTrim Result OF JZTrim JSPG2 007520 IF JZL-Result OF JZTrim > ZERO JSPG2 007530 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS JSPG2 007540 NUMERIC JSPG2 007550 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result JSPG2 007560 OF JZTrim(1:JZL-Result OF JZTrim)) JSPG2 007570 MOVE EMPNO OF JZ TO EMPNO OF EMPLOYEE JSPG2 007580 ELSE JSPG2 007590 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 007600 END-IF JSPG2 007610 END-IF JSPG2 007620 END-IF. JSPG2 007630 IF JZ-CHAR80 NOT = SPACE JSPG2 007640 MOVE 'Y' TO JZ-Error OF JZ JSPG2 007650 MOVE 80 TO JZ-MLTH JSPG2 007660 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 007670 END-IF. JSPG2 007680* Validate IJSPG2.WORKDEPT, assign to EMPLOYEE.WORKDEPT JSPG2 007690 MOVE SPACES TO JZ-CHAR80. JSPG2 007700 MOVE 'WORKDEPT' TO JZ-FNAME. JSPG2 007710 IF WORKDEPT OF IJSPG2 NOT = SPACES AND WORKDEPT OF IJSPG2 NOTJSPG2 007720 = LOW-VALUE JSPG2 007730 MOVE FUNCTION UPPER-CASE(WORKDEPT OF IJSPG2) TO WORKDEPT JSPG2 007740 OF IJSPG2 JSPG2 007750 MOVE 3 TO InDataLth OF JZTRIM JSPG2 007760 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 007770 CALL 'JZTrim' USING WORKDEPT OF IJSPG2 ParmIn OF JZTrim JSPG2 007780 ParmOut of JZTrim Result OF JZTrim JSPG2 007790 IF JZL-Result OF JZTrim > ZERO JSPG2 007800 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 007810 WORKDEPT OF EMPLOYEE JSPG2 007820 MOVE 0 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 007830 ELSE JSPG2 007840 MOVE SPACES TO WORKDEPT OF EMPLOYEE JSPG2 007850 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 007860 MOVE -1 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 007870 ELSE JSPG2 007880 MOVE 0 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 007890 END-IF JSPG2 007900 END-IF JSPG2 007910* Test that one of the OR-list fields are present JSPG2 007920 IF EMPNO OF EMPLOYEE = '000000' AND JZB-WORKDEPT OF JSPG2 007930 EMPLOYEE < ZERO JSPG2 007940 MOVE 'value required' TO JZ-CHAR80 JSPG2 007950 MOVE 'EMPNO,WORKDEPT' TO JZ-FNAME JSPG2 007960 END-IF JSPG2 007970* Check Exists JSPG2 007980 IF WORKDEPT OF EMPLOYEE NOT = SPACES JSPG2 007990 IF WORKDEPT OF EMPLOYEE NOT = DEPTNO OF DEPARTMENT JSPG2 008000 EXEC SQL JSPG2 008010 SELECT COUNT(*) INTO :JZ-SQLCOUNT FROM JSPG2 008020 DEPARTMENT WHERE DEPTNO = :EMPLOYEE.WORKDEPTJSPG2 008030 END-EXEC JSPG2 008040 IF JZ-SQLCOUNT = ZERO JSPG2 008050 MOVE 'VALUE DOES NOT EXIST' TO JZ-CHAR80 JSPG2 008060 END-IF JSPG2 008070 END-IF JSPG2 008080 END-IF JSPG2 008090 END-IF. JSPG2 008100 IF JZ-CHAR80 NOT = SPACE JSPG2 008110 MOVE 'Y' TO JZ-Error OF JZ JSPG2 008120 MOVE 80 TO JZ-MLTH JSPG2 008130 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 008140 END-IF. JSPG2 008150 IF JZ-Error OF JZ = 'Y' JSPG2 008160* Respond with error messages and exit program JSPG2 008170 GO TO JZ-Normal-Exit JSPG2 008180 END-IF. JSPG2 008190* JSPG2 008200 JZ-44-GET. JSPG2 008210* GET EMPLOYEE KEY(EMPLOYEE.EMPNO OR EMPLOYEE.WORKDEPT) JSPG2 008220* SAVESUM OJSPG2.JZ-EMPLOYEE.Checksum;JSPG2 008230 MOVE 'N' TO EMPLOYEE-GET4UPDATE-FLAG. JSPG2 008240 IF EMPNO OF EMPLOYEE NOT = '000000' JSPG2 008250 PERFORM JZ-EMPLOYEE-ReadBy1ryKey JSPG2 008260 MOVE ZERO TO JZ-EMPLOYEE-BrowseCount OF OJSPG2 JSPG2 008270 PERFORM JZ-44-GETGroup JSPG2 008280 ELSE JSPG2 008290 IF JZB-WORKDEPT OF EMPLOYEE >= ZERO JSPG2 008300 PERFORM VARYING JZ-KL FROM 3 BY -1 UNTIL JZ-KL <= 1 JSPG2 008310 OR WORKDEPT OF EMPLOYEE(JZ-KL:1) NOT = SPACE JSPG2 008320 END-PERFORM JSPG2 008330* Browse EMPLOYEE BY WORKDEPT(1:JZ-KL) to OJSPG2 JSPG2 008340 PERFORM JZ-44-BROWSE-WORKDEPT JSPG2 008350 ELSE JSPG2 008360 MOVE DFHRESP(NOTFND) TO JZ-RESPONSE JSPG2 008370 MOVE 'N' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 008380 END-IF JSPG2 008390 END-IF. JSPG2 008400* JSPG2 008410* Browse EMPLOYEE BY WORKDEPT(1:JZ-KL) to OJSPG2 JSPG2 008420 JZ-44-BROWSE-WORKDEPT. JSPG2 008430 MOVE 'N' TO EMPLOYEE-ENDFILE. JSPG2 008440 MOVE 'N' TO EMPLOYEE-FOUND-FLAG. JSPG2 008450 STRING WORKDEPT OF EMPLOYEE(1:JZ-KL) DELIMITED BY SIZE '%' JSPG2 008460 DELIMITED BY SIZE INTO JZD-JZLIKE. JSPG2 008470 ADD 1 TO JZ-KL. JSPG2 008480 MOVE JZ-KL TO JZL-JZLIKE. JSPG2 008490 EXEC SQL JSPG2 008500 SELECT COUNT(*) INTO :OJSPG2.JZ-EMPLOYEE-BrowseCount FROMJSPG2 008510 EMPLOYEE WHERE WORKDEPT LIKE :JZLIKE JSPG2 008520 END-EXEC. JSPG2 008530 EXEC SQL JSPG2 008540 DECLARE JZ-44-WORKDEPT-CURSOR CURSOR FOR SELECT JSPG2 008550 EMPLOYEE.EMPNO, EMPLOYEE.FIRSTNME, EMPLOYEE.MIDINIT, JSPG2 008560 EMPLOYEE.LASTNAME, EMPLOYEE.WORKDEPT, JSPG2 008570 EMPLOYEE.PHONENO, INT(REPLACE(CHAR(EMPLOYEE.HIREDATE,JSPG2 008580 ISO), '-', '')), EMPLOYEE.JOB, EMPLOYEE.EDLEVEL, JSPG2 008590 EMPLOYEE.SEX, INT(REPLACE(CHAR(EMPLOYEE.BIRTHDATE, JSPG2 008600 ISO), '-', '')), EMPLOYEE.SALARY, EMPLOYEE.BONUS, JSPG2 008610 EMPLOYEE.COMM, EMPLOYEE.CURRENCY, EMPLOYEE.DEPTMGR, JSPG2 008620 CAST(EMPLOYEE.STARTTIME AS INT) * 1000 FROM EMPLOYEE JSPG2 008630 WHERE WORKDEPT LIKE :JZLIKE JSPG2 008640 END-EXEC. JSPG2 008650 EXEC SQL JSPG2 008660 OPEN JZ-44-WORKDEPT-CURSOR JSPG2 008670 END-EXEC. JSPG2 008680 PERFORM UNTIL EMPLOYEE-ENDFILE = 'Y' JSPG2 008690 MOVE SPACES TO JZD-FIRSTNME OF EMPLOYEE JSPG2 008700 MOVE SPACES TO JZD-LASTNAME OF EMPLOYEE JSPG2 008710 EXEC SQL JSPG2 008720 FETCH JZ-44-WORKDEPT-CURSOR INTO :EMPLOYEE.EMPNO, JSPG2 008730 :EMPLOYEE.FIRSTNME, JSPG2 008740 :EMPLOYEE.MIDINIT:EMPLOYEE.JZB-MIDINIT, JSPG2 008750 :EMPLOYEE.LASTNAME, JSPG2 008760 :EMPLOYEE.WORKDEPT:EMPLOYEE.JZB-WORKDEPT, JSPG2 008770 :EMPLOYEE.PHONENO:EMPLOYEE.JZB-PHONENO, JSPG2 008780 :EMPLOYEE.HIREDATE:EMPLOYEE.JZB-HIREDATE, JSPG2 008790 :EMPLOYEE.JOB:EMPLOYEE.JZB-JOB, JSPG2 008800 :EMPLOYEE.EDLEVEL, JSPG2 008810 :EMPLOYEE.SEX:EMPLOYEE.JZB-SEX, JSPG2 008820 :EMPLOYEE.BIRTHDATE:EMPLOYEE.JZB-BIRTHDATE, JSPG2 008830 :EMPLOYEE.SALARY:EMPLOYEE.JZB-SALARY, JSPG2 008840 :EMPLOYEE.BONUS:EMPLOYEE.JZB-BONUS, JSPG2 008850 :EMPLOYEE.COMM:EMPLOYEE.JZB-COMM, JSPG2 008860 :EMPLOYEE.JZ-CURRENCY:EMPLOYEE.JZB-CURRENCY, JSPG2 008870 :EMPLOYEE.DEPTMGR:EMPLOYEE.JZB-DEPTMGR, JSPG2 008880 :EMPLOYEE.STARTTIME:EMPLOYEE.JZB-STARTTIME JSPG2 008890 END-EXEC JSPG2 008900* Check that READNEXT hasn't run past end JSPG2 008910 SET JZIX2 TO JZ-EMPLOYEE-NbrReturned OF OJSPG2 JSPG2 008920 If SQLCODE NOT = ZERO JSPG2 008930 MOVE 'Y' TO EMPLOYEE-ENDFILE JSPG2 008940 IF JZ-EMPLOYEE-NbrReturned OF OJSPG2 < 1 JSPG2 008950 SET JZIX2 UP BY 1 JSPG2 008960 MOVE 'A' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(JZIX2)JSPG2 008970 ELSE JSPG2 008980 MOVE 'L' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(JZIX2)JSPG2 008990 END-IF JSPG2 009000 END-IF JSPG2 009010 IF EMPLOYEE-ENDFILE = 'N' JSPG2 009020 SET JZIX2 UP BY 1 JSPG2 009030* Skip, or handle record JSPG2 009040 ADD 1 TO JZ-EMPLOYEE-ReadTo OF OJSPG2 JSPG2 009050 IF JZ-EMPLOYEE-ReadTo OF OJSPG2 > JZ-EMPLOYEE-Skip OFJSPG2 009060 IJSPG2 JSPG2 009070 IF JZ-EMPLOYEE-NbrReturned OF OJSPG2 >= 6 JSPG2 009080 MOVE 'Y' TO EMPLOYEE-ENDFILE JSPG2 009090 ELSE JSPG2 009100 IF JZ-EMPLOYEE-ReadTo OF OJSPG2 = 1 JSPG2 009110 MOVE 'F' TO JZ-EMPLOYEE-ReturnCode OF JSPG2 009120 OJSPG2(JZIX2) JSPG2 009130 ELSE JSPG2 009140 MOVE 'N' TO JZ-EMPLOYEE-ReturnCode OF JSPG2 009150 OJSPG2(JZIX2) JSPG2 009160 END-IF JSPG2 009170 MOVE 'Y' TO EMPLOYEE-FOUND-FLAG JSPG2 009180 PERFORM SET-EMPLOYEE-Value-Fields JSPG2 009190 PERFORM JZ-44-GETGroup JSPG2 009200 END-IF JSPG2 009210 END-IF JSPG2 009220 END-IF JSPG2 009230 END-PERFORM. JSPG2 009240 EXEC SQL JSPG2 009250 CLOSE JZ-44-WORKDEPT-CURSOR JSPG2 009260 END-EXEC. JSPG2 009270* JSPG2 009280 JZ-44-GETGroup. JSPG2 009290* END GET EMPLOYEE RESPOND OJSPG2; JSPG2 009300 PERFORM JZ-EMPLOYEE-CopyTo-OJSPG2. JSPG2 009310* JSPG2 009320* WHEN (Update); JSPG2 009330 JZ-46-WHEN. JSPG2 009340* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE OJSPG2.Error; JSPG2 009350 PERFORM JZ-47-ACCEPT. JSPG2 009360* GET EMPLOYEE KEY(EMPLOYEE.EMPNO) UPDATE CHECKSUM JSPG2 009370* IJSPG2.JZ-EMPLOYEE.Checksum;JSPG2 009380 PERFORM JZ-48-GET. JSPG2 009390* JSPG2 009400 JZ-47-ACCEPT. JSPG2 009410* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE OJSPG2.Error; JSPG2 009420 MOVE 'N' TO JZ-Error OF JZ. JSPG2 009430 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 009440 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 009450* Validate IJSPG2.EMPNO, assign to EMPLOYEE.EMPNO JSPG2 009460 MOVE SPACES TO JZ-CHAR80. JSPG2 009470 MOVE 'EMPNO' TO JZ-FNAME. JSPG2 009480 IF EMPNO OF IJSPG2 NOT = SPACES AND EMPNO OF IJSPG2 NOT = JSPG2 009490 LOW-VALUE JSPG2 009500 MOVE 6 TO InDataLth OF JZTRIM JSPG2 009510 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 009520 CALL 'JZTrim' USING EMPNO OF IJSPG2 ParmIn OF JZTrim JSPG2 009530 ParmOut of JZTrim Result OF JZTrim JSPG2 009540 IF JZL-Result OF JZTrim > ZERO JSPG2 009550 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS JSPG2 009560 NUMERIC JSPG2 009570 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result JSPG2 009580 OF JZTrim(1:JZL-Result OF JZTrim)) JSPG2 009590 MOVE EMPNO OF JZ TO EMPNO OF EMPLOYEE JSPG2 009600 ELSE JSPG2 009610 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 009620 END-IF JSPG2 009630 END-IF JSPG2 009640 IF EMPNO OF EMPLOYEE = '000000' JSPG2 009650 MOVE 'value required' TO JZ-CHAR80 JSPG2 009660 END-IF JSPG2 009670 END-IF. JSPG2 009680 IF JZ-CHAR80 NOT = SPACE JSPG2 009690 MOVE 'Y' TO JZ-Error OF JZ JSPG2 009700 MOVE 80 TO JZ-MLTH JSPG2 009710 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 009720 END-IF. JSPG2 009730 IF JZ-Error OF JZ = 'Y' JSPG2 009740* Respond with error messages and exit program JSPG2 009750 GO TO JZ-Normal-Exit JSPG2 009760 END-IF. JSPG2 009770* JSPG2 009780 JZ-48-GET. JSPG2 009790* GET EMPLOYEE KEY(EMPLOYEE.EMPNO) UPDATE CHECKSUM JSPG2 009800* IJSPG2.JZ-EMPLOYEE.Checksum;JSPG2 009810 MOVE 'Y' TO EMPLOYEE-GET4UPDATE-FLAG. JSPG2 009820 PERFORM JZ-EMPLOYEE-ReadBy1ryKey. JSPG2 009830 MOVE 'Y' TO EMPLOYEE-UpdatePending-Flag. JSPG2 009840 MOVE 113 TO JZ-INT. JSPG2 009850 CALL 'JZHASH' USING EMPLOYEE JZ-INT Checksum OF JZ. JSPG2 009860* Check against saved copy JSPG2 009870 IF Checksum OF IJSPG2 IS NOT EQUAL TO Checksum OF JZ JSPG2 009880 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 009890 MOVE 47 TO JZL-Error OF OJSPG2 JSPG2 009900 MOVE 'GET check failure: EMPLOYEE changed or not read' TOJSPG2 009910 JZD-Error OF OJSPG2 JSPG2 009920 GO TO JZ-Normal-Exit JSPG2 009930 END-IF. JSPG2 009940 PERFORM JZ-48-GETGroup. JSPG2 009950* JSPG2 009960 JZ-48-GETGroup. JSPG2 009970* ACCEPT (IJSPG2.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) MESSAGE JSPG2 009980* OJSPG2.Error;JSPG2 009990 PERFORM JZ-58-ACCEPT. JSPG2 010000* END GET EMPLOYEE UPDATE RESPOND OJSPG2; JSPG2 010010 PERFORM JZ-EMPLOYEE-CopyTo-OJSPG2. JSPG2 010020 PERFORM EMPLOYEE-Update. JSPG2 010030 MOVE 'I' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1). JSPG2 010040* JSPG2 010050 JZ-58-ACCEPT. JSPG2 010060* ACCEPT (IJSPG2.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) MESSAGE JSPG2 010070* OJSPG2.Error;JSPG2 010080 MOVE 'N' TO JZ-Error OF JZ. JSPG2 010090 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 010100 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 010110* Validate IJSPG2.JZ-EMPLOYEE.FIRSTNME, assign to JSPG2 010120* EMPLOYEE.FIRSTNMEJSPG2 010130 MOVE SPACES TO JZ-CHAR80. JSPG2 010140 MOVE 'FIRSTNME' TO JZ-FNAME. JSPG2 010150 IF FIRSTNME OF IJSPG2 NOT = SPACES AND FIRSTNME OF IJSPG2 NOTJSPG2 010160 = LOW-VALUE JSPG2 010170 MOVE 12 TO InDataLth OF JZTRIM JSPG2 010180 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 010190 CALL 'JZTrim' USING FIRSTNME OF IJSPG2 ParmIn OF JZTrim JSPG2 010200 ParmOut of JZTrim Result OF JZTrim JSPG2 010210 MOVE JZL-Result OF JZTrim TO JZL-FIRSTNME OF EMPLOYEE JSPG2 010220 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 010230 JZD-FIRSTNME OF EMPLOYEE JSPG2 010240 IF FIRSTNME OF EMPLOYEE = SPACES JSPG2 010250 MOVE 'value required' TO JZ-CHAR80 JSPG2 010260 END-IF JSPG2 010270 END-IF. JSPG2 010280 IF JZ-CHAR80 NOT = SPACE JSPG2 010290 MOVE 'Y' TO JZ-Error OF JZ JSPG2 010300 MOVE 80 TO JZ-MLTH JSPG2 010310 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 010320 END-IF. JSPG2 010330* IJSPG2.JZ-EMPLOYEE.MIDINIT:Nothing to check, assign to JSPG2 010340* EMPLOYEE.MIDINITJSPG2 010350 IF MIDINIT OF IJSPG2 NOT = SPACES AND MIDINIT OF IJSPG2 NOT =JSPG2 010360 LOW-VALUE JSPG2 010370 MOVE 1 TO InDataLth OF JZTRIM JSPG2 010380 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 010390 CALL 'JZTrim' USING MIDINIT OF IJSPG2 ParmIn OF JZTrim JSPG2 010400 ParmOut of JZTrim Result OF JZTrim JSPG2 010410 IF JZL-Result OF JZTrim > ZERO JSPG2 010420 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 010430 MIDINIT OF EMPLOYEE JSPG2 010440 MOVE 0 TO JZB-MIDINIT OF EMPLOYEE JSPG2 010450 ELSE JSPG2 010460 MOVE SPACES TO MIDINIT OF EMPLOYEE JSPG2 010470 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 010480 MOVE -1 TO JZB-MIDINIT OF EMPLOYEE JSPG2 010490 ELSE JSPG2 010500 MOVE 0 TO JZB-MIDINIT OF EMPLOYEE JSPG2 010510 END-IF JSPG2 010520 END-IF JSPG2 010530 END-IF. JSPG2 010540* Validate IJSPG2.JZ-EMPLOYEE.LASTNAME, assign to JSPG2 010550* EMPLOYEE.LASTNAMEJSPG2 010560 MOVE SPACES TO JZ-CHAR80. JSPG2 010570 MOVE 'LASTNAME' TO JZ-FNAME. JSPG2 010580 IF LASTNAME OF IJSPG2 NOT = SPACES AND LASTNAME OF IJSPG2 NOTJSPG2 010590 = LOW-VALUE JSPG2 010600 MOVE 15 TO InDataLth OF JZTRIM JSPG2 010610 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 010620 CALL 'JZTrim' USING LASTNAME OF IJSPG2 ParmIn OF JZTrim JSPG2 010630 ParmOut of JZTrim Result OF JZTrim JSPG2 010640 MOVE JZL-Result OF JZTrim TO JZL-LASTNAME OF EMPLOYEE JSPG2 010650 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 010660 JZD-LASTNAME OF EMPLOYEE JSPG2 010670 IF LASTNAME OF EMPLOYEE = SPACES JSPG2 010680 MOVE 'value required' TO JZ-CHAR80 JSPG2 010690 END-IF JSPG2 010700 END-IF. JSPG2 010710 IF JZ-CHAR80 NOT = SPACE JSPG2 010720 MOVE 'Y' TO JZ-Error OF JZ JSPG2 010730 MOVE 80 TO JZ-MLTH JSPG2 010740 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 010750 END-IF. JSPG2 010760* Validate IJSPG2.JZ-EMPLOYEE.WORKDEPT, assign to JSPG2 010770* EMPLOYEE.WORKDEPTJSPG2 010780 MOVE SPACES TO JZ-CHAR80. JSPG2 010790 MOVE 'WORKDEPT' TO JZ-FNAME. JSPG2 010800 IF WORKDEPT OF IJSPG2 NOT = SPACES AND WORKDEPT OF IJSPG2 NOTJSPG2 010810 = LOW-VALUE JSPG2 010820 MOVE FUNCTION UPPER-CASE(WORKDEPT OF IJSPG2) TO WORKDEPT JSPG2 010830 OF IJSPG2 JSPG2 010840 MOVE 3 TO InDataLth OF JZTRIM JSPG2 010850 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 010860 CALL 'JZTrim' USING WORKDEPT OF IJSPG2 ParmIn OF JZTrim JSPG2 010870 ParmOut of JZTrim Result OF JZTrim JSPG2 010880 IF JZL-Result OF JZTrim > ZERO JSPG2 010890 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 010900 WORKDEPT OF EMPLOYEE JSPG2 010910 MOVE 0 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 010920 ELSE JSPG2 010930 MOVE SPACES TO WORKDEPT OF EMPLOYEE JSPG2 010940 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 010950 MOVE -1 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 010960 ELSE JSPG2 010970 MOVE 0 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 010980 END-IF JSPG2 010990 END-IF JSPG2 011000* Check Exists JSPG2 011010 IF WORKDEPT OF EMPLOYEE NOT = SPACES JSPG2 011020 IF WORKDEPT OF EMPLOYEE NOT = DEPTNO OF DEPARTMENT JSPG2 011030 EXEC SQL JSPG2 011040 SELECT COUNT(*) INTO :JZ-SQLCOUNT FROM JSPG2 011050 DEPARTMENT WHERE DEPTNO = :EMPLOYEE.WORKDEPTJSPG2 011060 END-EXEC JSPG2 011070 IF JZ-SQLCOUNT = ZERO JSPG2 011080 MOVE 'VALUE DOES NOT EXIST' TO JZ-CHAR80 JSPG2 011090 END-IF JSPG2 011100 END-IF JSPG2 011110 END-IF JSPG2 011120 END-IF. JSPG2 011130 IF JZ-CHAR80 NOT = SPACE JSPG2 011140 MOVE 'Y' TO JZ-Error OF JZ JSPG2 011150 MOVE 80 TO JZ-MLTH JSPG2 011160 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 011170 END-IF. JSPG2 011180* Validate IJSPG2.JZ-EMPLOYEE.PHONENO, assign to JSPG2 011190* EMPLOYEE.PHONENOJSPG2 011200 MOVE SPACES TO JZ-CHAR80. JSPG2 011210 MOVE 'PHONENO' TO JZ-FNAME. JSPG2 011220 IF PHONENO OF IJSPG2 NOT = SPACES AND PHONENO OF IJSPG2 NOT =JSPG2 011230 LOW-VALUE JSPG2 011240 MOVE 4 TO InDataLth OF JZTRIM JSPG2 011250 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 011260 CALL 'JZTrim' USING PHONENO OF IJSPG2 ParmIn OF JZTrim JSPG2 011270 ParmOut of JZTrim Result OF JZTrim JSPG2 011280 IF JZL-Result OF JZTrim > ZERO JSPG2 011290 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS JSPG2 011300 NUMERIC JSPG2 011310 COMPUTE PHONENO OF JZ = FUNCTION JSPG2 011320 NUMVAL(JZD-Result OF JZTrim(1:JZL-Result OF JSPG2 011330 JZTrim)) JSPG2 011340 MOVE PHONENO OF JZ TO PHONENO OF EMPLOYEE JSPG2 011350 MOVE 0 TO JZB-PHONENO OF EMPLOYEE JSPG2 011360 ELSE JSPG2 011370 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 011380 END-IF JSPG2 011390 ELSE JSPG2 011400 MOVE '0000' TO PHONENO OF EMPLOYEE JSPG2 011410 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 011420 MOVE -1 TO JZB-PHONENO OF EMPLOYEE JSPG2 011430 ELSE JSPG2 011440 MOVE 0 TO JZB-PHONENO OF EMPLOYEE JSPG2 011450 END-IF JSPG2 011460 END-IF JSPG2 011470 END-IF. JSPG2 011480 IF JZ-CHAR80 NOT = SPACE JSPG2 011490 MOVE 'Y' TO JZ-Error OF JZ JSPG2 011500 MOVE 80 TO JZ-MLTH JSPG2 011510 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 011520 END-IF. JSPG2 011530* Validate IJSPG2.JZ-EMPLOYEE.HIREDATE, assign to JSPG2 011540* EMPLOYEE.HIREDATEJSPG2 011550 MOVE SPACES TO JZ-CHAR80. JSPG2 011560 MOVE 'HIREDATE' TO JZ-FNAME. JSPG2 011570 IF HIREDATE OF IJSPG2 NOT = SPACES AND HIREDATE OF IJSPG2 NOTJSPG2 011580 = LOW-VALUE JSPG2 011590 MOVE 9 TO InDataLth OF JZTRIM JSPG2 011600 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 011610 CALL 'JZTrim' USING HIREDATE OF IJSPG2 ParmIn OF JZTrim JSPG2 011620 ParmOut of JZTrim Result OF JZTrim JSPG2 011630 IF JZL-Result OF JZTrim > ZERO JSPG2 011640 MOVE 'N' TO IsDateArith OF JZ JSPG2 011650 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 011660 InDate OF JZ-JZDTVS JSPG2 011670 MOVE 'dd MMM yy' TO DPic OF JZ-JZDTVS JSPG2 011680 CALL 'JZDTVS' USING InDate OF JZ-JZDTVS DPic OF JSPG2 011690 JZ-JZDTVS JZ-DateDiff OF JZ JZ-Error OF JZ JSPG2 011700 PERFORM JZCheckDate JSPG2 011710 IF JZ-CHAR80 = SPACE JSPG2 011720 MOVE DateFormPic TO HIREDATE OF EMPLOYEE JSPG2 011730 MOVE 0 TO JZB-HIREDATE OF EMPLOYEE JSPG2 011740 END-IF JSPG2 011750 ELSE JSPG2 011760 MOVE ZERO TO HIREDATE OF EMPLOYEE JSPG2 011770 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 011780 MOVE -1 TO JZB-HIREDATE OF EMPLOYEE JSPG2 011790 ELSE JSPG2 011800 MOVE 0 TO JZB-HIREDATE OF EMPLOYEE JSPG2 011810 END-IF JSPG2 011820 END-IF JSPG2 011830 END-IF. JSPG2 011840 IF JZ-CHAR80 NOT = SPACE JSPG2 011850 MOVE 'Y' TO JZ-Error OF JZ JSPG2 011860 MOVE 80 TO JZ-MLTH JSPG2 011870 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 011880 END-IF. JSPG2 011890* IJSPG2.JZ-EMPLOYEE.JOB:Nothing to check, assign to JSPG2 011900* EMPLOYEE.JOBJSPG2 011910 IF JOB OF IJSPG2 NOT = SPACES AND JOB OF IJSPG2 NOT = JSPG2 011920 LOW-VALUE JSPG2 011930 MOVE 8 TO InDataLth OF JZTRIM JSPG2 011940 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 011950 CALL 'JZTrim' USING JOB OF IJSPG2 ParmIn OF JZTrim JSPG2 011960 ParmOut of JZTrim Result OF JZTrim JSPG2 011970 IF JZL-Result OF JZTrim > ZERO JSPG2 011980 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 011990 JOB OF EMPLOYEE JSPG2 012000 MOVE 0 TO JZB-JOB OF EMPLOYEE JSPG2 012010 ELSE JSPG2 012020 MOVE SPACES TO JOB OF EMPLOYEE JSPG2 012030 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 012040 MOVE -1 TO JZB-JOB OF EMPLOYEE JSPG2 012050 ELSE JSPG2 012060 MOVE 0 TO JZB-JOB OF EMPLOYEE JSPG2 012070 END-IF JSPG2 012080 END-IF JSPG2 012090 END-IF. JSPG2 012100* Validate IJSPG2.JZ-EMPLOYEE.EDLEVEL, assign to JSPG2 012110* EMPLOYEE.EDLEVELJSPG2 012120 MOVE SPACES TO JZ-CHAR80. JSPG2 012130 MOVE 'EDLEVEL' TO JZ-FNAME. JSPG2 012140 IF EDLEVEL OF IJSPG2 NOT = SPACES AND EDLEVEL OF IJSPG2 NOT =JSPG2 012150 LOW-VALUE JSPG2 012160 MOVE 7 TO InDataLth OF JZTRIM JSPG2 012170 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 012180 CALL 'JZTrim' USING EDLEVEL OF IJSPG2 ParmIn OF JZTrim JSPG2 012190 ParmOut of JZTrim Result OF JZTrim JSPG2 012200 IF JZL-Result OF JZTrim > ZERO JSPG2 012210 IF FUNCTION TEST-NUMVAL(JZD-Result OF JSPG2 012220 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 012230 COMPUTE EDLEVEL OF EMPLOYEE = FUNCTION JSPG2 012240 NUMVAL(JZD-Result OF JZTrim(1:JZL-Result OF JSPG2 012250 JZTrim)) JSPG2 012260 ELSE JSPG2 012270 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 012280 END-IF JSPG2 012290 END-IF JSPG2 012300 IF EDLEVEL OF EMPLOYEE = ZERO JSPG2 012310 MOVE 'value required' TO JZ-CHAR80 JSPG2 012320 END-IF JSPG2 012330 END-IF. JSPG2 012340 IF JZ-CHAR80 NOT = SPACE JSPG2 012350 MOVE 'Y' TO JZ-Error OF JZ JSPG2 012360 MOVE 80 TO JZ-MLTH JSPG2 012370 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 012380 END-IF. JSPG2 012390* Validate IJSPG2.JZ-EMPLOYEE.SEX, assign to EMPLOYEE.SEX JSPG2 012400 MOVE SPACES TO JZ-CHAR80. JSPG2 012410 MOVE 'SEX' TO JZ-FNAME. JSPG2 012420 IF SEX OF IJSPG2 NOT = SPACES AND SEX OF IJSPG2 NOT = JSPG2 012430 LOW-VALUE JSPG2 012440 MOVE FUNCTION UPPER-CASE(SEX OF IJSPG2) TO SEX OF IJSPG2 JSPG2 012450 MOVE 1 TO InDataLth OF JZTRIM JSPG2 012460 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 012470 CALL 'JZTrim' USING SEX OF IJSPG2 ParmIn OF JZTrim JSPG2 012480 ParmOut of JZTrim Result OF JZTrim JSPG2 012490 IF JZL-Result OF JZTrim > ZERO JSPG2 012500 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 012510 SEX OF EMPLOYEE JSPG2 012520 MOVE 0 TO JZB-SEX OF EMPLOYEE JSPG2 012530 ELSE JSPG2 012540 MOVE SPACES TO SEX OF EMPLOYEE JSPG2 012550 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 012560 MOVE -1 TO JZB-SEX OF EMPLOYEE JSPG2 012570 ELSE JSPG2 012580 MOVE 0 TO JZB-SEX OF EMPLOYEE JSPG2 012590 END-IF JSPG2 012600 END-IF JSPG2 012610* Check Code Values JSPG2 012620 MOVE SEX OF EMPLOYEE TO SEARCH-FOR OF JZCodes-EMPLOYEE-SEXJSPG2 012630 PERFORM JZCvt-EMPLOYEE-SEX JSPG2 012640 END-IF. JSPG2 012650 IF JZ-CHAR80 NOT = SPACE JSPG2 012660 MOVE 'Y' TO JZ-Error OF JZ JSPG2 012670 MOVE 80 TO JZ-MLTH JSPG2 012680 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 012690 END-IF. JSPG2 012700* Validate IJSPG2.JZ-EMPLOYEE.BIRTHDATE, assign to JSPG2 012710* EMPLOYEE.BIRTHDATEJSPG2 012720 MOVE SPACES TO JZ-CHAR80. JSPG2 012730 MOVE 'BIRTHDATE' TO JZ-FNAME. JSPG2 012740 IF BIRTHDATE OF IJSPG2 NOT = SPACES AND BIRTHDATE OF IJSPG2 JSPG2 012750 NOT = LOW-VALUE JSPG2 012760 MOVE 9 TO InDataLth OF JZTRIM JSPG2 012770 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 012780 CALL 'JZTrim' USING BIRTHDATE OF IJSPG2 ParmIn OF JZTrim JSPG2 012790 ParmOut of JZTrim Result OF JZTrim JSPG2 012800 IF JZL-Result OF JZTrim > ZERO JSPG2 012810 MOVE 'N' TO IsDateArith OF JZ JSPG2 012820 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 012830 InDate OF JZ-JZDTVS JSPG2 012840 MOVE 'dd MMM yy' TO DPic OF JZ-JZDTVS JSPG2 012850 CALL 'JZDTVS' USING InDate OF JZ-JZDTVS DPic OF JSPG2 012860 JZ-JZDTVS JZ-DateDiff OF JZ JZ-Error OF JZ JSPG2 012870 PERFORM JZCheckDate JSPG2 012880 IF JZ-CHAR80 = SPACE JSPG2 012890 MOVE DateFormPic TO BIRTHDATE OF EMPLOYEE JSPG2 012900 MOVE 0 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 012910 END-IF JSPG2 012920 ELSE JSPG2 012930 MOVE ZERO TO BIRTHDATE OF EMPLOYEE JSPG2 012940 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 012950 MOVE -1 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 012960 ELSE JSPG2 012970 MOVE 0 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 012980 END-IF JSPG2 012990 END-IF JSPG2 013000 END-IF. JSPG2 013010 IF JZ-CHAR80 NOT = SPACE JSPG2 013020 MOVE 'Y' TO JZ-Error OF JZ JSPG2 013030 MOVE 80 TO JZ-MLTH JSPG2 013040 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 013050 END-IF. JSPG2 013060* Validate IJSPG2.JZ-EMPLOYEE.SALARY, assign to JSPG2 013070* EMPLOYEE.SALARYJSPG2 013080 MOVE SPACES TO JZ-CHAR80. JSPG2 013090 MOVE 'SALARY' TO JZ-FNAME. JSPG2 013100 IF SALARY OF IJSPG2 NOT = SPACES AND SALARY OF IJSPG2 NOT = JSPG2 013110 LOW-VALUE JSPG2 013120 MOVE 15 TO InDataLth OF JZTRIM JSPG2 013130 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 013140 CALL 'JZTrim' USING SALARY OF IJSPG2 ParmIn OF JZTrim JSPG2 013150 ParmOut of JZTrim Result OF JZTrim JSPG2 013160 IF JZL-Result OF JZTrim > ZERO JSPG2 013170 IF FUNCTION TEST-NUMVAL-C(JZD-Result OF JSPG2 013180 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 013190 COMPUTE SALARY OF EMPLOYEE = FUNCTION JSPG2 013200 NUMVAL-C(JZD-Result OF JZTrim(1:JZL-Result OFJSPG2 013210 JZTrim)) JSPG2 013220 MOVE 0 TO JZB-SALARY OF EMPLOYEE JSPG2 013230 ELSE JSPG2 013240 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 013250 END-IF JSPG2 013260 ELSE JSPG2 013270 MOVE ZERO TO SALARY OF EMPLOYEE JSPG2 013280 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 013290 MOVE -1 TO JZB-SALARY OF EMPLOYEE JSPG2 013300 ELSE JSPG2 013310 MOVE 0 TO JZB-SALARY OF EMPLOYEE JSPG2 013320 END-IF JSPG2 013330 END-IF JSPG2 013340* Check Range JSPG2 013350 IF JZ-CHAR80 = SPACE JSPG2 013360 IF SALARY OF EMPLOYEE < 0 JSPG2 013370 MOVE 'too small' TO JZ-CHAR80 JSPG2 013380 END-IF JSPG2 013390 END-IF JSPG2 013400 END-IF. JSPG2 013410 IF JZ-CHAR80 NOT = SPACE JSPG2 013420 MOVE 'Y' TO JZ-Error OF JZ JSPG2 013430 MOVE 80 TO JZ-MLTH JSPG2 013440 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 013450 END-IF. JSPG2 013460* Validate IJSPG2.JZ-EMPLOYEE.BONUS, assign to EMPLOYEE.BONUS JSPG2 013470 MOVE SPACES TO JZ-CHAR80. JSPG2 013480 MOVE 'BONUS' TO JZ-FNAME. JSPG2 013490 IF BONUS OF IJSPG2 NOT = SPACES AND BONUS OF IJSPG2 NOT = JSPG2 013500 LOW-VALUE JSPG2 013510 MOVE 15 TO InDataLth OF JZTRIM JSPG2 013520 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 013530 CALL 'JZTrim' USING BONUS OF IJSPG2 ParmIn OF JZTrim JSPG2 013540 ParmOut of JZTrim Result OF JZTrim JSPG2 013550 IF JZL-Result OF JZTrim > ZERO JSPG2 013560 IF FUNCTION TEST-NUMVAL-C(JZD-Result OF JSPG2 013570 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 013580 COMPUTE BONUS OF EMPLOYEE = FUNCTION JSPG2 013590 NUMVAL-C(JZD-Result OF JZTrim(1:JZL-Result OFJSPG2 013600 JZTrim)) JSPG2 013610 MOVE 0 TO JZB-BONUS OF EMPLOYEE JSPG2 013620 ELSE JSPG2 013630 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 013640 END-IF JSPG2 013650 ELSE JSPG2 013660 MOVE ZERO TO BONUS OF EMPLOYEE JSPG2 013670 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 013680 MOVE -1 TO JZB-BONUS OF EMPLOYEE JSPG2 013690 ELSE JSPG2 013700 MOVE 0 TO JZB-BONUS OF EMPLOYEE JSPG2 013710 END-IF JSPG2 013720 END-IF JSPG2 013730* Check Range JSPG2 013740 IF JZ-CHAR80 = SPACE JSPG2 013750 IF BONUS OF EMPLOYEE < 0 JSPG2 013760 MOVE 'too small' TO JZ-CHAR80 JSPG2 013770 END-IF JSPG2 013780 END-IF JSPG2 013790 END-IF. JSPG2 013800 IF JZ-CHAR80 NOT = SPACE JSPG2 013810 MOVE 'Y' TO JZ-Error OF JZ JSPG2 013820 MOVE 80 TO JZ-MLTH JSPG2 013830 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 013840 END-IF. JSPG2 013850* Validate IJSPG2.JZ-EMPLOYEE.COMM, assign to EMPLOYEE.COMM JSPG2 013860 MOVE SPACES TO JZ-CHAR80. JSPG2 013870 MOVE 'COMM' TO JZ-FNAME. JSPG2 013880 IF COMM OF IJSPG2 NOT = SPACES AND COMM OF IJSPG2 NOT = JSPG2 013890 LOW-VALUE JSPG2 013900 MOVE 15 TO InDataLth OF JZTRIM JSPG2 013910 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 013920 CALL 'JZTrim' USING COMM OF IJSPG2 ParmIn OF JZTrim JSPG2 013930 ParmOut of JZTrim Result OF JZTrim JSPG2 013940 IF JZL-Result OF JZTrim > ZERO JSPG2 013950 IF FUNCTION TEST-NUMVAL-C(JZD-Result OF JSPG2 013960 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 013970 COMPUTE COMM OF EMPLOYEE = FUNCTION JSPG2 013980 NUMVAL-C(JZD-Result OF JZTrim(1:JZL-Result OFJSPG2 013990 JZTrim)) JSPG2 014000 MOVE 0 TO JZB-COMM OF EMPLOYEE JSPG2 014010 ELSE JSPG2 014020 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 014030 END-IF JSPG2 014040 ELSE JSPG2 014050 MOVE ZERO TO COMM OF EMPLOYEE JSPG2 014060 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 014070 MOVE -1 TO JZB-COMM OF EMPLOYEE JSPG2 014080 ELSE JSPG2 014090 MOVE 0 TO JZB-COMM OF EMPLOYEE JSPG2 014100 END-IF JSPG2 014110 END-IF JSPG2 014120* Check Range JSPG2 014130 IF JZ-CHAR80 = SPACE JSPG2 014140 IF COMM OF EMPLOYEE < 0 JSPG2 014150 MOVE 'too small' TO JZ-CHAR80 JSPG2 014160 END-IF JSPG2 014170 END-IF JSPG2 014180 END-IF. JSPG2 014190 IF JZ-CHAR80 NOT = SPACE JSPG2 014200 MOVE 'Y' TO JZ-Error OF JZ JSPG2 014210 MOVE 80 TO JZ-MLTH JSPG2 014220 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 014230 END-IF. JSPG2 014240* IJSPG2.JZ-EMPLOYEE.CURRENCY:Nothing to check, assign to JSPG2 014250* EMPLOYEE.CURRENCYJSPG2 014260 IF JZ-CURRENCY OF IJSPG2 NOT = SPACES AND JZ-CURRENCY OF JSPG2 014270 IJSPG2 NOT = LOW-VALUE JSPG2 014280 MOVE 3 TO InDataLth OF JZTRIM JSPG2 014290 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 014300 CALL 'JZTrim' USING JZ-CURRENCY OF IJSPG2 ParmIn OF JSPG2 014310 JZTrim ParmOut of JZTrim Result OF JZTrim JSPG2 014320 IF JZL-Result OF JZTrim > ZERO JSPG2 014330 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 014340 JZ-CURRENCY OF EMPLOYEE JSPG2 014350 MOVE 0 TO JZB-CURRENCY OF EMPLOYEE JSPG2 014360 ELSE JSPG2 014370 MOVE SPACES TO JZ-CURRENCY OF EMPLOYEE JSPG2 014380 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 014390 MOVE -1 TO JZB-CURRENCY OF EMPLOYEE JSPG2 014400 ELSE JSPG2 014410 MOVE 0 TO JZB-CURRENCY OF EMPLOYEE JSPG2 014420 END-IF JSPG2 014430 END-IF JSPG2 014440 END-IF. JSPG2 014450* Validate IJSPG2.JZ-EMPLOYEE.DEPTMGR, assign to JSPG2 014460* EMPLOYEE.DEPTMGRJSPG2 014470 MOVE SPACES TO JZ-CHAR80. JSPG2 014480 MOVE 'DEPTMGR' TO JZ-FNAME. JSPG2 014490 IF DEPTMGR OF IJSPG2 NOT = SPACES AND DEPTMGR OF IJSPG2 NOT =JSPG2 014500 LOW-VALUE JSPG2 014510 MOVE 5 TO InDataLth OF JZTRIM JSPG2 014520 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 014530 CALL 'JZTrim' USING DEPTMGR OF IJSPG2 ParmIn OF JZTrim JSPG2 014540 ParmOut of JZTrim Result OF JZTrim JSPG2 014550 IF JZL-Result OF JZTrim > ZERO JSPG2 014560* Check Boolean Value JSPG2 014570 IF DEPTMGR OF IJSPG2 = 'Y' OR DEPTMGR OF IJSPG2 = 'N'JSPG2 014580 MOVE DEPTMGR OF IJSPG2 TO DEPTMGR OF EMPLOYEE JSPG2 014590 ELSE JSPG2 014600 MOVE 'Invalid' TO JZ-CHAR80 JSPG2 014610 END-IF JSPG2 014620 ELSE JSPG2 014630 MOVE SPACES TO DEPTMGR OF EMPLOYEE JSPG2 014640 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 014650 MOVE -1 TO JZB-DEPTMGR OF EMPLOYEE JSPG2 014660 ELSE JSPG2 014670 MOVE 0 TO JZB-DEPTMGR OF EMPLOYEE JSPG2 014680 END-IF JSPG2 014690 END-IF JSPG2 014700 END-IF. JSPG2 014710 IF JZ-CHAR80 NOT = SPACE JSPG2 014720 MOVE 'Y' TO JZ-Error OF JZ JSPG2 014730 MOVE 80 TO JZ-MLTH JSPG2 014740 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 014750 END-IF. JSPG2 014760* Validate IJSPG2.JZ-EMPLOYEE.STARTTIME, assign to JSPG2 014770* EMPLOYEE.STARTTIMEJSPG2 014780 MOVE SPACES TO JZ-CHAR80. JSPG2 014790 MOVE 'STARTTIME' TO JZ-FNAME. JSPG2 014800 IF STARTTIME OF IJSPG2 NOT = SPACES AND STARTTIME OF IJSPG2 JSPG2 014810 NOT = LOW-VALUE JSPG2 014820 MOVE 12 TO InDataLth OF JZTRIM JSPG2 014830 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 014840 CALL 'JZTrim' USING STARTTIME OF IJSPG2 ParmIn OF JZTrim JSPG2 014850 ParmOut of JZTrim Result OF JZTrim JSPG2 014860 CALL 'JZTMVS' USING STARTTIME OF IJSPG2 InDPIC OF JSPG2 014870 JZ-JZTMVS STARTTIME OF EMPLOYEE JZ-Error OF JZ Msg OFJSPG2 014880 JZ-JZTMVS JSPG2 014890 MOVE JZD-Msg OF JZ-JZTMVS TO JZ-CHAR80 OF JZ JSPG2 014900 END-IF. JSPG2 014910 IF JZ-CHAR80 NOT = SPACE JSPG2 014920 MOVE 'Y' TO JZ-Error OF JZ JSPG2 014930 MOVE 80 TO JZ-MLTH JSPG2 014940 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 014950 END-IF. JSPG2 014960 IF JZ-Error OF JZ = 'Y' JSPG2 014970* Respond with error messages and exit program JSPG2 014980 GO TO JZ-Normal-Exit JSPG2 014990 END-IF. JSPG2 015000* JSPG2 015010* WHEN (Add); JSPG2 015020 JZ-60-WHEN. JSPG2 015030* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE OJSPG2.Error; JSPG2 015040 PERFORM JZ-61-ACCEPT. JSPG2 015050* GET EMPLOYEE FREEKEY CREATE; JSPG2 015060 PERFORM JZ-62-GET. JSPG2 015070* JSPG2 015080 JZ-61-ACCEPT. JSPG2 015090* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE OJSPG2.Error; JSPG2 015100 MOVE 'N' TO JZ-Error OF JZ. JSPG2 015110 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 015120 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 015130* Validate IJSPG2.EMPNO, assign to EMPLOYEE.EMPNO JSPG2 015140 MOVE SPACES TO JZ-CHAR80. JSPG2 015150 MOVE 'EMPNO' TO JZ-FNAME. JSPG2 015160 IF EMPNO OF IJSPG2 NOT = SPACES AND EMPNO OF IJSPG2 NOT = JSPG2 015170 LOW-VALUE JSPG2 015180 MOVE 6 TO InDataLth OF JZTRIM JSPG2 015190 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 015200 CALL 'JZTrim' USING EMPNO OF IJSPG2 ParmIn OF JZTrim JSPG2 015210 ParmOut of JZTrim Result OF JZTrim JSPG2 015220 IF JZL-Result OF JZTrim > ZERO JSPG2 015230 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS JSPG2 015240 NUMERIC JSPG2 015250 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result JSPG2 015260 OF JZTrim(1:JZL-Result OF JZTrim)) JSPG2 015270 MOVE EMPNO OF JZ TO EMPNO OF EMPLOYEE JSPG2 015280 ELSE JSPG2 015290 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 015300 END-IF JSPG2 015310 END-IF JSPG2 015320 IF EMPNO OF EMPLOYEE = '000000' JSPG2 015330 MOVE 'value required' TO JZ-CHAR80 JSPG2 015340 END-IF JSPG2 015350 END-IF. JSPG2 015360 IF JZ-CHAR80 NOT = SPACE JSPG2 015370 MOVE 'Y' TO JZ-Error OF JZ JSPG2 015380 MOVE 80 TO JZ-MLTH JSPG2 015390 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 015400 END-IF. JSPG2 015410 IF JZ-Error OF JZ = 'Y' JSPG2 015420* Respond with error messages and exit program JSPG2 015430 GO TO JZ-Normal-Exit JSPG2 015440 END-IF. JSPG2 015450* JSPG2 015460 JZ-62-GET. JSPG2 015470* GET EMPLOYEE FREEKEY CREATE; JSPG2 015480 MOVE 'Y' TO EMPLOYEE-GET4UPDATE-FLAG. JSPG2 015490 IF EMPNO OF EMPLOYEE NOT = '000000' JSPG2 015500 CONTINUE JSPG2 015510 ELSE JSPG2 015520 PERFORM EMPLOYEE-Freekey-SET JSPG2 015530 END-IF. JSPG2 015540 PERFORM JZ-EMPLOYEE-ReadBy1ryKey. JSPG2 015550 MOVE 'Y' TO EMPLOYEE-UpdatePending-Flag. JSPG2 015560 IF EMPLOYEE-FOUND-FLAG = 'Y' JSPG2 015570 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 015580 MOVE 34 TO JZL-Error OF OJSPG2 JSPG2 015590 MOVE 'ADD aborted: record already exists' TO JZD-Error OFJSPG2 015600 OJSPG2 JSPG2 015610 GO TO JZ-Normal-Exit JSPG2 015620 END-IF. JSPG2 015630 PERFORM JZ-62-GETGroup. JSPG2 015640* JSPG2 015650 JZ-62-GETGroup. JSPG2 015660* ACCEPT (IJSPG2.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) MESSAGE JSPG2 015670* OJSPG2.Error;JSPG2 015680 PERFORM JZ-63-ACCEPT. JSPG2 015690* END GET EMPLOYEE CREATE RESPOND OJSPG2; JSPG2 015700 PERFORM JZ-EMPLOYEE-CopyTo-OJSPG2. JSPG2 015710 If NOT EMPLOYEE-FOUND JSPG2 015720 PERFORM EMPLOYEE-Update JSPG2 015730 MOVE 'I' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 015740 END-IF. JSPG2 015750* JSPG2 015760 JZ-63-ACCEPT. JSPG2 015770* ACCEPT (IJSPG2.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) MESSAGE JSPG2 015780* OJSPG2.Error;JSPG2 015790 MOVE 'N' TO JZ-Error OF JZ. JSPG2 015800 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 015810 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 015820* Validate IJSPG2.JZ-EMPLOYEE.FIRSTNME, assign to JSPG2 015830* EMPLOYEE.FIRSTNMEJSPG2 015840 MOVE SPACES TO JZ-CHAR80. JSPG2 015850 MOVE 'FIRSTNME' TO JZ-FNAME. JSPG2 015860 IF FIRSTNME OF IJSPG2 NOT = SPACES AND FIRSTNME OF IJSPG2 NOTJSPG2 015870 = LOW-VALUE JSPG2 015880 MOVE 12 TO InDataLth OF JZTRIM JSPG2 015890 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 015900 CALL 'JZTrim' USING FIRSTNME OF IJSPG2 ParmIn OF JZTrim JSPG2 015910 ParmOut of JZTrim Result OF JZTrim JSPG2 015920 MOVE JZL-Result OF JZTrim TO JZL-FIRSTNME OF EMPLOYEE JSPG2 015930 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 015940 JZD-FIRSTNME OF EMPLOYEE JSPG2 015950 IF FIRSTNME OF EMPLOYEE = SPACES JSPG2 015960 MOVE 'value required' TO JZ-CHAR80 JSPG2 015970 END-IF JSPG2 015980 END-IF. JSPG2 015990 IF JZ-CHAR80 NOT = SPACE JSPG2 016000 MOVE 'Y' TO JZ-Error OF JZ JSPG2 016010 MOVE 80 TO JZ-MLTH JSPG2 016020 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 016030 END-IF. JSPG2 016040* IJSPG2.JZ-EMPLOYEE.MIDINIT:Nothing to check, assign to JSPG2 016050* EMPLOYEE.MIDINITJSPG2 016060 IF MIDINIT OF IJSPG2 NOT = SPACES AND MIDINIT OF IJSPG2 NOT =JSPG2 016070 LOW-VALUE JSPG2 016080 MOVE 1 TO InDataLth OF JZTRIM JSPG2 016090 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 016100 CALL 'JZTrim' USING MIDINIT OF IJSPG2 ParmIn OF JZTrim JSPG2 016110 ParmOut of JZTrim Result OF JZTrim JSPG2 016120 IF JZL-Result OF JZTrim > ZERO JSPG2 016130 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 016140 MIDINIT OF EMPLOYEE JSPG2 016150 MOVE 0 TO JZB-MIDINIT OF EMPLOYEE JSPG2 016160 ELSE JSPG2 016170 MOVE SPACES TO MIDINIT OF EMPLOYEE JSPG2 016180 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 016190 MOVE -1 TO JZB-MIDINIT OF EMPLOYEE JSPG2 016200 ELSE JSPG2 016210 MOVE 0 TO JZB-MIDINIT OF EMPLOYEE JSPG2 016220 END-IF JSPG2 016230 END-IF JSPG2 016240 END-IF. JSPG2 016250* Validate IJSPG2.JZ-EMPLOYEE.LASTNAME, assign to JSPG2 016260* EMPLOYEE.LASTNAMEJSPG2 016270 MOVE SPACES TO JZ-CHAR80. JSPG2 016280 MOVE 'LASTNAME' TO JZ-FNAME. JSPG2 016290 IF LASTNAME OF IJSPG2 NOT = SPACES AND LASTNAME OF IJSPG2 NOTJSPG2 016300 = LOW-VALUE JSPG2 016310 MOVE 15 TO InDataLth OF JZTRIM JSPG2 016320 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 016330 CALL 'JZTrim' USING LASTNAME OF IJSPG2 ParmIn OF JZTrim JSPG2 016340 ParmOut of JZTrim Result OF JZTrim JSPG2 016350 MOVE JZL-Result OF JZTrim TO JZL-LASTNAME OF EMPLOYEE JSPG2 016360 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 016370 JZD-LASTNAME OF EMPLOYEE JSPG2 016380 IF LASTNAME OF EMPLOYEE = SPACES JSPG2 016390 MOVE 'value required' TO JZ-CHAR80 JSPG2 016400 END-IF JSPG2 016410 END-IF. JSPG2 016420 IF JZ-CHAR80 NOT = SPACE JSPG2 016430 MOVE 'Y' TO JZ-Error OF JZ JSPG2 016440 MOVE 80 TO JZ-MLTH JSPG2 016450 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 016460 END-IF. JSPG2 016470* Validate IJSPG2.JZ-EMPLOYEE.WORKDEPT, assign to JSPG2 016480* EMPLOYEE.WORKDEPTJSPG2 016490 MOVE SPACES TO JZ-CHAR80. JSPG2 016500 MOVE 'WORKDEPT' TO JZ-FNAME. JSPG2 016510 IF WORKDEPT OF IJSPG2 NOT = SPACES AND WORKDEPT OF IJSPG2 NOTJSPG2 016520 = LOW-VALUE JSPG2 016530 MOVE FUNCTION UPPER-CASE(WORKDEPT OF IJSPG2) TO WORKDEPT JSPG2 016540 OF IJSPG2 JSPG2 016550 MOVE 3 TO InDataLth OF JZTRIM JSPG2 016560 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 016570 CALL 'JZTrim' USING WORKDEPT OF IJSPG2 ParmIn OF JZTrim JSPG2 016580 ParmOut of JZTrim Result OF JZTrim JSPG2 016590 IF JZL-Result OF JZTrim > ZERO JSPG2 016600 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 016610 WORKDEPT OF EMPLOYEE JSPG2 016620 MOVE 0 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 016630 ELSE JSPG2 016640 MOVE SPACES TO WORKDEPT OF EMPLOYEE JSPG2 016650 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 016660 MOVE -1 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 016670 ELSE JSPG2 016680 MOVE 0 TO JZB-WORKDEPT OF EMPLOYEE JSPG2 016690 END-IF JSPG2 016700 END-IF JSPG2 016710* Check Exists JSPG2 016720 IF WORKDEPT OF EMPLOYEE NOT = SPACES JSPG2 016730 IF WORKDEPT OF EMPLOYEE NOT = DEPTNO OF DEPARTMENT JSPG2 016740 EXEC SQL JSPG2 016750 SELECT COUNT(*) INTO :JZ-SQLCOUNT FROM JSPG2 016760 DEPARTMENT WHERE DEPTNO = :EMPLOYEE.WORKDEPTJSPG2 016770 END-EXEC JSPG2 016780 IF JZ-SQLCOUNT = ZERO JSPG2 016790 MOVE 'VALUE DOES NOT EXIST' TO JZ-CHAR80 JSPG2 016800 END-IF JSPG2 016810 END-IF JSPG2 016820 END-IF JSPG2 016830 END-IF. JSPG2 016840 IF JZ-CHAR80 NOT = SPACE JSPG2 016850 MOVE 'Y' TO JZ-Error OF JZ JSPG2 016860 MOVE 80 TO JZ-MLTH JSPG2 016870 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 016880 END-IF. JSPG2 016890* Validate IJSPG2.JZ-EMPLOYEE.PHONENO, assign to JSPG2 016900* EMPLOYEE.PHONENOJSPG2 016910 MOVE SPACES TO JZ-CHAR80. JSPG2 016920 MOVE 'PHONENO' TO JZ-FNAME. JSPG2 016930 IF PHONENO OF IJSPG2 NOT = SPACES AND PHONENO OF IJSPG2 NOT =JSPG2 016940 LOW-VALUE JSPG2 016950 MOVE 4 TO InDataLth OF JZTRIM JSPG2 016960 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 016970 CALL 'JZTrim' USING PHONENO OF IJSPG2 ParmIn OF JZTrim JSPG2 016980 ParmOut of JZTrim Result OF JZTrim JSPG2 016990 IF JZL-Result OF JZTrim > ZERO JSPG2 017000 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS JSPG2 017010 NUMERIC JSPG2 017020 COMPUTE PHONENO OF JZ = FUNCTION JSPG2 017030 NUMVAL(JZD-Result OF JZTrim(1:JZL-Result OF JSPG2 017040 JZTrim)) JSPG2 017050 MOVE PHONENO OF JZ TO PHONENO OF EMPLOYEE JSPG2 017060 MOVE 0 TO JZB-PHONENO OF EMPLOYEE JSPG2 017070 ELSE JSPG2 017080 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 017090 END-IF JSPG2 017100 ELSE JSPG2 017110 MOVE '0000' TO PHONENO OF EMPLOYEE JSPG2 017120 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 017130 MOVE -1 TO JZB-PHONENO OF EMPLOYEE JSPG2 017140 ELSE JSPG2 017150 MOVE 0 TO JZB-PHONENO OF EMPLOYEE JSPG2 017160 END-IF JSPG2 017170 END-IF JSPG2 017180 END-IF. JSPG2 017190 IF JZ-CHAR80 NOT = SPACE JSPG2 017200 MOVE 'Y' TO JZ-Error OF JZ JSPG2 017210 MOVE 80 TO JZ-MLTH JSPG2 017220 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 017230 END-IF. JSPG2 017240* Validate IJSPG2.JZ-EMPLOYEE.HIREDATE, assign to JSPG2 017250* EMPLOYEE.HIREDATEJSPG2 017260 MOVE SPACES TO JZ-CHAR80. JSPG2 017270 MOVE 'HIREDATE' TO JZ-FNAME. JSPG2 017280 IF HIREDATE OF IJSPG2 NOT = SPACES AND HIREDATE OF IJSPG2 NOTJSPG2 017290 = LOW-VALUE JSPG2 017300 MOVE 9 TO InDataLth OF JZTRIM JSPG2 017310 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 017320 CALL 'JZTrim' USING HIREDATE OF IJSPG2 ParmIn OF JZTrim JSPG2 017330 ParmOut of JZTrim Result OF JZTrim JSPG2 017340 IF JZL-Result OF JZTrim > ZERO JSPG2 017350 MOVE 'N' TO IsDateArith OF JZ JSPG2 017360 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 017370 InDate OF JZ-JZDTVS JSPG2 017380 MOVE 'dd MMM yy' TO DPic OF JZ-JZDTVS JSPG2 017390 CALL 'JZDTVS' USING InDate OF JZ-JZDTVS DPic OF JSPG2 017400 JZ-JZDTVS JZ-DateDiff OF JZ JZ-Error OF JZ JSPG2 017410 PERFORM JZCheckDate JSPG2 017420 IF JZ-CHAR80 = SPACE JSPG2 017430 MOVE DateFormPic TO HIREDATE OF EMPLOYEE JSPG2 017440 MOVE 0 TO JZB-HIREDATE OF EMPLOYEE JSPG2 017450 END-IF JSPG2 017460 ELSE JSPG2 017470 MOVE ZERO TO HIREDATE OF EMPLOYEE JSPG2 017480 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 017490 MOVE -1 TO JZB-HIREDATE OF EMPLOYEE JSPG2 017500 ELSE JSPG2 017510 MOVE 0 TO JZB-HIREDATE OF EMPLOYEE JSPG2 017520 END-IF JSPG2 017530 END-IF JSPG2 017540 END-IF. JSPG2 017550 IF JZ-CHAR80 NOT = SPACE JSPG2 017560 MOVE 'Y' TO JZ-Error OF JZ JSPG2 017570 MOVE 80 TO JZ-MLTH JSPG2 017580 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 017590 END-IF. JSPG2 017600* IJSPG2.JZ-EMPLOYEE.JOB:Nothing to check, assign to JSPG2 017610* EMPLOYEE.JOBJSPG2 017620 IF JOB OF IJSPG2 NOT = SPACES AND JOB OF IJSPG2 NOT = JSPG2 017630 LOW-VALUE JSPG2 017640 MOVE 8 TO InDataLth OF JZTRIM JSPG2 017650 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 017660 CALL 'JZTrim' USING JOB OF IJSPG2 ParmIn OF JZTrim JSPG2 017670 ParmOut of JZTrim Result OF JZTrim JSPG2 017680 IF JZL-Result OF JZTrim > ZERO JSPG2 017690 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 017700 JOB OF EMPLOYEE JSPG2 017710 MOVE 0 TO JZB-JOB OF EMPLOYEE JSPG2 017720 ELSE JSPG2 017730 MOVE SPACES TO JOB OF EMPLOYEE JSPG2 017740 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 017750 MOVE -1 TO JZB-JOB OF EMPLOYEE JSPG2 017760 ELSE JSPG2 017770 MOVE 0 TO JZB-JOB OF EMPLOYEE JSPG2 017780 END-IF JSPG2 017790 END-IF JSPG2 017800 END-IF. JSPG2 017810* Validate IJSPG2.JZ-EMPLOYEE.EDLEVEL, assign to JSPG2 017820* EMPLOYEE.EDLEVELJSPG2 017830 MOVE SPACES TO JZ-CHAR80. JSPG2 017840 MOVE 'EDLEVEL' TO JZ-FNAME. JSPG2 017850 IF EDLEVEL OF IJSPG2 NOT = SPACES AND EDLEVEL OF IJSPG2 NOT =JSPG2 017860 LOW-VALUE JSPG2 017870 MOVE 7 TO InDataLth OF JZTRIM JSPG2 017880 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 017890 CALL 'JZTrim' USING EDLEVEL OF IJSPG2 ParmIn OF JZTrim JSPG2 017900 ParmOut of JZTrim Result OF JZTrim JSPG2 017910 IF JZL-Result OF JZTrim > ZERO JSPG2 017920 IF FUNCTION TEST-NUMVAL(JZD-Result OF JSPG2 017930 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 017940 COMPUTE EDLEVEL OF EMPLOYEE = FUNCTION JSPG2 017950 NUMVAL(JZD-Result OF JZTrim(1:JZL-Result OF JSPG2 017960 JZTrim)) JSPG2 017970 ELSE JSPG2 017980 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 017990 END-IF JSPG2 018000 END-IF JSPG2 018010 IF EDLEVEL OF EMPLOYEE = ZERO JSPG2 018020 MOVE 'value required' TO JZ-CHAR80 JSPG2 018030 END-IF JSPG2 018040 END-IF. JSPG2 018050 IF JZ-CHAR80 NOT = SPACE JSPG2 018060 MOVE 'Y' TO JZ-Error OF JZ JSPG2 018070 MOVE 80 TO JZ-MLTH JSPG2 018080 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 018090 END-IF. JSPG2 018100* Validate IJSPG2.JZ-EMPLOYEE.SEX, assign to EMPLOYEE.SEX JSPG2 018110 MOVE SPACES TO JZ-CHAR80. JSPG2 018120 MOVE 'SEX' TO JZ-FNAME. JSPG2 018130 IF SEX OF IJSPG2 NOT = SPACES AND SEX OF IJSPG2 NOT = JSPG2 018140 LOW-VALUE JSPG2 018150 MOVE FUNCTION UPPER-CASE(SEX OF IJSPG2) TO SEX OF IJSPG2 JSPG2 018160 MOVE 1 TO InDataLth OF JZTRIM JSPG2 018170 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 018180 CALL 'JZTrim' USING SEX OF IJSPG2 ParmIn OF JZTrim JSPG2 018190 ParmOut of JZTrim Result OF JZTrim JSPG2 018200 IF JZL-Result OF JZTrim > ZERO JSPG2 018210 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 018220 SEX OF EMPLOYEE JSPG2 018230 MOVE 0 TO JZB-SEX OF EMPLOYEE JSPG2 018240 ELSE JSPG2 018250 MOVE SPACES TO SEX OF EMPLOYEE JSPG2 018260 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 018270 MOVE -1 TO JZB-SEX OF EMPLOYEE JSPG2 018280 ELSE JSPG2 018290 MOVE 0 TO JZB-SEX OF EMPLOYEE JSPG2 018300 END-IF JSPG2 018310 END-IF JSPG2 018320* Check Code Values JSPG2 018330 MOVE SEX OF EMPLOYEE TO SEARCH-FOR OF JZCodes-EMPLOYEE-SEXJSPG2 018340 PERFORM JZCvt-EMPLOYEE-SEX JSPG2 018350 END-IF. JSPG2 018360 IF JZ-CHAR80 NOT = SPACE JSPG2 018370 MOVE 'Y' TO JZ-Error OF JZ JSPG2 018380 MOVE 80 TO JZ-MLTH JSPG2 018390 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 018400 END-IF. JSPG2 018410* Validate IJSPG2.JZ-EMPLOYEE.BIRTHDATE, assign to JSPG2 018420* EMPLOYEE.BIRTHDATEJSPG2 018430 MOVE SPACES TO JZ-CHAR80. JSPG2 018440 MOVE 'BIRTHDATE' TO JZ-FNAME. JSPG2 018450 IF BIRTHDATE OF IJSPG2 NOT = SPACES AND BIRTHDATE OF IJSPG2 JSPG2 018460 NOT = LOW-VALUE JSPG2 018470 MOVE 9 TO InDataLth OF JZTRIM JSPG2 018480 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 018490 CALL 'JZTrim' USING BIRTHDATE OF IJSPG2 ParmIn OF JZTrim JSPG2 018500 ParmOut of JZTrim Result OF JZTrim JSPG2 018510 IF JZL-Result OF JZTrim > ZERO JSPG2 018520 MOVE 'N' TO IsDateArith OF JZ JSPG2 018530 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 018540 InDate OF JZ-JZDTVS JSPG2 018550 MOVE 'dd MMM yy' TO DPic OF JZ-JZDTVS JSPG2 018560 CALL 'JZDTVS' USING InDate OF JZ-JZDTVS DPic OF JSPG2 018570 JZ-JZDTVS JZ-DateDiff OF JZ JZ-Error OF JZ JSPG2 018580 PERFORM JZCheckDate JSPG2 018590 IF JZ-CHAR80 = SPACE JSPG2 018600 MOVE DateFormPic TO BIRTHDATE OF EMPLOYEE JSPG2 018610 MOVE 0 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 018620 END-IF JSPG2 018630 ELSE JSPG2 018640 MOVE ZERO TO BIRTHDATE OF EMPLOYEE JSPG2 018650 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 018660 MOVE -1 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 018670 ELSE JSPG2 018680 MOVE 0 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 018690 END-IF JSPG2 018700 END-IF JSPG2 018710 END-IF. JSPG2 018720 IF JZ-CHAR80 NOT = SPACE JSPG2 018730 MOVE 'Y' TO JZ-Error OF JZ JSPG2 018740 MOVE 80 TO JZ-MLTH JSPG2 018750 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 018760 END-IF. JSPG2 018770* Validate IJSPG2.JZ-EMPLOYEE.SALARY, assign to JSPG2 018780* EMPLOYEE.SALARYJSPG2 018790 MOVE SPACES TO JZ-CHAR80. JSPG2 018800 MOVE 'SALARY' TO JZ-FNAME. JSPG2 018810 IF SALARY OF IJSPG2 NOT = SPACES AND SALARY OF IJSPG2 NOT = JSPG2 018820 LOW-VALUE JSPG2 018830 MOVE 15 TO InDataLth OF JZTRIM JSPG2 018840 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 018850 CALL 'JZTrim' USING SALARY OF IJSPG2 ParmIn OF JZTrim JSPG2 018860 ParmOut of JZTrim Result OF JZTrim JSPG2 018870 IF JZL-Result OF JZTrim > ZERO JSPG2 018880 IF FUNCTION TEST-NUMVAL-C(JZD-Result OF JSPG2 018890 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 018900 COMPUTE SALARY OF EMPLOYEE = FUNCTION JSPG2 018910 NUMVAL-C(JZD-Result OF JZTrim(1:JZL-Result OFJSPG2 018920 JZTrim)) JSPG2 018930 MOVE 0 TO JZB-SALARY OF EMPLOYEE JSPG2 018940 ELSE JSPG2 018950 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 018960 END-IF JSPG2 018970 ELSE JSPG2 018980 MOVE ZERO TO SALARY OF EMPLOYEE JSPG2 018990 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 019000 MOVE -1 TO JZB-SALARY OF EMPLOYEE JSPG2 019010 ELSE JSPG2 019020 MOVE 0 TO JZB-SALARY OF EMPLOYEE JSPG2 019030 END-IF JSPG2 019040 END-IF JSPG2 019050* Check Range JSPG2 019060 IF JZ-CHAR80 = SPACE JSPG2 019070 IF SALARY OF EMPLOYEE < 0 JSPG2 019080 MOVE 'too small' TO JZ-CHAR80 JSPG2 019090 END-IF JSPG2 019100 END-IF JSPG2 019110 END-IF. JSPG2 019120 IF JZ-CHAR80 NOT = SPACE JSPG2 019130 MOVE 'Y' TO JZ-Error OF JZ JSPG2 019140 MOVE 80 TO JZ-MLTH JSPG2 019150 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 019160 END-IF. JSPG2 019170* Validate IJSPG2.JZ-EMPLOYEE.BONUS, assign to EMPLOYEE.BONUS JSPG2 019180 MOVE SPACES TO JZ-CHAR80. JSPG2 019190 MOVE 'BONUS' TO JZ-FNAME. JSPG2 019200 IF BONUS OF IJSPG2 NOT = SPACES AND BONUS OF IJSPG2 NOT = JSPG2 019210 LOW-VALUE JSPG2 019220 MOVE 15 TO InDataLth OF JZTRIM JSPG2 019230 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 019240 CALL 'JZTrim' USING BONUS OF IJSPG2 ParmIn OF JZTrim JSPG2 019250 ParmOut of JZTrim Result OF JZTrim JSPG2 019260 IF JZL-Result OF JZTrim > ZERO JSPG2 019270 IF FUNCTION TEST-NUMVAL-C(JZD-Result OF JSPG2 019280 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 019290 COMPUTE BONUS OF EMPLOYEE = FUNCTION JSPG2 019300 NUMVAL-C(JZD-Result OF JZTrim(1:JZL-Result OFJSPG2 019310 JZTrim)) JSPG2 019320 MOVE 0 TO JZB-BONUS OF EMPLOYEE JSPG2 019330 ELSE JSPG2 019340 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 019350 END-IF JSPG2 019360 ELSE JSPG2 019370 MOVE ZERO TO BONUS OF EMPLOYEE JSPG2 019380 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 019390 MOVE -1 TO JZB-BONUS OF EMPLOYEE JSPG2 019400 ELSE JSPG2 019410 MOVE 0 TO JZB-BONUS OF EMPLOYEE JSPG2 019420 END-IF JSPG2 019430 END-IF JSPG2 019440* Check Range JSPG2 019450 IF JZ-CHAR80 = SPACE JSPG2 019460 IF BONUS OF EMPLOYEE < 0 JSPG2 019470 MOVE 'too small' TO JZ-CHAR80 JSPG2 019480 END-IF JSPG2 019490 END-IF JSPG2 019500 END-IF. JSPG2 019510 IF JZ-CHAR80 NOT = SPACE JSPG2 019520 MOVE 'Y' TO JZ-Error OF JZ JSPG2 019530 MOVE 80 TO JZ-MLTH JSPG2 019540 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 019550 END-IF. JSPG2 019560* Validate IJSPG2.JZ-EMPLOYEE.COMM, assign to EMPLOYEE.COMM JSPG2 019570 MOVE SPACES TO JZ-CHAR80. JSPG2 019580 MOVE 'COMM' TO JZ-FNAME. JSPG2 019590 IF COMM OF IJSPG2 NOT = SPACES AND COMM OF IJSPG2 NOT = JSPG2 019600 LOW-VALUE JSPG2 019610 MOVE 15 TO InDataLth OF JZTRIM JSPG2 019620 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 019630 CALL 'JZTrim' USING COMM OF IJSPG2 ParmIn OF JZTrim JSPG2 019640 ParmOut of JZTrim Result OF JZTrim JSPG2 019650 IF JZL-Result OF JZTrim > ZERO JSPG2 019660 IF FUNCTION TEST-NUMVAL-C(JZD-Result OF JSPG2 019670 JZTrim(1:JZL-Result OF JZTrim)) = 0 JSPG2 019680 COMPUTE COMM OF EMPLOYEE = FUNCTION JSPG2 019690 NUMVAL-C(JZD-Result OF JZTrim(1:JZL-Result OFJSPG2 019700 JZTrim)) JSPG2 019710 MOVE 0 TO JZB-COMM OF EMPLOYEE JSPG2 019720 ELSE JSPG2 019730 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 019740 END-IF JSPG2 019750 ELSE JSPG2 019760 MOVE ZERO TO COMM OF EMPLOYEE JSPG2 019770 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 019780 MOVE -1 TO JZB-COMM OF EMPLOYEE JSPG2 019790 ELSE JSPG2 019800 MOVE 0 TO JZB-COMM OF EMPLOYEE JSPG2 019810 END-IF JSPG2 019820 END-IF JSPG2 019830* Check Range JSPG2 019840 IF JZ-CHAR80 = SPACE JSPG2 019850 IF COMM OF EMPLOYEE < 0 JSPG2 019860 MOVE 'too small' TO JZ-CHAR80 JSPG2 019870 END-IF JSPG2 019880 END-IF JSPG2 019890 END-IF. JSPG2 019900 IF JZ-CHAR80 NOT = SPACE JSPG2 019910 MOVE 'Y' TO JZ-Error OF JZ JSPG2 019920 MOVE 80 TO JZ-MLTH JSPG2 019930 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 019940 END-IF. JSPG2 019950* IJSPG2.JZ-EMPLOYEE.CURRENCY:Nothing to check, assign to JSPG2 019960* EMPLOYEE.CURRENCYJSPG2 019970 IF JZ-CURRENCY OF IJSPG2 NOT = SPACES AND JZ-CURRENCY OF JSPG2 019980 IJSPG2 NOT = LOW-VALUE JSPG2 019990 MOVE 3 TO InDataLth OF JZTRIM JSPG2 020000 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 020010 CALL 'JZTrim' USING JZ-CURRENCY OF IJSPG2 ParmIn OF JSPG2 020020 JZTrim ParmOut of JZTrim Result OF JZTrim JSPG2 020030 IF JZL-Result OF JZTrim > ZERO JSPG2 020040 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO JSPG2 020050 JZ-CURRENCY OF EMPLOYEE JSPG2 020060 MOVE 0 TO JZB-CURRENCY OF EMPLOYEE JSPG2 020070 ELSE JSPG2 020080 MOVE SPACES TO JZ-CURRENCY OF EMPLOYEE JSPG2 020090 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 020100 MOVE -1 TO JZB-CURRENCY OF EMPLOYEE JSPG2 020110 ELSE JSPG2 020120 MOVE 0 TO JZB-CURRENCY OF EMPLOYEE JSPG2 020130 END-IF JSPG2 020140 END-IF JSPG2 020150 END-IF. JSPG2 020160* Validate IJSPG2.JZ-EMPLOYEE.DEPTMGR, assign to JSPG2 020170* EMPLOYEE.DEPTMGRJSPG2 020180 MOVE SPACES TO JZ-CHAR80. JSPG2 020190 MOVE 'DEPTMGR' TO JZ-FNAME. JSPG2 020200 IF DEPTMGR OF IJSPG2 NOT = SPACES AND DEPTMGR OF IJSPG2 NOT =JSPG2 020210 LOW-VALUE JSPG2 020220 MOVE 5 TO InDataLth OF JZTRIM JSPG2 020230 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 020240 CALL 'JZTrim' USING DEPTMGR OF IJSPG2 ParmIn OF JZTrim JSPG2 020250 ParmOut of JZTrim Result OF JZTrim JSPG2 020260 IF JZL-Result OF JZTrim > ZERO JSPG2 020270* Check Boolean Value JSPG2 020280 IF DEPTMGR OF IJSPG2 = 'Y' OR DEPTMGR OF IJSPG2 = 'N'JSPG2 020290 MOVE DEPTMGR OF IJSPG2 TO DEPTMGR OF EMPLOYEE JSPG2 020300 ELSE JSPG2 020310 MOVE 'Invalid' TO JZ-CHAR80 JSPG2 020320 END-IF JSPG2 020330 ELSE JSPG2 020340 MOVE SPACES TO DEPTMGR OF EMPLOYEE JSPG2 020350 IF SPECIALNAME OF JZTRIM = 'NULL' JSPG2 020360 MOVE -1 TO JZB-DEPTMGR OF EMPLOYEE JSPG2 020370 ELSE JSPG2 020380 MOVE 0 TO JZB-DEPTMGR OF EMPLOYEE JSPG2 020390 END-IF JSPG2 020400 END-IF JSPG2 020410 END-IF. JSPG2 020420 IF JZ-CHAR80 NOT = SPACE JSPG2 020430 MOVE 'Y' TO JZ-Error OF JZ JSPG2 020440 MOVE 80 TO JZ-MLTH JSPG2 020450 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 020460 END-IF. JSPG2 020470* Validate IJSPG2.JZ-EMPLOYEE.STARTTIME, assign to JSPG2 020480* EMPLOYEE.STARTTIMEJSPG2 020490 MOVE SPACES TO JZ-CHAR80. JSPG2 020500 MOVE 'STARTTIME' TO JZ-FNAME. JSPG2 020510 IF STARTTIME OF IJSPG2 NOT = SPACES AND STARTTIME OF IJSPG2 JSPG2 020520 NOT = LOW-VALUE JSPG2 020530 MOVE 12 TO InDataLth OF JZTRIM JSPG2 020540 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 020550 CALL 'JZTrim' USING STARTTIME OF IJSPG2 ParmIn OF JZTrim JSPG2 020560 ParmOut of JZTrim Result OF JZTrim JSPG2 020570 CALL 'JZTMVS' USING STARTTIME OF IJSPG2 InDPIC OF JSPG2 020580 JZ-JZTMVS STARTTIME OF EMPLOYEE JZ-Error OF JZ Msg OFJSPG2 020590 JZ-JZTMVS JSPG2 020600 MOVE JZD-Msg OF JZ-JZTMVS TO JZ-CHAR80 OF JZ JSPG2 020610 END-IF. JSPG2 020620 IF JZ-CHAR80 NOT = SPACE JSPG2 020630 MOVE 'Y' TO JZ-Error OF JZ JSPG2 020640 MOVE 80 TO JZ-MLTH JSPG2 020650 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 020660 END-IF. JSPG2 020670 IF JZ-Error OF JZ = 'Y' JSPG2 020680* Respond with error messages and exit program JSPG2 020690 GO TO JZ-Normal-Exit JSPG2 020700 END-IF. JSPG2 020710* JSPG2 020720* WHEN (Delete); JSPG2 020730 JZ-65-WHEN. JSPG2 020740* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE OJSPG2.Error; JSPG2 020750 PERFORM JZ-66-ACCEPT. JSPG2 020760* DELETE EMPLOYEE KEY(EMPLOYEE.EMPNO) CHECKSUM JSPG2 020770* IJSPG2.JZ-EMPLOYEE.Checksum;JSPG2 020780 PERFORM JZ-67-DELETE. JSPG2 020790* END CASE; JSPG2 020800* JSPG2 020810 JZ-66-ACCEPT. JSPG2 020820* ACCEPT (EMPLOYEE.EMPNO=IJSPG2.EMPNO) MESSAGE OJSPG2.Error; JSPG2 020830 MOVE 'N' TO JZ-Error OF JZ. JSPG2 020840 Move SPACES TO JZD-Error OF OJSPG2. JSPG2 020850 MOVE ZERO TO JZL-Error OF OJSPG2. JSPG2 020860* Validate IJSPG2.EMPNO, assign to EMPLOYEE.EMPNO JSPG2 020870 MOVE SPACES TO JZ-CHAR80. JSPG2 020880 MOVE 'EMPNO' TO JZ-FNAME. JSPG2 020890 IF EMPNO OF IJSPG2 NOT = SPACES AND EMPNO OF IJSPG2 NOT = JSPG2 020900 LOW-VALUE JSPG2 020910 MOVE 6 TO InDataLth OF JZTRIM JSPG2 020920 MOVE 'TRIM' TO TrimType OF JZTrim JSPG2 020930 CALL 'JZTrim' USING EMPNO OF IJSPG2 ParmIn OF JZTrim JSPG2 020940 ParmOut of JZTrim Result OF JZTrim JSPG2 020950 IF JZL-Result OF JZTrim > ZERO JSPG2 020960 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS JSPG2 020970 NUMERIC JSPG2 020980 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result JSPG2 020990 OF JZTrim(1:JZL-Result OF JZTrim)) JSPG2 021000 MOVE EMPNO OF JZ TO EMPNO OF EMPLOYEE JSPG2 021010 ELSE JSPG2 021020 MOVE 'not numeric' TO JZ-CHAR80 JSPG2 021030 END-IF JSPG2 021040 END-IF JSPG2 021050 IF EMPNO OF EMPLOYEE = '000000' JSPG2 021060 MOVE 'value required' TO JZ-CHAR80 JSPG2 021070 END-IF JSPG2 021080 END-IF. JSPG2 021090 IF JZ-CHAR80 NOT = SPACE JSPG2 021100 MOVE 'Y' TO JZ-Error OF JZ JSPG2 021110 MOVE 80 TO JZ-MLTH JSPG2 021120 PERFORM JZ-ADD-TO-ERR-MESSAGE JSPG2 021130 END-IF. JSPG2 021140 IF JZ-Error OF JZ = 'Y' JSPG2 021150* Respond with error messages and exit program JSPG2 021160 GO TO JZ-Normal-Exit JSPG2 021170 END-IF. JSPG2 021180* JSPG2 021190 JZ-67-DELETE. JSPG2 021200* DELETE EMPLOYEE KEY(EMPLOYEE.EMPNO) CHECKSUM JSPG2 021210* IJSPG2.JZ-EMPLOYEE.Checksum;JSPG2 021220 PERFORM JZ-EMPLOYEE-ReadBy1ryKey. JSPG2 021230 MOVE 'Y' TO EMPLOYEE-UpdatePending-Flag. JSPG2 021240 MOVE 113 TO JZ-INT. JSPG2 021250 CALL 'JZHASH' USING EMPLOYEE JZ-INT Checksum OF JZ. JSPG2 021260* Check against saved copy JSPG2 021270 IF Checksum OF IJSPG2 IS NOT EQUAL TO Checksum OF JZ JSPG2 021280 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 021290 MOVE 50 TO JZL-Error OF OJSPG2 JSPG2 021300 MOVE 'DELETE check failure: EMPLOYEE changed or not read'JSPG2 021310 TO JZD-Error OF OJSPG2 JSPG2 021320 GO TO JZ-Normal-Exit JSPG2 021330 END-IF. JSPG2 021340 EXEC SQL JSPG2 021350 DELETE EMPLOYEE WHERE EMPLOYEE.EMPNO = :EMPLOYEE.EMPNO JSPG2 021360 END-EXEC. JSPG2 021370 IF SQLCODE = 0 JSPG2 021380 MOVE 'D' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 021390 MOVE 23 TO JZL-Error OF OJSPG2 JSPG2 021400 MOVE 'Record has been deleted' TO JZD-Error OF OJSPG2 JSPG2 021410 ELSE JSPG2 021420 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 021430 MOVE SPACES TO JZD-Error OF OJSPG2 JSPG2 021440 MOVE SQLCODE TO SQLCodePic OF JZ JSPG2 021450 STRING 'SQLCode=' DELIMITED BY SIZE JSPG2 021460 SQLCodePic OF JZ DELIMITED BY SIZE JSPG2 021470 ':' DELIMITED BY SIZE JSPG2 021480 SQLERRMC(1:SQLERRML) DELIMITED BY SIZE JSPG2 021490 INTO JZD-Error OF OJSPG2 JSPG2 021500 COMPUTE JZL-Error OF OJSPG2=FUNCTION MIN(80 SQLERRML+12) JSPG2 021510 GO TO JZ-Normal-Exit JSPG2 021520 END-IF. JSPG2 021530 MOVE 'N' TO EMPLOYEE-UpdatePending-Flag. JSPG2 021540******************************************************************JSPG2 021550** **JSPG2 021560** CICS Support Routine **JSPG2 021570** **JSPG2 021580******************************************************************JSPG2 021590******************************************************************JSPG2 021600** **JSPG2 021610** Code Conversion Routines **JSPG2 021620** **JSPG2 021630******************************************************************JSPG2 021640* JSPG2 021650* Convert EMPLOYEE-SEX code to value JSPG2 021660 JZCvt-EMPLOYEE-SEX. JSPG2 021670* Input: SEARCH-FOR OF JZCodes-EMPLOYEE-SEX JSPG2 021680* Output: FOUND-VALUE OF JZCodes-EMPLOYEE-SEX JSPG2 021690* If Invalid, FOUND-VALUE will be set to '****', JSPG2 021700* field JZ-CHAR80 will contain an error message JSPG2 021710 SET JZIX-EMPLOYEE-SEX TO 1. JSPG2 021720 SEARCH ITEM-VALUES OF JZCodes-EMPLOYEE-SEX VARYING JSPG2 021730 JZIX-EMPLOYEE-SEX JSPG2 021740 AT END JSPG2 021750 MOVE 'Invalid Code' TO JZ-CHAR80 JSPG2 021760 MOVE '******' TO FOUND-VALUE OF JZCodes-EMPLOYEE-SEX JSPG2 021770 MOVE SPACES TO SEARCH-FOR OF JZCodes-EMPLOYEE-SEX JSPG2 021780 WHEN JZCODE OF JZCodes-EMPLOYEE-SEX(JZIX-EMPLOYEE-SEX) = JSPG2 021790 SEARCH-FOR OF JZCodes-EMPLOYEE-SEX JSPG2 021800 MOVE CODE-VALUE OF JSPG2 021810 JZCodes-EMPLOYEE-SEX(JZIX-EMPLOYEE-SEX) TO JSPG2 021820 FOUND-VALUE OF JZCodes-EMPLOYEE-SEX JSPG2 021830 END-SEARCH. JSPG2 021840* JSPG2 021850* Convert JZSMth-SMth code to value JSPG2 021860 JZCvt-JZSMth-SMth. JSPG2 021870* Input: SEARCH-FOR OF JZCodes-JZSMth-SMth JSPG2 021880* Output: FOUND-VALUE OF JZCodes-JZSMth-SMth JSPG2 021890* If Invalid, FOUND-VALUE will be set to '****', JSPG2 021900* field JZ-CHAR80 will contain an error message JSPG2 021910 SET JZIX-JZSMth-SMth TO SEARCH-FOR OF JZCodes-JZSMth-SMth. JSPG2 021920 IF JZIX-JZSMth-SMth < 1 OR JZIX-JZSMth-SMth > 12 JSPG2 021930 MOVE 'Outside Code Range' TO JZ-CHAR80 JSPG2 021940 MOVE '***' TO FOUND-VALUE OF JZCodes-JZSMth-SMth JSPG2 021950 ELSE JSPG2 021960 MOVE CODE-Value OF JZCodes-JZSMth-SMth(JZIX-JZSMth-SMth) JSPG2 021970 TO FOUND-VALUE OF JZCodes-JZSMth-SMth JSPG2 021980 END-IF. JSPG2 021990* JSPG2 022000* Convert IJSPG2-Function code to value JSPG2 022010 JZCvt-IJSPG2-Function. JSPG2 022020* Input: SEARCH-FOR OF JZCodes-IJSPG2-Function JSPG2 022030* Output: FOUND-VALUE OF JZCodes-IJSPG2-Function JSPG2 022040* If Invalid, FOUND-VALUE will be set to '****', JSPG2 022050* field JZ-CHAR80 will contain an error message JSPG2 022060 SET JZIX-IJSPG2-Function TO 1. JSPG2 022070 SEARCH ITEM-VALUES OF JZCodes-IJSPG2-Function VARYING JSPG2 022080 JZIX-IJSPG2-Function JSPG2 022090 AT END JSPG2 022100 MOVE 'Invalid Code' TO JZ-CHAR80 JSPG2 022110 MOVE '*******' TO FOUND-VALUE OF JZCodes-IJSPG2-FunctionJSPG2 022120 MOVE SPACES TO SEARCH-FOR OF JZCodes-IJSPG2-Function JSPG2 022130 WHEN JZCODE OF JSPG2 022140 JZCodes-IJSPG2-Function(JZIX-IJSPG2-Function) = JSPG2 022150 SEARCH-FOR OF JZCodes-IJSPG2-Function JSPG2 022160 MOVE CODE-VALUE OF JSPG2 022170 JZCodes-IJSPG2-Function(JZIX-IJSPG2-Function)JSPG2 022180 TO FOUND-VALUE OF JZCodes-IJSPG2-Function JSPG2 022190 END-SEARCH. JSPG2 022200******************************************************************JSPG2 022210** **JSPG2 022220** Sundry Routines **JSPG2 022230** **JSPG2 022240******************************************************************JSPG2 022250* JSPG2 022260 CICS-CheckStatus. JSPG2 022270 EVALUATE JZ-Response JSPG2 022280 WHEN DFHRESP(NORMAL) JSPG2 022290 WHEN DFHRESP(DUPKEY) JSPG2 022300 CONTINUE JSPG2 022310 WHEN OTHER JSPG2 022320 GO TO JZ-Abend-Exit JSPG2 022330 END-EVALUATE. JSPG2 022340* JSPG2 022350 JZPutContainer. JSPG2 022360 MOVE 'DFHWS-DATA' TO JZContainerName. JSPG2 022370 EXEC CICS JSPG2 022380 PUT CONTAINER(JZContainerName) FROM(OJSPG2) JSPG2 022390 RESP(JZ-RESPONSE) JSPG2 022400 END-EXEC. JSPG2 022410 PERFORM CICS-CheckStatus. JSPG2 022420* JSPG2 022430* Is this a leap year JSPG2 022440 JZCheckLeapYear. JSPG2 022450 IF FUNCTION MOD (DFYears OF JZ 4) NOT = 0 JSPG2 022460 MOVE 'N' TO LeapYear OF JZ JSPG2 022470 ELSE JSPG2 022480 MOVE 'Y' TO LeapYear OF JZ JSPG2 022490 IF FUNCTION MOD(DFYears OF JZ 100) = 0 JSPG2 022500 IF FUNCTION MOD(DFYears OF JZ 400) NOT = 0 JSPG2 022510 MOVE 'N' TO LeapYear OF JZ JSPG2 022520 END-IF JSPG2 022530 END-IF JSPG2 022540 END-IF. JSPG2 022550* JSPG2 022560* Check value, format from DateDIFF to DATE JSPG2 022570 JZCheckDate. JSPG2 022580 MOVE 'Y' TO JZ-Error OF JZ. JSPG2 022590 MOVE 0 TO DateFormPic OF JZ. JSPG2 022600 IF DFOrdDays OF JZ > 0 JSPG2 022610 IF DFOrdDays OF JZ > 366 JSPG2 022620 MOVE 'Invalid Date' TO JZ-CHAR80 JSPG2 022630 ELSE JSPG2 022640 PERFORM JZOrdinalDayToGegorian JSPG2 022650 END-IF JSPG2 022660 END-IF. JSPG2 022670 IF DFYears OF JZ = ZERO OR DFMonths OF JZ = ZERO OR DFDays OFJSPG2 022680 JZ = ZERO JSPG2 022690 MOVE 'Invalid Date' TO JZ-CHAR80 JSPG2 022700 ELSE JSPG2 022710 IF DFMonths OF JZ > 12 JSPG2 022720 MOVE 'Month Invalid' TO JZ-CHAR80 JSPG2 022730 ELSE JSPG2 022740 IF DFDays OF JZ > MDayR OF JZMDays(DFMonths OF JZ) JSPG2 022750 IF DFMonths OF JZ = 2 AND DFDays OF JZ = 29 JSPG2 022760 PERFORM JZCheckLeapYear JSPG2 022770 IF LeapYear OF JZ = 'N' JSPG2 022780 MOVE 'Day Invalid' TO JZ-CHAR80 JSPG2 022790 ELSE JSPG2 022800 MOVE 'N' TO JZ-ERROR OF JZ JSPG2 022810 END-IF JSPG2 022820 ELSE JSPG2 022830 MOVE 'Day Invalid' TO JZ-CHAR80 JSPG2 022840 END-IF JSPG2 022850 ELSE JSPG2 022860 MOVE 'N' TO JZ-ERROR OF JZ JSPG2 022870 END-IF JSPG2 022880 IF JZ-ERROR OF JZ = 'N' JSPG2 022890* Format as DATE in DateFormPic JSPG2 022900 IF DFYears OF JZ < 100 JSPG2 022910 IF DFYears OF JZ < 40 JSPG2 022920 ADD 2000 TO DFYears OF JZ JSPG2 022930 ELSE JSPG2 022940 ADD 1900 TO DFYears OF JZ JSPG2 022950 END-IF JSPG2 022960 END-IF JSPG2 022970 MOVE DFYears OF JZ TO DateFormCYear OF JZ JSPG2 022980 MOVE DFMonths OF JZ TO DateFormMth OF JZ JSPG2 022990 MOVE DFDays OF JZ TO DateFormDay OF JZ JSPG2 023000 END-IF JSPG2 023010 END-IF JSPG2 023020 END-IF. JSPG2 023030* JSPG2 023040* Convert Ordinal Day to Months and Days JSPG2 023050 JZOrdinalDayToGegorian. JSPG2 023060* Input: DFOrdDays OF JZ, Output JZMonths,JZDays OF JZ JSPG2 023070* Test For Leap year JSPG2 023080 IF DFOrdDays OF JZ > 59 JSPG2 023090 PERFORM JZCheckLeapYear JSPG2 023100 IF LeapYear OF JZ = 'Y' JSPG2 023110 SUBTRACT 1 FROM DFOrdDays OF JZ JSPG2 023120 END-IF JSPG2 023130 END-IF. JSPG2 023140 PERFORM VARYING DFMonths OF JZ FROM 1 BY 1 UNTIL DFMonths OF JSPG2 023150 JZ > 12 OR CDayR OF JZMDays(DFMonths OF JZ) >= DFOrdDaysJSPG2 023160 OF JZ JSPG2 023170 END-PERFORM. JSPG2 023180 IF DFMonths OF JZ < 13 JSPG2 023190 IF DFMonths OF JZ > 1 JSPG2 023200 IF DFOrdDays OF JZ = 59 AND LeapYear OF JZ = 'Y' JSPG2 023210 ADD 1 TO DFOrdDays OF JZ JSPG2 023220 END-IF JSPG2 023230 COMPUTE JZ-IXMth = DFMonths OF JZ - 1 JSPG2 023240 SUBTRACT CDayR OF JZMDays(JZ-IXMth) FROM DFOrdDays OF JZJSPG2 023250 END-IF JSPG2 023260 MOVE DFOrdDays OF JZ TO DFDays OF JZ JSPG2 023270 END-IF. JSPG2 023280* JSPG2 023290 JZ-DEPARTMENT-ReadBy1ryKey. JSPG2 023300 MOVE SPACES TO JZD-DEPTNAME OF DEPARTMENT JSPG2 023310 EXEC SQL JSPG2 023320 SELECT DEPARTMENT.DEPTNAME INTO :DEPARTMENT.DEPTNAME FROMJSPG2 023330 DEPARTMENT WHERE DEPARTMENT.DEPTNO = :DEPARTMENT.DEPTNOJSPG2 023340 END-EXEC. JSPG2 023350 IF SQLCODE NOT = 0 JSPG2 023360 MOVE 'N' TO DEPARTMENT-Found-Flag JSPG2 023370 PERFORM DEPARTMENT-Initialize JSPG2 023380 ELSE JSPG2 023390 MOVE 'Y' TO DEPARTMENT-Found-Flag JSPG2 023400 END-IF. JSPG2 023410* JSPG2 023420 DEPARTMENT-Initialize. JSPG2 023430* Initialize non-key fields JSPG2 023440 Move SPACES TO JZD-DEPTNAME OF DEPARTMENT. JSPG2 023450 MOVE ZERO TO JZL-DEPTNAME OF DEPARTMENT. JSPG2 023460* JSPG2 023470 JZ-EMPLOYEE-ReadBy1ryKey. JSPG2 023480 MOVE SPACES TO JZD-FIRSTNME OF EMPLOYEE JSPG2 023490 MOVE SPACES TO JZD-LASTNAME OF EMPLOYEE JSPG2 023500 EXEC SQL JSPG2 023510 SELECT EMPLOYEE.EMPNO, EMPLOYEE.FIRSTNME, JSPG2 023520 EMPLOYEE.MIDINIT, EMPLOYEE.LASTNAME, JSPG2 023530 EMPLOYEE.WORKDEPT, EMPLOYEE.PHONENO, JSPG2 023540 INT(REPLACE(CHAR(EMPLOYEE.HIREDATE, ISO), '-', '')), JSPG2 023550 EMPLOYEE.JOB, EMPLOYEE.EDLEVEL, EMPLOYEE.SEX, JSPG2 023560 INT(REPLACE(CHAR(EMPLOYEE.BIRTHDATE, ISO), '-', '')),JSPG2 023570 EMPLOYEE.SALARY, EMPLOYEE.BONUS, EMPLOYEE.COMM, JSPG2 023580 EMPLOYEE.CURRENCY, EMPLOYEE.DEPTMGR, JSPG2 023590 CAST(EMPLOYEE.STARTTIME AS INT) * 1000 INTO JSPG2 023600 :EMPLOYEE.EMPNO, :EMPLOYEE.FIRSTNME, JSPG2 023610 :EMPLOYEE.MIDINIT:EMPLOYEE.JZB-MIDINIT, JSPG2 023620 :EMPLOYEE.LASTNAME, JSPG2 023630 :EMPLOYEE.WORKDEPT:EMPLOYEE.JZB-WORKDEPT, JSPG2 023640 :EMPLOYEE.PHONENO:EMPLOYEE.JZB-PHONENO, JSPG2 023650 :EMPLOYEE.HIREDATE:EMPLOYEE.JZB-HIREDATE, JSPG2 023660 :EMPLOYEE.JOB:EMPLOYEE.JZB-JOB, :EMPLOYEE.EDLEVEL, JSPG2 023670 :EMPLOYEE.SEX:EMPLOYEE.JZB-SEX, JSPG2 023680 :EMPLOYEE.BIRTHDATE:EMPLOYEE.JZB-BIRTHDATE, JSPG2 023690 :EMPLOYEE.SALARY:EMPLOYEE.JZB-SALARY, JSPG2 023700 :EMPLOYEE.BONUS:EMPLOYEE.JZB-BONUS, JSPG2 023710 :EMPLOYEE.COMM:EMPLOYEE.JZB-COMM, JSPG2 023720 :EMPLOYEE.JZ-CURRENCY:EMPLOYEE.JZB-CURRENCY, JSPG2 023730 :EMPLOYEE.DEPTMGR:EMPLOYEE.JZB-DEPTMGR, JSPG2 023740 :EMPLOYEE.STARTTIME:EMPLOYEE.JZB-STARTTIME FROM JSPG2 023750 EMPLOYEE WHERE EMPLOYEE.EMPNO = :EMPLOYEE.EMPNO JSPG2 023760 END-EXEC. JSPG2 023770 IF SQLCODE NOT = 0 JSPG2 023780 MOVE 'N' TO EMPLOYEE-Found-Flag JSPG2 023790 MOVE 'A' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 023800 PERFORM EMPLOYEE-Initialize JSPG2 023810 ELSE JSPG2 023820 MOVE 'Y' TO EMPLOYEE-Found-Flag JSPG2 023830 MOVE 'U' TO JZ-EMPLOYEE-ReturnCode OF OJSPG2(1) JSPG2 023840 PERFORM SET-EMPLOYEE-Value-Fields JSPG2 023850 END-IF. JSPG2 023860* JSPG2 023870 SET-EMPLOYEE-Value-Fields. JSPG2 023880* Set value fields for any Null fields retrieved JSPG2 023890 IF JZB-MIDINIT OF EMPLOYEE < 0 JSPG2 023900 MOVE SPACES TO MIDINIT OF EMPLOYEE JSPG2 023910 END-IF. JSPG2 023920 IF JZB-WORKDEPT OF EMPLOYEE < 0 JSPG2 023930 MOVE SPACES TO WORKDEPT OF EMPLOYEE JSPG2 023940 END-IF. JSPG2 023950 IF JZB-PHONENO OF EMPLOYEE < 0 JSPG2 023960 MOVE ZERO TO PHONENO OF EMPLOYEE JSPG2 023970 END-IF. JSPG2 023980 IF JZB-HIREDATE OF EMPLOYEE < 0 JSPG2 023990 MOVE ZERO TO HIREDATE OF EMPLOYEE JSPG2 024000 END-IF. JSPG2 024010 IF JZB-JOB OF EMPLOYEE < 0 JSPG2 024020 MOVE SPACES TO JOB OF EMPLOYEE JSPG2 024030 END-IF. JSPG2 024040 IF JZB-SEX OF EMPLOYEE < 0 JSPG2 024050 MOVE SPACES TO SEX OF EMPLOYEE JSPG2 024060 END-IF. JSPG2 024070 IF JZB-BIRTHDATE OF EMPLOYEE < 0 JSPG2 024080 MOVE ZERO TO BIRTHDATE OF EMPLOYEE JSPG2 024090 END-IF. JSPG2 024100 IF JZB-SALARY OF EMPLOYEE < 0 JSPG2 024110 MOVE ZERO TO SALARY OF EMPLOYEE JSPG2 024120 END-IF. JSPG2 024130 IF JZB-BONUS OF EMPLOYEE < 0 JSPG2 024140 MOVE ZERO TO BONUS OF EMPLOYEE JSPG2 024150 END-IF. JSPG2 024160 IF JZB-COMM OF EMPLOYEE < 0 JSPG2 024170 MOVE ZERO TO COMM OF EMPLOYEE JSPG2 024180 END-IF. JSPG2 024190 IF JZB-CURRENCY OF EMPLOYEE < 0 JSPG2 024200 MOVE SPACES TO JZ-CURRENCY OF EMPLOYEE JSPG2 024210 END-IF. JSPG2 024220 IF JZB-DEPTMGR OF EMPLOYEE < 0 JSPG2 024230 MOVE SPACES TO DEPTMGR OF EMPLOYEE JSPG2 024240 END-IF. JSPG2 024250 IF JZB-STARTTIME OF EMPLOYEE < 0 JSPG2 024260 MOVE ZERO TO STARTTIME OF EMPLOYEE JSPG2 024270 END-IF. JSPG2 024280* JSPG2 024290 EMPLOYEE-Initialize. JSPG2 024300* Initialize non-key fields JSPG2 024310 Move SPACES TO JZD-FIRSTNME OF EMPLOYEE. JSPG2 024320 MOVE ZERO TO JZL-FIRSTNME OF EMPLOYEE. JSPG2 024330 Move SPACES TO MIDINIT OF EMPLOYEE. JSPG2 024340 MOVE -1 TO JZB-MIDINIT OF EMPLOYEE. JSPG2 024350 Move SPACES TO JZD-LASTNAME OF EMPLOYEE. JSPG2 024360 MOVE ZERO TO JZL-LASTNAME OF EMPLOYEE. JSPG2 024370 Move SPACES TO WORKDEPT OF EMPLOYEE. JSPG2 024380 MOVE -1 TO JZB-WORKDEPT OF EMPLOYEE. JSPG2 024390 Move '0000' TO PHONENO OF EMPLOYEE. JSPG2 024400 MOVE -1 TO JZB-PHONENO OF EMPLOYEE. JSPG2 024410 Move ZERO TO HIREDATE OF EMPLOYEE. JSPG2 024420 MOVE -1 TO JZB-HIREDATE OF EMPLOYEE. JSPG2 024430 Move SPACES TO JOB OF EMPLOYEE. JSPG2 024440 MOVE -1 TO JZB-JOB OF EMPLOYEE. JSPG2 024450 Move ZERO TO EDLEVEL OF EMPLOYEE. JSPG2 024460 Move SPACES TO SEX OF EMPLOYEE. JSPG2 024470 MOVE -1 TO JZB-SEX OF EMPLOYEE. JSPG2 024480 Move ZERO TO BIRTHDATE OF EMPLOYEE. JSPG2 024490 MOVE -1 TO JZB-BIRTHDATE OF EMPLOYEE. JSPG2 024500 Move ZERO TO SALARY OF EMPLOYEE. JSPG2 024510 MOVE -1 TO JZB-SALARY OF EMPLOYEE. JSPG2 024520 Move ZERO TO BONUS OF EMPLOYEE. JSPG2 024530 MOVE -1 TO JZB-BONUS OF EMPLOYEE. JSPG2 024540 Move ZERO TO COMM OF EMPLOYEE. JSPG2 024550 MOVE -1 TO JZB-COMM OF EMPLOYEE. JSPG2 024560 Move SPACES TO JZ-CURRENCY OF EMPLOYEE. JSPG2 024570 MOVE -1 TO JZB-CURRENCY OF EMPLOYEE. JSPG2 024580 Move SPACES TO DEPTMGR OF EMPLOYEE. JSPG2 024590 MOVE -1 TO JZB-DEPTMGR OF EMPLOYEE. JSPG2 024600 Move ZERO TO STARTTIME OF EMPLOYEE. JSPG2 024610 MOVE -1 TO JZB-STARTTIME OF EMPLOYEE. JSPG2 024620* JSPG2 024630 JZ-EMPLOYEE-CopyTo-OJSPG2. JSPG2 024640* Move EMPLOYEE to OJSPG2 if there is room JSPG2 024650 IF JZ-EMPLOYEE-NbrReturned OF OJSPG2 IS LESS THAN 6 JSPG2 024660 ADD 1 TO JZ-EMPLOYEE-NbrReturned OF OJSPG2 JSPG2 024670 SET JZIX2 TO JZ-EMPLOYEE-NbrReturned OF OJSPG2 JSPG2 024680* Generic MOVE JSPG2 024690 MOVE EMPNO OF EMPLOYEE TO EMPNO OF OJSPG2(JZIX2) JSPG2 024700 MOVE FIRSTNME OF EMPLOYEE TO FIRSTNME OF OJSPG2(JZIX2) JSPG2 024710 MOVE MIDINIT OF EMPLOYEE TO MIDINIT OF OJSPG2(JZIX2) JSPG2 024720 MOVE LASTNAME OF EMPLOYEE TO LASTNAME OF OJSPG2(JZIX2) JSPG2 024730 MOVE WORKDEPT OF EMPLOYEE TO WORKDEPT OF OJSPG2(JZIX2) JSPG2 024740 MOVE PHONENO OF EMPLOYEE TO PHONENO OF OJSPG2(JZIX2) JSPG2 024750 MOVE HIREDATE OF EMPLOYEE TO HIREDATE OF OJSPG2(JZIX2) JSPG2 024760 MOVE JOB OF EMPLOYEE TO JOB OF OJSPG2(JZIX2) JSPG2 024770 MOVE EDLEVEL OF EMPLOYEE TO EDLEVEL OF OJSPG2(JZIX2) JSPG2 024780 MOVE SEX OF EMPLOYEE TO SEX OF OJSPG2(JZIX2) JSPG2 024790 MOVE BIRTHDATE OF EMPLOYEE TO BIRTHDATE OF OJSPG2(JZIX2) JSPG2 024800 MOVE SALARY OF EMPLOYEE TO SALARY OF OJSPG2(JZIX2) JSPG2 024810 MOVE BONUS OF EMPLOYEE TO BONUS OF OJSPG2(JZIX2) JSPG2 024820 MOVE COMM OF EMPLOYEE TO COMM OF OJSPG2(JZIX2) JSPG2 024830 MOVE JZ-CURRENCY OF EMPLOYEE TO JZ-CURRENCY OF OJSPG2(JZIX2)JSPG2 024840 MOVE DEPTMGR OF EMPLOYEE TO DEPTMGR OF OJSPG2(JZIX2) JSPG2 024850 MOVE STARTTIME OF EMPLOYEE TO STARTTIME OF OJSPG2(JZIX2) JSPG2 024860* Save Checksum Hash for later UPDATE CHECKSUM JSPG2 024870 MOVE 113 TO JZ-INT JSPG2 024880 CALL 'JZHASH' USING EMPLOYEE JZ-INT Checksum OF JSPG2 024890 OJSPG2(JZIX2) JSPG2 024900 IF DEPTNO OF DEPARTMENT IS NOT EQUAL TO WORKDEPT OF EMPLOYEEJSPG2 024910 MOVE WORKDEPT OF EMPLOYEE TO DEPTNO OF DEPARTMENT JSPG2 024920 PERFORM JZ-DEPARTMENT-ReadBy1ryKey JSPG2 024930 END-IF JSPG2 024940 MOVE DEPTNAME OF DEPARTMENT TO DEPTNAME OF OJSPG2(JZIX2) JSPG2 024950 ELSE JSPG2 024960 MOVE 'Y' TO EMPLOYEE-ENDFILE JSPG2 024970 END-IF. JSPG2 024980* JSPG2 024990 EMPLOYEE-Update. JSPG2 025000 IF EMPLOYEE-UpdatePending JSPG2 025010 MOVE 'N' TO EMPLOYEE-UpdatePending-Flag JSPG2 025020 IF HIREDATE OF EMPLOYEE = ZERO JSPG2 025030 MOVE -1 TO JZB-HIREDATE OF EMPLOYEE JSPG2 025040 END-IF JSPG2 025050 MOVE HIREDATE OF EMPLOYEE TO JZSQLDate1N JSPG2 025060 INSPECT JZSQLDate1 REPLACING ALL ' ' BY '-' JSPG2 025070 IF BIRTHDATE OF EMPLOYEE = ZERO JSPG2 025080 MOVE -1 TO JZB-BIRTHDATE OF EMPLOYEE JSPG2 025090 END-IF JSPG2 025100 MOVE BIRTHDATE OF EMPLOYEE TO JZSQLDate2N JSPG2 025110 INSPECT JZSQLDate2 REPLACING ALL ' ' BY '-' JSPG2 025120 CALL 'JZTM02' USING STARTTIME OF EMPLOYEE STARTTIME OF JZJSPG2 025130 IF EMPLOYEE-FOUND JSPG2 025140 EXEC SQL JSPG2 025150 UPDATE EMPLOYEE SET EMPNO = :EMPLOYEE.EMPNO, JSPG2 025160 FIRSTNME = :EMPLOYEE.FIRSTNME, MIDINIT = JSPG2 025170 :EMPLOYEE.MIDINIT:EMPLOYEE.JZB-MIDINIT, JSPG2 025180 LASTNAME = :EMPLOYEE.LASTNAME, WORKDEPT = JSPG2 025190 :EMPLOYEE.WORKDEPT:EMPLOYEE.JZB-WORKDEPT, JSPG2 025200 PHONENO = JSPG2 025210 :EMPLOYEE.PHONENO:EMPLOYEE.JZB-PHONENO, JSPG2 025220 HIREDATE = :JZSQLDate1:EMPLOYEE.JZB-HIREDATE,JSPG2 025230 JOB = :EMPLOYEE.JOB:EMPLOYEE.JZB-JOB, JSPG2 025240 EDLEVEL = :EMPLOYEE.EDLEVEL, SEX = JSPG2 025250 :EMPLOYEE.SEX:EMPLOYEE.JZB-SEX, BIRTHDATE = JSPG2 025260 :JZSQLDate2:EMPLOYEE.JZB-BIRTHDATE, SALARY = JSPG2 025270 :EMPLOYEE.SALARY:EMPLOYEE.JZB-SALARY, BONUS =JSPG2 025280 :EMPLOYEE.BONUS:EMPLOYEE.JZB-BONUS, COMM = JSPG2 025290 :EMPLOYEE.COMM:EMPLOYEE.JZB-COMM, CURRENCY = JSPG2 025300 :EMPLOYEE.JZ-CURRENCY:EMPLOYEE.JZB-CURRENCY, JSPG2 025310 DEPTMGR = JSPG2 025320 :EMPLOYEE.DEPTMGR:EMPLOYEE.JZB-DEPTMGR, JSPG2 025330 STARTTIME = JSPG2 025340 :JZ.STARTTIME:EMPLOYEE.JZB-STARTTIME WHERE JSPG2 025350 EMPLOYEE.EMPNO = :EMPLOYEE.EMPNO JSPG2 025360 END-EXEC JSPG2 025370 ELSE JSPG2 025380 EXEC SQL JSPG2 025390 INSERT INTO EMPLOYEE (EMPNO, FIRSTNME, MIDINIT, JSPG2 025400 LASTNAME, WORKDEPT, PHONENO, HIREDATE, JOB, JSPG2 025410 EDLEVEL, SEX, BIRTHDATE, SALARY, BONUS, COMM,JSPG2 025420 CURRENCY, DEPTMGR, STARTTIME) VALUES JSPG2 025430 (:EMPLOYEE.EMPNO, :EMPLOYEE.FIRSTNME, JSPG2 025440 :EMPLOYEE.MIDINIT:EMPLOYEE.JZB-MIDINIT, JSPG2 025450 :EMPLOYEE.LASTNAME, JSPG2 025460 :EMPLOYEE.WORKDEPT:EMPLOYEE.JZB-WORKDEPT, JSPG2 025470 :EMPLOYEE.PHONENO:EMPLOYEE.JZB-PHONENO, JSPG2 025480 :JZSQLDate1:EMPLOYEE.JZB-HIREDATE, JSPG2 025490 :EMPLOYEE.JOB:EMPLOYEE.JZB-JOB, JSPG2 025500 :EMPLOYEE.EDLEVEL, JSPG2 025510 :EMPLOYEE.SEX:EMPLOYEE.JZB-SEX, JSPG2 025520 :JZSQLDate2:EMPLOYEE.JZB-BIRTHDATE, JSPG2 025530 :EMPLOYEE.SALARY:EMPLOYEE.JZB-SALARY, JSPG2 025540 :EMPLOYEE.BONUS:EMPLOYEE.JZB-BONUS, JSPG2 025550 :EMPLOYEE.COMM:EMPLOYEE.JZB-COMM, JSPG2 025560 :EMPLOYEE.JZ-CURRENCY:EMPLOYEE.JZB-CURRENCY, JSPG2 025570 :EMPLOYEE.DEPTMGR:EMPLOYEE.JZB-DEPTMGR, JSPG2 025580 :JZ.STARTTIME:EMPLOYEE.JZB-STARTTIME) JSPG2 025590 END-EXEC JSPG2 025600 END-IF JSPG2 025610 IF SQLCODE NOT = ZERO JSPG2 025620* SQL UPDATE/INSERT FAILED JSPG2 025630 GO TO JZ-Abend-Exit JSPG2 025640 ELSE JSPG2 025650 MOVE 'SQL UPDATE/INSERT SUCCESSFUL' TO JZD-Error OF JSPG2 025660 OJSPG2 JSPG2 025670 MOVE 28 TO JZL-Error OF OJSPG2 JSPG2 025680 END-IF JSPG2 025690 END-IF. JSPG2 025700* JSPG2 025710 EMPLOYEE-Freekey-SET. JSPG2 025720* Set EMPLOYEE.$FreeKey to free value JSPG2 025730* SQL logic: find last record, set key to next value JSPG2 025740 EXEC SQL JSPG2 025750 SELECT EMPNO INTO :EMPLOYEE.EMPNO FROM EMPLOYEE ORDER BY JSPG2 025760 EMPNO DESC FETCH FIRST ROW ONLY JSPG2 025770 END-EXEC. JSPG2 025780* Set key to next value JSPG2 025790 MOVE EMPNO OF EMPLOYEE TO EMPNO OF JZ. JSPG2 025800 ADD 1 TO EMPNO OF JZ. JSPG2 025810 MOVE EMPNO OF JZ TO EMPNO OF EMPLOYEE. JSPG2 025820* JSPG2 025830 JZ-ADD-TO-ERR-MESSAGE. JSPG2 025840* Add JZ-CHAR80 to Error if there Is room JSPG2 025850 IF JZL-Error OF OJSPG2 > 0 And JZL-Error OF OJSPG2 < 78 JSPG2 025860 MOVE '; ' TO JZD-Error OF OJSPG2(JZL-Error OF OJSPG2 + 1:2)JSPG2 025870 ADD 2 TO JZL-Error OF OJSPG2 JSPG2 025880 END-IF. JSPG2 025890* Set JZ-Index to length of field name JSPG2 025900 PERFORM VARYING JZ-INDEX FROM 30 BY -1 UNTIL JZ-INDEX <= 1 ORJSPG2 025910 JZ-FNAME (JZ-INDEX:1) NOT = SPACE JSPG2 025920 END-PERFORM. JSPG2 025930 IF JZ-INDEX + JZL-Error OF OJSPG2 > 79 JSPG2 025940 COMPUTE JZ-INDEX = 79 - JZL-Error OF OJSPG2 JSPG2 025950 END-IF. JSPG2 025960 IF JZ-INDEX < 0 JSPG2 025970 MOVE 0 TO JZ-INDEX JSPG2 025980 END-IF. JSPG2 025990 STRING JZ-FNAME(1:JZ-INDEX) ':' DELIMITED BY SIZE INTO JSPG2 026000 JZD-Error OF OJSPG2(JZL-Error OF OJSPG2 + 1:JZ-INDEX). JSPG2 026010 ADD JZ-INDEX TO JZL-Error OF OJSPG2. JSPG2 026020 ADD 1 TO JZL-Error OF OJSPG2. JSPG2 026030* Set JZ-Index to length to be added JSPG2 026040 PERFORM VARYING JZ-INDEX FROM 80 BY -1 UNTIL JZ-INDEX <= 1 ORJSPG2 026050 JZ-CHAR80 (JZ-INDEX:1) NOT = SPACE JSPG2 026060 END-PERFORM. JSPG2 026070* Calculate Available Length JSPG2 026080 COMPUTE JZ-AL = 80 - JZL-Error OF OJSPG2. JSPG2 026090 IF JZ-AL < JZ-INDEX JSPG2 026100 MOVE JZ-AL TO JZ-INDEX JSPG2 026110 END-IF. JSPG2 026120 IF JZ-INDEX < 0 JSPG2 026130 MOVE 0 TO JZ-INDEX JSPG2 026140 MOVE '**' TO JZD-Error OF OJSPG2(78:2) JSPG2 026150 ELSE JSPG2 026160 MOVE JZ-CHAR80(1:JZ-INDEX) TO JZD-Error OF JSPG2 026170 OJSPG2(JZL-Error OF OJSPG2 + 1:JZ-INDEX) JSPG2 026180 ADD JZ-INDEX TO JZL-Error OF OJSPG2 JSPG2 026190 END-IF. JSPG2