00001 IDENTIFICATION DIVISION. 09/22/99 00002 PROGRAM-ID. DTSCS42. DTSCS42 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV047 00004 DATE-WRITTEN. JUNE 1994. DTSCS42 00005 DATE-COMPILED. DTSCS42 00006 DTSCS42 00007 DTSCS42 00008 ***** DTSCS42 00009 * DTSCS42 00010 * FUNCTION: MISCELLANEOUS COLLECTIONS INQUIRY/UPDATE DTSCS42 00011 * SCREEN PROCESSOR. DTSCS42 00012 * DTSCS42 00013 * DTSCS42 00014 * MODIFICATION LOG: DTSCS42 00015 * DTSCS42 00016 * 01/29/99 INITIAL DEVELOPMENT. COPIED FROM MACCS42 CL**2 00017 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00018 * DTSCS42 00019 * DTSCS42 00020 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS42 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS42 00022 * WORK ORDER: PROGRAMMER: XXX DTSCS42 00023 * DTSCS42 00024 * DTSCS42 00025 * DESCRIPTION: DTSCS42 00026 * DTSCS42 00027 * CLEAR: DTSCS42 00028 * DTSCS42 00029 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS42 00030 * DTSCS42 00031 * DTSCS42 00032 * JUMP: DTSCS42 00033 * DTSCS42 00034 * F19 QUARTER INQUIRY (31). DTSCS42 00035 * F20 COLLECTIONS INQUIRY (41). DTSCS42 00036 * DTSCS42 00037 * DTSCS42 00038 * INQUIRY: DTSCS42 00039 * DTSCS42 00040 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS42 00041 * DTSCS42 00042 * DTSCS42 00043 * JUMP IN: DISPLAY INFORMATION ASSOCIATED WITH LCCM-EMP-NO. DTSCS42 00044 * DTSCS42 00045 * DTSCS42 00046 * ENTER: DISPLAY INFORMATION ASSOCIATED WITH MAP-EMP-NO. DTSCS42 00047 * DTSCS42 00048 * DTSCS42 00049 * LCCM-MISC-CONTROL-AREA MAINTENANCE: DTSCS42 00050 * DTSCS42 00051 * LCCM-EMP-NO DTSCS42 00052 * DTSCS42 00053 * DTSCS42 00054 * UPDATE: DTSCS42 00055 * DTSCS42 00056 * MOD DTSCS42 00057 * DTSCS42 00058 * DON'T FORGET TO UPDATE MPRF-BANKRUPTCY-OPEN-IND. DTSCS42 00059 * DTSCS42 00060 * DTSCS42 00061 * RECORDS READ: DTSCS42 00062 * DTSCS42 00063 * MASTER: DTSCS42 00064 * DTSCS42 00065 * MPRF DTSCS42 00066 * MTAD DTSCS42 00067 * MCOL DTSCS42 00068 * DTSCS42 00069 * DTSCS42 00070 * ALTERNATE INDEX: DTSCS42 00071 * DTSCS42 00072 * NONE. DTSCS42 00073 * DTSCS42 00074 * DTSCS42 00075 * REFERENCE: DTSCS42 00076 * DTSCS42 00077 * NONE. DTSCS42 00078 * DTSCS42 00079 * DTSCS42 00080 * ACCOUNTING TRANSACTION COLLECTION: DTSCS42 00081 * DTSCS42 00082 * NONE. DTSCS42 00083 * DTSCS42 00084 * DTSCS42 00085 * RECORDS UPDATED: DTSCS42 00086 * DTSCS42 00087 * MASTER: DTSCS42 00088 * DTSCS42 00089 * MPRF (REWRITE) DTSCS42 00090 * MTAD (REWRITE) DTSCS42 00091 * MCOL (WRITE, REWRITE, DELETE) DTSCS42 00092 * MEVL (WRITE) CL*26 00093 * WRITE AN MEVL RECORD WHEN A USER ADDS AN CL*26 00094 * MCOL-LEGAL-REFERRAL-DATE. CL*26 00095 * CL*26 00096 * REFERENCE: DTSCS42 00097 * DTSCS42 00098 * NONE. DTSCS42 00099 * DTSCS42 00100 * DTSCS42 00101 * ACCOUNTING TRANSACTION COLLECTION: DTSCS42 00102 * DTSCS42 00103 * NONE. DTSCS42 00104 * DTSCS42 00105 * DTSCS42 00106 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS42 00107 * DTSCS42 00108 * NONE. DTSCS42 00109 * DTSCS42 00110 * DTSCS42 00111 * TEMPORARY STORAGE USAGE: DTSCS42 00112 * DTSCS42 00113 * NONE. DTSCS42 00114 * DTSCS42 00115 * DTSCS42 00116 * MODULES LINKED TO: DTSCS42 00117 * DTSCS42 00118 * DTSCU001 DATE EDIT/CONVERSION. CL**2 00119 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. CL**2 00120 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. CL**2 00121 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. CL**2 00122 * DTSCU034 COLLECTIONS CODES EDIT/DESCRIPTION. CL**2 00123 * DTSCU061 FIELD ZIP / FIELD REP ID. CL**2 00124 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. CL**2 00125 * DTSCU082 OPID LOOKUP EDIT/DESCRIPTION. CL**9 00126 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. CL**2 00127 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORD. CL**2 00128 * DTSCU810 MASTER FILE INPUT/OUTPUT. CL**2 00129 * DTSCS42 00130 ***** CL*28 00131 DTSCS42 00132 CL*28 00133 ENVIRONMENT DIVISION. DTSCS42 00134 DTSCS42 00135 CL*28 00136 DATA DIVISION. DTSCS42 00137 DTSCS42 00138 CL*28 00139 WORKING-STORAGE SECTION. DTSCS42 001395 77 PAN-VALET PICTURE X(24) VALUE '047DTSCS42 09/22/99'. DTSCS42 00140 DTSCS42 00141 01 WRK-AREA. DTSCS42 00142 05 WRK-ABEND-CD PIC X(04) VALUE 'S42 '. DTSCS42 00143 DTSCS42 00144 05 WRK-SCR-ID. DTSCS42 00145 10 WRK-SCR-ID-N PIC 9(02) VALUE 42. DTSCS42 00146 DTSCS42 00147 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS42 00148 DTSCS42 00149 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS42 00150 VALUE +999999999. DTSCS42 00151 DTSCS42 00152 05 WRK-MEVL-TEXT PIC X(50) CL*26 00153 VALUE 'CASE REFERRED TO GENERAL COUNSEL'. CL*26 00154 CL*26 00155 05 SCR-ACCESS-IND PIC X(01). DTSCS42 00156 88 SCR-ACCESS-INQ VALUE '1'. DTSCS42 00157 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS42 00158 DTSCS42 00159 05 CURSOR-SET-IND PIC X(01). DTSCS42 00160 88 CURSOR-SET-YES VALUE 'Y'. DTSCS42 00161 88 CURSOR-SET-NO VALUE 'N'. DTSCS42 00162 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS42 00163 DTSCS42 00164 05 REQ-IND PIC X(01). DTSCS42 00165 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS42 00166 88 REQ-ERROR VALUE 'O'. DTSCS42 00167 88 REQ-JUMP VALUE 'J'. DTSCS42 00168 88 REQ-UPDATE VALUE 'U'. DTSCS42 00169 88 REQ-INQUIRE VALUE 'I'. DTSCS42 00170 88 REQ-CLEAR VALUE 'C'. DTSCS42 00171 88 REQ-EDIT VALUE 'E'. DTSCS42 00172 DTSCS42 00173 05 RESP-IND PIC X(01). DTSCS42 00174 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS42 00175 88 RESP-SEND-MAP VALUE 'M'. DTSCS42 00176 88 RESP-JUMP VALUE 'J'. DTSCS42 00177 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS42 00178 DTSCS42 00179 05 WRK-MSG-AREA PIC X(64). DTSCS42 00180 DTSCS42 00181 05 WRK-ATB-AN PIC X(01). CL*28 00182 CL*28 00183 05 WRK-ATB-NUM PIC X(01). DTSCS42 00184 DTSCS42 00185 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS42 00186 DTSCS42 00187 05 WRK-START-DATE PIC S9(09) COMP-3. DTSCS42 00188 CL*28 00189 05 WRK-END-DATE PIC S9(09) COMP-3. DTSCS42 00190 DTSCS42 00191 05 WRK-MPRF-IND PIC X(01). DTSCS42 00192 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS42 00193 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS42 00194 DTSCS42 00195 05 WRK-MCOL-IND PIC X(01). DTSCS42 00196 88 WRK-MCOL-YES-88 VALUE 'Y'. DTSCS42 00197 88 WRK-MCOL-NO-88 VALUE 'N'. DTSCS42 00198 DTSCS42 00199 05 WRK-PETITION-IND PIC X(01). DTSCS42 00200 88 WRK-PETITION-IND-YES-88 VALUE 'Y'. DTSCS42 00201 88 WRK-PETITION-IND-NO-88 VALUE 'N'. DTSCS42 00202 DTSCS42 00203 05 WRK-DISCHRG-IND PIC X(01). DTSCS42 00204 88 WRK-DISCHRG-IND-YES-88 VALUE 'Y'. DTSCS42 00205 88 WRK-DISCHRG-IND-NO-88 VALUE 'N'. DTSCS42 00206 DTSCS42 00207 05 WRK-POC-REQ-IND PIC X(01). DTSCS42 00208 88 WRK-POC-REQ-IND-YES-88 VALUE 'Y'. DTSCS42 00209 88 WRK-POC-REQ-IND-NO-88 VALUE 'N'. DTSCS42 00210 DTSCS42 00211 *****05 WRK-OVERLAP-IND PIC X(01). CL*28 00212 *********88 WRK-OVERLAP-YES-88 VALUE 'Y'. CL*28 00213 *********88 WRK-OVERLAP-NO-88 VALUE 'N'. CL*28 00214 DTSCS42 00215 05 WRK-ACTION-IND PIC X(01). DTSCS42 00216 88 WRK-ACTION-ADD-88 VALUE 'A'. DTSCS42 00217 88 WRK-ACTION-MOD-88 VALUE 'M'. DTSCS42 00218 DTSCS42 00219 05 WRK-NULL-MCOL-IND PIC X(01). DTSCS42 00220 88 WRK-NULL-MCOL-YES-88 VALUE 'Y'. DTSCS42 00221 88 WRK-NULL-MCOL-NO-88 VALUE 'N'. DTSCS42 00222 DTSCS42 00223 05 WRK-DISPLAY PIC 9(11). DTSCS42 00224 DTSCS42 00225 05 FILLER REDEFINES WRK-DISPLAY. DTSCS42 00226 10 FILLER PIC X(05). DTSCS42 00227 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS42 00228 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS42 00229 DTSCS42 00230 05 FILLER REDEFINES WRK-DISPLAY. DTSCS42 00231 10 FILLER PIC 9(05). DTSCS42 00232 10 WRK-DISPLAY-YR PIC 9(02). DTSCS42 00233 10 WRK-DISPLAY-MO PIC 9(02). DTSCS42 00234 10 WRK-DISPLAY-DA PIC 9(02). DTSCS42 00235 DTSCS42 00236 05 FILLER REDEFINES WRK-DISPLAY. DTSCS42 00237 10 FILLER PIC X(08). DTSCS42 00238 10 WRK-DISPLAY-ID-NO PIC X(03). DTSCS42 00239 DTSCS42 00240 05 WRK-OCC PIC S9(04) COMP. DTSCS42 00241 EJECT CL*28 00242 01 MSG-LITERALS. DTSCS42 00243 *****05 MSG-E421-AREA. CL*29 00244 *********10 FILLER PIC X(04) VALUE 'E421'. CL*29 00245 *********10 FILLER PIC X(60) VALUE CL*29 00246 *****'BANKRUPT EMPLOYERS MUST BE INACTIVE '. CL*29 00247 DTSCS42 00248 *****05 MSG-E422-AREA. CL*29 00249 *********10 FILLER PIC X(04) VALUE 'E422'. CL*29 00250 *********10 FILLER PIC X(60) VALUE CL*29 00251 *****'SPAN OF BANKRUPTCY MAY NOT OVERLAP A SPAN OF LIABILITY '. CL*29 00252 DTSCS42 00253 05 MSG-E421-AREA. DTSCS42 00254 10 FILLER PIC X(04) VALUE 'E421'. DTSCS42 00255 10 FILLER PIC X(60) VALUE DTSCS42 00256 'PROOF REQ MUST BE > PETITION DATE '.DTSCS42 00257 DTSCS42 00258 05 MSG-E422-AREA. DTSCS42 00259 10 FILLER PIC X(04) VALUE 'E422'. DTSCS42 00260 10 FILLER PIC X(60) VALUE DTSCS42 00261 'PROOF FILED MUST BE > PETITION DATE '.DTSCS42 00262 DTSCS42 00263 05 MSG-E423-AREA. DTSCS42 00264 10 FILLER PIC X(04) VALUE 'E423'. DTSCS42 00265 10 FILLER PIC X(60) VALUE DTSCS42 00266 'PROOF FILED MUST BE <= CURRENT PROCESSING DATE '.DTSCS42 00267 DTSCS42 00268 05 MSG-E424-AREA. DTSCS42 00269 10 FILLER PIC X(04) VALUE 'E424'. DTSCS42 00270 10 FILLER PIC X(60) VALUE DTSCS42 00271 'DISCHRG/CLOSE MUST BE > PETITION DATE '.DTSCS42 00272 DTSCS42 00273 05 MSG-E425-AREA. DTSCS42 00274 10 FILLER PIC X(04) VALUE 'E425'. DTSCS42 00275 10 FILLER PIC X(60) VALUE DTSCS42 00276 'DISCHRG/CLOSE MUST BE <= CURRENT PROCESSING DATE '.DTSCS42 00277 DTSCS42 00278 05 MSG-E426-AREA. DTSCS42 00279 10 FILLER PIC X(04) VALUE 'E426'. DTSCS42 00280 10 FILLER PIC X(60) VALUE DTSCS42 00281 'DISMISS MUST BE > PETITION DATE '.DTSCS42 00282 DTSCS42 00283 05 MSG-E427-AREA. DTSCS42 00284 10 FILLER PIC X(04) VALUE 'E427'. DTSCS42 00285 10 FILLER PIC X(60) VALUE DTSCS42 00286 'DISMISS MUST BE <= CURRENT PROCESSING DATE '.DTSCS42 00287 DTSCS42 00288 05 MSG-E428-AREA. DTSCS42 00289 10 FILLER PIC X(04) VALUE 'E428'. DTSCS42 00290 10 FILLER PIC X(60) VALUE DTSCS42 00291 'LAST COMM MUST BE > PETITION DATE '.DTSCS42 00292 DTSCS42 00293 05 MSG-E429-AREA. DTSCS42 00294 10 FILLER PIC X(04) VALUE 'E429'. DTSCS42 00295 10 FILLER PIC X(60) VALUE DTSCS42 00296 'LAST COMM MUST BE <= CURRENT PROCESSING DATE '.DTSCS42 00297 EJECT DTSCS42 00298 01 L001-COMM-AREA. DTSCS42 00299 ++INCLUDE DTSIL001 CL**2 00300 EJECT DTSCS42 00301 01 L015-COMM-AREA. DTSCS42 00302 ++INCLUDE DTSIL015 CL**2 00303 EJECT DTSCS42 00304 01 L018-COMM-AREA. DTSCS42 00305 ++INCLUDE DTSIL018 CL**2 00306 EJECT DTSCS42 00307 01 L031-COMM-AREA. DTSCS42 00308 ++INCLUDE DTSIL031 CL**2 00309 EJECT DTSCS42 00310 01 L034-COMM-AREA. DTSCS42 00311 ++INCLUDE DTSIL034 CL**2 00312 EJECT DTSCS42 00313 01 L061-COMM-AREA. DTSCS42 00314 ++INCLUDE DTSIL061 CL**2 00315 EJECT DTSCS42 00316 01 L062-COMM-AREA. DTSCS42 00317 ++INCLUDE DTSIL062 CL**2 00318 EJECT DTSCS42 00319 01 L082-COMM-AREA. CL**9 00320 ++INCLUDE DTSIL082 CL**9 00321 EJECT CL**9 00322 01 L221-COMM-AREA. DTSCS42 00323 ++INCLUDE DTSIL221 CL**2 00324 EJECT DTSCS42 00325 01 L331-COMM-AREA. DTSCS42 00326 ++INCLUDE DTSIL331 CL**2 00327 EJECT DTSCS42 00328 01 L805-COMM-AREA. DTSCS42 00329 ++INCLUDE DTSIL805 CL**2 00330 EJECT DTSCS42 00331 01 L810-COMM-AREA. DTSCS42 00332 05 L810-CONTROL-BLOCK. DTSCS42 00333 ++INCLUDE DTSIL810 CL**2 00334 EJECT DTSCS42 00335 05 MSKL-REC. DTSCS42 00336 ++INCLUDE DTSIMSKL CL**2 00337 EJECT DTSCS42 00338 01 MPRF-REC. DTSCS42 00339 ++INCLUDE DTSIMPRF CL**2 00340 EJECT DTSCS42 00341 01 MCOL-REC. DTSCS42 00342 ++INCLUDE DTSIMCOL CL**2 00343 EJECT DTSCS42 00344 01 MTAD-REC. DTSCS42 00345 ++INCLUDE DTSIMTAD CL**2 00346 EJECT DTSCS42 00347 01 MEVL-REC. CL*26 00348 ++INCLUDE DTSIMEVL CL*26 00349 EJECT CL*26 00350 01 L851-COMM-AREA. DTSCS42 00351 ++INCLUDE DTSIL851 CL**2 00352 DTSCS42 00353 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS42 00354 ++INCLUDE DTSIS42 CL**2 00355 EJECT DTSCS42 00356 01 CATB-LITERALS. DTSCS42 00357 ++INCLUDE DTSICATB CL**2 00358 DTSCS42 00359 01 CFKD-LITERALS. DTSCS42 00360 ++INCLUDE DTSICFKD CL**2 00361 DTSCS42 00362 01 CECD-LITERALS. DTSCS42 00363 ++INCLUDE DTSICECD CL**2 00364 DTSCS42 00365 01 CPCD-LITERALS. DTSCS42 00366 ++INCLUDE DTSICPCD CL**2 00367 DTSCS42 00368 01 MMAX-LITERALS. DTSCS42 00369 ++INCLUDE DTSIMMAX CL**2 00370 DTSCS42 00371 LINKAGE SECTION. DTSCS42 00372 DTSCS42 00373 01 DFHCOMMAREA. DTSCS42 00374 ++INCLUDE DTSILCCM CL**2 00375 EJECT DTSCS42 00376 ******************************************************************DTSCS42 00377 * *DTSCS42 00378 ******************************************************************DTSCS42 00379 DTSCS42 00380 PROCEDURE DIVISION. DTSCS42 00381 DTSCS42 00382 SET WRK-MPRF-NO-88 TO TRUE. DTSCS42 00383 CL*30 00384 SET WRK-MCOL-NO-88 TO TRUE. DTSCS42 00385 DTSCS42 00386 MOVE +0 TO WRK-EMP-NO. DTSCS42 00387 DTSCS42 00388 MOVE LOW-VALUES TO MAP-AREA. DTSCS42 00389 DTSCS42 00390 SET CURSOR-SET-NO TO TRUE. DTSCS42 00391 DTSCS42 00392 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS42 00393 TO SCR-ACCESS-IND. DTSCS42 00394 DTSCS42 00395 CL*30 00396 MOVE SPACE TO REQ-IND. DTSCS42 00397 DTSCS42 00398 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS42 00399 DTSCS42 00400 CL*30 00401 *----------------------------------------------------- DTSCS42 00402 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS42 00403 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS42 00404 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS42 00405 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS42 00406 * DTSCS42 00407 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS42 00408 * PROCESSED. DTSCS42 00409 * DTSCS42 00410 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS42 00411 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS42 00412 * WORK STATION OPERATOR. DTSCS42 00413 *----------------------------------------------------- DTSCS42 00414 DTSCS42 00415 MOVE SPACE TO RESP-IND. DTSCS42 00416 DTSCS42 00417 IF REQ-ERROR DTSCS42 00418 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS42 00419 ELSE DTSCS42 00420 IF REQ-JUMP DTSCS42 00421 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS42 00422 ELSE DTSCS42 00423 IF REQ-CLEAR DTSCS42 00424 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS42 00425 ELSE DTSCS42 00426 IF REQ-CURSOR-TO-GOTO DTSCS42 00427 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS42 00428 ELSE DTSCS42 00429 IF REQ-INQUIRE DTSCS42 00430 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS42 00431 ELSE DTSCS42 00432 IF REQ-EDIT DTSCS42 00433 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS42 00434 ELSE DTSCS42 00435 IF REQ-UPDATE DTSCS42 00436 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS42 00437 ELSE DTSCS42 00438 GO TO S899-ABEND. DTSCS42 00439 DTSCS42 00440 CL*30 00441 *----------------------------------------------------- DTSCS42 00442 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS42 00443 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS42 00444 *----------------------------------------------------- DTSCS42 00445 DTSCS42 00446 IF RESP-SEND-MAP DTSCS42 00447 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS42 00448 SET LCCM-END-TASK-88 TO TRUE DTSCS42 00449 ELSE DTSCS42 00450 IF RESP-SEND-MSGONLY DTSCS42 00451 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS42 00452 SET LCCM-END-TASK-88 TO TRUE DTSCS42 00453 ELSE DTSCS42 00454 IF RESP-JUMP DTSCS42 00455 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS42 00456 ELSE DTSCS42 00457 IF RESP-CURSOR-TO-GOTO DTSCS42 00458 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS42 00459 SET LCCM-END-TASK-88 TO TRUE DTSCS42 00460 ELSE DTSCS42 00461 GO TO S899-ABEND. DTSCS42 00462 DTSCS42 00463 CL*30 00464 MAINLINE-EXIT. DTSCS42 00465 DTSCS42 00466 EXEC CICS DTSCS42 00467 RETURN DTSCS42 00468 END-EXEC. DTSCS42 00469 DTSCS42 00470 GOBACK. DTSCS42 00471 EJECT DTSCS42 00472 /*****************************************************************DTSCS42 00473 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS42 00474 ******************************************************************DTSCS42 00475 CL*30 00476 P1000-ANALYZE-REQUEST. DTSCS42 00477 DTSCS42 00478 *----------------------------------------------------- DTSCS42 00479 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS42 00480 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS42 00481 * REPLACED WITH ENTER) DTSCS42 00482 *----------------------------------------------------- DTSCS42 00483 CL*30 00484 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS42 00485 SET LCCM-ENTER-88 TO TRUE DTSCS42 00486 IF LCCM-EMP-NO > ZERO DTSCS42 00487 SET REQ-INQUIRE TO TRUE DTSCS42 00488 MOVE LCCM-EMP-NO TO WRK-DISPLAY DTSCS42 00489 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS42 00490 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS42 00491 ELSE DTSCS42 00492 SET REQ-INQUIRE TO TRUE DTSCS42 00493 END-IF DTSCS42 00494 GO TO P1000-EXIT. DTSCS42 00495 DTSCS42 00496 CL*30 00497 *----------------------------------------------------- DTSCS42 00498 * MAP IS RECEIVED DTSCS42 00499 *----------------------------------------------------- DTSCS42 00500 CL*30 00501 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS42 00502 DTSCS42 00503 CL*30 00504 *----------------------------------------------------- DTSCS42 00505 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS42 00506 * WORK STATION DTSCS42 00507 *----------------------------------------------------- DTSCS42 00508 CL*30 00509 IF LCCM-CLEAR-88 DTSCS42 00510 SET REQ-CLEAR TO TRUE DTSCS42 00511 GO TO P1000-EXIT. DTSCS42 00512 DTSCS42 00513 CL*30 00514 *----------------------------------------------------- DTSCS42 00515 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS42 00516 *----------------------------------------------------- DTSCS42 00517 CL*30 00518 IF LCCM-SCR-UPDATE-LOCKED DTSCS42 00519 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS42 00520 GO TO P1000-EXIT. DTSCS42 00521 DTSCS42 00522 CL*30 00523 *----------------------------------------------------- DTSCS42 00524 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS42 00525 *----------------------------------------------------- DTSCS42 00526 CL*30 00527 IF LCCM-PA2-88 DTSCS42 00528 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS42 00529 GO TO P1000-EXIT. DTSCS42 00530 DTSCS42 00531 CL*30 00532 *----------------------------------------------------- DTSCS42 00533 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS42 00534 *----------------------------------------------------- DTSCS42 00535 CL*30 00536 IF LCCM-PA-88 DTSCS42 00537 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS42 00538 SET REQ-ERROR TO TRUE DTSCS42 00539 GO TO P1000-EXIT. DTSCS42 00540 DTSCS42 00541 CL*30 00542 *----------------------------------------------------- CL**2 00543 * IF F12 KEY IS PRESSED AND UPDATE IN PROGRESS CL**2 00544 * CLEAR SCREEN CL**2 00545 *----------------------------------------------------- CL**2 00546 CL*30 00547 IF LCCM-F12-88 CL**2 00548 MOVE LOW-VALUES TO MAP-AREA CL**2 00549 SET REQ-CLEAR TO TRUE CL**2 00550 GO TO P1000-EXIT. CL**2 00551 CL**2 00552 CL*30 00553 *----------------------------------------------------- DTSCS42 00554 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS42 00555 *----------------------------------------------------- DTSCS42 00556 CL*30 00557 IF LCCM-F03-88 DTSCS42 00558 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS42 00559 SET REQ-JUMP TO TRUE DTSCS42 00560 GO TO P1000-EXIT. DTSCS42 00561 DTSCS42 00562 CL*30 00563 *----------------------------------------------------- DTSCS42 00564 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS42 00565 *----------------------------------------------------- DTSCS42 00566 CL*30 00567 IF LCCM-F04-88 DTSCS42 00568 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS42 00569 SET REQ-JUMP TO TRUE DTSCS42 00570 GO TO P1000-EXIT. DTSCS42 00571 DTSCS42 00572 CL*30 00573 *--------------------------------------------------------- DTSCS42 00574 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS42 00575 * CORRESPONDENCE SCREEN. DTSCS42 00576 *--------------------------------------------------------- DTSCS42 00577 CL*24 00578 IF LCCM-F14-88 CL*24 00579 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID CL*24 00580 SET REQ-JUMP TO TRUE CL*24 00581 GO TO P1000-EXIT. CL*24 00582 CL*24 00583 CL*30 00584 *----------------------------------------------------- DTSCS42 00585 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS42 00586 * REQUESTED SCREEN TYPE DTSCS42 00587 *----------------------------------------------------- DTSCS42 00588 CL*30 00589 *****IF LCCM-F19-88 CL*30 00590 ********MOVE '31' TO LCCM-REQ-SCR-ID CL*30 00591 ********SET REQ-JUMP TO TRUE CL*30 00592 ********GO TO P1000-EXIT. CL*30 00593 CL*30 00594 *****IF LCCM-F20-88 CL*30 00595 ********MOVE '41' TO LCCM-REQ-SCR-ID CL*30 00596 ********SET REQ-JUMP TO TRUE CL*30 00597 ********GO TO P1000-EXIT. CL*30 00598 CL*30 00599 CL*30 00600 *----------------------------------------------------- DTSCS42 00601 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS42 00602 * REQUESTED SCREEN TYPE DTSCS42 00603 *----------------------------------------------------- DTSCS42 00604 CL*30 00605 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS42 00606 NEXT SENTENCE DTSCS42 00607 ELSE DTSCS42 00608 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS42 00609 SET REQ-JUMP TO TRUE DTSCS42 00610 GO TO P1000-EXIT. DTSCS42 00611 DTSCS42 00612 CL*30 00613 *----------------------------------------------------- DTSCS42 00614 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS42 00615 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS42 00616 *----------------------------------------------------- DTSCS42 00617 CL*30 00618 IF LCCM-F10-88 DTSCS42 00619 IF SCR-ACCESS-UPDATE DTSCS42 00620 SET REQ-EDIT TO TRUE DTSCS42 00621 GO TO P1000-EXIT DTSCS42 00622 ELSE DTSCS42 00623 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS42 00624 SET REQ-ERROR TO TRUE DTSCS42 00625 GO TO P1000-EXIT. DTSCS42 00626 DTSCS42 00627 CL*30 00628 *----------------------------------------------------- DTSCS42 00629 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS42 00630 * OR F8), INDICATE INQUIRY REQUEST DTSCS42 00631 *----------------------------------------------------- DTSCS42 00632 CL*30 00633 IF LCCM-ENTER-88 DTSCS42 00634 SET REQ-INQUIRE TO TRUE DTSCS42 00635 GO TO P1000-EXIT. DTSCS42 00636 DTSCS42 00637 CL*30 00638 *----------------------------------------------------- DTSCS42 00639 * ANY OTHER KEY IS INVALID DTSCS42 00640 *----------------------------------------------------- DTSCS42 00641 CL*30 00642 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS42 00643 CL*30 00644 SET REQ-ERROR TO TRUE. DTSCS42 00645 P1000-EXIT. DTSCS42 00646 EXIT. DTSCS42 00647 DTSCS42 00648 CL*30 00649 CL*30 00650 ******************************************************************DTSCS42 00651 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS42 00652 ******************************************************************DTSCS42 00653 DTSCS42 00654 P1100-UPDATE-LOCKED. DTSCS42 00655 CL*30 00656 *----------------------------------------------------- DTSCS42 00657 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS42 00658 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS42 00659 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS42 00660 *----------------------------------------------------- DTSCS42 00661 CL*30 00662 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS42 00663 SET REQ-UPDATE TO TRUE DTSCS42 00664 ELSE DTSCS42 00665 SET REQ-ERROR TO TRUE DTSCS42 00666 IF LCCM-SCR-MOD-LOCKED DTSCS42 00667 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS42 00668 ELSE DTSCS42 00669 GO TO S899-ABEND. DTSCS42 00670 P1100-EXIT. DTSCS42 00671 EXIT. DTSCS42 00672 /*****************************************************************DTSCS42 00673 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS42 00674 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS42 00675 ******************************************************************DTSCS42 00676 DTSCS42 00677 P2000-REQUEST-ERROR. DTSCS42 00678 IF LCCM-MSG DTSCS42 00679 SET RESP-SEND-MSGONLY TO TRUE DTSCS42 00680 ELSE DTSCS42 00681 GO TO S899-ABEND. DTSCS42 00682 P2000-EXIT. DTSCS42 00683 EXIT. DTSCS42 00684 /*****************************************************************DTSCS42 00685 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS42 00686 ******************************************************************DTSCS42 00687 DTSCS42 00688 P3000-REQUEST-JUMP. DTSCS42 00689 CL*31 00690 *----------------------------------------------------- DTSCS42 00691 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS42 00692 * BY USER DTSCS42 00693 *----------------------------------------------------- DTSCS42 00694 CL*31 00695 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS42 00696 DTSCS42 00697 CL*31 00698 *----------------------------------------------------- DTSCS42 00699 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS42 00700 *----------------------------------------------------- DTSCS42 00701 CL*31 00702 IF LCCM-MSG DTSCS42 00703 SET RESP-SEND-MSGONLY TO TRUE DTSCS42 00704 SET CURSOR-SET-GOTO TO TRUE DTSCS42 00705 GO TO P3000-EXIT. DTSCS42 00706 CL*31 00707 CL*31 00708 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS42 00709 CL*31 00710 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS42 00711 CL*31 00712 IF L018-VALID DTSCS42 00713 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS42 00714 DTSCS42 00715 CL*31 00716 *----------------------------------------------------- DTSCS42 00717 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS42 00718 *----------------------------------------------------- DTSCS42 00719 CL*31 00720 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS42 00721 LCCM-SCR-HOLD-AREA. DTSCS42 00722 CL*31 00723 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS42 00724 CL*31 00725 SET RESP-JUMP TO TRUE. DTSCS42 00726 P3000-EXIT. DTSCS42 00727 EXIT. DTSCS42 00728 /*****************************************************************DTSCS42 00729 * CLEAR KEY WAS PRESSED *DTSCS42 00730 ******************************************************************DTSCS42 00731 DTSCS42 00732 P4000-REQUEST-CLEAR. DTSCS42 00733 DTSCS42 00734 *----------------------------------------------------- DTSCS42 00735 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS42 00736 * FIELDS FROM EARLIER REQUESTS DTSCS42 00737 *----------------------------------------------------- DTSCS42 00738 CL*31 00739 IF LCCM-EMP-NO > ZERO DTSCS42 00740 MOVE LCCM-EMP-NO TO WRK-DISPLAY DTSCS42 00741 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS42 00742 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS42 00743 DTSCS42 00744 MOVE ZERO TO LCCM-EMP-NO DTSCS42 00745 DTSCS42 00746 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS42 00747 DTSCS42 00748 SET LCCM-SCR-CLEAR TO TRUE. DTSCS42 00749 DTSCS42 00750 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS42 00751 DTSCS42 00752 SET RESP-SEND-MAP TO TRUE. DTSCS42 00753 P4000-EXIT. DTSCS42 00754 EXIT. DTSCS42 00755 /*****************************************************************DTSCS42 00756 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS42 00757 ******************************************************************DTSCS42 00758 DTSCS42 00759 P5000-CURSOR-TO-GOTO. DTSCS42 00760 SET CURSOR-SET-GOTO TO TRUE. DTSCS42 00761 CL*31 00762 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS42 00763 P5000-EXIT. DTSCS42 00764 EXIT. DTSCS42 00765 /*****************************************************************DTSCS42 00766 * INQUIRY WAS REQUESTED *DTSCS42 00767 ******************************************************************DTSCS42 00768 DTSCS42 00769 P6000-REQUEST-INQUIRE. DTSCS42 00770 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS42 00771 CL*31 00772 MOVE LOW-VALUES TO MAP-AREA. DTSCS42 00773 CL*31 00774 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS42 00775 DTSCS42 00776 SET LCCM-SCR-CLEAR TO TRUE. DTSCS42 00777 CL*31 00778 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS42 00779 DTSCS42 00780 SET RESP-SEND-MAP TO TRUE. DTSCS42 00781 DTSCS42 00782 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS42 00783 DTSCS42 00784 CL*31 00785 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS42 00786 CL*31 00787 IF LCCM-MSG DTSCS42 00788 GO TO P6000-EXIT. DTSCS42 00789 DTSCS42 00790 CL*31 00791 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS42 00792 DTSCS42 00793 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS42 00794 DTSCS42 00795 IF LCCM-MSG DTSCS42 00796 GO TO P6000-EXIT. DTSCS42 00797 DTSCS42 00798 CL*31 00799 IF SCR-ACCESS-UPDATE DTSCS42 00800 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS42 00801 DTSCS42 00802 CL*31 00803 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS42 00804 DTSCS42 00805 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS42 00806 P6000-EXIT. DTSCS42 00807 EXIT. DTSCS42 00808 /*****************************************************************DTSCS42 00809 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS42 00810 ******************************************************************DTSCS42 00811 DTSCS42 00812 P6900-CONSTRUCT-SCREEN. DTSCS42 00813 IF MPRF-WRITE-OFF-DATE > +0 CL**2 00814 MOVE MPRF-WRITE-OFF-DATE TO L001-FED-8-DATE-9 CL**2 00815 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS42 00816 MOVE L001-SLASH-DATE TO MAP-WRITEOFF-DATE. CL*10 00817 DTSCS42 00818 MOVE MPRF-SUSPEND-COLL-IND TO MAP-SUSPEND-IND. CL**4 00819 CL**4 00820 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. CL*31 00821 CL*31 00822 MOVE MPRF-FLD-ST TO L061-FLD-ST. CL*31 00823 CL*31 00824 MOVE WRK-EMP-NO TO L061-EMP-NO. CL*31 00825 CL*31 00826 PERFORM S061-FLD-ZIP THRU S061-EXIT. CL*31 00827 CL*31 00828 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID CL*31 00829 L062-FLD-REP-ID. CL*31 00830 CL**4 00831 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT. CL*10 00832 CL*31 00833 MOVE L062-NAME TO MAP-FLD-REP-ID-DSCR. CL*31 00834 CL**4 00835 CL*31 00836 PERFORM S1110-READ-MCOL THRU S1110-EXIT. DTSCS42 00837 DTSCS42 00838 IF WRK-MCOL-YES-88 DTSCS42 00839 PERFORM P6910-FROM-MCOL THRU P6910-EXIT. DTSCS42 00840 DTSCS42 00841 CL*31 00842 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS42 00843 CL*31 00844 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS42 00845 CL*31 00846 SET MTAD-TAD-88 TO TRUE. DTSCS42 00847 CL*31 00848 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. CL**4 00849 CL*31 00850 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS42 00851 CL*31 00852 PERFORM S810-START-BROWSE THRU S810-EXIT. CL*22 00853 CL*31 00854 PERFORM P6930-MTAD-SCAN THRU P6930-EXIT CL*22 00855 UNTIL L810-NO-REC-88. CL*22 00856 P6900-EXIT. DTSCS42 00857 EXIT. DTSCS42 00858 DTSCS42 00859 CL*31 00860 CL*31 00861 P6910-FROM-MCOL. DTSCS42 00862 IF MCOL-FINAL-NOTICE-DATE > +0 DTSCS42 00863 MOVE MCOL-FINAL-NOTICE-DATE TO WRK-DISPLAY DTSCS42 00864 MOVE WRK-DISPLAY-MO TO MAP-FINAL-NOTICE-MO DTSCS42 00865 MOVE WRK-DISPLAY-DA TO MAP-FINAL-NOTICE-DA DTSCS42 00866 MOVE WRK-DISPLAY-YR TO MAP-FINAL-NOTICE-YR DTSCS42 00867 END-IF. DTSCS42 00868 DTSCS42 00869 MOVE MCOL-SUBPOENA-ACTIVITY-CD TO MAP-SUBPOENA-CD. DTSCS42 00870 DTSCS42 00871 IF MCOL-LEGAL-REFERRAL-DATE > +0 CL**2 00872 MOVE MCOL-LEGAL-REFERRAL-DATE TO WRK-DISPLAY CL**2 00873 MOVE WRK-DISPLAY-MO TO MAP-LEGAL-REF-MO CL**2 00874 MOVE WRK-DISPLAY-DA TO MAP-LEGAL-REF-DA CL**2 00875 MOVE WRK-DISPLAY-YR TO MAP-LEGAL-REF-YR CL**2 00876 END-IF. CL**2 00877 CL**2 00878 IF MCOL-SUBPOENA-ACTIVITY-DATE > +0 DTSCS42 00879 MOVE MCOL-SUBPOENA-ACTIVITY-DATE TO WRK-DISPLAY DTSCS42 00880 MOVE WRK-DISPLAY-MO TO MAP-SUBPOENA-MO DTSCS42 00881 MOVE WRK-DISPLAY-DA TO MAP-SUBPOENA-DA DTSCS42 00882 MOVE WRK-DISPLAY-YR TO MAP-SUBPOENA-YR DTSCS42 00883 END-IF. DTSCS42 00884 DTSCS42 00885 CL**2 00886 IF MCOL-CIVIL-ACTION-BEGIN-DATE > +0 CL**2 00887 MOVE MCOL-CIVIL-ACTION-BEGIN-DATE TO WRK-DISPLAY CL**2 00888 MOVE WRK-DISPLAY-MO TO MAP-CIVIL-ACTION-BEGIN-MO CL**2 00889 MOVE WRK-DISPLAY-DA TO MAP-CIVIL-ACTION-BEGIN-DA CL**2 00890 MOVE WRK-DISPLAY-YR TO MAP-CIVIL-ACTION-BEGIN-YR CL**2 00891 END-IF. CL**2 00892 DTSCS42 00893 MOVE MCOL-SUBPOENA-RESP-OP-ID TO MAP-SUBPOENA-OPID. CL**2 00894 DTSCS42 00895 IF MCOL-CIVIL-ACTION-JUDGE-DATE > +0 CL**2 00896 MOVE MCOL-CIVIL-ACTION-JUDGE-DATE TO WRK-DISPLAY CL**2 00897 MOVE WRK-DISPLAY-MO TO MAP-CIVIL-ACTION-JUDGE-MO CL**2 00898 MOVE WRK-DISPLAY-DA TO MAP-CIVIL-ACTION-JUDGE-DA CL**2 00899 MOVE WRK-DISPLAY-YR TO MAP-CIVIL-ACTION-JUDGE-YR CL**2 00900 END-IF. CL**2 00901 CL**2 00902 IF MCOL-BNK-PETITION-DATE > +0 CL**2 00903 MOVE MCOL-BNK-PETITION-DATE TO WRK-DISPLAY CL**2 00904 MOVE WRK-DISPLAY-MO TO MAP-BNK-PETITION-MO CL**2 00905 MOVE WRK-DISPLAY-DA TO MAP-BNK-PETITION-DA CL**2 00906 MOVE WRK-DISPLAY-YR TO MAP-BNK-PETITION-YR CL**2 00907 END-IF. CL**2 00908 CL**2 00909 MOVE MCOL-BNK-COURT-CASE-NO TO MAP-BNK-COURT-CASE-NO. CL**2 00910 CL**2 00911 MOVE MCOL-BNK-CHAPTER TO MAP-BNK-CHAPTER. CL**2 00912 CL**2 00913 IF MCOL-BNK-POC-REQUIRED-DATE > +0 CL**2 00914 MOVE MCOL-BNK-POC-REQUIRED-DATE TO WRK-DISPLAY CL**2 00915 MOVE WRK-DISPLAY-MO TO MAP-BNK-POC-REQUIRED-MO CL**2 00916 MOVE WRK-DISPLAY-DA TO MAP-BNK-POC-REQUIRED-DA CL**2 00917 MOVE WRK-DISPLAY-YR TO MAP-BNK-POC-REQUIRED-YR CL**2 00918 END-IF. CL**2 00919 CL**2 00920 IF MCOL-BNK-POC-FILED-DATE > +0 CL**2 00921 MOVE MCOL-BNK-POC-FILED-DATE TO WRK-DISPLAY CL**2 00922 MOVE WRK-DISPLAY-MO TO MAP-BNK-POC-FILED-MO CL**2 00923 MOVE WRK-DISPLAY-DA TO MAP-BNK-POC-FILED-DA CL**2 00924 MOVE WRK-DISPLAY-YR TO MAP-BNK-POC-FILED-YR CL**2 00925 END-IF. CL**2 00926 CL**2 00927 IF MCOL-BNK-CHAPTER-CHNG-DATE > +0 CL**2 00928 MOVE MCOL-BNK-CHAPTER-CHNG-DATE TO WRK-DISPLAY CL**2 00929 MOVE WRK-DISPLAY-MO TO MAP-BNK-CHAPTER-CHNG-MO CL**2 00930 MOVE WRK-DISPLAY-DA TO MAP-BNK-CHAPTER-CHNG-DA CL**2 00931 MOVE WRK-DISPLAY-YR TO MAP-BNK-CHAPTER-CHNG-YR CL**2 00932 END-IF. CL**2 00933 CL**2 00934 IF MCOL-BNK-LAST-COMM-DATE > +0 CL**2 00935 MOVE MCOL-BNK-LAST-COMM-DATE TO WRK-DISPLAY CL**2 00936 MOVE WRK-DISPLAY-MO TO MAP-BNK-LAST-COMM-MO CL**2 00937 MOVE WRK-DISPLAY-DA TO MAP-BNK-LAST-COMM-DA CL**2 00938 MOVE WRK-DISPLAY-YR TO MAP-BNK-LAST-COMM-YR CL**2 00939 END-IF. CL**2 00940 CL**2 00941 IF MCOL-BNK-DISCHRG-CLOSE-DATE > +0 DTSCS42 00942 MOVE MCOL-BNK-DISCHRG-CLOSE-DATE TO WRK-DISPLAY DTSCS42 00943 MOVE WRK-DISPLAY-MO TO MAP-BNK-DISCHRG-CLOSE-MO DTSCS42 00944 MOVE WRK-DISPLAY-DA TO MAP-BNK-DISCHRG-CLOSE-DA DTSCS42 00945 MOVE WRK-DISPLAY-YR TO MAP-BNK-DISCHRG-CLOSE-YR DTSCS42 00946 END-IF. DTSCS42 00947 DTSCS42 00948 IF MCOL-BNK-DISMISS-DATE > +0 DTSCS42 00949 MOVE MCOL-BNK-DISMISS-DATE TO WRK-DISPLAY DTSCS42 00950 MOVE WRK-DISPLAY-MO TO MAP-BNK-DISMISS-MO DTSCS42 00951 MOVE WRK-DISPLAY-DA TO MAP-BNK-DISMISS-DA DTSCS42 00952 MOVE WRK-DISPLAY-YR TO MAP-BNK-DISMISS-YR DTSCS42 00953 END-IF. DTSCS42 00954 DTSCS42 00955 IF MCOL-BNK-PETITION-DATE = +0 DTSCS42 00956 MOVE LOW-VALUES TO MAP-BANKRUPTCY-OPEN-IND DTSCS42 00957 ELSE DTSCS42 00958 IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0) DTSCS42 00959 AND DTSCS42 00960 (MCOL-BNK-DISMISS-DATE = +0) DTSCS42 00961 MOVE 'OPEN' TO MAP-BANKRUPTCY-OPEN-IND DTSCS42 00962 ELSE DTSCS42 00963 MOVE 'CLOSED' TO MAP-BANKRUPTCY-OPEN-IND. DTSCS42 00964 DTSCS42 00965 MOVE MCOL-STMT-TEXT-TYPE TO MAP-STMT-TYPE. CL*20 00966 DTSCS42 00967 MOVE MCOL-STMT-TEXT-PERM-IND TO MAP-STMT-PERMANENT-IND. CL*17 00968 DTSCS42 00969 PERFORM DTSCS42 00970 VARYING WRK-OCC DTSCS42 00971 FROM 1 BY 1 DTSCS42 00972 UNTIL WRK-OCC > MCOL-STMT-TEXT-CNT CL**2 00973 MOVE MCOL-STMT-TEXT(WRK-OCC) CL**2 00974 TO MAP-STMT-TEXT(WRK-OCC) CL*10 00975 END-PERFORM. DTSCS42 00976 P6910-EXIT. DTSCS42 00977 EXIT. DTSCS42 00978 DTSCS42 00979 CL*31 00980 P6930-MTAD-SCAN. CL*22 00981 MOVE MSKL-REC TO MTAD-REC. CL*22 00982 CL*22 00983 IF MTAD-ID-TAX-MAILING-ADDR-88 CL*46 00984 MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-1-AREA-CD CL*22 00985 MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-1-PREFIX CL*22 00986 MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-1-SUFFIX CL*22 00987 MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-1-EXT CL*47 00988 MOVE MTAD-UC223-IND CL*22 00989 TO MAP-MAIL-DB-MEMO-IND CL*22 00990 MOVE MTAD-MISSING-RPT-LETTERS-IND CL*22 00991 TO MAP-MAIL-MISS-RPT-IND CL*22 00992 ELSE CL*22 00993 MOVE MTAD-UC223-IND CL*22 00994 TO MAP-PHYS-DB-MEMO-IND CL*22 00995 MOVE MTAD-MISSING-RPT-LETTERS-IND CL*22 00996 TO MAP-PHYS-MISS-RPT-IND. CL*22 00997 CL*22 00998 PERFORM S810-READ-NEXT THRU S810-EXIT. CL*22 00999 P6930-EXIT. CL*31 01000 EXIT. CL*31 01001 /*****************************************************************DTSCS42 01002 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED. *DTSCS42 01003 ******************************************************************DTSCS42 01004 DTSCS42 01005 P7000-REQUEST-EDIT. DTSCS42 01006 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS42 01007 DTSCS42 01008 CL*31 01009 IF LCCM-F10-88 DTSCS42 01010 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS42 01011 ELSE DTSCS42 01012 GO TO S899-ABEND. DTSCS42 01013 DTSCS42 01014 CL*31 01015 *------------------------------------------------------ DTSCS42 01016 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS42 01017 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS42 01018 * REMAIN IN 'INQUIRE' STATUS. DTSCS42 01019 *------------------------------------------------------ DTSCS42 01020 DTSCS42 01021 IF LCCM-MSG DTSCS42 01022 NEXT SENTENCE DTSCS42 01023 ELSE DTSCS42 01024 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS42 01025 IF LCCM-F10-88 DTSCS42 01026 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS42 01027 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCS42 01028 DTSCS42 01029 CL*31 01030 SET RESP-SEND-MAP TO TRUE. DTSCS42 01031 P7000-EXIT. DTSCS42 01032 EXIT. DTSCS42 01033 /*****************************************************************DTSCS42 01034 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS42 01035 ******************************************************************DTSCS42 01036 DTSCS42 01037 P7200-EDIT-MOD. DTSCS42 01038 CL*32 01039 *----------------------------------------------------- DTSCS42 01040 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS42 01041 * INQUIRED DTSCS42 01042 *----------------------------------------------------- DTSCS42 01043 CL*32 01044 IF NOT LCCM-SCR-INQUIRE DTSCS42 01045 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS42 01046 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS42 01047 GO TO P7200-EXIT. DTSCS42 01048 DTSCS42 01049 CL*32 01050 *----------------------------------------------------- DTSCS42 01051 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS42 01052 *----------------------------------------------------- DTSCS42 01053 CL*32 01054 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS42 01055 CL*32 01056 IF LCCM-MSG DTSCS42 01057 GO TO P7200-EXIT. DTSCS42 01058 DTSCS42 01059 CL*32 01060 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS42 01061 MOVE EMSG-NO-EMP-NO-CHANGE TO WRK-MSG-AREA DTSCS42 01062 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS42 01063 GO TO P7200-EXIT. DTSCS42 01064 DTSCS42 01065 CL*32 01066 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS42 01067 DTSCS42 01068 IF LCCM-MSG DTSCS42 01069 GO TO P7200-EXIT. DTSCS42 01070 DTSCS42 01071 CL*32 01072 PERFORM S1110-READ-MCOL THRU S1110-EXIT. DTSCS42 01073 DTSCS42 01074 IF LCCM-MSG DTSCS42 01075 GO TO P7200-EXIT. DTSCS42 01076 DTSCS42 01077 CL*32 01078 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS42 01079 P7200-EXIT. DTSCS42 01080 EXIT. DTSCS42 01081 /*****************************************************************DTSCS42 01082 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS42 01083 ******************************************************************DTSCS42 01084 DTSCS42 01085 P8000-REQUEST-UPDATE. DTSCS42 01086 IF LCCM-SCR-MOD-LOCKED DTSCS42 01087 PERFORM P8200-MOD THRU P8200-EXIT DTSCS42 01088 ELSE DTSCS42 01089 GO TO S899-ABEND. DTSCS42 01090 DTSCS42 01091 SET RESP-SEND-MAP TO TRUE. DTSCS42 01092 P8000-EXIT. DTSCS42 01093 EXIT. DTSCS42 01094 /*****************************************************************DTSCS42 01095 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS42 01096 ******************************************************************DTSCS42 01097 DTSCS42 01098 P8200-MOD. DTSCS42 01099 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS42 01100 DTSCS42 01101 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS42 01102 DTSCS42 01103 CL*33 01104 IF LCCM-F12-88 DTSCS42 01105 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS42 01106 GO TO P8200-EXIT. DTSCS42 01107 DTSCS42 01108 CL*33 01109 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS42 01110 DTSCS42 01111 CL*33 01112 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS42 01113 CL*33 01114 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS42 01115 CL*33 01116 IF LCCM-MSG DTSCS42 01117 GO TO P8200-EXIT. DTSCS42 01118 DTSCS42 01119 CL*33 01120 MOVE WRK-EMP-NO TO L331-EMP-NO. CL*40 01121 CL*40 01122 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. CL*40 01123 CL*40 01124 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. CL*40 01125 CL*40 01126 MOVE LCCM-OP-ID TO L331-OP-ID. CL*40 01127 CL*40 01128 CL*40 01129 PERFORM P8210-CONSTRUCT-MCOL THRU P8210-EXIT. DTSCS42 01130 DTSCS42 01131 CL*33 01132 PERFORM P8212-UPDATE-MPRF THRU P8212-EXIT. DTSCS42 01133 DTSCS42 01134 CL*33 01135 PERFORM P8213-UPDATE-MTAD THRU P8213-EXIT DTSCS42 01136 VARYING WRK-OCC FROM 1 BY 1 UNTIL WRK-OCC > 2. CL**4 01137 DTSCS42 01138 CL*33 01139 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS42 01140 DTSCS42 01141 CL*33 01142 IF MCOL-BNK-PETITION-DATE = +0 DTSCS42 01143 MOVE LOW-VALUES TO MAP-BANKRUPTCY-OPEN-IND DTSCS42 01144 ELSE DTSCS42 01145 IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0) DTSCS42 01146 AND DTSCS42 01147 (MCOL-BNK-DISMISS-DATE = +0) DTSCS42 01148 MOVE 'OPEN' TO MAP-BANKRUPTCY-OPEN-IND DTSCS42 01149 ELSE DTSCS42 01150 MOVE 'CLOSED' TO MAP-BANKRUPTCY-OPEN-IND. DTSCS42 01151 CL**9 01152 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS42 01153 DTSCS42 01154 CL*33 01155 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS42 01156 P8200-EXIT. DTSCS42 01157 EXIT. DTSCS42 01158 EJECT DTSCS42 01159 P8210-CONSTRUCT-MCOL. DTSCS42 01160 PERFORM S1110-READ-MCOL THRU S1110-EXIT. DTSCS42 01161 CL*34 01162 IF L810-NO-REC-88 DTSCS42 01163 SET WRK-ACTION-ADD-88 TO TRUE DTSCS42 01164 PERFORM P8211-INIT-MCOL THRU P8211-EXIT DTSCS42 01165 ELSE DTSCS42 01166 SET WRK-ACTION-MOD-88 TO TRUE DTSCS42 01167 MOVE MSKL-REC TO MCOL-REC. DTSCS42 01168 DTSCS42 01169 CL*34 01170 MOVE LCCM-CURR-RUN-DATE TO MCOL-CHNG-DATE. CL*34 01171 CL**2 01172 CL*34 01173 MOVE MAP-FINAL-NOTICE-DATE TO L015-S-DATE-AREA. CL*34 01174 CL*34 01175 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**2 01176 CL*34 01177 MOVE L015-DATE TO MCOL-FINAL-NOTICE-DATE. CL*34 01178 CL**2 01179 CL*34 01180 MOVE MAP-SUBPOENA-CD TO MCOL-SUBPOENA-ACTIVITY-CD. CL*34 01181 DTSCS42 01182 CL*34 01183 MOVE MAP-LEGAL-REF-DATE TO L015-S-DATE-AREA. CL*34 01184 CL*34 01185 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 01186 CL*34 01187 IF MCOL-LEGAL-REFERRAL-DATE = ZERO CL*34 01188 AND L015-DATE NOT = ZERO CL*34 01189 PERFORM P8240-CREATE-MEVL THRU P8240-EXIT CL*34 01190 END-IF. CL*34 01191 CL*34 01192 MOVE L015-DATE TO MCOL-LEGAL-REFERRAL-DATE. CL*34 01193 DTSCS42 01194 CL*34 01195 MOVE MAP-SUBPOENA-DATE TO L015-S-DATE-AREA. CL*34 01196 CL*34 01197 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 01198 CL*34 01199 MOVE L015-DATE TO MCOL-SUBPOENA-ACTIVITY-DATE. CL*34 01200 DTSCS42 01201 CL*34 01202 MOVE MAP-CIVIL-ACTION-BEGIN-DATE TO L015-S-DATE-AREA. CL*34 01203 CL*34 01204 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 01205 CL*34 01206 MOVE L015-DATE TO MCOL-CIVIL-ACTION-BEGIN-DATE. CL*34 01207 CL**2 01208 CL*34 01209 MOVE MAP-SUBPOENA-OPID TO MCOL-SUBPOENA-RESP-OP-ID. CL*34 01210 DTSCS42 01211 CL*34 01212 MOVE MAP-CIVIL-ACTION-JUDGE-DATE TO L015-S-DATE-AREA. CL*34 01213 CL*34 01214 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 01215 CL*34 01216 MOVE L015-DATE TO MCOL-CIVIL-ACTION-JUDGE-DATE. CL*34 01217 DTSCS42 01218 CL*34 01219 MOVE MAP-BNK-PETITION-DATE-AREA TO L015-S-DATE-AREA. CL*34 01220 CL*34 01221 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**2 01222 CL*34 01223 MOVE L015-DATE TO MCOL-BNK-PETITION-DATE. CL*34 01224 CL**2 01225 CL*34 01226 MOVE MAP-BNK-COURT-CASE-NO TO MCOL-BNK-COURT-CASE-NO. CL**2 01227 DTSCS42 01228 CL*34 01229 MOVE MAP-BNK-CHAPTER TO MCOL-BNK-CHAPTER. CL*34 01230 CL**2 01231 CL*34 01232 MOVE MAP-BNK-POC-REQUIRED-DATE-AREA TO L015-S-DATE-AREA. CL*34 01233 CL*34 01234 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**2 01235 CL*34 01236 MOVE L015-DATE TO MCOL-BNK-POC-REQUIRED-DATE. CL*34 01237 CL*34 01238 CL*34 01239 *****CREATION OF TICKLER NOT REQUIRED IN DC CL*34 01240 CL*34 01241 *****IF L015-DATE > +0 CL*34 01242 *****AND L015-DATE NOT = MCOL-BNK-POC-REQUIRED-DATE CL*34 01243 ********PERFORM P8230-CREATE-MTCK THRU P8230-EXIT. CL*34 01244 CL**2 01245 CL*34 01246 MOVE MAP-BNK-POC-FILED-DATE-AREA TO L015-S-DATE-AREA. CL*34 01247 CL*34 01248 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**2 01249 CL*34 01250 MOVE L015-DATE TO MCOL-BNK-POC-FILED-DATE. CL*34 01251 DTSCS42 01252 CL*34 01253 MOVE MAP-BNK-CHAPTER-CHNG-DATE-AREA TO L015-S-DATE-AREA. CL*34 01254 CL*34 01255 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 01256 CL*34 01257 MOVE L015-DATE TO MCOL-BNK-CHAPTER-CHNG-DATE. CL*34 01258 DTSCS42 01259 CL*34 01260 MOVE MAP-BNK-LAST-COMM-DATE-AREA TO L015-S-DATE-AREA. CL*34 01261 CL*34 01262 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**2 01263 CL*34 01264 MOVE L015-DATE TO MCOL-BNK-LAST-COMM-DATE. CL*34 01265 CL**2 01266 CL*34 01267 MOVE MAP-BNK-DISCHRG-DATE-AREA TO L015-S-DATE-AREA. CL**2 01268 CL*34 01269 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**2 01270 CL*34 01271 MOVE L015-DATE TO MCOL-BNK-DISCHRG-CLOSE-DATE. CL*34 01272 CL**2 01273 CL*34 01274 MOVE MAP-BNK-DISMISS-DATE-AREA TO L015-S-DATE-AREA. CL*34 01275 CL*34 01276 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 01277 CL*34 01278 MOVE L015-DATE TO MCOL-BNK-DISMISS-DATE. CL*34 01279 DTSCS42 01280 CL*34 01281 MOVE MAP-STMT-TYPE TO MCOL-STMT-TEXT-TYPE. CL*17 01282 CL*34 01283 CL*34 01284 MOVE MAP-STMT-PERMANENT-IND TO MCOL-STMT-TEXT-PERM-IND. CL*17 01285 DTSCS42 01286 CL*34 01287 MOVE +0 TO MCOL-STMT-TEXT-CNT. CL**2 01288 DTSCS42 01289 PERFORM DTSCS42 01290 VARYING WRK-OCC FROM 1 BY 1 CL*34 01291 UNTIL WRK-OCC > MMAX-COL-TEXT-MAX DTSCS42 01292 MOVE MAP-STMT-TEXT(WRK-OCC) CL*34 01293 TO MCOL-STMT-TEXT(WRK-OCC) CL*34 01294 IF MCOL-STMT-TEXT(WRK-OCC) NOT = SPACES CL*34 01295 MOVE WRK-OCC TO MCOL-STMT-TEXT-CNT CL*34 01296 END-IF CL*34 01297 END-PERFORM. DTSCS42 01298 DTSCS42 01299 DTSCS42 01300 SET WRK-NULL-MCOL-NO-88 TO TRUE. DTSCS42 01301 DTSCS42 01302 PERFORM P8220-CHECK-NULL THRU P8220-EXIT. DTSCS42 01303 DTSCS42 01304 CL*34 01305 IF WRK-ACTION-ADD-88 DTSCS42 01306 IF WRK-NULL-MCOL-YES-88 DTSCS42 01307 NEXT SENTENCE DTSCS42 01308 ELSE DTSCS42 01309 MOVE MCOL-REC TO MSKL-REC DTSCS42 01310 PERFORM S810-WRITE THRU S810-EXIT DTSCS42 01311 SET WRK-MCOL-YES-88 TO TRUE DTSCS42 01312 ELSE DTSCS42 01313 IF WRK-NULL-MCOL-YES-88 DTSCS42 01314 MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA DTSCS42 01315 PERFORM S810-DELETE THRU S810-EXIT DTSCS42 01316 SET WRK-MCOL-NO-88 TO TRUE DTSCS42 01317 ELSE DTSCS42 01318 MOVE MCOL-REC TO MSKL-REC DTSCS42 01319 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS42 01320 P8210-EXIT. DTSCS42 01321 EXIT. DTSCS42 01322 DTSCS42 01323 CL*34 01324 CL*34 01325 P8211-INIT-MCOL. DTSCS42 01326 MOVE +0 TO MCOL-PURGE-DATE DTSCS42 01327 DTSCS42 01328 MOVE LOW-VALUES TO MCOL-DATA-AREA. DTSCS42 01329 DTSCS42 01330 SET MCOL-BNK-NOT-BANKRUPT-88 TO TRUE. DTSCS42 01331 DTSCS42 01332 MOVE SPACES TO MCOL-BNK-COURT-CASE-NO. DTSCS42 01333 DTSCS42 01334 MOVE +0 TO MCOL-BNK-CHAPTER-CHNG-DATE CL*34 01335 MCOL-BNK-PETITION-DATE CL*34 01336 MCOL-BNK-DISCHRG-CLOSE-DATE CL*34 01337 MCOL-BNK-DISMISS-DATE CL*34 01338 MCOL-BNK-POC-REQUIRED-DATE CL*34 01339 MCOL-BNK-POC-FILED-DATE CL*34 01340 MCOL-BNK-LAST-COMM-DATE CL*34 01341 MCOL-FINAL-NOTICE-DATE CL*34 01342 MCOL-LEGAL-REFERRAL-DATE CL*34 01343 MCOL-CIVIL-ACTION-BEGIN-DATE CL*34 01344 MCOL-CIVIL-ACTION-JUDGE-DATE. CL*34 01345 DTSCS42 01346 SET MCOL-STMT-TEXT-TYPE-NONE-88 TO TRUE. CL**2 01347 DTSCS42 01348 SET MCOL-STMT-TEXT-PERM-NONE-88 TO TRUE. CL**2 01349 DTSCS42 01350 MOVE SPACE TO MCOL-SUBPOENA-ACTIVITY-CD. DTSCS42 01351 CL*34 01352 MOVE SPACE TO MCOL-SUBPOENA-RESP-OP-ID. CL*34 01353 DTSCS42 01354 MOVE +0 TO MCOL-SUBPOENA-ACTIVITY-DATE. CL*34 01355 DTSCS42 01356 SET MCOL-NOT-CONVERTED-88 TO TRUE. DTSCS42 01357 DTSCS42 01358 MOVE LCCM-CURR-RUN-DATE DTSCS42 01359 TO MCOL-ESTB-DATE DTSCS42 01360 MCOL-CHNG-DATE. DTSCS42 01361 DTSCS42 01362 MOVE +0 TO MCOL-STMT-TEXT-CNT. CL**2 01363 DTSCS42 01364 MOVE SPACES TO MCOL-STMT-TEXT-AREA. CL**2 01365 P8211-EXIT. DTSCS42 01366 EXIT. DTSCS42 01367 DTSCS42 01368 CL*34 01369 CL*34 01370 P8212-UPDATE-MPRF. DTSCS42 01371 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS42 01372 CL*34 01373 CL*40 01374 MOVE SPACES TO L331-REC-OCC-ID. CL*40 01375 CL*40 01376 CL*40 01377 IF MAP-SUSPEND-IND = MPRF-SUSPEND-COLL-IND CL*40 01378 NEXT SENTENCE CL*40 01379 ELSE CL*40 01380 MOVE 'MPRF-SUSPEND-COLL-IND' TO L331-FIELD-NAME CL*40 01381 MOVE MPRF-SUSPEND-COLL-IND TO L331-FROM-VALUE CL*40 01382 MOVE MAP-SUSPEND-IND TO L331-TO-VALUE CL*40 01383 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT CL*40 01384 MOVE MAP-SUSPEND-IND TO MPRF-SUSPEND-COLL-IND CL*40 01385 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. CL*40 01386 CL*40 01387 CL*40 01388 IF (MCOL-BNK-PETITION-DATE > +0 DTSCS42 01389 AND (MCOL-BNK-DISCHRG-CLOSE-DATE = +0 CL*34 01390 AND MCOL-BNK-DISMISS-DATE = +0)) DTSCS42 01391 SET MPRF-BANKRP-OPEN-88 TO TRUE DTSCS42 01392 ELSE DTSCS42 01393 SET MPRF-BANKRP-NOT-OPEN-88 TO TRUE DTSCS42 01394 END-IF. DTSCS42 01395 DTSCS42 01396 MOVE MPRF-REC TO MSKL-REC. DTSCS42 01397 CL*35 01398 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS42 01399 P8212-EXIT. DTSCS42 01400 EXIT. DTSCS42 01401 DTSCS42 01402 CL*35 01403 CL*35 01404 P8213-UPDATE-MTAD. DTSCS42 01405 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS42 01406 CL*35 01407 MOVE LCCM-EMP-NO TO MTAD-EMP-NO. DTSCS42 01408 CL*35 01409 MOVE WRK-OCC TO MTAD-ID-NO. DTSCS42 01410 CL*35 01411 SET MTAD-TAD-88 TO TRUE. DTSCS42 01412 DTSCS42 01413 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS42 01414 DTSCS42 01415 PERFORM S810-READ THRU S810-EXIT. DTSCS42 01416 DTSCS42 01417 IF L810-OK-88 DTSCS42 01418 MOVE MSKL-REC TO MTAD-REC DTSCS42 01419 ELSE CL*11 01420 IF WRK-OCC = 1 CL*11 01421 MOVE LOW-VALUES TO MAP-MAIL-DB-MEMO-IND CL*11 01422 MAP-MAIL-MISS-RPT-IND CL*11 01423 GO TO P8213-EXIT CL*11 01424 ELSE CL*11 01425 MOVE LOW-VALUES TO MAP-PHYS-DB-MEMO-IND CL*11 01426 MAP-PHYS-MISS-RPT-IND CL*11 01427 GO TO P8213-EXIT. CL*11 01428 CL*11 01429 IF WRK-OCC = 1 CL*11 01430 IF (MTAD-UC223-IND NOT = MAP-MAIL-DB-MEMO-IND) CL*11 01431 OR CL*35 01432 (MTAD-MISSING-RPT-LETTERS-IND CL*35 01433 NOT = MAP-MAIL-MISS-RPT-IND) CL*18 01434 PERFORM P8214-MODIFY-MTAD-MAIL THRU P8214-EXIT CL*16 01435 MOVE MTAD-REC TO MSKL-REC DTSCS42 01436 PERFORM S810-REWRITE THRU S810-EXIT DTSCS42 01437 ELSE DTSCS42 01438 NEXT SENTENCE CL*11 01439 ELSE CL*11 01440 IF (MTAD-UC223-IND NOT = MAP-PHYS-DB-MEMO-IND) CL*11 01441 OR CL*35 01442 (MTAD-MISSING-RPT-LETTERS-IND CL*35 01443 NOT = MAP-PHYS-MISS-RPT-IND) CL*18 01444 PERFORM P8215-MODIFY-MTAD-PHYS THRU P8215-EXIT CL*16 01445 MOVE MTAD-REC TO MSKL-REC CL*11 01446 PERFORM S810-REWRITE THRU S810-EXIT. CL*11 01447 P8213-EXIT. DTSCS42 01448 EXIT. DTSCS42 01449 DTSCS42 01450 CL*35 01451 CL*35 01452 P8214-MODIFY-MTAD-MAIL. CL*16 01453 MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID. CL*37 01454 CL*37 01455 IF MAP-MAIL-DB-MEMO-VALID-88 CL*16 01456 IF MAP-MAIL-DB-MEMO-IND = MTAD-UC223-IND CL*16 01457 NEXT SENTENCE DTSCS42 01458 ELSE DTSCS42 01459 MOVE 'MTAD-UC223-IND' TO L331-FIELD-NAME CL**4 01460 MOVE MTAD-UC223-IND TO L331-FROM-VALUE CL**4 01461 MOVE MAP-MAIL-DB-MEMO-IND TO L331-TO-VALUE CL*16 01462 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT CL**9 01463 MOVE MAP-MAIL-DB-MEMO-IND CL*16 01464 TO MTAD-UC223-IND CL**4 01465 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE DTSCS42 01466 ELSE DTSCS42 01467 MOVE MTAD-UC223-IND CL**4 01468 TO MAP-MAIL-DB-MEMO-IND. CL*16 01469 DTSCS42 01470 CL*37 01471 IF MAP-MAIL-MISS-RPT-VALID-88 CL*16 01472 IF MAP-MAIL-MISS-RPT-IND CL*16 01473 = MTAD-MISSING-RPT-LETTERS-IND CL*17 01474 NEXT SENTENCE DTSCS42 01475 ELSE DTSCS42 01476 MOVE 'MTAD-MISSING-RPT-LETTERS-IND' CL*17 01477 TO L331-FIELD-NAME DTSCS42 01478 MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE CL*17 01479 MOVE MAP-MAIL-MISS-RPT-IND TO L331-TO-VALUE CL*16 01480 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT CL**9 01481 MOVE MAP-MAIL-MISS-RPT-IND CL*16 01482 TO MTAD-MISSING-RPT-LETTERS-IND CL*18 01483 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE DTSCS42 01484 ELSE DTSCS42 01485 MOVE MTAD-MISSING-RPT-LETTERS-IND CL*18 01486 TO MAP-MAIL-MISS-RPT-IND. CL*16 01487 P8214-EXIT. DTSCS42 01488 EXIT. DTSCS42 01489 DTSCS42 01490 CL*37 01491 CL*37 01492 P8215-MODIFY-MTAD-PHYS. CL*16 01493 MOVE 'RECORDS ADDRESS' TO L331-REC-OCC-ID. CL*38 01494 CL*38 01495 IF MAP-PHYS-DB-MEMO-VALID-88 CL*16 01496 IF MAP-PHYS-DB-MEMO-IND = MTAD-UC223-IND CL*16 01497 NEXT SENTENCE CL*16 01498 ELSE CL*16 01499 MOVE 'MTAD-UC223-IND' TO L331-FIELD-NAME CL*16 01500 MOVE MTAD-UC223-IND TO L331-FROM-VALUE CL*16 01501 MOVE MAP-PHYS-DB-MEMO-IND TO L331-TO-VALUE CL*16 01502 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT CL*16 01503 MOVE MAP-PHYS-DB-MEMO-IND CL*16 01504 TO MTAD-UC223-IND CL*16 01505 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE CL*16 01506 ELSE CL*16 01507 MOVE MTAD-UC223-IND CL*16 01508 TO MAP-PHYS-DB-MEMO-IND. CL*16 01509 CL*16 01510 IF MAP-PHYS-MISS-RPT-VALID-88 CL*16 01511 IF MAP-PHYS-MISS-RPT-IND CL*16 01512 = MTAD-MISSING-RPT-LETTERS-IND CL*17 01513 NEXT SENTENCE CL*16 01514 ELSE CL*16 01515 MOVE 'MTAD-MISSING-RPT-LETTERS-IND' CL*17 01516 TO L331-FIELD-NAME CL*16 01517 MOVE MTAD-MISSING-RPT-LETTERS-IND TO L331-FROM-VALUE CL*17 01518 MOVE MAP-PHYS-MISS-RPT-IND TO L331-TO-VALUE CL*16 01519 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT CL*16 01520 MOVE MAP-PHYS-MISS-RPT-IND CL*16 01521 TO MTAD-MISSING-RPT-LETTERS-IND CL*17 01522 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE CL*16 01523 ELSE CL*16 01524 MOVE MTAD-MISSING-RPT-LETTERS-IND CL*17 01525 TO MAP-PHYS-MISS-RPT-IND. CL*16 01526 P8215-EXIT. CL*16 01527 EXIT. CL*16 01528 CL*16 01529 CL*38 01530 DTSCS42 01531 P8220-CHECK-NULL. DTSCS42 01532 IF MCOL-BNK-NOT-BANKRUPT-88 DTSCS42 01533 AND MCOL-BNK-COURT-CASE-NO = SPACES DTSCS42 01534 AND MCOL-BNK-PETITION-DATE = +0 DTSCS42 01535 AND MCOL-BNK-DISCHRG-CLOSE-DATE = +0 DTSCS42 01536 AND MCOL-BNK-DISMISS-DATE = +0 DTSCS42 01537 AND MCOL-BNK-POC-REQUIRED-DATE = +0 DTSCS42 01538 AND MCOL-BNK-POC-FILED-DATE = +0 DTSCS42 01539 AND MCOL-BNK-LAST-COMM-DATE = +0 DTSCS42 01540 AND MCOL-BNK-CHAPTER-CHNG-DATE = +0 DTSCS42 01541 AND MCOL-FINAL-NOTICE-DATE = +0 DTSCS42 01542 AND MCOL-SUBPOENA-ACTIVITY-CD = SPACES DTSCS42 01543 AND MCOL-SUBPOENA-RESP-OP-ID = SPACES CL*38 01544 AND MCOL-SUBPOENA-ACTIVITY-DATE = +0 DTSCS42 01545 AND MCOL-LEGAL-REFERRAL-DATE = +0 CL**2 01546 AND MCOL-CIVIL-ACTION-BEGIN-DATE = +0 DTSCS42 01547 AND MCOL-CIVIL-ACTION-JUDGE-DATE = +0 DTSCS42 01548 AND MCOL-STMT-TEXT-TYPE-NONE-88 CL**2 01549 AND MCOL-STMT-TEXT-PERM-NONE-88 CL**2 01550 AND MCOL-STMT-TEXT-CNT = +0 CL**2 01551 SET WRK-NULL-MCOL-YES-88 TO TRUE. DTSCS42 01552 P8220-EXIT. CL*38 01553 EXIT. CL*38 01554 CL*38 01555 CL*38 01556 DTSCS42 01557 *P8230-CREATE-MTCK. CL*25 01558 *****PERFORM P8233-MTCK-COMMON THRU P8233-EXIT. CL*38 01559 CL*38 01560 *****SET MTCK-TYPE-PRF-CLM-88 TO TRUE. CL*38 01561 CL*38 01562 *****MOVE L015-DATE TO L001-FED-8-DATE-9. CL*38 01563 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL*38 01564 *****SUBTRACT 10 FROM L001-JUL-ABS-DAY. CL*38 01565 *****PERFORM S001-FROM-ABS-DATE THRU S001-EXIT. CL*38 01566 *****IF L001-FED-8-DATE-9 NOT > LCCM-CURR-RUN-DATE CL*38 01567 *********GO TO P8230-EXIT. CL*38 01568 *****MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE. CL*38 01569 CL*38 01570 *****SET MTCK-SOURCE-SYSTEM-88 TO TRUE. CL*38 01571 CL*38 01572 *****SET MTCK-DEST-SYSTEM-88 TO TRUE. CL*38 01573 CL*38 01574 *****MOVE MTCK-REC TO MSKL-REC. CL*38 01575 *****PERFORM S810-WRITE THRU S810-EXIT. CL*38 01576 *P8230-EXIT. EXIT. CL*25 01577 CL*38 01578 CL*38 01579 CL*38 01580 *P8233-MTCK-COMMON. CL*25 01581 *****MOVE LOW-VALUES TO MTCK-REC. CL*38 01582 CL*38 01583 *****MOVE MCOL-EMP-NO TO MTCK-EMP-NO. CL*38 01584 CL*38 01585 *****SET MTCK-TCK-88 TO TRUE. CL*38 01586 CL*38 01587 *****ADD +1 TO LCCM-TASK-START-ABSTIME. CL*38 01588 *****MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME. CL*38 01589 CL*38 01590 *****MOVE +0 TO MTCK-PURGE-DATE. CL*38 01591 CL*38 01592 *****MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. CL*38 01593 CL*38 01594 *****SET MTCK-NOT-CONVERTED-88 TO TRUE. CL*38 01595 CL*38 01596 *****MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE CL*38 01597 ********************************MTCK-CHNG-DATE. CL*38 01598 CL*38 01599 *****MOVE +0 TO MTCK-TEXT-CNT. CL*38 01600 *P8233-EXIT. EXIT. CL*25 01601 DTSCS42 01602 CL*38 01603 CL*38 01604 P8240-CREATE-MEVL. CL*26 01605 MOVE LOW-VALUES TO MEVL-REC. CL*38 01606 CL*38 01607 MOVE WRK-EMP-NO TO MEVL-EMP-NO. CL*38 01608 CL*38 01609 SET MEVL-EVL-88 TO TRUE. CL*38 01610 CL*38 01611 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. CL*38 01612 CL*38 01613 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. CL*38 01614 CL*38 01615 MOVE WRK-MEVL-TEXT TO MEVL-TEXT. CL*38 01616 CL*38 01617 MOVE LCCM-OP-ID TO MEVL-SOURCE. CL*38 01618 CL*38 01619 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL*38 01620 CL*38 01621 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL*38 01622 MEVL-CHNG-DATE. CL*38 01623 CL*38 01624 MOVE MEVL-REC TO MSKL-REC. CL*38 01625 CL*38 01626 PERFORM S810-WRITE THRU S810-EXIT. CL*38 01627 P8240-EXIT. CL*38 01628 EXIT. CL*38 01629 CL*38 01630 CL*38 01631 CL*26 01632 P8810-LOCK-EMPLOYER. DTSCS42 01633 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS42 01634 CL*38 01635 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS42 01636 CL*38 01637 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS42 01638 CL*38 01639 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS42 01640 CL*38 01641 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS42 01642 CL*38 01643 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. CL**2 01644 CL*38 01645 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS42 01646 CL*38 01647 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS42 01648 CL*38 01649 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS42 01650 DTSCS42 01651 CL*38 01652 PERFORM S221-EMP-LOCK THRU S221-EXIT. CL*38 01653 P8810-EXIT. DTSCS42 01654 EXIT. DTSCS42 01655 /*****************************************************************DTSCS42 01656 * LINKS TO UTILITY MODULES DTSCS42 01657 ******************************************************************DTSCS42 01658 DTSCS42 01659 S001-FROM-FED-8. DTSCS42 01660 SET L001-FROM-FED-8 TO TRUE. DTSCS42 01661 GO TO S001-DATE. DTSCS42 01662 DTSCS42 01663 S001-FROM-ABS-DATE. DTSCS42 01664 SET L001-FROM-ABS-DAY TO TRUE. DTSCS42 01665 GO TO S001-DATE. DTSCS42 01666 DTSCS42 01667 S001-DATE. DTSCS42 01668 EXEC CICS LINK DTSCS42 01669 PROGRAM('DTSCU001') CL**2 01670 COMMAREA(L001-COMM-AREA) DTSCS42 01671 END-EXEC. DTSCS42 01672 S001-EXIT. DTSCS42 01673 EXIT. DTSCS42 01674 DTSCS42 01675 CL*40 01676 CL*40 01677 S015-DATE-FROM-SCREEN. DTSCS42 01678 EXEC CICS LINK DTSCS42 01679 PROGRAM('DTSCU015') CL**2 01680 COMMAREA(L015-COMM-AREA) DTSCS42 01681 END-EXEC. DTSCS42 01682 S015-EXIT. DTSCS42 01683 EXIT. DTSCS42 01684 DTSCS42 01685 CL*40 01686 CL*40 01687 S018-EMP-NO-FROM-SCREEN. DTSCS42 01688 EXEC CICS LINK DTSCS42 01689 PROGRAM('DTSCU018') CL**2 01690 COMMAREA(L018-COMM-AREA) DTSCS42 01691 END-EXEC. DTSCS42 01692 S018-EXIT. DTSCS42 01693 EXIT. DTSCS42 01694 DTSCS42 01695 CL*40 01696 CL*40 01697 S031-MPRF-EMP-CLASS. DTSCS42 01698 SET L031-MPRF-EMP-CLASS TO TRUE. CL*40 01699 GO TO S031-LINK. DTSCS42 01700 DTSCS42 01701 S031-MPRF-EMP-STATUS. DTSCS42 01702 SET L031-MPRF-EMP-STATUS TO TRUE. CL*40 01703 GO TO S031-LINK. DTSCS42 01704 DTSCS42 01705 S031-LINK. DTSCS42 01706 EXEC CICS LINK DTSCS42 01707 PROGRAM ('DTSCU031') CL**2 01708 COMMAREA (L031-COMM-AREA) DTSCS42 01709 END-EXEC. DTSCS42 01710 S031-EXIT. DTSCS42 01711 EXIT. DTSCS42 01712 DTSCS42 01713 CL*40 01714 CL*40 01715 S034-MCOL-SUBPOENA-CD. DTSCS42 01716 SET L034-MCOL-SUBPOENA-CD TO TRUE. CL*40 01717 GO TO S034-LINK. DTSCS42 01718 DTSCS42 01719 S034-MCOL-BNK-CHAPTER. DTSCS42 01720 SET L034-MCOL-BNK-CHAPTER TO TRUE. CL*40 01721 GO TO S034-LINK. DTSCS42 01722 DTSCS42 01723 S034-LINK. DTSCS42 01724 EXEC CICS LINK DTSCS42 01725 PROGRAM ('DTSCU034') CL**2 01726 COMMAREA (L034-COMM-AREA) DTSCS42 01727 END-EXEC. DTSCS42 01728 S034-EXIT. DTSCS42 01729 EXIT. DTSCS42 01730 DTSCS42 01731 CL*40 01732 CL*40 01733 S061-FLD-ZIP. CL*10 01734 EXEC CICS LINK DTSCS42 01735 PROGRAM('DTSCU061') CL**2 01736 COMMAREA(L061-COMM-AREA) DTSCS42 01737 END-EXEC. DTSCS42 01738 DTSCS42 01739 IF L061-FILE-CLOSED DTSCS42 01740 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS42 01741 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS42 01742 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS42 01743 GO TO MAINLINE-EXIT. DTSCS42 01744 S061-EXIT. DTSCS42 01745 EXIT. DTSCS42 01746 DTSCS42 01747 CL*40 01748 CL*40 01749 S062-FLD-REP-ID-DESC. DTSCS42 01750 EXEC CICS LINK DTSCS42 01751 PROGRAM('DTSCU062') CL**2 01752 COMMAREA(L062-COMM-AREA) DTSCS42 01753 END-EXEC. DTSCS42 01754 DTSCS42 01755 IF L062-FILE-CLOSED DTSCS42 01756 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS42 01757 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS42 01758 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS42 01759 GO TO MAINLINE-EXIT. DTSCS42 01760 S062-EXIT. DTSCS42 01761 EXIT. DTSCS42 01762 DTSCS42 01763 CL*40 01764 CL*40 01765 S082-OP-ID-LOOKUP. CL**9 01766 EXEC CICS LINK CL**9 01767 PROGRAM('DTSCU082') CL**9 01768 COMMAREA(L082-COMM-AREA) CL**9 01769 END-EXEC. CL**9 01770 CL**9 01771 IF L082-FILE-CLOSED CL**9 01772 MOVE L082-MSG-AREA TO LCCM-MSG-AREA CL**9 01773 SET LCCM-REQ-SCR-SF-88 TO TRUE CL**9 01774 SET LCCM-LINK-SCREEN-88 TO TRUE CL**9 01775 GO TO MAINLINE-EXIT. CL**9 01776 S082-EXIT. CL**9 01777 EXIT. CL**9 01778 CL**9 01779 CL*40 01780 CL*40 01781 S221-EMP-LOCK. DTSCS42 01782 SET L221-START-UPDATE TO TRUE. DTSCS42 01783 GO TO S221-EMP-LOCK-UNLOCK. DTSCS42 01784 DTSCS42 01785 S221-EMP-UNLOCK. DTSCS42 01786 SET L221-END-UPDATE TO TRUE. DTSCS42 01787 GO TO S221-EMP-LOCK-UNLOCK. DTSCS42 01788 DTSCS42 01789 S221-EMP-LOCK-UNLOCK. DTSCS42 01790 EXEC CICS LINK DTSCS42 01791 PROGRAM('DTSCU221') CL**2 01792 COMMAREA(L221-COMM-AREA) DTSCS42 01793 END-EXEC. DTSCS42 01794 DTSCS42 01795 IF L221-FILE-CLOSED DTSCS42 01796 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS42 01797 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS42 01798 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS42 01799 GO TO MAINLINE-EXIT. DTSCS42 01800 DTSCS42 01801 IF L221-NOT-OK DTSCS42 01802 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS42 01803 S221-EXIT. DTSCS42 01804 EXIT. DTSCS42 01805 DTSCS42 01806 CL*40 01807 CL*40 01808 S331-EMP-WRITE-MLOG. CL**9 01809 EXEC CICS LINK DTSCS42 01810 PROGRAM('DTSCU331') CL**2 01811 COMMAREA(L331-COMM-AREA) DTSCS42 01812 END-EXEC. DTSCS42 01813 DTSCS42 01814 IF L331-FILE-CLOSED DTSCS42 01815 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS42 01816 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS42 01817 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS42 01818 GO TO MAINLINE-EXIT. DTSCS42 01819 S331-EXIT. DTSCS42 01820 EXIT. DTSCS42 01821 DTSCS42 01822 CL*40 01823 CL*40 01824 S803-REQ-SCR-ID-EDIT. DTSCS42 01825 EXEC CICS LINK DTSCS42 01826 PROGRAM ('DTSCU803') CL**2 01827 COMMAREA (DFHCOMMAREA) DTSCS42 01828 END-EXEC. DTSCS42 01829 S803-EXIT. DTSCS42 01830 EXIT. DTSCS42 01831 DTSCS42 01832 CL*40 01833 CL*40 01834 S804-INVALID-KEY. DTSCS42 01835 EXEC CICS LINK DTSCS42 01836 PROGRAM ('DTSCU804') CL**2 01837 COMMAREA (DFHCOMMAREA) DTSCS42 01838 END-EXEC. DTSCS42 01839 S804-EXIT. DTSCS42 01840 EXIT. DTSCS42 01841 DTSCS42 01842 CL*40 01843 CL*40 01844 S805-MSG-AREA. DTSCS42 01845 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS42 01846 DTSCS42 01847 EXEC CICS LINK DTSCS42 01848 PROGRAM ('DTSCU805') CL**2 01849 COMMAREA (L805-COMM-AREA) DTSCS42 01850 END-EXEC. DTSCS42 01851 DTSCS42 01852 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS42 01853 S805-EXIT. DTSCS42 01854 EXIT. DTSCS42 01855 CL*40 01856 CL*40 01857 CL*40 01858 S810-READ. DTSCS42 01859 SET L810-READ-88 TO TRUE. DTSCS42 01860 GO TO S810-IO. DTSCS42 01861 DTSCS42 01862 S810-START-BROWSE. DTSCS42 01863 SET L810-START-BROWSE-88 TO TRUE. DTSCS42 01864 GO TO S810-IO. DTSCS42 01865 DTSCS42 01866 S810-READ-NEXT. DTSCS42 01867 SET L810-READ-NEXT-88 TO TRUE. DTSCS42 01868 GO TO S810-IO. DTSCS42 01869 DTSCS42 01870 S810-READ-PREV. DTSCS42 01871 SET L810-READ-PREV-88 TO TRUE. DTSCS42 01872 GO TO S810-IO. DTSCS42 01873 DTSCS42 01874 S810-END-BROWSE. DTSCS42 01875 SET L810-END-BROWSE-88 TO TRUE. DTSCS42 01876 GO TO S810-IO. DTSCS42 01877 DTSCS42 01878 S810-COUNT. DTSCS42 01879 SET L810-COUNT-88 TO TRUE. DTSCS42 01880 GO TO S810-IO. DTSCS42 01881 DTSCS42 01882 S810-REWRITE. DTSCS42 01883 SET L810-REWRITE-88 TO TRUE. DTSCS42 01884 GO TO S810-IO. DTSCS42 01885 DTSCS42 01886 S810-WRITE. DTSCS42 01887 SET L810-WRITE-88 TO TRUE. DTSCS42 01888 GO TO S810-IO. DTSCS42 01889 DTSCS42 01890 S810-DELETE. DTSCS42 01891 SET L810-DELETE-88 TO TRUE. DTSCS42 01892 GO TO S810-IO. DTSCS42 01893 DTSCS42 01894 S810-IO. DTSCS42 01895 EXEC CICS LINK DTSCS42 01896 PROGRAM ('DTSCU810') CL**2 01897 COMMAREA (L810-COMM-AREA) DTSCS42 01898 END-EXEC. DTSCS42 01899 DTSCS42 01900 IF L810-FILE-CLOSED-88 DTSCS42 01901 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS42 01902 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS42 01903 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS42 01904 GO TO MAINLINE-EXIT. DTSCS42 01905 S810-EXIT. DTSCS42 01906 EXIT. DTSCS42 01907 CL*40 01908 CL*40 01909 CL*40 01910 S851-SCREEN-PROCESSING. DTSCS42 01911 EXEC CICS LINK DTSCS42 01912 PROGRAM ('DTSCU851') CL**2 01913 COMMAREA (L851-COMM-AREA) DTSCS42 01914 END-EXEC. DTSCS42 01915 S851-EXIT. DTSCS42 01916 EXIT. DTSCS42 01917 DTSCS42 01918 CL*40 01919 CL*40 01920 S899-ABEND. DTSCS42 01921 EXEC CICS ABEND DTSCS42 01922 ABCODE(WRK-ABEND-CD) DTSCS42 01923 END-EXEC. DTSCS42 01924 S899-EXIT. DTSCS42 01925 EXIT. DTSCS42 01926 /*****************************************************************DTSCS42 01927 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS42 01928 ******************************************************************DTSCS42 01929 DTSCS42 01930 S1000-SCREEN-EDITS. DTSCS42 01931 MOVE +0 TO WRK-START-DATE. DTSCS42 01932 CL*40 01933 MOVE ALL-NINES-DATE TO WRK-END-DATE. DTSCS42 01934 DTSCS42 01935 CL*40 01936 PERFORM S1300-MTAD-EDITS THRU S1300-EXIT CL*40 01937 VARYING WRK-OCC FROM 1 BY 1 CL*40 01938 UNTIL WRK-OCC > 2. CL*40 01939 CL*40 01940 PERFORM S1500-SUSPEND THRU S1500-EXIT. CL*40 01941 CL*40 01942 PERFORM S1600-FINAL-NOTICE-DATE THRU S1600-EXIT. CL*40 01943 CL*40 01944 PERFORM S1700-SUBPOENA-CD THRU S1700-EXIT. CL*40 01945 CL*40 01946 PERFORM S1800-LEGAL-REFERRAL-DATE THRU S1800-EXIT. CL*40 01947 CL*40 01948 PERFORM S1900-CIVIL-ACTION-BEGIN-DATE THRU S1900-EXIT. CL*40 01949 CL*40 01950 PERFORM S2000-SUBPOENA-OPID THRU S2000-EXIT. CL*40 01951 CL*40 01952 PERFORM S2100-CIVIL-ACTION-JUDGE-DATE THRU S2100-EXIT. CL*40 01953 DTSCS42 01954 PERFORM S2300-BNK-PETITION-DATE THRU S2300-EXIT. CL*40 01955 CL*40 01956 PERFORM S2400-BNK-COURT-CASE-NO THRU S2400-EXIT. CL*40 01957 CL*40 01958 PERFORM S2500-BNK-CHAPTER THRU S2500-EXIT. CL*40 01959 CL*40 01960 PERFORM S2600-BNK-POC-REQUIRED-DATE THRU S2600-EXIT. CL*40 01961 CL*40 01962 PERFORM S2700-BNK-POC-FILED-DATE THRU S2700-EXIT. CL*40 01963 CL*40 01964 PERFORM S2800-BNK-CHAPTER-CHNG-DATE THRU S2800-EXIT. CL*40 01965 CL*40 01966 PERFORM S2900-BNK-LAST-COMM-DATE THRU S2900-EXIT. CL*40 01967 CL*40 01968 PERFORM S3000-BNK-DISCHRG-CLOSE-DATE THRU S3000-EXIT. CL*40 01969 CL*40 01970 PERFORM S3100-BNK-DISMISS-DATE THRU S3100-EXIT. CL*40 01971 DTSCS42 01972 PERFORM S3200-STMT-TEXT THRU S3200-EXIT. CL*40 01973 CL*40 01974 PERFORM S3300-STMT-TYPE THRU S3300-EXIT. CL*40 01975 CL*40 01976 PERFORM S3400-STMT-PERMANENT-IND THRU S3400-EXIT. CL*40 01977 DTSCS42 01978 *****IF LCCM-MSG DTSCS42 01979 ********GO TO S1000-EXIT. CL*40 01980 CL*40 01981 *****PERFORM S3500-MISC-EDITS THRU S3500-EXIT. DTSCS42 01982 S1000-EXIT. CL*40 01983 EXIT. CL*40 01984 EJECT DTSCS42 01985 /*****************************************************************DTSCS42 01986 * DTSCS42 01987 ******************************************************************DTSCS42 01988 CL*40 01989 S1100-EDIT-KEY. DTSCS42 01990 PERFORM S1101-EMP-NO THRU S1101-EXIT. CL*40 01991 S1100-EXIT. CL*40 01992 EXIT. CL*40 01993 /*****************************************************************DTSCS42 01994 * DTSCS42 01995 ******************************************************************DTSCS42 01996 CL*40 01997 S1101-EMP-NO. DTSCS42 01998 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. CL*40 01999 CL*40 02000 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS42 02001 DTSCS42 02002 IF L018-NO-ENTRY DTSCS42 02003 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA CL*40 02004 PERFORM S1199-ERROR THRU S1199-EXIT CL*40 02005 GO TO S1101-EXIT. DTSCS42 02006 DTSCS42 02007 IF L018-NOT-VALID DTSCS42 02008 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*40 02009 PERFORM S1199-ERROR THRU S1199-EXIT CL*40 02010 GO TO S1101-EXIT. DTSCS42 02011 DTSCS42 02012 MOVE L018-EMP-NO TO WRK-EMP-NO. CL*40 02013 S1101-EXIT. CL*40 02014 EXIT. CL*40 02015 /*****************************************************************DTSCS42 02016 * DTSCS42 02017 ******************************************************************DTSCS42 02018 CL*40 02019 S1110-READ-MCOL. DTSCS42 02020 MOVE LOW-VALUES TO MCOL-KEY-AREA. CL*40 02021 CL*40 02022 MOVE WRK-EMP-NO TO MCOL-EMP-NO. CL*40 02023 CL*40 02024 SET MCOL-COL-88 TO TRUE. CL*40 02025 DTSCS42 02026 MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA. CL*40 02027 DTSCS42 02028 PERFORM S810-READ THRU S810-EXIT. CL*40 02029 DTSCS42 02030 IF L810-NO-REC-88 DTSCS42 02031 NEXT SENTENCE DTSCS42 02032 ELSE DTSCS42 02033 SET WRK-MCOL-YES-88 TO TRUE DTSCS42 02034 MOVE MSKL-REC TO MCOL-REC. CL*40 02035 S1110-EXIT. DTSCS42 02036 EXIT. DTSCS42 02037 /*****************************************************************DTSCS42 02038 * DTSCS42 02039 ******************************************************************DTSCS42 02040 CL*40 02041 S1130-READ-MPRF. DTSCS42 02042 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*40 02043 CL*40 02044 MOVE WRK-EMP-NO TO MPRF-EMP-NO. CL*40 02045 CL*40 02046 SET MPRF-PRF-88 TO TRUE. CL*40 02047 DTSCS42 02048 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*40 02049 DTSCS42 02050 PERFORM S810-READ THRU S810-EXIT. CL*40 02051 DTSCS42 02052 IF L810-NO-REC-88 DTSCS42 02053 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS42 02054 PERFORM S1199-ERROR THRU S1199-EXIT CL*40 02055 ELSE DTSCS42 02056 MOVE MSKL-REC TO MPRF-REC DTSCS42 02057 SET WRK-MPRF-YES-88 TO TRUE. CL*40 02058 S1130-EXIT. DTSCS42 02059 EXIT. DTSCS42 02060 DTSCS42 02061 CL*40 02062 CL*40 02063 S1199-ERROR. DTSCS42 02064 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS42 02065 MAP-EMP-NO-2-A. DTSCS42 02066 IF LCCM-NO-MSG DTSCS42 02067 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*40 02068 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L CL*40 02069 SET CURSOR-SET-YES TO TRUE. DTSCS42 02070 S1199-EXIT. CL*40 02071 EXIT. CL*40 02072 /*****************************************************************DTSCS42 02073 * DTSCS42 02074 ******************************************************************DTSCS42 02075 CL*40 02076 S1300-MTAD-EDITS. DTSCS42 02077 IF MAP-MAIL-DB-MEMO-IND = LOW-VALUES CL*12 02078 MOVE SPACES TO MAP-MAIL-DB-MEMO-IND. CL*12 02079 DTSCS42 02080 IF MAP-PHYS-DB-MEMO-IND = LOW-VALUES CL*12 02081 MOVE SPACES TO MAP-PHYS-DB-MEMO-IND. CL*12 02082 CL*12 02083 IF MAP-MAIL-MISS-RPT-IND = LOW-VALUES CL*12 02084 MOVE SPACES TO MAP-MAIL-MISS-RPT-IND. CL*12 02085 DTSCS42 02086 IF MAP-PHYS-MISS-RPT-IND = LOW-VALUES CL*12 02087 MOVE SPACES TO MAP-PHYS-MISS-RPT-IND. CL*12 02088 CL*12 02089 CL*41 02090 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS42 02091 CL*41 02092 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS42 02093 CL*41 02094 SET MTAD-TAD-88 TO TRUE. DTSCS42 02095 CL*41 02096 MOVE WRK-OCC TO MTAD-ID-NO. DTSCS42 02097 CL*41 02098 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS42 02099 CL*41 02100 PERFORM S810-READ THRU S810-EXIT. DTSCS42 02101 DTSCS42 02102 IF L810-NO-REC-88 DTSCS42 02103 PERFORM S1310-NO-MTAD-EXISTS THRU S1310-EXIT DTSCS42 02104 ELSE DTSCS42 02105 MOVE MSKL-REC TO MTAD-REC DTSCS42 02106 PERFORM S1320-MTAD-EXISTS THRU S1320-EXIT. DTSCS42 02107 S1300-EXIT. CL*41 02108 EXIT. CL*41 02109 CL*41 02110 CL*41 02111 CL*41 02112 S1310-NO-MTAD-EXISTS. DTSCS42 02113 IF WRK-OCC = +1 CL*12 02114 PERFORM S1311-NO-MAIL-EXISTS THRU S1311-EXIT CL*12 02115 ELSE CL*12 02116 PERFORM S1312-NO-PHYS-EXISTS THRU S1312-EXIT. CL*12 02117 S1310-EXIT. CL*12 02118 EXIT. CL*12 02119 CL*12 02120 CL*41 02121 CL*41 02122 S1311-NO-MAIL-EXISTS. CL*12 02123 IF MAP-MAIL-DB-MEMO-NO-MTAD-88 CL*12 02124 NEXT SENTENCE DTSCS42 02125 ELSE DTSCS42 02126 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS42 02127 PERFORM S1396-ERROR THRU S1396-EXIT. CL*13 02128 DTSCS42 02129 IF MAP-MAIL-MISS-RPT-NO-MTAD-88 CL*12 02130 NEXT SENTENCE CL*12 02131 ELSE CL*12 02132 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*12 02133 PERFORM S1397-ERROR THRU S1397-EXIT. CL*13 02134 S1311-EXIT. CL*12 02135 EXIT. CL*12 02136 CL*12 02137 CL*41 02138 CL*41 02139 S1312-NO-PHYS-EXISTS. CL*12 02140 IF MAP-PHYS-DB-MEMO-NO-MTAD-88 CL*12 02141 NEXT SENTENCE CL*12 02142 ELSE CL*12 02143 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*12 02144 PERFORM S1398-ERROR THRU S1398-EXIT. CL*12 02145 CL*12 02146 IF MAP-PHYS-MISS-RPT-NO-MTAD-88 CL*13 02147 NEXT SENTENCE DTSCS42 02148 ELSE DTSCS42 02149 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS42 02150 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS42 02151 S1312-EXIT. CL*12 02152 EXIT. DTSCS42 02153 DTSCS42 02154 CL*41 02155 CL*41 02156 S1320-MTAD-EXISTS. DTSCS42 02157 IF WRK-OCC = +1 CL*13 02158 PERFORM S1321-MAIL-EXISTS THRU S1321-EXIT CL*13 02159 ELSE CL*13 02160 PERFORM S1322-PHYS-EXISTS THRU S1322-EXIT. CL*13 02161 S1320-EXIT. CL*13 02162 EXIT. CL*13 02163 CL*13 02164 CL*41 02165 CL*41 02166 S1321-MAIL-EXISTS. CL*13 02167 IF MAP-MAIL-DB-MEMO-NO-MTAD-88 CL*13 02168 MOVE 'Y' TO MAP-MAIL-DB-MEMO-IND CL*13 02169 ELSE DTSCS42 02170 IF MAP-MAIL-DB-MEMO-VALID-88 CL*13 02171 NEXT SENTENCE DTSCS42 02172 ELSE DTSCS42 02173 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS42 02174 PERFORM S1396-ERROR THRU S1396-EXIT. CL*13 02175 DTSCS42 02176 IF MAP-MAIL-MISS-RPT-NO-MTAD-88 CL*20 02177 MOVE 'Y' TO MAP-MAIL-MISS-RPT-IND CL*13 02178 ELSE DTSCS42 02179 IF MAP-MAIL-MISS-RPT-VALID-88 CL*13 02180 NEXT SENTENCE CL*13 02181 ELSE CL*13 02182 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*13 02183 PERFORM S1397-ERROR THRU S1397-EXIT. CL*13 02184 S1321-EXIT. CL*13 02185 EXIT. DTSCS42 02186 DTSCS42 02187 CL*41 02188 CL*41 02189 S1322-PHYS-EXISTS. CL*13 02190 IF MAP-PHYS-DB-MEMO-NO-MTAD-88 CL*13 02191 MOVE 'N' TO MAP-PHYS-DB-MEMO-IND CL*13 02192 ELSE CL*13 02193 IF MAP-PHYS-DB-MEMO-VALID-88 CL*13 02194 NEXT SENTENCE CL*13 02195 ELSE CL*13 02196 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*13 02197 PERFORM S1398-ERROR THRU S1398-EXIT. CL*13 02198 CL*13 02199 IF MAP-PHYS-MISS-RPT-NO-MTAD-88 CL*20 02200 MOVE 'N' TO MAP-PHYS-MISS-RPT-IND CL*13 02201 ELSE CL*13 02202 IF MAP-PHYS-MISS-RPT-VALID-88 CL*13 02203 NEXT SENTENCE CL*13 02204 ELSE CL*13 02205 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*13 02206 PERFORM S1399-ERROR THRU S1399-EXIT. CL*13 02207 S1322-EXIT. CL*13 02208 EXIT. CL*13 02209 CL*13 02210 CL*41 02211 CL*41 02212 S1396-ERROR. CL*13 02213 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS42 02214 TO MAP-MAIL-DB-MEMO-IND-A. CL*13 02215 CL*41 02216 IF LCCM-NO-MSG DTSCS42 02217 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02218 MOVE CATB-CURSOR TO MAP-MAIL-DB-MEMO-IND-L CL*41 02219 SET CURSOR-SET-YES TO TRUE. DTSCS42 02220 S1396-EXIT. CL*41 02221 EXIT. CL*41 02222 DTSCS42 02223 CL*41 02224 CL*41 02225 S1397-ERROR. CL*13 02226 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS42 02227 TO MAP-MAIL-MISS-RPT-IND-A. CL*13 02228 CL*41 02229 IF LCCM-NO-MSG DTSCS42 02230 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02231 MOVE CATB-CURSOR DTSCS42 02232 TO MAP-MAIL-MISS-RPT-IND-L CL*13 02233 SET CURSOR-SET-YES TO TRUE. DTSCS42 02234 S1397-EXIT. CL*41 02235 EXIT. CL*41 02236 CL*41 02237 CL*41 02238 CL*13 02239 S1398-ERROR. CL*13 02240 MOVE CATB-UNPROT-NORM-AN-MDTON CL*13 02241 TO MAP-PHYS-DB-MEMO-IND-A. CL*13 02242 CL*41 02243 IF LCCM-NO-MSG CL*13 02244 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02245 MOVE CATB-CURSOR TO MAP-PHYS-DB-MEMO-IND-L CL*41 02246 SET CURSOR-SET-YES TO TRUE. CL*13 02247 S1398-EXIT. CL*41 02248 EXIT. CL*41 02249 CL*13 02250 CL*41 02251 CL*41 02252 S1399-ERROR. CL*13 02253 MOVE CATB-UNPROT-NORM-AN-MDTON CL*13 02254 TO MAP-PHYS-MISS-RPT-IND-A. CL*13 02255 CL*41 02256 IF LCCM-NO-MSG CL*13 02257 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02258 MOVE CATB-CURSOR CL*13 02259 TO MAP-PHYS-MISS-RPT-IND-L CL*13 02260 SET CURSOR-SET-YES TO TRUE. CL*13 02261 S1399-EXIT. CL*41 02262 EXIT. CL*41 02263 /*****************************************************************DTSCS42 02264 * DTSCS42 02265 ******************************************************************DTSCS42 02266 CL*41 02267 S1500-SUSPEND. CL**5 02268 IF MAP-SUSPEND-IND = LOW-VALUES OR SPACES CL**5 02269 MOVE 'N' TO MAP-SUSPEND-IND CL**6 02270 GO TO S1500-EXIT CL**5 02271 END-IF. CL**5 02272 CL**5 02273 IF NOT MAP-SUSPEND-VALID-88 CL*20 02274 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*41 02275 PERFORM S1501-ERROR THRU S1501-EXIT. CL*41 02276 S1500-EXIT. CL*41 02277 EXIT. CL*41 02278 CL**5 02279 CL*41 02280 CL*41 02281 S1501-ERROR. CL**5 02282 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SUSPEND-IND-A. CL*18 02283 CL*41 02284 IF LCCM-NO-MSG CL**5 02285 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02286 MOVE CATB-CURSOR TO MAP-SUSPEND-IND-L CL*41 02287 SET CURSOR-SET-YES TO TRUE. CL**5 02288 S1501-EXIT. CL*41 02289 EXIT. CL*41 02290 /*****************************************************************DTSCS42 02291 * DTSCS42 02292 ******************************************************************DTSCS42 02293 CL**6 02294 S1600-FINAL-NOTICE-DATE. CL**6 02295 MOVE MAP-FINAL-NOTICE-DATE TO L015-S-DATE-AREA. CL**6 02296 CL*41 02297 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**6 02298 CL**6 02299 CL**6 02300 IF L015-NO-ENTRY CL**6 02301 GO TO S1600-EXIT CL**6 02302 END-IF. CL**6 02303 CL**6 02304 IF L015-NOT-VALID CL**6 02305 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*41 02306 PERFORM S1601-ERROR THRU S1601-EXIT. CL*41 02307 S1600-EXIT. CL*41 02308 EXIT. CL*41 02309 CL*41 02310 CL*41 02311 CL*41 02312 S1601-ERROR. CL**6 02313 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FINAL-NOTICE-MO-A CL**6 02314 MAP-FINAL-NOTICE-DA-A CL**6 02315 MAP-FINAL-NOTICE-YR-A. CL**6 02316 CL*41 02317 IF LCCM-NO-MSG CL**6 02318 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02319 MOVE CATB-CURSOR TO MAP-FINAL-NOTICE-MO-L CL*41 02320 SET CURSOR-SET-YES TO TRUE. CL**6 02321 S1601-EXIT. CL*41 02322 EXIT. CL*41 02323 /***************************************************************** CL**5 02324 * CL**5 02325 ****************************************************************** CL**5 02326 S1700-SUBPOENA-CD. CL*14 02327 IF MAP-SUBPOENA-CD = LOW-VALUE CL**5 02328 MOVE SPACE TO MAP-SUBPOENA-CD. CL**5 02329 CL*41 02330 CL*41 02331 MOVE MAP-SUBPOENA-DATE TO L015-S-DATE-AREA. CL**5 02332 CL*41 02333 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL**5 02334 CL**5 02335 CL*41 02336 IF MAP-SUBPOENA-CD = SPACE CL**5 02337 IF L015-NO-ENTRY CL**5 02338 NEXT SENTENCE CL**5 02339 ELSE CL**5 02340 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*41 02341 PERFORM S1702-ERROR THRU S1702-EXIT CL*41 02342 ELSE CL**5 02343 MOVE MAP-SUBPOENA-CD TO L034-CD CL**5 02344 PERFORM S034-MCOL-SUBPOENA-CD THRU S034-EXIT CL**5 02345 IF L034-NOT-VALID CL**5 02346 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*41 02347 PERFORM S1701-ERROR THRU S1701-EXIT CL*41 02348 ELSE CL**5 02349 IF L015-NO-ENTRY CL**5 02350 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA CL*41 02351 PERFORM S1702-ERROR THRU S1702-EXIT. CL*41 02352 CL**5 02353 IF L015-NOT-VALID CL**5 02354 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*41 02355 PERFORM S1702-ERROR THRU S1702-EXIT. CL*41 02356 S1700-EXIT. CL*41 02357 EXIT. CL*41 02358 CL*41 02359 CL*41 02360 CL*41 02361 S1701-ERROR. CL**5 02362 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SUBPOENA-CD-A. CL**5 02363 CL*41 02364 IF LCCM-NO-MSG CL**5 02365 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02366 MOVE CATB-CURSOR TO MAP-SUBPOENA-CD-L CL*41 02367 SET CURSOR-SET-YES TO TRUE. CL**5 02368 S1701-EXIT. CL*41 02369 EXIT. CL*41 02370 CL*41 02371 CL*41 02372 CL*41 02373 S1702-ERROR. CL**5 02374 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SUBPOENA-MO-A CL**5 02375 MAP-SUBPOENA-DA-A CL**5 02376 MAP-SUBPOENA-YR-A. CL**5 02377 CL*41 02378 IF LCCM-NO-MSG CL**5 02379 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02380 MOVE CATB-CURSOR TO MAP-SUBPOENA-MO-L CL*41 02381 SET CURSOR-SET-YES TO TRUE. CL**5 02382 S1702-EXIT. CL*41 02383 EXIT. CL*41 02384 /************************************************************* CL*41 02385 * CL*41 02386 ************************************************************** CL*41 02387 CL*41 02388 S1800-LEGAL-REFERRAL-DATE. CL**5 02389 MOVE MAP-LEGAL-REF-DATE TO L015-S-DATE-AREA. CL*18 02390 CL*41 02391 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02392 DTSCS42 02393 DTSCS42 02394 IF L015-NO-ENTRY DTSCS42 02395 GO TO S1800-EXIT CL**5 02396 END-IF. DTSCS42 02397 DTSCS42 02398 IF L015-NOT-VALID DTSCS42 02399 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*41 02400 PERFORM S1801-ERROR THRU S1801-EXIT. CL*41 02401 S1800-EXIT. CL*41 02402 EXIT. CL*41 02403 CL*41 02404 CL*41 02405 CL*41 02406 S1801-ERROR. CL**5 02407 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LEGAL-REF-MO-A CL*10 02408 MAP-LEGAL-REF-DA-A CL*10 02409 MAP-LEGAL-REF-YR-A. CL*10 02410 CL*41 02411 IF LCCM-NO-MSG DTSCS42 02412 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02413 MOVE CATB-CURSOR TO MAP-LEGAL-REF-MO-L CL*41 02414 SET CURSOR-SET-YES TO TRUE. DTSCS42 02415 S1801-EXIT. CL*41 02416 EXIT. CL*41 02417 CL*41 02418 CL*41 02419 CL*41 02420 /*****************************************************************DTSCS42 02421 * DTSCS42 02422 ******************************************************************DTSCS42 02423 CL*41 02424 S1900-CIVIL-ACTION-BEGIN-DATE. CL**6 02425 MOVE MAP-CIVIL-ACTION-BEGIN-DATE TO L015-S-DATE-AREA. DTSCS42 02426 CL*41 02427 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02428 DTSCS42 02429 DTSCS42 02430 IF L015-NO-ENTRY DTSCS42 02431 GO TO S1900-EXIT CL**7 02432 END-IF. DTSCS42 02433 DTSCS42 02434 IF L015-NOT-VALID DTSCS42 02435 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*41 02436 PERFORM S1901-ERROR THRU S1901-EXIT. CL*41 02437 S1900-EXIT. CL*41 02438 EXIT. CL*41 02439 CL*41 02440 CL*41 02441 CL*41 02442 S1901-ERROR. CL**7 02443 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS42 02444 TO MAP-CIVIL-ACTION-BEGIN-MO-A CL*41 02445 MAP-CIVIL-ACTION-BEGIN-DA-A CL*41 02446 MAP-CIVIL-ACTION-BEGIN-YR-A. CL*41 02447 CL*41 02448 IF LCCM-NO-MSG DTSCS42 02449 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*41 02450 MOVE CATB-CURSOR TO MAP-CIVIL-ACTION-BEGIN-MO-L CL*41 02451 SET CURSOR-SET-YES TO TRUE. DTSCS42 02452 S1901-EXIT. CL*41 02453 EXIT. CL*41 02454 /*****************************************************************DTSCS42 02455 * DTSCS42 02456 ******************************************************************DTSCS42 02457 CL*42 02458 S2000-SUBPOENA-OPID. CL**7 02459 MOVE MAP-SUBPOENA-DATE TO L015-S-DATE-AREA. CL*27 02460 CL*42 02461 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. CL*27 02462 CL*27 02463 IF L015-NO-ENTRY CL*27 02464 IF MAP-SUBPOENA-OPID = SPACES OR LOW-VALUES CL*27 02465 MOVE SPACES TO MAP-SUBPOENA-OPID CL*42 02466 GO TO S2000-EXIT CL*42 02467 ELSE CL*27 02468 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*42 02469 PERFORM S2001-ERROR THRU S2001-EXIT CL*42 02470 GO TO S2000-EXIT. CL*42 02471 CL*27 02472 IF MAP-SUBPOENA-OPID = SPACES OR LOW-VALUES CL*27 02473 MOVE LCCM-RESP-OP-ID TO MAP-SUBPOENA-OPID. CL*27 02474 CL*27 02475 IF MAP-SUBPOENA-OPID = LCCM-OP-ID CL**9 02476 MOVE MAP-SUBPOENA-OPID TO LCCM-RESP-OP-ID CL**9 02477 GO TO S2000-EXIT CL**7 02478 END-IF. DTSCS42 02479 DTSCS42 02480 MOVE MAP-SUBPOENA-OPID TO L082-OP-ID. CL*42 02481 CL*42 02482 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. CL*42 02483 CL**9 02484 IF (L082-VALID-OP) AND (L082-EXTERNAL-88) CL**9 02485 MOVE MAP-SUBPOENA-OPID TO LCCM-RESP-OP-ID CL**9 02486 ELSE CL**9 02487 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02488 PERFORM S2001-ERROR THRU S2001-EXIT. CL*42 02489 S2000-EXIT. CL*42 02490 EXIT. CL*42 02491 CL*42 02492 CL*42 02493 CL*42 02494 S2001-ERROR. CL**7 02495 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SUBPOENA-OPID-A CL**9 02496 MAP-SUBPOENA-OPID-A CL**9 02497 MAP-SUBPOENA-OPID-A. CL**9 02498 CL*42 02499 IF LCCM-NO-MSG DTSCS42 02500 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02501 MOVE CATB-CURSOR TO MAP-SUBPOENA-OPID-L CL*42 02502 SET CURSOR-SET-YES TO TRUE. DTSCS42 02503 S2001-EXIT. CL*42 02504 EXIT. CL*42 02505 /*****************************************************************DTSCS42 02506 * DTSCS42 02507 ******************************************************************DTSCS42 02508 CL*42 02509 S2100-CIVIL-ACTION-JUDGE-DATE. CL**7 02510 MOVE MAP-CIVIL-ACTION-JUDGE-DATE TO L015-S-DATE-AREA. DTSCS42 02511 CL*42 02512 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02513 DTSCS42 02514 DTSCS42 02515 IF L015-NO-ENTRY DTSCS42 02516 GO TO S2100-EXIT CL**7 02517 END-IF. DTSCS42 02518 DTSCS42 02519 IF L015-NOT-VALID DTSCS42 02520 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02521 PERFORM S2101-ERROR THRU S2101-EXIT. CL*42 02522 S2100-EXIT. CL*42 02523 EXIT. CL*42 02524 CL*42 02525 CL*42 02526 CL*42 02527 S2101-ERROR. CL**7 02528 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS42 02529 TO MAP-CIVIL-ACTION-JUDGE-MO-A CL*42 02530 MAP-CIVIL-ACTION-JUDGE-DA-A CL*42 02531 MAP-CIVIL-ACTION-JUDGE-YR-A. CL*42 02532 CL*42 02533 IF LCCM-NO-MSG DTSCS42 02534 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02535 MOVE CATB-CURSOR TO MAP-CIVIL-ACTION-JUDGE-MO-L CL*42 02536 SET CURSOR-SET-YES TO TRUE. DTSCS42 02537 S2101-EXIT. CL*42 02538 EXIT. CL*42 02539 /*****************************************************************DTSCS42 02540 * DTSCS42 02541 ******************************************************************DTSCS42 02542 CL*42 02543 S2300-BNK-PETITION-DATE. CL**7 02544 MOVE MAP-BNK-PETITION-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02545 CL*42 02546 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02547 DTSCS42 02548 IF L015-NO-ENTRY DTSCS42 02549 SET WRK-PETITION-IND-NO-88 TO TRUE DTSCS42 02550 GO TO S2300-EXIT CL**7 02551 END-IF. DTSCS42 02552 DTSCS42 02553 SET WRK-PETITION-IND-YES-88 TO TRUE DTSCS42 02554 DTSCS42 02555 IF L015-NOT-VALID DTSCS42 02556 OR L015-DATE > LCCM-CURR-RUN-DATE CL*42 02557 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02558 PERFORM S2301-ERROR THRU S2301-EXIT CL*42 02559 ELSE DTSCS42 02560 ********IF NOT MPRF-STATUS-INACT-88 DTSCS42 02561 ***********SET WRK-PETITION-IND-NO-88 TO TRUE CL*42 02562 ***********MOVE MSG-E421-AREA TO WRK-MSG-AREA CL*42 02563 ***********PERFORM S2301-ERROR THRU S2301-EXIT CL*42 02564 ********ELSE DTSCS42 02565 MOVE L015-DATE TO WRK-START-DATE. DTSCS42 02566 S2300-EXIT. CL*42 02567 EXIT. CL*42 02568 CL*42 02569 CL*42 02570 CL*42 02571 S2301-ERROR. CL**7 02572 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-PETITION-MO-A DTSCS42 02573 MAP-BNK-PETITION-DA-A DTSCS42 02574 MAP-BNK-PETITION-YR-A. DTSCS42 02575 CL*42 02576 IF LCCM-NO-MSG DTSCS42 02577 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02578 MOVE CATB-CURSOR TO MAP-BNK-PETITION-MO-L CL*42 02579 SET CURSOR-SET-YES TO TRUE. DTSCS42 02580 S2301-EXIT. CL*42 02581 EXIT. CL*42 02582 /***************************************************************** CL**7 02583 * CL**7 02584 ****************************************************************** CL**7 02585 CL*42 02586 S2400-BNK-COURT-CASE-NO. CL**7 02587 INSPECT MAP-BNK-COURT-CASE-NO CONVERTING CL**7 02588 LOW-VALUES TO SPACES. CL**7 02589 CL**7 02590 IF MAP-BNK-COURT-CASE-NO = SPACES CL**7 02591 IF WRK-PETITION-IND-YES-88 CL**7 02592 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA CL**7 02593 PERFORM S2401-ERROR THRU S2401-EXIT CL**7 02594 ELSE CL**7 02595 NEXT SENTENCE CL**7 02596 ELSE CL**7 02597 IF WRK-PETITION-IND-NO-88 CL**7 02598 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL**7 02599 PERFORM S2401-ERROR THRU S2401-EXIT CL**7 02600 ELSE CL**7 02601 NEXT SENTENCE. CL**7 02602 S2400-EXIT. CL*42 02603 EXIT. CL*42 02604 CL*42 02605 CL*42 02606 CL*42 02607 S2401-ERROR. CL**7 02608 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-BNK-COURT-CASE-NO-A. CL*47 02609 CL*42 02610 IF LCCM-NO-MSG CL**7 02611 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02612 MOVE CATB-CURSOR TO MAP-BNK-COURT-CASE-NO-L CL*42 02613 SET CURSOR-SET-YES TO TRUE. CL**7 02614 S2401-EXIT. CL*42 02615 EXIT. CL*42 02616 /*****************************************************************DTSCS42 02617 * DTSCS42 02618 ******************************************************************DTSCS42 02619 CL*42 02620 S2500-BNK-CHAPTER. DTSCS42 02621 INSPECT MAP-BNK-CHAPTER CONVERTING DTSCS42 02622 LOW-VALUES TO SPACES. DTSCS42 02623 DTSCS42 02624 MOVE MAP-BNK-CHAPTER TO L034-CD. DTSCS42 02625 DTSCS42 02626 PERFORM S034-MCOL-BNK-CHAPTER THRU S034-EXIT. DTSCS42 02627 CL*42 02628 IF L034-NOT-VALID DTSCS42 02629 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS42 02630 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS42 02631 ELSE DTSCS42 02632 IF WRK-PETITION-IND-NO-88 DTSCS42 02633 IF MAP-BNK-CHAPTER = SPACES DTSCS42 02634 NEXT SENTENCE DTSCS42 02635 ELSE DTSCS42 02636 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS42 02637 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS42 02638 ELSE DTSCS42 02639 IF MAP-BNK-CHAPTER = SPACES DTSCS42 02640 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS42 02641 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS42 02642 S2500-EXIT. CL*42 02643 EXIT. CL*42 02644 CL*42 02645 CL*42 02646 CL*42 02647 S2501-ERROR. DTSCS42 02648 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-BNK-CHAPTER-A. DTSCS42 02649 CL*42 02650 IF LCCM-NO-MSG DTSCS42 02651 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02652 MOVE CATB-CURSOR TO MAP-BNK-CHAPTER-L CL*42 02653 SET CURSOR-SET-YES TO TRUE. DTSCS42 02654 S2501-EXIT. CL*42 02655 EXIT. CL*42 02656 /*****************************************************************DTSCS42 02657 * DTSCS42 02658 ******************************************************************DTSCS42 02659 CL*42 02660 S2600-BNK-POC-REQUIRED-DATE. DTSCS42 02661 MOVE MAP-BNK-POC-REQUIRED-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02662 CL*42 02663 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02664 DTSCS42 02665 IF L015-NO-ENTRY DTSCS42 02666 SET WRK-POC-REQ-IND-NO-88 TO TRUE DTSCS42 02667 GO TO S2600-EXIT DTSCS42 02668 END-IF. DTSCS42 02669 DTSCS42 02670 SET WRK-POC-REQ-IND-YES-88 TO TRUE. DTSCS42 02671 DTSCS42 02672 IF WRK-PETITION-IND-NO-88 DTSCS42 02673 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*42 02674 PERFORM S2601-ERROR THRU S2601-EXIT CL*42 02675 ELSE DTSCS42 02676 IF L015-NOT-VALID DTSCS42 02677 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02678 PERFORM S2601-ERROR THRU S2601-EXIT CL*42 02679 ELSE DTSCS42 02680 PERFORM S2610-CROSS-EDITS THRU S2610-EXIT. DTSCS42 02681 S2600-EXIT. CL*42 02682 EXIT. CL*42 02683 CL*42 02684 CL*42 02685 CL*42 02686 S2601-ERROR. DTSCS42 02687 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-POC-REQUIRED-MO-A DTSCS42 02688 MAP-BNK-POC-REQUIRED-DA-A DTSCS42 02689 MAP-BNK-POC-REQUIRED-YR-A.DTSCS42 02690 CL*42 02691 IF LCCM-NO-MSG DTSCS42 02692 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02693 MOVE CATB-CURSOR TO MAP-BNK-POC-REQUIRED-MO-L CL*42 02694 SET CURSOR-SET-YES TO TRUE. DTSCS42 02695 S2601-EXIT. CL*42 02696 EXIT. CL*42 02697 CL*42 02698 CL*42 02699 CL*42 02700 S2610-CROSS-EDITS. DTSCS42 02701 IF L015-DATE > WRK-START-DATE DTSCS42 02702 NEXT SENTENCE DTSCS42 02703 ELSE DTSCS42 02704 MOVE MSG-E421-AREA TO WRK-MSG-AREA DTSCS42 02705 PERFORM S2601-ERROR THRU S2601-EXIT. DTSCS42 02706 S2610-EXIT. CL*42 02707 EXIT. CL*42 02708 /*****************************************************************DTSCS42 02709 * DTSCS42 02710 ******************************************************************DTSCS42 02711 S2700-BNK-POC-FILED-DATE. DTSCS42 02712 MOVE MAP-BNK-POC-FILED-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02713 CL*42 02714 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02715 DTSCS42 02716 IF L015-NO-ENTRY DTSCS42 02717 GO TO S2700-EXIT DTSCS42 02718 END-IF. CL*42 02719 DTSCS42 02720 IF WRK-PETITION-IND-NO-88 DTSCS42 02721 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*42 02722 PERFORM S2701-ERROR THRU S2701-EXIT CL*42 02723 ELSE DTSCS42 02724 IF L015-NOT-VALID DTSCS42 02725 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02726 PERFORM S2701-ERROR THRU S2701-EXIT CL*42 02727 ELSE DTSCS42 02728 PERFORM S2710-CROSS-EDITS THRU S2710-EXIT. DTSCS42 02729 S2700-EXIT. CL*42 02730 EXIT. CL*42 02731 CL*42 02732 CL*42 02733 CL*42 02734 S2701-ERROR. DTSCS42 02735 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-POC-FILED-MO-A DTSCS42 02736 MAP-BNK-POC-FILED-DA-A DTSCS42 02737 MAP-BNK-POC-FILED-YR-A. DTSCS42 02738 CL*42 02739 IF LCCM-NO-MSG DTSCS42 02740 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02741 MOVE CATB-CURSOR TO MAP-BNK-POC-FILED-MO-L CL*42 02742 SET CURSOR-SET-YES TO TRUE. DTSCS42 02743 S2701-EXIT. CL*42 02744 EXIT. CL*42 02745 CL*42 02746 CL*42 02747 CL*42 02748 S2710-CROSS-EDITS. DTSCS42 02749 IF L015-DATE > WRK-START-DATE DTSCS42 02750 NEXT SENTENCE DTSCS42 02751 ELSE DTSCS42 02752 MOVE MSG-E422-AREA TO WRK-MSG-AREA DTSCS42 02753 PERFORM S2701-ERROR THRU S2701-EXIT DTSCS42 02754 GO TO S2710-EXIT. DTSCS42 02755 DTSCS42 02756 IF L015-DATE <= LCCM-CURR-RUN-DATE DTSCS42 02757 NEXT SENTENCE DTSCS42 02758 ELSE DTSCS42 02759 MOVE MSG-E423-AREA TO WRK-MSG-AREA DTSCS42 02760 PERFORM S2701-ERROR THRU S2701-EXIT DTSCS42 02761 GO TO S2710-EXIT. DTSCS42 02762 S2710-EXIT. CL*42 02763 EXIT. CL*42 02764 /*****************************************************************DTSCS42 02765 * DTSCS42 02766 ******************************************************************DTSCS42 02767 CL*42 02768 S2800-BNK-CHAPTER-CHNG-DATE. DTSCS42 02769 MOVE MAP-BNK-CHAPTER-CHNG-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02770 CL*42 02771 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02772 DTSCS42 02773 IF L015-NO-ENTRY DTSCS42 02774 GO TO S2800-EXIT DTSCS42 02775 END-IF. CL*42 02776 DTSCS42 02777 IF WRK-PETITION-IND-NO-88 DTSCS42 02778 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*42 02779 PERFORM S2801-ERROR THRU S2801-EXIT CL*42 02780 ELSE DTSCS42 02781 IF L015-NOT-VALID DTSCS42 02782 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02783 PERFORM S2801-ERROR THRU S2801-EXIT. CL*42 02784 S2800-EXIT. CL*42 02785 EXIT. CL*42 02786 CL*42 02787 CL*42 02788 CL*42 02789 S2801-ERROR. DTSCS42 02790 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-CHAPTER-CHNG-MO-A DTSCS42 02791 MAP-BNK-CHAPTER-CHNG-DA-A DTSCS42 02792 MAP-BNK-CHAPTER-CHNG-YR-A.DTSCS42 02793 CL*42 02794 IF LCCM-NO-MSG DTSCS42 02795 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02796 MOVE CATB-CURSOR TO MAP-BNK-CHAPTER-CHNG-MO-L CL*42 02797 SET CURSOR-SET-YES TO TRUE. DTSCS42 02798 S2801-EXIT. CL*42 02799 EXIT. CL*42 02800 /*****************************************************************DTSCS42 02801 * DTSCS42 02802 ******************************************************************DTSCS42 02803 CL*42 02804 S2900-BNK-LAST-COMM-DATE. DTSCS42 02805 MOVE MAP-BNK-LAST-COMM-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02806 CL*42 02807 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02808 DTSCS42 02809 IF L015-NO-ENTRY DTSCS42 02810 GO TO S2900-EXIT DTSCS42 02811 END-IF. DTSCS42 02812 DTSCS42 02813 IF WRK-PETITION-IND-NO-88 DTSCS42 02814 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS42 02815 PERFORM S2901-ERROR THRU S2901-EXIT DTSCS42 02816 ELSE DTSCS42 02817 IF L015-NOT-VALID DTSCS42 02818 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS42 02819 PERFORM S2901-ERROR THRU S2901-EXIT DTSCS42 02820 ELSE DTSCS42 02821 PERFORM S2910-CROSS-EDITS THRU S2910-EXIT. DTSCS42 02822 S2900-EXIT. CL*42 02823 EXIT. CL*42 02824 CL*42 02825 CL*42 02826 CL*42 02827 S2901-ERROR. DTSCS42 02828 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-LAST-COMM-MO-A DTSCS42 02829 MAP-BNK-LAST-COMM-DA-A DTSCS42 02830 MAP-BNK-LAST-COMM-YR-A. DTSCS42 02831 CL*42 02832 IF LCCM-NO-MSG DTSCS42 02833 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02834 MOVE CATB-CURSOR TO MAP-BNK-LAST-COMM-MO-L CL*42 02835 SET CURSOR-SET-YES TO TRUE. DTSCS42 02836 S2901-EXIT. CL*42 02837 EXIT. CL*42 02838 CL*42 02839 CL*42 02840 CL*42 02841 S2910-CROSS-EDITS. DTSCS42 02842 IF L015-DATE > WRK-START-DATE DTSCS42 02843 NEXT SENTENCE DTSCS42 02844 ELSE DTSCS42 02845 MOVE MSG-E428-AREA TO WRK-MSG-AREA DTSCS42 02846 PERFORM S2901-ERROR THRU S2901-EXIT DTSCS42 02847 GO TO S2910-EXIT. DTSCS42 02848 DTSCS42 02849 IF L015-DATE <= LCCM-CURR-RUN-DATE DTSCS42 02850 NEXT SENTENCE DTSCS42 02851 ELSE DTSCS42 02852 MOVE MSG-E429-AREA TO WRK-MSG-AREA DTSCS42 02853 PERFORM S2901-ERROR THRU S2901-EXIT DTSCS42 02854 GO TO S2910-EXIT. DTSCS42 02855 S2910-EXIT. CL*42 02856 EXIT. CL*42 02857 /*****************************************************************DTSCS42 02858 * DTSCS42 02859 ******************************************************************DTSCS42 02860 CL*42 02861 S3000-BNK-DISCHRG-CLOSE-DATE. DTSCS42 02862 MOVE MAP-BNK-DISCHRG-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02863 CL*42 02864 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02865 DTSCS42 02866 IF L015-NO-ENTRY DTSCS42 02867 SET WRK-DISCHRG-IND-NO-88 TO TRUE DTSCS42 02868 GO TO S3000-EXIT DTSCS42 02869 END-IF. DTSCS42 02870 DTSCS42 02871 SET WRK-DISCHRG-IND-YES-88 TO TRUE. DTSCS42 02872 DTSCS42 02873 IF WRK-PETITION-IND-NO-88 DTSCS42 02874 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*42 02875 PERFORM S3001-ERROR THRU S3001-EXIT CL*42 02876 ELSE DTSCS42 02877 IF L015-NOT-VALID DTSCS42 02878 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02879 PERFORM S3001-ERROR THRU S3001-EXIT CL*42 02880 ELSE DTSCS42 02881 PERFORM S3010-CROSS-EDITS THRU S3010-EXIT. DTSCS42 02882 S3000-EXIT. CL*42 02883 EXIT. CL*42 02884 CL*42 02885 CL*42 02886 CL*42 02887 S3001-ERROR. DTSCS42 02888 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS42 02889 TO MAP-BNK-DISCHRG-CLOSE-MO-A DTSCS42 02890 MAP-BNK-DISCHRG-CLOSE-DA-A DTSCS42 02891 MAP-BNK-DISCHRG-CLOSE-YR-A. DTSCS42 02892 CL*42 02893 IF LCCM-NO-MSG DTSCS42 02894 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02895 MOVE CATB-CURSOR TO MAP-BNK-DISCHRG-CLOSE-MO-L CL*42 02896 SET CURSOR-SET-YES TO TRUE. DTSCS42 02897 S3001-EXIT. CL*42 02898 EXIT. CL*42 02899 CL*42 02900 CL*42 02901 CL*42 02902 S3010-CROSS-EDITS. DTSCS42 02903 IF L015-DATE > WRK-START-DATE DTSCS42 02904 NEXT SENTENCE DTSCS42 02905 ELSE DTSCS42 02906 MOVE MSG-E424-AREA TO WRK-MSG-AREA DTSCS42 02907 PERFORM S3001-ERROR THRU S3001-EXIT DTSCS42 02908 GO TO S3010-EXIT. DTSCS42 02909 DTSCS42 02910 IF L015-DATE <= LCCM-CURR-RUN-DATE DTSCS42 02911 NEXT SENTENCE DTSCS42 02912 ELSE DTSCS42 02913 MOVE MSG-E425-AREA TO WRK-MSG-AREA DTSCS42 02914 PERFORM S3001-ERROR THRU S3001-EXIT DTSCS42 02915 GO TO S3010-EXIT. DTSCS42 02916 DTSCS42 02917 MOVE L015-DATE TO WRK-END-DATE. DTSCS42 02918 S3010-EXIT. CL*42 02919 EXIT. CL*42 02920 /*****************************************************************DTSCS42 02921 * DTSCS42 02922 ******************************************************************DTSCS42 02923 CL*42 02924 S3100-BNK-DISMISS-DATE. DTSCS42 02925 MOVE MAP-BNK-DISMISS-DATE-AREA TO L015-S-DATE-AREA. DTSCS42 02926 CL*42 02927 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS42 02928 DTSCS42 02929 IF L015-NO-ENTRY DTSCS42 02930 GO TO S3100-EXIT DTSCS42 02931 END-IF. DTSCS42 02932 DTSCS42 02933 IF WRK-PETITION-IND-NO-88 DTSCS42 02934 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA CL*42 02935 PERFORM S3101-ERROR THRU S3101-EXIT CL*42 02936 ELSE DTSCS42 02937 IF WRK-DISCHRG-IND-YES-88 DTSCS42 02938 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS42 02939 PERFORM S3001-ERROR THRU S3001-EXIT DTSCS42 02940 PERFORM S3101-ERROR THRU S3101-EXIT DTSCS42 02941 ELSE DTSCS42 02942 IF L015-NOT-VALID DTSCS42 02943 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL*42 02944 PERFORM S3101-ERROR THRU S3101-EXIT CL*42 02945 ELSE DTSCS42 02946 PERFORM S3110-CROSS-EDITS THRU S3110-EXIT. DTSCS42 02947 S3100-EXIT. CL*42 02948 EXIT. CL*42 02949 CL*42 02950 CL*42 02951 CL*42 02952 S3101-ERROR. DTSCS42 02953 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BNK-DISMISS-MO-A DTSCS42 02954 MAP-BNK-DISMISS-DA-A DTSCS42 02955 MAP-BNK-DISMISS-YR-A. DTSCS42 02956 CL*42 02957 IF LCCM-NO-MSG DTSCS42 02958 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*42 02959 MOVE CATB-CURSOR TO MAP-BNK-DISMISS-MO-L CL*42 02960 SET CURSOR-SET-YES TO TRUE. DTSCS42 02961 S3101-EXIT. CL*42 02962 EXIT. CL*42 02963 CL*42 02964 CL*42 02965 CL*42 02966 S3110-CROSS-EDITS. DTSCS42 02967 IF L015-DATE > WRK-START-DATE DTSCS42 02968 NEXT SENTENCE DTSCS42 02969 ELSE DTSCS42 02970 MOVE MSG-E426-AREA TO WRK-MSG-AREA DTSCS42 02971 PERFORM S3101-ERROR THRU S3101-EXIT DTSCS42 02972 GO TO S3110-EXIT. DTSCS42 02973 DTSCS42 02974 IF L015-DATE <= LCCM-CURR-RUN-DATE DTSCS42 02975 NEXT SENTENCE DTSCS42 02976 ELSE DTSCS42 02977 MOVE MSG-E427-AREA TO WRK-MSG-AREA DTSCS42 02978 PERFORM S3101-ERROR THRU S3101-EXIT DTSCS42 02979 GO TO S3110-EXIT. DTSCS42 02980 DTSCS42 02981 MOVE L015-DATE TO WRK-END-DATE. DTSCS42 02982 S3110-EXIT. CL*42 02983 EXIT. CL*42 02984 /*****************************************************************DTSCS42 02985 * DTSCS42 02986 ******************************************************************DTSCS42 02987 CL*43 02988 S3200-STMT-TEXT. CL**7 02989 MOVE +0 TO MCOL-STMT-TEXT-CNT. CL**7 02990 CL*43 02991 PERFORM DTSCS42 02992 VARYING WRK-OCC FROM 1 BY 1 CL*43 02993 UNTIL WRK-OCC > MMAX-COL-TEXT-MAX DTSCS42 02994 INSPECT MAP-STMT-TEXT(WRK-OCC) CONVERTING CL*43 02995 LOW-VALUES TO SPACES CL*43 02996 IF MAP-STMT-TEXT(WRK-OCC) NOT = SPACES CL*43 02997 MOVE WRK-OCC TO MCOL-STMT-TEXT-CNT CL*43 02998 END-IF DTSCS42 02999 END-PERFORM. DTSCS42 03000 S3200-EXIT. CL*43 03001 EXIT. CL*43 03002 CL*44 03003 /*****************************************************************DTSCS42 03004 * DTSCS42 03005 ******************************************************************DTSCS42 03006 CL*44 03007 S3300-STMT-TYPE. CL*10 03008 IF MAP-STMT-TYPE = LOW-VALUES OR SPACES CL*10 03009 MOVE SPACES TO MAP-STMT-TYPE CL*10 03010 END-IF. DTSCS42 03011 DTSCS42 03012 IF NOT MAP-STMT-TYPE-VALID CL*10 03013 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS42 03014 PERFORM S3301-ERROR THRU S3301-EXIT DTSCS42 03015 ELSE DTSCS42 03016 IF (MAP-STMT-TYPE = ' ') CL*10 03017 AND (MCOL-STMT-TEXT-CNT > +0) CL*44 03018 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS42 03019 PERFORM S3301-ERROR THRU S3301-EXIT DTSCS42 03020 ELSE DTSCS42 03021 IF (MAP-STMT-TYPE NOT = ' ') CL*10 03022 AND (MCOL-STMT-TEXT-CNT = +0) CL*44 03023 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS42 03024 PERFORM S3301-ERROR THRU S3301-EXIT. DTSCS42 03025 S3300-EXIT. CL*44 03026 EXIT. CL*44 03027 CL*44 03028 CL*44 03029 CL*44 03030 S3301-ERROR. DTSCS42 03031 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STMT-TYPE-A. CL*10 03032 CL*44 03033 IF LCCM-NO-MSG DTSCS42 03034 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*44 03035 MOVE CATB-CURSOR TO MAP-STMT-TYPE-L CL*44 03036 SET CURSOR-SET-YES TO TRUE. DTSCS42 03037 S3301-EXIT. CL*44 03038 EXIT. CL*44 03039 /*****************************************************************DTSCS42 03040 * DTSCS42 03041 ******************************************************************DTSCS42 03042 CL*44 03043 S3400-STMT-PERMANENT-IND. CL*10 03044 IF MAP-STMT-PERMANENT-IND = LOW-VALUES OR SPACES CL*10 03045 MOVE SPACE TO MAP-STMT-PERMANENT-IND CL*10 03046 END-IF. DTSCS42 03047 DTSCS42 03048 IF NOT MAP-STMT-PERMANENT-VALID CL*10 03049 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS42 03050 PERFORM S3401-ERROR THRU S3401-EXIT DTSCS42 03051 ELSE DTSCS42 03052 IF (MAP-STMT-PERMANENT-IND = ' ') CL*10 03053 AND (MCOL-STMT-TEXT-CNT > +0) CL**7 03054 MOVE 'N' TO MAP-STMT-PERMANENT-IND CL*10 03055 ELSE DTSCS42 03056 IF (MAP-STMT-PERMANENT-IND NOT = ' ') CL*10 03057 AND (MCOL-STMT-TEXT-CNT = +0) CL**7 03058 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS42 03059 PERFORM S3401-ERROR THRU S3401-EXIT. DTSCS42 03060 S3400-EXIT. CL*44 03061 EXIT. CL*44 03062 CL*44 03063 CL*44 03064 CL*44 03065 S3401-ERROR. DTSCS42 03066 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STMT-PERMANENT-IND-A. CL*10 03067 CL*45 03068 IF LCCM-NO-MSG DTSCS42 03069 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*45 03070 MOVE CATB-CURSOR TO MAP-STMT-PERMANENT-IND-L CL*45 03071 SET CURSOR-SET-YES TO TRUE. DTSCS42 03072 S3401-EXIT. CL*45 03073 EXIT. CL*45 03074 /*****************************************************************DTSCS42 03075 * DTSCS42 03076 ******************************************************************DTSCS42 03077 CL*45 03078 *S3500-MISC-EDITS. DTSCS42 03079 *****IF WRK-PETITION-IND-NO-88 DTSCS42 03080 ********GO TO S3500-EXIT CL*45 03081 *****END-IF. DTSCS42 03082 CL*45 03083 *****MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSCS42 03084 *****MOVE WRK-EMP-NO TO MSOL-EMP-NO. DTSCS42 03085 *****SET MSOL-SOL-88 TO TRUE. DTSCS42 03086 *****MOVE +0 TO MSOL-LIAB-DATE. DTSCS42 03087 *****MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSCS42 03088 CL*45 03089 *****PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS42 03090 CL*45 03091 *****SET WRK-OVERLAP-NO-88 TO TRUE. DTSCS42 03092 CL*45 03093 *****PERFORM S3510-MSOL-SCAN THRU S3510-EXIT DTSCS42 03094 *******UNTIL L810-NO-REC-88. CL*45 03095 CL*45 03096 *****IF WRK-OVERLAP-YES-88 DTSCS42 03097 ********MOVE MSG-E422-AREA TO WRK-MSG-AREA CL*45 03098 ********PERFORM S2401-ERROR THRU S2401-EXIT CL*45 03099 *****END-IF. DTSCS42 03100 *S3500-EXIT. EXIT. DTSCS42 03101 CL*45 03102 *S3510-MSOL-SCAN. DTSCS42 03103 *****MOVE MSKL-REC TO MSOL-REC. DTSCS42 03104 CL*45 03105 *****IF MSOL-INACT-WITHDRAWN-88 DTSCS42 03106 *********NEXT SENTENCE CL*45 03107 *****ELSE DTSCS42 03108 *****IF (WRK-END-DATE < MSOL-LIAB-DATE) DTSCS42 03109 *************OR CL*45 03110 ********(WRK-START-DATE > MSOL-INACT-DATE) CL*45 03111 *********NEXT SENTENCE CL*45 03112 *****ELSE DTSCS42 03113 *********SET WRK-OVERLAP-YES-88 TO TRUE. CL*45 03114 CL*45 03115 *****PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS42 03116 *S3510-EXIT. DTSCS42 03117 *****EXIT. DTSCS42 03118 /*****************************************************************DTSCS42 03119 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS42 03120 ******************************************************************DTSCS42 03121 CL*45 03122 S5100-SET-LOCK-ATTRB. DTSCS42 03123 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS42 03124 WRK-ATB-NUM. CL*45 03125 DTSCS42 03126 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS42 03127 DTSCS42 03128 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS42 03129 MAP-EMP-NO-2-A CL*45 03130 MAP-GOTO-A. CL*45 03131 S5100-EXIT. DTSCS42 03132 EXIT. DTSCS42 03133 DTSCS42 03134 CL*45 03135 CL*45 03136 ******************************************************************DTSCS42 03137 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS42 03138 ******************************************************************DTSCS42 03139 CL*45 03140 S5200-SET-UPDATE-ATTRB. DTSCS42 03141 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS42 03142 CL*45 03143 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS42 03144 DTSCS42 03145 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS42 03146 S5200-EXIT. DTSCS42 03147 EXIT. DTSCS42 03148 DTSCS42 03149 CL*45 03150 CL*45 03151 ******************************************************************DTSCS42 03152 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS42 03153 ******************************************************************DTSCS42 03154 CL*45 03155 S5300-SET-INQ-ATTRB. DTSCS42 03156 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS42 03157 WRK-ATB-NUM. DTSCS42 03158 DTSCS42 03159 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS42 03160 S5300-EXIT. DTSCS42 03161 EXIT. DTSCS42 03162 DTSCS42 03163 CL*45 03164 CL*45 03165 S5900-SET-ATTRB. DTSCS42 03166 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS42 03167 MAP-EMP-NO-2-A. DTSCS42 03168 DTSCS42 03169 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A CL**9 03170 MAP-EMP-CLASS-A DTSCS42 03171 MAP-EMP-STATUS-A DTSCS42 03172 MAP-WRITEOFF-DATE-A CL**7 03173 MAP-BANKRUPTCY-OPEN-IND-A DTSCS42 03174 MAP-VOICE-1-AREA-CD-A CL**4 03175 MAP-VOICE-1-PREFIX-A CL**4 03176 MAP-VOICE-1-SUFFIX-A CL**4 03177 MAP-VOICE-1-EXT-A CL*47 03178 MAP-FLD-REP-ID-A. DTSCS42 03179 DTSCS42 03180 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FLD-REP-ID-DSCR-A. DTSCS42 03181 DTSCS42 03182 MOVE WRK-ATB-NUM TO DTSCS42 03183 MAP-BNK-PETITION-MO-A DTSCS42 03184 MAP-BNK-PETITION-DA-A DTSCS42 03185 MAP-BNK-PETITION-YR-A DTSCS42 03186 MAP-BNK-CHAPTER-CHNG-MO-A DTSCS42 03187 MAP-BNK-CHAPTER-CHNG-DA-A DTSCS42 03188 MAP-BNK-CHAPTER-CHNG-YR-A DTSCS42 03189 MAP-BNK-DISCHRG-CLOSE-MO-A DTSCS42 03190 MAP-BNK-DISCHRG-CLOSE-DA-A DTSCS42 03191 MAP-BNK-DISCHRG-CLOSE-YR-A DTSCS42 03192 MAP-BNK-POC-REQUIRED-MO-A DTSCS42 03193 MAP-BNK-POC-REQUIRED-DA-A DTSCS42 03194 MAP-BNK-POC-REQUIRED-YR-A DTSCS42 03195 MAP-BNK-CHAPTER-A DTSCS42 03196 MAP-BNK-DISMISS-MO-A DTSCS42 03197 MAP-BNK-DISMISS-DA-A DTSCS42 03198 MAP-BNK-DISMISS-YR-A DTSCS42 03199 MAP-BNK-POC-FILED-MO-A DTSCS42 03200 MAP-BNK-POC-FILED-DA-A DTSCS42 03201 MAP-BNK-POC-FILED-YR-A DTSCS42 03202 MAP-BNK-LAST-COMM-MO-A DTSCS42 03203 MAP-BNK-LAST-COMM-DA-A DTSCS42 03204 MAP-BNK-LAST-COMM-YR-A DTSCS42 03205 MAP-CIVIL-ACTION-BEGIN-DA-A DTSCS42 03206 MAP-CIVIL-ACTION-BEGIN-MO-A DTSCS42 03207 MAP-CIVIL-ACTION-BEGIN-YR-A DTSCS42 03208 MAP-CIVIL-ACTION-JUDGE-DA-A DTSCS42 03209 MAP-CIVIL-ACTION-JUDGE-MO-A DTSCS42 03210 MAP-CIVIL-ACTION-JUDGE-YR-A DTSCS42 03211 MAP-SUBPOENA-DA-A DTSCS42 03212 MAP-SUBPOENA-MO-A DTSCS42 03213 MAP-SUBPOENA-YR-A DTSCS42 03214 MAP-FINAL-NOTICE-DA-A DTSCS42 03215 MAP-FINAL-NOTICE-MO-A DTSCS42 03216 MAP-FINAL-NOTICE-YR-A DTSCS42 03217 MAP-LEGAL-REF-DA-A CL**7 03218 MAP-LEGAL-REF-MO-A CL**7 03219 MAP-LEGAL-REF-YR-A. CL**7 03220 DTSCS42 03221 MOVE WRK-ATB-AN TO DTSCS42 03222 MAP-BNK-COURT-CASE-NO-A DTSCS42 03223 MAP-SUBPOENA-CD-A DTSCS42 03224 MAP-SUBPOENA-OPID-A CL**8 03225 MAP-SUSPEND-IND-A CL*23 03226 MAP-STMT-TYPE-A CL*10 03227 MAP-STMT-PERMANENT-IND-A CL*10 03228 MAP-MAIL-DB-MEMO-IND-A CL*14 03229 MAP-MAIL-MISS-RPT-IND-A CL*14 03230 MAP-PHYS-DB-MEMO-IND-A CL*14 03231 MAP-PHYS-MISS-RPT-IND-A. CL*14 03232 DTSCS42 03233 PERFORM VARYING WRK-OCC DTSCS42 03234 FROM 1 BY 1 DTSCS42 03235 UNTIL WRK-OCC > MMAX-COL-TEXT-MAX DTSCS42 03236 MOVE WRK-ATB-AN TO DTSCS42 03237 MAP-STMT-TEXT-A(WRK-OCC) CL*10 03238 END-PERFORM. DTSCS42 03239 DTSCS42 03240 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS42 03241 S5900-EXIT. DTSCS42 03242 EXIT. DTSCS42 03243 EJECT DTSCS42 03244 /*****************************************************************DTSCS42 03245 * MAP ROUTINES *DTSCS42 03246 ******************************************************************DTSCS42 03247 CL*45 03248 S9100-RECEIVE. DTSCS42 03249 SET L851-RECEIVE-88 TO TRUE. DTSCS42 03250 DTSCS42 03251 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS42 03252 DTSCS42 03253 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS42 03254 DTSCS42 03255 MOVE L851-AID TO LCCM-AID. DTSCS42 03256 CL*45 03257 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS42 03258 S9100-EXIT. DTSCS42 03259 EXIT. DTSCS42 03260 DTSCS42 03261 CL*45 03262 CL*45 03263 S9200-SEND-DATAONLY. DTSCS42 03264 MOVE LOW-VALUES TO MAP-AREA. DTSCS42 03265 DTSCS42 03266 IF LCCM-NO-MSG DTSCS42 03267 NEXT SENTENCE DTSCS42 03268 ELSE DTSCS42 03269 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS42 03270 DTSCS42 03271 IF CURSOR-SET-GOTO DTSCS42 03272 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS42 03273 ELSE DTSCS42 03274 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS42 03275 DTSCS42 03276 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS42 03277 DTSCS42 03278 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS42 03279 DTSCS42 03280 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS42 03281 S9200-EXIT. DTSCS42 03282 EXIT. DTSCS42 03283 DTSCS42 03284 CL*45 03285 CL*45 03286 S9300-SEND-MAP. DTSCS42 03287 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS42 03288 CL*45 03289 MOVE SPACES TO MAP-SYS-TIME. DTSCS42 03290 CL*45 03291 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS42 03292 CL*45 03293 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS42 03294 DTSCS42 03295 IF SCR-ACCESS-UPDATE DTSCS42 03296 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS42 03297 ELSE DTSCS42 03298 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS42 03299 DTSCS42 03300 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS42 03301 DTSCS42 03302 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS42 03303 DTSCS42 03304 IF CURSOR-SET-NO DTSCS42 03305 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS42 03306 DTSCS42 03307 SET L851-SEND-88 TO TRUE. DTSCS42 03308 DTSCS42 03309 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS42 03310 DTSCS42 03311 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS42 03312 S9300-EXIT. DTSCS42 03313 EXIT. DTSCS42 03314 DTSCS42 03315 CL*45 03316 CL*45 03317 S9310-UPDATE-FKEYS. DTSCS42 03318 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS42 03319 DTSCS42 03320 IF LCCM-SCR-INQUIRE DTSCS42 03321 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS42 03322 S9310-EXIT. DTSCS42 03323 EXIT. DTSCS42 03324 DTSCS42 03325 CL*45 03326 CL*45 03327 S9320-INQUIRY-FKEYS. DTSCS42 03328 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS42 03329 DTSCS42 03330 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. CL*45 03331 S9320-EXIT. DTSCS42 03332 EXIT. DTSCS42 03333 DTSCS42 03334 CL*45 03335 CL*45 03336 *S9321-JUMP-KEYS. CL**7 03337 *****MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. CL*45 03338 *****MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. CL*45 03339 *S9321-EXIT. CL**7 03340 *****EXIT. CL*45 03341 CL*45 03342 CL*45 03343 CL*45 03344 S9330-DSCR-FIELDS. DTSCS42 03345 IF WRK-MPRF-YES-88 DTSCS42 03346 PERFORM S9331-FROM-MPRF THRU S9331-EXIT DTSCS42 03347 END-IF. DTSCS42 03348 S9330-EXIT. CL*45 03349 EXIT. CL*45 03350 CL*45 03351 CL*45 03352 CL*45 03353 S9331-FROM-MPRF. DTSCS42 03354 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. CL**7 03355 DTSCS42 03356 CL*45 03357 MOVE MPRF-EMP-CLASS TO L031-CD. DTSCS42 03358 CL*45 03359 PERFORM S031-MPRF-EMP-CLASS THRU S031-EXIT. DTSCS42 03360 CL*45 03361 MOVE L031-SHORT-DSCR TO MAP-EMP-CLASS. DTSCS42 03362 DTSCS42 03363 CL*45 03364 MOVE MPRF-EMP-STATUS TO L031-CD. DTSCS42 03365 CL*45 03366 PERFORM S031-MPRF-EMP-STATUS THRU S031-EXIT. DTSCS42 03367 CL*45 03368 MOVE L031-SHORT-DSCR TO MAP-EMP-STATUS. DTSCS42 03369 DTSCS42 03370 CL*45 03371 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSCS42 03372 CL*45 03373 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSCS42 03374 CL*45 03375 PERFORM S061-FLD-ZIP THRU S061-EXIT. CL*45 03376 CL*45 03377 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS42 03378 L062-FLD-REP-ID. DTSCS42 03379 CL*45 03380 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT. DTSCS42 03381 CL*45 03382 MOVE L062-NAME TO MAP-FLD-REP-ID-DSCR. CL*45 03383 S9331-EXIT. DTSCS42 03384 EXIT. DTSCS42 03385 DTSCS42 03386 CL*45 03387 CL*45 03388 S9900-PREPARE-SEND. DTSCS42 03389 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS42 03390 LCCM-SCR-ID. DTSCS42 03391 CL*45 03392 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS42 03393 CL*45 03394 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS42 03395 S9900-EXIT. DTSCS42 03396 EXIT. DTSCS42