000100 Identification Division.
000200 Program-Id. ED08PGM.
000300*--------------------------------------------------
000400* This is a sample solution for Exercise 8
000500* Paging using temporary storage and VSAM
000600* Mapset: EDMAP3  COPYBOOK: EDMAP3X
000700* Map:    EDMAP3  Max number of rows: 9
000800*--------------------------------------------------
000900 Data Division.
001000 Working-Storage Section.
001100     Copy DFHAID.
001200     Copy EDMAP3X.
001300
001400 01 WS-Commarea.
001500    05 Page-No     Pic S9(04) Binary Value 0.
001600    05 Page-Maxno  Pic S9(04) Binary.
001700
001800 01 MyDBRecord.
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 01 Messages.
002700    05 MyMessage  Pic X(40).
002800
002900 77           Pic 9(01)  Value 0.
003000    88 NoMoreRecords     Value 1.
003100
003200 77 MyMenuProgram Pic X(08) Value 'ED03PGM'.
003300 77 MyEdempFile   Pic X(08) Value 'EDEMP0'.
003400 77 MyStartKey    Pic X(05) Value '00000'.
003500 77 MyResp        Pic S9(08) Binary.
003600
003700 77 Pageno    Pic 9(02) Value 0.
003800
003900 77 Rowno     Pic 9(02)  Value 0.
004000    88 Rowmax            Value 10.
004100
004200 Linkage Section.
004300 01 DFHCOMMAREA  Pic S9(08) Binary.
004400
004500 Procedure Division.
004600     If EIBCALEN = 0
004700        Perform Init1
004800        Perform Edemp-StartBrowse
004900        Perform Until NoMoreRecords
005000           Perform Edemp-Readnext
005100        End-Perform
005200        Move 1 to Page-No
005300        Perform Get-Page-TS
005400        Perform Send-Page-Map
005500     Else
005600        Perform Init2
005700        Evaluate True
005800           When EIBAID = DFHCLEAR
005900           When EIBAID = DFHPF3
006000              Perform Return-Menu-Program
006100           When EIBAID = DFHPF8
006200              Add 1 to Page-No
006300              If Page-No Not > Page-Maxno
006400                 Perform Get-Page-TS
006500                 Perform Send-Page-Map
006600              Else
006700                 Move Page-Maxno to Page-No
006800              End-If
006900           When EIBAID = DFHPF7
007000              If Page-No > 1
007100                 Subtract 1 from Page-No
007200                 Perform Get-Page-TS
007300                 Perform Send-Page-Map
007400              End-If
007500        End-Evaluate
007600     End-If
007700     Perform Return-Transid-Commarea
007800     .
007900*-------------------------------------------------
008000 Edemp-Readnext.
008100*-------------------------------------------------
008200     Exec CICS
008300          Readnext
008400          File(MyEdempFile)
008500          Ridfld(MyStartKey)
008600          Into(MyDBRecord)
008700          Resp(MyResp)
008800     End-Exec
008900
009000     If MyResp = DFHRESP(ENDFILE)
009100        Set NoMoreRecords to True
009200        Perform Save-Page-TS
009300     Else
009400        Perform Move-To-MAp
009500     End-If
009600     .
009700*-------------------------------------------------
009800 Edemp-Startbrowse.
009900*-------------------------------------------------
010000     Exec CICS
010100          Startbr
010200          File(MyEdempFile)
010300          Ridfld(MySTartKey)
010400          Resp(MyResp)
010500     End-Exec
010600     .
010700*--------------------------------------------
010800 Return-Menu-Program.
010900*--------------------------------------------
011000     Exec CICS
011100          XCTL
011200          Program(MyMenuProgram)
011300     End-Exec
011400     .
011500*--------------------------------------------
011600 Return-Transid-Commarea.
011700*--------------------------------------------
011800     Exec CICS
011900          Send Control
012000          Freekb
012100     End-Exec
012200
012300     Exec CICS
012400          Return
012500          Transid('ED08')
012600          Commarea(WS-Commarea)
012700     End-Exec
012800     .
012900*--------------------------------------------
013000 Move-To-Map.
013100*--------------------------------------------
013200     Add 1 to RowNo
013300     If RowMax
013400        Perform Save-Page-TS
013500        Move 1 to RowNo
013600     End-if
013700     String
013800        Space          Delimited by size
013900        Empno          Delimited by size
014000        Into Empnoo(Rowno)
014100     End-String
014200     Move Ssno     to SsnoO(Rowno)
014300     Move Fname    to FnameO(Rowno)
014400     Move Lname    to LnameO(Rowno)
014500     Move Dpt      to DptO(Rowno)
014600     .
014700*--------------------------------------------
014800 Init1.
014900*--------------------------------------------
015000     Move Low-Value to EDMAP3XO
015100     Exec CICS
015200          Deleteq TS
015300          Queue('ED08PGM')
015400          Nohandle
015500     End-Exec
015600     .
015700*--------------------------------------------
015800 Init2.
015900*--------------------------------------------
016000     Move Low-Value to EDMAP3XO
016100     Move DFHCOMMAREA to WS-COMMAREA
016200     .
016300*--------------------------------------------
016400 Save-Page-TS.
016500*--------------------------------------------
016600     Add 1 to Pageno
016700     Move Pageno to PagenoO
016800
016900     Exec CICS
017000          WriteQ TS
017100          Queue('ED08PGM')
017200          From(EDMAP3XO)
017300          Numitems(Page-Maxno)
017400     End-Exec
017500     Move Low-Value to EDMAP3XO
017600     .
017700*--------------------------------------------
017800 Get-Page-TS.
017900*--------------------------------------------
018000     Exec CICS
018100          Readq TS
018200          Queue('ED08PGM')
018300          Into(EDMAP3XO)
018400          Item(Page-No)
018500     End-Exec
018600     .
018700*--------------------------------------------
018800 Send-Page-Map.
018900*--------------------------------------------
019000     Exec CICS
019100          Send
019200          Map('EDMAP3')
019300          From(EDMAP3XO)
019400          Erase
019500          Freekb
019600     End-Exec
019700     .
019800*--------------------------------------------
019900 End Program ED08PGM.
020000*--------------------------------------------