000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM75. 00020000 000300*AUTHOR. Kenneth W. Caldwell. 00030000 000400*INSTALLATION. Train-Right. 00040000 000500*DATE-WRITTEN. January 15, 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 displays a VSAM record. 00110000 001200* It is a Non-Conversational program. 00120000 001300* 00130000 001400 DATA DIVISION. 00140000 001500 WORKING-STORAGE SECTION. 00150000 001600 01. 00160000 001700 05 result. 00170000 001800 10 user-area. 00180000 001900 15 user-input. 00190000 002000 20 PIC X(5) VALUE SPACES. 00200000 002100 20 user-team PIC X(5) VALUE SPACES. 00210000 002200 20 user-num PIC X(2) VALUE SPACES. 00220000 002300 15 PIC X(68) VALUE SPACES. 00230000 002400 10 msg1 PIC X(80). 00240000 002500 COPY TRRECORD REPLACING ==01== BY ==10== 00250000 002600 ==05== BY ==15== 00260000 002700 ==10== BY ==20==. 00270000 002800 10 msg2 PIC X(80) VALUE 00280000 002900 'Change your choice and press ENTER to play again. Cle00290000 003000- 'ar screen to stop playing.'. 00300000 003100 00310000 003200 LINKAGE SECTION. 00320000 003300 00330000 003400 PROCEDURE DIVISION. 00340000 003500 Main. 00350000 003600 EXEC CICS IGNORE CONDITION LENGERR END-EXEC. 00360000 003700 00370000 003800 Receive-Trans-Input. 00380000 003900* Receive updates eibcposn. 00390000 004000 EXEC CICS RECEIVE INTO(user-input) 00400000 004100 MAXFLENGTH(LENGTH OF user-input) 00410000 004200 END-EXEC. 00420000 004300 00430000 004400 Process-Data. 00440000 004500 EXEC CICS HANDLE CONDITION NOTFND(No-Record) END-EXEC. 00450000 004600 00460000 004700 EVALUATE user-team ALSO user-num 00470000 004800 WHEN SPACES ALSO SPACES 00480000 004900 MOVE 'No key information entered. 1st record displayed.' 00490000 005000 TO msg1 00500000 005100 MOVE LOW-VALUES TO tr-key 00510000 005200 EXEC CICS READ FILE('TRVSAM') INTO(tr-record) 00520000 005300 RIDFLD(tr-key) 00530000 005400 GTEQ 00540000 005500 END-EXEC 00550000 005600 WHEN NOT SPACES ALSO SPACES 00560000 005700 MOVE 'Teamid only entered. 1st record for team displayed.' 00570000 005800 TO msg1 00580000 005900 MOVE user-team TO tr-key-team 00590000 006000 EXEC CICS READ FILE('TRVSAM') INTO(tr-record) 00600000 006100 RIDFLD(tr-key) 00610000 006200 KEYLENGTH(LENGTH OF tr-key-team) 00620000 006300 GENERIC 00630000 006400 EQUAL 00640000 006500 END-EXEC 00650000 006600 WHEN OTHER 00660000 006700 MOVE 'Teamid and number entered. Exact match required.' 00670000 006800 TO msg1 00680000 006900 MOVE user-team TO tr-key-team 00690000 007000 MOVE user-num TO tr-key-num 00700000 007100 EXEC CICS READ FILE('TRVSAM') INTO(tr-record) 00710000 007200 RIDFLD(tr-key) 00720000 007300 EQUAL 00730000 007400 END-EXEC 00740000 007500 END-EVALUATE. 00750000 007600 00760000 007700 Send-Result. 00770000 007800 EXEC CICS SEND FROM(result) ERASE END-EXEC. 00780000 007900 00790000 008000 Process-Exit. 00800000 008100 EXEC CICS RETURN END-EXEC. 00810000 008200* Dummy GOBACK. 00820000 008300 GOBACK. 00830000 008400 00840000 008500 No-Record. 00850000 008600 MOVE 'No record found with provided information.' TO msg1. 00860000 008700 MOVE SPACES TO tr-record. 00870000 008800 GO TO Send-Result. 00880000