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