Lösningar - Professionell utbildning för blivande COBOL...

CICS programmering från grunden Lösningar

© 2015 MONITOR IT-utbildning, Cobolskolan Sverige, www.cobolskolan.se B2-1

Lösningar

http://www.cobolskolan.se/



Innehållsförteckning

Exercise 1 – A simple program ................................................................................................ 3

Exercise 2 – A conversation ..................................................................................................... 5

Exercise 3 – Menu program ..................................................................................................... 5

Exercise 4 – Employees ........................................................................................................... 12

Exercise 5 – Tiers .................................................................................................................... 15 Presentation Program ............................................................................................................ 15 Database Program - VSAM .................................................................................................. 18 Database Program – DB2/SQL ............................................................................................. 19

Exercise 6 – Changes .............................................................................................................. 21 Presentation Program ............................................................................................................ 21 Database Program – DB2/SQL ............................................................................................. 25

Exercise 8 – Paging ................................................................................................................. 27

Exercise 9 – Asynchronous Transactions ............................................................................. 31 Start background task ............................................................................................................ 31 Presentation Program ............................................................................................................ 31 Start background task ............................................................................................................ 36 Database Program ................................................................................................................. 36

Exercise 10 – Transient Data ................................................................................................. 39




Exercise 1 – A simple program 000100 Identification Division.

000200 Program-Id. ED01PGM.

000300*----------------------------------------------

000400* Exercise 1, Part 1

000500*----------------------------------------------

000600 Data Division.

000700 Working-Storage Section.

000910

001000 01 Cursor-Placment.

001100 05 Cursor-Row Pic 9(04) Binary Value 0.

001300 88 Cursor-Row10 Value 800.


001410

001500 01 TheMessage Pic X(80) Value Space.

001700 88 Msg1 Value 'This is exercise 1, Part 1'.

001900 88 Msg2 Value 'Best Regards Peter'.

002110

002200 Procedure Division.

002201 Perform Clear-Screen

002202

002210 Set Cursor-Row10 to True

002211 Perform Place-Cursor

002212

002220 Set Msg1 to True

002400 Perform Send-Message

002410



002502


002600 Perform Send-Message

002700

002710 Perform Return-CICS

002900 .

004500*----------------------------------------------

004600 Send-Message.

004700*----------------------------------------------

005100 Exec CICS

005200 Send

005300 From(TheMessage)

005400 End-Exec

005700 .

007000*----------------------------------------------

007100 Clear-Screen.

007200*----------------------------------------------

007300 Exec CICS

007400 Send

007500 Control

007600 Erase

007700 End-Exec

007800 .

007900*----------------------------------------------

008000 Place-Cursor.

008100*----------------------------------------------

008200 Exec CICS

008300 Send

008400 Control




008500 Cursor(Cursor-Row)

008600 End-Exec

008700 .

008800*----------------------------------------------

008900 Return-CICS.

009000*----------------------------------------------

009160

009200 Exec CICS

009300 Return

009400 End-Exec

009500 .

009510 End Program ED01PGM.

009600*----------------------------------------------




Exercise 2 – A conversation 000100 Identification Division.


000300*----------------------------------------------

000400* Exercise 2.

000500*----------------------------------------------



000800 Copy DFHAID.

000900 01 WS-Commarea.

001000 05 WS-Times Pic 99 Value 0.

001100

001200 01 Cursor-Settings.

001300 05 Cursor-Row Pic 9(04) Binary Value 0.




001600

001700 01 Messages.

001800 05 Message1.

001900 10 Msg1.

002000 15 Pic X(40)

002100 Value 'Pseudoconversational program, entered'.

002400 15 Msg1-Times Pic ZZ.

002500 15 Pic X(10) Value ' times.'.

002600 05 Message2.

002700 10 Msg2.

002800 15 Pic X(80)

002810 Value 'Press Enter to continue, CLEAR to terminate'.

002901

002910 05 Message3 Pic X(80) Value Space.

002920 88 NoMsg3 Value Space.

002930 88 Msg3 Value '*** Invalid key pressed ***'.

003000 Linkage Section.

003100

003200 01 DFHCOMMAREA Pic 99.

003300


003500

003510 Evaluate True

003600 When EIBCALEN = 0

003700 Perform Send-Control-Erase

003710 When EIBAID = DFHCLEAR


003730 When EIBAID = DFHENTER

003900 Move DFHCOMMAREA to WS-Commarea

003910 Set Nomsg3 to True

004010 When Other

004011 Move DFHCOMMAREA to WS-Commarea


004100 End-Evaluate

004110 Perform Send-Messages

004200 Perform Return-CICS-Transid

004300 .

004400*----------------------------------------------

004500 Send-Messages.

004600*----------------------------------------------

004700 Add 1 to WS-Times




004800 Move WS-Times to Msg1-Times

004900



005200 Exec CICS

005300 Send

005400 From(Message1)

005500 End-Exec



005800 Exec CICS

005900 Send


006100 End-Exec



006130 Exec CICS

006140 Send


006160 End-Exec

006200 .

006210*----------------------------------------------

006220 Send-Control-Erase.

006230*----------------------------------------------

006240 Exec CICS

006250 Send

006260 Control

006270 Erase

006280 End-Exec

006290 .

006300*----------------------------------------------

006400 Place-Cursor.

006500*----------------------------------------------

006600 Exec CICS

006700 Send

006800 Control

006900 Cursor(Cursor-Row)

007000 End-Exec

007100 .

007200*----------------------------------------------

007300 Return-CICS.

007400*----------------------------------------------

007500 Exec CICS Send Control

007600* Erase

007700 Freekb

007800 End-Exec

007900

008000 Exec CICS

008100 Return

008200 End-Exec

008300 .

008400*----------------------------------------------

008500 Return-CICS-Transid.

008600*----------------------------------------------

008800 Exec CICS

008900 Return

009000 Transid(EIBTRNID)

009100 Commarea(WS-Commarea)

009200 End-Exec




009300 .





Exercise 3 – Menu program 000100 Identification Division.




000500 Copy DFHAID.

000600 Copy DFHBMSCA.

000700 Copy EDMAP1.

000800 02 MyMessage Redefines MESSAGEO Pic X(50).

000900 88 Msg-SelectErr Value 'Invalid choice'.

001000 88 Msg-OtherErr Value 'Other error!'.

001100 88 Msg-NoEmpPgm Value 'Program ED03PGM missing'.

001200 88 Msg-NoPagPgm Value 'Program ED08PGM missing'.

001300 77 Ws-Commarea Pic X.

001400 77 MyResp Pic S9(08) Binary.

001500 77 Pic 9 Value 0.

001600 88 ExitPgm Value 1.

001700 88 Msg-Exist Value 2.

001800 88 SelectErr Value 3.

001900 88 Employees Value 4.

002000 88 Paging Value 5.

002100

002200 01 Date-Accept Pic X(08).

002300 01 Date-Map Pic X(10).

002400




002800 Perform Date-Create

002900 Perform Send-Map


003100 When EIBAID = DFHPF3



003400 Perform Receive-Map

003500 Perform Validate-Indata

003600 If ExitPgm


003800 Else

003900 Perform XCTL-Program

004000 End-If

004100 When Other

004200 Set Msg-OtherErr to True

004300 Set Msg-Exist to True

004400 End-Evaluate

004500 If MSG-Exist

004600 Perform Send-MapDataonly

004700 End-If

004800 Perform Return-Transid

004900 .

005000*--------------------------------------------

005100 Date-Create.

005200*--------------------------------------------

005300 Accept Date-Accept from Date YYYYMMDD

005400 String

005500 Date-Accept(1:4)

005600 '-'

005700 Date-Accept(5:2)




005800 '-'

005900 Date-Accept(7:2) Delimited by Size

006000 Into Date-Map

006100 End-String

006200 .

006300*--------------------------------------------

006400 XCTL-Program.

006500*--------------------------------------------


006700 When Employees

006800 Exec CICS

006900 XCTL

007000 Program('ED04PGM')

007100 Resp(MyResp)

007200 End-Exec

007300 If Myresp = DFHRESP(PGMIDERR)

007400 Set Msg-NoEmpPgm to True


007600 End-If

007700 When Paging

007800 Exec CICS

007900 XCTL


008100 Resp(MyResp)

008200 End-Exec

008300 If Myresp = DFHRESP(PGMIDERR)

008400 Set Msg-NoPagPgm to True


008600 End-If

008700 When Other

008800 Exec CICS

008900 XCTL

009000 Program('ERRPGM')

009100 End-Exec

009200 End-Evaluate

009300 .

009400*--------------------------------------------

009500 Return-CICS.

009600*--------------------------------------------

009700 Exec CICS

009800 Send Control

009900 Erase

010000 Freekb

010100 End-Exec

010200 Exec CICS

010300 Return

010400 End-Exec

010500 .

010600*--------------------------------------------

010700 Return-Transid.

010800*--------------------------------------------

010900 Exec CICS

011000 Return

011100 Transid('ED03')

011200 Commarea(Ws-Commarea)

011300 End-Exec

011400 .

011500*--------------------------------------------

011600 Send-Map.




011700*--------------------------------------------

011800 Move Low-Value to EDMAP1O

011900 Move Date-Map to DateO

012000 Exec CICS

012100 Send

012200 Map('EDMAP1')

012300 Erase Freekb

012400 End-Exec

012500 .

012600*--------------------------------------------

012700 Send-Maponly.

012800*--------------------------------------------

012900 Exec CICS

013000 Send


013200 Maponly

013300 End-Exec

013400 .

013500*--------------------------------------------

013600 Send-Mapdataonly.

013700*--------------------------------------------

013800 Exec CICS

013900 Send


014100 Dataonly Freekb EraseAup

014200 End-Exec

014300 .

014400*--------------------------------------------

014500 Receive-Map.

014600*--------------------------------------------

014700 Exec CICS

014800 Receive


015000 Resp(MyResp)

015100 End-Exec


015300 When ExitF = DFHBMCUR

015400 or ExitL = 1

015500 Set ExitPgm to True

015600 When EmpfileF = DFHBMCUR

015700 or EmpfileL = 1

015800 Set Employees to True

015900 When PagingF = DFHBMCUR

016000 or PagingL = 1

016100 Set Paging to True

016200 When Other

016300 Set SelectErr to True

016400 End-Evaluate


016600 .

016700*--------------------------------------------

016800 Validate-Indata.

016900*--------------------------------------------


017100 When ExitPgm


017300 When SelectErr

017400 Set Msg-SelectErr to True

017500 Perform Send-Mapdataonly





017700 When Employees

017800 When Paging

017900 Continue

018000 When Other

018100 Set Msg-OtherErr to True



018400 End-Evaluate

018500 .





Exercise 4 – Employees 000100 Identification Division.


000300*-------------------------------------------------------

000400* This is a sample solution to exercise 4 using VSAM

000500*-------------------------------------------------------



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).


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


003600 Perform InitVars



003900 Perform Send-Maponly

004000 Perform Return-Transid-Commarea





004500 Perform Send-MapEraseAup




004900 If Indata-OK

005000 Perform ReadEdemp

005100 End-If

005200 When Other

005300 Set InvalidPFK to True

005400 End-Evaluate



005700 .




005800*--------------------------------------------

005900 InitVars.

006000*--------------------------------------------


006200 .

006300*--------------------------------------------


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)


007800 End-Exec

007900 .

008000*--------------------------------------------

008100 Send-MapEraseAup.

008200*--------------------------------------------

008300 Exec CICS

008400 Send Control

008500 EraseAup

008600 Freekb

008700 End-Exec


008900 Move Space to MSGO

009000 .

009100*--------------------------------------------


009300*--------------------------------------------

009400 Exec CICS

009500 Send


009700 Maponly

009800 Erase

009900 Freekb

010000 End-Exec

010100 .

010200*--------------------------------------------


010400*--------------------------------------------

010500 Exec CICS

010600 Send


010800 Dataonly

010900 Freekb

011000 EraseAup

011100 End-Exec

011200 .

011300*--------------------------------------------

011400 Receive-Map.

011500*--------------------------------------------

011600 Exec CICS




011700 Receive


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


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*--------------------------------------------


014600*--------------------------------------------


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 .





Exercise 5 – Tiers

Presentation Program 000100 Identification Division.


000300*-----------------------------------------------------

000400* This is a sample solution to Exercise 5

000500* the Presentation Program

000600*-----------------------------------------------------



000900 Copy DFHAID.

001000 Copy EDMAP2.


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

002000 01 Ws-Commarea Pic X(01).

002100

002200 01 MyDBCommarea.

002300 05 MyDBRequest Pic 9(01) Value 0.

002400 88 DBRead Value 1.

002500

002600 05 MyDBResponse Pic 9(02) Value 0.

002700 88 DBReadOK Value 11.

002800 88 DBReadNotfnd Value 12.

002900 88 DBReadError Value 19.

003000 88 DBRequestError Value 99.

003100

003200 05 MyDBRecord.

003300 10 Empno Pic X(05).

003400 10 Ssno Pic X(10).

003500 10 Fname Pic X(20).

003600 10 Lname Pic X(20).

003700 10 Dpt Pic X(05).

003800 10 Pic X(20).

003900

004000 77 MyEmpno Pic X(05).




004400 77 MyDBPgm Pic X(08) Value 'ED0DB1'.




004800


















006300 If Indata-OK


006500 End-If

006600 When Other

006700 Set Msg-InvalidPFK to True

006800 End-Evaluate



007100 .

007200*--------------------------------------------

007300 InitVars.

007400*--------------------------------------------


007600 .

007700*--------------------------------------------


007900*--------------------------------------------

008000 Exec CICS

008100 XCTL


008300 End-Exec

008400 .

008500*--------------------------------------------


008700*--------------------------------------------

008800 Exec CICS

008900 Return



009200 End-Exec

009300 .

009400*--------------------------------------------


009600*--------------------------------------------

009700 Exec CICS

009800 Send Control

009900 EraseAup

010000 Freekb

010100 End-Exec



010400 .

010500*--------------------------------------------


010700*--------------------------------------------

010800 Exec CICS

010900 Send


011100 Maponly

011200 Erase

011300 Freekb




011400 End-Exec

011500 .

011600*--------------------------------------------


011800*--------------------------------------------

011900 Exec CICS

012000 Send


012200 Dataonly

012300 Freekb

012400 EraseAup

012500 End-Exec

012600 .

012700*--------------------------------------------

012800 Receive-Map.

012900*--------------------------------------------

013000 Exec CICS

013100 Receive


013300 Resp(MyResp)

013400 End-Exec

013500 .

013600*--------------------------------------------

013700 ReadEdemp.

013800*--------------------------------------------

013900 Move MyEmpno to Empno in MyDBCommarea

014000 Set DBRead to True

014100 Exec CICS

014200 Link

014300 Program(MyDBPgm)

014400 Commarea(MyDBCommarea)

014500 End-Exec



014800 When DBReadOK






015400 Set MSG-DBReadOK to True

015500 When DBReadNotfnd


015700 Set Msg-EmprecNotfnd to True

015800 When Other

015900 Set Msg-DBReadError to True

016000 End-Evaluate

016100 .

016200*--------------------------------------------


016400*--------------------------------------------



016700 Set Msg-EmpnoMissing to True


016900 Set Msg-EmpnoNotNum to True

017000 When Other






017300 End-Evaluate

017400 .


Database Program - VSAM 000100 Identification Division.

000200 Program-Id. ED0DB1.

000300*-----------------------------------------------------


000500* the Database Program using VSAM

000600*-----------------------------------------------------




001000 77 MyEdempfile Pic x(08) Value 'EDEMP0'.

001100


001300 01 DFHCOMMAREA.

001400 05 MyDBRequest Pic 9(01).


001600

001700 05 MyDBResponse Pic 9(02).





002200


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



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





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 ED0DB1.

006400*--------------------------------------------

Database Program – DB2/SQL 000100 Identification Division.


000300*-----------------------------------------------------


000500* the Database Program using DB2/SQL

000600*-----------------------------------------------------



000900 77 SQLNormal Pic S9(09) Comp-5 Value 0.

001000 77 SQLNotfnd Pic S9(09) Comp-5 Value +100.

001100

001200 Exec SQL Include SQLCA End-Exec.

001300* Exec SQL Include EDEMP0 End-Exec.

001400





001900






002500


002700 10 Empno Pic X(05).

002800 10 Ssno Pic X(10).

002900 10 Fname Pic X(20).

003000 10 Lname Pic X(20).

003100 10 Dpt Pic X(05).

003200 10 Pic X(20).

003300



003600 When DBRead


003800 When Other


004000 End-Evaluate

004100 Exec CICS

004200 Return

004300 End-Exec

004400 .




004500*--------------------------------------------

004600 MyDBRead.

004700*--------------------------------------------

004800 Exec SQL

004900 Select Empno, Ssno, Fname, Lname, Dpt

005000 Into :Empno,:Ssno,:Fname,:Lname,:Dpt

005100 From utb00.EDEMP0

005200 Where Empno = :Empno

005300 End-Exec.

005400


005600 When SQLCODE = SQLNormal


005800 When SQLCode = SQLNotfnd


006000 When Other


006200 End-Evaluate

006300 .

006400*--------------------------------------------


006600*--------------------------------------------




Exercise 6 – Changes

Presentation Program 000100 Identification Division.


000300*-----------------------------------------------------


000500* the Presentation Program

000600*-----------------------------------------------------



000900 Copy DFHAID.

001000 Copy EDMAP2.









001900 88 Msg-DBUpdateError Value 'DBUpdate returned error'.

002000 88 Msg-DBUpdateOK Value 'Update normal'.

002100

002200

002300 77 MyEmpno Pic X(05).










003300 05 MyDBRequest Pic 9(01) Value 0.


003500 88 DBUpdate Value 2.

003600

003700 05 MyDBResponse Pic 9(02) Value 0.




004100

004200 88 DBUpdateOK Value 21.

004300 88 DBUpdateError Value 29.


004500


004700 10 Empno Pic X(05).

004800 10 Ssno Pic X(10).

004900 10 Fname Pic X(20).

005000 10 Lname Pic X(20).

005100 10 Dpt Pic X(05).

005200 10 Emptime Pic X(26).

005300









005900 Perform Getmain-Commarea










006900 If Indata-OK


007100 End-If

007200 When EIBAID = DFHPF5 and DBReadOK



007500 If Indata-OK

007600 Perform UpdateEdemp

007700 End-If

007800 When Other


008000 End-Evaluate



008300 .

008400*--------------------------------------------

008500 InitVars.

008600*--------------------------------------------


008800 .

008900*--------------------------------------------

009000 Getmain-Commarea.

009100*--------------------------------------------

009200 Exec CICS

009300 Getmain

009400 Length(Length of DFHCOMMAREA)

009500 Set(Address of DFHCOMMAREA)

009600 End-Exec

009700 Move Low-Value to DFHCOMMAREA

009800 .

009900*--------------------------------------------


010100*--------------------------------------------

010200 Exec CICS

010300 XCTL


010500 End-Exec

010600 .

010700*--------------------------------------------


010900*--------------------------------------------

011000 Exec CICS

011100 Return


011300 Commarea(DFHCOMMAREA)




011400 End-Exec

011500 .

011600*--------------------------------------------


011800*--------------------------------------------

011900 Exec CICS

012000 Send Control

012100 EraseAup

012200 Freekb

012300 End-Exec




012700 .

012800*--------------------------------------------


013000*--------------------------------------------

013100 Exec CICS

013200 Send


013400 Maponly

013500 Erase

013600 Freekb

013700 End-Exec

013800 .

013900*--------------------------------------------


014100*--------------------------------------------

014200 Exec CICS

014300 Send


014500 Dataonly

014600 Freekb

014700 EraseAup

014800 End-Exec

014900 .

015000*--------------------------------------------

015100 Receive-Map.

015200*--------------------------------------------

015300 Exec CICS

015400 Receive


015600 Resp(MyResp)

015700 End-Exec

015800 .

015900*--------------------------------------------

016000 ReadEdemp.

016100*--------------------------------------------

016200 Move MyEmpno to Empno in DFHCOMMAREA


016400 Exec CICS

016500 Link



016800 End-Exec
















018100 When Other


018300 End-Evaluate

018400 .

018500*--------------------------------------------

018600 UpdateEdemp.

018700*--------------------------------------------

018800 If SsnoL Not = 0

018900 Move SsnoI to SSno in DFHCOMMAREA

019000 End-If

019100 If FnameL Not = 0

019200 Move FnameI to Fname in DFHCOMMAREA

019300 End-If

019400 If LnameL Not = 0

019500 Move LnameI to Lname in DFHCOMMAREA

019600 End-If

019700 If DptL Not = 0

019800 Move DptI to Dpt in DFHCOMMAREA

019900 End-If


020100 Set DBUpdate to True

020200 Exec CICS

020300 Link



020600 End-Exec



020900 When DBUpdateOK






021500 Set MSG-DBUpdateOK to True

021600 When Other

021700 Set Msg-DBUpdateError to True

021800 End-Evaluate

021900 .

022000*--------------------------------------------


022200*--------------------------------------------






022800 When Other



023100 End-Evaluate




023200 .

023300*--------------------------------------------


023500*--------------------------------------------

Database Program – DB2/SQL 000100 Identification Division.


000300*-----------------------------------------------------


000500* the Database Program using DB2/SQL

000600*-----------------------------------------------------





001100



001400






002000





002500




002900


003100 10 Empno Pic X(05).

003200 10 Ssno Pic X(10).

003300 10 Fname Pic X(20).

003400 10 Lname Pic X(20).

003500 10 Dpt Pic X(05).

003600 10 Emptime Pic X(26).

003700



004000 When DBRead


004200 When DBUpdate

004300 Perform MyDBUpdate

004400 When Other


004600 End-Evaluate

004700 Exec CICS

004800 Return

004900 End-Exec

005000 .

005100*--------------------------------------------

005200 MyDBRead.




005300*--------------------------------------------

005400 Exec SQL

005500 Select Empno, Ssno, Fname, Lname, Dpt, Emptime

005600 Into :Empno,:Ssno,:Fname,:Lname,:Dpt,:Emptime



005900 End-Exec.

006000






006600 When Other


006800 End-Evaluate

006900 .

007000*--------------------------------------------

007100 MyDBUpdate.

007200*--------------------------------------------

007300 Exec SQL

007400 Update utb00.EDEMP0

007500 Set Empno = :Empno,

007600 Ssno = :Ssno,

007700 Fname = :Fname,

007800 Lname = :Lname,

007900 Dpt = :Dpt

008000 Where Empno = :empno

008100 And

008200 Emptime = :Emptime

008300 End-Exec.

008400



008700 Set DBUpdateOK to True

008800 When Other

008900 Set DBUpdateError to True

009000 End-Evaluate

009100 .

009200*--------------------------------------------


009400*--------------------------------------------




Exercise 8 – Paging 000100 Identification Division.


000300*--------------------------------------------------

000400* This is a sample solution for Exercise 8

000500* Paging using temporary storage and DB2/SQL

000600* Mapset: EDMAP3 COPYBOOK: EDMAP3X

000700* Map: EDMAP3 Max number of rows: 9

000800*--------------------------------------------------



001100 Copy DFHAID.

001200 Copy EDMAP3X.

001300

001400 Exec SQL

001500 Include SQLCA

001600 End-Exec.

001700

001800 Exec SQL

001900 Include Edemp0

002000 End-Exec.

002100

002200 Exec SQL

002300 Declare Cur-Edemp Cursor

002400 for

002500 Select Empno, Ssno, Fname, Lname, Dpt

002600 From UTB00.Edemp0

002700 End-Exec.

002800

002900 01 WS-Commarea.

003000 05 Page-No Pic S9(04) Binary Value 0.

003100 05 Page-Maxno Pic S9(04) Binary.

003200

003300 01 Messages.

003400 05 MyMessage Pic X(40).

003500

003600 77 Pic 9(01) Value 0.

003700 88 NoMoreRows Value 1.

003800 88 Valklart Value 2.

003900


004100

004200 77 Pageno Pic 9(02) Value 0.

004300

004400 77 Rowno Pic 9(02) Value 0.

004500 88 Rowmax Value 10.

004600


004800 01 DFHCOMMAREA Pic S9(08) Binary.

004900


005100 If EIBCALEN = 0

005200 Perform Init1

005300 Perform Cursor-Open

005400 Perform Until NoMoreRows

005500 Perform Cursor-Fetch

005600 End-Perform




005700 Move 1 to Page-No

005800 Perform Get-Page-TS

005900 Perform Send-Page-Map

006000 Else

006100 Perform Init2




006500 Perform Return-Menu-Program


006700 Add 1 to Page-No

006800 If Page-No Not > Page-Maxno



007100 Else

007200 Move Page-Maxno to Page-No

007300 End-If


007500 If Page-No > 1

007600 Subtract 1 from Page-No



007900 End-If

008000 End-Evaluate

008100 End-If


008300 .

008400*-------------------------------------------------

008500 Cursor-Fetch.

008600*-------------------------------------------------

008700 Exec SQL

008800 Fetch Cur-Edemp

008900 Into :Empno,

009000 :Ssno,

009100 :Fname,

009200 :Lname,

009300 :Dpt

009400 End-Exec

009500

009600 If SQLCODE Not = 0

009700 Set NoMoreRows to True

009800 Perform Save-Page-TS

009900 Else

010000 Perform Move-To-Map

010100 End-If

010200 .

010300*-------------------------------------------------

010400 Cursor-Open.

010500*-------------------------------------------------

010600 Exec SQL

010700 Open Cur-Edemp

010800 End-Exec

010900

011000 If SQLCODE Not = 0

011100 String 'Error opening SQL-Cursor: '

011200 ', SQLState: '

011300 SQLState

011400 Delimited by Size

011500 Into MSGO




011600 End-String

011700 End-If

011800 .

011900*--------------------------------------------

012000 Return-Menu-Program.

012100*--------------------------------------------

012200 Exec CICS

012300 XCTL


012500 End-Exec

012600 .

012700*--------------------------------------------


012900*--------------------------------------------

013000 Exec CICS

013100 Send Control

013200 Freekb

013300 End-Exec

013400

013500 Exec CICS

013600 Return

013700 Transid('ED08')

013800 Commarea(WS-Commarea)

013900 End-Exec

014000 .

014100*--------------------------------------------

014200 Move-To-Map.

014300*--------------------------------------------

014400 Add 1 to RowNo

014500 If RowMax

014600 Perform Save-Page-TS

014700 Move 1 to RowNo

014800 End-if

014900 String

015000 Space Delimited by size

015100 Empno Delimited by size

015200 Into Empnoo(Rowno)

015300 End-String

015400 Move Ssno to SsnoO(Rowno)

015500 Move Fname to FnameO(Rowno)

015600 Move Lname to LnameO(Rowno)

015700 Move Dpt to DptO(Rowno)

015800 .

015900*--------------------------------------------

016000 Init1.

016100*--------------------------------------------

016200 Move Low-Value to EDMAP3XO

016300 Exec CICS

016400 Deleteq TS

016500 Queue('ED08PGM')

016600 Nohandle

016700 End-Exec

016800 .

016900*--------------------------------------------

017000 Init2.

017100*--------------------------------------------


017300 Move DFHCOMMAREA to WS-COMMAREA

017400 .




017500*--------------------------------------------

017600 Save-Page-TS.

017700*--------------------------------------------

017800 Add 1 to Pageno

017900 Move Pageno to PagenoO

018000

018100 Exec CICS

018200 WriteQ TS


018400 From(EDMAP3XO)

018500 Numitems(Page-Maxno)

018600 End-Exec


018800 .

018900*--------------------------------------------

019000 Get-Page-TS.

019100*--------------------------------------------

019200 Exec CICS

019300 Readq TS


019500 Into(EDMAP3XO)

019600 Item(Page-No)

019700 End-Exec

019800 .

019900*--------------------------------------------

020000 Send-Page-Map.

020100*--------------------------------------------

020200 Exec CICS

020300 Send


020500 From(EDMAP3XO)

020600 Erase

020700 Freekb

020800 End-Exec

020900 .

021000*--------------------------------------------

021100 Send-MyMessage.

021200*--------------------------------------------

021300 Exec CICS

021400 Send

021500 From(MyMessage)

021600 Erase

021700 End-Exec

021800 Exec CICS

021900 Return

022000 End-Exec

022100 .

022200*--------------------------------------------


022400*--------------------------------------------




Exercise 9 – Asynchronous Transactions

Start background task

Presentation Program

000100 Identification Division.


000300*-----------------------------------------------------


000500* the Presentation Program and Asyncronous Database Program

000600*-----------------------------------------------------



000900 Copy DFHAID.

001000 Copy EDMAP2.











002100

002200

002300 77 MyEmpno Pic X(05).





002800 77 MyTSQname Pic X(16) Value 'MYTSQNAME'.

002900 77 MyDelayReqid Pic X(08) Value 'MYREQID'.









003800





004300




004700





004900 10 Empno Pic X(05).

005000 10 Ssno Pic X(10).

005100 10 Fname Pic X(20).

005200 10 Lname Pic X(20).

005300 10 Dpt Pic X(05).

005400 10 Emptime Pic X(26).

005500

005600 05 MyDelayReqidComm Pic X(08).

005700 05 MyTSQnameComm Pic X(16).

005800
















007400 If Indata-OK


007600 End-If




008000 If Indata-OK


008200 End-If

008300 When Other


008500 End-Evaluate



008800 .

008900*--------------------------------------------

009000 InitVars.

009100*--------------------------------------------


009300 .

009400*--------------------------------------------


009600*--------------------------------------------

009700 Exec CICS

009800 Getmain



010100 End-Exec


010300 .

010400*--------------------------------------------


010600*--------------------------------------------




010700 Exec CICS

010800 XCTL


011000 End-Exec

011100 .

011200*--------------------------------------------


011400*--------------------------------------------

011500 Exec CICS

011600 Return



011900 End-Exec

012000 .

012100*--------------------------------------------


012300*--------------------------------------------

012400 Exec CICS

012500 Send Control

012600 EraseAup

012700 Freekb

012800 End-Exec




013200 .

013300*--------------------------------------------


013500*--------------------------------------------

013600 Exec CICS

013700 Send


013900 Maponly

014000 Erase

014100 Freekb

014200 End-Exec

014300 .

014400*--------------------------------------------


014600*--------------------------------------------

014700 Exec CICS

014800 Send


015000 Dataonly

015100 Freekb

015200 EraseAup

015300 End-Exec

015400 .

015500*--------------------------------------------

015600 Receive-Map.

015700*--------------------------------------------

015800 Exec CICS

015900 Receive


016100 Resp(MyResp)

016200 End-Exec

016300 .

016400*--------------------------------------------

016500 ReadEdemp.




016600*--------------------------------------------



016900 Move MyTSQname to MyTSQnameComm

017000 Move MyDelayReqid to MyDelayReqidComm


017200

017300 Perform StartDBprogram

017400












018600 When Other


018800 End-Evaluate

018900 .

019000*--------------------------------------------

019100 UpdateEdemp.

019200*--------------------------------------------



019500 End-If



019800 End-If



020100 End-If



020400 End-If



020700


020900










021900 When Other


022100 End-Evaluate

022200 .

022300*--------------------------------------------





022500*--------------------------------------------






023100 When Other



023400 End-Evaluate

023500 .

023600*--------------------------------------------

023700 StartDBprogram.

023800*--------------------------------------------

023900 Exec CICS

024000 Deleteq TS

024100 Qname(MyTSQname)

024200 Resp(Myresp)

024300 End-Exec

024400 Exec CICS

024500 Start

024600 Transid('ED0A')

024700 From(DFHCOMMAREA)

024800 Resp(Myresp)

024900 End-Exec

025000 Exec CICS

025100 Delay

025200 Interval(25)

025300 Reqid(MyDelayReqid)

025400 Resp(Myresp)

025500 End-Exec

025600*-------------------------------------------

025700* Continue here when interval has expired

025800* or has been cancelled

025900*-------------------------------------------

026000 Exec CICS

026100 ReadQ TS


026300 Into(DFHCOMMAREA)

026400 Resp(MyResp)

026500 End-Exec

026600 .

026700*--------------------------------------------


026900*--------------------------------------------




Start background task

Database Program 000100 Identification Division.

000200 Program-Id. ED0ADB2

000300*-----------------------------------------------------


000500* Asyncronous Database Program.

000600*-----------------------------------------------------









001500






002100





002600




003000


003200 10 Empno Pic X(05).

003300 10 Ssno Pic X(10).

003400 10 Fname Pic X(20).

003500 10 Lname Pic X(20).

003600 10 Dpt Pic X(05).

003700 10 Emptime Pic X(26).



004000


004200 Perform RetrieveCommarea

004300 Perform Until MyResp = DFHRESP(ENDDATA)


004500 When DBRead


004700 When DBUpdate

004800 Perform MyDBUpdate

004900 When Other


005100 End-Evaluate

005200 Exec CICS

005300 Writeq TS

005400 Qname(MyTSQnameComm)





005600 End-EXec

005700 Exec CICS

005800 Cancel

005900 Reqid(MyDelayReqidComm)

006000 End-Exec

006100 Perform RetrieveCommarea

006200 End-Perform

006300 Exec CICS

006400 Return

006500 End-Exec

006600 .

006700*--------------------------------------------

006800 RetrieveCommarea.

006900*--------------------------------------------

007000 Exec CICS Retrieve



007300 Resp(MyResp)

007400 End-Exec

007500 .

007600*--------------------------------------------

007700 MyDBRead.

007800*--------------------------------------------

007900 Exec SQL

008000 Select Empno, Ssno, Fname, Lname, Dpt, Emptime

008100 Into :Empno,:Ssno,:Fname,:Lname,:Dpt,:Emptime



008400 End-Exec.

008500






009100 When Other


009300 End-Evaluate

009400 .

009500*--------------------------------------------

009600 MyDBUpdate.

009700*--------------------------------------------

009800 Exec SQL

009900 Update utb00.EDEMP0

010000 Set Empno = :Empno,

010100 Ssno = :Ssno,

010200 Fname = :Fname,

010300 Lname = :Lname,

010400 Dpt = :Dpt

010500 Where Empno = :empno

010600 And

010700 Emptime = :Emptime

010800 End-Exec.

010900



011200 Set DBUpdateOK to True

011300 When Other

011400 Set DBUpdateError to True




011500 End-Evaluate

011600 .

011700*--------------------------------------------

011800 End Program ED0ADB2.

011900*--------------------------------------------




Exercise 10 – Transient Data 000100 Identification Division.


000300*-----------------------------------------------------


000500* the Presentation Program and Asyncronous Database Program

000600*-----------------------------------------------------



000900 Copy DFHAID.

001000 Copy EDMAP2.











002100

002200

002300 77 MyEmpno Pic X(05).






002900 77 MyTDQname Pic X(04) Value 'ERRA'.

003000 77 MyABcode Pic X(04) Value 'ERRA'.

003100 77 MyDelayReqid Pic X(08) Value 'MYREQID'.

003200 01 MyABmessage.

003300 05 Pic X(40) Value 'The Database Program indicated that

it'.

003400 05 Pic X(40) Value 'didnt complete correctly.'.

003500 05 Pic X(40) Value 'Contact system support for further'.

003600 05 Pic X(40) Value 'information. Press ENTER'.

003700 01 MyTDmessage.

003800 05 Pic X(40) Value '**** Transaction ED04 has terminated'.

003900 05 Pic X(40) Value 'due to problem in program ED0ADB2

****'.









004800





005300







005700


005900 10 Empno Pic X(05).

006000 10 Ssno Pic X(10).

006100 10 Fname Pic X(20).

006200 10 Lname Pic X(20).

006300 10 Dpt Pic X(05).

006400 10 Emptime Pic X(26).

006500



006800
















008400 If Indata-OK


008600 End-If




009000 If Indata-OK


009200 End-If

009300 When Other


009500 End-Evaluate



009800 .

009900*--------------------------------------------

010000 InitVars.

010100*--------------------------------------------


010300 .

010400*--------------------------------------------


010600*--------------------------------------------

010700 Exec CICS

010800 Getmain



011100 End-Exec


011300 .

011400*--------------------------------------------





011600*--------------------------------------------

011700 Exec CICS

011800 XCTL


012000 End-Exec

012100 .

012200*--------------------------------------------


012400*--------------------------------------------

012500 Exec CICS

012600 Return



012900 End-Exec

013000 .

013100*--------------------------------------------


013300*--------------------------------------------

013400 Exec CICS

013500 Send Control

013600 EraseAup

013700 Freekb

013800 End-Exec




014200 .

014300*--------------------------------------------


014500*--------------------------------------------

014600 Exec CICS

014700 Send


014900 Maponly

015000 Erase

015100 Freekb

015200 End-Exec

015300 .

015400*--------------------------------------------


015600*--------------------------------------------

015700 Exec CICS

015800 Send


016000 Dataonly

016100 Freekb

016200 EraseAup

016300 End-Exec

016400 .

016500*--------------------------------------------

016600 Receive-Map.

016700*--------------------------------------------

016800 Exec CICS

016900 Receive


017100 Resp(MyResp)

017200 End-Exec

017300 .




017400*--------------------------------------------

017500 ReadEdemp.

017600*--------------------------------------------



017900 Move MyTSQname to MyTSQnameComm

018000 Move MyDelayReqid to MyDelayReqidComm


018200


018400












019600 When Other


019800 End-Evaluate

019900 .

020000*--------------------------------------------

020100 UpdateEdemp.

020200*--------------------------------------------



020500 End-If



020800 End-If



021100 End-If



021400 End-If



021700


021900










022900 When Other


023100 End-Evaluate

023200 .




023300*--------------------------------------------


023500*--------------------------------------------






024100 When Other



024400 End-Evaluate

024500 .

024600*--------------------------------------------

024700 StartDBprogram.

024800*--------------------------------------------

024900 Exec CICS

025000 Deleteq TS


025200 Resp(Myresp)

025300 End-Exec

025400 Exec CICS

025500 Start

025600 Transid('ED0A')


025800 Resp(Myresp)

025900 End-Exec

026000 Exec CICS

026100 Delay

026200 Interval(25)

026300 Reqid(MyDelayReqid)

026400 Resp(Myresp)

026500 End-Exec

026600*-------------------------------------------

026700* Continue here when interval has expired

026800* or has been cancelled

026900*-------------------------------------------

027000 Exec CICS

027100 ReadQ TS


027300 Into(DFHCOMMAREA)

027400 Resp(MyResp)

027500 End-Exec

027600

027700 If MyResp = DFHRESP(QIDERR)

027800 Perform LogAndAbend

027900 End-If

028000 .

028100*--------------------------------------------

028200 LogAndAbend.

028300*--------------------------------------------

028400 Exec CICS

028500 Writeq TD

028600 Queue(MyTDQname)

028700 From(MyTDmessage)

028800 End-Exec

028900 Exec CICS

029000 Send

029100 From(MyABmessage)




029200 Erase

029300 Wait

029400 End-Exec

029500 Exec CICS

029600 Abend

029700 Abcode(MyABcode)

029800 End-Exec

029900 .

030000*--------------------------------------------


030200*--------------------------------------------


Lösningar - Professionell utbildning för blivande COBOL...

Documents

Transcript of Lösningar - Professionell utbildning för blivande COBOL...