       IDENTIFICATION DIVISION.
       PROGRAM-ID. UCTRAN41.

       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  CAPARM           PIC X(1).
       01  UCTRANST         PIC X(8).
       01  EIBTRMID         PIC X(4).
       01  EIBTRNID         PIC X(4).
       01  EIBCALEN         PIC S9(4) COMP.

       LINKAGE SECTION.
       01  DFHCOMMAREA.
           05  FILLER       PIC X(1).

       PROCEDURE DIVISION.

           MOVE EIBTRMID TO EIBTRMID
           MOVE EIBTRNID TO EIBTRNID

           IF EIBTRMID = SPACES
               EXEC CICS ABEND ABCODE('UCTR') END-EXEC
           END-IF

           IF EIBCALEN = 0
               PERFORM FLIP-UCTRAN
           ELSE
               EXEC CICS RETRIEVE INTO(CAPARM) LENGTH(1) END-EXEC
               IF CAPARM = 'U'
                   MOVE 'UCTRAN' TO UCTRANST
               ELSE IF CAPARM = 'L'
                   MOVE 'NOUCTRAN' TO UCTRANST
               ELSE
                   EXEC CICS ABEND ABCODE('UCTR') END-EXEC
               END-IF
               PERFORM APPLY-SETTING
           END-IF

           EXEC CICS RETURN END-EXEC.

       FLIP-UCTRAN.
           EXEC CICS INQUIRE TERMINAL(EIBTRMID) UCTRANST(UCTRANST)
                END-EXEC
           IF UCTRANST = 'UCTRAN'
               MOVE 'NOUCTRAN' TO UCTRANST
           ELSE
               MOVE 'UCTRAN' TO UCTRANST
           END-IF
           PERFORM APPLY-SETTING.

       APPLY-SETTING.
           EXEC CICS SET TERMINAL(EIBTRMID) UCTRANST(UCTRANST) END-EXEC.

