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