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

Fix the COBOL logon program to call UCTRAN41 and remove unneeded code.

Browse Source
This commit is contained in:
Johan Fabry
2025-09-15 14:01:52 -04:00
parent 27dde5abfa
commit 7842ff7f77
1 changed files with 8 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
CICS/RCSIGNON.cob
View File

@ -24,31 +24,22 @@
05 LK-DATA PIC X(1). 05 LK-DATA PIC X(1).
PROCEDURE DIVISION. PROCEDURE DIVISION.
DISPLAY '=== Hello!'.
IF EIBCALEN = 0 IF EIBCALEN = 0
EXEC CICS EXEC CICS
GETMAIN SET(ADDRESS OF DFHCOMMAREA) GETMAIN SET(ADDRESS OF DFHCOMMAREA)
FLENGTH(LENGTH OF DFHCOMMAREA) FLENGTH(LENGTH OF DFHCOMMAREA)
END-EXEC END-EXEC
DISPLAY '=== Sending Map'
MOVE 0 TO LK-DATA MOVE 0 TO LK-DATA
PERFORM SEND-MAP PERFORM SEND-MAP
END-IF. END-IF.
IF LK-DATA = 0 IF LK-DATA = 0
DISPLAY '=== Receiving Map'
MOVE 1 TO LK-DATA MOVE 1 TO LK-DATA
PERFORM REC-MAP PERFORM REC-MAP
END-IF. END-IF.
IF LK-DATA = 1 DISPLAY "=== You should never get here!".
DISPLAY '=== New user logged on'
MOVE 2 TO LK-DATA
PERFORM SHOW-ID
END-IF.
DISPLAY "=== You should never get here! (" LK-DATA ")".
GOBACK. GOBACK.
SEND-MAP. SEND-MAP.
@ -86,8 +77,6 @@
* Remove from possible mem dumps * Remove from possible mem dumps
MOVE SPACES TO PASSWO MOVE SPACES TO PASSWO
DISPLAY '=== Signon'
EXEC CICS SIGNON EXEC CICS SIGNON
* USERID('LETMEIN0') * USERID('LETMEIN0')
USERID(' ') USERID(' ')
@ -124,8 +113,12 @@
LENGTH(LENGTH OF DFHCOMMAREA) LENGTH(LENGTH OF DFHCOMMAREA)
END-EXEC END-EXEC
END-IF END-IF
DISPLAY "=== Switching user" EXEC CICS
SET TERMINAL(EIBTRMID)
UCTRANST('UCTRAN')
END-EXEC
EXEC CICS EXEC CICS
SEND MAP('SUXESS') MAPSET('SIGNON') SEND MAP('SUXESS') MAPSET('SIGNON')
ERASE ERASE
@ -134,15 +127,8 @@
END-EXEC END-EXEC
EXEC CICS EXEC CICS
RETURN TRANSID('DTS') RETURN TRANSID('DTS')
* COMMAREA(DFHCOMMAREA)
* LENGTH(LENGTH OF DFHCOMMAREA)
END-EXEC. END-EXEC.
SHOW-ID.
EXEC CICS ASSIGN USERID(WS-USERID) END-EXEC
DISPLAY '=== CICS USERID:' WS-USERID
EXEC CICS LINK PROGRAM('DTSCDRV') END-EXEC
GOBACK.