Identification division.

       program-id. newdoct.
      *****************************************************************
      *
      * this program is started by entering the following information
      * from a blank CICS screen:
      *
      * newd template-name
      *
      * where NEWD is the transaction code and
      *       template-name is the name of an existing template we want
      *       to re-install
      *
      *****************************************************************

       Data Division.
       Working-storage section.
       01  screen-area.
           05  tran-code            pic x(4).
           05                       pic x.
           05  doctemplate-name     pic x(8).

       01  inquire-response.
           05  crlf                 pic s9(8) binary.
           05  ddname               pic x(8).
           05  exitpgm              pic x(8).
           05  filedd               pic x(8).
           05  member-name          pic x(8).
           05  prog-name            pic x(8).
           05  tdqueue              pic x(4).
           05  tsqueue              pic x(16).
           05  template-name        pic x(48).
           05  doctemplate-type     pic s9(8) binary.
           05  template-type        pic s9(8) binary.

       01  attr-file.
           05                       pic x(05) value 'FILE('.
           05  a-filenm             pic x(8).
           05                       pic x(1) value ')'.

       01  attr-tsqueue.
           05                       pic x(08) value 'TSQUEUE('.
           05 a-tsqueuenm           pic x(16).
           05                       pic x(1)  value ')'.

       01  attr-tdqueue.
           05                       pic x(08) value 'TDQUEUE('.
           05 a-tdqueuenm           pic x(04).
           05                       pic x(1)  value ')'.

       01  attr-exitpgm.
           05                       pic x(08) value 'EXITPGM('.
           05 a-exitpgmnm           pic x(08).
           05                       pic x(1)  value ')'.

       01  attr-program.
           05                       pic x(08) value 'PROGRAM('.
           05 a-programnm           pic x(08).
           05                       pic x(1)  value ')'.

       01  attr-pds.
           05                       pic x(07) value 'MEMBER('.
           05  a-membernm           pic x(08).
           05                       pic x(02) value ') '.
           05                       pic x(07) value 'DDNAME('.
           05  a-pdsdd              pic x(08).
           05                       pic x     value ')'.

       01  attr-crlf.
           05  crlf-yes             pic x(16) value 'APPENDCRLF(YES)'.
           05  crlf-no              pic x(16) value 'APPENDCRLF(NO)'.

       01  attr-type.
           05  type-ebcdic          pic x(13) value 'TYPE(EBCDIC)'.
           05  type-binary          pic x(13) value 'TYPE(BINARY)'.

       01  create-attributes.
           05                       pic x(13) value 'TEMPLATENAME('.
           05  c-template-name      pic x(48).
           05                       pic x(2)  value ')'.
           05  c-type               pic x(13).
           05  c-crlf               pic x(16).
           05  c-resource           pic x(33).

       01  messages.
           05  mess1 pic x(72) value 'install successful ***********'.
           05  mess2.
               10                   pic x(15) value '***** template '.
               10  m-template       pic x(9).
               10                   pic x(15) value 'not found *****'.
           05  mess3         pic x(72) value '***** create failure'.    e'.
           05  mess4         pic x(72) value '+++++ fatal error +++++'. ++++'.
       01  maxl                     pic s9(4) binary value 13.
       procedure division.
           exec cics handle condition error(fatal-error) end-exec

           exec cics receive into(screen-area)
                            maxlength(maxl)
           end-exec

           exec cics inquire doctemplate(doctemplate-name)
                    appendcrlf(crlf)
                    ddname(ddname)
                    exitpgm(exitpgm)
                    file(filedd)
                    member(member-name)
                    program(prog-name)
                    tdqueue(tdqueue)
                    tsqueue(tsqueue)
                    templatename(template-name)
                    templatetype(doctemplate-type)
                    type(template-type)
                    resp(eibresp)
           end-exec

           if eibresp = dfhresp(normal)
               continue
           else
              if eibresp = dfhresp(notfnd)
                  move doctemplate-name to m-template
                  exec cics send from(mess2)
                                 length(length of mess2)
                                 erase
                  end-exec
                  exec cics return end-exec
              else
                 perform fatal-error
              end-if
           end-if

           move filedd to a-filenm
           move prog-name to a-programnm
           move tdqueue to a-tdqueuenm
           move tsqueue to a-tsqueuenm
           move template-name to c-template-name
           move exitpgm to a-exitpgmnm
           move member-name to a-membernm
           move ddname to a-pdsdd

           evaluate crlf
              when dfhvalue(append)  move crlf-yes to c-crlf
              when other             move crlf-no to c-crlf
           end-evaluate

           evaluate template-type
              when dfhvalue(binary)  move type-binary to c-type
              when other             move type-ebcdic to c-type
           end-evaluate

           evaluate doctemplate-type
              when 1035     move attr-pds to c-resource
              when 238      move attr-file to c-resource
              when 912      move attr-exitpgm to c-resource
              when 768      move attr-tsqueue to c-resource
              when 767      move attr-tdqueue to c-resource
              when 154      move attr-program to c-resource
              when other    perform fatal-error
           end-evaluate

           exec cics create doctemplate(doctemplate-name)
                            attributes(create-attributes)
                            attrlen(length of create-attributes)
                            resp(eibresp)
           end-exec

           if eibresp = dfhresp(normal)
              exec cics send from(mess1)
                             erase
                             length(length of mess1)
              end-exec
              exec cics return end-exec
           else
              exec cics send from(mess3)
                             erase
                             length(length of mess3)
              end-exec
              exec cics return end-exec
           end-if
            .

       Fatal-error.

           exec cics send from(mess4)
                          length(length of mess4)
                          erase
           end-exec

           exec cics return end-exec
           .
           stop run.