giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix #2 for UCTRAN41 to perform actual work

Browse Source
This commit is contained in:
Johan Fabry
2025-09-12 16:11:02 -04:00
parent 558b3dcb41
commit 27dde5abfa
1 changed files with 8 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
CICS/UCTRAN41.cob
View File

@ -5,22 +5,15 @@
DATA DIVISION. DATA DIVISION.
WORKING-STORAGE SECTION. WORKING-STORAGE SECTION.
01 CAPARM PIC X(1).
01 UCTRANST PIC X(8). 01 UCTRANST PIC X(8).
01 EIBTRMID PIC X(4).
01 EIBTRNID PIC X(4).
01 EIBCALEN PIC S9(4) COMP.
LINKAGE SECTION. LINKAGE SECTION.
01 DFHCOMMAREA. 01 DFHCOMMAREA.
05 FILLER PIC X(1). 05 CAPARM PIC X(1).
PROCEDURE DIVISION. PROCEDURE DIVISION.
EXEC CICS RETURN END-EXEC. * EXEC CICS RETURN END-EXEC.
MOVE EIBTRMID TO EIBTRMID
MOVE EIBTRNID TO EIBTRNID
IF EIBTRMID = SPACES IF EIBTRMID = SPACES
EXEC CICS ABEND ABCODE('UCTR') END-EXEC EXEC CICS ABEND ABCODE('UCTR') END-EXEC
@ -29,20 +22,20 @@
IF EIBCALEN = 0 IF EIBCALEN = 0
PERFORM FLIP-UCTRAN PERFORM FLIP-UCTRAN
ELSE ELSE
EXEC CICS RETRIEVE INTO(CAPARM) LENGTH(1) END-EXEC
IF CAPARM = 'U' IF CAPARM = 'U'
MOVE 'UCTRAN' TO UCTRANST MOVE 'UCTRAN' TO UCTRANST
ELSE IF CAPARM = 'L' ELSE
IF CAPARM = 'L'
MOVE 'NOUCTRAN' TO UCTRANST MOVE 'NOUCTRAN' TO UCTRANST
ELSE ELSE
EXEC CICS ABEND ABCODE('UCTR') END-EXEC EXEC CICS ABEND ABCODE('UCTR') END-EXEC
END-IF END-IF
END-IF
PERFORM APPLY-SETTING PERFORM APPLY-SETTING
END-IF END-IF
EXEC CICS RETURN END-EXEC. EXEC CICS RETURN END-EXEC.
GOBACK.
FLIP-UCTRAN. FLIP-UCTRAN.
EXEC CICS INQUIRE TERMINAL(EIBTRMID) UCTRANST(UCTRANST) EXEC CICS INQUIRE TERMINAL(EIBTRMID) UCTRANST(UCTRANST)
END-EXEC END-EXEC