000100 Identification Division. 000200 Program-Id. ED06PGM. 000300*----------------------------------------------------- 000400* This is a sample solution to Exercise 6 000500* the Presentation Program 000600*----------------------------------------------------- 000700 Data Division. 000800 Working-Storage Section. 000900 Copy DFHAID. 001000 Copy EDMAP2. 001100 02 MyMessage Redefines MSGO Pic X(60). 001200 88 Msg-InvalidPFK Value 'Invalid PF-key pressed'. 001300 88 Msg-ReadEdempErr Value 'Employee not found'. 001400 88 Msg-EmpnoMissing Value 'Employee no missing'. 001500 88 Msg-EmpnoNotNum Value 'Employee no not numeric'. 001600 88 Msg-EmpRecNotfnd Value 'Employee record not found'. 001700 88 Msg-DBReadError Value 'DBRead returned error'. 001800 88 Msg-DBReadOK Value 'This is requested record'. 001900 88 Msg-DBUpdateError Value 'DBUpdate returned error'. 002000 88 Msg-DBUpdateOK Value 'Update normal'. 002100 88 Msg-DBDeleteError Value 'DBDelete returned error'. 002200 88 Msg-DBDeleteOK Value 'Delete normal'. 002300 88 Msg-DBAddError Value 'DBAdd returned error'. 002400 88 Msg-DBAddOK Value 'Add normal'. 002500 88 Msg-DBAddDuprec Value 'Add duplicate empno'. 002600 88 Msg-DBAddInputError Value 'Invalid field value((s)'. 002700 002800 002900 77 MyEmpno Pic X(05). 003000 77 MyResp Pic S9(08) Binary. 003100 77 MyTransid Pic X(04) Value 'ED06'. 003200 77 MyMenuPgm Pic X(08) Value 'ED03PGM'. 003300 77 MyDBPgm Pic X(08) Value 'ED0DB1B'. 003400 77 Switches Pic 9(01) Value 0. 003500 88 Indata-ERR Value 0. 003600 88 Indata-OK Value 1. 003700 003800 Linkage Section. 003900 004000 01 DFHCOMMAREA. 004100 05 MyDBRequest Pic 9(01). 004200 88 DBRead Value 1. 004300 88 DBUpdate Value 2. 004400 88 DBDelete Value 3. 004500 88 DBAdd Value 4. 004600 004700 05 MyDBResponse Pic 9(02). 004800 88 DBReadOK Value 10. 004900 88 DBReadNotfnd Value 11. 005000 88 DBReadError Value 19. 005100 005200 88 DBUpdateOK Value 20. 005300 88 DBUpdateNotfnd Value 21. 005400 88 DBUpdateError Value 29. 005500 005600 88 DBDeleteOK Value 30. 005700 88 DBDeleteNotfnd Value 31. 005800 88 DBDeleteError Value 39. 005900 006000 88 DBAddOK Value 40. 006100 88 DBAddDuprec Value 41. 006200 88 DBAddError Value 49. 006300 006400 88 DBRequestError Value 99. 006500 88 DBRequestNormal Value 00. 006600 006700 05 MyDBRecord. 006800 10 Empno Pic X(05). 006900 10 Ssno Pic X(10). 007000 10 Fname Pic X(20). 007100 10 Lname Pic X(20). 007200 10 Dpt Pic X(05). 007300 10 Pic X(20). 007400 007500 Procedure Division. 007600 Evaluate True 007700 When EIBCALEN = 0 007800 Perform InitVars 007900 Perform Send-Maponly 008000 Perform Return-Transid-Commarea 008100 When EIBAID = DFHPF3 008200 When EIBAID = DFHCLEAR 008300 Perform XCTL-Program 008400 When EIBAID = DFHPF1 008500 Perform Send-MapEraseAup 008600 When EIBAID = DFHENTER 008700 Perform Receive-Map 008800 Perform Validate-Indata 008900 If Indata-OK 009000 Perform ReadEdemp 009100 End-If 009200 When EIBAID = DFHPF5 and DBReadOK 009300 Perform Receive-Map 009400 Perform Validate-Indata 009500 If Indata-OK 009600 Perform UpdateEdemp 009700 End-If 009800 When EIBAID = DFHPF6 009900 Perform Receive-Map 010000 Perform AddEdemp 010100 When EIBAID = DFHPF7 and DBReadOK 010200 Perform DeleteEdemp 010300 When Other 010400 Set Msg-InvalidPFK to True 010500 End-Evaluate 010600 Perform Send-Mapdataonly 010700 Perform Return-Transid-Commarea 010800 . 010900*-------------------------------------------- 011000 InitVars. 011100*-------------------------------------------- 011200 Exec CICS Getmain 011300 Length(Length of DFHCOMMAREA) 011400 Set(Address of DFHCOMMAREA) 011500 End-Exec 011600 Move Low-Value to EDMAP2O 011700 Initialize DFHCOMMAREA 011800 . 011900*-------------------------------------------- 012000 XCTL-Program. 012100*-------------------------------------------- 012200 Exec CICS 012300 XCTL 012400 Program(MyMenuPgm) 012500 End-Exec 012600 . 012700*-------------------------------------------- 012800 Return-Transid-Commarea. 012900*-------------------------------------------- 013000 Exec CICS 013100 Return 013200 Transid(MyTransid) 013300 Commarea(DFHCOMMAREA) 013400 End-Exec 013500 . 013600*-------------------------------------------- 013700 Send-MapEraseAup. 013800*-------------------------------------------- 013900 Exec CICS 014000 Send Control 014100 EraseAup 014200 Freekb 014300 End-Exec 014400 Move Low-Value to EDMAP2O 014500 Move Space to MSGO 014600 Move Low-Value to DFHCOMMAREA 014700 . 014800*-------------------------------------------- 014900 Send-Maponly. 015000*-------------------------------------------- 015100 Exec CICS 015200 Send 015300 Map('EDMAP2') 015400 Maponly 015500 Erase 015600 Freekb 015700 End-Exec 015800 . 015900*-------------------------------------------- 016000 Send-Mapdataonly. 016100*-------------------------------------------- 016200 Exec CICS 016300 Send 016400 Map('EDMAP2') 016500 Dataonly 016600 Freekb 016700 EraseAup 016800 End-Exec 016900 . 017000*-------------------------------------------- 017100 Receive-Map. 017200*-------------------------------------------- 017300 Exec CICS 017400 Receive 017500 Map('EDMAP2') 017600 Resp(MyResp) 017700 End-Exec 017800 . 017900*-------------------------------------------- 018000 ReadEdemp. 018100*-------------------------------------------- 018200 Initialize DFHCOMMAREA 018300 Move EmpnoI to Empno in MyDBRecord 018400 Set DBRead to True 018500 Exec CICS 018600 Link 018700 Program(MyDBPgm) 018800 Commarea(DFHCOMMAREA) 018900 End-Exec 019000 Move Low-Value to EDMAP2O 019100 Evaluate True 019200 When DBReadOK 019300 Move MyEmpno to EmpnoO 019400 Move Ssno to SsnoO 019500 Move Fname to FnameO 019600 Move Lname to LnameO 019700 Move Dpt to DptO 019800 Set MSG-DBReadOK to True 019900 When DBReadNotfnd 020000 Move MyEMpno to EmpnoO 020100 Set Msg-EmprecNotfnd to True 020200 When Other 020300 Set Msg-DBReadError to True 020400 End-Evaluate 020500 . 020600*-------------------------------------------- 020700 AddEdemp. 020800*-------------------------------------------- 020900 If EmpnoL = 0 or 021000 SsnoL = 0 or 021100 FnameL = 0 or 021200 LnameL = 0 or 021300 DptL = 0 021400 Set MSG-DBAddInputError to True 021500 Else 021600 Move EmpnoI to Empno in MyDBRecord 021700 Move SsnoI to SSno in MyDBRecord 021800 Move FnameI to Fname in MyDBRecord 021900 Move LnameI to Lname in MyDBRecord 022000 Move DptI to Dpt in MyDBRecord 022100 Set DBAdd to True 022200 Exec CICS 022300 Link 022400 Program(MyDBPgm) 022500 Commarea(DFHCOMMAREA) 022600 End-Exec 022700 Move Low-Value to EDMAP2O 022800 Evaluate True 022900 When DBAddOK 023000 Set MSG-DBAddOK to True 023100 When DBAddDuprec 023200 Set MSG-DBAddDuprec to True 023300 When Other 023400 Set Msg-DBAddError to True 023500 End-Evaluate 023600 End-If 023700 . 023800*-------------------------------------------- 023900 UpdateEdemp. 024000*-------------------------------------------- 024100 If SsnoL Not = 0 024200 Move SsnoI to SSno in MyDBRecord 024300 End-If 024400 If FnameL Not = 0 024500 Move FnameI to Fname in MyDBRecord 024600 End-If 024700 If LnameL Not = 0 024800 Move LnameI to Lname in MyDBRecord 024900 End-If 025000 If DptL Not = 0 025100 Move DptI to Dpt in MyDBRecord 025200 End-If 025300 Move MyEmpno to Empno in MyDBRecord 025400 Set DBUpdate to True 025500 Exec CICS 025600 Link 025700 Program(MyDBPgm) 025800 Commarea(DFHCOMMAREA) 025900 End-Exec 026000 Move Low-Value to EDMAP2O 026100 Evaluate True 026200 When DBUpdateOK 026300 Move MyEmpno to EmpnoO 026400 Move Ssno to SsnoO 026500 Move Fname to FnameO 026600 Move Lname to LnameO 026700 Move Dpt to DptO 026800 Set MSG-DBUpdateOK to True 026900 When Other 027000 Set Msg-DBUpdateError to True 027100 End-Evaluate 027200 . 027300*-------------------------------------------- 027400 DeleteEdemp. 027500*-------------------------------------------- 027600 Initialize DFHCOMMAREA 027700 Move MyEmpno to Empno in MyDBRecord 027800 Set DBDelete to True 027900 Exec CICS 028000 Link 028100 Program(MyDBPgm) 028200 Commarea(DFHCOMMAREA) 028300 End-Exec 028400 Move Low-Value to EDMAP2O 028500 Evaluate True 028600 When DBDeleteOK 028700 Set MSG-DBDeleteOK to True 028800 When DBDeleteNotFnd 028900 Move MyEMpno to EmpnoO 029000 Set Msg-EmprecNotfnd to True 029100 When Other 029200 Set Msg-DBDeleteError to True 029300 End-Evaluate 029400 . 029500*-------------------------------------------- 029600 Validate-Indata. 029700*-------------------------------------------- 029800 Evaluate True 029900 When EmpnoL = 0 030000 Set Msg-EmpnoMissing to True 030100 When EmpnoI Not Numeric 030200 Set Msg-EmpnoNotNum to True 030300 When Other 030400 Move EmpnoI to MyEmpno 030500 Set Indata-OK to True 030600 End-Evaluate 030700 . 030800*-------------------------------------------- 030900 End Program ED06PGM. 031000*--------------------------------------------