758 lines
60 KiB
COBOL
758 lines
60 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/12/98
|
|
00002 PROGRAM-ID. DTSCU805. DTSCU805
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU805
|
|
00005 DATE-COMPILED. DTSCU805
|
|
00006 SKIP3 DTSCU805
|
|
00007 ***** DTSCU805
|
|
00008 * DTSCU805
|
|
00009 * FUNCTION: BUILD SCREEN MESSAGE LINE. DTSCU805
|
|
00010 * DTSCU805
|
|
00011 * DTSCU805
|
|
00012 * MODIFICATION LOG: DTSCU805
|
|
00013 * DTSCU805
|
|
00014 * 11/05/91 INITIAL DEVELOPMENT. DTSCU805
|
|
00015 * WORK ORDER: PROGRAMMER: TCL DTSCU805
|
|
00016 * DTSCU805
|
|
00017 * 01/22/92 PROMPT MESSAGES WILL BE BRIGHT ATTRIBUTE AS ARE DTSCU805
|
|
00018 * ERROR MESSAGES DTSCU805
|
|
00019 * WORK ORDER: PROGRAMMER: JLB DTSCU805
|
|
00020 * DTSCU805
|
|
00021 * 04/01/94 MODIFIED FOR MONTANA. DTSCU805
|
|
00022 * WORK ORDER: PROGRAMMER: EHH DTSCU805
|
|
00023 * DTSCU805
|
|
00024 * 12/08/94 ADD A CONSTRUCTABLE ERROR MESSAGE (E051). DTSCU805
|
|
00025 * WORK ORDER: PROGRAMMER: RHC DTSCU805
|
|
00026 * DTSCU805
|
|
00027 * 10/03/95 ADD NEW JOINT REGISTRATION ERROR MESSAGES. DTSCU805
|
|
00028 * WORK ORDER: JR PROGRAMMER: EHH DTSCU805
|
|
00029 * DTSCU805
|
|
00030 * 08/12/1998 REVIEWED AND MODIFIED FOR DC. CL**2
|
|
00031 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2
|
|
00032 * CL**2
|
|
00033 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
|
|
00035 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2
|
|
00036 * DTSCU805
|
|
00037 * DTSCU805
|
|
00038 * DESCRIPTION: DTSCU805
|
|
00039 * DTSCU805
|
|
00040 * SCREEN PROCESSING MODULES LINK DTSCU805 FOR ASSISTANCE CL**2
|
|
00041 * IN BUILDING A SCREEN SEND/RECEIVE MESSAGE AREA. DTSCU805
|
|
00042 * DTSCU805
|
|
00043 * IF L805-NO-MSG DTSCU805
|
|
00044 * INITIALIZE L805-S-MSG-AREA TO NULL DTSCU805
|
|
00045 * GO TO EXIT. DTSCU805
|
|
00046 * DTSCU805
|
|
00047 * IF L805-MSG-TEXT IS EQUAL TO SPACES OR LOW VALUES, TRY TO DTSCU805
|
|
00048 * FIND THE APPROPRIATE MESSAGE TEXT. DTSCU805
|
|
00049 * DTSCU805
|
|
00050 * MOVE L805-MSG-ID TO L805-S-MSG-ID. DTSCU805
|
|
00051 * MOVE L805-MSG-TEXT TO L805-S-MSG-TEXT. DTSCU805
|
|
00052 * DTSCU805
|
|
00053 * SET L805-S-MSG-ID-A TO HIGH INTENSITY DTSCU805
|
|
00054 * SET L805-S-MSG-TEXT-A TO HIGH INTENSITY. DTSCU805
|
|
00055 * DTSCU805
|
|
00056 * DTSCU805
|
|
00057 ***** DTSCU805
|
|
00058 SKIP3 DTSCU805
|
|
00059 ENVIRONMENT DIVISION. DTSCU805
|
|
00060 SKIP3 DTSCU805
|
|
00061 DATA DIVISION. DTSCU805
|
|
00062 SKIP3 DTSCU805
|
|
00063 WORKING-STORAGE SECTION. DTSCU805
|
|
000635 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU805 08/12/98'. DTSCU805
|
|
00064 SKIP3 DTSCU805
|
|
00065 01 WRK-AREA. DTSCU805
|
|
00066 05 WRK-ABEND-CD PIC X(04) VALUE 'U805'. DTSCU805
|
|
00067 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU805
|
|
00068 CL**3
|
|
00069 05 WRK-MSG-NO PIC 9(03). DTSCU805
|
|
00070 CL**3
|
|
00071 05 MSG-INVALID-ID. DTSCU805
|
|
00072 10 FILLER PIC X(30) DTSCU805
|
|
00073 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00074 10 FILLER PIC X(30) DTSCU805
|
|
00075 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00076 EJECT DTSCU805
|
|
00077 01 CATB-LIT. DTSCU805
|
|
00078 ++INCLUDE DTSICATB CL**2
|
|
00079 EJECT DTSCU805
|
|
00080 01 EMSG-TEXT-AREA. DTSCU805
|
|
00081 05 E001-DUPLICATE. DTSCU805
|
|
00082 10 FILLER PIC X(30) DTSCU805
|
|
00083 VALUE 'DUPLICATE FOUND - ADD IS NOT V'. DTSCU805
|
|
00084 10 FILLER PIC X(30) DTSCU805
|
|
00085 VALUE 'ALID '. DTSCU805
|
|
00086 CL**3
|
|
00087 05 E002-NO-RECORD. DTSCU805
|
|
00088 10 FILLER PIC X(30) DTSCU805
|
|
00089 VALUE 'NO RECORD - RECORD DOES NOT CU'. DTSCU805
|
|
00090 10 FILLER PIC X(30) DTSCU805
|
|
00091 VALUE 'RRENTLY RESIDE ON FILE '. DTSCU805
|
|
00092 CL**3
|
|
00093 05 E003-NOT-ALLOWED. DTSCU805
|
|
00094 10 FILLER PIC X(30) DTSCU805
|
|
00095 VALUE 'NOT ALLOWED - ENTRY INTO INDIC'. DTSCU805
|
|
00096 10 FILLER PIC X(30) DTSCU805
|
|
00097 VALUE 'ATED FIELD NOT ALLOWED '. DTSCU805
|
|
00098 CL**3
|
|
00099 05 E004-BANKRUPT. DTSCU805
|
|
00100 10 FILLER PIC X(30) DTSCU805
|
|
00101 VALUE 'BANKRUPT - EMPLOYER MAY NOT BE'. DTSCU805
|
|
00102 10 FILLER PIC X(30) DTSCU805
|
|
00103 VALUE ' ACTIVATED '. DTSCU805
|
|
00104 CL**3
|
|
00105 05 E005-INVALID-ID. DTSCU805
|
|
00106 10 FILLER PIC X(30) DTSCU805
|
|
00107 VALUE 'TRANSACTION SELECTION IS INVAL'. DTSCU805
|
|
00108 10 FILLER PIC X(30) DTSCU805
|
|
00109 VALUE 'ID '. DTSCU805
|
|
00110 CL**3
|
|
00111 05 E006-SEARCH-CRITERIA. DTSCU805
|
|
00112 10 FILLER PIC X(30) DTSCU805
|
|
00113 VALUE 'NO RECORD - MODIFY SEARCH CRIT'. DTSCU805
|
|
00114 10 FILLER PIC X(30) DTSCU805
|
|
00115 VALUE 'ERIA '. DTSCU805
|
|
00116 CL**3
|
|
00117 05 E007-INVALID-ID. DTSCU805
|
|
00118 10 FILLER PIC X(30) DTSCU805
|
|
00119 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00120 10 FILLER PIC X(30) DTSCU805
|
|
00121 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00122 CL**3
|
|
00123 05 E008-INVALID-ID. DTSCU805
|
|
00124 10 FILLER PIC X(30) DTSCU805
|
|
00125 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00126 10 FILLER PIC X(30) DTSCU805
|
|
00127 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00128 CL**3
|
|
00129 05 E009-INVALID-ID. DTSCU805
|
|
00130 10 FILLER PIC X(30) DTSCU805
|
|
00131 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00132 10 FILLER PIC X(30) DTSCU805
|
|
00133 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00134 CL**3
|
|
00135 05 E010-INVALID-ID. DTSCU805
|
|
00136 10 FILLER PIC X(30) DTSCU805
|
|
00137 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00138 10 FILLER PIC X(30) DTSCU805
|
|
00139 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00140 CL**3
|
|
00141 05 E011-FIELD-NOT-VALID. DTSCU805
|
|
00142 10 FILLER PIC X(30) DTSCU805
|
|
00143 VALUE 'NOT VALID - VALUE IN INDICATED'. DTSCU805
|
|
00144 10 FILLER PIC X(30) DTSCU805
|
|
00145 VALUE ' FIELD IS NOT A VALID VALUE '. DTSCU805
|
|
00146 CL**3
|
|
00147 05 E012-FIELD-REQUIRED. DTSCU805
|
|
00148 10 FILLER PIC X(30) DTSCU805
|
|
00149 VALUE 'REQUIRED - ENTRY IS REQUIRED I'. DTSCU805
|
|
00150 10 FILLER PIC X(30) DTSCU805
|
|
00151 VALUE 'N INDICATED FIELD '. DTSCU805
|
|
00152 CL**3
|
|
00153 05 E013-NEGATIVE-NOT-VALID. DTSCU805
|
|
00154 10 FILLER PIC X(30) DTSCU805
|
|
00155 VALUE 'NEGATIVE VALUE IS NOT VALID IN'. DTSCU805
|
|
00156 10 FILLER PIC X(30) DTSCU805
|
|
00157 VALUE ' INDICATED FIELD '. DTSCU805
|
|
00158 CL**3
|
|
00159 05 E014-EXCEEDS-MIN-MAX. DTSCU805
|
|
00160 10 FILLER PIC X(30) DTSCU805
|
|
00161 VALUE 'VALUE IN INDICATED FIELD IS NO'. DTSCU805
|
|
00162 10 FILLER PIC X(30) DTSCU805
|
|
00163 VALUE 'T AN ALLOWABLE VALUE '. DTSCU805
|
|
00164 CL**3
|
|
00165 05 E015-CROSS-EDIT. DTSCU805
|
|
00166 10 FILLER PIC X(30) DTSCU805
|
|
00167 VALUE 'NOT VALID - FAILED DATA ELEMEN'. DTSCU805
|
|
00168 10 FILLER PIC X(30) DTSCU805
|
|
00169 VALUE 'T CROSS EDITS '. DTSCU805
|
|
00170 CL**3
|
|
00171 05 E016-INVALID-ID. DTSCU805
|
|
00172 10 FILLER PIC X(30) DTSCU805
|
|
00173 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00174 10 FILLER PIC X(30) DTSCU805
|
|
00175 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00176 CL**3
|
|
00177 05 E017-INVALID-ID. DTSCU805
|
|
00178 10 FILLER PIC X(30) DTSCU805
|
|
00179 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00180 10 FILLER PIC X(30) DTSCU805
|
|
00181 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00182 CL**3
|
|
00183 05 E018-INVALID-ID. DTSCU805
|
|
00184 10 FILLER PIC X(30) DTSCU805
|
|
00185 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00186 10 FILLER PIC X(30) DTSCU805
|
|
00187 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00188 CL**3
|
|
00189 05 E019-INVALID-ID. DTSCU805
|
|
00190 10 FILLER PIC X(30) DTSCU805
|
|
00191 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00192 10 FILLER PIC X(30) DTSCU805
|
|
00193 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00194 CL**3
|
|
00195 05 E020-INVALID-ID. DTSCU805
|
|
00196 10 FILLER PIC X(30) DTSCU805
|
|
00197 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00198 10 FILLER PIC X(30) DTSCU805
|
|
00199 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00200 CL**3
|
|
00201 05 E021-NO-EMPLOYER. DTSCU805
|
|
00202 10 FILLER PIC X(30) DTSCU805
|
|
00203 VALUE 'EMPLOYER DOES NOT EXIST '. DTSCU805
|
|
00204 10 FILLER PIC X(30) DTSCU805
|
|
00205 VALUE ' '. DTSCU805
|
|
00206 CL**3
|
|
00207 05 E022-NO-ASSIGNMENT. DTSCU805
|
|
00208 10 FILLER PIC X(30) DTSCU805
|
|
00209 VALUE 'ASSIGNMENT DOES NOT EXIST '. DTSCU805
|
|
00210 10 FILLER PIC X(30) DTSCU805
|
|
00211 VALUE ' '. DTSCU805
|
|
00212 CL**3
|
|
00213 05 E023-NO-BATCH. DTSCU805
|
|
00214 10 FILLER PIC X(30) DTSCU805
|
|
00215 VALUE 'BATCH DOES NOT EXIST '. DTSCU805
|
|
00216 10 FILLER PIC X(30) DTSCU805
|
|
00217 VALUE ' '. DTSCU805
|
|
00218 CL**3
|
|
00219 05 E024-NO-DOC. DTSCU805
|
|
00220 10 FILLER PIC X(30) DTSCU805
|
|
00221 VALUE 'DOCUMENT DOES NOT EXIST '. DTSCU805
|
|
00222 10 FILLER PIC X(30) DTSCU805
|
|
00223 VALUE ' '. DTSCU805
|
|
00224 CL**3
|
|
00225 05 E025-ADD-PRECEDED. DTSCU805
|
|
00226 10 FILLER PIC X(30) DTSCU805
|
|
00227 VALUE 'ADD MUST BE PRECEDED BY CLEAR '. DTSCU805
|
|
00228 10 FILLER PIC X(30) DTSCU805
|
|
00229 VALUE ' '. DTSCU805
|
|
00230 CL**3
|
|
00231 05 E026-MOD-PRECEDED. DTSCU805
|
|
00232 10 FILLER PIC X(30) DTSCU805
|
|
00233 VALUE 'MODIFY MUST BE PRECEDED BY INQ'. DTSCU805
|
|
00234 10 FILLER PIC X(30) DTSCU805
|
|
00235 VALUE 'UIRY '. DTSCU805
|
|
00236 CL**3
|
|
00237 05 E027-DEL-PRECEDED. DTSCU805
|
|
00238 10 FILLER PIC X(30) DTSCU805
|
|
00239 VALUE 'DELETE MUST BE PRECEDED BY INQ'. DTSCU805
|
|
00240 10 FILLER PIC X(30) DTSCU805
|
|
00241 VALUE 'UIRY '. DTSCU805
|
|
00242 CL**3
|
|
00243 05 E028-PRINT-PRECEDED. CL**2
|
|
00244 10 FILLER PIC X(30) DTSCU805
|
|
00245 VALUE 'PRINT MUST BE PRECEDED BY INQU'. DTSCU805
|
|
00246 10 FILLER PIC X(30) DTSCU805
|
|
00247 VALUE 'IRY '. DTSCU805
|
|
00248 CL**3
|
|
00249 05 E029-EMP-LOCKED. DTSCU805
|
|
00250 10 FILLER PIC X(30) DTSCU805
|
|
00251 VALUE 'EMPLOYER LOCKED AGAINST UPDATE'. DTSCU805
|
|
00252 10 FILLER PIC X(30) DTSCU805
|
|
00253 VALUE ' (PRIOR UPDATE FAILED) '. DTSCU805
|
|
00254 CL**3
|
|
00255 05 E030-MARKED-FOR-PURGE. DTSCU805
|
|
00256 10 FILLER PIC X(30) DTSCU805
|
|
00257 VALUE 'EMPLOYER MARKED FOR PURGE UPD'. DTSCU805
|
|
00258 10 FILLER PIC X(30) DTSCU805
|
|
00259 VALUE 'ATE NOT ALLOWED '. DTSCU805
|
|
00260 CL**3
|
|
00261 05 E031-NOT-CURRENT-UPDATE. DTSCU805
|
|
00262 10 FILLER PIC X(30) DTSCU805
|
|
00263 VALUE 'DISPLAY MAY NOT BE CURRENT RE'. DTSCU805
|
|
00264 10 FILLER PIC X(30) DTSCU805
|
|
00265 VALUE 'DISPLAY AND RETRY UPDATE '. DTSCU805
|
|
00266 CL**3
|
|
00267 05 E032-NOT-CURRENT-PRINT. DTSCU805
|
|
00268 10 FILLER PIC X(30) DTSCU805
|
|
00269 VALUE 'DISPLAY MAY NOT BE CURRENT RE'. DTSCU805
|
|
00270 10 FILLER PIC X(30) DTSCU805
|
|
00271 VALUE 'DISPLAY AND RETRY PRINT '. DTSCU805
|
|
00272 CL**3
|
|
00273 05 E033-NO-EMP-NO-CHANGE. DTSCU805
|
|
00274 10 FILLER PIC X(30) DTSCU805
|
|
00275 VALUE 'EMP NO MAY NOT BE CHANGED DURI'. DTSCU805
|
|
00276 10 FILLER PIC X(30) DTSCU805
|
|
00277 VALUE 'NG MODIFY OR DELETE '. DTSCU805
|
|
00278 CL**3
|
|
00279 05 E034-NO-BATCH-NO-CHANGE. DTSCU805
|
|
00280 10 FILLER PIC X(30) DTSCU805
|
|
00281 VALUE 'BATCH NO MAY NOT BE CHANGED DU'. DTSCU805
|
|
00282 10 FILLER PIC X(30) DTSCU805
|
|
00283 VALUE 'RING MODIFY OR DELETE '. DTSCU805
|
|
00284 CL**3
|
|
00285 05 E035-NO-ASSIGN-NO-CHANGE. DTSCU805
|
|
00286 10 FILLER PIC X(30) DTSCU805
|
|
00287 VALUE 'ASSIGN NO MAY NOT BE CHANGED D'. DTSCU805
|
|
00288 10 FILLER PIC X(30) DTSCU805
|
|
00289 VALUE 'URING MODIFY OR DELETE '. DTSCU805
|
|
00290 CL**3
|
|
00291 05 E036-NO-ITEM-NO-CHANGE. DTSCU805
|
|
00292 10 FILLER PIC X(30) DTSCU805
|
|
00293 VALUE 'ITEM NO MAY NOT BE CHANGED DUR'. DTSCU805
|
|
00294 10 FILLER PIC X(30) DTSCU805
|
|
00295 VALUE 'ING MODIFY OR DELETE '. DTSCU805
|
|
00296 CL**3
|
|
00297 05 E037-NO-FIELD-CHANGE-UPDATE. DTSCU805
|
|
00298 10 FILLER PIC X(30) DTSCU805
|
|
00299 VALUE 'FIELD MAY NOT BE CHANGED DURIN'. DTSCU805
|
|
00300 10 FILLER PIC X(30) DTSCU805
|
|
00301 VALUE 'G MODIFY OR DELETE '. DTSCU805
|
|
00302 CL**3
|
|
00303 05 E038-NO-FIELD-CHANGE-PRINT. DTSCU805
|
|
00304 10 FILLER PIC X(30) DTSCU805
|
|
00305 VALUE 'FIELD MAY NOT BE CHANGED DURIN'. DTSCU805
|
|
00306 10 FILLER PIC X(30) DTSCU805
|
|
00307 VALUE 'G PRINT '. DTSCU805
|
|
00308 CL**3
|
|
00309 05 E039-COLLECTIONS-WRITTEN-OFF. CL**2
|
|
00310 10 FILLER PIC X(30) DTSCU805
|
|
00311 VALUE 'EMPLOYER WRITTEN OFF UPDATE N'. CL**2
|
|
00312 10 FILLER PIC X(30) DTSCU805
|
|
00313 VALUE 'OT ALLOWED '. CL**2
|
|
00314 CL**3
|
|
00315 05 E040-INVALID-ID. DTSCU805
|
|
00316 10 FILLER PIC X(30) DTSCU805
|
|
00317 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00318 10 FILLER PIC X(30) DTSCU805
|
|
00319 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00320 CL**3
|
|
00321 05 E041-INVALID-ID. CL**2
|
|
00322 10 FILLER PIC X(30) DTSCU805
|
|
00323 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00324 10 FILLER PIC X(30) DTSCU805
|
|
00325 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00326 CL**3
|
|
00327 05 E042-DUPLICATE-FEIN. DTSCU805
|
|
00328 10 FILLER PIC X(30) DTSCU805
|
|
00329 VALUE 'ACTIVE EMPLOYER WITH SPECIFIED'. DTSCU805
|
|
00330 10 FILLER PIC X(30) DTSCU805
|
|
00331 VALUE ' FEIN ALREADY EXISTS '. DTSCU805
|
|
00332 CL**3
|
|
00333 05 E043-PRINT-FAILED. DTSCU805
|
|
00334 10 FILLER PIC X(30) DTSCU805
|
|
00335 VALUE 'PRINT FAILED PRINTER ID IS NO'. DTSCU805
|
|
00336 10 FILLER PIC X(30) DTSCU805
|
|
00337 VALUE 'T VALID OR NOT AVAILABLE '. DTSCU805
|
|
00338 CL**3
|
|
00339 05 E044-NO-ADDRESS. DTSCU805
|
|
00340 10 FILLER PIC X(30) DTSCU805
|
|
00341 VALUE 'REQUESTED ADDRESS DOES NOT EXI'. DTSCU805
|
|
00342 10 FILLER PIC X(30) DTSCU805
|
|
00343 VALUE 'ST '. DTSCU805
|
|
00344 CL**3
|
|
00345 05 E045-NO-AHDR-RECORD. DTSCU805
|
|
00346 10 FILLER PIC X(30) DTSCU805
|
|
00347 VALUE 'ACCOUNTING BATCH HEADER RECORD'. DTSCU805
|
|
00348 10 FILLER PIC X(30) DTSCU805
|
|
00349 VALUE ' NOT FOUND '. DTSCU805
|
|
00350 CL**3
|
|
00351 05 E046-BATCH-FULL. DTSCU805
|
|
00352 10 FILLER PIC X(30) DTSCU805
|
|
00353 VALUE 'BATCH IS FULL ADDITIONAL TRAN'. DTSCU805
|
|
00354 10 FILLER PIC X(30) DTSCU805
|
|
00355 VALUE 'SACTIONS MAY NOT BE ADDED '. DTSCU805
|
|
00356 CL**3
|
|
00357 05 E047-INVALID-ID. CL**2
|
|
00358 10 FILLER PIC X(30) DTSCU805
|
|
00359 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00360 10 FILLER PIC X(30) DTSCU805
|
|
00361 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00362 CL**3
|
|
00363 05 E048-OLD-RECEIVED-DATE. DTSCU805
|
|
00364 10 FILLER PIC X(30) DTSCU805
|
|
00365 VALUE 'RCVD DATE NOT WITHIN ONE YEAR '. DTSCU805
|
|
00366 10 FILLER PIC X(30) DTSCU805
|
|
00367 VALUE 'OF CURRENT DATE DISREGARD? '. DTSCU805
|
|
00368 CL**3
|
|
00369 05 E049-INVALID-ID. DTSCU805
|
|
00370 10 FILLER PIC X(30) DTSCU805
|
|
00371 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00372 10 FILLER PIC X(30) DTSCU805
|
|
00373 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00374 CL**3
|
|
00375 05 E050-INVALID-ID. DTSCU805
|
|
00376 10 FILLER PIC X(30) DTSCU805
|
|
00377 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00378 10 FILLER PIC X(30) DTSCU805
|
|
00379 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00380 CL**3
|
|
00381 05 E051-INVALID-ID. DTSCU805
|
|
00382 10 FILLER PIC X(30) DTSCU805
|
|
00383 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00384 10 FILLER PIC X(30) DTSCU805
|
|
00385 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00386 CL**3
|
|
00387 05 E052-INVALID-ID. DTSCU805
|
|
00388 10 FILLER PIC X(30) DTSCU805
|
|
00389 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00390 10 FILLER PIC X(30) DTSCU805
|
|
00391 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00392 CL**3
|
|
00393 05 E053-INVALID-ID. DTSCU805
|
|
00394 10 FILLER PIC X(30) DTSCU805
|
|
00395 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00396 10 FILLER PIC X(30) DTSCU805
|
|
00397 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00398 CL**3
|
|
00399 05 E054-INVALID-ID. DTSCU805
|
|
00400 10 FILLER PIC X(30) DTSCU805
|
|
00401 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00402 10 FILLER PIC X(30) DTSCU805
|
|
00403 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00404 CL**3
|
|
00405 05 E055-INVALID-ID. DTSCU805
|
|
00406 10 FILLER PIC X(30) DTSCU805
|
|
00407 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00408 10 FILLER PIC X(30) DTSCU805
|
|
00409 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00410 CL**3
|
|
00411 05 E056-INVALID-ID. DTSCU805
|
|
00412 10 FILLER PIC X(30) DTSCU805
|
|
00413 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00414 10 FILLER PIC X(30) DTSCU805
|
|
00415 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00416 CL**3
|
|
00417 05 E057-INVALID-ID. DTSCU805
|
|
00418 10 FILLER PIC X(30) DTSCU805
|
|
00419 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00420 10 FILLER PIC X(30) DTSCU805
|
|
00421 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00422 CL**3
|
|
00423 05 E058-INVALID-ID. DTSCU805
|
|
00424 10 FILLER PIC X(30) DTSCU805
|
|
00425 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00426 10 FILLER PIC X(30) DTSCU805
|
|
00427 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00428 CL**3
|
|
00429 05 E059-INVALID-ID. DTSCU805
|
|
00430 10 FILLER PIC X(30) DTSCU805
|
|
00431 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00432 10 FILLER PIC X(30) DTSCU805
|
|
00433 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00434 CL**3
|
|
00435 05 E060-INVALID-ID. DTSCU805
|
|
00436 10 FILLER PIC X(30) DTSCU805
|
|
00437 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00438 10 FILLER PIC X(30) DTSCU805
|
|
00439 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00440 CL**3
|
|
00441 05 E061-INVALID-ID. CL**2
|
|
00442 10 FILLER PIC X(30) CL**2
|
|
00443 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00444 10 FILLER PIC X(30) CL**2
|
|
00445 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00446 CL**3
|
|
00447 05 E062-INVALID-ID. CL**2
|
|
00448 10 FILLER PIC X(30) CL**2
|
|
00449 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00450 10 FILLER PIC X(30) CL**2
|
|
00451 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00452 CL**3
|
|
00453 05 E063-INVALID-ID. CL**2
|
|
00454 10 FILLER PIC X(30) CL**2
|
|
00455 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00456 10 FILLER PIC X(30) CL**2
|
|
00457 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00458 CL**3
|
|
00459 05 E064-INVALID-ID. CL**2
|
|
00460 10 FILLER PIC X(30) CL**2
|
|
00461 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00462 10 FILLER PIC X(30) CL**2
|
|
00463 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00464 CL**3
|
|
00465 05 E065-INVALID-ID. CL**2
|
|
00466 10 FILLER PIC X(30) CL**2
|
|
00467 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00468 10 FILLER PIC X(30) CL**2
|
|
00469 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00470 CL**3
|
|
00471 05 E066-INVALID-ID. CL**2
|
|
00472 10 FILLER PIC X(30) CL**2
|
|
00473 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00474 10 FILLER PIC X(30) CL**2
|
|
00475 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00476 CL**3
|
|
00477 05 E067-INVALID-ID. CL**2
|
|
00478 10 FILLER PIC X(30) CL**2
|
|
00479 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00480 10 FILLER PIC X(30) CL**2
|
|
00481 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00482 CL**3
|
|
00483 05 E068-INVALID-ID. CL**2
|
|
00484 10 FILLER PIC X(30) CL**2
|
|
00485 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00486 10 FILLER PIC X(30) CL**2
|
|
00487 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00488 CL**3
|
|
00489 05 E069-INVALID-ID. CL**2
|
|
00490 10 FILLER PIC X(30) CL**2
|
|
00491 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**2
|
|
00492 10 FILLER PIC X(30) CL**2
|
|
00493 VALUE 'NOTIFY PROGRAMMING '. CL**2
|
|
00494 CL**3
|
|
00495 05 E070-INVALID-ID. DTSCU805
|
|
00496 10 FILLER PIC X(30) DTSCU805
|
|
00497 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00498 10 FILLER PIC X(30) DTSCU805
|
|
00499 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00500 SKIP2 DTSCU805
|
|
00501 01 FILLER REDEFINES EMSG-TEXT-AREA. DTSCU805
|
|
00502 05 EMSG-TEXT OCCURS 70 TIMES DTSCU805
|
|
00503 PIC X(60). DTSCU805
|
|
00504 EJECT DTSCU805
|
|
00505 01 PMSG-TEXT-AREA. DTSCU805
|
|
00506 05 P001-KEY-OPTION. DTSCU805
|
|
00507 10 FILLER PIC X(30) DTSCU805
|
|
00508 VALUE 'PLEASE KEY OPTION AND PRESS EN'. DTSCU805
|
|
00509 10 FILLER PIC X(30) DTSCU805
|
|
00510 VALUE 'TER '. DTSCU805
|
|
00511 CL**3
|
|
00512 05 P002-ADD-CONFIRM. DTSCU805
|
|
00513 10 FILLER PIC X(30) DTSCU805
|
|
00514 VALUE 'PRESS ENTER TO CONFIRM ADD; PR'. DTSCU805
|
|
00515 10 FILLER PIC X(30) DTSCU805
|
|
00516 VALUE 'ESS F12 TO CANCEL ADD '. DTSCU805
|
|
00517 CL**3
|
|
00518 05 P003-MOD-CONFIRM. DTSCU805
|
|
00519 10 FILLER PIC X(30) DTSCU805
|
|
00520 VALUE 'PRESS ENTER TO CONFIRM MODIFY;'. DTSCU805
|
|
00521 10 FILLER PIC X(30) DTSCU805
|
|
00522 VALUE ' PRESS F12 TO CANCEL MODIFY '. DTSCU805
|
|
00523 CL**3
|
|
00524 05 P004-DEL-CONFIRM. DTSCU805
|
|
00525 10 FILLER PIC X(30) DTSCU805
|
|
00526 VALUE 'PRESS ENTER TO CONFIRM DELETE;'. DTSCU805
|
|
00527 10 FILLER PIC X(30) DTSCU805
|
|
00528 VALUE ' PRESS F12 TO CANCEL DELETE '. DTSCU805
|
|
00529 CL**3
|
|
00530 05 P005-ADD-CANCELED. DTSCU805
|
|
00531 10 FILLER PIC X(30) DTSCU805
|
|
00532 VALUE 'ADD CANCELED '. DTSCU805
|
|
00533 10 FILLER PIC X(30) DTSCU805
|
|
00534 VALUE ' '. DTSCU805
|
|
00535 CL**3
|
|
00536 05 P006-MOD-CANCELED. DTSCU805
|
|
00537 10 FILLER PIC X(30) DTSCU805
|
|
00538 VALUE 'MODIFY CANCELED '. DTSCU805
|
|
00539 10 FILLER PIC X(30) DTSCU805
|
|
00540 VALUE ' '. DTSCU805
|
|
00541 CL**3
|
|
00542 05 P007-DEL-CANCELED. DTSCU805
|
|
00543 10 FILLER PIC X(30) DTSCU805
|
|
00544 VALUE 'DELETE CANCELED '. DTSCU805
|
|
00545 10 FILLER PIC X(30) DTSCU805
|
|
00546 VALUE ' '. DTSCU805
|
|
00547 CL**3
|
|
00548 05 P008-ADD-SUCCESSFUL. DTSCU805
|
|
00549 10 FILLER PIC X(30) DTSCU805
|
|
00550 VALUE 'ADD SUCCESSFUL '. DTSCU805
|
|
00551 10 FILLER PIC X(30) DTSCU805
|
|
00552 VALUE ' '. DTSCU805
|
|
00553 CL**3
|
|
00554 05 P009-MOD-SUCCESSFUL. DTSCU805
|
|
00555 10 FILLER PIC X(30) DTSCU805
|
|
00556 VALUE 'MODIFY SUCCESSFUL '. DTSCU805
|
|
00557 10 FILLER PIC X(30) DTSCU805
|
|
00558 VALUE ' '. DTSCU805
|
|
00559 CL**3
|
|
00560 05 P010-DEL-SUCCESSFUL. DTSCU805
|
|
00561 10 FILLER PIC X(30) DTSCU805
|
|
00562 VALUE 'DELETE SUCCESSFUL '. DTSCU805
|
|
00563 10 FILLER PIC X(30) DTSCU805
|
|
00564 VALUE ' '. DTSCU805
|
|
00565 CL**3
|
|
00566 05 P011-PRINT-CONFIRM. DTSCU805
|
|
00567 10 FILLER PIC X(30) DTSCU805
|
|
00568 VALUE 'PRESS ENTER TO CONFIRM PRINT; '. DTSCU805
|
|
00569 10 FILLER PIC X(30) DTSCU805
|
|
00570 VALUE 'PRESS F12 TO CANCEL PRINT '. DTSCU805
|
|
00571 CL**3
|
|
00572 05 P012-PRINT-CANCELED. DTSCU805
|
|
00573 10 FILLER PIC X(30) DTSCU805
|
|
00574 VALUE 'PRINT CANCELED '. DTSCU805
|
|
00575 10 FILLER PIC X(30) DTSCU805
|
|
00576 VALUE ' '. DTSCU805
|
|
00577 CL**3
|
|
00578 05 P013-PRINT-SUCCESSFUL. DTSCU805
|
|
00579 10 FILLER PIC X(30) DTSCU805
|
|
00580 VALUE 'PRINT SUCCESSFUL '. DTSCU805
|
|
00581 10 FILLER PIC X(30) DTSCU805
|
|
00582 VALUE ' '. DTSCU805
|
|
00583 CL**3
|
|
00584 05 P014-KEY-EMP-NO. DTSCU805
|
|
00585 10 FILLER PIC X(30) DTSCU805
|
|
00586 VALUE 'PLEASE KEY EMPLOYER NUMBER '. DTSCU805
|
|
00587 10 FILLER PIC X(30) DTSCU805
|
|
00588 VALUE ' '. DTSCU805
|
|
00589 CL**3
|
|
00590 05 P015-KEY-BATCH-NO. DTSCU805
|
|
00591 10 FILLER PIC X(30) DTSCU805
|
|
00592 VALUE 'PLEASE KEY BATCH NUMBER '. DTSCU805
|
|
00593 10 FILLER PIC X(30) DTSCU805
|
|
00594 VALUE ' '. DTSCU805
|
|
00595 CL**3
|
|
00596 05 P016-KEY-ASSIGN-NO. DTSCU805
|
|
00597 10 FILLER PIC X(30) DTSCU805
|
|
00598 VALUE 'PLEASE KEY ASSIGNMENT NUMBER '. DTSCU805
|
|
00599 10 FILLER PIC X(30) DTSCU805
|
|
00600 VALUE ' '. DTSCU805
|
|
00601 CL**3
|
|
00602 05 P017-KEY-DOC-NO. DTSCU805
|
|
00603 10 FILLER PIC X(30) DTSCU805
|
|
00604 VALUE 'PLEASE KEY DOCUMENT NUMBER '. DTSCU805
|
|
00605 10 FILLER PIC X(30) DTSCU805
|
|
00606 VALUE ' '. DTSCU805
|
|
00607 CL**3
|
|
00608 05 P018-INVALID-ID. DTSCU805
|
|
00609 10 FILLER PIC X(30) DTSCU805
|
|
00610 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00611 10 FILLER PIC X(30) DTSCU805
|
|
00612 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00613 CL**3
|
|
00614 05 P019-INVALID-ID. DTSCU805
|
|
00615 10 FILLER PIC X(30) DTSCU805
|
|
00616 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00617 10 FILLER PIC X(30) DTSCU805
|
|
00618 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00619 CL**3
|
|
00620 05 P020-INVALID-ID. DTSCU805
|
|
00621 10 FILLER PIC X(30) DTSCU805
|
|
00622 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00623 10 FILLER PIC X(30) DTSCU805
|
|
00624 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00625 CL**3
|
|
00626 05 P021-FIRST-PAGE. DTSCU805
|
|
00627 10 FILLER PIC X(30) DTSCU805
|
|
00628 VALUE 'FIRST PAGE OF INFORMATION DISP'. DTSCU805
|
|
00629 10 FILLER PIC X(30) DTSCU805
|
|
00630 VALUE 'LAYED. '. DTSCU805
|
|
00631 CL**3
|
|
00632 05 P022-LAST-PAGE. DTSCU805
|
|
00633 10 FILLER PIC X(30) DTSCU805
|
|
00634 VALUE 'LAST PAGE OF INFORMATION DISPL'. DTSCU805
|
|
00635 10 FILLER PIC X(30) DTSCU805
|
|
00636 VALUE 'AYED. '. DTSCU805
|
|
00637 CL**3
|
|
00638 05 P023-ONLY-PAGE. DTSCU805
|
|
00639 10 FILLER PIC X(30) DTSCU805
|
|
00640 VALUE 'ONLY PAGE OF INFORMATION DISPL'. DTSCU805
|
|
00641 10 FILLER PIC X(30) DTSCU805
|
|
00642 VALUE 'AYED. '. DTSCU805
|
|
00643 CL**3
|
|
00644 05 P024-INVALID-ID. DTSCU805
|
|
00645 10 FILLER PIC X(30) DTSCU805
|
|
00646 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00647 10 FILLER PIC X(30) DTSCU805
|
|
00648 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00649 CL**3
|
|
00650 05 P025-PRINT-CONFIRM-ALT. CL**3
|
|
00651 10 FILLER PIC X(30) DTSCU805
|
|
00652 VALUE 'PRESS ENTER (OR F9) TO CONFIRM'. DTSCU805
|
|
00653 10 FILLER PIC X(30) DTSCU805
|
|
00654 VALUE ' PRINT; PRESS F12 TO CANCEL '. DTSCU805
|
|
00655 CL**3
|
|
00656 05 P026-ADD-CONFIRM-ALT. DTSCU805
|
|
00657 10 FILLER PIC X(30) DTSCU805
|
|
00658 VALUE 'PRESS ENTER (OR F9) TO CONFIRM'. DTSCU805
|
|
00659 10 FILLER PIC X(30) DTSCU805
|
|
00660 VALUE ' ADD; PRESS F12 TO CANCEL ADD '. DTSCU805
|
|
00661 CL**3
|
|
00662 05 P027-INVALID-ID. CL**3
|
|
00663 10 FILLER PIC X(30) DTSCU805
|
|
00664 VALUE 'MESSAGE IDENTIFIER NOT VALID '. CL**3
|
|
00665 10 FILLER PIC X(30) DTSCU805
|
|
00666 VALUE 'NOTIFY PROGRAMMING '. CL**3
|
|
00667 CL**3
|
|
00668 05 P028-INVALID-ID. DTSCU805
|
|
00669 10 FILLER PIC X(30) DTSCU805
|
|
00670 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00671 10 FILLER PIC X(30) DTSCU805
|
|
00672 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00673 CL**3
|
|
00674 05 P029-INVALID-ID. DTSCU805
|
|
00675 10 FILLER PIC X(30) DTSCU805
|
|
00676 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00677 10 FILLER PIC X(30) DTSCU805
|
|
00678 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00679 CL**3
|
|
00680 05 P030-INVALID-ID. DTSCU805
|
|
00681 10 FILLER PIC X(30) DTSCU805
|
|
00682 VALUE 'MESSAGE IDENTIFIER NOT VALID '. DTSCU805
|
|
00683 10 FILLER PIC X(30) DTSCU805
|
|
00684 VALUE 'NOTIFY PROGRAMMING '. DTSCU805
|
|
00685 SKIP2 DTSCU805
|
|
00686 01 FILLER REDEFINES PMSG-TEXT-AREA. DTSCU805
|
|
00687 05 PMSG-TEXT OCCURS 30 TIMES DTSCU805
|
|
00688 PIC X(60). DTSCU805
|
|
00689 EJECT DTSCU805
|
|
00690 LINKAGE SECTION. DTSCU805
|
|
00691 SKIP3 DTSCU805
|
|
00692 01 DFHCOMMAREA. DTSCU805
|
|
00693 ++INCLUDE DTSIL805 CL**2
|
|
00694 EJECT DTSCU805
|
|
00695 PROCEDURE DIVISION. DTSCU805
|
|
00696 SKIP2 DTSCU805
|
|
00697 MOVE LOW-VALUES TO L805-S-MSG-AREA. DTSCU805
|
|
00698 CL**3
|
|
00699 MOVE 'DTS' TO L805-S-MSG-ID (1:3). CL**2
|
|
00700 CL**3
|
|
00701 IF L805-NO-MSG DTSCU805
|
|
00702 *********SET ATTRIBUTE TO 'DARK' IF THE USERS DON'T LIKE 'DTS' CL**2
|
|
00703 MOVE CATB-ASKIP-NORM-MDTOFF TO L805-S-MSG-ID-A DTSCU805
|
|
00704 L805-S-MSG-TEXT-A CL**3
|
|
00705 ELSE DTSCU805
|
|
00706 MOVE L805-MSG-ID TO L805-S-MSG-ID (4:4) DTSCU805
|
|
00707 PERFORM P1000-MSG-TEXT THRU P1000-EXIT DTSCU805
|
|
00708 MOVE CATB-ASKIP-NORM-MDTOFF TO L805-S-MSG-ID-A DTSCU805
|
|
00709 MOVE CATB-ASKIP-BRT-MDTOFF TO L805-S-MSG-TEXT-A. DTSCU805
|
|
00710 SKIP2 DTSCU805
|
|
00711 EXEC CICS DTSCU805
|
|
00712 RETURN DTSCU805
|
|
00713 END-EXEC. DTSCU805
|
|
00714 SKIP2 DTSCU805
|
|
00715 *****GOBACK. CL**3
|
|
00716 EJECT DTSCU805
|
|
00717 P1000-MSG-TEXT. DTSCU805
|
|
00718 IF L805-MSG-TEXT = SPACES OR LOW-VALUES DTSCU805
|
|
00719 NEXT SENTENCE DTSCU805
|
|
00720 ELSE DTSCU805
|
|
00721 IF L805-CONSTRUCT-88 DTSCU805
|
|
00722 MOVE SPACE TO L805-S-MSG-TEXT DTSCU805
|
|
00723 STRING 'VALIDATE {' DELIMITED BY SIZE DTSCU805
|
|
00724 L805-MSG-TEXT DELIMITED BY ' ' DTSCU805
|
|
00725 '}' DELIMITED BY SIZE DTSCU805
|
|
00726 INTO L805-S-MSG-TEXT DTSCU805
|
|
00727 GO TO P1000-EXIT DTSCU805
|
|
00728 ELSE DTSCU805
|
|
00729 MOVE L805-MSG-TEXT TO L805-S-MSG-TEXT DTSCU805
|
|
00730 GO TO P1000-EXIT. DTSCU805
|
|
00731 CL**3
|
|
00732 IF L805-MSG-NO NUMERIC DTSCU805
|
|
00733 MOVE L805-MSG-NO TO WRK-MSG-NO DTSCU805
|
|
00734 ELSE DTSCU805
|
|
00735 MOVE MSG-INVALID-ID TO L805-S-MSG-TEXT DTSCU805
|
|
00736 GO TO P1000-EXIT. DTSCU805
|
|
00737 CL**3
|
|
00738 IF L805-PROMPT-MSG DTSCU805
|
|
00739 IF (WRK-MSG-NO > 0) DTSCU805
|
|
00740 AND DTSCU805
|
|
00741 (WRK-MSG-NO < 31) DTSCU805
|
|
00742 MOVE PMSG-TEXT (WRK-MSG-NO) TO L805-S-MSG-TEXT DTSCU805
|
|
00743 ELSE DTSCU805
|
|
00744 MOVE MSG-INVALID-ID TO L805-S-MSG-TEXT DTSCU805
|
|
00745 ELSE DTSCU805
|
|
00746 IF L805-ERROR-MSG DTSCU805
|
|
00747 IF (WRK-MSG-NO > 0) DTSCU805
|
|
00748 AND DTSCU805
|
|
00749 (WRK-MSG-NO < 71) DTSCU805
|
|
00750 MOVE EMSG-TEXT (WRK-MSG-NO) TO L805-S-MSG-TEXT DTSCU805
|
|
00751 ELSE DTSCU805
|
|
00752 MOVE MSG-INVALID-ID TO L805-S-MSG-TEXT DTSCU805
|
|
00753 ELSE DTSCU805
|
|
00754 MOVE MSG-INVALID-ID TO L805-S-MSG-TEXT. DTSCU805
|
|
00755 P1000-EXIT. DTSCU805
|
|
00756 EXIT. DTSCU805
|