00001 IDENTIFICATION DIVISION. 08/11/98 00002 PROGRAM-ID. DTSCU898 DTSCU898 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU898 00005 DATE-COMPILED. DTSCU898 00006 SKIP3 DTSCU898 00007 ***** DTSCU898 00008 * DTSCU898 00009 * FUNCTION: DELETE ALL TEMPORARY STORAGE QUEUES ASSOCIATED DTSCU898 00010 * WITH THE PSEUDO CONVERSATION. DTSCU898 00011 * DTSCU898 00012 * DTSCU898 00013 * MODIFICATION LOG: DTSCU898 00014 * DTSCU898 00015 * 11/05/91 INITIAL DEVELOPMENT. DTSCU898 00016 * WORK ORDER: PROGRAMMER: TCL DTSCU898 00017 * DTSCU898 00018 * 08/11/1998 REVIEWED AND MODIFIED FOR DC. CL**2 00019 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00020 * CL**2 00021 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00023 * REFERENCE: XXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00024 * DTSCU898 00025 * DTSCU898 00026 * DESCRIPTION: DTSCU898 00027 * DTSCU898 00028 * WHEN A PSEUDO CONVERSATION IS INITIATED, A PSEUDO DTSCU898 00029 * CONVERSATION IS TERMINATED OR DURING ABEND PROCESSING DTSCU898 00030 * ALL TEMPORARY STORAGE AREAS ASSOCIATED WITH THE PSEUDO DTSCU898 00031 * CONVERSATION MUST BE DELETED. DTSCU898 00032 * DTSCU898 00033 * DTSCU898 DELETES ALL POSSIBLE TEMPORARY STORAGE AREAS. CL**2 00034 * IF CERTAIN AREAS DO NOT EXIST IN A PARTICULAR PSEUDO DTSCU898 00035 * CONVERSATION, THEN THE DELETE YIELDS A QIDERR. THE QIDERR DTSCU898 00036 * IS SIMPLY TOLERATED. DTSCU898 00037 * DTSCU898 00038 * IF TEMPORARY STORAGE AREA NAMES ARE ADDED ANYWHERE IN THE DTSCU898 00039 * COMPLEX OF MODULES CONSTITUTING CICS TRANSACTION 'DTS', THEN CL**2 00040 * THE NEW TEMPORARY STORAGE AREA NAMES SHOULD BE ADDED TO THIS DTSCU898 00041 * MODULE. DTSCU898 00042 * DTSCU898 00043 * IN PARTICULAR, THIS MODULE ASSUMES THAT CHARACTER ONE THRU DTSCU898 00044 * CHARACTER THREE OF A TS QUEUE NAME IS EQUAL TO 'DTS' AND THAT CL**2 00045 * CHARACTER FOUR THRU CHARACTER SEVEN OF A TS QUEUE NAME IS EQUDTSCU898 00046 * TO EIBTRMID. IF THESE ASSUMPTIONS BECOME INVALID, THEN THIS DTSCU898 00047 * MODULE MUST BE MOFIFIED. DTSCU898 00048 * DTSCU898 00049 ***** DTSCU898 00050 SKIP3 DTSCU898 00051 ENVIRONMENT DIVISION. DTSCU898 00052 SKIP3 DTSCU898 00053 DATA DIVISION. DTSCU898 00054 SKIP3 DTSCU898 00055 WORKING-STORAGE SECTION. DTSCU898 000555 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU898 08/11/98'. DTSCU898 00056 SKIP3 DTSCU898 00057 01 WRK-AREA. DTSCU898 00058 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU898 00059 SKIP3 DTSCU898 00060 05 WRK-CNT PIC S9(04) COMP VALUE +6. DTSCU898 00061 CL**2 00062 05 WRK-QUEUE-NAME-SUFFIX-LITERALS. DTSCU898 00063 10 FILLER PIC X(06) DTSCU898 00064 VALUE 'SPE123'. DTSCU898 00065 05 FILLER REDEFINES WRK-QUEUE-NAME-SUFFIX-LITERALS. DTSCU898 00066 10 WRK-QUEUE-NAME-SUFFIX-LITERAL OCCURS 6 TIMES DTSCU898 00067 INDEXED BY WRK-IDX DTSCU898 00068 PIC X(01). DTSCU898 00069 01 L829-AREA. DTSCU898 00070 ++INCLUDE DTSIL829 CL**2 00071 EJECT DTSCU898 00072 PROCEDURE DIVISION. DTSCU898 00073 SKIP2 DTSCU898 00074 *****MOVE L829-CONTROL-BLOCK-LENGTH TO L829-COMM-AREA-LENGTH. CL**2 00075 CL**2 00076 SET L829-DELETE-QUEUE-88 TO TRUE. CL**4 00077 CL**2 00078 MOVE +0 TO L829-ITEM-NO DTSCU898 00079 L829-REC-LENGTH. DTSCU898 00080 CL**2 00081 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCU898 00082 CL**2 00083 MOVE 'DTS' TO L829-QUEUE-NAME-PREFIX (1:3). CL**2 00084 CL**2 00085 MOVE EIBTRMID TO L829-QUEUE-NAME-PREFIX (4:4). DTSCU898 00086 CL**2 00087 PERFORM P1000-DELETE-QUEUE THRU P1000-EXIT DTSCU898 00088 VARYING WRK-IDX FROM 1 BY 1 DTSCU898 00089 UNTIL WRK-IDX > WRK-CNT. DTSCU898 00090 CL**2 00091 EXEC CICS DTSCU898 00092 RETURN DTSCU898 00093 END-EXEC. DTSCU898 00094 SKIP2 DTSCU898 00095 GOBACK. DTSCU898 00096 EJECT DTSCU898 00097 P1000-DELETE-QUEUE. DTSCU898 00098 MOVE WRK-QUEUE-NAME-SUFFIX-LITERAL (WRK-IDX) DTSCU898 00099 TO L829-QUEUE-NAME-SUFFIX. DTSCU898 00100 CL**2 00101 EXEC CICS DTSCU898 00102 LINK DTSCU898 00103 PROGRAM ('DTSCU829') CL**2 00104 COMMAREA (L829-AREA) DTSCU898 00105 END-EXEC. DTSCU898 00106 P1000-EXIT. DTSCU898 00107 EXIT. DTSCU898