000100 Identification Division.
000200 Program-Id. ED0DB1A.
000300*-----------------------------------------------------
000400* This is a sample solution to Exercise 5
000500* the Database Program using VSAM
000600*-----------------------------------------------------
000700 Data Division.
000800 Working-Storage Section.
000900 77 MyResp         Pic S9(08) Binary.
001000 77 MyEdempfile    Pic x(08) Value 'EDEMP0'.
001100
001200 Linkage Section.
001300 01 DFHCOMMAREA.
001400     05 MyDBRequest Pic 9(01).
001500        88 DBRead   Value 1.
001600
001700     05 MyDBResponse Pic 9(02).
001800        88 DBReadOK       Value 11.
001900        88 DBReadNotfnd   Value 12.
002000        88 DBReadError    Value 19.
002100        88 DBRequestError Value 99.
002200
002300     05 MyDBRecord.
002400        10 Empno   Pic X(05).
002500        10 Ssno    Pic X(10).
002600        10 Fname   Pic X(20).
002700        10 Lname   Pic X(20).
002800        10 Dpt     Pic X(05).
002900        10         Pic X(20).
003000     05            Pic X(20).
003100
003200 Procedure Division.
003300     Evaluate True
003400        When DBRead
003500           Perform MyDBRead
003600        When Other
003700           Set DBRequestError to True
003800     End-Evaluate
003900     Exec CICS
004000          Return
004100     End-Exec
004200     .
004300*--------------------------------------------
004400 MyDBRead.
004500*--------------------------------------------
004600     Exec CICS
004700          Read
004800          File(MyEdempFile)
004900          Into(MyDBRecord)
005000          Ridfld(Empno)
005100          Resp(MyResp)
005200     End-Exec
005300     Evaluate True
005400        When Myresp = DFHRESP(NORMAL)
005500           Set DBReadOK to True
005600        When Myresp = DFHRESP(NOTFND)
005700           Set DBReadNotFnd to True
005800        When Other
005900           Set DBReadError to True
006000     End-Evaluate
006100     .
006200*--------------------------------------------
006300 End Program ED0DB1A.
006400*--------------------------------------------