DUTAS re-platformed to Raincode - Initial Source Code

2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions
--- a/CICS/UCTRAN41.cob
+++ b/CICS/UCTRAN41.cob
@ -0,0 +1,55 @@
+       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.
+