000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM76. 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 LINK's or XCTL's to program TRPGM75.00110000 001200* Program TRPGM75 either RETURN's or XCTL's back. 00120000 001300* It is a Non-Conversational program. 00130000 001400* 00140000 001500 DATA DIVISION. 00150000 001600 WORKING-STORAGE SECTION. 00160000 001700 01. 00170000 001800 05 invoking-pgm PIC X(8). 00180000 001900 05 user-input. 00190000 002000 10 PIC X(5) VALUE SPACES. 00200000 002100 10 user-data PIC X(5) VALUE SPACES. 00210000 002200 00220000 002300 05 input-msg PIC X(12) VALUE 'TR76 TR00 08'. 00230000 002400* 05 input-msg PIC X(9) VALUE 'TR76 TR00'. 00240000 002500* 05 input-msg PIC X(4) VALUE 'TR76'. 00250000 002600* 05 input-msg PIC X(4) VALUE 'TRxx'. 00260000 002700 00270000 002800 LINKAGE SECTION. 00280000 002900 01 dfhcommarea. 00290000 003000 COPY TRRECORD REPLACING ==01== BY ==10== 00300000 003100 ==05== BY ==15== 00310000 003200 ==10== BY ==20==. 00320000 003300 00330000 003400 PROCEDURE DIVISION. 00340000 003500 Main. 00350000 003600 EXEC CICS ASSIGN INVOKINGPROG(invoking-pgm) END-EXEC. 00360000 003700 00370000 003800 IF invoking-pgm > SPACES 00380000 003900 THEN GO TO Process-Exit 00390000 004000 END-IF. 00400000 004100 00410000 004200 Receive-Trans-Input. 00420000 004300 EXEC CICS IGNORE CONDITION LENGERR END-EXEC. 00430000 004400 EXEC CICS RECEIVE INTO(user-input) 00440000 004500 MAXFLENGTH(LENGTH OF user-input) 00450000 004600 END-EXEC. 00460000 004700 00470000 004800 Process-Data. 00480000 004900 EVALUATE user-data 00490000 005000 WHEN 'XCTL' 00500000 005100 EXEC CICS XCTL PROGRAM('TRPGM75') 00510000 005200 INPUTMSG(input-msg) 00520000 005300 INPUTMSGLEN(LENGTH OF input-msg) 00530000 005400 END-EXEC 00540000 005500* WHEN 'LINK' 00550000 005600 WHEN OTHER 00560000 005700 EXEC CICS GETMAIN SET(ADDRESS OF dfhcommarea) 00570000 005800 FLENGTH(LENGTH OF dfhcommarea) 00580000 005900 END-EXEC 00590000 006000 00600000 006100 EXEC CICS LINK PROGRAM('TRPGM75') 00610000 006200 INPUTMSG(input-msg) 00620000 006300 INPUTMSGLEN(LENGTH OF input-msg) 00630000 006400 COMMAREA(tr-record) 00640000 006500 END-EXEC 00650000 006600 END-EVALUATE. 00660000 006700 00670000 006800*Send-Result. 00680000 006900 00690000 007000 Process-Exit. 00700000 007100 EXEC CICS RETURN END-EXEC. 00710000 007200* Dummy GOBACK. 00720000 007300 GOBACK. 00730000