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