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