giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
Dutas-Dev-Update
DUTAS/CICS/DTSCS42.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

3398 lines
267 KiB
COBOL
Raw Permalink Blame History

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
Reference in New Issue View Git Blame Copy Permalink