000100 ID DIVISION.                                                     00010000
000200 PROGRAM-ID.     TRPGM88.                                         00020000
000300*AUTHOR.         Kenneth W. Caldwell.                             00030000
000400*INSTALLATION.   Train-Right.                                     00040000
000500*DATE-WRITTEN.   November 18, 2010.                               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 demonstrates the use of DOCUMENT    00110000
001200*                commands.                                        00120000
001300*                                                                 00130000
001400 DATA DIVISION.                                                   00140000
001500 WORKING-STORAGE SECTION.                                         00150000
001600 77  ws-low-value  PIC X      VALUE LOW-VALUES.                   00160000
001700 77  doctoken      PIC X(16)  VALUE SPACES.                       00170000
001800 77  doctext       PIC X(26)  VALUE 'This+is+a+&text;+document.'. 00180000
001900 77  doclength     PIC S9(8)  BINARY VALUE ZERO.                  00190000
002000 77  templength    PIC S9(8)  BINARY VALUE ZERO.                  00200000
002100 77  docsymbols    PIC X(17)  VALUE 'text=Ken+Caldwell'.          00210000
002200 77  tempsymbols   PIC X(25)  VALUE 'dfhwbpw_form_encoding=xyz'.  00220000
002300 77  docarea       PIC X(1000) VALUE SPACES.                      00230000
002400                                                                  00240000
002500 LINKAGE SECTION.                                                 00250000
002600 01  dfhcommarea   PIC X.                                         00260000
002700                                                                  00270000
002800 PROCEDURE DIVISION.                                              00280000
002900 Main.                                                            00290000
003000*    EXEC CICS DOCUMENT CREATE DOCTOKEN(doctoken)                 00300000
003100*                              TEXT(doctext)                      00310000
003200*                              LENGTH(LENGTH OF doctext)          00320000
003300*                              SYMBOLLIST(docsymbols)             00330000
003400*                              LISTLENGTH(LENGTH OF docsymbols)   00340000
003500*                              END-EXEC.                          00350000
003600*                                                                 00360000
003700     EXEC CICS DOCUMENT CREATE DOCTOKEN(doctoken)                 00370000
003800                               TEMPLATE('DFHWBPW4')               00380000
003900                               SYMBOLLIST(tempsymbols)            00390000
004000                               LISTLENGTH(LENGTH OF tempsymbols)  00400000
004100                               DOCSIZE(templength)                00410000
004200                               END-EXEC.                          00420000
004300                                                                  00430000
004400     EXEC CICS DOCUMENT RETRIEVE DOCTOKEN(doctoken)               00440000
004500                                 INTO(docarea)                    00450000
004600                                 LENGTH(doclength)                00460000
004700                                 MAXLENGTH(LENGTH OF docarea)     00470000
004800                                 END-EXEC.                        00480000
004900                                                                  00490000
005000     EXEC CICS SEND FROM(docarea)                                 00500000
005100                    ERASE                                         00510000
005200                    FLENGTH(doclength)                            00520000
005300                    END-EXEC.                                     00530000
005400                                                                  00540000
005500     EXEC CICS RETURN END-EXEC.                                   00550000
005600                                                                  00560000
005700     GOBACK.                                                      00570000