000010* C:\tutorials\TstSQL\cbl\WSPGEM.CBL 000020 IDENTIFICATION DIVISION. WSPGEM 000030 PROGRAM-ID. WSPGEM. WSPGEM 000040 AUTHOR. JazzUser (Using Jazz from Visual Studio) WSPGEM 000050 DATE-WRITTEN. 9/06/2019 4:03:26 PM WSPGEM 000060 ENVIRONMENT DIVISION. WSPGEM 000070*# Last Updated by JazzUser at 9/06/2019 4:03:26 PM WSPGEM 000080*PROGRAM WSPGEM WEBSERVICE MySvce CONTAINER DFHWS-DATA DATABASE WSPGEM 000090* Sample DB2 WSDL; WSPGEM 000100** Single Table Update WSPGEM 000110*COPY JZTrim; WSPGEM 000120*COPY JZSMth; WSPGEM 000130*COPY JZMDays; WSPGEM 000140*COPY JZDTVS; WSPGEM 000150*ACCEPT (IWSPGEM.Function) MESSAGE OWSPGEM.ERROR; WSPGEM 000160*#052 W Item IWSPGEM.Function will be validated, but not moved WSPGEM 000170* from the input record WSPGEM 000180*CASE (IWSPGEM.Function); WSPGEM 000190* WHEN (Enquiry); WSPGEM 000200* ACCEPT (EMPLOYEE.EMPNO = IWSPGEM.EMPNO OR WSPGEM 000210* EMPLOYEE.WORKDEPT = IWSPGEM.WORKDEPT) MESSAGE WSPGEM 000220* OWSPGEM.ERROR; WSPGEM 000230* GET EMPLOYEE KEY(EMPLOYEE.EMPNO OR EMPLOYEE.WORKDEPT) WSPGEM 000240* SAVESUM OWSPGEM.CheckSum-EMPLOYEE; WSPGEM 000250* #628 W GENERIC assumed for WORKDEPT WSPGEM 000260* END GET EMPLOYEE RESPOND OWSPGEM; WSPGEM 000270* WHEN (Update); WSPGEM 000280* ACCEPT (EMPLOYEE.EMPNO=IWSPGEM.EMPNO) MESSAGE WSPGEM 000290* OWSPGEM.ERROR; WSPGEM 000300* GET EMPLOYEE KEY(EMPLOYEE.EMPNO) UPDATE CHECKSUM WSPGEM 000310* IWSPGEM.CheckSum-EMPLOYEE; WSPGEM 000320* ACCEPT (IWSPGEM.JZ-EMPLOYEE.*) WSPGEM 000330* EXCEPT(EMPLOYEE.EMPNO) TOLIKE MESSAGE WSPGEM 000340* OWSPGEM.ERROR; WSPGEM 000350* #207 I JZ-EMPLOYEE.FIRSTNME,JZ-EMPLOYEE.LASTNAME, WSPGEM 000360* JZ-EMPLOYEE.WORKDEPT,JZ-EMPLOYEE.PHONENO, WSPGEM 000370* JZ-EMPLOYEE.HIREDATE, included in generic WSPGEM 000380* assignment WSPGEM 000390* END GET EMPLOYEE UPDATE RESPOND OWSPGEM; WSPGEM 000400* WHEN (Add); WSPGEM 000410* GET EMPLOYEE FREEKEY CREATE; WSPGEM 000420* #221 E EMPLOYEE.EMPNO used as key field(s). It/they WSPGEM 000430* will be set to next available value. WSPGEM 000440* ACCEPT (IWSPGEM.JZ-EMPLOYEE.*) WSPGEM 000450* EXCEPT(EMPLOYEE.EMPNO) TOLIKE MESSAGE WSPGEM 000460* OWSPGEM.ERROR; WSPGEM 000470* #207 I JZ-EMPLOYEE.FIRSTNME,JZ-EMPLOYEE.LASTNAME, WSPGEM 000480* JZ-EMPLOYEE.WORKDEPT,JZ-EMPLOYEE.PHONENO, WSPGEM 000490* JZ-EMPLOYEE.HIREDATE, included in generic WSPGEM 000500* assignment WSPGEM 000510* END GET EMPLOYEE CREATE RESPOND OWSPGEM; WSPGEM 000520* WHEN (Delete); WSPGEM 000530* ACCEPT (EMPLOYEE.EMPNO=IWSPGEM.EMPNO) MESSAGE WSPGEM 000540* OWSPGEM.ERROR; WSPGEM 000550* DELETE EMPLOYEE KEY(EMPLOYEE.EMPNO) CHECKSUM WSPGEM 000560* IWSPGEM.CheckSum-EMPLOYEE; WSPGEM 000570*END CASE; WSPGEM 000580*REPLY; WSPGEM 000590******************************************************************WSPGEM 000600** **WSPGEM 000610** Data Division **WSPGEM 000620** **WSPGEM 000630******************************************************************WSPGEM 000640 DATA DIVISION. WSPGEM 000650******************************************************************WSPGEM 000660** **WSPGEM 000670** Working Storage Section: General Program Data **WSPGEM 000680** **WSPGEM 000690******************************************************************WSPGEM 000700* WSPGEM 000710 WORKING-STORAGE SECTION. WSPGEM 000720******************************************************************WSPGEM 000730** **WSPGEM 000740** General Program Information **WSPGEM 000750** **WSPGEM 000760******************************************************************WSPGEM 000770* WSPGEM 000780* Status Flags and control data WSPGEM 000790 01 JZ-FileControl. WSPGEM 000800 03 SORTWORK-ENDFILE PIC X VALUE 'N'. WSPGEM 000810 03 JZDB2Co-ENDFILE PIC X VALUE 'N'. WSPGEM 000820 03 JZDB2Co-STATUS PIC S9(8) VALUE 0. WSPGEM 000830 03 JZDB2Co-FOUND-FLAG PIC X VALUE 'Y'. WSPGEM 000840 88 JZDB2Co-FOUND VALUE 'Y'. WSPGEM 000850 03 JZDB2Co-UPDATEPENDING-FLAG PIC X VALUE 'N'. WSPGEM 000860 88 JZDB2Co-UPDATEPENDING VALUE 'Y'. WSPGEM 000870 03 JZDB2Co-Get4Update-FLAG PIC X VALUE 'N'. WSPGEM 000880 88 JZDB2Co-Get4Update VALUE 'Y'. WSPGEM 000890 03 DEPARTMENT-ENDFILE PIC X VALUE 'N'. WSPGEM 000900 03 DEPARTMENT-STATUS PIC S9(8) VALUE 0. WSPGEM 000910 03 DEPARTMENT-FOUND-FLAG PIC X VALUE 'Y'. WSPGEM 000920 88 DEPARTMENT-FOUND VALUE 'Y'. WSPGEM 000930 03 DEPARTMENT-UPDATEPENDING-FLAG PIC X VALUE 'N'. WSPGEM 000940 88 DEPARTMENT-UPDATEPENDING VALUE 'Y'. WSPGEM 000950 03 DEPARTMENT-Get4Update-FLAG PIC X VALUE 'N'. WSPGEM 000960 88 DEPARTMENT-Get4Update VALUE 'Y'. WSPGEM 000970 03 EMPLOYEE-ENDFILE PIC X VALUE 'N'. WSPGEM 000980 03 EMPLOYEE-STATUS PIC S9(8) VALUE 0. WSPGEM 000990 03 EMPLOYEE-FOUND-FLAG PIC X VALUE 'Y'. WSPGEM 001000 88 EMPLOYEE-FOUND VALUE 'Y'. WSPGEM 001010 03 EMPLOYEE-UPDATEPENDING-FLAG PIC X VALUE 'N'. WSPGEM 001020 88 EMPLOYEE-UPDATEPENDING VALUE 'Y'. WSPGEM 001030 03 EMPLOYEE-Get4Update-FLAG PIC X VALUE 'N'. WSPGEM 001040 88 EMPLOYEE-Get4Update VALUE 'Y'. WSPGEM 001050 01 EMPLOYEE-CheckCopy PIC X(79). WSPGEM 001060* WSPGEM 001070 LOCAL-STORAGE SECTION. WSPGEM 001080******************************************************************WSPGEM 001090** **WSPGEM 001100** SQL Data **WSPGEM 001110** **WSPGEM 001120******************************************************************WSPGEM 001130 EXEC SQL WSPGEM 001140 INCLUDE SQLCA WSPGEM 001150 END-EXEC. WSPGEM 001160 EXEC SQL WSPGEM 001170 INCLUDE JZDB2Co WSPGEM 001180 END-EXEC. WSPGEM 001190 EXEC SQL WSPGEM 001200 INCLUDE $SQDEPAR WSPGEM 001210 END-EXEC. WSPGEM 001220 EXEC SQL WSPGEM 001230 INCLUDE EMPLOYEE WSPGEM 001240 END-EXEC. WSPGEM 001250******************************************************************WSPGEM 001260** **WSPGEM 001270** JZ - Jazz Sundry fields **WSPGEM 001280** **WSPGEM 001290******************************************************************WSPGEM 001300* WSPGEM 001310 01 JZ. WSPGEM 001320 03 JZ-AL PIC S9(4) COMP VALUE ZERO. WSPGEM 001330 03 JZ-ALIM PIC S9(4) COMP VALUE ZERO. WSPGEM 001340 03 JZ-NOFML PIC S9(4) COMP VALUE ZERO. WSPGEM 001350 03 JZ-INDEX PIC S9(4) COMP VALUE ZERO. WSPGEM 001360 03 JZ-INDEX2 PIC S9(4) COMP VALUE ZERO. WSPGEM 001370 03 JZ-IXMth PIC S9(4) COMP VALUE ZERO. WSPGEM 001380 03 IX1 PIC S9(4) COMP VALUE ZERO. WSPGEM 001390 03 IX2 PIC S9(4) COMP VALUE ZERO. WSPGEM 001400 03 IX3 PIC S9(4) COMP VALUE ZERO. WSPGEM 001410 03 IX4 PIC S9(4) COMP VALUE ZERO. WSPGEM 001420 03 IX5 PIC S9(4) COMP VALUE ZERO. WSPGEM 001430 03 IX6 PIC S9(4) COMP VALUE ZERO. WSPGEM 001440 03 IX7 PIC S9(4) COMP VALUE ZERO. WSPGEM 001450 03 JZ-ST PIC S9(4) COMP VALUE ZERO. WSPGEM 001460 03 JZ-SL PIC S9(4) COMP VALUE ZERO. WSPGEM 001470 03 JZ-BLANK PIC XXXX VALUE SPACES. WSPGEM 001480 03 JZ-CHAR80 PIC X(80) VALUE SPACES. WSPGEM 001490 03 JZ-FNAME PIC X(30) VALUE SPACES. WSPGEM 001500 03 JZ-KL PIC S9(4) COMP VALUE ZERO. WSPGEM 001510 03 JZ-MLTH PIC S9(4) COMP VALUE ZERO. WSPGEM 001520 03 JZ-INT PIC S9(9) COMP VALUE ZERO. WSPGEM 001530 03 JZ-TRUEFALSE PIC XXXXX VALUE SPACES. WSPGEM 001540 03 JZ-TinyNbr PIC S9(9) COMP VALUE ZERO. WSPGEM 001550 03 JZ-TinyGr REDEFINES JZ-TinyNbr. WSPGEM 001560 05 FILLER PIC XXX. WSPGEM 001570 05 JZ-Tiny PIC X. WSPGEM 001580 03 JZ-Error PIC X VALUE 'N'. WSPGEM 001590 03 JZ-NBR1 PIC 9999 VALUE ZERO. WSPGEM 001600 03 JZ-NBR1X REDEFINES JZ-NBR1 PIC XXXX. WSPGEM 001610 03 JZ-NBR2 PIC 9999 VALUE ZERO. WSPGEM 001620 03 JZ-NBR2X REDEFINES JZ-NBR2 PIC XXXX. WSPGEM 001630 03 JZ-SUBVAL PIC ZZZZZ9 VALUE ZERO. WSPGEM 001640 03 JZ-SUBVALR REDEFINES JZ-SUBVAL PIC X(6). WSPGEM 001650 03 JZ-SUBDIGIT PIC S9(4) COMP VALUE ZERO. WSPGEM 001660 03 JZ-INDEXES OCCURS 7 INDEXED BY JZIX1 PIC X(6) VALUE WSPGEM 001670 SPACES. WSPGEM 001680 03 JZ-INDEXPR PIC X(6) VALUE SPACES. WSPGEM 001690 03 EMPNO PIC 999999 VALUE ZERO. WSPGEM 001700 03 JZ-SQLCount PIC S9(9) COMP VALUE ZERO. WSPGEM 001710 03 JZLIKE. WSPGEM 001720 49 JZL-JZLIKE PIC S9999 COMP-5 Value 0. WSPGEM 001730 49 JZD-JZLIKE PIC XXXX Value SPACE. WSPGEM 001740 03 EMPLOYEE-WORKDEPT PIC XXX VALUE SPACES. WSPGEM 001750 03 JZSQLDate1 PIC X(10) VALUE SPACES. WSPGEM 001760 03 JZSQLDate1N REDEFINES JZSQLDate1 PIC 9999B99B99. WSPGEM 001770 03 JZSQLDate2 PIC X(10) VALUE SPACES. WSPGEM 001780 03 JZSQLDate2N REDEFINES JZSQLDate2 PIC 9999B99B99. WSPGEM 001790 03 PHONENO PIC 9999 VALUE ZERO. WSPGEM 001800 03 IsDateArith PIC X VALUE 'N'. WSPGEM 001810 03 LeapYear PIC X VALUE 'N'. WSPGEM 001820 03 DateFormPic PIC 99999999 VALUE ZERO. WSPGEM 001830 03 DateFormPicR REDEFINES DateFormPic. WSPGEM 001840 05 DateFormCYear PIC 9999. WSPGEM 001850 05 DateFormCYearR REDEFINES DateFormCYear. WSPGEM 001860 07 FILLER PIC 99. WSPGEM 001870 07 DateFormYear PIC 99. WSPGEM 001880 05 DateFormMth PIC 99. WSPGEM 001890 05 DateFormDay PIC 99. WSPGEM 001900 03 JZ-DateDiff. WSPGEM 001910 05 DFYears PIC S9(4) COMP VALUE ZERO. WSPGEM 001920 05 DFMonths PIC S9(4) COMP VALUE ZERO. WSPGEM 001930 05 DFDays PIC S9(4) COMP VALUE ZERO. WSPGEM 001940 05 DFOrdDays PIC S9(4) COMP VALUE ZERO. WSPGEM 001950 03 DateFormddbMMMbyy PIC X(9) VALUE SPACES. WSPGEM 001960 03 DateFormddbMMMbyyR REDEFINES DateFormddbMMMbyy. WSPGEM 001970 05 JZ-Day PIC 99. WSPGEM 001980 05 FILLER PIC X. WSPGEM 001990 05 SMth PIC XXX. WSPGEM 002000 05 FILLER PIC X. WSPGEM 002010 05 Year PIC 99. WSPGEM 002020 03 JZNXTKY6. WSPGEM 002030 49 JZL-JZNXTKY6 PIC S9999 COMP-5 Value 0. WSPGEM 002040 49 JZD-JZNXTKY6 PIC X(6) Value SPACE. WSPGEM 002050******************************************************************WSPGEM 002060** **WSPGEM 002070** JZ-Program-Info **WSPGEM 002080** **WSPGEM 002090******************************************************************WSPGEM 002100* WSPGEM 002110 01 JZ-Program-Info. WSPGEM 002120 05 ABID PIC X(8) VALUE 'JZABNDW'. WSPGEM 002130 05 Prog-id. WSPGEM 002140 49 JZL-Prog-id PIC S9999 COMP-5 Value 0. WSPGEM 002150 49 JZD-Prog-id PIC X(20) Value SPACE. WSPGEM 002160 05 Auth. WSPGEM 002170 49 JZL-Auth PIC S9999 COMP-5 Value 0. WSPGEM 002180 49 JZD-Auth PIC X(40) Value SPACE. WSPGEM 002190 05 DTE-Written. WSPGEM 002200 49 JZL-DTE-Written PIC S9999 COMP-5 Value 0. WSPGEM 002210 49 JZD-DTE-Written PIC X(24) Value SPACE. WSPGEM 002220 05 Jazz-Stmt. WSPGEM 002230 49 JZL-Jazz-Stmt PIC S9999 COMP-5 Value 0. WSPGEM 002240 49 JZD-Jazz-Stmt PIC X(80) Value SPACE. WSPGEM 002250 05 CICS-Stmt. WSPGEM 002260 49 JZL-CICS-Stmt PIC S9999 COMP-5 Value 0. WSPGEM 002270 49 JZD-CICS-Stmt PIC X(80) Value SPACE. WSPGEM 002280 05 JZ-Response PIC S9(9) COMP VALUE ZERO. WSPGEM 002290 05 Response2 PIC S9(9) COMP VALUE ZERO. WSPGEM 002300 05 SQLIsUsed PIC X VALUE 'N'. WSPGEM 002310 05 IsWebService PIC X VALUE 'N'. WSPGEM 002320 05 SQL-Stmt. WSPGEM 002330 49 JZL-SQL-Stmt PIC S9999 COMP-5 Value 0. WSPGEM 002340 49 JZD-SQL-Stmt PIC X(80) Value SPACE. WSPGEM 002350 05 JZ-SQLCA. WSPGEM 002360 49 JZL-JZ-SQLCA PIC S9999 COMP-5 Value 0. WSPGEM 002370 49 JZD-JZ-SQLCA PIC X(80) Value SPACE. WSPGEM 002380 05 JZ-SQLCODE PIC S9(9) COMP VALUE ZERO. WSPGEM 002390 05 WSType PIC XXXX VALUE SPACES. WSPGEM 002400 05 WSTransportType PIC XXXX VALUE SPACES. WSPGEM 002410 05 WSSourceType PIC XXXX VALUE SPACES. WSPGEM 002420******************************************************************WSPGEM 002430** **WSPGEM 002440** Web Service Control data **WSPGEM 002450** **WSPGEM 002460******************************************************************WSPGEM 002470* WSPGEM 002480 01 JZSoap-Pipeline-Data. WSPGEM 002490 03 JZServiceName PIC X(32) VALUE 'MYSVCE'. WSPGEM 002500 03 JZOperationName PIC X(255) VALUE 'WSPGEM'. WSPGEM 002510 03 JZContainerName PIC X(16) VALUE 'DFHWS-DATA'. WSPGEM 002520 03 JZChannelName PIC X(16) VALUE 'WSPGEM-CHANNEL'. WSPGEM 002530 03 JZInputContainer PIC X(16) VALUE SPACES. WSPGEM 002540 03 JZBrowseToken PIC 9(8) BINARY VALUE 0. WSPGEM 002550* WSPGEM 002560 01 JZURI-Structure. WSPGEM 002570 03 FILLER PIC X(10) VALUE SPACES. WSPGEM 002580 03 JZURI PIC X(255) VALUE SPACES. WSPGEM 002590******************************************************************WSPGEM 002600** **WSPGEM 002610** IWSPGEM **WSPGEM 002620** **WSPGEM 002630******************************************************************WSPGEM 002640* WSPGEM 002650 01 IWSPGEM. WSPGEM 002660 03 JZ-Function PIC X VALUE 'E'. WSPGEM 002670 03 JZ-EMPLOYEE-Skip PIC S9(4) COMP-5 VALUE 0. WSPGEM 002680 03 JZ-EMPLOYEE. WSPGEM 002690 05 EMPNO PIC X(6) VALUE '000000'. WSPGEM 002700 05 FIRSTNME PIC X(12) VALUE SPACES. WSPGEM 002710 05 LASTNAME PIC X(15) VALUE SPACES. WSPGEM 002720 05 WORKDEPT PIC XXX VALUE SPACES. WSPGEM 002730 05 PHONENO PIC XXXX VALUE '0000'. WSPGEM 002740 05 HIREDATE PIC X(9) VALUE SPACES. WSPGEM 002750 03 ViewState. WSPGEM 002760 05 CheckSum-EMPLOYEE PIC X(40) VALUE SPACES. WSPGEM 002770******************************************************************WSPGEM 002780** **WSPGEM 002790** OWSPGEM **WSPGEM 002800** **WSPGEM 002810******************************************************************WSPGEM 002820* WSPGEM 002830 01 OWSPGEM. WSPGEM 002840 03 JZ-ERROR. WSPGEM 002850 49 JZL-ERROR PIC S9999 COMP-5. WSPGEM 002860 49 JZD-ERROR PIC X(80). WSPGEM 002870 03 ViewState. WSPGEM 002880 05 CheckSum-EMPLOYEE PIC X(40) VALUE SPACES. WSPGEM 002890 03 JZ-EMPLOYEE-ReadTo PIC S9(4) COMP-5 VALUE 0. WSPGEM 002900 03 JZ-EMPLOYEE-NbrReturned PIC S9(4) COMP-5 VALUE 0. WSPGEM 002910 03 JZ-EMPLOYEE-ReturnCode PIC X VALUE SPACES. WSPGEM 002920 03 JZ-EMPLOYEE OCCURS 1 INDEXED BY JZIX2. WSPGEM 002930 05 EMPNO PIC X(6) VALUE '000000'. WSPGEM 002940 05 FIRSTNME. WSPGEM 002950 49 JZL-FIRSTNME PIC S9999 COMP-5. WSPGEM 002960 49 JZD-FIRSTNME PIC X(12). WSPGEM 002970 05 LASTNAME. WSPGEM 002980 49 JZL-LASTNAME PIC S9999 COMP-5. WSPGEM 002990 49 JZD-LASTNAME PIC X(15). WSPGEM 003000 05 WORKDEPT PIC XXX VALUE SPACES. WSPGEM 003010 05 PHONENO PIC XXXX VALUE '0000'. WSPGEM 003020 05 HIREDATE PIC S9(9) COMP-5 VALUE ZERO. WSPGEM 003030******************************************************************WSPGEM 003040** **WSPGEM 003050** JZTrim (Parameters) **WSPGEM 003060** **WSPGEM 003070******************************************************************WSPGEM 003080* WSPGEM 003090 01 JZTrim. WSPGEM 003100* Indata CHAR(*) WSPGEM 003110 03 Indata PIC X(15) VALUE SPACES. WSPGEM 003120 03 IndataA REDEFINES Indata OCCURS 1 INDEXED BY JZIX3 PIC X.WSPGEM 003130 03 ParmIn. WSPGEM 003140 05 InDataLth PIC S9(4) COMP VALUE ZERO. WSPGEM 003150 05 OutDataLth PIC S9(4) COMP VALUE ZERO. WSPGEM 003160 05 TrimType PIC XXXXX VALUE SPACES. WSPGEM 003170 03 ParmOut. WSPGEM 003180 05 JZ-Left PIC S9(4) COMP VALUE ZERO. WSPGEM 003190 05 JZ-Right PIC S9(4) COMP VALUE ZERO. WSPGEM 003200 05 JZ-Length PIC S9(4) COMP VALUE ZERO. WSPGEM 003210 05 SpecialName PIC XXXXX VALUE SPACES. WSPGEM 003220* Result VARCHAR(*) WSPGEM 003230 03 Result. WSPGEM 003240 49 JZL-Result PIC S9999 COMP-5. WSPGEM 003250 49 JZD-Result PIC X(15). WSPGEM 003260 03 ResultG REDEFINES Result. WSPGEM 003270 05 ResultL PIC S9(4) COMP-5. WSPGEM 003280 05 ResultA OCCURS 1 INDEXED BY JZIX4 PIC X. WSPGEM 003290******************************************************************WSPGEM 003300** **WSPGEM 003310** JZSMth **WSPGEM 003320** **WSPGEM 003330******************************************************************WSPGEM 003340* WSPGEM 003350 01 JZSMth. WSPGEM 003360 03 SMth PIC S9(4) COMP VALUE ZERO. WSPGEM 003370******************************************************************WSPGEM 003380** **WSPGEM 003390** JZMDays **WSPGEM 003400** **WSPGEM 003410******************************************************************WSPGEM 003420* WSPGEM 003430 01 JZMDays. WSPGEM 003440 03 MDayG. WSPGEM 003450 05 Jan PIC S9(4) COMP VALUE 31. WSPGEM 003460 05 Feb PIC S9(4) COMP VALUE 28. WSPGEM 003470 05 Mar PIC S9(4) COMP VALUE 31. WSPGEM 003480 05 Apr PIC S9(4) COMP VALUE 30. WSPGEM 003490 05 May PIC S9(4) COMP VALUE 31. WSPGEM 003500 05 Jun PIC S9(4) COMP VALUE 30. WSPGEM 003510 05 Jul PIC S9(4) COMP VALUE 31. WSPGEM 003520 05 Aug PIC S9(4) COMP VALUE 31. WSPGEM 003530 05 Sep PIC S9(4) COMP VALUE 30. WSPGEM 003540 05 Oct PIC S9(4) COMP VALUE 31. WSPGEM 003550 05 Nov PIC S9(4) COMP VALUE 30. WSPGEM 003560 05 Dec PIC S9(4) COMP VALUE 31. WSPGEM 003570 03 MDayR REDEFINES MDayG OCCURS 12 INDEXED BY JZIX5 PIC WSPGEM 003580 S9(4) COMP. WSPGEM 003590 03 CDayG. WSPGEM 003600 05 Jan PIC S9(4) COMP VALUE 31. WSPGEM 003610 05 Feb PIC S9(4) COMP VALUE 59. WSPGEM 003620 05 Mar PIC S9(4) COMP VALUE 90. WSPGEM 003630 05 Apr PIC S9(4) COMP VALUE 120. WSPGEM 003640 05 May PIC S9(4) COMP VALUE 151. WSPGEM 003650 05 Jun PIC S9(4) COMP VALUE 181. WSPGEM 003660 05 Jul PIC S9(4) COMP VALUE 212. WSPGEM 003670 05 Aug PIC S9(4) COMP VALUE 243. WSPGEM 003680 05 Sep PIC S9(4) COMP VALUE 273. WSPGEM 003690 05 Oct PIC S9(4) COMP VALUE 304. WSPGEM 003700 05 Nov PIC S9(4) COMP VALUE 334. WSPGEM 003710 05 Dec PIC S9(4) COMP VALUE 365. WSPGEM 003720 03 CDayR REDEFINES CDayG OCCURS 12 INDEXED BY JZIX6 PIC WSPGEM 003730 S9(4) COMP. WSPGEM 003740******************************************************************WSPGEM 003750** **WSPGEM 003760** JZDTVS (Parameters) **WSPGEM 003770** **WSPGEM 003780******************************************************************WSPGEM 003790* WSPGEM 003800 01 JZ-JZDTVS. WSPGEM 003810 03 InDate PIC X(16) VALUE SPACES. WSPGEM 003820 03 DPic PIC X(16) VALUE SPACES. WSPGEM 003830 03 DateOut. WSPGEM 003840 05 Years PIC S9(4) COMP VALUE ZERO. WSPGEM 003850 05 Months PIC S9(4) COMP VALUE ZERO. WSPGEM 003860 05 Days PIC S9(4) COMP VALUE ZERO. WSPGEM 003870 05 OrdDays PIC S9(4) COMP VALUE ZERO. WSPGEM 003880 03 HasError PIC X VALUE 'N'. WSPGEM 003890******************************************************************WSPGEM 003900** **WSPGEM 003910** Code Tables **WSPGEM 003920** **WSPGEM 003930******************************************************************WSPGEM 003940* WSPGEM 003950* IWSPGEM.Function WSPGEM 003960 01 JZCodes-IWSPGEM-Function. WSPGEM 003970 03 JZValues. WSPGEM 003980 05 FILLER PIC X(8) VALUE 'EEnquiry'. WSPGEM 003990 05 FILLER PIC X(8) VALUE 'UUpdate '. WSPGEM 004000 05 FILLER PIC X(8) VALUE 'AAdd '. WSPGEM 004010 05 FILLER PIC X(8) VALUE 'DDelete '. WSPGEM 004020 03 JZTABLE REDEFINES JZValues. WSPGEM 004030 05 ITEM-VALUES OCCURS 4 INDEXED BY WSPGEM 004040 JZIX-IWSPGEM-Function. WSPGEM 004050 07 JZCODE PIC X. WSPGEM 004060 07 CODE-VALUE PIC X(7). WSPGEM 004070 03 FILLER. WSPGEM 004080 05 SEARCH-FOR PIC X. WSPGEM 004090 05 FOUND-VALUE PIC X(7) VALUE '*******'. WSPGEM 004100* WSPGEM 004110* JZSMth.SMth WSPGEM 004120 01 JZCodes-JZSMth-SMth. WSPGEM 004130 03 JZValues. WSPGEM 004140 05 FILLER PIC X(3) VALUE 'Jan'. WSPGEM 004150 05 FILLER PIC X(3) VALUE 'Feb'. WSPGEM 004160 05 FILLER PIC X(3) VALUE 'Mar'. WSPGEM 004170 05 FILLER PIC X(3) VALUE 'Apr'. WSPGEM 004180 05 FILLER PIC X(3) VALUE 'May'. WSPGEM 004190 05 FILLER PIC X(3) VALUE 'Jun'. WSPGEM 004200 05 FILLER PIC X(3) VALUE 'Jul'. WSPGEM 004210 05 FILLER PIC X(3) VALUE 'Aug'. WSPGEM 004220 05 FILLER PIC X(3) VALUE 'Sep'. WSPGEM 004230 05 FILLER PIC X(3) VALUE 'Oct'. WSPGEM 004240 05 FILLER PIC X(3) VALUE 'Nov'. WSPGEM 004250 05 FILLER PIC X(3) VALUE 'Dec'. WSPGEM 004260 03 JZTABLE REDEFINES JZValues. WSPGEM 004270 05 ITEM-VALUES OCCURS 12 INDEXED BY JZIX-JZSMth-SMth. WSPGEM 004280 07 CODE-VALUE PIC X(3). WSPGEM 004290 03 FILLER. WSPGEM 004300 05 SEARCH-FOR PIC S9(4) COMP. WSPGEM 004310 05 FOUND-VALUE PIC X(3) VALUE '***'. WSPGEM 004320******************************************************************WSPGEM 004330** **WSPGEM 004340** Procedure Division. **WSPGEM 004350** **WSPGEM 004360******************************************************************WSPGEM 004370* WSPGEM 004380 PROCEDURE DIVISION. WSPGEM 004390 MOVE 'SAMPLE' TO JZC-DATABASE. WSPGEM 004400 EXEC SQL WSPGEM 004410 CONNECT TO :JZC-DATABASE WSPGEM 004420 END-EXEC. WSPGEM 004430 IF SQLCODE NOT = 0 WSPGEM 004440* Try reset and connect again WSPGEM 004450 EXEC SQL WSPGEM 004460 ROLLBACK WSPGEM 004470 END-EXEC WSPGEM 004480 EXEC SQL WSPGEM 004490 CONNECT TO :JZC-DATABASE WSPGEM 004500 END-EXEC WSPGEM 004510 IF SQLCODE NOT = 0 WSPGEM 004520 GO TO JZ-Abend-Exit WSPGEM 004530 END-IF WSPGEM 004540 END-IF. WSPGEM 004550* Find container name, and GET it WSPGEM 004560 EXEC CICS WSPGEM 004570 STARTBROWSE CONTAINER BROWSETOKEN(JZBrowseToken) WSPGEM 004580 RESP(JZ-RESPONSE) WSPGEM 004590 END-EXEC. WSPGEM 004600 EXEC CICS WSPGEM 004610 GETNEXT CONTAINER(JZInputContainer) WSPGEM 004620 BROWSETOKEN(JZBrowseToken) RESP(JZ-RESPONSE) WSPGEM 004630 END-EXEC. WSPGEM 004640 EXEC CICS WSPGEM 004650 ENDBROWSE CONTAINER BROWSETOKEN(JZBrowseToken) WSPGEM 004660 RESP(JZ-RESPONSE) WSPGEM 004670 END-EXEC. WSPGEM 004680 EXEC CICS WSPGEM 004690 GET CONTAINER(JZInputContainer) INTO(IWSPGEM) WSPGEM 004700 RESP(JZ-RESPONSE) WSPGEM 004710 END-EXEC. WSPGEM 004720 PERFORM CICS-CheckStatus. WSPGEM 004730* Initialise output message WSPGEM 004740 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 004750 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 004760 Move SPACES TO CheckSum-EMPLOYEE OF OWSPGEM. WSPGEM 004770 Move 0 TO JZ-EMPLOYEE-ReadTo OF OWSPGEM. WSPGEM 004780 Move 0 TO JZ-EMPLOYEE-NbrReturned OF OWSPGEM. WSPGEM 004790 Move SPACES TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM. WSPGEM 004800 PERFORM VARYING JZIX2 FROM 1 BY 1 UNTIL JZIX2 > 1 WSPGEM 004810 Move '000000' TO EMPNO OF OWSPGEM(JZIX2) WSPGEM 004820 Move SPACES TO JZD-FIRSTNME OF OWSPGEM(JZIX2) WSPGEM 004830 MOVE ZERO TO JZL-FIRSTNME OF OWSPGEM(JZIX2) WSPGEM 004840 Move SPACES TO JZD-LASTNAME OF OWSPGEM(JZIX2) WSPGEM 004850 MOVE ZERO TO JZL-LASTNAME OF OWSPGEM(JZIX2) WSPGEM 004860 Move SPACES TO WORKDEPT OF OWSPGEM(JZIX2) WSPGEM 004870 Move '0000' TO PHONENO OF OWSPGEM(JZIX2) WSPGEM 004880 Move ZERO TO HIREDATE OF OWSPGEM(JZIX2) WSPGEM 004890 END-PERFORM. WSPGEM 004900 PERFORM JZ-Main-Program-Logic. WSPGEM 004910* WSPGEM 004920 JZ-Normal-Exit. WSPGEM 004930 IF EMPLOYEE-UpdatePending-Flag = 'Y' WSPGEM 004940* Update not done - probably because of Accept-detected WSPGEM 004950* errorsWSPGEM 004960 EXEC SQL ROLLBACK END-EXEC WSPGEM 004970 ELSE WSPGEM 004980 EXEC SQL COMMIT END-EXEC WSPGEM 004990 END-IF. WSPGEM 005000 MOVE 'DFHWS-DATA' TO JZContainerName. WSPGEM 005010 EXEC CICS WSPGEM 005020 PUT CONTAINER(JZContainerName) FROM(OWSPGEM) WSPGEM 005030 RESP(JZ-RESPONSE) WSPGEM 005040 END-EXEC. WSPGEM 005050 PERFORM CICS-CheckStatus. WSPGEM 005060 EXEC CICS WSPGEM 005070 RETURN RESP(JZ-RESPONSE) WSPGEM 005080 END-EXEC. WSPGEM 005090 GOBACK. WSPGEM 005100* WSPGEM 005110 JZ-Abend-Exit. WSPGEM 005120* BR14 does nothing, but is useful for CEDF/CEDX debugging WSPGEM 005130 MOVE SQLCODE TO JZ-SQLCODE OF JZ-Program-Info. WSPGEM 005140 IF SQLCODE NOT = ZERO WSPGEM 005150 MOVE SQLERRM OF SQLCA TO JZ-SQLCA OF JZ-Program-Info WSPGEM 005160 END-IF. WSPGEM 005170 EXEC CICS LINK PROGRAM('JZBR14 ') COMMAREA(JZ-Program-Info) WSPGEM 005180 END-EXEC. WSPGEM 005190 EXEC SQL ROLLBACK END-EXEC. WSPGEM 005200 MOVE 80 TO JZ-MLTH. WSPGEM 005210 CALL 'JZABNDW' USING DFHEIBLK DFHCOMMAREA JZ-Program-Info WSPGEM 005220 JZ-ERROR OF OWSPGEM JZ-MLTH. WSPGEM 005230 MOVE 'DFHWS-DATA' TO JZContainerName. WSPGEM 005240 EXEC CICS WSPGEM 005250 PUT CONTAINER(JZContainerName) FROM(OWSPGEM) WSPGEM 005260 RESP(JZ-RESPONSE) WSPGEM 005270 END-EXEC. WSPGEM 005280 PERFORM CICS-CheckStatus. WSPGEM 005290 EXEC CICS WSPGEM 005300 RETURN RESP(JZ-RESPONSE) WSPGEM 005310 END-EXEC. WSPGEM 005320******************************************************************WSPGEM 005330** **WSPGEM 005340** Main Program Logic **WSPGEM 005350** **WSPGEM 005360******************************************************************WSPGEM 005370* WSPGEM 005380 JZ-Main-Program-Logic. WSPGEM 005390* ACCEPT (IWSPGEM.Function) MESSAGE OWSPGEM.ERROR; WSPGEM 005400 PERFORM JZ-42-ACCEPT. WSPGEM 005410* CASE (IWSPGEM.Function); WSPGEM 005420 EVALUATE JZ-Function OF IWSPGEM WSPGEM 005430* WHEN (Enquiry); WSPGEM 005440 When 'E' WSPGEM 005450 PERFORM JZ-44-WHEN WSPGEM 005460* WHEN (Update); WSPGEM 005470 When 'U' WSPGEM 005480 PERFORM JZ-48-WHEN WSPGEM 005490* WHEN (Add); WSPGEM 005500 When 'A' WSPGEM 005510 PERFORM JZ-53-WHEN WSPGEM 005520* WHEN (Delete); WSPGEM 005530 When 'D' WSPGEM 005540 PERFORM JZ-57-WHEN WSPGEM 005550 END-EVALUATE. WSPGEM 005560* REPLY; WSPGEM 005570 GO TO JZ-Normal-Exit. WSPGEM 005580* WSPGEM 005590 JZ-42-ACCEPT. WSPGEM 005600* ACCEPT (IWSPGEM.Function) MESSAGE OWSPGEM.ERROR; WSPGEM 005610 MOVE 'N' TO JZ-Error OF JZ. WSPGEM 005620 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 005630 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 005640* Validate IWSPGEM.Function WSPGEM 005650 MOVE SPACES TO JZ-CHAR80. WSPGEM 005660 MOVE 'Function' TO JZ-FNAME. WSPGEM 005670 IF JZ-Function OF IWSPGEM NOT = SPACES WSPGEM 005680 MOVE FUNCTION UPPER-CASE(JZ-Function OF IWSPGEM) TO WSPGEM 005690 JZ-Function OF IWSPGEM WSPGEM 005700 END-IF. WSPGEM 005710* Check Code Values WSPGEM 005720 MOVE JZ-Function OF IWSPGEM TO SEARCH-FOR OF WSPGEM 005730 JZCodes-IWSPGEM-Function. WSPGEM 005740 PERFORM JZCvt-IWSPGEM-Function. WSPGEM 005750 IF JZ-CHAR80 NOT = SPACE WSPGEM 005760 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 005770 MOVE 80 TO JZ-MLTH WSPGEM 005780 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 005790 END-IF. WSPGEM 005800 IF JZ-Error OF JZ = 'Y' WSPGEM 005810* Respond with error messages and exit program WSPGEM 005820 GO TO JZ-Normal-Exit WSPGEM 005830 END-IF. WSPGEM 005840* WSPGEM 005850* WHEN (Enquiry); WSPGEM 005860 JZ-44-WHEN. WSPGEM 005870* ACCEPT (EMPLOYEE.EMPNO = IWSPGEM.EMPNO OR EMPLOYEE.WORKDEPT WSPGEM 005880* = IWSPGEM.WORKDEPT) MESSAGE OWSPGEM.ERROR;WSPGEM 005890 PERFORM JZ-45-ACCEPT. WSPGEM 005900* GET EMPLOYEE KEY(EMPLOYEE.EMPNO OR EMPLOYEE.WORKDEPT) WSPGEM 005910* SAVESUM OWSPGEM.CheckSum-EMPLOYEE;WSPGEM 005920 PERFORM JZ-46-GET. WSPGEM 005930* WSPGEM 005940 JZ-45-ACCEPT. WSPGEM 005950* ACCEPT (EMPLOYEE.EMPNO = IWSPGEM.EMPNO OR EMPLOYEE.WORKDEPT WSPGEM 005960* = IWSPGEM.WORKDEPT) MESSAGE OWSPGEM.ERROR;WSPGEM 005970 MOVE 'N' TO JZ-Error OF JZ. WSPGEM 005980 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 005990 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 006000* Validate IWSPGEM.EMPNO, assign to EMPLOYEE.EMPNO WSPGEM 006010 MOVE SPACES TO JZ-CHAR80. WSPGEM 006020 MOVE 'EMPNO' TO JZ-FNAME. WSPGEM 006030 IF EMPNO OF IWSPGEM NOT = SPACES WSPGEM 006040 MOVE 6 TO InDataLth OF JZTRIM WSPGEM 006050 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 006060 CALL 'JZTrim' USING EMPNO OF IWSPGEM ParmIn OF JZTrim WSPGEM 006070 ParmOut of JZTrim Result OF JZTrim WSPGEM 006080 IF JZL-Result OF JZTrim > ZERO WSPGEM 006090 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS WSPGEM 006100 NUMERIC WSPGEM 006110 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result WSPGEM 006120 OF JZTrim(1:JZL-Result OF JZTrim)) WSPGEM 006130 MOVE EMPNO OF JZ TO EMP-EMPNO OF EMPLOYEE WSPGEM 006140 ELSE WSPGEM 006150 MOVE 'not numeric' TO JZ-CHAR80 WSPGEM 006160 END-IF WSPGEM 006170 END-IF WSPGEM 006180 END-IF. WSPGEM 006190 IF JZ-CHAR80 NOT = SPACE WSPGEM 006200 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 006210 MOVE 80 TO JZ-MLTH WSPGEM 006220 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 006230 END-IF. WSPGEM 006240* Validate IWSPGEM.WORKDEPT, assign to EMPLOYEE.WORKDEPT WSPGEM 006250 MOVE SPACES TO JZ-CHAR80. WSPGEM 006260 MOVE 'WORKDEPT' TO JZ-FNAME. WSPGEM 006270 IF WORKDEPT OF IWSPGEM NOT = SPACES WSPGEM 006280 MOVE FUNCTION UPPER-CASE(WORKDEPT OF IWSPGEM) TO WORKDEPTWSPGEM 006290 OF IWSPGEM WSPGEM 006300 MOVE 3 TO InDataLth OF JZTRIM WSPGEM 006310 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 006320 CALL 'JZTrim' USING WORKDEPT OF IWSPGEM ParmIn OF JZTrim WSPGEM 006330 ParmOut of JZTrim Result OF JZTrim WSPGEM 006340 IF JZL-Result OF JZTrim > ZERO WSPGEM 006350 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 006360 EMP-WORKDEPT OF EMPLOYEE WSPGEM 006370 MOVE 0 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 006380 ELSE WSPGEM 006390 MOVE SPACES TO EMP-WORKDEPT OF EMPLOYEE WSPGEM 006400 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 006410 MOVE -1 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 006420 ELSE WSPGEM 006430 MOVE 0 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 006440 END-IF WSPGEM 006450 END-IF WSPGEM 006460* Test that one of the OR-list fields are present WSPGEM 006470 IF EMP-EMPNO OF EMPLOYEE = '000000' AND JZB-EMP-WORKDEPT WSPGEM 006480 OF EMPLOYEE < ZERO WSPGEM 006490 MOVE 'value required' TO JZ-CHAR80 WSPGEM 006500 MOVE 'EMPNO,WORKDEPT' TO JZ-FNAME WSPGEM 006510 END-IF WSPGEM 006520 END-IF. WSPGEM 006530* Check Exists WSPGEM 006540 IF EMP-WORKDEPT OF EMPLOYEE NOT = SPACES WSPGEM 006550 IF EMP-WORKDEPT OF EMPLOYEE NOT = DEP-DEPTNO OF DEPARTMENTWSPGEM 006560 MOVE EMP-WORKDEPT OF EMPLOYEE TO DEP-DEPTNO OF WSPGEM 006570 DEPARTMENT WSPGEM 006580 EXEC SQL WSPGEM 006590 SELECT COUNT(*) INTO :JZ-SQLCOUNT FROM DEPARTMENTWSPGEM 006600 WHERE DEPTNO = :DEP-DEPTNO WSPGEM 006610 END-EXEC WSPGEM 006620 IF JZ-SQLCOUNT = ZERO WSPGEM 006630 MOVE 'VALUE DOES NOT EXIST' TO JZ-CHAR80 WSPGEM 006640 END-IF WSPGEM 006650 END-IF WSPGEM 006660 END-IF. WSPGEM 006670 IF JZ-CHAR80 NOT = SPACE WSPGEM 006680 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 006690 MOVE 80 TO JZ-MLTH WSPGEM 006700 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 006710 END-IF. WSPGEM 006720 IF JZ-Error OF JZ = 'Y' WSPGEM 006730* Respond with error messages and exit program WSPGEM 006740 GO TO JZ-Normal-Exit WSPGEM 006750 END-IF. WSPGEM 006760* WSPGEM 006770 JZ-46-GET. WSPGEM 006780* GET EMPLOYEE KEY(EMPLOYEE.EMPNO OR EMPLOYEE.WORKDEPT) WSPGEM 006790* SAVESUM OWSPGEM.CheckSum-EMPLOYEE;WSPGEM 006800 MOVE 'N' TO EMPLOYEE-Get4Update-FLAG. WSPGEM 006810 IF EMP-EMPNO OF EMPLOYEE NOT = '000000' WSPGEM 006820 PERFORM JZ-EMPLOYEE-ReadBy1ryKey WSPGEM 006830 PERFORM JZ-46-GETGroup WSPGEM 006840 ELSE WSPGEM 006850 IF JZB-EMP-WORKDEPT OF EMPLOYEE >= ZERO WSPGEM 006860 PERFORM VARYING JZ-KL FROM 3 BY -1 UNTIL JZ-KL <= 1 WSPGEM 006870 OR EMP-WORKDEPT OF EMPLOYEE(JZ-KL:1) NOT = SPACE WSPGEM 006880 END-PERFORM WSPGEM 006890* Browse EMPLOYEE BY WORKDEPT(1:JZ-KL) to OWSPGEM WSPGEM 006900 PERFORM JZ-46-BROWSE-WORKDEPT WSPGEM 006910 ELSE WSPGEM 006920 MOVE DFHRESP(NOTFND) TO JZ-RESPONSE WSPGEM 006930 MOVE 'N' TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM WSPGEM 006940 END-IF WSPGEM 006950 END-IF. WSPGEM 006960* WSPGEM 006970* Browse EMPLOYEE BY WORKDEPT(1:JZ-KL) to OWSPGEM WSPGEM 006980 JZ-46-BROWSE-WORKDEPT. WSPGEM 006990 MOVE 'N' TO EMPLOYEE-ENDFILE. WSPGEM 007000 MOVE 'N' TO EMPLOYEE-FOUND-FLAG. WSPGEM 007010 STRING EMP-WORKDEPT OF EMPLOYEE(1:JZ-KL) DELIMITED BY SIZE '%WSPGEM 007020- '' DELIMITED BY SIZE INTO JZD-JZLIKE. WSPGEM 007030 ADD 1 TO JZ-KL. WSPGEM 007040 MOVE JZ-KL TO JZL-JZLIKE. WSPGEM 007050 EXEC SQL WSPGEM 007060 DECLARE JZ-46-WORKDEPT-CURSOR CURSOR FOR SELECT EMPNO, WSPGEM 007070 FIRSTNME, LASTNAME, WORKDEPT, PHONENO, CAST(HIREDATE WSPGEM 007080 AS INTEGER) FROM EMPLOYEE WHERE WORKDEPT LIKE :JZLIKEWSPGEM 007090 END-EXEC. WSPGEM 007100 EXEC SQL WSPGEM 007110 OPEN JZ-46-WORKDEPT-CURSOR WSPGEM 007120 END-EXEC. WSPGEM 007130 PERFORM UNTIL EMPLOYEE-ENDFILE = 'Y' WSPGEM 007140 EXEC SQL WSPGEM 007150 FETCH JZ-46-WORKDEPT-CURSOR INTO :EMP-EMPNO, WSPGEM 007160 :EMP-FIRSTNME, :EMP-LASTNAME, WSPGEM 007170 :EMP-WORKDEPT:JZB-EMP-WORKDEPT, WSPGEM 007180 :EMP-PHONENO:JZB-EMP-PHONENO, WSPGEM 007190 :EMP-HIREDATE:JZB-EMP-HIREDATE WSPGEM 007200 END-EXEC WSPGEM 007210* Check that READNEXT hasn't run past end WSPGEM 007220 If SQLCODE NOT = ZERO WSPGEM 007230 MOVE 'Y' TO EMPLOYEE-ENDFILE WSPGEM 007240 MOVE 'D' TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM WSPGEM 007250 END-IF WSPGEM 007260 IF EMPLOYEE-ENDFILE = 'N' WSPGEM 007270* Skip, or handle record WSPGEM 007280 ADD 1 TO JZ-EMPLOYEE-ReadTo OF OWSPGEM WSPGEM 007290 IF JZ-EMPLOYEE-ReadTo OF OWSPGEM > JZ-EMPLOYEE-Skip WSPGEM 007300 OF IWSPGEM WSPGEM 007310 IF JZ-EMPLOYEE-NbrReturned OF OWSPGEM >= 1 WSPGEM 007320 MOVE 'Y' TO EMPLOYEE-ENDFILE WSPGEM 007330 ELSE WSPGEM 007340 MOVE 'Y' TO EMPLOYEE-FOUND-FLAG WSPGEM 007350 PERFORM JZ-46-GETGroup WSPGEM 007360 END-IF WSPGEM 007370 END-IF WSPGEM 007380 END-IF WSPGEM 007390 END-PERFORM. WSPGEM 007400 EXEC SQL WSPGEM 007410 CLOSE JZ-46-WORKDEPT-CURSOR WSPGEM 007420 END-EXEC. WSPGEM 007430 MOVE 'N' TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM. WSPGEM 007440* WSPGEM 007450 JZ-46-GETGroup. WSPGEM 007460* END GET EMPLOYEE RESPOND OWSPGEM; WSPGEM 007470 PERFORM JZ-EMPLOYEE-CopyTo-OWSPGEM. WSPGEM 007480* Save Checksum Hash for later UPDATE CHECKSUM WSPGEM 007490 MOVE 79 TO JZ-INT. WSPGEM 007500 CALL 'JZHASH' USING EMPLOYEE JZ-INT CheckSum-EMPLOYEE OF WSPGEM 007510 OWSPGEM. WSPGEM 007520* WSPGEM 007530* WHEN (Update); WSPGEM 007540 JZ-48-WHEN. WSPGEM 007550* ACCEPT (EMPLOYEE.EMPNO=IWSPGEM.EMPNO) MESSAGE OWSPGEM.ERROR; WSPGEM 007560 PERFORM JZ-49-ACCEPT. WSPGEM 007570* GET EMPLOYEE KEY(EMPLOYEE.EMPNO) UPDATE CHECKSUM WSPGEM 007580* IWSPGEM.CheckSum-EMPLOYEE;WSPGEM 007590 PERFORM JZ-50-GET. WSPGEM 007600* WSPGEM 007610 JZ-49-ACCEPT. WSPGEM 007620* ACCEPT (EMPLOYEE.EMPNO=IWSPGEM.EMPNO) MESSAGE OWSPGEM.ERROR; WSPGEM 007630 MOVE 'N' TO JZ-Error OF JZ. WSPGEM 007640 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 007650 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 007660* Validate IWSPGEM.EMPNO, assign to EMPLOYEE.EMPNO WSPGEM 007670 MOVE SPACES TO JZ-CHAR80. WSPGEM 007680 MOVE 'EMPNO' TO JZ-FNAME. WSPGEM 007690 IF EMPNO OF IWSPGEM NOT = SPACES WSPGEM 007700 MOVE 6 TO InDataLth OF JZTRIM WSPGEM 007710 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 007720 CALL 'JZTrim' USING EMPNO OF IWSPGEM ParmIn OF JZTrim WSPGEM 007730 ParmOut of JZTrim Result OF JZTrim WSPGEM 007740 IF JZL-Result OF JZTrim > ZERO WSPGEM 007750 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS WSPGEM 007760 NUMERIC WSPGEM 007770 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result WSPGEM 007780 OF JZTrim(1:JZL-Result OF JZTrim)) WSPGEM 007790 MOVE EMPNO OF JZ TO EMP-EMPNO OF EMPLOYEE WSPGEM 007800 ELSE WSPGEM 007810 MOVE 'not numeric' TO JZ-CHAR80 WSPGEM 007820 END-IF WSPGEM 007830 END-IF WSPGEM 007840 IF EMP-EMPNO OF EMPLOYEE = '000000' WSPGEM 007850 MOVE 'value required' TO JZ-CHAR80 WSPGEM 007860 END-IF WSPGEM 007870 END-IF. WSPGEM 007880 IF JZ-CHAR80 NOT = SPACE WSPGEM 007890 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 007900 MOVE 80 TO JZ-MLTH WSPGEM 007910 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 007920 END-IF. WSPGEM 007930 IF JZ-Error OF JZ = 'Y' WSPGEM 007940* Respond with error messages and exit program WSPGEM 007950 GO TO JZ-Normal-Exit WSPGEM 007960 END-IF. WSPGEM 007970* WSPGEM 007980 JZ-50-GET. WSPGEM 007990* GET EMPLOYEE KEY(EMPLOYEE.EMPNO) UPDATE CHECKSUM WSPGEM 008000* IWSPGEM.CheckSum-EMPLOYEE;WSPGEM 008010 MOVE 'Y' TO EMPLOYEE-Get4Update-FLAG. WSPGEM 008020 PERFORM JZ-EMPLOYEE-ReadBy1ryKey. WSPGEM 008030 MOVE 'Y' TO EMPLOYEE-UpdatePending-Flag. WSPGEM 008040 MOVE 79 TO JZ-INT. WSPGEM 008050 CALL 'JZHASH' USING EMPLOYEE JZ-INT CheckSum-EMPLOYEE OF WSPGEM 008060 OWSPGEM. WSPGEM 008070* Check against saved copy WSPGEM 008080 IF CheckSum-EMPLOYEE OF IWSPGEM IS NOT EQUAL TO WSPGEM 008090 CheckSum-EMPLOYEE OF OWSPGEM WSPGEM 008100 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM WSPGEM 008110 MOVE 'Record has been changed. Sorry, you need to re-applWSPGEM 008120- 'y the updates' TO JZD-ERROR OF OWSPGEM WSPGEM 008130 MOVE 64 TO JZL-ERROR OF OWSPGEM WSPGEM 008140 GO TO JZ-Normal-Exit WSPGEM 008150 END-IF. WSPGEM 008160 PERFORM JZ-50-GETGroup. WSPGEM 008170* WSPGEM 008180 JZ-50-GETGroup. WSPGEM 008190* ACCEPT (IWSPGEM.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) TOLIKE WSPGEM 008200* MESSAGE OWSPGEM.ERROR;WSPGEM 008210 PERFORM JZ-51-ACCEPT. WSPGEM 008220* END GET EMPLOYEE UPDATE RESPOND OWSPGEM; WSPGEM 008230* [Re]calculate Checksum WSPGEM 008240 MOVE 79 TO JZ-INT. WSPGEM 008250 CALL 'JZHASH' USING EMPLOYEE JZ-INT CheckSum-EMPLOYEE OF WSPGEM 008260 OWSPGEM. WSPGEM 008270 PERFORM JZ-EMPLOYEE-CopyTo-OWSPGEM. WSPGEM 008280 PERFORM EMPLOYEE-Update. WSPGEM 008290* WSPGEM 008300 JZ-51-ACCEPT. WSPGEM 008310* ACCEPT (IWSPGEM.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) TOLIKE WSPGEM 008320* MESSAGE OWSPGEM.ERROR;WSPGEM 008330 MOVE 'N' TO JZ-Error OF JZ. WSPGEM 008340 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 008350 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 008360* Validate IWSPGEM.JZ-EMPLOYEE.FIRSTNME, assign to WSPGEM 008370* EMPLOYEE.FIRSTNMEWSPGEM 008380 MOVE SPACES TO JZ-CHAR80. WSPGEM 008390 MOVE 'FIRSTNME' TO JZ-FNAME. WSPGEM 008400 IF FIRSTNME OF IWSPGEM NOT = SPACES WSPGEM 008410 MOVE 12 TO InDataLth OF JZTRIM WSPGEM 008420 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 008430 CALL 'JZTrim' USING FIRSTNME OF IWSPGEM ParmIn OF JZTrim WSPGEM 008440 ParmOut of JZTrim Result OF JZTrim WSPGEM 008450 MOVE JZL-Result OF JZTrim TO JZL-EMP-FIRSTNME OF EMPLOYEEWSPGEM 008460 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 008470 JZD-EMP-FIRSTNME OF EMPLOYEE WSPGEM 008480 IF EMP-FIRSTNME OF EMPLOYEE = SPACES WSPGEM 008490 MOVE 'value required' TO JZ-CHAR80 WSPGEM 008500 END-IF WSPGEM 008510 END-IF. WSPGEM 008520 IF JZ-CHAR80 NOT = SPACE WSPGEM 008530 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 008540 MOVE 80 TO JZ-MLTH WSPGEM 008550 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 008560 END-IF. WSPGEM 008570* Validate IWSPGEM.JZ-EMPLOYEE.LASTNAME, assign to WSPGEM 008580* EMPLOYEE.LASTNAMEWSPGEM 008590 MOVE SPACES TO JZ-CHAR80. WSPGEM 008600 MOVE 'LASTNAME' TO JZ-FNAME. WSPGEM 008610 IF LASTNAME OF IWSPGEM NOT = SPACES WSPGEM 008620 MOVE 15 TO InDataLth OF JZTRIM WSPGEM 008630 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 008640 CALL 'JZTrim' USING LASTNAME OF IWSPGEM ParmIn OF JZTrim WSPGEM 008650 ParmOut of JZTrim Result OF JZTrim WSPGEM 008660 MOVE JZL-Result OF JZTrim TO JZL-EMP-LASTNAME OF EMPLOYEEWSPGEM 008670 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 008680 JZD-EMP-LASTNAME OF EMPLOYEE WSPGEM 008690 IF EMP-LASTNAME OF EMPLOYEE = SPACES WSPGEM 008700 MOVE 'value required' TO JZ-CHAR80 WSPGEM 008710 END-IF WSPGEM 008720 END-IF. WSPGEM 008730 IF JZ-CHAR80 NOT = SPACE WSPGEM 008740 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 008750 MOVE 80 TO JZ-MLTH WSPGEM 008760 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 008770 END-IF. WSPGEM 008780* Validate IWSPGEM.JZ-EMPLOYEE.WORKDEPT, assign to WSPGEM 008790* EMPLOYEE.WORKDEPTWSPGEM 008800 MOVE SPACES TO JZ-CHAR80. WSPGEM 008810 MOVE 'WORKDEPT' TO JZ-FNAME. WSPGEM 008820 IF WORKDEPT OF IWSPGEM NOT = SPACES WSPGEM 008830 MOVE FUNCTION UPPER-CASE(WORKDEPT OF IWSPGEM) TO WORKDEPTWSPGEM 008840 OF IWSPGEM WSPGEM 008850 MOVE 3 TO InDataLth OF JZTRIM WSPGEM 008860 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 008870 CALL 'JZTrim' USING WORKDEPT OF IWSPGEM ParmIn OF JZTrim WSPGEM 008880 ParmOut of JZTrim Result OF JZTrim WSPGEM 008890 IF JZL-Result OF JZTrim > ZERO WSPGEM 008900 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 008910 EMP-WORKDEPT OF EMPLOYEE WSPGEM 008920 MOVE 0 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 008930 ELSE WSPGEM 008940 MOVE SPACES TO EMP-WORKDEPT OF EMPLOYEE WSPGEM 008950 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 008960 MOVE -1 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 008970 ELSE WSPGEM 008980 MOVE 0 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 008990 END-IF WSPGEM 009000 END-IF WSPGEM 009010 END-IF. WSPGEM 009020* Check Exists WSPGEM 009030 IF EMP-WORKDEPT OF EMPLOYEE NOT = SPACES WSPGEM 009040 IF EMP-WORKDEPT OF EMPLOYEE NOT = DEP-DEPTNO OF DEPARTMENTWSPGEM 009050 MOVE EMP-WORKDEPT OF EMPLOYEE TO DEP-DEPTNO OF WSPGEM 009060 DEPARTMENT WSPGEM 009070 EXEC SQL WSPGEM 009080 SELECT COUNT(*) INTO :JZ-SQLCOUNT FROM DEPARTMENTWSPGEM 009090 WHERE DEPTNO = :DEP-DEPTNO WSPGEM 009100 END-EXEC WSPGEM 009110 IF JZ-SQLCOUNT = ZERO WSPGEM 009120 MOVE 'VALUE DOES NOT EXIST' TO JZ-CHAR80 WSPGEM 009130 END-IF WSPGEM 009140 END-IF WSPGEM 009150 END-IF. WSPGEM 009160 IF JZ-CHAR80 NOT = SPACE WSPGEM 009170 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 009180 MOVE 80 TO JZ-MLTH WSPGEM 009190 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 009200 END-IF. WSPGEM 009210* Validate IWSPGEM.JZ-EMPLOYEE.PHONENO, assign to WSPGEM 009220* EMPLOYEE.PHONENOWSPGEM 009230 MOVE SPACES TO JZ-CHAR80. WSPGEM 009240 MOVE 'PHONENO' TO JZ-FNAME. WSPGEM 009250 IF PHONENO OF IWSPGEM NOT = SPACES WSPGEM 009260 MOVE 4 TO InDataLth OF JZTRIM WSPGEM 009270 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 009280 CALL 'JZTrim' USING PHONENO OF IWSPGEM ParmIn OF JZTrim WSPGEM 009290 ParmOut of JZTrim Result OF JZTrim WSPGEM 009300 IF JZL-Result OF JZTrim > ZERO WSPGEM 009310 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS WSPGEM 009320 NUMERIC WSPGEM 009330 COMPUTE PHONENO OF JZ = FUNCTION WSPGEM 009340 NUMVAL(JZD-Result OF JZTrim(1:JZL-Result OF WSPGEM 009350 JZTrim)) WSPGEM 009360 MOVE PHONENO OF JZ TO EMP-PHONENO OF EMPLOYEE WSPGEM 009370 MOVE 0 TO JZB-EMP-PHONENO OF EMPLOYEE WSPGEM 009380 ELSE WSPGEM 009390 MOVE 'not numeric' TO JZ-CHAR80 WSPGEM 009400 END-IF WSPGEM 009410 ELSE WSPGEM 009420 MOVE '0000' TO EMP-PHONENO OF EMPLOYEE WSPGEM 009430 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 009440 MOVE -1 TO JZB-EMP-PHONENO OF EMPLOYEE WSPGEM 009450 ELSE WSPGEM 009460 MOVE 0 TO JZB-EMP-PHONENO OF EMPLOYEE WSPGEM 009470 END-IF WSPGEM 009480 END-IF WSPGEM 009490 END-IF. WSPGEM 009500 IF JZ-CHAR80 NOT = SPACE WSPGEM 009510 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 009520 MOVE 80 TO JZ-MLTH WSPGEM 009530 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 009540 END-IF. WSPGEM 009550* Validate IWSPGEM.JZ-EMPLOYEE.HIREDATE, assign to WSPGEM 009560* EMPLOYEE.HIREDATEWSPGEM 009570 MOVE SPACES TO JZ-CHAR80. WSPGEM 009580 MOVE 'HIREDATE' TO JZ-FNAME. WSPGEM 009590 IF HIREDATE OF IWSPGEM NOT = SPACES WSPGEM 009600 MOVE 9 TO InDataLth OF JZTRIM WSPGEM 009610 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 009620 CALL 'JZTrim' USING HIREDATE OF IWSPGEM ParmIn OF JZTrim WSPGEM 009630 ParmOut of JZTrim Result OF JZTrim WSPGEM 009640 IF JZL-Result OF JZTrim > ZERO WSPGEM 009650 MOVE 'N' TO IsDateArith OF JZ WSPGEM 009660 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 009670 InDate OF JZ-JZDTVS WSPGEM 009680 MOVE 'dd MMM yy' TO DPic OF JZ-JZDTVS WSPGEM 009690 CALL 'JZDTVS' USING DFHEIBLK DFHCOMMAREA InDate OF WSPGEM 009700 JZ-JZDTVS DPic OF JZ-JZDTVS JZ-DateDiff OF JZ WSPGEM 009710 JZ-Error OF JZ WSPGEM 009720 PERFORM JZCheckDate WSPGEM 009730 IF JZ-CHAR80 = SPACE WSPGEM 009740 MOVE DateFormPic TO EMP-HIREDATE OF EMPLOYEE WSPGEM 009750 MOVE 0 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 009760 END-IF WSPGEM 009770 ELSE WSPGEM 009780 MOVE ZERO TO EMP-HIREDATE OF EMPLOYEE WSPGEM 009790 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 009800 MOVE -1 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 009810 ELSE WSPGEM 009820 MOVE 0 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 009830 END-IF WSPGEM 009840 END-IF WSPGEM 009850 END-IF. WSPGEM 009860 IF JZ-CHAR80 NOT = SPACE WSPGEM 009870 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 009880 MOVE 80 TO JZ-MLTH WSPGEM 009890 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 009900 END-IF. WSPGEM 009910 IF JZ-Error OF JZ = 'Y' WSPGEM 009920* Respond with error messages and exit program WSPGEM 009930 GO TO JZ-Normal-Exit WSPGEM 009940 END-IF. WSPGEM 009950* WSPGEM 009960* WHEN (Add); WSPGEM 009970 JZ-53-WHEN. WSPGEM 009980* GET EMPLOYEE FREEKEY CREATE; WSPGEM 009990 PERFORM EMPLOYEE-FreeKey-SET. WSPGEM 010000 PERFORM JZ-54-GET. WSPGEM 010010* WSPGEM 010020 JZ-54-GET. WSPGEM 010030* GET EMPLOYEE FREEKEY CREATE; WSPGEM 010040 MOVE 'Y' TO EMPLOYEE-Get4Update-FLAG. WSPGEM 010050 PERFORM JZ-EMPLOYEE-ReadBy1ryKey. WSPGEM 010060 MOVE 'Y' TO EMPLOYEE-UpdatePending-Flag. WSPGEM 010070 IF EMPLOYEE-FOUND-FLAG = 'Y' WSPGEM 010080 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM WSPGEM 010090 MOVE 'UPDATE aborted: record already exists' TO JZD-ERRORWSPGEM 010100 OF OWSPGEM WSPGEM 010110 MOVE 37 TO JZL-ERROR OF OWSPGEM WSPGEM 010120 GO TO JZ-Normal-Exit WSPGEM 010130 END-IF. WSPGEM 010140 PERFORM JZ-54-GETGroup. WSPGEM 010150* WSPGEM 010160 JZ-54-GETGroup. WSPGEM 010170* ACCEPT (IWSPGEM.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) TOLIKE WSPGEM 010180* MESSAGE OWSPGEM.ERROR;WSPGEM 010190 PERFORM JZ-55-ACCEPT. WSPGEM 010200* END GET EMPLOYEE CREATE RESPOND OWSPGEM; WSPGEM 010210* [Re]calculate Checksum WSPGEM 010220 MOVE 79 TO JZ-INT. WSPGEM 010230 CALL 'JZHASH' USING EMPLOYEE JZ-INT CheckSum-EMPLOYEE OF WSPGEM 010240 OWSPGEM. WSPGEM 010250 PERFORM JZ-EMPLOYEE-CopyTo-OWSPGEM. WSPGEM 010260 If NOT EMPLOYEE-FOUND WSPGEM 010270 PERFORM EMPLOYEE-Update WSPGEM 010280 END-IF. WSPGEM 010290* WSPGEM 010300 JZ-55-ACCEPT. WSPGEM 010310* ACCEPT (IWSPGEM.JZ-EMPLOYEE.*) EXCEPT(EMPLOYEE.EMPNO) TOLIKE WSPGEM 010320* MESSAGE OWSPGEM.ERROR;WSPGEM 010330 MOVE 'N' TO JZ-Error OF JZ. WSPGEM 010340 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 010350 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 010360* Validate IWSPGEM.JZ-EMPLOYEE.FIRSTNME, assign to WSPGEM 010370* EMPLOYEE.FIRSTNMEWSPGEM 010380 MOVE SPACES TO JZ-CHAR80. WSPGEM 010390 MOVE 'FIRSTNME' TO JZ-FNAME. WSPGEM 010400 IF FIRSTNME OF IWSPGEM NOT = SPACES WSPGEM 010410 MOVE 12 TO InDataLth OF JZTRIM WSPGEM 010420 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 010430 CALL 'JZTrim' USING FIRSTNME OF IWSPGEM ParmIn OF JZTrim WSPGEM 010440 ParmOut of JZTrim Result OF JZTrim WSPGEM 010450 MOVE JZL-Result OF JZTrim TO JZL-EMP-FIRSTNME OF EMPLOYEEWSPGEM 010460 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 010470 JZD-EMP-FIRSTNME OF EMPLOYEE WSPGEM 010480 IF EMP-FIRSTNME OF EMPLOYEE = SPACES WSPGEM 010490 MOVE 'value required' TO JZ-CHAR80 WSPGEM 010500 END-IF WSPGEM 010510 END-IF. WSPGEM 010520 IF JZ-CHAR80 NOT = SPACE WSPGEM 010530 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 010540 MOVE 80 TO JZ-MLTH WSPGEM 010550 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 010560 END-IF. WSPGEM 010570* Validate IWSPGEM.JZ-EMPLOYEE.LASTNAME, assign to WSPGEM 010580* EMPLOYEE.LASTNAMEWSPGEM 010590 MOVE SPACES TO JZ-CHAR80. WSPGEM 010600 MOVE 'LASTNAME' TO JZ-FNAME. WSPGEM 010610 IF LASTNAME OF IWSPGEM NOT = SPACES WSPGEM 010620 MOVE 15 TO InDataLth OF JZTRIM WSPGEM 010630 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 010640 CALL 'JZTrim' USING LASTNAME OF IWSPGEM ParmIn OF JZTrim WSPGEM 010650 ParmOut of JZTrim Result OF JZTrim WSPGEM 010660 MOVE JZL-Result OF JZTrim TO JZL-EMP-LASTNAME OF EMPLOYEEWSPGEM 010670 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 010680 JZD-EMP-LASTNAME OF EMPLOYEE WSPGEM 010690 IF EMP-LASTNAME OF EMPLOYEE = SPACES WSPGEM 010700 MOVE 'value required' TO JZ-CHAR80 WSPGEM 010710 END-IF WSPGEM 010720 END-IF. WSPGEM 010730 IF JZ-CHAR80 NOT = SPACE WSPGEM 010740 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 010750 MOVE 80 TO JZ-MLTH WSPGEM 010760 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 010770 END-IF. WSPGEM 010780* Validate IWSPGEM.JZ-EMPLOYEE.WORKDEPT, assign to WSPGEM 010790* EMPLOYEE.WORKDEPTWSPGEM 010800 MOVE SPACES TO JZ-CHAR80. WSPGEM 010810 MOVE 'WORKDEPT' TO JZ-FNAME. WSPGEM 010820 IF WORKDEPT OF IWSPGEM NOT = SPACES WSPGEM 010830 MOVE FUNCTION UPPER-CASE(WORKDEPT OF IWSPGEM) TO WORKDEPTWSPGEM 010840 OF IWSPGEM WSPGEM 010850 MOVE 3 TO InDataLth OF JZTRIM WSPGEM 010860 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 010870 CALL 'JZTrim' USING WORKDEPT OF IWSPGEM ParmIn OF JZTrim WSPGEM 010880 ParmOut of JZTrim Result OF JZTrim WSPGEM 010890 IF JZL-Result OF JZTrim > ZERO WSPGEM 010900 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 010910 EMP-WORKDEPT OF EMPLOYEE WSPGEM 010920 MOVE 0 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 010930 ELSE WSPGEM 010940 MOVE SPACES TO EMP-WORKDEPT OF EMPLOYEE WSPGEM 010950 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 010960 MOVE -1 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 010970 ELSE WSPGEM 010980 MOVE 0 TO JZB-EMP-WORKDEPT OF EMPLOYEE WSPGEM 010990 END-IF WSPGEM 011000 END-IF WSPGEM 011010 END-IF. WSPGEM 011020* Check Exists WSPGEM 011030 IF EMP-WORKDEPT OF EMPLOYEE NOT = SPACES WSPGEM 011040 IF EMP-WORKDEPT OF EMPLOYEE NOT = DEP-DEPTNO OF DEPARTMENTWSPGEM 011050 MOVE EMP-WORKDEPT OF EMPLOYEE TO DEP-DEPTNO OF WSPGEM 011060 DEPARTMENT WSPGEM 011070 EXEC SQL WSPGEM 011080 SELECT COUNT(*) INTO :JZ-SQLCOUNT FROM DEPARTMENTWSPGEM 011090 WHERE DEPTNO = :DEP-DEPTNO WSPGEM 011100 END-EXEC WSPGEM 011110 IF JZ-SQLCOUNT = ZERO WSPGEM 011120 MOVE 'VALUE DOES NOT EXIST' TO JZ-CHAR80 WSPGEM 011130 END-IF WSPGEM 011140 END-IF WSPGEM 011150 END-IF. WSPGEM 011160 IF JZ-CHAR80 NOT = SPACE WSPGEM 011170 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 011180 MOVE 80 TO JZ-MLTH WSPGEM 011190 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 011200 END-IF. WSPGEM 011210* Validate IWSPGEM.JZ-EMPLOYEE.PHONENO, assign to WSPGEM 011220* EMPLOYEE.PHONENOWSPGEM 011230 MOVE SPACES TO JZ-CHAR80. WSPGEM 011240 MOVE 'PHONENO' TO JZ-FNAME. WSPGEM 011250 IF PHONENO OF IWSPGEM NOT = SPACES WSPGEM 011260 MOVE 4 TO InDataLth OF JZTRIM WSPGEM 011270 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 011280 CALL 'JZTrim' USING PHONENO OF IWSPGEM ParmIn OF JZTrim WSPGEM 011290 ParmOut of JZTrim Result OF JZTrim WSPGEM 011300 IF JZL-Result OF JZTrim > ZERO WSPGEM 011310 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS WSPGEM 011320 NUMERIC WSPGEM 011330 COMPUTE PHONENO OF JZ = FUNCTION WSPGEM 011340 NUMVAL(JZD-Result OF JZTrim(1:JZL-Result OF WSPGEM 011350 JZTrim)) WSPGEM 011360 MOVE PHONENO OF JZ TO EMP-PHONENO OF EMPLOYEE WSPGEM 011370 MOVE 0 TO JZB-EMP-PHONENO OF EMPLOYEE WSPGEM 011380 ELSE WSPGEM 011390 MOVE 'not numeric' TO JZ-CHAR80 WSPGEM 011400 END-IF WSPGEM 011410 ELSE WSPGEM 011420 MOVE '0000' TO EMP-PHONENO OF EMPLOYEE WSPGEM 011430 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 011440 MOVE -1 TO JZB-EMP-PHONENO OF EMPLOYEE WSPGEM 011450 ELSE WSPGEM 011460 MOVE 0 TO JZB-EMP-PHONENO OF EMPLOYEE WSPGEM 011470 END-IF WSPGEM 011480 END-IF WSPGEM 011490 END-IF. WSPGEM 011500 IF JZ-CHAR80 NOT = SPACE WSPGEM 011510 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 011520 MOVE 80 TO JZ-MLTH WSPGEM 011530 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 011540 END-IF. WSPGEM 011550* Validate IWSPGEM.JZ-EMPLOYEE.HIREDATE, assign to WSPGEM 011560* EMPLOYEE.HIREDATEWSPGEM 011570 MOVE SPACES TO JZ-CHAR80. WSPGEM 011580 MOVE 'HIREDATE' TO JZ-FNAME. WSPGEM 011590 IF HIREDATE OF IWSPGEM NOT = SPACES WSPGEM 011600 MOVE 9 TO InDataLth OF JZTRIM WSPGEM 011610 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 011620 CALL 'JZTrim' USING HIREDATE OF IWSPGEM ParmIn OF JZTrim WSPGEM 011630 ParmOut of JZTrim Result OF JZTrim WSPGEM 011640 IF JZL-Result OF JZTrim > ZERO WSPGEM 011650 MOVE 'N' TO IsDateArith OF JZ WSPGEM 011660 MOVE JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) TO WSPGEM 011670 InDate OF JZ-JZDTVS WSPGEM 011680 MOVE 'dd MMM yy' TO DPic OF JZ-JZDTVS WSPGEM 011690 CALL 'JZDTVS' USING DFHEIBLK DFHCOMMAREA InDate OF WSPGEM 011700 JZ-JZDTVS DPic OF JZ-JZDTVS JZ-DateDiff OF JZ WSPGEM 011710 JZ-Error OF JZ WSPGEM 011720 PERFORM JZCheckDate WSPGEM 011730 IF JZ-CHAR80 = SPACE WSPGEM 011740 MOVE DateFormPic TO EMP-HIREDATE OF EMPLOYEE WSPGEM 011750 MOVE 0 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 011760 END-IF WSPGEM 011770 ELSE WSPGEM 011780 MOVE ZERO TO EMP-HIREDATE OF EMPLOYEE WSPGEM 011790 IF SPECIALNAME OF JZTRIM = 'NULL' WSPGEM 011800 MOVE -1 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 011810 ELSE WSPGEM 011820 MOVE 0 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 011830 END-IF WSPGEM 011840 END-IF WSPGEM 011850 END-IF. WSPGEM 011860 IF JZ-CHAR80 NOT = SPACE WSPGEM 011870 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 011880 MOVE 80 TO JZ-MLTH WSPGEM 011890 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 011900 END-IF. WSPGEM 011910 IF JZ-Error OF JZ = 'Y' WSPGEM 011920* Respond with error messages and exit program WSPGEM 011930 GO TO JZ-Normal-Exit WSPGEM 011940 END-IF. WSPGEM 011950* WSPGEM 011960* WHEN (Delete); WSPGEM 011970 JZ-57-WHEN. WSPGEM 011980* ACCEPT (EMPLOYEE.EMPNO=IWSPGEM.EMPNO) MESSAGE OWSPGEM.ERROR; WSPGEM 011990 PERFORM JZ-58-ACCEPT. WSPGEM 012000* DELETE EMPLOYEE KEY(EMPLOYEE.EMPNO) CHECKSUM WSPGEM 012010* IWSPGEM.CheckSum-EMPLOYEE;WSPGEM 012020 PERFORM JZ-59-DELETE. WSPGEM 012030* END CASE; WSPGEM 012040* WSPGEM 012050 JZ-58-ACCEPT. WSPGEM 012060* ACCEPT (EMPLOYEE.EMPNO=IWSPGEM.EMPNO) MESSAGE OWSPGEM.ERROR; WSPGEM 012070 MOVE 'N' TO JZ-Error OF JZ. WSPGEM 012080 Move SPACES TO JZD-ERROR OF OWSPGEM. WSPGEM 012090 MOVE ZERO TO JZL-ERROR OF OWSPGEM. WSPGEM 012100* Validate IWSPGEM.EMPNO, assign to EMPLOYEE.EMPNO WSPGEM 012110 MOVE SPACES TO JZ-CHAR80. WSPGEM 012120 MOVE 'EMPNO' TO JZ-FNAME. WSPGEM 012130 IF EMPNO OF IWSPGEM NOT = SPACES WSPGEM 012140 MOVE 6 TO InDataLth OF JZTRIM WSPGEM 012150 MOVE 'TRIM' TO TrimType OF JZTrim WSPGEM 012160 CALL 'JZTrim' USING EMPNO OF IWSPGEM ParmIn OF JZTrim WSPGEM 012170 ParmOut of JZTrim Result OF JZTrim WSPGEM 012180 IF JZL-Result OF JZTrim > ZERO WSPGEM 012190 IF JZD-Result OF JZTrim(1:JZL-Result OF JZTrim) IS WSPGEM 012200 NUMERIC WSPGEM 012210 COMPUTE EMPNO OF JZ = FUNCTION NUMVAL(JZD-Result WSPGEM 012220 OF JZTrim(1:JZL-Result OF JZTrim)) WSPGEM 012230 MOVE EMPNO OF JZ TO EMP-EMPNO OF EMPLOYEE WSPGEM 012240 ELSE WSPGEM 012250 MOVE 'not numeric' TO JZ-CHAR80 WSPGEM 012260 END-IF WSPGEM 012270 END-IF WSPGEM 012280 IF EMP-EMPNO OF EMPLOYEE = '000000' WSPGEM 012290 MOVE 'value required' TO JZ-CHAR80 WSPGEM 012300 END-IF WSPGEM 012310 END-IF. WSPGEM 012320 IF JZ-CHAR80 NOT = SPACE WSPGEM 012330 MOVE 'Y' TO JZ-Error OF JZ WSPGEM 012340 MOVE 80 TO JZ-MLTH WSPGEM 012350 PERFORM JZ-ADD-TO-ERR-MESSAGE WSPGEM 012360 END-IF. WSPGEM 012370 IF JZ-Error OF JZ = 'Y' WSPGEM 012380* Respond with error messages and exit program WSPGEM 012390 GO TO JZ-Normal-Exit WSPGEM 012400 END-IF. WSPGEM 012410* WSPGEM 012420 JZ-59-DELETE. WSPGEM 012430* DELETE EMPLOYEE KEY(EMPLOYEE.EMPNO) CHECKSUM WSPGEM 012440* IWSPGEM.CheckSum-EMPLOYEE;WSPGEM 012450 PERFORM JZ-EMPLOYEE-ReadBy1ryKey. WSPGEM 012460 MOVE 'Y' TO EMPLOYEE-UpdatePending-Flag. WSPGEM 012470 MOVE 79 TO JZ-INT. WSPGEM 012480 CALL 'JZHASH' USING EMPLOYEE JZ-INT CheckSum-EMPLOYEE OF WSPGEM 012490 OWSPGEM. WSPGEM 012500* Check against saved copy WSPGEM 012510 IF CheckSum-EMPLOYEE OF IWSPGEM IS NOT EQUAL TO WSPGEM 012520 CheckSum-EMPLOYEE OF OWSPGEM WSPGEM 012530 MOVE 'E' TO JZ-EMPLOYEE-ReturnCode OF OWSPGEM WSPGEM 012540 MOVE 'Record has been changed. Sorry, you need to re-applWSPGEM 012550- 'y the updates' TO JZD-ERROR OF OWSPGEM WSPGEM 012560 MOVE 64 TO JZL-ERROR OF OWSPGEM WSPGEM 012570 GO TO JZ-Normal-Exit WSPGEM 012580 END-IF. WSPGEM 012590 EXEC SQL WSPGEM 012600 DELETE EMPLOYEE WHERE EMPNO = :EMP-EMPNO WSPGEM 012610 END-EXEC. WSPGEM 012620 PERFORM EMPLOYEE-CheckStatus. WSPGEM 012630 MOVE 'N' TO EMPLOYEE-UpdatePending-Flag. WSPGEM 012640******************************************************************WSPGEM 012650** **WSPGEM 012660** CICS Support Routine **WSPGEM 012670** **WSPGEM 012680******************************************************************WSPGEM 012690******************************************************************WSPGEM 012700** **WSPGEM 012710** Code Conversion Routines **WSPGEM 012720** **WSPGEM 012730******************************************************************WSPGEM 012740* WSPGEM 012750* Convert IWSPGEM-Function code to value WSPGEM 012760 JZCvt-IWSPGEM-Function. WSPGEM 012770* Input: SEARCH-FOR OF JZCodes-IWSPGEM-Function WSPGEM 012780* Output: FOUND-VALUE OF JZCodes-IWSPGEM-Function WSPGEM 012790* If Invalid, FOUND-VALUE will be set to '****', WSPGEM 012800* field JZ-CHAR80 will contain an error message WSPGEM 012810 SET JZIX-IWSPGEM-Function TO 1. WSPGEM 012820 SEARCH ITEM-VALUES OF JZCodes-IWSPGEM-Function VARYING WSPGEM 012830 JZIX-IWSPGEM-Function WSPGEM 012840 AT END WSPGEM 012850 MOVE 'Invalid Code' TO JZ-CHAR80 WSPGEM 012860 MOVE '*******' TO FOUND-VALUE OF WSPGEM 012870 JZCodes-IWSPGEM-Function WSPGEM 012880 MOVE SPACES TO SEARCH-FOR OF JZCodes-IWSPGEM-FunctionWSPGEM 012890 WHEN JZCODE OF WSPGEM 012900 JZCodes-IWSPGEM-Function(JZIX-IWSPGEM-Function) = WSPGEM 012910 SEARCH-FOR OF JZCodes-IWSPGEM-Function WSPGEM 012920 MOVE CODE-VALUE OF WSPGEM 012930 JZCodes-IWSPGEM-Function(JZIX-IWSPGEM-Function) WSPGEM 012940 TO FOUND-VALUE OF JZCodes-IWSPGEM-Function WSPGEM 012950 END-SEARCH. WSPGEM 012960* WSPGEM 012970* Convert JZSMth-SMth code to value WSPGEM 012980 JZCvt-JZSMth-SMth. WSPGEM 012990* Input: SEARCH-FOR OF JZCodes-JZSMth-SMth WSPGEM 013000* Output: FOUND-VALUE OF JZCodes-JZSMth-SMth WSPGEM 013010* If Invalid, FOUND-VALUE will be set to '****', WSPGEM 013020* field JZ-CHAR80 will contain an error message WSPGEM 013030 SET JZIX-JZSMth-SMth TO SEARCH-FOR OF JZCodes-JZSMth-SMth. WSPGEM 013040 IF JZIX-JZSMth-SMth < 1 OR JZIX-JZSMth-SMth > 12 WSPGEM 013050 MOVE 'Outside Code Range' TO JZ-CHAR80 WSPGEM 013060 MOVE '***' TO FOUND-VALUE OF JZCodes-JZSMth-SMth WSPGEM 013070 ELSE WSPGEM 013080 MOVE CODE-Value OF JZCodes-JZSMth-SMth(JZIX-JZSMth-SMth) WSPGEM 013090 TO FOUND-VALUE OF JZCodes-JZSMth-SMth WSPGEM 013100 END-IF. WSPGEM 013110******************************************************************WSPGEM 013120** **WSPGEM 013130** Sundry Routines **WSPGEM 013140** **WSPGEM 013150******************************************************************WSPGEM 013160* WSPGEM 013170 CICS-CheckStatus. WSPGEM 013180 EVALUATE JZ-Response WSPGEM 013190 WHEN DFHRESP(NORMAL) WSPGEM 013200 WHEN DFHRESP(DUPKEY) WSPGEM 013210 CONTINUE WSPGEM 013220 WHEN OTHER WSPGEM 013230 GO TO JZ-Abend-Exit WSPGEM 013240 END-EVALUATE. WSPGEM 013250* WSPGEM 013260* Is this a leap year WSPGEM 013270 JZCheckLeapYear. WSPGEM 013280 IF FUNCTION MOD (DFYears OF JZ 4) NOT = 0 WSPGEM 013290 MOVE 'N' TO LeapYear OF JZ WSPGEM 013300 ELSE WSPGEM 013310 MOVE 'Y' TO LeapYear OF JZ WSPGEM 013320 IF FUNCTION MOD(DFYears OF JZ 100) = 0 WSPGEM 013330 IF FUNCTION MOD(DFYears OF JZ 400) NOT = 0 WSPGEM 013340 MOVE 'N' TO LeapYear OF JZ WSPGEM 013350 END-IF WSPGEM 013360 END-IF WSPGEM 013370 END-IF. WSPGEM 013380* WSPGEM 013390* Check value, format from DateDIFF to DATE WSPGEM 013400 JZCheckDate. WSPGEM 013410 MOVE 'Y' TO JZ-Error OF JZ. WSPGEM 013420 MOVE 0 TO DateFormPic OF JZ. WSPGEM 013430 IF DFOrdDays OF JZ > 0 WSPGEM 013440 IF DFOrdDays OF JZ > 366 WSPGEM 013450 MOVE 'Invalid Date' TO JZ-CHAR80 WSPGEM 013460 ELSE WSPGEM 013470 PERFORM JZOrdinalDayToGegorian WSPGEM 013480 END-IF WSPGEM 013490 END-IF. WSPGEM 013500 IF DFYears OF JZ = ZERO OR DFMonths OF JZ = ZERO OR DFDays OFWSPGEM 013510 JZ = ZERO WSPGEM 013520 MOVE 'Invalid Date' TO JZ-CHAR80 WSPGEM 013530 ELSE WSPGEM 013540 IF DFMonths OF JZ > 12 WSPGEM 013550 MOVE 'Month Invalid' TO JZ-CHAR80 WSPGEM 013560 ELSE WSPGEM 013570 IF DFDays OF JZ > MDayR OF JZMDays(DFMonths OF JZ) WSPGEM 013580 IF DFMonths OF JZ = 2 AND DFDays OF JZ = 29 WSPGEM 013590 PERFORM JZCheckLeapYear WSPGEM 013600 IF LeapYear OF JZ = 'N' WSPGEM 013610 MOVE 'Day Invalid' TO JZ-CHAR80 WSPGEM 013620 ELSE WSPGEM 013630 MOVE 'N' TO JZ-ERROR OF JZ WSPGEM 013640 END-IF WSPGEM 013650 ELSE WSPGEM 013660 MOVE 'Day Invalid' TO JZ-CHAR80 WSPGEM 013670 END-IF WSPGEM 013680 ELSE WSPGEM 013690 MOVE 'N' TO JZ-ERROR OF JZ WSPGEM 013700 END-IF WSPGEM 013710 IF JZ-ERROR OF JZ = 'N' WSPGEM 013720* Format as DATE in DateFormPic WSPGEM 013730 IF DFYears OF JZ < 100 WSPGEM 013740 IF DFYears OF JZ > 40 WSPGEM 013750 ADD 1900 TO DFYears OF JZ WSPGEM 013760 ELSE WSPGEM 013770 ADD 2000 TO DFYears OF JZ WSPGEM 013780 END-IF WSPGEM 013790 END-IF WSPGEM 013800 MOVE DFYears OF JZ TO DateFormCYear OF JZ WSPGEM 013810 MOVE DFMonths OF JZ TO DateFormMth OF JZ WSPGEM 013820 MOVE DFDays OF JZ TO DateFormDay OF JZ WSPGEM 013830 END-IF WSPGEM 013840 END-IF WSPGEM 013850 END-IF. WSPGEM 013860* WSPGEM 013870* Convert Ordinal Day to Months and Days WSPGEM 013880 JZOrdinalDayToGegorian. WSPGEM 013890* Input: DFOrdDays OF JZ, Output JZMonths,JZDays OF JZ WSPGEM 013900* Test For Leap year WSPGEM 013910 IF DFOrdDays OF JZ > 59 WSPGEM 013920 PERFORM JZCheckLeapYear WSPGEM 013930 IF LeapYear OF JZ = 'Y' WSPGEM 013940 SUBTRACT 1 FROM DFOrdDays OF JZ WSPGEM 013950 END-IF WSPGEM 013960 END-IF. WSPGEM 013970 PERFORM VARYING DFMonths OF JZ FROM 1 BY 1 UNTIL DFMonths OF WSPGEM 013980 JZ > 12 OR CDayR OF JZMDays(DFMonths OF JZ) >= DFOrdDaysWSPGEM 013990 OF JZ WSPGEM 014000 END-PERFORM. WSPGEM 014010 IF DFMonths OF JZ < 13 WSPGEM 014020 IF DFMonths OF JZ > 1 WSPGEM 014030 IF DFOrdDays OF JZ = 59 AND LeapYear OF JZ = 'Y' WSPGEM 014040 ADD 1 TO DFOrdDays OF JZ WSPGEM 014050 END-IF WSPGEM 014060 COMPUTE JZ-IXMth = DFMonths OF JZ - 1 WSPGEM 014070 SUBTRACT CDayR OF JZMDays(JZ-IXMth) FROM DFOrdDays OF JZWSPGEM 014080 END-IF WSPGEM 014090 MOVE DFOrdDays OF JZ TO DFDays OF JZ WSPGEM 014100 END-IF. WSPGEM 014110* WSPGEM 014120 EMPLOYEE-FreeKey-SET. WSPGEM 014130* Set EMPLOYEE.$FreeKey WSPGEM 014140* SQL logic: find last record, set key to next value WSPGEM 014150 EXEC SQL WSPGEM 014160 SELECT EMPNO INTO :EMP-EMPNO FROM EMPLOYEE ORDER BY EMPNOWSPGEM 014170 DESC FETCH FIRST ROW ONLY WSPGEM 014180 END-EXEC. WSPGEM 014190* Set key to next value WSPGEM 014200 MOVE 6 TO JZL-JZNXTKY6 OF JZ. WSPGEM 014210 MOVE EMP-EMPNO OF EMPLOYEE TO JZD-JZNXTKY6 OF JZ. WSPGEM 014220 CALL 'JZNXTKY' USING JZNXTKY6 OF JZ. WSPGEM 014230 MOVE JZD-JZNXTKY6 OF JZ TO EMP-EMPNO OF EMPLOYEE. WSPGEM 014240* WSPGEM 014250 JZ-EMPLOYEE-ReadBy1ryKey. WSPGEM 014260 MOVE SPACES TO JZD-EMP-FIRSTNME OF EMPLOYEE WSPGEM 014270 MOVE SPACES TO JZD-EMP-LASTNAME OF EMPLOYEE WSPGEM 014280 EXEC SQL WSPGEM 014290 SELECT EMPNO, FIRSTNME, LASTNAME, WORKDEPT, PHONENO, WSPGEM 014300 CAST(HIREDATE AS INTEGER) INTO :EMP-EMPNO, WSPGEM 014310 :EMP-FIRSTNME, :EMP-LASTNAME, WSPGEM 014320 :EMP-WORKDEPT:JZB-EMP-WORKDEPT, WSPGEM 014330 :EMP-PHONENO:JZB-EMP-PHONENO, WSPGEM 014340 :EMP-HIREDATE:JZB-EMP-HIREDATE FROM EMPLOYEE WHERE WSPGEM 014350 EMPNO = :EMP-EMPNO WSPGEM 014360 END-EXEC. WSPGEM 014370 IF SQLCODE NOT = 0 WSPGEM 014380 MOVE 'N' TO EMPLOYEE-Found-Flag WSPGEM 014390 PERFORM EMPLOYEE-Initialize WSPGEM 014400 ELSE WSPGEM 014410 MOVE 'Y' TO EMPLOYEE-Found-Flag WSPGEM 014420* Set value fields for any Null fields retrieved WSPGEM 014430 IF JZB-EMP-WORKDEPT OF EMPLOYEE < 0 WSPGEM 014440 MOVE SPACES TO EMP-WORKDEPT OF EMPLOYEE WSPGEM 014450 END-IF WSPGEM 014460 IF JZB-EMP-PHONENO OF EMPLOYEE < 0 WSPGEM 014470 MOVE ZERO TO EMP-PHONENO OF EMPLOYEE WSPGEM 014480 END-IF WSPGEM 014490 IF JZB-EMP-HIREDATE OF EMPLOYEE < 0 WSPGEM 014500 MOVE ZERO TO EMP-HIREDATE OF EMPLOYEE WSPGEM 014510 END-IF WSPGEM 014520 END-IF. WSPGEM 014530* WSPGEM 014540 EMPLOYEE-Initialize. WSPGEM 014550* Initialize non-key fields WSPGEM 014560 Move SPACES TO JZD-EMP-FIRSTNME OF EMPLOYEE. WSPGEM 014570 MOVE ZERO TO JZL-EMP-FIRSTNME OF EMPLOYEE. WSPGEM 014580 Move SPACES TO JZD-EMP-LASTNAME OF EMPLOYEE. WSPGEM 014590 MOVE ZERO TO JZL-EMP-LASTNAME OF EMPLOYEE. WSPGEM 014600 Move SPACES TO EMP-WORKDEPT OF EMPLOYEE. WSPGEM 014610 MOVE -1 TO JZB-EMP-WORKDEPT OF EMPLOYEE. WSPGEM 014620 Move '0000' TO EMP-PHONENO OF EMPLOYEE. WSPGEM 014630 MOVE -1 TO JZB-EMP-PHONENO OF EMPLOYEE. WSPGEM 014640 Move ZERO TO EMP-HIREDATE OF EMPLOYEE. WSPGEM 014650 MOVE -1 TO JZB-EMP-HIREDATE OF EMPLOYEE. WSPGEM 014660* WSPGEM 014670 JZ-EMPLOYEE-CopyTo-OWSPGEM. WSPGEM 014680* Move EMPLOYEE to OWSPGEM if there is room WSPGEM 014690 IF JZ-EMPLOYEE-NbrReturned OF OWSPGEM IS LESS THAN 1 WSPGEM 014700 ADD 1 TO JZ-EMPLOYEE-NbrReturned OF OWSPGEM WSPGEM 014710 SET JZIX2 TO JZ-EMPLOYEE-NbrReturned OF OWSPGEM WSPGEM 014720* Generic MOVE WSPGEM 014730 MOVE EMP-EMPNO OF EMPLOYEE TO EMPNO OF OWSPGEM (JZIX2) WSPGEM 014740 MOVE EMP-FIRSTNME OF EMPLOYEE TO FIRSTNME OF OWSPGEM (JZIX2)WSPGEM 014750 MOVE EMP-LASTNAME OF EMPLOYEE TO LASTNAME OF OWSPGEM (JZIX2)WSPGEM 014760 MOVE EMP-WORKDEPT OF EMPLOYEE TO WORKDEPT OF OWSPGEM (JZIX2)WSPGEM 014770 MOVE EMP-PHONENO OF EMPLOYEE TO PHONENO OF OWSPGEM (JZIX2)WSPGEM 014780 MOVE EMP-HIREDATE OF EMPLOYEE TO HIREDATE OF OWSPGEM (JZIX2)WSPGEM 014790 ELSE WSPGEM 014800 MOVE 'Y' TO EMPLOYEE-ENDFILE WSPGEM 014810 END-IF. WSPGEM 014820* WSPGEM 014830 EMPLOYEE-Update. WSPGEM 014840 IF EMPLOYEE-UpdatePending WSPGEM 014850 MOVE 'N' TO EMPLOYEE-UpdatePending-Flag WSPGEM 014860 IF EMP-HIREDATE OF EMPLOYEE = ZERO WSPGEM 014870 MOVE -1 TO JZB-EMP-HIREDATE OF EMPLOYEE WSPGEM 014880 END-IF WSPGEM 014890 MOVE EMP-HIREDATE OF EMPLOYEE TO JZSQLDate1N WSPGEM 014900 MOVE '-' TO JZSQLDate1(5:1) WSPGEM 014910 MOVE '-' TO JZSQLDate1(8:1) WSPGEM 014920 IF EMP-BIRTHDATE OF EMPLOYEE = ZERO WSPGEM 014930 MOVE -1 TO JZB-EMP-BIRTHDATE OF EMPLOYEE WSPGEM 014940 END-IF WSPGEM 014950 MOVE EMP-BIRTHDATE OF EMPLOYEE TO JZSQLDate2N WSPGEM 014960 MOVE '-' TO JZSQLDate2(5:1) WSPGEM 014970 MOVE '-' TO JZSQLDate2(8:1) WSPGEM 014980 IF EMPLOYEE-FOUND WSPGEM 014990 EXEC SQL WSPGEM 015000 UPDATE EMPLOYEE SET EMPNO = :EMP-EMPNO, FIRSTNME WSPGEM 015010 = :EMP-FIRSTNME, LASTNAME = :EMP-LASTNAME, WSPGEM 015020 WORKDEPT = :EMP-WORKDEPT:JZB-EMP-WORKDEPT, WSPGEM 015030 PHONENO = :EMP-PHONENO:JZB-EMP-PHONENO, WSPGEM 015040 HIREDATE = :JZSQLDate1:JZB-EMP-HIREDATE WHEREWSPGEM 015050 EMPNO = :EMP-EMPNO WSPGEM 015060 END-EXEC WSPGEM 015070 ELSE WSPGEM 015080 EXEC SQL WSPGEM 015090 INSERT INTO EMPLOYEE (EMPNO, FIRSTNME, MIDINIT, WSPGEM 015100 LASTNAME, WORKDEPT, PHONENO, HIREDATE, JOB, WSPGEM 015110 EDLEVEL, SEX, BIRTHDATE, SALARY, BONUS, COMM)WSPGEM 015120 VALUES (:EMP-EMPNO, :EMP-FIRSTNME, WSPGEM 015130 :EMP-MIDINIT:JZB-EMP-MIDINIT, :EMP-LASTNAME, WSPGEM 015140 :EMP-WORKDEPT:JZB-EMP-WORKDEPT, WSPGEM 015150 :EMP-PHONENO:JZB-EMP-PHONENO, WSPGEM 015160 :JZSQLDate1:JZB-EMP-HIREDATE, WSPGEM 015170 :EMP-JOB:JZB-EMP-JOB, :EMP-EDLEVEL, WSPGEM 015180 :EMP-SEX:JZB-EMP-SEX, WSPGEM 015190 :JZSQLDate2:JZB-EMP-BIRTHDATE, WSPGEM 015200 :EMP-SALARY:JZB-EMP-SALARY, WSPGEM 015210 :EMP-BONUS:JZB-EMP-BONUS, WSPGEM 015220 :EMP-COMM:JZB-EMP-COMM) WSPGEM 015230 END-EXEC WSPGEM 015240 END-IF WSPGEM 015250 IF SQLCODE NOT = ZERO WSPGEM 015260* SQL UPDATE/INSERT FAILED WSPGEM 015270 GO TO JZ-Abend-Exit WSPGEM 015280 ELSE WSPGEM 015290 MOVE 'SQL UPDATE/INSERT SUCCESSFUL' TO JZD-ERROR OF WSPGEM 015300 OWSPGEM WSPGEM 015310 MOVE 28 TO JZL-ERROR OF OWSPGEM WSPGEM 015320 END-IF WSPGEM 015330 END-IF. WSPGEM 015340* WSPGEM 015350 EMPLOYEE-CheckStatus. WSPGEM 015360 EVALUATE JZ-Response WSPGEM 015370 WHEN DFHRESP(NORMAL) WSPGEM 015380 WHEN DFHRESP(DUPKEY) WSPGEM 015390 CONTINUE WSPGEM 015400* GET and DELETE: check that record found WSPGEM 015410 WHEN DFHRESP(NOTFND) WSPGEM 015420 MOVE 'N' TO EMPLOYEE-Found-Flag WSPGEM 015430* Process (Browse): check for Endfile WSPGEM 015440 WHEN DFHRESP(ENDFILE) WSPGEM 015450 MOVE 'Y' TO EMPLOYEE-ENDFILE WSPGEM 015460 WHEN OTHER WSPGEM 015470 GO TO JZ-Abend-Exit WSPGEM 015480 END-EVALUATE. WSPGEM 015490* WSPGEM 015500 JZ-ADD-TO-ERR-MESSAGE. WSPGEM 015510* Add JZ-CHAR80 to ERROR if there is room WSPGEM 015520 IF JZL-ERROR OF OWSPGEM > 0 AND JZL-ERROR OF OWSPGEM < 78 WSPGEM 015530 MOVE '; ' TO JZD-ERROR OF OWSPGEM(JZL-ERROR OF OWSPGEM + WSPGEM 015540 1:2) WSPGEM 015550 ADD 2 TO JZL-ERROR OF OWSPGEM WSPGEM 015560 END-IF. WSPGEM 015570* Set JZ-Index to length of field name WSPGEM 015580 PERFORM VARYING JZ-INDEX FROM 30 BY -1 UNTIL JZ-INDEX <= 1 ORWSPGEM 015590 JZ-FNAME (JZ-INDEX:1) NOT = SPACE WSPGEM 015600 END-PERFORM. WSPGEM 015610 IF JZ-INDEX + JZL-ERROR OF OWSPGEM > 79 WSPGEM 015620 COMPUTE JZ-INDEX = 79 - JZL-ERROR OF OWSPGEM WSPGEM 015630 END-IF. WSPGEM 015640 IF JZ-INDEX < 0 WSPGEM 015650 MOVE 0 TO JZ-INDEX WSPGEM 015660 END-IF. WSPGEM 015670 STRING JZ-FNAME(1:JZ-INDEX) ':' DELIMITED BY SIZE INTO WSPGEM 015680 JZD-ERROR OF OWSPGEM(JZL-ERROR OF OWSPGEM + 1:JZ-INDEX). WSPGEM 015690 ADD JZ-INDEX TO JZL-ERROR OF OWSPGEM. WSPGEM 015700 ADD 1 TO JZL-ERROR OF OWSPGEM. WSPGEM 015710* Set JZ-Index to length to be added WSPGEM 015720 PERFORM VARYING JZ-INDEX FROM 80 BY -1 UNTIL JZ-INDEX <= 1 ORWSPGEM 015730 JZ-CHAR80 (JZ-INDEX:1) NOT = SPACE WSPGEM 015740 END-PERFORM. WSPGEM 015750* Calculate Available Length WSPGEM 015760 COMPUTE JZ-AL = 80 - JZL-ERROR OF OWSPGEM. WSPGEM 015770 IF JZ-AL < JZ-INDEX WSPGEM 015780 MOVE JZ-AL TO JZ-INDEX WSPGEM 015790 END-IF. WSPGEM 015800 IF JZ-INDEX < 0 WSPGEM 015810 MOVE 0 TO JZ-INDEX WSPGEM 015820 MOVE '**' TO JZD-ERROR OF OWSPGEM(78:2) WSPGEM 015830 ELSE WSPGEM 015840 MOVE JZ-CHAR80(1:JZ-INDEX) TO JZD-ERROR OF WSPGEM 015850 OWSPGEM(JZL-ERROR OF OWSPGEM + 1:JZ-INDEX) WSPGEM 015860 ADD JZ-INDEX TO JZL-ERROR OF OWSPGEM WSPGEM 015870 END-IF. WSPGEM