295 lines
23 KiB
COBOL
295 lines
23 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/11/98
|
|
00002 PROGRAM-ID. DTSCU851. DTSCU851
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. APRIL 1994. DTSCU851
|
|
00005 DATE-COMPILED. DTSCU851
|
|
00006 SKIP3 DTSCU851
|
|
00007 ***** DTSCU851
|
|
00008 * DTSCU851
|
|
00009 * FUNCTION: MAP SEND/RECEIVE. DTSCU851
|
|
00010 * DTSCU851
|
|
00011 * DTSCU851
|
|
00012 * MODIFICATION LOG: DTSCU851
|
|
00013 * DTSCU851
|
|
00014 * 04/04/94 INITIAL DEVELOPMENT. DTSCU851
|
|
00015 * WORK ORDER: PROGRAMMER: EHH DTSCU851
|
|
00016 * DTSCU851
|
|
00017 * 07/22/94 RECEIVE-ASIS IS WORTHLESS IN A PSEUDO DTSCU851
|
|
00018 * CONVERSATION. IF YOU WANT TO SUPPRESS TRANSALTION DTSCU851
|
|
00019 * TO UPPER CASE, THEN YOU MUST SET THE UCTRAN BYTE DTSCU851
|
|
00020 * IN THE TCTTE TO "NO TRANSLATE" BEFORE THE TASK DTSCU851
|
|
00021 * (IN WHICH THE RECEIVE COMMAND IS ISSUED) STARTS. DTSCU851
|
|
00022 * DTSCU851
|
|
00023 * IN MONTANA, A HANDY LITTLE MODULE NAMED UCTRAN DTSCU851
|
|
00024 * EXISTS. TALK TO THE CICS SYSTEM PROGRAMMER OR DTSCU851
|
|
00025 * SEE THE USAGE OF UCTRAN IN DTSCS92. CL**2
|
|
00026 * WORK ORDER: PROGRAMMER: EHH DTSCU851
|
|
00027 * DTSCU851
|
|
00028 * 05/09/95 ONCE IN A GREAT WHILE A MYSTERIOUS MAPFAIL DTSCU851
|
|
00029 * OCCURS. THIS DOES NOT APPEAR TO BE A DTS PROBLEM. CL**2
|
|
00030 * THE SITUATION CANNOT BE REPRODUCED. GRINSELL DTSCU851
|
|
00031 * SAYS THAT THERE ARE SO MANY LAYERS OF SOFTWARE DTSCU851
|
|
00032 * BETWEEN CICS AND THE SCREEN (ATTACHMATE, PC NET- DTSCU851
|
|
00033 * WORK SOFTWARE, SNA, VTAM, SUPER SESSION, JUGGLER, DTSCU851
|
|
00034 * AND ASSIST/MENU - TO NAME A FEW), THAT IT IS DTSCU851
|
|
00035 * AMAZING THAT ANYTHING EVER WORKS. DTSCU851
|
|
00036 * DTSCU851
|
|
00037 * P1100 MODIFIED TO TREAT A MAPFAIL AS A CLEAR. DTSCU851
|
|
00038 * WORK ORDER: PROGRAMMER: EHH DTSCU851
|
|
00039 * DTSCU851
|
|
00040 * 09/21/95 WHEN DETERMINING WHETHER OR NOT TO SOUND THE DTSCU851
|
|
00041 * AUDIBLE ALARM, TREAT A 'R' MESSAGE JUST LIKE AN DTSCU851
|
|
00042 * 'E' MESSAGE. DTSCU851
|
|
00043 * WORK ORDER: JR PROGRAMMER: EHH DTSCU851
|
|
00044 * DTSCU851
|
|
00045 * 08/11/1998 REVIEWED AND MODIFIED FOR DC. CL**2
|
|
00046 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
|
00047 * CL**2
|
|
00048 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00049 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00050 * REFERENCE: XXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
|
|
00051 * DTSCU851
|
|
00052 * DTSCU851
|
|
00053 * DESCRIPTION: DTSCU851
|
|
00054 * DTSCU851
|
|
00055 * DTSCU851 PERFORMS ALL REQUIRED MAP SEND COMMANDS CL**2
|
|
00056 * AND MAP RECEIVE COMMANDS. DTSCU851
|
|
00057 * DTSCU851
|
|
00058 ***** DTSCU851
|
|
00059 SKIP3 DTSCU851
|
|
00060 ENVIRONMENT DIVISION. DTSCU851
|
|
00061 SKIP3 DTSCU851
|
|
00062 DATA DIVISION. DTSCU851
|
|
00063 SKIP3 DTSCU851
|
|
00064 WORKING-STORAGE SECTION. DTSCU851
|
|
000645 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU851 08/11/98'. DTSCU851
|
|
00065 SKIP3 DTSCU851
|
|
00066 01 WRK-AREA. DTSCU851
|
|
00067 05 WRK-ABEND-CD PIC X(04) VALUE 'U851'. DTSCU851
|
|
00068 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU851
|
|
00069 DTSCU851
|
|
00070 05 MAPSET-NAME PIC X(08) VALUE 'DTSMSET'. CL**2
|
|
00071 05 MAP-NAME. DTSCU851
|
|
00072 10 MAP-NAME-PREFIX PIC X(04) VALUE 'DTSM'. CL**2
|
|
00073 10 MAP-NAME-SUFFIX PIC X(04). DTSCU851
|
|
00074 DTSCU851
|
|
00075 05 WRK-AID PIC X(01). DTSCU851
|
|
00076 88 WRK-CLEAR-88 VALUE '_'. DTSCU851
|
|
00077 88 WRK-PA-88 VALUE '%' DTSCU851
|
|
00078 '>' ','. DTSCU851
|
|
00079 DTSCU851
|
|
00080 05 SOUND-ALARM-IND PIC X(01). DTSCU851
|
|
00081 EJECT DTSCU851
|
|
00082 LINKAGE SECTION. DTSCU851
|
|
00083 SKIP3 DTSCU851
|
|
00084 01 DFHCOMMAREA. DTSCU851
|
|
00085 ++INCLUDE DTSIL851 CL**2
|
|
00086 EJECT DTSCU851
|
|
00087 PROCEDURE DIVISION. DTSCU851
|
|
00088 SKIP2 DTSCU851
|
|
00089 MOVE L851-SCR-ID TO MAP-NAME-SUFFIX. DTSCU851
|
|
00090 DTSCU851
|
|
00091 IF L851-RECEIVE-88 DTSCU851
|
|
00092 PERFORM P1100-RECEIVE THRU P1100-EXIT DTSCU851
|
|
00093 *****ELSE DTSCU851
|
|
00094 *****IF L851-RECEIVE-ASIS-88 DTSCU851
|
|
00095 ***** PERFORM P1200-RECEIVE-ASIS THRU P1200-EXIT DTSCU851
|
|
00096 ELSE DTSCU851
|
|
00097 IF L851-SEND-88 DTSCU851
|
|
00098 PERFORM P2100-SEND THRU P2100-EXIT DTSCU851
|
|
00099 ELSE DTSCU851
|
|
00100 IF L851-SEND-DATAONLY-88 DTSCU851
|
|
00101 PERFORM P2200-SEND-DATAONLY THRU P2200-EXIT DTSCU851
|
|
00102 ELSE DTSCU851
|
|
00103 PERFORM S899-ABEND THRU S899-EXIT. DTSCU851
|
|
00104 SKIP2 DTSCU851
|
|
00105 EXEC CICS DTSCU851
|
|
00106 RETURN DTSCU851
|
|
00107 END-EXEC. DTSCU851
|
|
00108 SKIP2 DTSCU851
|
|
00109 GOBACK. DTSCU851
|
|
00110 EJECT DTSCU851
|
|
00111 P1100-RECEIVE. DTSCU851
|
|
00112 MOVE LOW-VALUES TO L851-MAP-AREA. DTSCU851
|
|
00113 DTSCU851
|
|
00114 EXEC CICS DTSCU851
|
|
00115 RECEIVE DTSCU851
|
|
00116 MAP (MAP-NAME) DTSCU851
|
|
00117 MAPSET (MAPSET-NAME) DTSCU851
|
|
00118 INTO (L851-MAP-AREA) DTSCU851
|
|
00119 RESP (WRK-RESP-CD) DTSCU851
|
|
00120 END-EXEC. DTSCU851
|
|
00121 DTSCU851
|
|
00122 MOVE EIBAID TO WRK-AID DTSCU851
|
|
00123 L851-AID. DTSCU851
|
|
00124 DTSCU851
|
|
00125 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU851
|
|
00126 NEXT SENTENCE DTSCU851
|
|
00127 ELSE DTSCU851
|
|
00128 IF WRK-RESP-CD = DFHRESP (MAPFAIL) DTSCU851
|
|
00129 IF WRK-CLEAR-88 OR WRK-PA-88 DTSCU851
|
|
00130 NEXT SENTENCE DTSCU851
|
|
00131 ELSE DTSCU851
|
|
00132 SET WRK-CLEAR-88 TO TRUE DTSCU851
|
|
00133 MOVE WRK-AID TO L851-AID DTSCU851
|
|
00134 ELSE DTSCU851
|
|
00135 PERFORM S899-ABEND THRU S899-EXIT. DTSCU851
|
|
00136 DTSCU851
|
|
00137 PERFORM S1100-L851-CURSOR THRU S1100-EXIT. DTSCU851
|
|
00138 P1100-EXIT. DTSCU851
|
|
00139 EXIT. DTSCU851
|
|
00140 EJECT DTSCU851
|
|
00141 *P1200-RECEIVE-ASIS. DTSCU851
|
|
00142 *****MOVE LOW-VALUES TO L851-MAP-AREA. DTSCU851
|
|
00143 ***** DTSCU851
|
|
00144 *****EXEC CICS DTSCU851
|
|
00145 ***** RECEIVE DTSCU851
|
|
00146 ***** MAP (MAP-NAME) DTSCU851
|
|
00147 ***** MAPSET (MAPSET-NAME) DTSCU851
|
|
00148 ***** INTO (L851-MAP-AREA) DTSCU851
|
|
00149 ***** ASIS DTSCU851
|
|
00150 ***** RESP (WRK-RESP-CD) DTSCU851
|
|
00151 *****END-EXEC. DTSCU851
|
|
00152 ***** DTSCU851
|
|
00153 *****MOVE EIBAID TO WRK-AID DTSCU851
|
|
00154 ***** L851-AID. DTSCU851
|
|
00155 ***** DTSCU851
|
|
00156 *****IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU851
|
|
00157 ***** NEXT SENTENCE DTSCU851
|
|
00158 *****ELSE DTSCU851
|
|
00159 *****IF WRK-RESP-CD = DFHRESP (MAPFAIL) DTSCU851
|
|
00160 ***** IF WRK-CLEAR-88 OR WRK-PA-88 DTSCU851
|
|
00161 ***** NEXT SENTENCE DTSCU851
|
|
00162 ***** ELSE DTSCU851
|
|
00163 ***** PERFORM S899-ABEND THRU S899-EXIT DTSCU851
|
|
00164 *****ELSE DTSCU851
|
|
00165 ***** PERFORM S899-ABEND THRU S899-EXIT. DTSCU851
|
|
00166 ***** DTSCU851
|
|
00167 *****PERFORM S1100-L851-CURSOR THRU S1100-EXIT. DTSCU851
|
|
00168 *P1200-EXIT. DTSCU851
|
|
00169 *****EXIT. DTSCU851
|
|
00170 EJECT DTSCU851
|
|
00171 P2100-SEND. DTSCU851
|
|
00172 PERFORM S1200-DETERMINE-ALARM THRU S1200-EXIT. DTSCU851
|
|
00173 DTSCU851
|
|
00174 IF SOUND-ALARM-IND = 'N' DTSCU851
|
|
00175 DTSCU851
|
|
00176 EXEC CICS DTSCU851
|
|
00177 SEND DTSCU851
|
|
00178 MAP (MAP-NAME) DTSCU851
|
|
00179 MAPSET (MAPSET-NAME) DTSCU851
|
|
00180 FROM (L851-MAP-AREA) DTSCU851
|
|
00181 CURSOR DTSCU851
|
|
00182 ERASE DTSCU851
|
|
00183 FREEKB DTSCU851
|
|
00184 RESP (WRK-RESP-CD) DTSCU851
|
|
00185 END-EXEC DTSCU851
|
|
00186 DTSCU851
|
|
00187 ELSE DTSCU851
|
|
00188 DTSCU851
|
|
00189 EXEC CICS DTSCU851
|
|
00190 SEND DTSCU851
|
|
00191 MAP (MAP-NAME) DTSCU851
|
|
00192 MAPSET (MAPSET-NAME) DTSCU851
|
|
00193 FROM (L851-MAP-AREA) DTSCU851
|
|
00194 CURSOR DTSCU851
|
|
00195 ERASE DTSCU851
|
|
00196 FREEKB DTSCU851
|
|
00197 ALARM DTSCU851
|
|
00198 RESP (WRK-RESP-CD) DTSCU851
|
|
00199 END-EXEC. DTSCU851
|
|
00200 DTSCU851
|
|
00201 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU851
|
|
00202 NEXT SENTENCE DTSCU851
|
|
00203 ELSE DTSCU851
|
|
00204 PERFORM S899-ABEND THRU S899-EXIT. DTSCU851
|
|
00205 P2100-EXIT. DTSCU851
|
|
00206 EXIT. DTSCU851
|
|
00207 EJECT DTSCU851
|
|
00208 P2200-SEND-DATAONLY. DTSCU851
|
|
00209 PERFORM S1200-DETERMINE-ALARM THRU S1200-EXIT. DTSCU851
|
|
00210 DTSCU851
|
|
00211 IF SOUND-ALARM-IND = 'N' DTSCU851
|
|
00212 DTSCU851
|
|
00213 EXEC CICS DTSCU851
|
|
00214 SEND DTSCU851
|
|
00215 MAP (MAP-NAME) DTSCU851
|
|
00216 MAPSET (MAPSET-NAME) DTSCU851
|
|
00217 FROM (L851-MAP-AREA) DTSCU851
|
|
00218 CURSOR DTSCU851
|
|
00219 DATAONLY DTSCU851
|
|
00220 FREEKB DTSCU851
|
|
00221 RESP (WRK-RESP-CD) DTSCU851
|
|
00222 END-EXEC DTSCU851
|
|
00223 DTSCU851
|
|
00224 ELSE DTSCU851
|
|
00225 DTSCU851
|
|
00226 EXEC CICS DTSCU851
|
|
00227 SEND DTSCU851
|
|
00228 MAP (MAP-NAME) DTSCU851
|
|
00229 MAPSET (MAPSET-NAME) DTSCU851
|
|
00230 FROM (L851-MAP-AREA) DTSCU851
|
|
00231 CURSOR DTSCU851
|
|
00232 DATAONLY DTSCU851
|
|
00233 FREEKB DTSCU851
|
|
00234 ALARM DTSCU851
|
|
00235 RESP (WRK-RESP-CD) DTSCU851
|
|
00236 END-EXEC. DTSCU851
|
|
00237 DTSCU851
|
|
00238 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU851
|
|
00239 NEXT SENTENCE DTSCU851
|
|
00240 ELSE DTSCU851
|
|
00241 PERFORM S899-ABEND THRU S899-EXIT. DTSCU851
|
|
00242 P2200-EXIT. DTSCU851
|
|
00243 EXIT. DTSCU851
|
|
00244 EJECT DTSCU851
|
|
00245 S1100-L851-CURSOR. DTSCU851
|
|
00246 DIVIDE EIBCPOSN BY 80 DTSCU851
|
|
00247 GIVING L851-CURSOR-ROW DTSCU851
|
|
00248 REMAINDER L851-CURSOR-COL. DTSCU851
|
|
00249 DTSCU851
|
|
00250 ADD +1 TO L851-CURSOR-ROW. DTSCU851
|
|
00251 CL**2
|
|
00252 ADD +1 TO L851-CURSOR-COL. DTSCU851
|
|
00253 S1100-EXIT. DTSCU851
|
|
00254 EXIT. DTSCU851
|
|
00255 SKIP3 DTSCU851
|
|
00256 S1200-DETERMINE-ALARM. DTSCU851
|
|
00257 IF L851-ALARM-IND = 'N' DTSCU851
|
|
00258 MOVE 'N' TO SOUND-ALARM-IND DTSCU851
|
|
00259 ELSE DTSCU851
|
|
00260 IF L851-ALARM-IND = 'E' DTSCU851
|
|
00261 IF L851-ERROR-MSG-88 CL**3
|
|
00262 MOVE 'Y' TO SOUND-ALARM-IND DTSCU851
|
|
00263 ELSE DTSCU851
|
|
00264 MOVE 'N' TO SOUND-ALARM-IND DTSCU851
|
|
00265 ELSE DTSCU851
|
|
00266 IF L851-ALARM-IND = 'P' DTSCU851
|
|
00267 IF L851-PROMPT-MSG-88 DTSCU851
|
|
00268 MOVE 'Y' TO SOUND-ALARM-IND DTSCU851
|
|
00269 ELSE DTSCU851
|
|
00270 MOVE 'N' TO SOUND-ALARM-IND DTSCU851
|
|
00271 ELSE DTSCU851
|
|
00272 IF L851-ALARM-IND = 'M' DTSCU851
|
|
00273 IF L851-MSG-88 DTSCU851
|
|
00274 MOVE 'Y' TO SOUND-ALARM-IND DTSCU851
|
|
00275 ELSE DTSCU851
|
|
00276 MOVE 'N' TO SOUND-ALARM-IND DTSCU851
|
|
00277 ELSE DTSCU851
|
|
00278 IF L851-ALARM-IND = 'Y' DTSCU851
|
|
00279 MOVE 'Y' TO SOUND-ALARM-IND DTSCU851
|
|
00280 ELSE DTSCU851
|
|
00281 MOVE 'N' TO SOUND-ALARM-IND. DTSCU851
|
|
00282 S1200-EXIT. DTSCU851
|
|
00283 EXIT. DTSCU851
|
|
00284 EJECT DTSCU851
|
|
00285 S899-ABEND. DTSCU851
|
|
00286 DTSCU851
|
|
00287 EXEC CICS DTSCU851
|
|
00288 ABEND DTSCU851
|
|
00289 ABCODE (WRK-ABEND-CD) DTSCU851
|
|
00290 END-EXEC. DTSCU851
|
|
00291 DTSCU851
|
|
00292 S899-EXIT. DTSCU851
|
|
00293 EXIT. DTSCU851
|