52 lines
1.3 KiB
COBOL
52 lines
1.3 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. UCTRAN41.
|
|
|
|
ENVIRONMENT DIVISION.
|
|
DATA DIVISION.
|
|
WORKING-STORAGE SECTION.
|
|
|
|
01 UCTRANST PIC X(8).
|
|
|
|
LINKAGE SECTION.
|
|
01 DFHCOMMAREA.
|
|
05 CAPARM PIC X(1).
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
* EXEC CICS RETURN END-EXEC.
|
|
|
|
IF EIBTRMID = SPACES
|
|
EXEC CICS ABEND ABCODE('UCTR') END-EXEC
|
|
END-IF
|
|
|
|
IF EIBCALEN = 0
|
|
PERFORM FLIP-UCTRAN
|
|
ELSE
|
|
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
|
|
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.
|
|
|