000100 Identification Division.
000200 Program-Id. ED04PGM.
000300*-------------------------------------------------------
000400* This is a sample solution to exercise 4 using VSAM
000500*-------------------------------------------------------
000600 Data Division.
000700 Working-Storage Section.
000800     Copy DFHAID.
000900     Copy EDMAP2.
001000     02 MyMessage  Redefines MSGO Pic X(50).
001100        88 InvalidPFK   Value 'Invalid PF-key pressed'.
001200        88 EmpnoMissing Value 'Employee no missing'.
001300        88 EmpnoNotNum  Value 'Employee no not numeric'.
001400        88 EmpRecNotfnd Value 'Employee record not found'.
001500
001600 01 Ws-Commarea    Pic X(01).
001700
001800 01 Edemp-Record.
001900     05 Empno      Pic X(05).
002000     05 Ssno       Pic X(10).
002100     05 Fname      Pic X(20).
002200     05 Lname      Pic X(20).
002300     05 Dpt        Pic X(05).
002400     05            Pic X(20).
002500
002600 77 MyEmpno        Pic X(05).
002700 77 MyResp         Pic S9(08) Binary.
002800 77 MyTransid      Pic X(04) Value 'ED04'.
002900 77 MyMenuPgm      Pic X(08) Value 'ED03PGM'.
003000 77 MyEdempFile    Pic X(08) Value 'EDEMP0'.
003100 77 Switches       Pic 9(01) Value 0.
003200    88 Indata-ERR    Value 0.
003300    88 Indata-OK     Value 1.
003400
003500 Procedure Division.
003600     Perform InitVars
003700     Evaluate True
003800        When EIBCALEN = 0
003900             Perform Send-Maponly
004000             Perform Return-Transid-Commarea
004100        When EIBAID = DFHPF3
004200        When EIBAID = DFHCLEAR
004300             Perform XCTL-Program
004400        When EIBAID = DFHPF1
004500             Perform Send-MapEraseAup
004600        When EIBAID = DFHENTER
004700             Perform Receive-Map
004800             Perform Validate-Indata
004900             If Indata-OK
005000                Perform ReadEdemp
005100             End-If
005200        When Other
005300             Set InvalidPFK to True
005400     End-Evaluate
005500     Perform Send-Mapdataonly
005600     Perform Return-Transid-Commarea
005700     .
005800*--------------------------------------------
005900 InitVars.
006000*--------------------------------------------
006100     Move Low-Value to EDMAP2O
006200     .
006300*--------------------------------------------
006400 XCTL-Program.
006500*--------------------------------------------
006600     Exec CICS
006700          XCTL
006800          Program(MyMenuPgm)
006900     End-Exec
007000     .
007100*--------------------------------------------
007200 Return-Transid-Commarea.
007300*--------------------------------------------
007400     Exec CICS
007500          Return
007600          Transid(MyTransid)
007700          Commarea(Ws-Commarea)
007800     End-Exec
007900     .
008000*--------------------------------------------
008100 Send-MapEraseAup.
008200*--------------------------------------------
008300     Exec CICS
008400          Send Control
008500          EraseAup
008600          Freekb
008700     End-Exec
008800     Move Low-Value to EDMAP2O
008900     Move Space to MSGO
009000     .
009100*--------------------------------------------
009200 Send-Maponly.
009300*--------------------------------------------
009400     Exec CICS
009500          Send
009600          Map('EDMAP2')
009700          Maponly
009800          Erase
009900          Freekb
010000     End-Exec
010100     .
010200*--------------------------------------------
010300 Send-Mapdataonly.
010400*--------------------------------------------
010500     Exec CICS
010600          Send
010700          Map('EDMAP2')
010800          Dataonly
010900          Freekb
011000          EraseAup
011100     End-Exec
011200     .
011300*--------------------------------------------
011400 Receive-Map.
011500*--------------------------------------------
011600     Exec CICS
011700          Receive
011800          Map('EDMAP2')
011900          Resp(MyResp)
012000     End-Exec
012100     .
012200*--------------------------------------------
012300 ReadEdemp.
012400*--------------------------------------------
012500     Exec CICS
012600          Read
012700          File(MyEdempFile)
012800          Into(Edemp-Record)
012900          Ridfld(MyEmpno)
013000          Resp(MyResp)
013100     End-Exec
013200     Move Low-Value to EDMAP2O
013300     If MyResp = DFHRESP(NOTFND)
013400        Move MyEMpno   to EmpnoO
013500        Set EmprecNotfnd to True
013600     Else
013700        Move MyEmpno    to EmpnoO
013800        Move Ssno       to SsnoO
013900        Move Fname      to FnameO
014000        Move Lname      to LnameO
014100        Move Dpt        to DptO
014200     End-If
014300     .
014400*--------------------------------------------
014500 Validate-Indata.
014600*--------------------------------------------
014700      Evaluate True
014800         When EmpnoL = 0
014900              Set  EmpnoMissing to True
015000         When EmpnoI  Not Numeric
015100              Set EmpnoNotNum to True
015200         When Other
015300              Move EmpnoI to MyEmpno
015400              Set Indata-OK to True
015500      End-Evaluate
015600     .