DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
294
CICS/DTSCU851.cob
Normal file
294
CICS/DTSCU851.cob
Normal file
@ -0,0 +1,294 @@
|
||||
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
|
||||
Reference in New Issue
Block a user