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