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