000100 Identification Division. 000200 Program-Id. ED08PGM2. 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* XCTL to Edemp-Program using selection x and PF10 000900*-------------------------------------------------- 001000 Data Division. 001100 Working-Storage Section. 001200 Copy DFHAID. 001300 Copy EDMAP3X. 001400 05 MyMessage Redefines MSGO Pic X(70). 001500 88 MSG-InvalidSelcode Value 'Invalid Selection-code'. 001600 001700 01 WS-Commarea. 001800 05 Page-No Pic S9(04) Binary Value 0. 001900 05 Page-Maxno Pic S9(04) Binary. 002000 002100 01 MyDBRecord. 002200 05 Empno Pic X(05). 002300 05 Ssno Pic X(10). 002400 05 Fname Pic X(20). 002500 05 Lname Pic X(20). 002600 05 Dpt Pic X(05). 002700 05 Pic X(20). 002800 002900 01 MyEmpnoArea. 003000 05 Pic X(03). 003100 05 SelCode Pic X(01). 003200 05 SelEmpno Pic X(05). 003300 05 Pic X(10). 003400 003500 77 Pic 9(01) Value 0. 003600 88 ValidSelCode Value 0. 003700 88 InvalidSelCode Value 1. 003800 88 NoMoreRecords Value 9. 003900 004000 77 MyMenuProgram Pic X(08) Value 'ED03PGM'. 004100 77 MyEdempFile Pic X(08) Value 'EDEMP0'. 004200 77 MyEdempProgram Pic X(08) Value 'ED0APGM'. 004300 77 MyStartKey Pic X(05) Value '00000'. 004400 77 MyResp Pic S9(08) Binary. 004500 004600 77 Pageno Pic 9(02) Value 0. 004700 004800 77 Rowno Pic 9(02) Value 0. 004900 88 Rowmax Value 10. 005000 005100 01 MyEdempProgramCommarea. 005200 05 MyDBRequest Pic 9(01). 005300 88 DBRead Value 1. 005400 88 DBUpdate Value 2. 005500 88 DBDelete Value 3. 005600 88 DBAdd Value 4. 005700 88 DBPageRequest Value 5. 005800 005900 05 MyDBResponse Pic 9(02). 006000 006100 05 MyTSQueue Pic X(08). 006200 05 MyDelayReqid Pic X(08). 006300 006400 05 MyDBRecordEdempProgram. 006500 10 Empno Pic X(05). 006600 10 Ssno Pic X(10). 006700 10 Fname Pic X(20). 006800 10 Lname Pic X(20). 006900 10 Dpt Pic X(05). 007000 10 Pic X(20). 007100 Linkage Section. 007200 01 DFHCOMMAREA Pic S9(08) Binary. 007300 007400 Procedure Division. 007500 If EIBCALEN = 0 007600 Perform Init1 007700 Perform Edemp-StartBrowse 007800 Perform Until NoMoreRecords 007900 Perform Edemp-Readnext 008000 End-Perform 008100 Move 1 to Page-No 008200 Perform Get-Page-TS 008300 Perform Send-Page-Map 008400 Else 008500 Perform Init2 008600 Evaluate True 008700 When EIBAID = DFHPF10 008800 Perform Receive-Empno 008900 Perform XCTL-EdempProgram 009000 When EIBAID = DFHCLEAR 009100 When EIBAID = DFHPF3 009200 Perform Return-Menu-Program 009300 When EIBAID = DFHPF8 009400 Add 1 to Page-No 009500 If Page-No Not > Page-Maxno 009600 Perform Get-Page-TS 009700 Perform Send-Page-Map 009800 Else 009900 Move Page-Maxno to Page-No 010000 End-If 010100 When EIBAID = DFHPF7 010200 If Page-No > 1 010300 Subtract 1 from Page-No 010400 Perform Get-Page-TS 010500 Perform Send-Page-Map 010600 End-If 010700 End-Evaluate 010800 End-If 010900 Perform Return-Transid-Commarea 011000 . 011100*------------------------------------------------- 011200 Receive-Empno. 011300*------------------------------------------------- 011400 Exec CICS Receive 011500 Into(MyEmpnoArea) 011600 Resp(MyResp) 011700 End-Exec 011800 If Selcode = 'X' or 'x' 011900 Set ValidSelCode to True 012000 Else 012100 Set InvalidSelCode to True 012200 End-If 012300 . 012400*------------------------------------------------- 012500 XCTL-EdempProgram. 012600*-------------------- ---------------------------- 012700 If ValidSelCode 012800 Move SelEmpno to Empno in MyDBRecordEdempProgram 012900 Set DBPageRequest to True 013000 Exec CICS XCTL 013100 Program(MyEdempProgram) 013200 Commarea(MyEdempProgramCommarea) 013300 End-Exec 013400 Else 013500 Set MSG-InvalidSelCode to True 013600 Exec CICS Send 013700 Map('EDMAP3') 013800 From(EDMAP3XO) 013900 Freekb 014000 Dataonly 014100 End-Exec 014200 End-If 014300 . 014400*------------------------------------------------- 014500 Edemp-Readnext. 014600*------------------------------------------------- 014700 Exec CICS 014800 Readnext 014900 File(MyEdempFile) 015000 Ridfld(MyStartKey) 015100 Into(MyDBRecord) 015200 Resp(MyResp) 015300 End-Exec 015400 015500 If MyResp = DFHRESP(ENDFILE) 015600 Set NoMoreRecords to True 015700 Perform Save-Page-TS 015800 Else 015900 Perform Move-To-MAp 016000 End-If 016100 . 016200*------------------------------------------------- 016300 Edemp-Startbrowse. 016400*------------------------------------------------- 016500 Exec CICS 016600 Startbr 016700 File(MyEdempFile) 016800 Ridfld(MySTartKey) 016900 Resp(MyResp) 017000 End-Exec 017100 . 017200*-------------------------------------------- 017300 Return-Menu-Program. 017400*-------------------------------------------- 017500 Exec CICS 017600 XCTL 017700 Program(MyMenuProgram) 017800 End-Exec 017900 . 018000*-------------------------------------------- 018100 Return-Transid-Commarea. 018200*-------------------------------------------- 018300 Exec CICS 018400 Send Control 018500 Freekb 018600 End-Exec 018700 018800 Exec CICS 018900 Return 019000 Transid('ED08') 019100 Commarea(WS-Commarea) 019200 End-Exec 019300 . 019400*-------------------------------------------- 019500 Move-To-Map. 019600*-------------------------------------------- 019700 Add 1 to RowNo 019800 If RowMax 019900 Perform Save-Page-TS 020000 Move 1 to RowNo 020100 End-if 020200 String 020300 Space 020400 Empno In MyDBRecord Delimited by size 020500 Into Empnoo(Rowno) 020600 End-String 020700 Move Ssno in MyDBRecord to SsnoO(Rowno) 020800 Move Fname in MyDBRecord to FnameO(Rowno) 020900 Move Lname in MyDBRecord to LnameO(Rowno) 021000 Move Dpt in MyDBRecord to DptO(Rowno) 021100 . 021200*-------------------------------------------- 021300 Init1. 021400*-------------------------------------------- 021500 Move Low-Value to EDMAP3XO 021600 Exec CICS 021700 Deleteq TS 021800 Queue('ED08PGM') 021900 Nohandle 022000 End-Exec 022100 . 022200*-------------------------------------------- 022300 Init2. 022400*-------------------------------------------- 022500 Move Low-Value to EDMAP3XO 022600 Move DFHCOMMAREA to WS-COMMAREA 022700 . 022800*-------------------------------------------- 022900 Save-Page-TS. 023000*-------------------------------------------- 023100 Add 1 to Pageno 023200 Move Pageno to PagenoO 023300 023400 Exec CICS 023500 WriteQ TS 023600 Queue('ED08PGM') 023700 From(EDMAP3XO) 023800 Numitems(Page-Maxno) 023900 End-Exec 024000 Move Low-Value to EDMAP3XO 024100 . 024200*-------------------------------------------- 024300 Get-Page-TS. 024400*-------------------------------------------- 024500 Exec CICS 024600 Readq TS 024700 Queue('ED08PGM') 024800 Into(EDMAP3XO) 024900 Item(Page-No) 025000 End-Exec 025100 . 025200*-------------------------------------------- 025300 Send-Page-Map. 025400*-------------------------------------------- 025500 Move Page-Maxno to PageMaxO 025600 Exec CICS 025700 Send 025800 Map('EDMAP3') 025900 From(EDMAP3XO) 026000 Erase 026100 Freekb 026200 End-Exec 026300 . 026400*-------------------------------------------- 026500 End Program ED08PGM2. 026600*--------------------------------------------