57 lines
1.5 KiB
COBOL
57 lines
1.5 KiB
COBOL
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.
|
|
GOBACK.
|
|
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.
|
|
|