000100 ID DIVISION. 00010000 000200* Change to your teamid. 00020000 000300 PROGRAM-ID. TRPGM00. 00030000 000400*AUTHOR. Kenneth W. Caldwell. 00040000 000500*INSTALLATION. Train-Right. 00050000 000600*DATE-WRITTEN. April 25, 2001. 00060000 000700*DATE-COMPILED. 00070000 000800* 00080000 000900*SECURITY. This program is for students of Train-Right 00090000 001000* courses ONLY!. 00100000 001100* 00110000 001200*REMARKS. This program is a special version of TRPGM00X. 00120000 001300* It allows any team id to add records using TR00. 00130000 001400* It is for the Advanced CICS Programming Topics. 00140000 001500* 00150000 001900 DATA DIVISION. 00190000 002000 WORKING-STORAGE SECTION. 00200000 002100 77 ws-low-value PIC X VALUE LOW-VALUES. 00210000 002200 88 ws-cursor-key VALUE 'K'. 00220000 002300 88 ws-cursor-data VALUE 'D'. 00230000 002400* 00240000 002500* 3270 Web Bridge - termid begins with right curly brace. 00250000 002600* Rebuild underlying screen from delete (no popups). 00260000 002700 77 ws-web-delete PIC X VALUE LOW-VALUES. 00270000 002800 88 ws-web-delete-no VALUE LOW-VALUES. 00280000 002900 88 ws-web-delete-yes VALUE 'Y'. 00290000 003000 00300000 003100 77 ws-length PIC S9(4) BINARY. 00310000 003200 00320000 003300 01 ws-queue-name. 00330000 003400 05 ws-queue-eibtrnid PIC X(4). 00340000 003500 05 ws-queue-eibtrmid PIC X(4). 00350000 003600 00360000 003700 01 ws-data REDEFINES ws-queue-name PIC X(8). 00370000 003800 00380000 003900 COPY TRRECORD. 00390000 004000 00400000 004100* Change to your teamid. 00410000 004200 COPY TRMAP00. 00420000 004300 00430000 004400 COPY DFHBMSCA. 00440000 004500 00450000 004600 LINKAGE SECTION. 00460000 004700 01 dfhcommarea. 00470000 004800 COPY TRCOMM. 00480000 004900 00490000 005000 COPY TBLREC. 00500000 005100 00510000 005200 PROCEDURE DIVISION. 00520000 005300 Main. 00530000 005400 EVALUATE TRUE 00540000 005500 WHEN eibcalen = ZERO 00550000 005600 EXEC CICS GETMAIN SET(ADDRESS OF dfhcommarea) 00560000 005700 FLENGTH(LENGTH OF dfhcommarea) 00570000 005800 INITIMG(ws-low-value) 00580000 005900 END-EXEC 00590000 006000 00600000 006100 GO TO Start-Records 00610000 006200 00620000 006300 WHEN pgm-xctl-return 00630000 006400* 00640000 006500* 3270 Web Bridge - termid begins with right curly brace. 00650000 006600* Rebuild underlying screen from delete (no popups). 00660000 006700 IF eibtrmid(1:1) NOT = X'D0' 00670000 006800 THEN GO TO Process-Delete-Confirm 00680000 006900 ELSE SET ws-web-delete-yes TO TRUE 00690000 007000 MOVE save-key(1) TO tr-key 00700000 007100 PERFORM Retrieve-Records 00710000 007200 GO TO Process-Delete-Confirm 00720000 007300 END-IF 00730000 007400 00740000 007500 WHEN eibtrnid NOT = 'TR00' 00750000 007600 GO TO Start-Records 00760000 007700 00770000 007800 WHEN OTHER CONTINUE 00780000 007900 END-EVALUATE. 00790000 008000 00800000 008100 Receive-Map. 00810000 008200 00820000 008300 EXEC CICS IGNORE CONDITION MAPFAIL END-EXEC. 00830000 008400 00840000 008500 EXEC CICS HANDLE AID ENTER(Process-Enter) 00850000 008600 PF3(Process-Exit) 00860000 008700 PF5(Start-Records) 00870000 008800 PF7(Scroll-Up) 00880000 008900 PF8(Scroll-Down) 00890000 009000 PF23(Process-Undo) 00900000 009100 END-EXEC. 00910000 009200 00920000 009300 EXEC CICS RECEIVE MAP('TRMAP00') 00930000 009400 MAPSET('TRMAP00') 00940000 009500 END-EXEC. 00950000 009600 00960000 009700* Change to your teamid. 00970000 009800 MOVE LOW-VALUES TO trmap00o. 00980000 009900 MOVE -1 TO save-cursor(1). 00990000 010000 MOVE 'Invalid key pressed - try again.' TO msgo. 01000000 010100 01010000 010200 Send-Data-Map. 01020000 010300 01030000 010400 MOVE save-action(1) TO action1o. 01040000 010500 MOVE save-action(2) TO action2o. 01050000 010600 MOVE save-action(3) TO action3o. 01060000 010700 MOVE save-action(4) TO action4o. 01070000 010800 MOVE save-action(5) TO action5o. 01080000 010900 01090000 011000 EVALUATE TRUE 01100000 011100 WHEN ws-cursor-key 01110000 011200 MOVE save-cursor(1) TO key1l 01120000 011300 MOVE save-cursor(2) TO key2l 01130000 011400 MOVE save-cursor(3) TO key3l 01140000 011500 MOVE save-cursor(4) TO key4l 01150000 011600 MOVE save-cursor(5) TO key5l 01160000 011700 WHEN ws-cursor-data 01170000 011800 MOVE save-cursor(1) TO data1l 01180000 011900 MOVE save-cursor(2) TO data2l 01190000 012000 MOVE save-cursor(3) TO data3l 01200000 012100 MOVE save-cursor(4) TO data4l 01210000 012200 MOVE save-cursor(5) TO data5l 01220000 012300 WHEN OTHER 01230000 012400 MOVE save-cursor(1) TO action1l 01240000 012500 MOVE save-cursor(2) TO action2l 01250000 012600 MOVE save-cursor(3) TO action3l 01260000 012700 MOVE save-cursor(4) TO action4l 01270000 012800 MOVE save-cursor(5) TO action5l 01280000 012900 END-EVALUATE. 01290000 013000 01300000 013100 MOVE save-attribute(1) TO action1a. 01310000 013200 MOVE save-attribute(2) TO action2a. 01320000 013300 MOVE save-attribute(3) TO action3a. 01330000 013400 MOVE save-attribute(4) TO action4a. 01340000 013500 MOVE save-attribute(5) TO action5a. 01350000 013600* 01360000 013700* 3270 Web Bridge - termid begins with right curly brace. 01370000 013800* Resend underlying screen in case of delete (no popups). 01380000 013900 IF ws-web-delete-yes 01390000 014000 THEN GO TO Send-Whole-Map 01400000 014100 END-IF. 01410000 014200 01420000 014300 EXEC CICS SEND MAP('TRMAP00') 01430000 014400 MAPSET('TRMAP00') 01440000 014500 DATAONLY 01450000 014600 CURSOR 01460000 014700 END-EXEC. 01470000 014800 01480000 014900 EXEC CICS RETURN TRANSID('TR00') 01490000 015000 COMMAREA(dfhcommarea) 01500000 015100 END-EXEC. 01510000 015200 01520000 015300 Start-Records. 01530000 015400 01540000 015500 MOVE LOW-VALUES TO tr-key. 01550000 015600 01560000 015700 GO TO Retrieve-Records. 01570000 015800 01580000 015900 Scroll-Up. 01590000 016000 01600000 016100 EXEC CICS HANDLE CONDITION NOTOPEN(Process-Not-Open) 01610000 016200 ENDFILE(Process-Beg-Of-File) 01620000 016300 NOTFND(Process-End-Of-File) 01630000 016400 END-EXEC. 01640000 016500 01650000 016600 MOVE save-key(1) TO tr-key 01660000 016700 01670000 016800 EXEC CICS STARTBR FILE('TRVSAM') 01680000 016900 RIDFLD(tr-key) 01690000 017000 GTEQ 01700000 017100 END-EXEC. 01710000 017200 01720000 017300 PERFORM 6 times 01730000 017400 EXEC CICS READPREV FILE('TRVSAM') 01740000 017500 RIDFLD(tr-key) 01750000 017600 INTO(tr-record) 01760000 017700 END-EXEC 01770000 017800 END-PERFORM. 01780000 017900 01790000 018000 Process-Beg-Of-File. 01800000 018100 01810000 018200 MOVE tr-key TO scroll-key. 01820000 018300 01830000 018400 EXEC CICS ENDBR FILE('TRVSAM') 01840000 018500 END-EXEC. 01850000 018600 01860000 018700 GO TO Retrieve-Records. 01870000 018800 01880000 018900 Scroll-Down. 01890000 019000 01900000 019100 IF scroll-end 01910000 019200* Change to your teamid. 01920000 019300 THEN MOVE LOW-VALUES TO trmap00o 01930000 019400 MOVE -1 TO save-cursor(1) 01940000 019500 MOVE 'Scrolling not available - end of file.' TO msgo 01950000 019600 01960000 019700 GO TO Send-Data-Map 01970000 019800 ELSE 01980000 019900 MOVE scroll-key TO tr-key 01990000 020000 END-IF. 02000000 020100 02010000 020200 Retrieve-Records. 02020000 020300* 02030000 020400* 3270 Web Bridge - termid begins with right curly brace. 02040000 020500* Rebuild underlying screen from delete (no popups). 02050000 020600 IF ws-web-delete-yes 02060000 020700* Change to your teamid. 02070000 020800 THEN MOVE LOW-VALUES TO trmap00o 02080000 020900 ELSE 02090000 021000* Change to your teamid. 02100000 021100 MOVE LOW-VALUES TO trmap00o, save-area 02110000 021200 MOVE -1 TO action1l 02120000 021300 END-IF. 02130000 021400 02140000 021500 MOVE dfhprotn TO action1a, team1a, key1a, data1a, 02150000 021600 save-attribute(1), 02160000 021700 action2a, team2a, key2a, data2a, 02170000 021800 save-attribute(2), 02180000 021900 action3a, team3a, key3a, data3a, 02190000 022000 save-attribute(3), 02200000 022100 action4a, team4a, key4a, data4a, 02210000 022200 save-attribute(4), 02220000 022300 action5a, team5a, key5a, data5a, 02230000 022400 save-attribute(5). 02240000 022500 02250000 022600 EXEC CICS HANDLE CONDITION NOTOPEN(Process-Not-Open) 02260000 022700 ENDFILE(Process-End-Of-File) 02270000 022800 NOTFND(Process-End-Of-File) 02280000 022900 END-EXEC. 02290000 023000 02300000 023100 EXEC CICS STARTBR FILE('TRVSAM') 02310000 023200 RIDFLD(tr-key) 02320000 023300 GTEQ 02330000 023400 END-EXEC. 02340000 023500 02350000 023600 EXEC CICS READNEXT FILE('TRVSAM') 02360000 023700 RIDFLD(tr-key) 02370000 023800 INTO(tr-record) 02380000 023900 END-EXEC. 02390000 024000 02400000 024100 MOVE tr-key TO save-key(1). 02410000 024200 MOVE tr-key-team TO team1o. 02420000 024300 MOVE tr-key-num TO key1o. 02430000 024400 MOVE tr-data TO data1o. 02440000 024500 MOVE dfhbmfse TO action1a, save-attribute(1). 02450000 024600 MOVE dfhbmpro TO team1a, key1a, data1a. 02460000 024700 02470000 024800 EXEC CICS READNEXT FILE('TRVSAM') 02480000 024900 RIDFLD(tr-key) 02490000 025000 INTO(tr-record) 02500000 025100 END-EXEC. 02510000 025200 02520000 025300 MOVE tr-key TO save-key(2). 02530000 025400 MOVE tr-key-team TO team2o. 02540000 025500 MOVE tr-key-num TO key2o. 02550000 025600 MOVE tr-data TO data2o. 02560000 025700 MOVE dfhbmfse TO action2a, save-attribute(2). 02570000 025800 MOVE dfhbmpro TO team2a, key2a, data2a. 02580000 025900 02590000 026000 EXEC CICS READNEXT FILE('TRVSAM') 02600000 026100 RIDFLD(tr-key) 02610000 026200 INTO(tr-record) 02620000 026300 END-EXEC. 02630000 026400 02640000 026500 MOVE tr-key TO save-key(3). 02650000 026600 MOVE tr-key-team TO team3o. 02660000 026700 MOVE tr-key-num TO key3o. 02670000 026800 MOVE tr-data TO data3o. 02680000 026900 MOVE dfhbmfse TO action3a, save-attribute(3). 02690000 027000 MOVE dfhbmpro TO team3a, key3a, data3a. 02700000 027100 02710000 027200 EXEC CICS READNEXT FILE('TRVSAM') 02720000 027300 RIDFLD(tr-key) 02730000 027400 INTO(tr-record) 02740000 027500 END-EXEC. 02750000 027600 02760000 027700 MOVE tr-key TO save-key(4). 02770000 027800 MOVE tr-key-team TO team4o. 02780000 027900 MOVE tr-key-num TO key4o. 02790000 028000 MOVE tr-data TO data4o. 02800000 028100 MOVE dfhbmfse TO action4a, save-attribute(4). 02810000 028200 MOVE dfhbmpro TO team4a, key4a, data4a. 02820000 028300 02830000 028400 EXEC CICS READNEXT FILE('TRVSAM') 02840000 028500 RIDFLD(tr-key) 02850000 028600 INTO(tr-record) 02860000 028700 END-EXEC. 02870000 028800 02880000 028900 MOVE tr-key TO save-key(5). 02890000 029000 MOVE tr-key-team TO team5o. 02900000 029100 MOVE tr-key-num TO key5o. 02910000 029200 MOVE tr-data TO data5o. 02920000 029300 MOVE dfhbmfse TO action5a, save-attribute(5). 02930000 029400 MOVE dfhbmpro TO team5a, key5a, data5a. 02940000 029500 02950000 029600 EXEC CICS READNEXT FILE('TRVSAM') 02960000 029700 RIDFLD(tr-key) 02970000 029800 INTO(tr-record) 02980000 029900 END-EXEC. 02990000 030000 03000000 030100 EXEC CICS ENDBR FILE('TRVSAM') 03010000 030200 END-EXEC. 03020000 030300 03030000 030400 MOVE 'More records exist - Scrolling available.' TO msgo. 03040000 030500 MOVE tr-key TO scroll-key. 03050000 030600 03060000 030700 Send-Whole-Map. 03070000 030800 03080000 030900 EXEC CICS SEND MAP('TRMAP00') 03090000 031000 MAPSET('TRMAP00') 03100000 031100 ERASE 03110000 031200 CURSOR 03120000 031300 END-EXEC. 03130000 031400 03140000 031500 EXEC CICS RETURN TRANSID('TR00') 03150000 031600 COMMAREA(dfhcommarea) 03160000 031700 END-EXEC. 03170000 031800 03180000 031900 Process-End-Of-File. 03190000 032000 03200000 032100 EXEC CICS ENDBR FILE('TRVSAM') 03210000 032200 END-EXEC. 03220000 032300 03230000 032400 MOVE 'End of file reached - no more records.' TO msgo. 03240000 032500 SET scroll-end TO TRUE. 03250000 032600 03260000 032700 GO TO Send-Whole-Map. 03270000 032800 03280000 032900 Process-Not-Open. 03290000 033000 03300000 033100 MOVE 'File not open - try again later.' TO msgo. 03310000 033200 03320000 033300 GO TO Send-Whole-Map. 03330000 033400 03340000 033500 Process-Enter. 03350000 033600 03360000 033700 MOVE action1i TO save-action(1). 03370000 033800 MOVE action2i TO save-action(2). 03380000 033900 MOVE action3i TO save-action(3). 03390000 034000 MOVE action4i TO save-action(4). 03400000 034100 MOVE action5i TO save-action(5). 03410000 034200 03420000 034300 IF pgm-add-return 03430000 034400 THEN GO TO Process-Add-Complete 03440000 034500 ELSE 03450000 034600 IF pgm-change-return 03460000 034700 THEN GO TO Process-Change-Complete 03470000 034800 END-IF. 03480000 034900 03490000 035000* Change to your teamid. 03500000 035100 MOVE LOW-VALUES TO trmap00o. 03510000 035200 MOVE SPACES TO msgo. 03520000 035300 03530000 035400 MOVE ZERO TO save-cursor(1), save-cursor(2), 03540000 035500 save-cursor(3), save-cursor(4), 03550000 035600 save-cursor(5). 03560000 035700 03570000 035800 MOVE +1 TO save-sub. 03580000 035900 03590000 036000 Process-Continue. 03600000 036100 03610000 036200 SET pgm-normal TO TRUE. 03620000 036300 03630000 036400 PERFORM VARYING save-sub FROM save-sub BY +1 03640000 036500 UNTIL save-sub > +5 03650000 036600 EVALUATE save-action(save-sub) 03660000 036700 WHEN LOW-VALUES CONTINUE 03670000 036800 WHEN SPACES CONTINUE 03680000 036900 WHEN '*' CONTINUE 03690000 037000 WHEN 'A' GO TO Process-Add 03700000 037100 WHEN 'C' GO TO Process-Change 03710000 037200 WHEN 'D' GO TO Process-Delete 03720000 037300 WHEN OTHER MOVE 'Invalid action code.' TO msgo 03730000 037400 MOVE -1 TO save-cursor(save-sub) 03740000 037500 GO TO Send-Data-Map 03750000 037600 END-EVALUATE 03760000 037700 END-PERFORM. 03770000 037800 03780000 037900 GO TO Send-Data-Map. 03790000 038000 03800000 038100 Process-Add. 03810000 038200 03820000 038300 MOVE 'Enter new data on line with cursor or remove action cod03830000 038400- 'e and press Enter.' 03840000 038500 TO msgo. 03850000 038600 03860000 038700 Process-Add-Repeat. 03870000 038710* Special version - allow team id to be entered. 03871000 038900 EVALUATE save-sub 03890000 039000 WHEN 1 MOVE dfhbmfse TO team1a, key1a, data1a 03900001 039400 WHEN 2 MOVE dfhbmfse TO team2a, key2a, data2a 03940001 039800 WHEN 3 MOVE dfhbmfse TO team3a, key3a, data3a 03980001 040200 WHEN 4 MOVE dfhbmfse TO team4a, key4a, data4a 04020001 040600 WHEN 5 MOVE dfhbmfse TO team5a, key5a, data5a 04060001 041000 WHEN OTHER CONTINUE 04100000 041100 END-EVALUATE. 04110000 041200 04120000 041300 MOVE -1 TO save-cursor(save-sub) 04130000 041400 04140000 041500 SET pgm-add-return TO TRUE. 04150000 041600 04160000 041700 GO TO Send-Data-Map. 04170000 041800 04180000 041900 Process-Add-Complete. 04190000 042000 04200000 042100 MOVE ZERO TO save-cursor(save-sub). 04210000 042110* Special version - allow team id to be entered. 04211000 042200 MOVE SPACES TO tr-record. 04220000 042300 04230000 042400 EVALUATE save-sub 04240000 042500 WHEN 1 MOVE team1i TO tr-key-team 04250000 042600 MOVE key1i TO tr-key-num 04260000 042700 MOVE data1i TO tr-data 04270000 042800 MOVE dfhbmpro TO team1a, key1a, data1a 04280000 042900 04290000 043000 WHEN 2 MOVE team2i TO tr-key-team 04300000 043100 MOVE key2i TO tr-key-num 04310000 043200 MOVE data2i TO tr-data 04320000 043300 MOVE dfhbmpro TO team2a, key2a, data2a 04330000 043400 04340000 043500 WHEN 3 MOVE team3i TO tr-key-team 04350000 043600 MOVE key3i TO tr-key-num 04360000 043700 MOVE data3i TO tr-data 04370000 043800 MOVE dfhbmpro TO team3a, key3a, data3a 04380000 043900 04390000 044000 WHEN 4 MOVE team4i TO tr-key-team 04400000 044100 MOVE key4i TO tr-key-num 04410000 044200 MOVE data4i TO tr-data 04420000 044300 MOVE dfhbmpro TO team4a, key4a, data4a 04430000 044400 04440000 044500 WHEN 5 MOVE team5i TO tr-key-team 04450000 044600 MOVE key5i TO tr-key-num 04460000 044610 MOVE data5i TO tr-data 04461000 044620 MOVE dfhbmpro TO team5a, key5a, data5a 04462000 044630 04463000 044640 WHEN OTHER CONTINUE 04464000 044650 END-EVALUATE. 04465000 044700 04470000 044800 MOVE tr-key TO save-key(save-sub). 04480000 044900 04490000 045000 EVALUATE TRUE 04500000 045100 WHEN save-action(save-sub) NOT = 'A' 04510000 045200 MOVE 'Add action removed. Continuing with action codes04520000 045300- '.' 04530000 045400 TO msgo 04540000 045500 GO TO Process-Continue 04550000 045600 04560000 045700* Special version - allow team id to be entered. 04570000 045800 WHEN tr-key-team NOT > SPACES 04580000 045810 OR tr-key-num NOT > SPACES 04581000 045820 OR tr-data NOT > SPACES 04582000 045900 MOVE 'Fields missing for Add action code.' TO msgo 04590000 046000 SET ws-cursor-key TO TRUE 04600000 046100 GO TO Process-Add-Repeat 04610000 046300 WHEN OTHER 04630000 046400 CONTINUE 04640000 048700 END-EVALUATE. 04870000 048800 04880000 048900 EXEC CICS HANDLE CONDITION DUPREC(Process-Add-Duplicate) 04890000 049000 END-EXEC. 04900000 049100 04910000 049200 EXEC CICS WRITE FILE('TRVSAM') 04920000 049300 RIDFLD(tr-key) 04930000 049400 FROM(tr-record) 04940000 049500 END-EXEC. 04950000 049600 04960000 049700 MOVE '*' TO save-action(save-sub). 04970000 049800 04980000 049900 MOVE 'Record added. Continuing with action codes.' 04990000 050000 TO msgo. 05000000 050100 05010000 050200 GO TO Process-Continue. 05020000 050300 05030000 050400 Process-Add-Duplicate. 05040000 050500 05050000 050600 MOVE 'Record with key already exists. Change the key value.' 05060000 050700 TO msgo. 05070000 050800 05080000 050900 SET ws-cursor-key TO TRUE. 05090000 051000 05100000 051100 GO TO Process-Add-Repeat. 05110000 051200 05120000 051300 Process-Change. 05130000 051400 05140000 051500 MOVE 'Change data on line with cursor or remove action code a05150000 051600- 'nd press Enter.' 05160000 051700 TO msgo. 05170000 051800 05180000 051900 Process-Change-Repeat. 05190000 052000 05200000 052100 EVALUATE save-sub 05210000 052200 WHEN 1 MOVE dfhbmfse TO data1a 05220000 052300 MOVE dfhbmpro TO team1a, key1a 05230000 052400 05240000 052500 WHEN 2 MOVE dfhbmfse TO data2a 05250000 052600 MOVE dfhbmpro TO team2a, key2a 05260000 052700 05270000 052800 WHEN 3 MOVE dfhbmfse TO data3a 05280000 052900 MOVE dfhbmpro TO team3a, key3a 05290000 053000 05300000 053100 WHEN 4 MOVE dfhbmfse TO data4a 05310000 053200 MOVE dfhbmpro TO team4a, key4a 05320000 053300 05330000 053400 WHEN 5 MOVE dfhbmfse TO data5a 05340000 053500 MOVE dfhbmpro TO team5a, key5a 05350000 053600 05360000 053700 WHEN OTHER CONTINUE 05370000 053800 END-EVALUATE. 05380000 053900 05390000 054000 MOVE -1 TO save-cursor(save-sub). 05400000 054100 05410000 054200 SET pgm-change-return TO TRUE. 05420000 054300 05430000 054400 GO TO Send-Data-Map. 05440000 054500 05450000 054600 Process-Change-Complete. 05460000 054700 05470000 054800 MOVE ZERO TO save-cursor(save-sub). 05480000 054900 MOVE save-key(save-sub) TO tr-key. 05490000 055000 05500000 055100 EVALUATE save-sub 05510000 055200 WHEN 1 MOVE data1i TO ws-data 05520000 055300 MOVE dfhbmpro TO data1a 05530000 055400 05540000 055500 WHEN 2 MOVE data2i TO ws-data 05550000 055600 MOVE dfhbmpro TO data2a 05560000 055700 05570000 055800 WHEN 3 MOVE data3i TO ws-data 05580000 055900 MOVE dfhbmpro TO data3a 05590000 056000 05600000 056100 WHEN 4 MOVE data4i TO ws-data 05610000 056200 MOVE dfhbmpro TO data4a 05620000 056300 05630000 056400 WHEN 5 MOVE data5i TO ws-data 05640000 056500 MOVE dfhbmpro TO data5a 05650000 056600 05660000 056700 WHEN OTHER CONTINUE 05670000 056800 END-EVALUATE. 05680000 056900 05690000 057000 EVALUATE TRUE 05700000 057100 WHEN save-action(save-sub) NOT = 'C' 05710000 057200 MOVE 'Change action removed. Continuing with action co05720000 057300- 'des.' 05730000 057400 TO msgo 05740000 057500 GO TO Process-Continue 05750000 057600 05760000 057700 WHEN ws-data NOT > SPACES 05770000 057800 MOVE 'Data missing for Change action code.' TO msgo 05780000 057900 SET ws-cursor-data TO TRUE 05790000 058000 GO TO Process-Change-Repeat 05800000 058100 05810000 058200 WHEN OTHER 05820000 058300 EXEC CICS LOAD PROGRAM('TRTABLE') 05830000 058400 SET(ADDRESS OF tr-table) 05840000 058500 LENGTH(ws-length) 05850000 058600 END-EXEC 05860000 058700 05870000 058800 DIVIDE 10 INTO ws-length 05880000 058900 05890000 059000 SET tr-index TO 1 05900000 059100 SEARCH tr-table-entries 05910000 059200 AT END MOVE 'Data field is invalid.' TO msgo 05920000 059300 SET ws-cursor-data TO TRUE 05930000 059400 GO TO Process-Change-Repeat 05940000 059500 WHEN tr-table-data(tr-index) = ws-data 05950000 059600 CONTINUE 05960000 059700 END-SEARCH 05970000 059800 END-EVALUATE. 05980000 059900 05990000 060000 EXEC CICS READ FILE('TRVSAM') 06000000 060100 INTO(tr-record) 06010000 060200 RIDFLD(tr-key) 06020000 060300 UPDATE 06030000 060400 END-EXEC. 06040000 060500 06050000 060600 MOVE ws-data TO tr-data. 06060000 060700 06070000 060800 EXEC CICS REWRITE FILE('TRVSAM') 06080000 060900 FROM(tr-record) 06090000 061000 END-EXEC. 06100000 061100 06110000 061200 MOVE '*' TO save-action(save-sub). 06120000 061300 06130000 061400 MOVE 'Record changed. Continuing with action codes.' 06140000 061500 TO msgo. 06150000 061600 06160000 061700 GO TO Process-Continue. 06170000 061800 06180000 061900 Process-Delete. 06190000 062000 06200000 062100* Change to your teamid. 06210000 062200 MOVE 'TRPGM00' TO pgm-xctl-from. 06220000 062300 06230000 062400 MOVE SPACES TO pgm-message. 06240000 062500 STRING 'Delete record ' DELIMITED BY SIZE, 06250000 062600 save-key(save-sub) DELIMITED BY SIZE, 06260000 062700 ' ?' DELIMITED BY SIZE 06270000 062800 INTO pgm-message. 06280000 062900 06290000 063000 EXEC CICS XCTL PROGRAM('TRYESNO') 06300000 063100 COMMAREA(dfhcommarea) 06310000 063200 END-EXEC. 06320000 063300 06330000 063400 Process-Delete-Confirm. 06340000 063500 06350000 063600 IF pgm-yes 06360000 063700 THEN EXEC CICS IGNORE CONDITION NOTFND END-EXEC 06370000 063800 06380000 063900 EXEC CICS READ FILE('TRVSAM') 06390000 064000 INTO(tr-record) 06400000 064100 RIDFLD(save-key(save-sub)) 06410000 064200 EQUAL 06420000 064300 END-EXEC 06430000 064400 06440000 064500* Change to your teamid. 06450000 064600 MOVE 'TR00' TO ws-queue-eibtrnid 06460000 064700 MOVE eibtrmid TO ws-queue-eibtrmid 06470000 064800 06480000 064900 EXEC CICS WRITEQ TS QUEUE(ws-queue-name) 06490000 065000 FROM(tr-record) 06500000 065100 END-EXEC 06510000 065200 06520000 065300 EXEC CICS DELETE FILE('TRVSAM') 06530000 065400 RIDFLD(save-key(save-sub)) 06540000 065500 END-EXEC 06550000 065600 06560000 065700 MOVE '*' TO save-action(save-sub) 06570000 065800 06580000 065900 MOVE 'Record deleted. Continuing with action codes.' 06590000 066000 TO msgo 06600000 066100 ELSE 06610000 066200 MOVE SPACE TO save-action(save-sub) 06620000 066300 06630000 066400 MOVE 'Record not deleted. Continuing with action codes.'06640000 066500 TO msgo 06650000 066600 END-IF. 06660000 066700 06670000 066800 GO TO Process-Continue. 06680000 066900 06690000 067000 Process-Undo. 06700000 067100 06710000 067200 MOVE eibtrnid TO ws-queue-eibtrnid. 06720000 067300 MOVE eibtrmid TO ws-queue-eibtrmid. 06730000 067400 06740000 067500 EXEC CICS HANDLE CONDITION QIDERR(Process-Undo-Error) 06750000 067600 END-EXEC. 06760000 067700 06770000 067800 EXEC CICS READQ TS QUEUE(ws-queue-name) 06780000 067900 INTO(tr-record) 06790000 068000 END-EXEC 06800000 068100 06810000 068200 EXEC CICS WRITE FILE('TRVSAM') 06820000 068300 FROM(tr-record) 06830000 068400 RIDFLD(tr-key) 06840000 068500 END-EXEC. 06850000 068600 06860000 068700 EXEC CICS DELETEQ TS QUEUE(ws-queue-name) END-EXEC. 06870000 068800 06880000 068900 MOVE 'Record restored. Press another valid key to continue.' 06890000 069000 TO msgo. 06900000 069100 06910000 069200 GO TO Send-Data-Map. 06920000 069300 06930000 069400 Process-Undo-Error. 06940000 069500 06950000 069600 MOVE 'Undo not available.' 06960000 069700 TO msgo. 06970000 069800 06980000 069900 GO TO Send-Data-Map. 06990000 070000 07000000 070100 Process-Exit. 07010000 070200 07020000 070300 MOVE eibtrnid TO ws-queue-eibtrnid. 07030000 070400 MOVE eibtrmid TO ws-queue-eibtrmid. 07040000 070500 07050000 070600 EXEC CICS IGNORE CONDITION QIDERR END-EXEC. 07060000 070700 07070000 070800 EXEC CICS DELETEQ QUEUE(ws-queue-name) END-EXEC. 07080000 070900 07090000 071000 MOVE 'End of Application.' TO msgo. 07100000 071100 07110000 071200 EXEC CICS SEND FROM(msgo) LENGTH(19) ERASE END-EXEC. 07120000 071300 07130000 071400 EXEC CICS RETURN END-EXEC. 07140000 071500 07150000 071600 GOBACK. 07160000