The program below performs processing that enables it to run under TCF.
This program checks TCF-related fields in the UCE and performs TCF processing before performing any application-specific processing.
WORKING-STORAGE SECTION.
01 WS-START PIC X(10) VALUE '*WS START*'.
01 USER-IDENT.
05 USER-ID-FIRST-EIGHT PIC X(8).
05 USER-ID-REST PIC X(24).
01 TASK-ID PIC X(8).
01 SESSION-DESC-WORK.
05 SDW-1 PIC X(8).
05 SDW-2 PIC X(8).
01 TCF-REC.
02 TCF-REC-COMMLINE PIC X(7).
88 SUS-COMMAND VALUE 'SUS'
'SUSP' 'SUSPE' 'SUSPEN'
'SUSPEND'.
88 BYE-COMMAND VALUE 'BYE'
'QUIT' 'QUI' 'END'.
88 SWITCH-COMMAND VALUE 'SWI'
'SWIT' 'SWITC' 'SWITCH'.
02 TCF-REC-QUIT PIC X VALUE '_'.
02 TCF-REC-SUSPEND PIC X VALUE '_'.
02 TCF-REC-SWITCH PIC X VALUE '_'.
02 TCF-REC-HELP PIC X VALUE '_'.
02 TCF-REC-SWI-TASK PIC X(8).
02 TCF-REC-OLDNEW PIC X.
88 SWI-OLD VALUE 'O'.
88 SWI-NEW VALUE 'N'.
01 DATA-REC.
02 DATA-REC-FIELD1 PIC X VALUE '_'.
02 DATA-REC-FIELD2 PIC X VALUE '_'.
02 DATA-REC-FIELD3 PIC X VALUE '_'.
02 DATA-REC-FIELD4 PIC X VALUE '_'.
01 WS-END PIC X(8) VALUE '*WS END*'.
LINKAGE SECTION.
01 COPY IDMS UNIVERSAL-COMM-ELEMENT VERSION 2.
01 UNIVERSAL-COMM-ELEMENT.
03 UCE-IDENT-02 PIC XXXX.
03 UCE-DBNAME-02 PIC X(8).
03 UCE-NODE-NAME-02 PIC X(8).
03 UCE-DICT-NAME-02 PIC X(8).
03 UCE-DICT-NODE-02 PIC X(8).
03 UCE-SCHEMA-NAME-02 PIC X(8).
03 UCE-SCHEMA-VER-02 PIC 9999 USAGE COMP.
03 UCE-SUBSCHEMA-NAME-02 PIC X(8).
03 UCE-SUBSCHEMA-VER-02 PIC 9999 USAGE COMP.
03 UCE-INPUT-POINTER-02 PIC S9(8) USAGE COMP.
03 UCE-INPUT-LENGTH-02 PIC S9(8) USAGE COMP.
03 UCE-OUTPUT-POINTER-02 PIC S9(8) USAGE COMP.
03 UCE-OUTPUT-LENGTH-02 PIC S9(8) USAGE COMP.
03 UCE-ENTITY-OCCURRENCE-02
PIC X(32).
03 UCE-ENTITY-OCCUR-VER-02
PIC 9999 USAGE COMP.
03 FILLER PIC XX.
03 UCE-ACTION-CODE-02 PIC XXXX.
03 UCE-RETURN-CODE-02 PIC S9(8) USAGE COMP.
03 UCE-MSG-CODE-02 PIC 9(7) USAGE COMP-3.
03 UCE-MSG-TEXT-POINTER-02
PIC S9(8) USAGE COMP.
03 FILLER PIC X(32).
03 UCE-SYS-INIT-TIME-02 PIC S9(8) USAGE COMP.
03 UCE-FROM-TASK-02 PIC X(8).
03 UCE-ACTIVE-TASK-02 PIC X(8).
03 UCE-NEXT-TASK-02 PIC X(8).
03 UCE-ENTRY-TASK-02 PIC X(8).
03 UCE-PT-LIST-POINTER-02 PIC S9(8) USAGE COMP.
03 UCE-NBR-TASKS-02 PIC S9999 USAGE COMP.
03 UCE-NBR-SESSIONS-02 PIC S9999 USAGE COMP.
03 UCE-QUEUE-ID-02 PIC S9(8)
USAGE COMP.
03 UCE-SESSION-DESCR-02 PIC X(16).
03 UCE-CURR-TASK-FLAG-02 PIC X.
88 UCE-SUSPEND-02 VALUE 'S'.
88 UCE-END-02 VALUE 'O'.
88 UCE-CONVERSE-02 VALUE 'P'.
03 UCE-NEXT-TASK-FLAG-02 PIC X.
88 UCE-NEW-02 VALUE 'N'.
88 UCE-RESUME-02 VALUE 'O'.
PROCEDURE DIVISION USING UNIVERSAL-COMM-ELEMENT.
MAIN-LINE.
*** CHECK FOR TCF SESSION
IF UCE-IDENT-02 NOT = 'UMBR'
THEN GO TO C100-SESSION.
*** MOST LIKELY PSEUDO-CONV
IF UCE-CONVERSE-02
THEN GO TO A100-PSEUDOCONVERSE.
*** NOT PCONV, DATA SENT?
IF UCE-INPUT-POINTER-02 NOT = 0 OR
UCE-ENTITY-OCCURRENCE-02 NOT = SPACES
THEN
GO TO A100-START-WITH-DATA.
*** NEW SESSION SPECIFIED?
IF UCE-NEW-02
THEN GO TO A100-START-NEW-SESSION
*** ELSE DEFAULT TO OLD
ELSE
GO TO A100-START-OLD-SESSION.
A100-PSEUDOCONVERSE.
BIND MAP TCFMAP01.
BIND MAP TCFMAP01 RECORD TCF-REC.
BIND MAP TCFMAP01 RECORD DATA-REC.
ACCEPT USER ID INTO USER-IDENT.
ACCEPT TASK ID INTO TASK-ID.
*** MENU OR COMMAND-LINE SUSPEND
IF (TCF-REC-SUSPEND NOT = '_')
OR SUS-COMMAND
THEN
MOVE USER-ID-FIRST-EIGHT TO SDW-1.
MOVE TASK-ID TO SDW-2.
MOVE SESSION-DESC-WORK TO UCE-SESSION-DESCR-02.
*** USE SESS-DESCRIPTOR FOR QID
PERFORM U100-SAVE-STORAGE
MOVE 'S' TO UCE-CURR-TASK-FLAG-02
DC RETURN.
*** MENU OR COMMAND-LINE QUIT
IF (TCF-REC-QUIT NOT = '_')
OR BYE-COMMAND
THEN
MOVE 'O' TO UCE-CURR-TASK-FLAG-02
DC RETURN.
*** MENU OR COMMAND-LINE SWITCH
IF (TCF-REC-SWI-TASK NOT = SPACES)
OR SWITCH-COMMAND
THEN
PERFORM B100-SWITCH
ELSE
MOVE 'P' TO UCE-CURR-TASK-FLAG-02
GO TO C100-SESSION.
*
A100-START-WITH-DATA.
*** START SESSION USING THE DATA PASSED IN ***
*** UCE-INPUT-POINTER-02 OR UCE-ENTITY-OCCURRENCE-02 ***
*
A100-START-NEW-SESSION.
*** START A NEW SESSION, MOVE 'P' ***
*** TO UCE-CURR-TASK-FLAG-02 ***
*
A100-START-OLD-SESSION.
*** RESTART OLD SESSION, GET PREVIOUS VARIABLE ***
*** STORAGE FROM SCRATCH OR QUEUE AND MOVE 'P' ***
*** TO UCE-CURR-TASK-FLAG-02. ***
*** IF UCE-SESSION-DESCR-02 IS EMPTY, OR IF ***
*** GET QUEUE/SCRATCH FAILS, MOVE +4 TO ***
*** UCE-RETURN-CODE-02 AND ISSUE A DC RETURN ***
*
IF UCE-SESSION-DESCR-02 = SPACES
MOVE +4 TO UCE-RETURN-CODE-02
DC RETURN.
GET QUEUE ID UCE-SESSION-DESCR-02
FROM WS-START
TO WS-END
RETENTION 7
ON ANY-ERROR-STATUS
MOVE +4 TO UCE-RETURN-CODE-02
DC RETURN.
MOVE 'P' TO UCE-CURR-TASK-FLAG-02.
GO TO C100-SESSION.
*
B100-SWITCH.
MOVE USER-ID-FIRST-EIGHT TO SDW-1.
MOVE TASK-ID TO SDW-2.
MOVE SESSION-DESC-WORK TO UCE-SESSION-DESCR-02.
* USE SESS-DESCRIPTOR FOR QID
PERFORM U100-SAVE-STORAGE.
IF TCF-REC-SWI-TASK = SPACES
THEN MOVE SPACES TO UCE-NEXT-TASK-02
DC RETURN.
MOVE TCF-REC-SWI-TASK TO UCE-NEXT-TASK-02.
IF SWI-NEW THEN
MOVE 'N' TO UCE-NEXT-TASK-FLAG-02
ELSE
MOVE 'O' TO UCE-NEXT-TASK-FLAG-02.
DC RETURN.
*
C100-SESSION.
*** PROGRAM PROCESSING ***
*
U100-SAVE-STORAGE.
*** SAVE WORKING STORAGE FROM WS-START TO WS-END ***
*** IN THIS EXAMPLE, ITS A QUEUE RECORD ***
PUT QUEUE ID UCE-SESSION-DESCR-02
FROM WS-START
TO WS-END
RETENTION 7.
IDMS-ABORT.
IDMS-ABORT-EXIT.
EXIT.
COPY IDMS IDMS-STATUS.
|
Copyright © 2013 CA.
All rights reserved.
|
|