000100 ID DIVISION. 00010000
000200 PROGRAM-ID. TRPDOC00. 00020000
000300*AUTHOR. Kenneth W. Caldwell. 00030000
000400*INSTALLATION. Train-Right. 00040000
000500*DATE-WRITTEN. May 18, 2007. 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 is a DOCUMENT EXIT program. 00110000
001200* It builds a document for use by another program. 00120000
001300* It uses the result buffer passed from CICS to 00130000
001400* build and return the document. 00140000
001500* 00150000
001600 DATA DIVISION. 00160000
001700 WORKING-STORAGE SECTION. 00170000
001800 01. 00180000
001900 05 ws-length PIC S9(8) BINARY. 00190000
002000 05 doc-token PIC X(16). 00200000
002100 05 doc-pulldown PIC X(12) VALUE 'tr-pulldown='. 00210000
002200 05 doc-symbollist PIC X(400). 00220000
002300 05 doc-symbollist-length PIC S9(8) BINARY. 00230000
002400 00240000
002500 LINKAGE SECTION. 00250000
002600* Data passed to the DOCUMENT exit program. 00260000
002700 COPY DFHDHTXO. 00270000
002800* Data area passed to the DOCUMENT exit program for result. 00280000
002900 01 doc-buffer. 00290000
003000 05 PIC X OCCURS 0 TO 32767 TIMES 00300000
003100 DEPENDING ON dhtx-buffer-len. 00310000
003200 00320000
003300 01 doc-name PIC X(48). 00330000
003400 00340000
003500 COPY TBLREC. 00350000
003600 00360000
003700 PROCEDURE DIVISION. 00370000
003800 Main. 00380000
003900* Initialize DOCUMENT exit data area. 00390000
004000 EXEC CICS ADDRESS COMMAREA(ADDRESS OF dhtx-plist) END-EXEC. 00400000
004100 MOVE ZERO TO dhtx-message-len, 00410000
004200 dhtx-return-code, 00420000
004300 dhtx-template-len 00430000
004400* dhtx-cache-response. 00440001
004500 MOVE '1' TO dhtx-append-crlf. 00450000
004600 SET dhtx-message-ptr TO NULL. 00460000
004700 SET ADDRESS OF doc-buffer TO dhtx-buffer-ptr. 00470000
004800 SET ADDRESS OF doc-name TO dhtx-template-name-ptr. 00480000
004900 00490000
005000*Receive-Trans-Input. 00500000
005100 00510000
005200 Process-Data. 00520000
005300 EXEC CICS LOAD PROGRAM('TRTABLE') 00530000
005400 SET(ADDRESS OF tr-table) 00540000
005500 FLENGTH(ws-length) 00550000
005600 END-EXEC. 00560000
005700 00570000
005800 DIVIDE ws-length BY LENGTH OF tr-table-entries 00580000
005900 GIVING ws-length 00590000
006000 END-DIVIDE. 00600000
006100 00610000
006200 MOVE +1 TO doc-symbollist-length. 00620000
006300 STRING doc-pulldown 00630000
006400 '