000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM94. 00020000 000300*AUTHOR. Kenneth W. Caldwell. 00030000 000400*INSTALLATION. Train-Right. 00040000 000500*DATE-WRITTEN. January 18, 2011. 00050000 000600*DATE-COMPILED. 00060000 000700* 00070000 000800*SECURITY. This program is for students of Train-Right 00080000 000900* courses ONLY!. 00090000 001000* 00100000 001100*REMARKS. This program plays Rock, Paper, Scissors with 00110000 001200* another CICS system. 00120000 001300* It is a front-end Distributed Transaction Program00130000 001400* . 00140000 001500 DATA DIVISION. 00150000 001600 WORKING-STORAGE SECTION. 00160000 001700 01. 00170000 001800 05 local-parms. 00180000 001900 10 PIC X(5) VALUE SPACES. 00190000 002000 10 remote-sysid PIC X(4) VALUE SPACES. 00200000 002100 10 PIC X VALUE SPACES. 00210000 002200 10 local-option PIC X(5) VALUE SPACES. 00220000 002300 88 local-syncpoint VALUE 'LSYNC'. 00230000 002400 88 local-rollback VALUE 'LROLL'. 00240000 002500 00250000 002600 05 local-sysid PIC X(4). 00260000 002700 05 cvda-state PIC S9(8) BINARY. 00270000 002800 05 conversation-id PIC X(4). 00280000 002900 05 conversation-tranid PIC X(4) VALUE 'TR95'. 00290000 003000 00300000 003100 05 wins PIC S9(4) BINARY VALUE ZERO. 00310000 003200 05 losses PIC S9(4) BINARY VALUE ZERO. 00320000 003300 05 pgm-choice PIC 9 PACKED-DECIMAL. 00330000 003400 05 user-choice PIC X(8) VALUE SPACES. 00340000 003500 05 msg1 PIC X(79) VALUE SPACES. 00350000 003600 00360000 003700 PROCEDURE DIVISION. 00370000 003800 Main. 00380000 003900 EXEC CICS ASSIGN SYSID(local-sysid) END-EXEC. 00390000 004000 00400000 004100 Receive-Trans-Input. 00410000 004200 EXEC CICS IGNORE CONDITION LENGERR END-EXEC. 00420000 004300 EXEC CICS RECEIVE INTO(local-parms) END-EXEC. 00430000 004400 00440000 004500 IF local-sysid = remote-sysid 00450000 004600 THEN GO TO No-Remote-Sysid 00460000 004700 END-IF. 00470000 004800 00480000 004900 Start-Conversation. 00490000 005000 EXEC CICS HANDLE CONDITION SYSIDERR(No-Sysid) END-EXEC. 00500000 005100 EXEC CICS ALLOCATE SYSID(remote-sysid) 00510000 005200 STATE(cvda-state) END-EXEC. 00520000 005300* Initial CVDA state should be ALLOCATED (81). 00530000 005400* EIBRSRCE will be set. 00540000 005500 00550000 005600 MOVE eibrsrce TO conversation-id. 00560000 005700 00570000 005800 Process-Data. 00580000 005900 COMPUTE pgm-choice ROUNDED = 00590000 006000 FUNCTION RANDOM(eibtaskn + eibtime) * 2 00600000 006100 END-COMPUTE. 00610000 006200 00620000 006300 PERFORM UNTIL wins + losses = +3 00630000 006400 EXEC CICS CONVERSE CONVID(conversation-id) 00640000 006500 STATE(cvda-state) 00650000 006600 FROM(conversation-tranid) 00660000 006700 INTO(user-choice) 00670000 006800 END-EXEC 00680000 006900* EIBCOMPL should be X'FF' (RECEIVE complete). 00690000 007000* CVDA state should be SEND (90). 00700000 007100 00710000 007200 EVALUATE user-choice ALSO pgm-choice 00720000 007300 WHEN 'ROCK' ALSO 0 00730000 007400 MOVE 'Two Rocks is a tie.' TO msg1 00740000 007500 WHEN 'PAPER' ALSO 1 00750000 007600 MOVE 'Two Papers is a tie.' TO msg1 00760000 007700 WHEN 'SCISSORS' ALSO 2 00770000 007800 MOVE 'Two Scissors is a tie.' TO msg1 00780000 007900 WHEN 'ROCK' ALSO 1 00790000 008000 MOVE 'Paper covers Rock - I win!' TO msg1 00800000 008100 ADD +1 TO losses 00810000 008200 WHEN 'ROCK' ALSO 2 00820000 008300 MOVE 'Rock smashes Scissors - You win!' TO msg1 00830000 008400 ADD +1 TO wins 00840000 008500 WHEN 'PAPER' ALSO 0 00850000 008600 MOVE 'Paper covers Rock - You win!' TO msg1 00860000 008700 ADD +1 TO wins 00870000 008800 WHEN 'PAPER' ALSO 2 00880000 008900 MOVE 'Scissors cut Paper - I win!' TO msg1 00890000 009000 ADD +1 TO losses 00900000 009100 WHEN 'SCISSORS' ALSO 0 00910000 009200 MOVE 'Rock smashes Scissors - I win!' TO msg1 00920000 009300 ADD +1 TO losses 00930000 009400 WHEN 'SCISSORS' ALSO 1 00940000 009500 MOVE 'Scissors cut Paper - You win!' TO msg1 00950000 009600 ADD +1 TO wins 00960000 009700 WHEN OTHER 00970000 009800 MOVE 'You did not select "Rock", "Paper", or "Scissors". 00980000 009900- 'Please try again.' TO msg1 00990000 010000 END-EVALUATE 01000000 010100 01010000 010200* This command will reset EIBRSRCE to blank. 01020000 010300 EXEC CICS SEND TEXT FROM(msg1) ACCUM END-EXEC 01030000 010400 01040000 010500 EVALUATE TRUE 01050000 010600 WHEN local-syncpoint 01060000 010700 EXEC CICS SYNCPOINT END-EXEC 01070000 010800 WHEN local-rollback 01080000 010900 EXEC CICS SYNCPOINT ROLLBACK END-EXEC 01090000 011000 WHEN OTHER CONTINUE 01100000 011100 END-EVALUATE 01110000 011200 01120000 011300 COMPUTE pgm-choice ROUNDED = FUNCTION RANDOM * 2 01130000 011400 END-COMPUTE 01140000 011500 END-PERFORM. 01150000 011600 01160000 011700 Send-Result. 01170000 011800* This command will reset EIBRSRCE to blank. 01180000 011900 EXEC CICS SEND PAGE RETAIN END-EXEC. 01190000 012000 01200000 012100 EXEC CICS SEND CONVID(conversation-id) STATE(cvda-state) 01210000 012200 LAST 01220000 012300 END-EXEC. 01230000 012400* CVDA state should be PENDFREE (86). 01240000 012500 01250000 012600 Process-Exit. 01260000 012700 IF local-syncpoint 01270000 012800 THEN EXEC CICS SYNCPOINT END-EXEC 01280000 012900 END-IF. 01290000 013000 01300000 013100 EXEC CICS FREE CONVID(conversation-id) STATE(cvda-state) 01310000 013200 END-EXEC. 01320000 013300* CVDA state should be zero. 01330000 013400* End of conversation (no RETURN command). Dummy GOBACK. 01340000 013500 GOBACK. 01350000 013600 01360000 013700 No-Remote-Sysid. 01370000 013800 STRING 'System ' remote-sysid ' is not remote.' 01380000 013900 DELIMITED BY SIZE 01390000 014000 INTO msg1 01400000 014100 END-STRING. 01410000 014200 01420000 014300 EXEC CICS SEND FROM(msg1) ERASE END-EXEC. 01430000 014400 EXEC CICS RETURN END-EXEC. 01440000 014500 01450000 014600 No-Sysid. 01460000 014700 STRING 'System ' remote-sysid ' does not exist.' 01470000 014800 DELIMITED BY SIZE 01480000 014900 INTO msg1 01490000 015000 END-STRING. 01500000 015100 01510000 015200 EXEC CICS SEND FROM(msg1) ERASE END-EXEC. 01520000 015300 EXEC CICS RETURN END-EXEC. 01530000