diff --git a/CICS/DTSCS44.cob b/CICS/DTSCS44.cob index 43946db..569c4be 100644 --- a/CICS/DTSCS44.cob +++ b/CICS/DTSCS44.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 05/19/08 +00001 IDENTIFICATION DIVISION. 02/06/25 00002 PROGRAM-ID. DTSCS44. DTSCS44 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV053 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV029 00004 DATE-WRITTEN. JUNE 1994. DTSCS44 00005 DATE-COMPILED. DTSCS44 00006 SKIP3 DTSCS44 @@ -205,3454 +205,3507 @@ 00205 DATA DIVISION. DTSCS44 00206 DTSCS44 00207 WORKING-STORAGE SECTION. DTSCS44 -002075 77 PAN-VALET PICTURE X(24) VALUE '053DTSCS44 05/19/08'. DTSCS44 -00208 DTSCS44 -00209 01 WRK-AREA. DTSCS44 -00210 05 WRK-ABEND-CD PIC X(04) VALUE 'S44 '. DTSCS44 -00211 DTSCS44 -00212 05 WRK-SCR-ID. DTSCS44 -00213 10 WRK-SCR-ID-N PIC 9(02) VALUE 44. DTSCS44 -00214 DTSCS44 -00215 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS44 -00216 DTSCS44 -00217 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS44 -00218 VALUE +999999999. DTSCS44 -00219 DTSCS44 -00220 05 SCR-ACCESS-IND PIC X(01). DTSCS44 -00221 88 SCR-ACCESS-INQ VALUE '1'. DTSCS44 -00222 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS44 -00223 DTSCS44 -00224 05 CURSOR-SET-IND PIC X(01). DTSCS44 -00225 88 CURSOR-SET-YES VALUE 'Y'. DTSCS44 -00226 88 CURSOR-SET-NO VALUE 'N'. DTSCS44 -00227 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS44 -00228 DTSCS44 -00229 05 REQ-IND PIC X(01). DTSCS44 -00230 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS44 -00231 88 REQ-ERROR VALUE 'O'. DTSCS44 -00232 88 REQ-JUMP VALUE 'J'. DTSCS44 -00233 88 REQ-UPDATE VALUE 'U'. DTSCS44 -00234 88 REQ-INQUIRE VALUE 'I'. DTSCS44 -00235 88 REQ-CLEAR VALUE 'C'. DTSCS44 -00236 88 REQ-EDIT VALUE 'E'. DTSCS44 -00237 DTSCS44 -00238 05 RESP-IND PIC X(01). DTSCS44 -00239 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS44 -00240 88 RESP-SEND-MAP VALUE 'M'. DTSCS44 -00241 88 RESP-JUMP VALUE 'J'. DTSCS44 -00242 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS44 -00243 DTSCS44 -00244 05 WRK-MSG-AREA PIC X(64). DTSCS44 -00245 DTSCS44 -00246 05 WRK-ATB-AN PIC X(01). DTSCS44 -00247 DTSCS44 -00248 05 WRK-ATB-NUM PIC X(01). DTSCS44 -00249 DTSCS44 -00250 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS44 -00251 DTSCS44 -00252 05 WRK-CERT-NO PIC 9(08). DTSCS44 -00253 DTSCS44 -00254 05 WRK-EDIT-CERT-NO REDEFINES WRK-CERT-NO. DTSCS44 -00255 10 WRK-EDIT-CERT-NO1 PIC 9(04). DTSCS44 -00256 10 WRK-EDIT-CERT-NO2 PIC 9(04). DTSCS44 -00257 DTSCS44 -00258 05 WRK-AMT-DUE PIC S9(09)V9(02) COMP-3. DTSCS44 -00259 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS44 -00260 05 WRK-YRQ-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS44 -00261 05 WRK-YRQ-WRITTEN-OFF-AMT PIC S9(09)V9(02) COMP-3. DTSCS44 -00262 DTSCS44 -00263 05 WRK-STATUS-CD PIC X(01). DTSCS44 -00264 DTSCS44 -00265 05 WRK-SUB PIC S9(04) COMP. DTSCS44 -00266 DTSCS44 -00267 05 MAP-CNT PIC S9(04) COMP. DTSCS44 -00268 05 WRK-SUB2 PIC S9(04) COMP. DTSCS44 -00269 DTSCS44 -00270 05 WRK-TBL-SUB PIC S9(04) COMP. DTSCS44 -00271 DTSCS44 -00272 05 WRK-SUB-MINUS-ONE PIC S9(04) COMP. DTSCS44 +002075 77 PAN-VALET PICTURE X(24) VALUE '029DTSCS44 02/06/25'. DTSCS44 +00208 77 PAN-VALET PICTURE X(24) VALUE '053DTSCS44 05/19/08'. DTSCS44 +00209 DTSCS44 +00210 01 WRK-AREA. DTSCS44 +00211 05 WRK-ABEND-CD PIC X(04) VALUE 'S44 '. DTSCS44 +00212 DTSCS44 +00213 05 WRK-SCR-ID. DTSCS44 +00214 10 WRK-SCR-ID-N PIC 9(02) VALUE 44. DTSCS44 +00215 DTSCS44 +00216 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS44 +00217 DTSCS44 +00218 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS44 +00219 VALUE +999999999. DTSCS44 +00220 DTSCS44 +00221 05 SCR-ACCESS-IND PIC X(01). DTSCS44 +00222 88 SCR-ACCESS-INQ VALUE '1'. DTSCS44 +00223 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS44 +00224 DTSCS44 +00225 05 CURSOR-SET-IND PIC X(01). DTSCS44 +00226 88 CURSOR-SET-YES VALUE 'Y'. DTSCS44 +00227 88 CURSOR-SET-NO VALUE 'N'. DTSCS44 +00228 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS44 +00229 DTSCS44 +00230 05 REQ-IND PIC X(01). DTSCS44 +00231 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS44 +00232 88 REQ-ERROR VALUE 'O'. DTSCS44 +00233 88 REQ-JUMP VALUE 'J'. DTSCS44 +00234 88 REQ-UPDATE VALUE 'U'. DTSCS44 +00235 88 REQ-INQUIRE VALUE 'I'. DTSCS44 +00236 88 REQ-CLEAR VALUE 'C'. DTSCS44 +00237 88 REQ-EDIT VALUE 'E'. DTSCS44 +00238 DTSCS44 +00239 05 RESP-IND PIC X(01). DTSCS44 +00240 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS44 +00241 88 RESP-SEND-MAP VALUE 'M'. DTSCS44 +00242 88 RESP-JUMP VALUE 'J'. DTSCS44 +00243 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS44 +00244 DTSCS44 +00245 05 WRK-MSG-AREA PIC X(64). DTSCS44 +00246 DTSCS44 +00247 05 WRK-ATB-AN PIC X(01). DTSCS44 +00248 DTSCS44 +00249 05 WRK-ATB-NUM PIC X(01). DTSCS44 +00250 DTSCS44 +00251 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS44 +00252 DTSCS44 +00253 05 WRK-CERT-NO PIC 9(08). DTSCS44 +00254 DTSCS44 +00255 05 WRK-EDIT-CERT-NO REDEFINES WRK-CERT-NO. DTSCS44 +00256 10 WRK-EDIT-CERT-NO1 PIC 9(04). DTSCS44 +00257 10 WRK-EDIT-CERT-NO2 PIC 9(04). DTSCS44 +00258 DTSCS44 +00259 05 WRK-AMT-DUE PIC S9(09)V9(02) COMP-3. DTSCS44 +00260 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS44 +00261 05 WRK-YRQ-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS44 +00262 05 WRK-YRQ-WRITTEN-OFF-AMT PIC S9(09)V9(02) COMP-3. DTSCS44 +00263 DTSCS44 +00264 05 WRK-STATUS-CD PIC X(01). DTSCS44 +00265 DTSCS44 +00266 05 WRK-STRING PIC X(12) VALUE SPACES. CL*21 +00267 05 WRK-MAP-CURR-TOT-DUE PIC 9(12) VALUE ZERO. CL*21 +00268 CL*18 +00269 05 WRK-SUB PIC S9(04) COMP. DTSCS44 +00270 DTSCS44 +00271 05 MAP-CNT PIC S9(04) COMP. DTSCS44 +00272 05 WRK-SUB2 PIC S9(04) COMP. DTSCS44 00273 DTSCS44 -00274 05 WRK-NO-ENTRY-CTR PIC S9(04) COMP. DTSCS44 +00274 05 WRK-TBL-SUB PIC S9(04) COMP. DTSCS44 00275 DTSCS44 -00276 05 WRK-MPRF-IND PIC X(01). DTSCS44 -00277 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS44 -00278 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS44 +00276 05 WRK-SUB-MINUS-ONE PIC S9(04) COMP. DTSCS44 +00277 DTSCS44 +00278 05 WRK-NO-ENTRY-CTR PIC S9(04) COMP. DTSCS44 00279 DTSCS44 -00280 05 WRK-MLIN-IND PIC X(01). DTSCS44 -00281 88 WRK-MLIN-YES-88 VALUE 'Y'. DTSCS44 -00282 88 WRK-MLIN-NO-88 VALUE 'N'. DTSCS44 +00280 05 WRK-MPRF-IND PIC X(01). DTSCS44 +00281 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS44 +00282 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS44 00283 DTSCS44 -00284 05 WRK-STMT-DATE PIC S9(09) COMP-3. DTSCS44 -00285 05 WRK-CERT-DATE PIC S9(09) COMP-3. DTSCS44 -00286 05 WRK-MAIL-DATE PIC S9(09) COMP-3. DTSCS44 +00284 05 WRK-MLIN-IND PIC X(01). DTSCS44 +00285 88 WRK-MLIN-YES-88 VALUE 'Y'. DTSCS44 +00286 88 WRK-MLIN-NO-88 VALUE 'N'. DTSCS44 00287 DTSCS44 -00288 05 WRK-TBL OCCURS 21 TIMES. DTSCS44 -00289 10 WRK-TBL-QTR PIC S9(05) COMP-3. DTSCS44 -00290 10 WRK-TBL-BALANCE PIC S9(09)V99 COMP-3. DTSCS44 -00291 10 WRK-TBL-RPT-TYPE PIC X(01). DTSCS44 -00292 DTSCS44 -00293 05 WRK-YRQ PIC 9(05). DTSCS44 -00294 05 FILLER REDEFINES WRK-YRQ. DTSCS44 -00295 10 WRK-YRQ-YR PIC 9(04). DTSCS44 -00296 10 WRK-YRQ-Q PIC 9(01). DTSCS44 -00297 DTSCS44 -00298 DTSCS44 -00299 05 WRK-CURR-ANN-YRQ PIC 9(05). DTSCS44 -00300 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSCS44 -00301 10 WRK-CURR-ANN-YR. DTSCS44 -00302 15 WRK-CURR-ANN-CC PIC 9(02). DTSCS44 -00303 15 WRK-CURR-ANN-YY PIC 9(02). DTSCS44 -00304 10 WRK-CURR-ANN-Q PIC 9(01). DTSCS44 -00305 DTSCS44 -00306 05 WRK-DISPLAY PIC 9(11). DTSCS44 -00307 DTSCS44 -00308 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 -00309 10 FILLER PIC X(05). DTSCS44 -00310 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS44 -00311 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS44 -00312 DTSCS44 -00313 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 -00314 10 FILLER PIC X(05). DTSCS44 -00315 10 WRK-DISPLAY-YR PIC X(02). DTSCS44 -00316 10 WRK-DISPLAY-MO PIC X(02). DTSCS44 -00317 10 WRK-DISPLAY-DA PIC X(02). DTSCS44 -00318 DTSCS44 -00319 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 -00320 10 FILLER PIC X(08). DTSCS44 -00321 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS44 -00322 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS44 -00323 DTSCS44 -00324 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 -00325 10 FILLER PIC X(05). DTSCS44 -00326 10 WRK-DISPLAY-CERT-NO-1 PIC X(02). DTSCS44 -00327 10 WRK-DISPLAY-CERT-NO-2 PIC X(04). DTSCS44 -00328 DTSCS44 -00329 DTSCS44 -00330 05 INQUIRY-CONTROL-AREA. DTSCS44 -00331 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS44 -00332 10 WS-REC-NUM PIC S9(08) COMP. DTSCS44 +00288 05 WRK-STMT-DATE PIC S9(09) COMP-3. DTSCS44 +00289 05 WRK-CERT-DATE PIC S9(09) COMP-3. DTSCS44 +00290 05 WRK-MAIL-DATE PIC S9(09) COMP-3. DTSCS44 +00291 DTSCS44 +00292 05 WRK-TBL OCCURS 21 TIMES. DTSCS44 +00293 10 WRK-TBL-QTR PIC S9(05) COMP-3. DTSCS44 +00294 10 WRK-TBL-BALANCE PIC S9(09)V99 COMP-3. DTSCS44 +00295 10 WRK-TBL-RPT-TYPE PIC X(01). DTSCS44 +00296 DTSCS44 +00297 05 WRK-YRQ PIC 9(05). DTSCS44 +00298 05 FILLER REDEFINES WRK-YRQ. DTSCS44 +00299 10 WRK-YRQ-YR PIC 9(04). DTSCS44 +00300 10 WRK-YRQ-Q PIC 9(01). DTSCS44 +00301 DTSCS44 +00302 DTSCS44 +00303 05 WRK-CURR-ANN-YRQ PIC 9(05). DTSCS44 +00304 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSCS44 +00305 10 WRK-CURR-ANN-YR. DTSCS44 +00306 15 WRK-CURR-ANN-CC PIC 9(02). DTSCS44 +00307 15 WRK-CURR-ANN-YY PIC 9(02). DTSCS44 +00308 10 WRK-CURR-ANN-Q PIC 9(01). DTSCS44 +00309 DTSCS44 +00310 05 WRK-DISPLAY PIC 9(11). DTSCS44 +00311 DTSCS44 +00312 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 +00313 10 FILLER PIC X(05). DTSCS44 +00314 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS44 +00315 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS44 +00316 DTSCS44 +00317 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 +00318 10 FILLER PIC X(05). DTSCS44 +00319 10 WRK-DISPLAY-YR PIC X(02). DTSCS44 +00320 10 WRK-DISPLAY-MO PIC X(02). DTSCS44 +00321 10 WRK-DISPLAY-DA PIC X(02). DTSCS44 +00322 DTSCS44 +00323 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 +00324 10 FILLER PIC X(08). DTSCS44 +00325 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS44 +00326 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS44 +00327 DTSCS44 +00328 05 FILLER REDEFINES WRK-DISPLAY. DTSCS44 +00329 10 FILLER PIC X(05). DTSCS44 +00330 10 WRK-DISPLAY-CERT-NO-1 PIC X(02). DTSCS44 +00331 10 WRK-DISPLAY-CERT-NO-2 PIC X(04). DTSCS44 +00332 DTSCS44 00333 DTSCS44 -00334 10 LAST-REC-KEY-AREA PIC X(16). DTSCS44 -00335 10 SCR-REC-KEY-AREA PIC X(16). DTSCS44 -00336 DTSCS44 -00337 10 WS-REC-FOUND-IND PIC X(01). DTSCS44 -00338 DTSCS44 -00339 DTSCS44 -00340 05 EVL-TEXT. DTSCS44 -00341 10 FILLER PIC X(05) VALUE 'LIEN '. DTSCS44 -00342 10 EVL-STATUS-CD-DSCR PIC X(12). DTSCS44 -00343 10 FILLER PIC X(15) DTSCS44 -00344 VALUE 'CERTIFICATE #: '. DTSCS44 -00345 10 EVL-CERTIFICATE-NO PIC 9(02)B9(04). DTSCS44 -00346 EJECT DTSCS44 -00347 01 MSG-LITERALS. DTSCS44 -00348 DTSCS44 -00349 05 MSG-E441-AREA. DTSCS44 -00350 10 FILLER PIC X(04) VALUE 'E441'. DTSCS44 -00351 10 FILLER PIC X(30) DTSCS44 -00352 VALUE 'YRQ MUST BE IN ASCENDING SEQUE'. DTSCS44 -00353 10 FILLER PIC X(30) DTSCS44 -00354 VALUE 'NCE '. DTSCS44 -00355 DTSCS44 -00356 05 MSG-E442-AREA. DTSCS44 -00357 10 FILLER PIC X(04) VALUE 'E442'. DTSCS44 -00358 10 FILLER PIC X(30) DTSCS44 -00359 VALUE 'BALANCE DUE EQUAL TO ZERO '. DTSCS44 -00360 10 FILLER PIC X(30) DTSCS44 -00361 VALUE ' '. DTSCS44 -00362 DTSCS44 -00363 05 MSG-E443-AREA. DTSCS44 -00364 10 FILLER PIC X(04) VALUE 'E443'. DTSCS44 -00365 10 FILLER PIC X(30) DTSCS44 -00366 VALUE 'NOT CONSISTENT WITH EXISTING V'. DTSCS44 -00367 10 FILLER PIC X(30) DTSCS44 -00368 VALUE 'ALUE '. DTSCS44 -00369 DTSCS44 -00370 05 MSG-E444-AREA. DTSCS44 -00371 10 FILLER PIC X(04) VALUE 'E444'. DTSCS44 -00372 10 FILLER PIC X(30) DTSCS44 -00373 VALUE 'STATEMENT MUST PRINT BEFORE OP'. DTSCS44 -00374 10 FILLER PIC X(30) DTSCS44 -00375 VALUE 'EN MAY BE CHANGED TO RELEASE '. DTSCS44 -00376 DTSCS44 -00377 05 MSG-E445-AREA. DTSCS44 -00378 10 FILLER PIC X(04) VALUE 'E445'. DTSCS44 -00379 10 FILLER PIC X(30) DTSCS44 -00380 VALUE 'MORE THAN 20 POTENTIAL QUARTER'. DTSCS44 -00381 10 FILLER PIC X(30) DTSCS44 -00382 VALUE 'S. MANUAL ENTRY REQUIRED '. DTSCS44 -00383 DTSCS44 -00384 05 MSG-E446-AREA. DTSCS44 -00385 10 FILLER PIC X(04) VALUE 'E446'. DTSCS44 -00386 10 FILLER PIC X(30) DTSCS44 -00387 VALUE 'CERT DATE MUST BE GREATER THAN'. DTSCS44 -00388 10 FILLER PIC X(30) DTSCS44 -00389 VALUE ' OR EQUAL TO LIEN DATE '. DTSCS44 -00390 DTSCS44 -00391 05 MSG-E447-AREA. DTSCS44 -00392 10 FILLER PIC X(04) VALUE 'E447'. DTSCS44 -00393 10 FILLER PIC X(30) DTSCS44 -00394 VALUE 'EMPLOYER BALANCE DUE IS EQUAL '. DTSCS44 -00395 10 FILLER PIC X(30) DTSCS44 -00396 VALUE 'TO ZERO '. DTSCS44 -00397 DTSCS44 -00398 05 MSG-E448-AREA. DTSCS44 -00399 10 FILLER PIC X(04) VALUE 'E448'. DTSCS44 -00400 10 FILLER PIC X(30) DTSCS44 -00401 VALUE 'CERTIFIED MAIL DATE MUST BE > '. DTSCS44 -00402 10 FILLER PIC X(30) DTSCS44 -00403 VALUE 'OR = CERTIFICATE DATE '. DTSCS44 -00404 DTSCS44 -00405 05 MSG-E449-AREA. DTSCS44 -00406 10 FILLER PIC X(04) VALUE 'E449'. DTSCS44 -00407 10 FILLER PIC X(30) DTSCS44 -00408 VALUE 'RETURN DATE MUST BE GREATER TH'. DTSCS44 -00409 10 FILLER PIC X(30) DTSCS44 -00410 VALUE 'AN CERTIFIED MAIL DATE '. DTSCS44 -00411 DTSCS44 -00412 05 MSG-E44A-AREA. DTSCS44 -00413 10 FILLER PIC X(04) VALUE 'E44A'. DTSCS44 -00414 10 FILLER PIC X(30) DTSCS44 -00415 VALUE 'PENDING DPC - LIEN NOT ALLOWED'. DTSCS44 -00416 10 FILLER PIC X(30) DTSCS44 -00417 VALUE ' '. DTSCS44 -00418 EJECT DTSCS44 -00419 01 L001-COMM-AREA. DTSCS44 -00420 ++INCLUDE DTSIL001 DTSCS44 -00421 EJECT DTSCS44 -00422 01 L004-COMM-AREA. DTSCS44 -00423 ++INCLUDE DTSIL004 DTSCS44 -00424 EJECT DTSCS44 -00425 01 L005-COMM-AREA. DTSCS44 -00426 ++INCLUDE DTSIL005 DTSCS44 -00427 EJECT DTSCS44 -00428 01 L011-COMM-AREA. DTSCS44 -00429 ++INCLUDE DTSIL011 DTSCS44 -00430 EJECT DTSCS44 -00431 01 L013-COMM-AREA. DTSCS44 -00432 ++INCLUDE DTSIL013 DTSCS44 -00433 EJECT DTSCS44 -00434 01 L015-COMM-AREA. DTSCS44 -00435 ++INCLUDE DTSIL015 DTSCS44 +00334 05 INQUIRY-CONTROL-AREA. DTSCS44 +00335 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS44 +00336 10 WS-REC-NUM PIC S9(08) COMP. DTSCS44 +00337 DTSCS44 +00338 10 LAST-REC-KEY-AREA PIC X(16). DTSCS44 +00339 10 SCR-REC-KEY-AREA PIC X(16). DTSCS44 +00340 DTSCS44 +00341 10 WS-REC-FOUND-IND PIC X(01). DTSCS44 +00342 DTSCS44 +00343 DTSCS44 +00344 05 EVL-TEXT. DTSCS44 +00345 10 FILLER PIC X(05) VALUE 'LIEN '. DTSCS44 +00346 10 EVL-STATUS-CD-DSCR PIC X(12). DTSCS44 +00347 10 FILLER PIC X(15) DTSCS44 +00348 VALUE 'CERTIFICATE #: '. DTSCS44 +00349 10 EVL-CERTIFICATE-NO PIC 9(02)B9(04). DTSCS44 +00350 EJECT DTSCS44 +00351 01 MSG-LITERALS. DTSCS44 +00352 DTSCS44 +00353 05 MSG-E441-AREA. DTSCS44 +00354 10 FILLER PIC X(04) VALUE 'E441'. DTSCS44 +00355 10 FILLER PIC X(30) DTSCS44 +00356 VALUE 'YRQ MUST BE IN ASCENDING SEQUE'. DTSCS44 +00357 10 FILLER PIC X(30) DTSCS44 +00358 VALUE 'NCE '. DTSCS44 +00359 DTSCS44 +00360 05 MSG-E442-AREA. DTSCS44 +00361 10 FILLER PIC X(04) VALUE 'E442'. DTSCS44 +00362 10 FILLER PIC X(30) DTSCS44 +00363 VALUE 'BALANCE DUE EQUAL TO ZERO '. DTSCS44 +00364 10 FILLER PIC X(30) DTSCS44 +00365 VALUE ' '. DTSCS44 +00366 DTSCS44 +00367 05 MSG-E443-AREA. DTSCS44 +00368 10 FILLER PIC X(04) VALUE 'E443'. DTSCS44 +00369 10 FILLER PIC X(30) DTSCS44 +00370 VALUE 'NOT CONSISTENT WITH EXISTING V'. DTSCS44 +00371 10 FILLER PIC X(30) DTSCS44 +00372 VALUE 'ALUE '. DTSCS44 +00373 DTSCS44 +00374 05 MSG-E444-AREA. DTSCS44 +00375 10 FILLER PIC X(04) VALUE 'E444'. DTSCS44 +00376 10 FILLER PIC X(30) DTSCS44 +00377 VALUE 'STATEMENT MUST PRINT BEFORE OP'. DTSCS44 +00378 10 FILLER PIC X(30) DTSCS44 +00379 VALUE 'EN MAY BE CHANGED TO RELEASE '. DTSCS44 +00380 DTSCS44 +00381 05 MSG-E445-AREA. DTSCS44 +00382 10 FILLER PIC X(04) VALUE 'E445'. DTSCS44 +00383 10 FILLER PIC X(30) DTSCS44 +00384 VALUE 'MORE THAN 20 POTENTIAL QUARTER'. DTSCS44 +00385 10 FILLER PIC X(30) DTSCS44 +00386 VALUE 'S. MANUAL ENTRY REQUIRED '. DTSCS44 +00387 DTSCS44 +00388 05 MSG-E446-AREA. DTSCS44 +00389 10 FILLER PIC X(04) VALUE 'E446'. DTSCS44 +00390 10 FILLER PIC X(30) DTSCS44 +00391 VALUE 'CERT DATE MUST BE GREATER THAN'. DTSCS44 +00392 10 FILLER PIC X(30) DTSCS44 +00393 VALUE ' OR EQUAL TO LIEN DATE '. DTSCS44 +00394 DTSCS44 +00395 05 MSG-E447-AREA. DTSCS44 +00396 10 FILLER PIC X(04) VALUE 'E447'. DTSCS44 +00397 10 FILLER PIC X(30) DTSCS44 +00398 VALUE 'EMPLOYER BALANCE DUE IS EQUAL '. DTSCS44 +00399 10 FILLER PIC X(30) DTSCS44 +00400 VALUE 'TO ZERO '. DTSCS44 +00401 DTSCS44 +00402 05 MSG-E448-AREA. DTSCS44 +00403 10 FILLER PIC X(04) VALUE 'E448'. DTSCS44 +00404 10 FILLER PIC X(30) DTSCS44 +00405 VALUE 'CERTIFIED MAIL DATE MUST BE > '. DTSCS44 +00406 10 FILLER PIC X(30) DTSCS44 +00407 VALUE 'OR = CERTIFICATE DATE '. DTSCS44 +00408 DTSCS44 +00409 05 MSG-E449-AREA. DTSCS44 +00410 10 FILLER PIC X(04) VALUE 'E449'. DTSCS44 +00411 10 FILLER PIC X(30) DTSCS44 +00412 VALUE 'RETURN DATE MUST BE GREATER TH'. DTSCS44 +00413 10 FILLER PIC X(30) DTSCS44 +00414 VALUE 'AN CERTIFIED MAIL DATE '. DTSCS44 +00415 DTSCS44 +00416 05 MSG-E44A-AREA. DTSCS44 +00417 10 FILLER PIC X(04) VALUE 'E44A'. DTSCS44 +00418 10 FILLER PIC X(30) DTSCS44 +00419 VALUE 'PENDING DPC - LIEN NOT ALLOWED'. DTSCS44 +00420 10 FILLER PIC X(30) DTSCS44 +00421 VALUE ' '. DTSCS44 +00422 CL*23 +00423 05 MSG-E44B-AREA. CL*23 +00424 10 FILLER PIC X(04) VALUE 'E44B'. CL*23 +00425 10 FILLER PIC X(30) CL*23 +00426 VALUE 'LIEN ALREADY RELEASED--LIEN '. CL*29 +00427 10 FILLER PIC X(30) CL*23 +00428 VALUE 'STATUS CANNOT BE CHANGED '. CL*29 +00429 CL*27 +00430 05 MSG-E44C-AREA. CL*27 +00431 10 FILLER PIC X(04) VALUE 'E44C'. CL*27 +00432 10 FILLER PIC X(30) CL*27 +00433 VALUE 'STAFF CANNOT RELEASE LIEN '. CL*27 +00434 10 FILLER PIC X(30) CL*27 +00435 VALUE 'SYSTEM REQUIREMENT '. CL*27 00436 EJECT DTSCS44 -00437 01 L018-COMM-AREA. DTSCS44 -00438 ++INCLUDE DTSIL018 DTSCS44 +00437 01 L001-COMM-AREA. DTSCS44 +00438 ++INCLUDE DTSIL001 DTSCS44 00439 EJECT DTSCS44 -00440 01 L028-COMM-AREA. DTSCS44 -00441 ++INCLUDE DTSIL028 DTSCS44 +00440 01 L004-COMM-AREA. DTSCS44 +00441 ++INCLUDE DTSIL004 DTSCS44 00442 EJECT DTSCS44 -00443 01 L029-COMM-AREA. DTSCS44 -00444 ++INCLUDE DTSIL029 DTSCS44 +00443 01 L005-COMM-AREA. DTSCS44 +00444 ++INCLUDE DTSIL005 DTSCS44 00445 EJECT DTSCS44 -00446 01 L034-COMM-AREA. DTSCS44 -00447 ++INCLUDE DTSIL034 DTSCS44 +00446 01 L011-COMM-AREA. DTSCS44 +00447 ++INCLUDE DTSIL011 DTSCS44 00448 EJECT DTSCS44 -00449 01 L062-COMM-AREA. DTSCS44 -00450 ++INCLUDE DTSIL062 DTSCS44 +00449 01 L013-COMM-AREA. DTSCS44 +00450 ++INCLUDE DTSIL013 DTSCS44 00451 EJECT DTSCS44 -00452 01 L101-COMM-AREA. DTSCS44 -00453 ++INCLUDE DTSIL101 DTSCS44 +00452 01 L015-COMM-AREA. DTSCS44 +00453 ++INCLUDE DTSIL015 DTSCS44 00454 EJECT DTSCS44 -00455 01 L109-COMM-AREA. DTSCS44 -00456 ++INCLUDE DTSIL109 DTSCS44 +00455 01 L018-COMM-AREA. DTSCS44 +00456 ++INCLUDE DTSIL018 DTSCS44 00457 EJECT DTSCS44 -00458 01 L111-COMM-AREA. DTSCS44 -00459 ++INCLUDE DTSIL111 DTSCS44 +00458 01 L028-COMM-AREA. DTSCS44 +00459 ++INCLUDE DTSIL028 DTSCS44 00460 EJECT DTSCS44 -00461 01 L112-COMM-AREA. DTSCS44 -00462 ++INCLUDE DTSIL112 DTSCS44 +00461 01 L029-COMM-AREA. DTSCS44 +00462 ++INCLUDE DTSIL029 DTSCS44 00463 EJECT DTSCS44 -00464 01 L221-COMM-AREA. DTSCS44 -00465 ++INCLUDE DTSIL221 DTSCS44 +00464 01 L034-COMM-AREA. DTSCS44 +00465 ++INCLUDE DTSIL034 DTSCS44 00466 EJECT DTSCS44 -00467 01 L805-COMM-AREA. DTSCS44 -00468 ++INCLUDE DTSIL805 DTSCS44 +00467 01 L062-COMM-AREA. DTSCS44 +00468 ++INCLUDE DTSIL062 DTSCS44 00469 EJECT DTSCS44 -00470 01 L810-COMM-AREA. DTSCS44 -00471 05 L810-CONTROL-BLOCK. DTSCS44 -00472 ++INCLUDE DTSIL810 DTSCS44 -00473 EJECT DTSCS44 -00474 05 MSKL-REC. DTSCS44 -00475 ++INCLUDE DTSIMSKL DTSCS44 -00476 EJECT DTSCS44 -00477 01 MPRF-REC. DTSCS44 -00478 ++INCLUDE DTSIMPRF DTSCS44 -00479 EJECT DTSCS44 -00480 01 MLIN-REC. DTSCS44 -00481 ++INCLUDE DTSIMLIN DTSCS44 -00482 EJECT DTSCS44 -00483 01 MHDR-REC. DTSCS44 -00484 ++INCLUDE DTSIMHDR DTSCS44 -00485 EJECT DTSCS44 -00486 01 MQTR-REC. DTSCS44 -00487 ++INCLUDE DTSIMQTR DTSCS44 -00488 EJECT DTSCS44 -00489 01 MTCK-REC. DTSCS44 -00490 ++INCLUDE DTSIMTCK DTSCS44 +00470 01 L101-COMM-AREA. DTSCS44 +00471 ++INCLUDE DTSIL101 DTSCS44 +00472 EJECT DTSCS44 +00473 01 L109-COMM-AREA. DTSCS44 +00474 ++INCLUDE DTSIL109 DTSCS44 +00475 EJECT DTSCS44 +00476 01 L111-COMM-AREA. DTSCS44 +00477 ++INCLUDE DTSIL111 DTSCS44 +00478 EJECT DTSCS44 +00479 01 L112-COMM-AREA. DTSCS44 +00480 ++INCLUDE DTSIL112 DTSCS44 +00481 EJECT DTSCS44 +00482 01 L221-COMM-AREA. DTSCS44 +00483 ++INCLUDE DTSIL221 DTSCS44 +00484 EJECT DTSCS44 +00485 01 L805-COMM-AREA. DTSCS44 +00486 ++INCLUDE DTSIL805 DTSCS44 +00487 EJECT DTSCS44 +00488 01 L810-COMM-AREA. DTSCS44 +00489 05 L810-CONTROL-BLOCK. DTSCS44 +00490 ++INCLUDE DTSIL810 DTSCS44 00491 EJECT DTSCS44 -00492 01 MEVL-REC. DTSCS44 -00493 ++INCLUDE DTSIMEVL DTSCS44 +00492 05 MSKL-REC. DTSCS44 +00493 ++INCLUDE DTSIMSKL DTSCS44 00494 EJECT DTSCS44 -00495 01 MOPO-REC. DTSCS44 -00496 ++INCLUDE DTSIMOPO DTSCS44 +00495 01 MPRF-REC. DTSCS44 +00496 ++INCLUDE DTSIMPRF DTSCS44 00497 EJECT DTSCS44 -00498 01 MDPC-REC. DTSCS44 -00499 ++INCLUDE DTSIMDPC DTSCS44 +00498 01 MLIN-REC. DTSCS44 +00499 ++INCLUDE DTSIMLIN DTSCS44 00500 EJECT DTSCS44 -00501 01 R901-REC. DTSCS44 -00502 ++INCLUDE DTSIR901 DTSCS44 +00501 01 MHDR-REC. DTSCS44 +00502 ++INCLUDE DTSIMHDR DTSCS44 00503 EJECT DTSCS44 -00504 01 L825-COMM-AREA. DTSCS44 -00505 05 L825-CONTROL-BLOCK. DTSCS44 -00506 ++INCLUDE DTSIL825 DTSCS44 -00507 DTSCS44 -00508 05 RSKL-REC. DTSCS44 -00509 ++INCLUDE DTSIRSK1 DTSCS44 -00510 EJECT DTSCS44 -00511 01 T011-REC. DTSCS44 -00512 ++INCLUDE DTSIT011 DTSCS44 -00513 EJECT DTSCS44 -00514 01 L851-COMM-AREA. DTSCS44 -00515 ++INCLUDE DTSIL851 DTSCS44 -00516 DTSCS44 -00517 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS44 -00518 ++INCLUDE DTSIS44 DTSCS44 -00519 EJECT DTSCS44 -00520 01 CATB-LITERALS. DTSCS44 -00521 ++INCLUDE DTSICATB DTSCS44 -00522 DTSCS44 -00523 01 CFKD-LITERALS. DTSCS44 -00524 ++INCLUDE DTSICFKD DTSCS44 +00504 01 MQTR-REC. DTSCS44 +00505 ++INCLUDE DTSIMQTR DTSCS44 +00506 EJECT DTSCS44 +00507 01 MTCK-REC. DTSCS44 +00508 ++INCLUDE DTSIMTCK DTSCS44 +00509 EJECT DTSCS44 +00510 01 MEVL-REC. DTSCS44 +00511 ++INCLUDE DTSIMEVL DTSCS44 +00512 EJECT DTSCS44 +00513 01 MOPO-REC. DTSCS44 +00514 ++INCLUDE DTSIMOPO DTSCS44 +00515 EJECT DTSCS44 +00516 01 MDPC-REC. DTSCS44 +00517 ++INCLUDE DTSIMDPC DTSCS44 +00518 EJECT DTSCS44 +00519 01 R901-REC. DTSCS44 +00520 ++INCLUDE DTSIR901 DTSCS44 +00521 EJECT DTSCS44 +00522 01 L825-COMM-AREA. DTSCS44 +00523 05 L825-CONTROL-BLOCK. DTSCS44 +00524 ++INCLUDE DTSIL825 DTSCS44 00525 DTSCS44 -00526 01 CECD-LITERALS. DTSCS44 -00527 ++INCLUDE DTSICECD DTSCS44 -00528 DTSCS44 -00529 01 CPCD-LITERALS. DTSCS44 -00530 ++INCLUDE DTSICPCD DTSCS44 +00526 05 RSKL-REC. DTSCS44 +00527 ++INCLUDE DTSIRSK1 DTSCS44 +00528 EJECT DTSCS44 +00529 01 T011-REC. DTSCS44 +00530 ++INCLUDE DTSIT011 DTSCS44 00531 EJECT DTSCS44 -00532 DTSCS44 -00533 01 MMAX-LITERALS. DTSCS44 -00534 ++INCLUDE DTSIMMAX DTSCS44 -00535 EJECT DTSCS44 -00536 LINKAGE SECTION. DTSCS44 -00537 DTSCS44 -00538 01 DFHCOMMAREA. DTSCS44 -00539 ++INCLUDE DTSILCCM DTSCS44 -00540 EJECT DTSCS44 -00541 ******************************************************************DTSCS44 -00542 * *DTSCS44 -00543 ******************************************************************DTSCS44 -00544 DTSCS44 -00545 PROCEDURE DIVISION. DTSCS44 +00532 01 L851-COMM-AREA. DTSCS44 +00533 ++INCLUDE DTSIL851 DTSCS44 +00534 DTSCS44 +00535 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS44 +00536 ++INCLUDE DTSIS44 DTSCS44 +00537 EJECT DTSCS44 +00538 01 CATB-LITERALS. DTSCS44 +00539 ++INCLUDE DTSICATB DTSCS44 +00540 DTSCS44 +00541 01 CFKD-LITERALS. DTSCS44 +00542 ++INCLUDE DTSICFKD DTSCS44 +00543 DTSCS44 +00544 01 CECD-LITERALS. DTSCS44 +00545 ++INCLUDE DTSICECD DTSCS44 00546 DTSCS44 -00547 MOVE +0 TO WRK-EMP-NO. DTSCS44 -00548 DTSCS44 -00549 SET WRK-MPRF-NO-88 TO TRUE. DTSCS44 +00547 01 CPCD-LITERALS. DTSCS44 +00548 ++INCLUDE DTSICPCD DTSCS44 +00549 EJECT DTSCS44 00550 DTSCS44 -00551 SET WRK-MLIN-NO-88 TO TRUE. DTSCS44 -00552 DTSCS44 -00553 MOVE LOW-VALUES TO MAP-AREA. DTSCS44 -00554 DTSCS44 -00555 SET CURSOR-SET-NO TO TRUE. DTSCS44 -00556 DTSCS44 -00557 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS44 -00558 TO SCR-ACCESS-IND. DTSCS44 -00559 DTSCS44 -00560 MOVE SPACE TO REQ-IND. DTSCS44 -00561 DTSCS44 -00562 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS44 -00563 DTSCS44 -00564 *----------------------------------------------------- DTSCS44 -00565 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS44 -00566 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS44 -00567 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS44 -00568 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS44 -00569 * DTSCS44 -00570 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS44 -00571 * PROCESSED. DTSCS44 -00572 * DTSCS44 -00573 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS44 -00574 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS44 -00575 * WORK STATION OPERATOR. DTSCS44 -00576 *----------------------------------------------------- DTSCS44 +00551 01 MMAX-LITERALS. DTSCS44 +00552 ++INCLUDE DTSIMMAX DTSCS44 +00553 EJECT DTSCS44 +00554 LINKAGE SECTION. DTSCS44 +00555 DTSCS44 +00556 01 DFHCOMMAREA. DTSCS44 +00557 ++INCLUDE DTSILCCM DTSCS44 +00558 EJECT DTSCS44 +00559 ******************************************************************DTSCS44 +00560 * *DTSCS44 +00561 ******************************************************************DTSCS44 +00562 DTSCS44 +00563 PROCEDURE DIVISION. DTSCS44 +00564 DTSCS44 +00565 MOVE +0 TO WRK-EMP-NO. DTSCS44 +00566 DTSCS44 +00567 SET WRK-MPRF-NO-88 TO TRUE. DTSCS44 +00568 DTSCS44 +00569 SET WRK-MLIN-NO-88 TO TRUE. DTSCS44 +00570 DTSCS44 +00571 MOVE LOW-VALUES TO MAP-AREA. DTSCS44 +00572 DTSCS44 +00573 SET CURSOR-SET-NO TO TRUE. DTSCS44 +00574 DTSCS44 +00575 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS44 +00576 TO SCR-ACCESS-IND. DTSCS44 00577 DTSCS44 -00578 MOVE SPACE TO RESP-IND. DTSCS44 +00578 MOVE SPACE TO REQ-IND. DTSCS44 00579 DTSCS44 -00580 IF REQ-ERROR DTSCS44 -00581 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS44 -00582 ELSE DTSCS44 -00583 IF REQ-JUMP DTSCS44 -00584 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS44 -00585 ELSE DTSCS44 -00586 IF REQ-CLEAR DTSCS44 -00587 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS44 -00588 ELSE DTSCS44 -00589 IF REQ-CURSOR-TO-GOTO DTSCS44 -00590 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS44 -00591 ELSE DTSCS44 -00592 IF REQ-INQUIRE DTSCS44 -00593 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS44 -00594 ELSE DTSCS44 -00595 IF REQ-EDIT DTSCS44 -00596 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS44 -00597 ELSE DTSCS44 -00598 IF REQ-UPDATE DTSCS44 -00599 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS44 +00580 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS44 +00581 DTSCS44 +00582 *----------------------------------------------------- DTSCS44 +00583 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS44 +00584 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS44 +00585 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS44 +00586 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS44 +00587 * DTSCS44 +00588 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS44 +00589 * PROCESSED. DTSCS44 +00590 * DTSCS44 +00591 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS44 +00592 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS44 +00593 * WORK STATION OPERATOR. DTSCS44 +00594 *----------------------------------------------------- DTSCS44 +00595 DTSCS44 +00596 MOVE SPACE TO RESP-IND. DTSCS44 +00597 DTSCS44 +00598 IF REQ-ERROR DTSCS44 +00599 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS44 00600 ELSE DTSCS44 -00601 GO TO S899-ABEND. DTSCS44 -00602 DTSCS44 -00603 *----------------------------------------------------- DTSCS44 -00604 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS44 -00605 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS44 -00606 *----------------------------------------------------- DTSCS44 -00607 DTSCS44 -00608 IF RESP-SEND-MAP DTSCS44 -00609 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS44 -00610 SET LCCM-END-TASK-88 TO TRUE DTSCS44 -00611 ELSE DTSCS44 -00612 IF RESP-SEND-MSGONLY DTSCS44 -00613 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS44 -00614 SET LCCM-END-TASK-88 TO TRUE DTSCS44 +00601 IF REQ-JUMP DTSCS44 +00602 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS44 +00603 ELSE DTSCS44 +00604 IF REQ-CLEAR DTSCS44 +00605 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS44 +00606 ELSE DTSCS44 +00607 IF REQ-CURSOR-TO-GOTO DTSCS44 +00608 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS44 +00609 ELSE DTSCS44 +00610 IF REQ-INQUIRE DTSCS44 +00611 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS44 +00612 ELSE DTSCS44 +00613 IF REQ-EDIT DTSCS44 +00614 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS44 00615 ELSE DTSCS44 -00616 IF RESP-JUMP DTSCS44 -00617 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 +00616 IF REQ-UPDATE DTSCS44 +00617 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS44 00618 ELSE DTSCS44 -00619 IF RESP-CURSOR-TO-GOTO DTSCS44 -00620 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS44 -00621 SET LCCM-END-TASK-88 TO TRUE DTSCS44 -00622 ELSE DTSCS44 -00623 GO TO S899-ABEND. DTSCS44 -00624 DTSCS44 -00625 MAINLINE-EXIT. DTSCS44 -00626 DTSCS44 -00627 EXEC CICS DTSCS44 -00628 RETURN DTSCS44 -00629 END-EXEC. DTSCS44 -00630 DTSCS44 -00631 * GOBACK. DTSCS44 -00632 EJECT DTSCS44 -00633 /*****************************************************************DTSCS44 -00634 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS44 -00635 ******************************************************************DTSCS44 -00636 P1000-ANALYZE-REQUEST. DTSCS44 -00637 DTSCS44 -00638 *----------------------------------------------------- DTSCS44 -00639 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS44 -00640 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS44 -00641 * REPLACED WITH ENTER) DTSCS44 -00642 *----------------------------------------------------- DTSCS44 -00643 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS44 -00644 SET LCCM-ENTER-88 TO TRUE DTSCS44 -00645 IF LCCM-EMP-NO > ZERO DTSCS44 -00646 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS44 -00647 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS44 -00648 END-IF DTSCS44 -00649 SET REQ-INQUIRE TO TRUE DTSCS44 -00650 GO TO P1000-EXIT. DTSCS44 -00651 DTSCS44 -00652 *----------------------------------------------------- DTSCS44 -00653 * MAP IS RECEIVED DTSCS44 -00654 *----------------------------------------------------- DTSCS44 -00655 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS44 -00656 DTSCS44 -00657 *----------------------------------------------------- DTSCS44 -00658 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS44 -00659 * WORK STATION DTSCS44 +00619 GO TO S899-ABEND. DTSCS44 +00620 DTSCS44 +00621 *----------------------------------------------------- DTSCS44 +00622 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS44 +00623 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS44 +00624 *----------------------------------------------------- DTSCS44 +00625 DTSCS44 +00626 IF RESP-SEND-MAP DTSCS44 +00627 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS44 +00628 SET LCCM-END-TASK-88 TO TRUE DTSCS44 +00629 ELSE DTSCS44 +00630 IF RESP-SEND-MSGONLY DTSCS44 +00631 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS44 +00632 SET LCCM-END-TASK-88 TO TRUE DTSCS44 +00633 ELSE DTSCS44 +00634 IF RESP-JUMP DTSCS44 +00635 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 +00636 ELSE DTSCS44 +00637 IF RESP-CURSOR-TO-GOTO DTSCS44 +00638 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS44 +00639 SET LCCM-END-TASK-88 TO TRUE DTSCS44 +00640 ELSE DTSCS44 +00641 GO TO S899-ABEND. DTSCS44 +00642 DTSCS44 +00643 MAINLINE-EXIT. DTSCS44 +00644 DTSCS44 +00645 EXEC CICS DTSCS44 +00646 RETURN DTSCS44 +00647 END-EXEC. DTSCS44 +00648 DTSCS44 +00649 * GOBACK. DTSCS44 +00650 EJECT DTSCS44 +00651 /*****************************************************************DTSCS44 +00652 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS44 +00653 ******************************************************************DTSCS44 +00654 P1000-ANALYZE-REQUEST. DTSCS44 +00655 DTSCS44 +00656 *----------------------------------------------------- DTSCS44 +00657 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS44 +00658 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS44 +00659 * REPLACED WITH ENTER) DTSCS44 00660 *----------------------------------------------------- DTSCS44 -00661 IF LCCM-CLEAR-88 DTSCS44 -00662 SET REQ-CLEAR TO TRUE DTSCS44 -00663 GO TO P1000-EXIT. DTSCS44 -00664 DTSCS44 -00665 *----------------------------------------------------- DTSCS44 -00666 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS44 -00667 *----------------------------------------------------- DTSCS44 -00668 IF LCCM-SCR-UPDATE-LOCKED DTSCS44 -00669 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS44 -00670 GO TO P1000-EXIT. DTSCS44 -00671 DTSCS44 +00661 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS44 +00662 SET LCCM-ENTER-88 TO TRUE DTSCS44 +00663 IF LCCM-EMP-NO > ZERO DTSCS44 +00664 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS44 +00665 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS44 +00666 END-IF DTSCS44 +00667 SET REQ-INQUIRE TO TRUE DTSCS44 +00668 GO TO P1000-EXIT. DTSCS44 +00669 DTSCS44 +00670 *----------------------------------------------------- DTSCS44 +00671 * MAP IS RECEIVED DTSCS44 00672 *----------------------------------------------------- DTSCS44 -00673 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS44 -00674 *----------------------------------------------------- DTSCS44 -00675 IF LCCM-PA2-88 DTSCS44 -00676 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS44 -00677 GO TO P1000-EXIT. DTSCS44 -00678 DTSCS44 -00679 *----------------------------------------------------- DTSCS44 -00680 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS44 -00681 *----------------------------------------------------- DTSCS44 -00682 IF LCCM-PA-88 DTSCS44 -00683 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS44 -00684 SET REQ-ERROR TO TRUE DTSCS44 -00685 GO TO P1000-EXIT. DTSCS44 -00686 DTSCS44 -00687 *----------------------------------------------------- DTSCS44 -00688 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS44 -00689 * CLEAR SCREEN DTSCS44 +00673 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS44 +00674 DTSCS44 +00675 *----------------------------------------------------- DTSCS44 +00676 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS44 +00677 * WORK STATION DTSCS44 +00678 *----------------------------------------------------- DTSCS44 +00679 IF LCCM-CLEAR-88 DTSCS44 +00680 SET REQ-CLEAR TO TRUE DTSCS44 +00681 GO TO P1000-EXIT. DTSCS44 +00682 DTSCS44 +00683 *----------------------------------------------------- DTSCS44 +00684 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS44 +00685 *----------------------------------------------------- DTSCS44 +00686 IF LCCM-SCR-UPDATE-LOCKED DTSCS44 +00687 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS44 +00688 GO TO P1000-EXIT. DTSCS44 +00689 DTSCS44 00690 *----------------------------------------------------- DTSCS44 -00691 IF LCCM-F12-88 DTSCS44 -00692 MOVE LOW-VALUES TO MAP-AREA DTSCS44 -00693 SET REQ-CLEAR TO TRUE DTSCS44 -00694 GO TO P1000-EXIT. DTSCS44 -00695 DTSCS44 -00696 *----------------------------------------------------- DTSCS44 -00697 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS44 -00698 *----------------------------------------------------- DTSCS44 -00699 IF LCCM-F03-88 DTSCS44 -00700 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS44 -00701 SET REQ-JUMP TO TRUE DTSCS44 -00702 GO TO P1000-EXIT. DTSCS44 -00703 DTSCS44 -00704 *----------------------------------------------------- DTSCS44 -00705 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS44 -00706 *----------------------------------------------------- DTSCS44 -00707 IF LCCM-F04-88 DTSCS44 -00708 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS44 -00709 SET REQ-JUMP TO TRUE DTSCS44 -00710 GO TO P1000-EXIT. DTSCS44 -00711 DTSCS44 -00712 *--------------------------------------------------------- DTSCS44 -00713 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS44 -00714 * CORRESPONDENCE SCREEN. DTSCS44 -00715 *--------------------------------------------------------- DTSCS44 -00716 DTSCS44 -00717 IF LCCM-F14-88 DTSCS44 -00718 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS44 +00691 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS44 +00692 *----------------------------------------------------- DTSCS44 +00693 IF LCCM-PA2-88 DTSCS44 +00694 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS44 +00695 GO TO P1000-EXIT. DTSCS44 +00696 DTSCS44 +00697 *----------------------------------------------------- DTSCS44 +00698 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS44 +00699 *----------------------------------------------------- DTSCS44 +00700 IF LCCM-PA-88 DTSCS44 +00701 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS44 +00702 SET REQ-ERROR TO TRUE DTSCS44 +00703 GO TO P1000-EXIT. DTSCS44 +00704 DTSCS44 +00705 *----------------------------------------------------- DTSCS44 +00706 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS44 +00707 * CLEAR SCREEN DTSCS44 +00708 *----------------------------------------------------- DTSCS44 +00709 IF LCCM-F12-88 DTSCS44 +00710 MOVE LOW-VALUES TO MAP-AREA DTSCS44 +00711 SET REQ-CLEAR TO TRUE DTSCS44 +00712 GO TO P1000-EXIT. DTSCS44 +00713 DTSCS44 +00714 *----------------------------------------------------- DTSCS44 +00715 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS44 +00716 *----------------------------------------------------- DTSCS44 +00717 IF LCCM-F03-88 DTSCS44 +00718 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS44 00719 SET REQ-JUMP TO TRUE DTSCS44 00720 GO TO P1000-EXIT. DTSCS44 00721 DTSCS44 00722 *----------------------------------------------------- DTSCS44 -00723 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS44 -00724 * REQUESTED SCREEN TYPE DTSCS44 -00725 *----------------------------------------------------- DTSCS44 -00726 * DTSCS44 -00727 * IF LCCM-F19-88 DTSCS44 -00728 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS44 -00729 * SET REQ-JUMP TO TRUE DTSCS44 -00730 * GO TO P1000-EXIT. DTSCS44 -00731 * DTSCS44 -00732 * IF LCCM-F20-88 DTSCS44 -00733 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS44 -00734 * SET REQ-JUMP TO TRUE DTSCS44 -00735 * GO TO P1000-EXIT. DTSCS44 -00736 * DTSCS44 -00737 * IF LCCM-F21-88 DTSCS44 -00738 * MOVE '15' TO LCCM-REQ-SCR-ID DTSCS44 -00739 * SET REQ-JUMP TO TRUE DTSCS44 -00740 * GO TO P1000-EXIT. DTSCS44 -00741 * DTSCS44 -00742 *----------------------------------------------------- DTSCS44 -00743 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS44 -00744 * REQUESTED SCREEN TYPE DTSCS44 -00745 *----------------------------------------------------- DTSCS44 -00746 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS44 -00747 NEXT SENTENCE DTSCS44 -00748 ELSE DTSCS44 -00749 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS44 -00750 SET REQ-JUMP TO TRUE DTSCS44 -00751 GO TO P1000-EXIT. DTSCS44 -00752 DTSCS44 -00753 *----------------------------------------------------- DTSCS44 -00754 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS44 -00755 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS44 -00756 *----------------------------------------------------- DTSCS44 -00757 IF LCCM-F09-88 DTSCS44 -00758 OR LCCM-F10-88 DTSCS44 -00759 *** OR LCCM-F23-88 DTSCS44 -00760 IF SCR-ACCESS-UPDATE DTSCS44 -00761 SET REQ-EDIT TO TRUE DTSCS44 -00762 GO TO P1000-EXIT DTSCS44 -00763 ELSE DTSCS44 -00764 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS44 -00765 SET REQ-ERROR TO TRUE DTSCS44 -00766 GO TO P1000-EXIT. DTSCS44 -00767 DTSCS44 -00768 *----------------------------------------------------- DTSCS44 -00769 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS44 -00770 * OR F8), INDICATE INQUIRY REQUEST DTSCS44 +00723 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS44 +00724 *----------------------------------------------------- DTSCS44 +00725 IF LCCM-F04-88 DTSCS44 +00726 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS44 +00727 SET REQ-JUMP TO TRUE DTSCS44 +00728 GO TO P1000-EXIT. DTSCS44 +00729 DTSCS44 +00730 *--------------------------------------------------------- DTSCS44 +00731 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS44 +00732 * CORRESPONDENCE SCREEN. DTSCS44 +00733 *--------------------------------------------------------- DTSCS44 +00734 DTSCS44 +00735 IF LCCM-F14-88 DTSCS44 +00736 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS44 +00737 SET REQ-JUMP TO TRUE DTSCS44 +00738 GO TO P1000-EXIT. DTSCS44 +00739 DTSCS44 +00740 *----------------------------------------------------- DTSCS44 +00741 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS44 +00742 * REQUESTED SCREEN TYPE DTSCS44 +00743 *----------------------------------------------------- DTSCS44 +00744 * DTSCS44 +00745 * IF LCCM-F19-88 DTSCS44 +00746 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS44 +00747 * SET REQ-JUMP TO TRUE DTSCS44 +00748 * GO TO P1000-EXIT. DTSCS44 +00749 * DTSCS44 +00750 * IF LCCM-F20-88 DTSCS44 +00751 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS44 +00752 * SET REQ-JUMP TO TRUE DTSCS44 +00753 * GO TO P1000-EXIT. DTSCS44 +00754 * DTSCS44 +00755 * IF LCCM-F21-88 DTSCS44 +00756 * MOVE '15' TO LCCM-REQ-SCR-ID DTSCS44 +00757 * SET REQ-JUMP TO TRUE DTSCS44 +00758 * GO TO P1000-EXIT. DTSCS44 +00759 * DTSCS44 +00760 *----------------------------------------------------- DTSCS44 +00761 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS44 +00762 * REQUESTED SCREEN TYPE DTSCS44 +00763 *----------------------------------------------------- DTSCS44 +00764 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS44 +00765 NEXT SENTENCE DTSCS44 +00766 ELSE DTSCS44 +00767 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS44 +00768 SET REQ-JUMP TO TRUE DTSCS44 +00769 GO TO P1000-EXIT. DTSCS44 +00770 DTSCS44 00771 *----------------------------------------------------- DTSCS44 -00772 IF LCCM-INQUIRY-88 DTSCS44 -00773 SET REQ-INQUIRE TO TRUE DTSCS44 -00774 GO TO P1000-EXIT. DTSCS44 -00775 DTSCS44 -00776 *----------------------------------------------------- DTSCS44 -00777 * ANY OTHER KEY IS INVALID DTSCS44 -00778 *----------------------------------------------------- DTSCS44 -00779 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS44 -00780 SET REQ-ERROR TO TRUE. DTSCS44 -00781 P1000-EXIT. DTSCS44 -00782 EXIT. DTSCS44 -00783 DTSCS44 -00784 ******************************************************************DTSCS44 -00785 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS44 -00786 ******************************************************************DTSCS44 -00787 DTSCS44 -00788 P1100-UPDATE-LOCKED. DTSCS44 +00772 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS44 +00773 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS44 +00774 *----------------------------------------------------- DTSCS44 +00775 IF LCCM-F09-88 DTSCS44 +00776 OR LCCM-F10-88 DTSCS44 +00777 *** OR LCCM-F23-88 DTSCS44 +00778 IF SCR-ACCESS-UPDATE DTSCS44 +00779 SET REQ-EDIT TO TRUE DTSCS44 +00780 GO TO P1000-EXIT DTSCS44 +00781 ELSE DTSCS44 +00782 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS44 +00783 SET REQ-ERROR TO TRUE DTSCS44 +00784 GO TO P1000-EXIT. DTSCS44 +00785 DTSCS44 +00786 *----------------------------------------------------- DTSCS44 +00787 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS44 +00788 * OR F8), INDICATE INQUIRY REQUEST DTSCS44 00789 *----------------------------------------------------- DTSCS44 -00790 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS44 -00791 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS44 -00792 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS44 -00793 *----------------------------------------------------- DTSCS44 -00794 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS44 -00795 SET REQ-UPDATE TO TRUE DTSCS44 -00796 ELSE DTSCS44 -00797 SET REQ-ERROR TO TRUE DTSCS44 -00798 IF LCCM-SCR-ADD-LOCKED DTSCS44 -00799 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS44 -00800 ELSE DTSCS44 -00801 IF LCCM-SCR-MOD-LOCKED DTSCS44 -00802 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS44 -00803 *** ELSE DTSCS44 -00804 *** IF LCCM-SCR-DEL-LOCKED DTSCS44 -00805 *** MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS44 -00806 ELSE DTSCS44 -00807 GO TO S899-ABEND. DTSCS44 -00808 P1100-EXIT. DTSCS44 -00809 EXIT. DTSCS44 -00810 /*****************************************************************DTSCS44 -00811 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS44 -00812 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS44 -00813 ******************************************************************DTSCS44 -00814 DTSCS44 -00815 P2000-REQUEST-ERROR. DTSCS44 -00816 IF LCCM-MSG DTSCS44 -00817 SET RESP-SEND-MSGONLY TO TRUE DTSCS44 -00818 ELSE DTSCS44 -00819 GO TO S899-ABEND. DTSCS44 -00820 P2000-EXIT. DTSCS44 -00821 EXIT. DTSCS44 -00822 /*****************************************************************DTSCS44 -00823 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS44 -00824 ******************************************************************DTSCS44 -00825 DTSCS44 -00826 P3000-REQUEST-JUMP. DTSCS44 -00827 *----------------------------------------------------- DTSCS44 -00828 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS44 -00829 * BY USER DTSCS44 -00830 *----------------------------------------------------- DTSCS44 -00831 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS44 +00790 IF LCCM-INQUIRY-88 DTSCS44 +00791 SET REQ-INQUIRE TO TRUE DTSCS44 +00792 GO TO P1000-EXIT. DTSCS44 +00793 DTSCS44 +00794 *----------------------------------------------------- DTSCS44 +00795 * ANY OTHER KEY IS INVALID DTSCS44 +00796 *----------------------------------------------------- DTSCS44 +00797 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS44 +00798 SET REQ-ERROR TO TRUE. DTSCS44 +00799 P1000-EXIT. DTSCS44 +00800 EXIT. DTSCS44 +00801 DTSCS44 +00802 ******************************************************************DTSCS44 +00803 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS44 +00804 ******************************************************************DTSCS44 +00805 DTSCS44 +00806 P1100-UPDATE-LOCKED. DTSCS44 +00807 *----------------------------------------------------- DTSCS44 +00808 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS44 +00809 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS44 +00810 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS44 +00811 *----------------------------------------------------- DTSCS44 +00812 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS44 +00813 SET REQ-UPDATE TO TRUE DTSCS44 +00814 ELSE DTSCS44 +00815 SET REQ-ERROR TO TRUE DTSCS44 +00816 IF LCCM-SCR-ADD-LOCKED DTSCS44 +00817 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS44 +00818 ELSE DTSCS44 +00819 IF LCCM-SCR-MOD-LOCKED DTSCS44 +00820 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS44 +00821 *** ELSE DTSCS44 +00822 *** IF LCCM-SCR-DEL-LOCKED DTSCS44 +00823 *** MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS44 +00824 ELSE DTSCS44 +00825 GO TO S899-ABEND. DTSCS44 +00826 P1100-EXIT. DTSCS44 +00827 EXIT. DTSCS44 +00828 /*****************************************************************DTSCS44 +00829 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS44 +00830 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS44 +00831 ******************************************************************DTSCS44 00832 DTSCS44 -00833 *----------------------------------------------------- DTSCS44 -00834 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS44 -00835 *----------------------------------------------------- DTSCS44 -00836 IF LCCM-MSG DTSCS44 -00837 SET RESP-SEND-MSGONLY TO TRUE DTSCS44 -00838 SET CURSOR-SET-GOTO TO TRUE DTSCS44 -00839 GO TO P3000-EXIT. DTSCS44 -00840 SKIP3 DTSCS44 -00841 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS44 -00842 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS44 -00843 IF L018-VALID DTSCS44 -00844 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS44 -00845 DTSCS44 -00846 *----------------------------------------------------- DTSCS44 -00847 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS44 +00833 P2000-REQUEST-ERROR. DTSCS44 +00834 IF LCCM-MSG DTSCS44 +00835 SET RESP-SEND-MSGONLY TO TRUE DTSCS44 +00836 ELSE DTSCS44 +00837 GO TO S899-ABEND. DTSCS44 +00838 P2000-EXIT. DTSCS44 +00839 EXIT. DTSCS44 +00840 /*****************************************************************DTSCS44 +00841 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS44 +00842 ******************************************************************DTSCS44 +00843 DTSCS44 +00844 P3000-REQUEST-JUMP. DTSCS44 +00845 *----------------------------------------------------- DTSCS44 +00846 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS44 +00847 * BY USER DTSCS44 00848 *----------------------------------------------------- DTSCS44 -00849 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS44 -00850 LCCM-SCR-HOLD-AREA. DTSCS44 -00851 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS44 -00852 SET RESP-JUMP TO TRUE. DTSCS44 -00853 P3000-EXIT. DTSCS44 -00854 EXIT. DTSCS44 -00855 /*****************************************************************DTSCS44 -00856 * CLEAR KEY WAS PRESSED *DTSCS44 -00857 ******************************************************************DTSCS44 -00858 DTSCS44 -00859 P4000-REQUEST-CLEAR. DTSCS44 -00860 DTSCS44 -00861 *----------------------------------------------------- DTSCS44 -00862 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS44 -00863 * FIELDS FROM EARLIER REQUESTS DTSCS44 +00849 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS44 +00850 DTSCS44 +00851 *----------------------------------------------------- DTSCS44 +00852 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS44 +00853 *----------------------------------------------------- DTSCS44 +00854 IF LCCM-MSG DTSCS44 +00855 SET RESP-SEND-MSGONLY TO TRUE DTSCS44 +00856 SET CURSOR-SET-GOTO TO TRUE DTSCS44 +00857 GO TO P3000-EXIT. DTSCS44 +00858 SKIP3 DTSCS44 +00859 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS44 +00860 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS44 +00861 IF L018-VALID DTSCS44 +00862 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS44 +00863 DTSCS44 00864 *----------------------------------------------------- DTSCS44 -00865 IF LCCM-EMP-NO > ZERO DTSCS44 -00866 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS44 -00867 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS44 -00868 DTSCS44 -00869 MOVE ZERO TO LCCM-EMP-NO. DTSCS44 -00870 DTSCS44 -00871 MOVE LOW-VALUES TO LCCM-SCR44-HOLD-AREA. DTSCS44 -00872 DTSCS44 -00873 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 -00874 DTSCS44 -00875 SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 +00865 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS44 +00866 *----------------------------------------------------- DTSCS44 +00867 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS44 +00868 LCCM-SCR-HOLD-AREA. DTSCS44 +00869 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS44 +00870 SET RESP-JUMP TO TRUE. DTSCS44 +00871 P3000-EXIT. DTSCS44 +00872 EXIT. DTSCS44 +00873 /*****************************************************************DTSCS44 +00874 * CLEAR KEY WAS PRESSED *DTSCS44 +00875 ******************************************************************DTSCS44 00876 DTSCS44 -00877 IF SCR-ACCESS-UPDATE DTSCS44 -00878 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS44 -00879 ELSE DTSCS44 -00880 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS44 -00881 DTSCS44 -00882 SET RESP-SEND-MAP TO TRUE. DTSCS44 -00883 P4000-EXIT. DTSCS44 -00884 EXIT. DTSCS44 -00885 /*****************************************************************DTSCS44 -00886 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS44 -00887 ******************************************************************DTSCS44 +00877 P4000-REQUEST-CLEAR. DTSCS44 +00878 DTSCS44 +00879 *----------------------------------------------------- DTSCS44 +00880 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS44 +00881 * FIELDS FROM EARLIER REQUESTS DTSCS44 +00882 *----------------------------------------------------- DTSCS44 +00883 IF LCCM-EMP-NO > ZERO DTSCS44 +00884 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS44 +00885 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS44 +00886 DTSCS44 +00887 MOVE ZERO TO LCCM-EMP-NO. DTSCS44 00888 DTSCS44 -00889 P5000-CURSOR-TO-GOTO. DTSCS44 -00890 SET CURSOR-SET-GOTO TO TRUE. DTSCS44 -00891 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS44 -00892 P5000-EXIT. DTSCS44 -00893 EXIT. DTSCS44 -00894 /*****************************************************************DTSCS44 -00895 * INQUIRY WAS REQUESTED *DTSCS44 -00896 ******************************************************************DTSCS44 -00897 DTSCS44 -00898 P6000-REQUEST-INQUIRE. DTSCS44 -00899 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS44 -00900 MOVE MAP-CURR-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -00901 MOVE LOW-VALUES TO MAP-AREA. DTSCS44 -00902 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS44 -00903 MOVE L015-S-DATE-AREA TO MAP-CURR-COMP-DATE-AREA. DTSCS44 -00904 DTSCS44 -00905 SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 -00906 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 -00907 DTSCS44 -00908 SET RESP-SEND-MAP TO TRUE. DTSCS44 -00909 DTSCS44 -00910 IF SCR-ACCESS-UPDATE DTSCS44 -00911 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS44 -00912 ELSE DTSCS44 -00913 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS44 -00914 DTSCS44 -00915 MOVE LCCM-SCR44-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS44 -00916 MOVE LOW-VALUES TO LCCM-SCR44-HOLD-AREA. DTSCS44 -00917 DTSCS44 -00918 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -00919 IF LCCM-MSG DTSCS44 -00920 GO TO P6000-EXIT. DTSCS44 -00921 DTSCS44 -00922 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS44 -00923 DTSCS44 -00924 PERFORM S2600-CURR-COMP-DATE THRU S2600-EXIT. DTSCS44 -00925 IF LCCM-MSG DTSCS44 -00926 GO TO P6000-EXIT. DTSCS44 +00889 MOVE LOW-VALUES TO LCCM-SCR44-HOLD-AREA. DTSCS44 +00890 DTSCS44 +00891 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 +00892 DTSCS44 +00893 SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 +00894 DTSCS44 +00895 IF SCR-ACCESS-UPDATE DTSCS44 +00896 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS44 +00897 ELSE DTSCS44 +00898 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS44 +00899 DTSCS44 +00900 SET RESP-SEND-MAP TO TRUE. DTSCS44 +00901 P4000-EXIT. DTSCS44 +00902 EXIT. DTSCS44 +00903 /*****************************************************************DTSCS44 +00904 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS44 +00905 ******************************************************************DTSCS44 +00906 DTSCS44 +00907 P5000-CURSOR-TO-GOTO. DTSCS44 +00908 SET CURSOR-SET-GOTO TO TRUE. DTSCS44 +00909 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS44 +00910 P5000-EXIT. DTSCS44 +00911 EXIT. DTSCS44 +00912 /*****************************************************************DTSCS44 +00913 * INQUIRY WAS REQUESTED *DTSCS44 +00914 ******************************************************************DTSCS44 +00915 DTSCS44 +00916 P6000-REQUEST-INQUIRE. DTSCS44 +00917 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS44 +00918 MOVE MAP-CURR-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +00919 MOVE LOW-VALUES TO MAP-AREA. DTSCS44 +00920 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS44 +00921 MOVE L015-S-DATE-AREA TO MAP-CURR-COMP-DATE-AREA. DTSCS44 +00922 DTSCS44 +00923 SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 +00924 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 +00925 DTSCS44 +00926 SET RESP-SEND-MAP TO TRUE. DTSCS44 00927 DTSCS44 -00928 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS44 -00929 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 -00930 SET MSKL-LIN-88 TO TRUE. DTSCS44 -00931 PERFORM S810-COUNT THRU S810-EXIT. DTSCS44 +00928 IF SCR-ACCESS-UPDATE DTSCS44 +00929 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS44 +00930 ELSE DTSCS44 +00931 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS44 00932 DTSCS44 -00933 IF L810-RECORD-CNT = +0 DTSCS44 -00934 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -00935 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -00936 GO TO P6000-EXIT. DTSCS44 -00937 DTSCS44 -00938 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS44 -00939 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS44 -00940 DTSCS44 -00941 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS44 -00942 IF LCCM-MSG DTSCS44 -00943 GO TO P6000-EXIT. DTSCS44 -00944 DTSCS44 -00945 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS44 -00946 DTSCS44 -00947 MOVE MLIN-KEY-AREA TO LCCM-SCR44-HOLD-AREA. DTSCS44 -00948 DTSCS44 -00949 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS44 +00933 MOVE LCCM-SCR44-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS44 +00934 MOVE LOW-VALUES TO LCCM-SCR44-HOLD-AREA. DTSCS44 +00935 DTSCS44 +00936 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +00937 IF LCCM-MSG DTSCS44 +00938 GO TO P6000-EXIT. DTSCS44 +00939 DTSCS44 +00940 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS44 +00941 DTSCS44 +00942 PERFORM S2600-CURR-COMP-DATE THRU S2600-EXIT. DTSCS44 +00943 IF LCCM-MSG DTSCS44 +00944 GO TO P6000-EXIT. DTSCS44 +00945 DTSCS44 +00946 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS44 +00947 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 +00948 SET MSKL-LIN-88 TO TRUE. DTSCS44 +00949 PERFORM S810-COUNT THRU S810-EXIT. DTSCS44 00950 DTSCS44 -00951 IF SCR-ACCESS-UPDATE DTSCS44 -00952 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 -00953 P6000-EXIT. DTSCS44 -00954 EXIT. DTSCS44 -00955 EJECT DTSCS44 -00956 DTSCS44 -00957 P6100-LOCATE-REC. DTSCS44 -00958 *------------------------------------------------------------ DTSCS44 -00959 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS44 -00960 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS44 -00961 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS44 -00962 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS44 -00963 * RECORD WITH THE GREATEST MLIN-ESTB-DATE DTSCS44 -00964 *------------------------------------------------------------ DTSCS44 -00965 DTSCS44 -00966 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS44 -00967 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS44 -00968 GO TO P6100-EXIT. DTSCS44 -00969 DTSCS44 -00970 MOVE SCR-REC-KEY-AREA TO MLIN-KEY-AREA. DTSCS44 -00971 DTSCS44 -00972 IF WRK-EMP-NO = MLIN-EMP-NO DTSCS44 -00973 NEXT SENTENCE DTSCS44 -00974 ELSE DTSCS44 -00975 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS44 -00976 GO TO P6100-EXIT. DTSCS44 -00977 DTSCS44 -00978 IF LCCM-F05-88 DTSCS44 -00979 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS44 -00980 GO TO P6100-EXIT. DTSCS44 -00981 DTSCS44 -00982 IF LCCM-F06-88 DTSCS44 -00983 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS44 -00984 GO TO P6100-EXIT. DTSCS44 -00985 DTSCS44 -00986 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS44 -00987 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 -00988 SET MSKL-LIN-88 TO TRUE. DTSCS44 -00989 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 -00990 IF L810-NO-REC-88 DTSCS44 -00991 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -00992 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -00993 GO TO P6100-EXIT. DTSCS44 -00994 DTSCS44 -00995 MOVE +0 TO WS-REC-NUM. DTSCS44 -00996 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS44 -00997 PERFORM P6190-BROWSE-MLIN THRU P6190-EXIT DTSCS44 -00998 UNTIL (L810-NO-REC-88) DTSCS44 -00999 OR DTSCS44 -01000 (WS-REC-FOUND-IND = 'Y'). DTSCS44 -01001 DTSCS44 -01002 IF L810-NO-REC-88 DTSCS44 -01003 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS44 -01004 GO TO P6100-EXIT. DTSCS44 -01005 DTSCS44 -01006 IF LCCM-ENTER-88 DTSCS44 -01007 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS44 -01008 GO TO P6100-EXIT. DTSCS44 -01009 DTSCS44 -01010 IF LCCM-F07-88 DTSCS44 -01011 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS44 -01012 GO TO P6100-EXIT. DTSCS44 -01013 DTSCS44 -01014 IF LCCM-F08-88 DTSCS44 -01015 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS44 -01016 GO TO P6100-EXIT. DTSCS44 -01017 DTSCS44 -01018 GO TO S899-ABEND. DTSCS44 -01019 P6100-EXIT. DTSCS44 -01020 EXIT. DTSCS44 -01021 DTSCS44 -01022 P6101-DEFAULT-PAGE. DTSCS44 -01023 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS44 -01024 P6101-EXIT. DTSCS44 -01025 EXIT. DTSCS44 -01026 DTSCS44 -01027 P6110-FIRST-REC. DTSCS44 -01028 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS44 -01029 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 -01030 SET MSKL-LIN-88 TO TRUE. DTSCS44 -01031 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 -01032 IF L810-NO-REC-88 DTSCS44 -01033 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -01034 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -01035 GO TO P6110-EXIT. DTSCS44 -01036 DTSCS44 -01037 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 -01038 DTSCS44 -01039 MOVE MSKL-REC TO MLIN-REC. DTSCS44 -01040 DTSCS44 -01041 MOVE +1 TO WS-REC-NUM. DTSCS44 -01042 P6110-EXIT. DTSCS44 +00951 IF L810-RECORD-CNT = +0 DTSCS44 +00952 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +00953 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +00954 GO TO P6000-EXIT. DTSCS44 +00955 DTSCS44 +00956 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS44 +00957 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS44 +00958 DTSCS44 +00959 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS44 +00960 IF LCCM-MSG DTSCS44 +00961 GO TO P6000-EXIT. DTSCS44 +00962 DTSCS44 +00963 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS44 +00964 DTSCS44 +00965 MOVE MLIN-KEY-AREA TO LCCM-SCR44-HOLD-AREA. DTSCS44 +00966 DTSCS44 +00967 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS44 +00968 DTSCS44 +00969 IF SCR-ACCESS-UPDATE DTSCS44 +00970 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 +00971 P6000-EXIT. DTSCS44 +00972 EXIT. DTSCS44 +00973 EJECT DTSCS44 +00974 DTSCS44 +00975 P6100-LOCATE-REC. DTSCS44 +00976 *------------------------------------------------------------ DTSCS44 +00977 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS44 +00978 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS44 +00979 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS44 +00980 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS44 +00981 * RECORD WITH THE GREATEST MLIN-ESTB-DATE DTSCS44 +00982 *------------------------------------------------------------ DTSCS44 +00983 DTSCS44 +00984 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS44 +00985 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS44 +00986 GO TO P6100-EXIT. DTSCS44 +00987 DTSCS44 +00988 MOVE SCR-REC-KEY-AREA TO MLIN-KEY-AREA. DTSCS44 +00989 DTSCS44 +00990 IF WRK-EMP-NO = MLIN-EMP-NO DTSCS44 +00991 NEXT SENTENCE DTSCS44 +00992 ELSE DTSCS44 +00993 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS44 +00994 GO TO P6100-EXIT. DTSCS44 +00995 DTSCS44 +00996 IF LCCM-F05-88 DTSCS44 +00997 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS44 +00998 GO TO P6100-EXIT. DTSCS44 +00999 DTSCS44 +01000 IF LCCM-F06-88 DTSCS44 +01001 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS44 +01002 GO TO P6100-EXIT. DTSCS44 +01003 DTSCS44 +01004 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS44 +01005 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 +01006 SET MSKL-LIN-88 TO TRUE. DTSCS44 +01007 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 +01008 IF L810-NO-REC-88 DTSCS44 +01009 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +01010 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +01011 GO TO P6100-EXIT. DTSCS44 +01012 DTSCS44 +01013 MOVE +0 TO WS-REC-NUM. DTSCS44 +01014 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS44 +01015 PERFORM P6190-BROWSE-MLIN THRU P6190-EXIT DTSCS44 +01016 UNTIL (L810-NO-REC-88) DTSCS44 +01017 OR DTSCS44 +01018 (WS-REC-FOUND-IND = 'Y'). DTSCS44 +01019 DTSCS44 +01020 IF L810-NO-REC-88 DTSCS44 +01021 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS44 +01022 GO TO P6100-EXIT. DTSCS44 +01023 DTSCS44 +01024 IF LCCM-ENTER-88 DTSCS44 +01025 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS44 +01026 GO TO P6100-EXIT. DTSCS44 +01027 DTSCS44 +01028 IF LCCM-F07-88 DTSCS44 +01029 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS44 +01030 GO TO P6100-EXIT. DTSCS44 +01031 DTSCS44 +01032 IF LCCM-F08-88 DTSCS44 +01033 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS44 +01034 GO TO P6100-EXIT. DTSCS44 +01035 DTSCS44 +01036 GO TO S899-ABEND. DTSCS44 +01037 P6100-EXIT. DTSCS44 +01038 EXIT. DTSCS44 +01039 DTSCS44 +01040 P6101-DEFAULT-PAGE. DTSCS44 +01041 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS44 +01042 P6101-EXIT. DTSCS44 01043 EXIT. DTSCS44 01044 DTSCS44 -01045 P6120-PREV-REC. DTSCS44 -01046 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS44 -01047 IF L810-NO-REC-88 DTSCS44 -01048 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -01049 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -01050 GO TO P6120-EXIT. DTSCS44 -01051 DTSCS44 -01052 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS44 -01053 IF L810-NO-REC-88 DTSCS44 -01054 GO TO P6120-EXIT. DTSCS44 -01055 DTSCS44 -01056 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 -01057 DTSCS44 -01058 SUBTRACT 1 FROM WS-REC-NUM. DTSCS44 -01059 DTSCS44 -01060 MOVE MSKL-REC TO MLIN-REC. DTSCS44 -01061 P6120-EXIT. DTSCS44 -01062 EXIT. DTSCS44 -01063 DTSCS44 -01064 P6130-NEXT-REC. DTSCS44 -01065 IF MLIN-KEY-AREA > SCR-REC-KEY-AREA DTSCS44 -01066 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS44 -01067 GO TO P6130-EXIT. DTSCS44 -01068 DTSCS44 -01069 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 -01070 DTSCS44 +01045 P6110-FIRST-REC. DTSCS44 +01046 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS44 +01047 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 +01048 SET MSKL-LIN-88 TO TRUE. DTSCS44 +01049 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 +01050 IF L810-NO-REC-88 DTSCS44 +01051 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +01052 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +01053 GO TO P6110-EXIT. DTSCS44 +01054 DTSCS44 +01055 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 +01056 DTSCS44 +01057 MOVE MSKL-REC TO MLIN-REC. DTSCS44 +01058 DTSCS44 +01059 MOVE +1 TO WS-REC-NUM. DTSCS44 +01060 P6110-EXIT. DTSCS44 +01061 EXIT. DTSCS44 +01062 DTSCS44 +01063 P6120-PREV-REC. DTSCS44 +01064 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS44 +01065 IF L810-NO-REC-88 DTSCS44 +01066 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +01067 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +01068 GO TO P6120-EXIT. DTSCS44 +01069 DTSCS44 +01070 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS44 01071 IF L810-NO-REC-88 DTSCS44 -01072 GO TO P6130-EXIT. DTSCS44 +01072 GO TO P6120-EXIT. DTSCS44 01073 DTSCS44 01074 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 01075 DTSCS44 -01076 ADD +1 TO WS-REC-NUM. DTSCS44 +01076 SUBTRACT 1 FROM WS-REC-NUM. DTSCS44 01077 DTSCS44 01078 MOVE MSKL-REC TO MLIN-REC. DTSCS44 -01079 P6130-EXIT. DTSCS44 +01079 P6120-EXIT. DTSCS44 01080 EXIT. DTSCS44 01081 DTSCS44 -01082 P6140-LAST-REC. DTSCS44 -01083 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -01084 PERFORM S810-READ THRU S810-EXIT. DTSCS44 -01085 IF L810-NO-REC-88 DTSCS44 -01086 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -01087 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -01088 GO TO P6140-EXIT. DTSCS44 -01089 DTSCS44 -01090 MOVE MSKL-REC TO MLIN-REC. DTSCS44 +01082 P6130-NEXT-REC. DTSCS44 +01083 IF MLIN-KEY-AREA > SCR-REC-KEY-AREA DTSCS44 +01084 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS44 +01085 GO TO P6130-EXIT. DTSCS44 +01086 DTSCS44 +01087 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 +01088 DTSCS44 +01089 IF L810-NO-REC-88 DTSCS44 +01090 GO TO P6130-EXIT. DTSCS44 01091 DTSCS44 -01092 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS44 -01093 P6140-EXIT. DTSCS44 -01094 EXIT. DTSCS44 +01092 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 +01093 DTSCS44 +01094 ADD +1 TO WS-REC-NUM. DTSCS44 01095 DTSCS44 -01096 P6190-BROWSE-MLIN. DTSCS44 -01097 MOVE MSKL-REC TO MLIN-REC. DTSCS44 -01098 ADD +1 TO WS-REC-NUM. DTSCS44 -01099 IF MLIN-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS44 -01100 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS44 -01101 ELSE DTSCS44 -01102 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 -01103 P6190-EXIT. DTSCS44 -01104 EXIT. DTSCS44 -01105 /*****************************************************************DTSCS44 -01106 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS44 -01107 ******************************************************************DTSCS44 -01108 DTSCS44 -01109 P6900-CONSTRUCT-SCREEN. DTSCS44 -01110 PERFORM P6910-FROM-MLIN THRU P6910-EXIT. DTSCS44 -01111 DTSCS44 -01112 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS44 -01113 P6900-EXIT. DTSCS44 -01114 EXIT. DTSCS44 -01115 DTSCS44 -01116 P6910-FROM-MLIN. DTSCS44 -01117 MOVE MLIN-STATUS-CD TO MAP-STATUS-CD. DTSCS44 -01118 DTSCS44 -01119 MOVE MLIN-STATUS-DATE TO L001-FED-8-DATE-9. DTSCS44 -01120 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS44 -01121 MOVE L001-SLASH-DATE TO MAP-STATUS-DATE. DTSCS44 -01122 DTSCS44 -01123 MOVE MLIN-STATUS-OP-ID TO MAP-STATUS-OP-ID. DTSCS44 -01124 DTSCS44 -01125 MOVE MLIN-STMT-DATE TO WRK-DISPLAY. DTSCS44 -01126 MOVE WRK-DISPLAY-MO TO MAP-STMT-MO. DTSCS44 -01127 MOVE WRK-DISPLAY-DA TO MAP-STMT-DA. DTSCS44 -01128 MOVE WRK-DISPLAY-YR TO MAP-STMT-YR. DTSCS44 +01096 MOVE MSKL-REC TO MLIN-REC. DTSCS44 +01097 P6130-EXIT. DTSCS44 +01098 EXIT. DTSCS44 +01099 DTSCS44 +01100 P6140-LAST-REC. DTSCS44 +01101 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +01102 PERFORM S810-READ THRU S810-EXIT. DTSCS44 +01103 IF L810-NO-REC-88 DTSCS44 +01104 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +01105 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +01106 GO TO P6140-EXIT. DTSCS44 +01107 DTSCS44 +01108 MOVE MSKL-REC TO MLIN-REC. DTSCS44 +01109 DTSCS44 +01110 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS44 +01111 P6140-EXIT. DTSCS44 +01112 EXIT. DTSCS44 +01113 DTSCS44 +01114 P6190-BROWSE-MLIN. DTSCS44 +01115 MOVE MSKL-REC TO MLIN-REC. DTSCS44 +01116 ADD +1 TO WS-REC-NUM. DTSCS44 +01117 IF MLIN-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS44 +01118 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS44 +01119 ELSE DTSCS44 +01120 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 +01121 P6190-EXIT. DTSCS44 +01122 EXIT. DTSCS44 +01123 /*****************************************************************DTSCS44 +01124 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS44 +01125 ******************************************************************DTSCS44 +01126 DTSCS44 +01127 P6900-CONSTRUCT-SCREEN. DTSCS44 +01128 PERFORM P6910-FROM-MLIN THRU P6910-EXIT. CL*12 01129 DTSCS44 -01130 IF MLIN-CERTIFICATE-DATE > 0 DTSCS44 -01131 MOVE MLIN-CERTIFICATE-DATE TO WRK-DISPLAY DTSCS44 -01132 MOVE WRK-DISPLAY-MO TO MAP-CERT-MO DTSCS44 -01133 MOVE WRK-DISPLAY-DA TO MAP-CERT-DA DTSCS44 -01134 MOVE WRK-DISPLAY-YR TO MAP-CERT-YR. DTSCS44 -01135 DTSCS44 -01136 MOVE MLIN-REC-DEEDS-NO TO MAP-DEED-NO. DTSCS44 -01137 DTSCS44 -01138 MOVE MLIN-CERTFD-MAIL-NO TO MAP-MAIL-NO. DTSCS44 -01139 DTSCS44 -01140 IF MLIN-CERTFD-MAIL-DATE > 0 DTSCS44 -01141 MOVE MLIN-CERTFD-MAIL-DATE TO WRK-DISPLAY DTSCS44 -01142 MOVE WRK-DISPLAY-MO TO MAP-CERT-DATE-MO DTSCS44 -01143 MOVE WRK-DISPLAY-DA TO MAP-CERT-DATE-DA DTSCS44 -01144 MOVE WRK-DISPLAY-YR TO MAP-CERT-DATE-YR. DTSCS44 -01145 DTSCS44 -01146 IF MLIN-RECEIPT-RETURN-DATE > 0 DTSCS44 -01147 MOVE MLIN-RECEIPT-RETURN-DATE TO WRK-DISPLAY DTSCS44 -01148 MOVE WRK-DISPLAY-MO TO MAP-RETURN-DATE-MO DTSCS44 -01149 MOVE WRK-DISPLAY-DA TO MAP-RETURN-DATE-DA DTSCS44 -01150 MOVE WRK-DISPLAY-YR TO MAP-RETURN-DATE-YR. DTSCS44 -01151 DTSCS44 -01152 MOVE MLIN-FLD-REP-ID TO MAP-FLD-REP-ID-CD DTSCS44 -01153 L062-FLD-REP-ID. DTSCS44 -01154 DTSCS44 -01155 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT. DTSCS44 -01156 DTSCS44 -01157 MOVE L062-OP-ID TO MAP-FLD-REP-ID-CD-DSCR. DTSCS44 -01158 DTSCS44 -01159 MOVE MLIN-COMP-DATE TO WRK-DISPLAY. DTSCS44 -01160 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO. DTSCS44 -01161 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA. DTSCS44 -01162 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR. DTSCS44 +01130 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS44 +01131 P6900-EXIT. DTSCS44 +01132 EXIT. DTSCS44 +01133 DTSCS44 +01134 P6910-FROM-MLIN. DTSCS44 +01135 MOVE MLIN-STATUS-CD TO MAP-STATUS-CD. DTSCS44 +01136 DTSCS44 +01137 MOVE MLIN-STATUS-DATE TO L001-FED-8-DATE-9. DTSCS44 +01138 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS44 +01139 MOVE L001-SLASH-DATE TO MAP-STATUS-DATE. DTSCS44 +01140 DTSCS44 +01141 MOVE MLIN-STATUS-OP-ID TO MAP-STATUS-OP-ID. DTSCS44 +01142 DTSCS44 +01143 MOVE MLIN-STMT-DATE TO WRK-DISPLAY. DTSCS44 +01144 MOVE WRK-DISPLAY-MO TO MAP-STMT-MO. DTSCS44 +01145 MOVE WRK-DISPLAY-DA TO MAP-STMT-DA. DTSCS44 +01146 MOVE WRK-DISPLAY-YR TO MAP-STMT-YR. DTSCS44 +01147 DTSCS44 +01148 IF MLIN-CERTIFICATE-DATE > 0 DTSCS44 +01149 MOVE MLIN-CERTIFICATE-DATE TO WRK-DISPLAY DTSCS44 +01150 MOVE WRK-DISPLAY-MO TO MAP-CERT-MO DTSCS44 +01151 MOVE WRK-DISPLAY-DA TO MAP-CERT-DA DTSCS44 +01152 MOVE WRK-DISPLAY-YR TO MAP-CERT-YR. DTSCS44 +01153 DTSCS44 +01154 MOVE MLIN-REC-DEEDS-NO TO MAP-DEED-NO. DTSCS44 +01155 DTSCS44 +01156 MOVE MLIN-CERTFD-MAIL-NO TO MAP-MAIL-NO. DTSCS44 +01157 DTSCS44 +01158 IF MLIN-CERTFD-MAIL-DATE > 0 DTSCS44 +01159 MOVE MLIN-CERTFD-MAIL-DATE TO WRK-DISPLAY DTSCS44 +01160 MOVE WRK-DISPLAY-MO TO MAP-CERT-DATE-MO DTSCS44 +01161 MOVE WRK-DISPLAY-DA TO MAP-CERT-DATE-DA DTSCS44 +01162 MOVE WRK-DISPLAY-YR TO MAP-CERT-DATE-YR. DTSCS44 01163 DTSCS44 -01164 MOVE MLIN-ADDRESS-LINE-1 DTSCS44 -01165 TO MAP-LIEN-ADDR-LINE-1. DTSCS44 -01166 MOVE MLIN-ADDRESS-LINE-2 DTSCS44 -01167 TO MAP-LIEN-ADDR-LINE-2. DTSCS44 -01168 MOVE MLIN-ADDRESS-LINE-3 DTSCS44 -01169 TO MAP-LIEN-ADDR-LINE-3. DTSCS44 -01170 MOVE MLIN-ADDRESS-LINE-4 DTSCS44 -01171 TO MAP-LIEN-ADDR-LINE-4. DTSCS44 -01172 MOVE MLIN-ADDRESS-LINE-5 DTSCS44 -01173 TO MAP-LIEN-ADDR-LINE-5. DTSCS44 +01164 IF MLIN-RECEIPT-RETURN-DATE > 0 DTSCS44 +01165 MOVE MLIN-RECEIPT-RETURN-DATE TO WRK-DISPLAY DTSCS44 +01166 MOVE WRK-DISPLAY-MO TO MAP-RETURN-DATE-MO DTSCS44 +01167 MOVE WRK-DISPLAY-DA TO MAP-RETURN-DATE-DA DTSCS44 +01168 MOVE WRK-DISPLAY-YR TO MAP-RETURN-DATE-YR. DTSCS44 +01169 DTSCS44 +01170 *SRJ MOVE MLIN-FLD-REP-ID TO MAP-FLD-REP-ID-CD CL**4 +01171 *SRJ L062-FLD-REP-ID. CL**4 +01172 DTSCS44 +01173 *SRJ PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT. CL**4 01174 DTSCS44 -01175 DTSCS44 -01176 MOVE MLIN-LICENSE-IND TO MAP-LICENSE-IND. DTSCS44 -01177 DTSCS44 -01178 IF MLIN-STMT-DUE-AMT > +0 DTSCS44 -01179 MOVE MLIN-STMT-DUE-AMT TO MAP-STMT-DUE-AMT-Z. DTSCS44 -01180 DTSCS44 -01181 MOVE MLIN-CERTIFICATE-NO TO WRK-DISPLAY. DTSCS44 -01182 MOVE WRK-DISPLAY-CERT-NO-1 TO MAP-CERT-NUM1. DTSCS44 -01183 MOVE WRK-DISPLAY-CERT-NO-2 TO MAP-CERT-NUM2. DTSCS44 -01184 DTSCS44 -01185 DTSCS44 -01186 MOVE +0 TO WRK-TOT-BALANCE-AMT. DTSCS44 -01187 MOVE +0 TO MAP-CNT. DTSCS44 -01188 MOVE +0 TO WRK-AMT-DUE. DTSCS44 -01189 MOVE 99999 TO WRK-YRQ. DTSCS44 -01190 MOVE +0 TO WRK-CURR-ANN-YR. DTSCS44 -01191 DTSCS44 +01175 *SRJ MOVE L062-OP-ID TO MAP-FLD-REP-ID-CD-DSCR. CL**4 +01176 DTSCS44 +01177 MOVE MLIN-COMP-DATE TO WRK-DISPLAY. DTSCS44 +01178 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO. DTSCS44 +01179 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA. DTSCS44 +01180 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR. DTSCS44 +01181 DTSCS44 +01182 MOVE MLIN-ADDRESS-LINE-1 DTSCS44 +01183 TO MAP-LIEN-ADDR-LINE-1. DTSCS44 +01184 MOVE MLIN-ADDRESS-LINE-2 DTSCS44 +01185 TO MAP-LIEN-ADDR-LINE-2. DTSCS44 +01186 MOVE MLIN-ADDRESS-LINE-3 DTSCS44 +01187 TO MAP-LIEN-ADDR-LINE-3. DTSCS44 +01188 MOVE MLIN-ADDRESS-LINE-4 DTSCS44 +01189 TO MAP-LIEN-ADDR-LINE-4. DTSCS44 +01190 MOVE MLIN-ADDRESS-LINE-5 DTSCS44 +01191 TO MAP-LIEN-ADDR-LINE-5. DTSCS44 01192 DTSCS44 -01193 PERFORM P6911-COVERED-YRQ THRU P6911-EXIT DTSCS44 -01194 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 -01195 UNTIL WRK-SUB > MLIN-COV-CNT. DTSCS44 -01196 DTSCS44 -01197 MOVE WRK-TOT-BALANCE-AMT TO MAP-CURR-TOT-DUE-Z. DTSCS44 +01193 DTSCS44 +01194 MOVE MLIN-LICENSE-IND TO MAP-LICENSE-IND. DTSCS44 +01195 DTSCS44 +01196 IF MLIN-STMT-DUE-AMT > +0 DTSCS44 +01197 MOVE MLIN-STMT-DUE-AMT TO MAP-STMT-DUE-AMT-Z. DTSCS44 01198 DTSCS44 -01199 MOVE MLIN-ESTB-ABSTIME TO L005-ABSTIME. DTSCS44 -01200 SET L005-FROM-ABSTIME TO TRUE. DTSCS44 -01201 PERFORM S005-CDATE-TIME THRU S005-EXIT. DTSCS44 -01202 MOVE L005-DATE-8-SLASH-TIME TO MAP-CREATE-DATE-TIME. DTSCS44 -01203 P6910-EXIT. DTSCS44 -01204 EXIT. DTSCS44 -01205 DTSCS44 -01206 P6911-COVERED-YRQ. DTSCS44 -01207 MOVE ZEROS TO WRK-YRQ. DTSCS44 -01208 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS44 -01209 MOVE MLIN-EMP-NO TO MQTR-EMP-NO. DTSCS44 -01210 SET MQTR-QTR-88 TO TRUE. DTSCS44 -01211 MOVE MLIN-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS44 -01212 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -01213 DTSCS44 -01214 PERFORM S810-READ THRU S810-EXIT. DTSCS44 -01215 DTSCS44 -01216 IF L810-NO-REC-88 DTSCS44 -01217 GO TO P6911-EXIT. DTSCS44 -01218 DTSCS44 -01219 MOVE MSKL-REC TO MQTR-REC. DTSCS44 -01220 DTSCS44 -01221 IF MQTR-ANNUAL-YES-88 DTSCS44 -01222 MOVE MQTR-YRQ TO WRK-YRQ. DTSCS44 +01199 MOVE MLIN-CERTIFICATE-NO TO WRK-DISPLAY. DTSCS44 +01200 MOVE WRK-DISPLAY-CERT-NO-1 TO MAP-CERT-NUM1. DTSCS44 +01201 MOVE WRK-DISPLAY-CERT-NO-2 TO MAP-CERT-NUM2. DTSCS44 +01202 DTSCS44 +01203 DTSCS44 +01204 MOVE +0 TO WRK-TOT-BALANCE-AMT. DTSCS44 +01205 MOVE +0 TO MAP-CNT. DTSCS44 +01206 MOVE +0 TO WRK-AMT-DUE. DTSCS44 +01207 MOVE 99999 TO WRK-YRQ. DTSCS44 +01208 MOVE +0 TO WRK-CURR-ANN-YR. DTSCS44 +01209 DTSCS44 +01210 DTSCS44 +01211 PERFORM P6911-COVERED-YRQ THRU P6911-EXIT DTSCS44 +01212 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 +01213 UNTIL WRK-SUB > MLIN-COV-CNT. DTSCS44 +01214 DTSCS44 +01215 MOVE WRK-TOT-BALANCE-AMT TO MAP-CURR-TOT-DUE-Z. DTSCS44 +01216 DTSCS44 +01217 MOVE MLIN-ESTB-ABSTIME TO L005-ABSTIME. DTSCS44 +01218 SET L005-FROM-ABSTIME TO TRUE. DTSCS44 +01219 PERFORM S005-CDATE-TIME THRU S005-EXIT. DTSCS44 +01220 MOVE L005-DATE-8-SLASH-TIME TO MAP-CREATE-DATE-TIME. DTSCS44 +01221 P6910-EXIT. DTSCS44 +01222 EXIT. DTSCS44 01223 DTSCS44 -01224 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR DTSCS44 -01225 ADD 1 TO MAP-CNT DTSCS44 -01226 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS44 -01227 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS44 -01228 DTSCS44 -01229 PERFORM S4000-INTEREST THRU S4000-EXIT. DTSCS44 -01230 DTSCS44 -01231 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS44 -01232 MOVE ' WRITTEN OFF' TO MAP-AMT-DUE (MAP-CNT) DTSCS44 -01233 ELSE DTSCS44 -01234 IF MQTR-ANNUAL-YES-88 DTSCS44 -01235 ADD WRK-YRQ-BALANCE-AMT TO WRK-AMT-DUE DTSCS44 -01236 MOVE WRK-AMT-DUE TO MAP-AMT-DUE-Z (MAP-CNT) DTSCS44 -01237 ELSE DTSCS44 -01238 MOVE WRK-YRQ-BALANCE-AMT TO MAP-AMT-DUE-Z (MAP-CNT). DTSCS44 -01239 DTSCS44 -01240 IF MLIN-COVERED-YRQ (WRK-SUB) = LCCM-PICKUP-YRQ DTSCS44 -01241 MOVE 'PU' TO MAP-COVERED-YRQ-YR (MAP-CNT) DTSCS44 -01242 MOVE SPACE TO MAP-COVERED-YRQ-Q (MAP-CNT) DTSCS44 -01243 ELSE DTSCS44 -01244 MOVE MLIN-COVERED-YRQ(WRK-SUB) TO WRK-DISPLAY DTSCS44 -01245 IF MQTR-ANNUAL-YES-88 DTSCS44 -01246 MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YR DTSCS44 -01247 MOVE ZERO TO WRK-CURR-ANN-Q DTSCS44 -01248 MOVE WRK-CURR-ANN-YY TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS44 -01249 MOVE '*' TO MAP-COVERED-YRQ-Q(MAP-CNT) DTSCS44 -01250 ELSE DTSCS44 -01251 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS44 -01252 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q(MAP-CNT). DTSCS44 -01253 DTSCS44 -01254 MOVE MQTR-CURR-RPT-TYPE DTSCS44 -01255 TO MAP-CURR-RPT-TYPE (MAP-CNT). DTSCS44 -01256 DTSCS44 -01257 PERFORM P6913-TRANSLATE THRU P6913-EXIT. DTSCS44 -01258 P6911-EXIT. DTSCS44 -01259 EXIT. DTSCS44 -01260 DTSCS44 -01261 P6913-TRANSLATE. DTSCS44 -01262 MOVE MAP-CURR-RPT-TYPE (MAP-CNT) TO MQTR-CURR-RPT-TYPE. DTSCS44 -01263 DTSCS44 -01264 IF MQTR-CURR-RCVD-88 DTSCS44 -01265 MOVE 'R' TO MAP-CURR-RPT-TYPE (MAP-CNT) DTSCS44 -01266 ELSE DTSCS44 -01267 IF MQTR-CURR-MISSING-88 DTSCS44 -01268 MOVE 'M' TO MAP-CURR-RPT-TYPE (MAP-CNT). DTSCS44 -01269 P6913-EXIT. DTSCS44 -01270 EXIT. DTSCS44 +01224 P6911-COVERED-YRQ. DTSCS44 +01225 MOVE ZEROS TO WRK-YRQ. DTSCS44 +01226 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS44 +01227 MOVE MLIN-EMP-NO TO MQTR-EMP-NO. DTSCS44 +01228 SET MQTR-QTR-88 TO TRUE. DTSCS44 +01229 MOVE MLIN-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS44 +01230 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +01231 DTSCS44 +01232 PERFORM S810-READ THRU S810-EXIT. DTSCS44 +01233 DTSCS44 +01234 IF L810-NO-REC-88 DTSCS44 +01235 GO TO P6911-EXIT. DTSCS44 +01236 DTSCS44 +01237 MOVE MSKL-REC TO MQTR-REC. DTSCS44 +01238 DTSCS44 +01239 IF MQTR-ANNUAL-YES-88 DTSCS44 +01240 MOVE MQTR-YRQ TO WRK-YRQ. DTSCS44 +01241 DTSCS44 +01242 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR DTSCS44 +01243 ADD 1 TO MAP-CNT DTSCS44 +01244 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS44 +01245 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS44 +01246 DTSCS44 +01247 PERFORM S4000-INTEREST THRU S4000-EXIT. DTSCS44 +01248 DTSCS44 +01249 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS44 +01250 MOVE ' WRITTEN OFF' TO MAP-AMT-DUE (MAP-CNT) DTSCS44 +01251 ELSE DTSCS44 +01252 IF MQTR-ANNUAL-YES-88 DTSCS44 +01253 ADD WRK-YRQ-BALANCE-AMT TO WRK-AMT-DUE DTSCS44 +01254 MOVE WRK-AMT-DUE TO MAP-AMT-DUE-Z (MAP-CNT) DTSCS44 +01255 ELSE DTSCS44 +01256 MOVE WRK-YRQ-BALANCE-AMT TO MAP-AMT-DUE-Z (MAP-CNT). DTSCS44 +01257 DTSCS44 +01258 IF MLIN-COVERED-YRQ (WRK-SUB) = LCCM-PICKUP-YRQ DTSCS44 +01259 MOVE 'PU' TO MAP-COVERED-YRQ-YR (MAP-CNT) DTSCS44 +01260 MOVE SPACE TO MAP-COVERED-YRQ-Q (MAP-CNT) DTSCS44 +01261 ELSE DTSCS44 +01262 MOVE MLIN-COVERED-YRQ(WRK-SUB) TO WRK-DISPLAY DTSCS44 +01263 IF MQTR-ANNUAL-YES-88 DTSCS44 +01264 MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YR DTSCS44 +01265 MOVE ZERO TO WRK-CURR-ANN-Q DTSCS44 +01266 MOVE WRK-CURR-ANN-YY TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS44 +01267 MOVE '*' TO MAP-COVERED-YRQ-Q(MAP-CNT) DTSCS44 +01268 ELSE DTSCS44 +01269 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS44 +01270 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q(MAP-CNT). DTSCS44 01271 DTSCS44 -01272 P6990-PAGE-NUMBER. DTSCS44 -01273 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS44 -01274 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS44 -01275 DTSCS44 -01276 IF WS-REC-NUM = +1 DTSCS44 -01277 IF LAST-REC-NUM = +1 DTSCS44 -01278 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS44 -01279 ELSE DTSCS44 -01280 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS44 -01281 ELSE DTSCS44 -01282 IF WS-REC-NUM = LAST-REC-NUM DTSCS44 -01283 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS44 -01284 P6990-EXIT. DTSCS44 -01285 EXIT. DTSCS44 -01286 /*****************************************************************DTSCS44 -01287 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS44 -01288 ******************************************************************DTSCS44 +01272 MOVE MQTR-CURR-RPT-TYPE DTSCS44 +01273 TO MAP-CURR-RPT-TYPE (MAP-CNT). DTSCS44 +01274 DTSCS44 +01275 PERFORM P6913-TRANSLATE THRU P6913-EXIT. DTSCS44 +01276 P6911-EXIT. DTSCS44 +01277 EXIT. DTSCS44 +01278 DTSCS44 +01279 P6913-TRANSLATE. DTSCS44 +01280 MOVE MAP-CURR-RPT-TYPE (MAP-CNT) TO MQTR-CURR-RPT-TYPE. DTSCS44 +01281 DTSCS44 +01282 IF MQTR-CURR-RCVD-88 DTSCS44 +01283 MOVE 'R' TO MAP-CURR-RPT-TYPE (MAP-CNT) DTSCS44 +01284 ELSE DTSCS44 +01285 IF MQTR-CURR-MISSING-88 DTSCS44 +01286 MOVE 'M' TO MAP-CURR-RPT-TYPE (MAP-CNT). DTSCS44 +01287 P6913-EXIT. DTSCS44 +01288 EXIT. DTSCS44 01289 DTSCS44 -01290 P7000-REQUEST-EDIT. DTSCS44 -01291 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 -01292 DTSCS44 -01293 IF LCCM-F09-88 DTSCS44 -01294 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS44 -01295 ELSE DTSCS44 -01296 IF LCCM-F10-88 DTSCS44 -01297 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS44 -01298 ELSE DTSCS44 -01299 IF LCCM-F23-88 DTSCS44 -01300 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS44 -01301 ELSE DTSCS44 -01302 GO TO S899-ABEND. DTSCS44 -01303 DTSCS44 -01304 *------------------------------------------------------ DTSCS44 -01305 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS44 -01306 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS44 -01307 * REMAIN IN 'INQUIRE' STATUS. DTSCS44 -01308 *------------------------------------------------------ DTSCS44 -01309 DTSCS44 -01310 IF LCCM-MSG DTSCS44 -01311 NEXT SENTENCE DTSCS44 -01312 ELSE DTSCS44 -01313 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS44 -01314 IF LCCM-F09-88 DTSCS44 -01315 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS44 -01316 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS44 -01317 ELSE DTSCS44 -01318 IF LCCM-F10-88 DTSCS44 -01319 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS44 -01320 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS44 -01321 ELSE DTSCS44 -01322 IF LCCM-F23-88 DTSCS44 -01323 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS44 -01324 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS44 -01325 DTSCS44 -01326 SET RESP-SEND-MAP TO TRUE. DTSCS44 -01327 P7000-EXIT. DTSCS44 -01328 EXIT. DTSCS44 -01329 /*****************************************************************DTSCS44 -01330 * ADD FUNCTION WAS REQUESTED *DTSCS44 -01331 ******************************************************************DTSCS44 -01332 DTSCS44 -01333 P7100-EDIT-ADD. DTSCS44 -01334 *----------------------------------------------------- DTSCS44 -01335 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS44 -01336 *----------------------------------------------------- DTSCS44 -01337 IF NOT LCCM-SCR-CLEAR DTSCS44 -01338 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS44 -01339 GO TO P7100-EXIT. DTSCS44 -01340 DTSCS44 -01341 *----------------------------------------------------- DTSCS44 -01342 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS44 -01343 *----------------------------------------------------- DTSCS44 -01344 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -01345 IF LCCM-MSG DTSCS44 -01346 GO TO P7100-EXIT. DTSCS44 -01347 DTSCS44 -01348 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS44 -01349 P7100-EXIT. DTSCS44 -01350 EXIT. DTSCS44 -01351 /*****************************************************************DTSCS44 -01352 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS44 -01353 ******************************************************************DTSCS44 -01354 DTSCS44 -01355 P7200-EDIT-MOD. DTSCS44 -01356 *----------------------------------------------------- DTSCS44 -01357 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS44 -01358 * INQUIRED DTSCS44 +01290 P6990-PAGE-NUMBER. DTSCS44 +01291 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS44 +01292 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS44 +01293 DTSCS44 +01294 IF WS-REC-NUM = +1 DTSCS44 +01295 IF LAST-REC-NUM = +1 DTSCS44 +01296 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS44 +01297 ELSE DTSCS44 +01298 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS44 +01299 ELSE DTSCS44 +01300 IF WS-REC-NUM = LAST-REC-NUM DTSCS44 +01301 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS44 +01302 P6990-EXIT. DTSCS44 +01303 EXIT. DTSCS44 +01304 /*****************************************************************DTSCS44 +01305 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS44 +01306 ******************************************************************DTSCS44 +01307 DTSCS44 +01308 P7000-REQUEST-EDIT. DTSCS44 +01309 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 +01310 DTSCS44 +01311 IF LCCM-F09-88 DTSCS44 +01312 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS44 +01313 ELSE DTSCS44 +01314 IF LCCM-F10-88 DTSCS44 +01315 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS44 +01316 ELSE DTSCS44 +01317 IF LCCM-F23-88 DTSCS44 +01318 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS44 +01319 ELSE DTSCS44 +01320 GO TO S899-ABEND. DTSCS44 +01321 DTSCS44 +01322 *------------------------------------------------------ DTSCS44 +01323 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS44 +01324 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS44 +01325 * REMAIN IN 'INQUIRE' STATUS. DTSCS44 +01326 *------------------------------------------------------ DTSCS44 +01327 DTSCS44 +01328 IF LCCM-MSG DTSCS44 +01329 NEXT SENTENCE DTSCS44 +01330 ELSE DTSCS44 +01331 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS44 +01332 IF LCCM-F09-88 DTSCS44 +01333 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS44 +01334 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS44 +01335 ELSE DTSCS44 +01336 IF LCCM-F10-88 DTSCS44 +01337 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS44 +01338 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS44 +01339 ELSE DTSCS44 +01340 IF LCCM-F23-88 DTSCS44 +01341 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS44 +01342 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS44 +01343 DTSCS44 +01344 SET RESP-SEND-MAP TO TRUE. DTSCS44 +01345 P7000-EXIT. DTSCS44 +01346 EXIT. DTSCS44 +01347 /*****************************************************************DTSCS44 +01348 * ADD FUNCTION WAS REQUESTED *DTSCS44 +01349 ******************************************************************DTSCS44 +01350 DTSCS44 +01351 P7100-EDIT-ADD. DTSCS44 +01352 *----------------------------------------------------- DTSCS44 +01353 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS44 +01354 *----------------------------------------------------- DTSCS44 +01355 IF NOT LCCM-SCR-CLEAR DTSCS44 +01356 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS44 +01357 GO TO P7100-EXIT. DTSCS44 +01358 DTSCS44 01359 *----------------------------------------------------- DTSCS44 -01360 IF NOT LCCM-SCR-INQUIRE DTSCS44 -01361 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS44 -01362 GO TO P7200-EXIT. DTSCS44 -01363 DTSCS44 -01364 *----------------------------------------------------- DTSCS44 -01365 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS44 -01366 *----------------------------------------------------- DTSCS44 -01367 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -01368 IF LCCM-MSG DTSCS44 -01369 GO TO P7200-EXIT. DTSCS44 -01370 DTSCS44 -01371 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS44 -01372 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS44 -01373 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -01374 GO TO P7200-EXIT. DTSCS44 -01375 DTSCS44 -01376 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS44 -01377 DTSCS44 -01378 P7200-EXIT. DTSCS44 -01379 EXIT. DTSCS44 -01380 /*****************************************************************DTSCS44 -01381 * DELETE FUNCTION WAS REQUESTED *DTSCS44 -01382 ******************************************************************DTSCS44 -01383 DTSCS44 -01384 P7300-EDIT-DEL. DTSCS44 -01385 *----------------------------------------------------- DTSCS44 -01386 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS44 -01387 * INQUIRED DTSCS44 -01388 *----------------------------------------------------- DTSCS44 -01389 IF NOT LCCM-SCR-INQUIRE DTSCS44 -01390 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS44 -01391 GO TO P7300-EXIT. DTSCS44 -01392 DTSCS44 -01393 *----------------------------------------------------- DTSCS44 -01394 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS44 -01395 *----------------------------------------------------- DTSCS44 -01396 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -01397 IF LCCM-MSG DTSCS44 -01398 GO TO P7300-EXIT. DTSCS44 -01399 DTSCS44 -01400 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS44 -01401 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS44 -01402 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS44 -01403 DTSCS44 -01404 P7300-EXIT. DTSCS44 -01405 EXIT. DTSCS44 -01406 /*****************************************************************DTSCS44 -01407 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS44 -01408 ******************************************************************DTSCS44 -01409 DTSCS44 -01410 P8000-REQUEST-UPDATE. DTSCS44 -01411 DTSCS44 -01412 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 -01413 DTSCS44 -01414 IF LCCM-SCR-ADD-LOCKED DTSCS44 -01415 PERFORM P8100-ADD THRU P8100-EXIT DTSCS44 -01416 ELSE DTSCS44 -01417 IF LCCM-SCR-MOD-LOCKED DTSCS44 -01418 PERFORM P8200-MOD THRU P8200-EXIT DTSCS44 -01419 ** ELSE DTSCS44 -01420 ** IF LCCM-SCR-DEL-LOCKED DTSCS44 -01421 ** PERFORM P8300-DEL THRU P8300-EXIT DTSCS44 -01422 ELSE DTSCS44 -01423 GO TO S899-ABEND. DTSCS44 -01424 DTSCS44 -01425 SET RESP-SEND-MAP TO TRUE. DTSCS44 -01426 P8000-EXIT. DTSCS44 -01427 EXIT. DTSCS44 -01428 /*****************************************************************DTSCS44 -01429 * *DTSCS44 -01430 ******************************************************************DTSCS44 +01360 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS44 +01361 *----------------------------------------------------- DTSCS44 +01362 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +01363 IF LCCM-MSG DTSCS44 +01364 GO TO P7100-EXIT. DTSCS44 +01365 DTSCS44 +01366 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS44 +01367 P7100-EXIT. DTSCS44 +01368 EXIT. DTSCS44 +01369 /*****************************************************************DTSCS44 +01370 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS44 +01371 ******************************************************************DTSCS44 +01372 DTSCS44 +01373 P7200-EDIT-MOD. DTSCS44 +01374 *----------------------------------------------------- DTSCS44 +01375 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS44 +01376 * INQUIRED DTSCS44 +01377 *----------------------------------------------------- DTSCS44 +01378 IF NOT LCCM-SCR-INQUIRE DTSCS44 +01379 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS44 +01380 GO TO P7200-EXIT. DTSCS44 +01381 DTSCS44 +01382 *----------------------------------------------------- DTSCS44 +01383 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS44 +01384 *----------------------------------------------------- DTSCS44 +01385 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +01386 IF LCCM-MSG DTSCS44 +01387 GO TO P7200-EXIT. DTSCS44 +01388 DTSCS44 +01389 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS44 +01390 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS44 +01391 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +01392 GO TO P7200-EXIT. DTSCS44 +01393 DTSCS44 +01394 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS44 +01395 DTSCS44 +01396 P7200-EXIT. DTSCS44 +01397 EXIT. DTSCS44 +01398 /*****************************************************************DTSCS44 +01399 * DELETE FUNCTION WAS REQUESTED *DTSCS44 +01400 ******************************************************************DTSCS44 +01401 DTSCS44 +01402 P7300-EDIT-DEL. DTSCS44 +01403 *----------------------------------------------------- DTSCS44 +01404 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS44 +01405 * INQUIRED DTSCS44 +01406 *----------------------------------------------------- DTSCS44 +01407 IF NOT LCCM-SCR-INQUIRE DTSCS44 +01408 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS44 +01409 GO TO P7300-EXIT. DTSCS44 +01410 DTSCS44 +01411 *----------------------------------------------------- DTSCS44 +01412 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS44 +01413 *----------------------------------------------------- DTSCS44 +01414 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +01415 IF LCCM-MSG DTSCS44 +01416 GO TO P7300-EXIT. DTSCS44 +01417 DTSCS44 +01418 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS44 +01419 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS44 +01420 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS44 +01421 DTSCS44 +01422 P7300-EXIT. DTSCS44 +01423 EXIT. DTSCS44 +01424 /*****************************************************************DTSCS44 +01425 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS44 +01426 ******************************************************************DTSCS44 +01427 DTSCS44 +01428 P8000-REQUEST-UPDATE. DTSCS44 +01429 DTSCS44 +01430 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 01431 DTSCS44 -01432 P8100-ADD. DTSCS44 -01433 SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 -01434 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 -01435 DTSCS44 -01436 IF LCCM-F12-88 DTSCS44 -01437 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS44 -01438 GO TO P8100-EXIT. DTSCS44 -01439 DTSCS44 -01440 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -01441 DTSCS44 -01442 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS44 -01443 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS44 -01444 IF LCCM-MSG DTSCS44 -01445 GO TO P8100-EXIT. DTSCS44 -01446 DTSCS44 -01447 *****PERFORM P8190-GET-CERT-NUM THRU P8190-EXIT. DTSCS44 -01448 DTSCS44 -01449 *****IF LCCM-MSG DTSCS44 -01450 ********PERFORM S221-EMP-UNLOCK THRU S221-EXIT DTSCS44 -01451 ********GO TO P8100-EXIT. DTSCS44 -01452 DTSCS44 -01453 *****IF MAP-ADDR-ID-ALL-88 DTSCS44 -01454 *********MOVE LOW-VALUE TO MSKL-KEY-AREA DTSCS44 -01455 *********MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS44 -01456 *********SET MSKL-OPO-88 TO TRUE DTSCS44 -01457 *********PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS44 -01458 *********IF L810-OK-88 DTSCS44 -01459 *************PERFORM P8105-MULTIPLE-LIENS THRU P8105-EXIT DTSCS44 -01460 *********************UNTIL L810-NO-REC-88 DTSCS44 -01461 *********ELSE DTSCS44 -01462 *************PERFORM S899-ABEND THRU S899-EXIT DTSCS44 -01463 *****ELSE DTSCS44 -01464 PERFORM P8110-CONSTRUCT-MLIN THRU P8110-EXIT. DTSCS44 -01465 DTSCS44 -01466 PERFORM P8113-WRITE-R901 THRU P8113-EXIT. DTSCS44 -01467 DTSCS44 -01468 IF MPRF-NO-MLIN-88 DTSCS44 -01469 PERFORM P8120-UPDATE-MPRF THRU P8120-EXIT. DTSCS44 +01432 IF LCCM-SCR-ADD-LOCKED DTSCS44 +01433 PERFORM P8100-ADD THRU P8100-EXIT DTSCS44 +01434 ELSE DTSCS44 +01435 IF LCCM-SCR-MOD-LOCKED DTSCS44 +01436 PERFORM P8200-MOD THRU P8200-EXIT DTSCS44 +01437 ** ELSE DTSCS44 +01438 ** IF LCCM-SCR-DEL-LOCKED DTSCS44 +01439 ** PERFORM P8300-DEL THRU P8300-EXIT DTSCS44 +01440 ELSE DTSCS44 +01441 GO TO S899-ABEND. DTSCS44 +01442 DTSCS44 +01443 SET RESP-SEND-MAP TO TRUE. DTSCS44 +01444 P8000-EXIT. DTSCS44 +01445 EXIT. DTSCS44 +01446 /*****************************************************************DTSCS44 +01447 * *DTSCS44 +01448 ******************************************************************DTSCS44 +01449 DTSCS44 +01450 P8100-ADD. DTSCS44 +01451 SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 +01452 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 +01453 DTSCS44 +01454 IF LCCM-F12-88 DTSCS44 +01455 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS44 +01456 GO TO P8100-EXIT. DTSCS44 +01457 DTSCS44 +01458 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +01459 DTSCS44 +01460 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS44 +01461 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS44 +01462 IF LCCM-MSG DTSCS44 +01463 GO TO P8100-EXIT. DTSCS44 +01464 DTSCS44 +01465 *****PERFORM P8190-GET-CERT-NUM THRU P8190-EXIT. DTSCS44 +01466 DTSCS44 +01467 *****IF LCCM-MSG DTSCS44 +01468 ********PERFORM S221-EMP-UNLOCK THRU S221-EXIT DTSCS44 +01469 ********GO TO P8100-EXIT. DTSCS44 01470 DTSCS44 -01471 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS44 -01472 DTSCS44 -01473 DTSCS44 -01474 MOVE MLIN-KEY-AREA TO LCCM-SCR44-HOLD-AREA. DTSCS44 -01475 SET LCCM-ENTER-88 TO TRUE. DTSCS44 -01476 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS44 -01477 DTSCS44 -01478 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS44 -01479 DTSCS44 -01480 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 -01481 P8100-EXIT. DTSCS44 -01482 EXIT. DTSCS44 -01483 EJECT DTSCS44 -01484 *P8105-MULTIPLE-LIENS. DTSCS44 -01485 *****PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 -01486 *****MOVE MSKL-REC TO MOPO-REC. DTSCS44 -01487 *****SET L112-OPO-ADDR-88 TO TRUE. DTSCS44 -01488 *****SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS44 -01489 DTSCS44 -01490 ***** PER A MEMO FROM RUDY, WHEN USING AN OPO ADDRESS DTSCS44 -01491 ***** AS A "LIEN LETTER" ADDRESS, DO NOT FORMAT DTSCS44 -01492 ***** MPRF-PRIMARY-NAME INTO THE MAILING ADDRESS. 03/28/95 DTSCS44 -01493 DTSCS44 -01494 *****MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS44 +01471 *****IF MAP-ADDR-ID-ALL-88 DTSCS44 +01472 *********MOVE LOW-VALUE TO MSKL-KEY-AREA DTSCS44 +01473 *********MOVE WRK-EMP-NO TO MSKL-EMP-NO DTSCS44 +01474 *********SET MSKL-OPO-88 TO TRUE DTSCS44 +01475 *********PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS44 +01476 *********IF L810-OK-88 DTSCS44 +01477 *************PERFORM P8105-MULTIPLE-LIENS THRU P8105-EXIT DTSCS44 +01478 *********************UNTIL L810-NO-REC-88 DTSCS44 +01479 *********ELSE DTSCS44 +01480 *************PERFORM S899-ABEND THRU S899-EXIT DTSCS44 +01481 *****ELSE DTSCS44 +01482 PERFORM P8110-CONSTRUCT-MLIN THRU P8110-EXIT. DTSCS44 +01483 DTSCS44 +01484 PERFORM P8113-WRITE-R901 THRU P8113-EXIT. DTSCS44 +01485 DTSCS44 +01486 IF MPRF-NO-MLIN-88 DTSCS44 +01487 PERFORM P8120-UPDATE-MPRF THRU P8120-EXIT. DTSCS44 +01488 DTSCS44 +01489 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS44 +01490 DTSCS44 +01491 DTSCS44 +01492 MOVE MLIN-KEY-AREA TO LCCM-SCR44-HOLD-AREA. DTSCS44 +01493 SET LCCM-ENTER-88 TO TRUE. DTSCS44 +01494 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS44 01495 DTSCS44 -01496 *****MOVE SPACE TO L112-PRIMARY-NAME. DTSCS44 +01496 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS44 01497 DTSCS44 -01498 *****IF MOPO-ADDRESS = SPACE OR LOW-VALUE DTSCS44 -01499 *********MOVE WRK-EMP-NO TO L111-EMP-NO DTSCS44 -01500 *********SET L111-LOOKUP-TAD-88 TO TRUE DTSCS44 -01501 *********SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS44 -01502 *********PERFORM S111-ADDR-LOOKUP THRU S111-EXIT DTSCS44 -01503 *********MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSCS44 -01504 *****ELSE DTSCS44 -01505 *********MOVE MOPO-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND DTSCS44 -01506 *********MOVE MOPO-ADDRESS TO L112-ADDRESS. DTSCS44 -01507 *****MOVE MOPO-NAME TO L112-NAME. DTSCS44 -01508 *****MOVE MOPO-TITLE TO L112-TITLE. DTSCS44 -01509 *****PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS44 -01510 *****PERFORM P8110-CONSTRUCT-MLIN THRU P8110-EXIT. DTSCS44 -01511 *****MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -01512 *****PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 -01513 *****IF L810-NO-REC-88 DTSCS44 -01514 *********GO TO P8105-EXIT. DTSCS44 -01515 *****PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 -01516 *P8105-EXIT. EXIT. DTSCS44 -01517 DTSCS44 -01518 P8110-CONSTRUCT-MLIN. DTSCS44 -01519 MOVE LOW-VALUES TO MLIN-REC. DTSCS44 -01520 DTSCS44 -01521 MOVE WRK-EMP-NO TO MLIN-EMP-NO. DTSCS44 -01522 SET MLIN-LIN-88 TO TRUE. DTSCS44 -01523 ADD +1 TO LCCM-TASK-START-ABSTIME. DTSCS44 -01524 MOVE LCCM-TASK-START-ABSTIME TO MLIN-ESTB-ABSTIME. DTSCS44 -01525 DTSCS44 -01526 MOVE ZERO TO MLIN-PURGE-DATE DTSCS44 -01527 MLIN-CERTFD-MAIL-DATE DTSCS44 -01528 MLIN-RECEIPT-RETURN-DATE. DTSCS44 -01529 SET MLIN-NOT-CONVERTED-88 TO TRUE. DTSCS44 -01530 MOVE LCCM-CURR-RUN-DATE TO MLIN-ESTB-DATE. DTSCS44 -01531 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 -01532 DTSCS44 -01533 MOVE MAP-STATUS-CD TO MLIN-STATUS-CD. DTSCS44 -01534 MOVE LCCM-CURR-RUN-DATE TO MLIN-STATUS-DATE. DTSCS44 -01535 MOVE LCCM-OP-ID TO MLIN-STATUS-OP-ID. DTSCS44 -01536 DTSCS44 -01537 MOVE MAP-STMT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -01538 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -01539 MOVE L015-DATE TO MLIN-STMT-DATE. DTSCS44 -01540 DTSCS44 -01541 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -01542 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -01543 MOVE L015-DATE TO MLIN-COMP-DATE. DTSCS44 -01544 DTSCS44 -01545 MOVE MAP-LIEN-ADDR-LINE-1 TO MLIN-ADDRESS-LINE-1. DTSCS44 -01546 MOVE MAP-LIEN-ADDR-LINE-2 TO MLIN-ADDRESS-LINE-2. DTSCS44 -01547 MOVE MAP-LIEN-ADDR-LINE-3 TO MLIN-ADDRESS-LINE-3. DTSCS44 -01548 MOVE MAP-LIEN-ADDR-LINE-4 TO MLIN-ADDRESS-LINE-4. DTSCS44 -01549 MOVE MAP-LIEN-ADDR-LINE-5 TO MLIN-ADDRESS-LINE-5. DTSCS44 +01498 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 +01499 P8100-EXIT. DTSCS44 +01500 EXIT. DTSCS44 +01501 EJECT DTSCS44 +01502 *P8105-MULTIPLE-LIENS. DTSCS44 +01503 *****PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 +01504 *****MOVE MSKL-REC TO MOPO-REC. DTSCS44 +01505 *****SET L112-OPO-ADDR-88 TO TRUE. DTSCS44 +01506 *****SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS44 +01507 DTSCS44 +01508 ***** PER A MEMO FROM RUDY, WHEN USING AN OPO ADDRESS DTSCS44 +01509 ***** AS A "LIEN LETTER" ADDRESS, DO NOT FORMAT DTSCS44 +01510 ***** MPRF-PRIMARY-NAME INTO THE MAILING ADDRESS. 03/28/95 DTSCS44 +01511 DTSCS44 +01512 *****MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS44 +01513 DTSCS44 +01514 *****MOVE SPACE TO L112-PRIMARY-NAME. DTSCS44 +01515 DTSCS44 +01516 *****IF MOPO-ADDRESS = SPACE OR LOW-VALUE DTSCS44 +01517 *********MOVE WRK-EMP-NO TO L111-EMP-NO DTSCS44 +01518 *********SET L111-LOOKUP-TAD-88 TO TRUE DTSCS44 +01519 *********SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS44 +01520 *********PERFORM S111-ADDR-LOOKUP THRU S111-EXIT DTSCS44 +01521 *********MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSCS44 +01522 *****ELSE DTSCS44 +01523 *********MOVE MOPO-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND DTSCS44 +01524 *********MOVE MOPO-ADDRESS TO L112-ADDRESS. DTSCS44 +01525 *****MOVE MOPO-NAME TO L112-NAME. DTSCS44 +01526 *****MOVE MOPO-TITLE TO L112-TITLE. DTSCS44 +01527 *****PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS44 +01528 *****PERFORM P8110-CONSTRUCT-MLIN THRU P8110-EXIT. DTSCS44 +01529 *****MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +01530 *****PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 +01531 *****IF L810-NO-REC-88 DTSCS44 +01532 *********GO TO P8105-EXIT. DTSCS44 +01533 *****PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 +01534 *P8105-EXIT. EXIT. DTSCS44 +01535 DTSCS44 +01536 P8110-CONSTRUCT-MLIN. DTSCS44 +01537 MOVE LOW-VALUES TO MLIN-REC. DTSCS44 +01538 DTSCS44 +01539 MOVE WRK-EMP-NO TO MLIN-EMP-NO. DTSCS44 +01540 SET MLIN-LIN-88 TO TRUE. DTSCS44 +01541 ADD +1 TO LCCM-TASK-START-ABSTIME. DTSCS44 +01542 MOVE LCCM-TASK-START-ABSTIME TO MLIN-ESTB-ABSTIME. DTSCS44 +01543 DTSCS44 +01544 MOVE ZERO TO MLIN-PURGE-DATE DTSCS44 +01545 MLIN-CERTFD-MAIL-DATE DTSCS44 +01546 MLIN-RECEIPT-RETURN-DATE. DTSCS44 +01547 SET MLIN-NOT-CONVERTED-88 TO TRUE. DTSCS44 +01548 MOVE LCCM-CURR-RUN-DATE TO MLIN-ESTB-DATE. DTSCS44 +01549 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 01550 DTSCS44 -01551 MOVE MAP-LICENSE-IND TO MLIN-LICENSE-IND. DTSCS44 -01552 DTSCS44 -01553 MOVE MAP-FLD-REP-ID-CD TO MLIN-FLD-REP-ID. DTSCS44 +01551 MOVE MAP-STATUS-CD TO MLIN-STATUS-CD. DTSCS44 +01552 MOVE LCCM-CURR-RUN-DATE TO MLIN-STATUS-DATE. DTSCS44 +01553 MOVE LCCM-OP-ID TO MLIN-STATUS-OP-ID. DTSCS44 01554 DTSCS44 -01555 IF MAP-STATUS-CD = 'C' DTSCS44 -01556 MOVE MAP-CERTIFICATE-NUM-AREA TO L028-S-NO-AREA DTSCS44 -01557 PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT DTSCS44 -01558 MOVE L028-NO TO MLIN-CERTIFICATE-NO DTSCS44 -01559 ELSE DTSCS44 -01560 PERFORM P8190-GET-CERT-NUM THRU P8190-EXIT DTSCS44 -01561 MOVE WRK-CERT-NO TO MLIN-CERTIFICATE-NO. DTSCS44 +01555 MOVE MAP-STMT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +01556 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +01557 MOVE L015-DATE TO MLIN-STMT-DATE. DTSCS44 +01558 DTSCS44 +01559 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +01560 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +01561 MOVE L015-DATE TO MLIN-COMP-DATE. DTSCS44 01562 DTSCS44 -01563 MOVE MAP-CERT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -01564 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -01565 MOVE L015-DATE TO MLIN-CERTIFICATE-DATE. DTSCS44 -01566 DTSCS44 -01567 MOVE +0 TO MLIN-STMT-DUE-AMT. DTSCS44 +01563 MOVE MAP-LIEN-ADDR-LINE-1 TO MLIN-ADDRESS-LINE-1. DTSCS44 +01564 MOVE MAP-LIEN-ADDR-LINE-2 TO MLIN-ADDRESS-LINE-2. DTSCS44 +01565 MOVE MAP-LIEN-ADDR-LINE-3 TO MLIN-ADDRESS-LINE-3. DTSCS44 +01566 MOVE MAP-LIEN-ADDR-LINE-4 TO MLIN-ADDRESS-LINE-4. DTSCS44 +01567 MOVE MAP-LIEN-ADDR-LINE-5 TO MLIN-ADDRESS-LINE-5. DTSCS44 01568 DTSCS44 -01569 IF MLIN-STATUS-CONV-88 OR MLIN-STATUS-MANUAL-88 DTSCS44 -01570 MOVE MAP-STMT-DUE-AMT-AREA TO L011-S-AMT-AREA DTSCS44 -01571 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT DTSCS44 -01572 MOVE L011-AMT TO MLIN-STMT-DUE-AMT. DTSCS44 -01573 DTSCS44 -01574 MOVE +0 TO MLIN-COV-CNT. DTSCS44 -01575 DTSCS44 -01576 PERFORM P8111-COVERED-YRQ-LOOP THRU P8111-EXIT DTSCS44 -01577 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 -01578 UNTIL WRK-SUB > MMAX-LIN-COV-MAX. DTSCS44 -01579 DTSCS44 -01580 MOVE MLIN-REC TO MSKL-REC. DTSCS44 -01581 PERFORM S810-WRITE THRU S810-EXIT. DTSCS44 -01582 DTSCS44 -01583 PERFORM P8112-OPEN-ADD THRU P8112-EXIT. DTSCS44 -01584 P8110-EXIT. EXIT. DTSCS44 -01585 DTSCS44 -01586 P8111-COVERED-YRQ-LOOP. DTSCS44 -01587 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS44 -01588 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS44 -01589 DTSCS44 -01590 IF L029-VALID DTSCS44 -01591 ADD +1 TO MLIN-COV-CNT DTSCS44 -01592 MOVE L029-YRQ TO MLIN-COVERED-YRQ (MLIN-COV-CNT). DTSCS44 -01593 P8111-EXIT. DTSCS44 -01594 EXIT. DTSCS44 -01595 DTSCS44 -01596 P8112-OPEN-ADD. DTSCS44 -01597 IF MLIN-STATUS-OPEN-88 DTSCS44 -01598 MOVE MLIN-EMP-NO TO T011-EMP-NO DTSCS44 -01599 MOVE LCCM-OP-ID TO T011-OP-ID DTSCS44 -01600 MOVE WRK-SCR-ID TO T011-SCR-ID DTSCS44 -01601 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE DTSCS44 -01602 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME DTSCS44 -01603 SET T011-LIN-PKG TO TRUE DTSCS44 -01604 MOVE MAP-FLD-REP-ID-CD TO L062-FLD-REP-ID DTSCS44 -01605 DTSCS44 -01606 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS44 +01569 MOVE MAP-LICENSE-IND TO MLIN-LICENSE-IND. DTSCS44 +01570 DTSCS44 +01571 *SRJ MOVE MAP-FLD-REP-ID-CD TO MLIN-FLD-REP-ID. CL**4 +01572 DTSCS44 +01573 IF MAP-STATUS-CD = 'C' DTSCS44 +01574 MOVE MAP-CERTIFICATE-NUM-AREA TO L028-S-NO-AREA DTSCS44 +01575 PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT DTSCS44 +01576 MOVE L028-NO TO MLIN-CERTIFICATE-NO DTSCS44 +01577 ELSE DTSCS44 +01578 PERFORM P8190-GET-CERT-NUM THRU P8190-EXIT DTSCS44 +01579 MOVE WRK-CERT-NO TO MLIN-CERTIFICATE-NO. DTSCS44 +01580 DTSCS44 +01581 MOVE MAP-CERT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +01582 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +01583 MOVE L015-DATE TO MLIN-CERTIFICATE-DATE. DTSCS44 +01584 DTSCS44 +01585 MOVE +0 TO MLIN-STMT-DUE-AMT. DTSCS44 +01586 DTSCS44 +01587 IF MLIN-STATUS-CONV-88 OR MLIN-STATUS-MANUAL-88 DTSCS44 +01588 MOVE MAP-STMT-DUE-AMT-AREA TO L011-S-AMT-AREA DTSCS44 +01589 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT DTSCS44 +01590 MOVE L011-AMT TO MLIN-STMT-DUE-AMT. DTSCS44 +01591 DTSCS44 +01592 MOVE +0 TO MLIN-COV-CNT. DTSCS44 +01593 DTSCS44 +01594 PERFORM P8111-COVERED-YRQ-LOOP THRU P8111-EXIT DTSCS44 +01595 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 +01596 UNTIL WRK-SUB > MMAX-LIN-COV-MAX. DTSCS44 +01597 DTSCS44 +01598 MOVE MLIN-REC TO MSKL-REC. DTSCS44 +01599 PERFORM S810-WRITE THRU S810-EXIT. DTSCS44 +01600 DTSCS44 +01601 PERFORM P8112-OPEN-ADD THRU P8112-EXIT. DTSCS44 +01602 P8110-EXIT. EXIT. DTSCS44 +01603 DTSCS44 +01604 P8111-COVERED-YRQ-LOOP. DTSCS44 +01605 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS44 +01606 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS44 01607 DTSCS44 -01608 MOVE ZEROS TO T011-START-YRQ DTSCS44 -01609 T011-END-YRQ DTSCS44 -01610 T011-BATCH-NO DTSCS44 -01611 T011-ITEM-NO DTSCS44 -01612 MOVE L062-OP-ID TO T011-RESP-OP-ID DTSCS44 -01613 MOVE MLIN-ESTB-ABSTIME TO T011-ESTB-ABSTIME DTSCS44 -01614 MOVE LENGTH OF T011-REC TO T011-LENGTH DTSCS44 -01615 MOVE T011-REC TO RSKL-REC DTSCS44 -01616 PERFORM S825-WRITE THRU S825-EXIT. DTSCS44 -01617 DTSCS44 -01618 IF MLIN-CERTIFICATE-DATE = +0 DTSCS44 -01619 MOVE LOW-VALUES TO MTCK-REC DTSCS44 -01620 MOVE MPRF-EMP-NO TO MTCK-EMP-NO DTSCS44 -01621 SET MTCK-TCK-88 TO TRUE DTSCS44 -01622 MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME DTSCS44 +01608 IF L029-VALID DTSCS44 +01609 ADD +1 TO MLIN-COV-CNT DTSCS44 +01610 MOVE L029-YRQ TO MLIN-COVERED-YRQ (MLIN-COV-CNT). DTSCS44 +01611 P8111-EXIT. DTSCS44 +01612 EXIT. DTSCS44 +01613 DTSCS44 +01614 P8112-OPEN-ADD. DTSCS44 +01615 IF MLIN-STATUS-OPEN-88 DTSCS44 +01616 MOVE MLIN-EMP-NO TO T011-EMP-NO DTSCS44 +01617 MOVE LCCM-OP-ID TO T011-OP-ID DTSCS44 +01618 MOVE WRK-SCR-ID TO T011-SCR-ID DTSCS44 +01619 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE DTSCS44 +01620 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME DTSCS44 +01621 SET T011-LIN-PKG TO TRUE DTSCS44 +01622 *SRJ MOVE MAP-FLD-REP-ID-CD TO L062-FLD-REP-ID CL**4 01623 DTSCS44 -01624 SET MTCK-TYPE-LIEN-88 TO TRUE DTSCS44 +01624 *SRJ PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT CL**4 01625 DTSCS44 -01626 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSCS44 -01627 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS44 -01628 ADD +14 TO L001-JUL-ABS-DAY DTSCS44 -01629 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSCS44 -01630 MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE DTSCS44 -01631 DTSCS44 -01632 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE DTSCS44 -01633 DTSCS44 -01634 SET MTCK-SOURCE-SYSTEM-88 TO TRUE DTSCS44 +01626 MOVE ZEROS TO T011-START-YRQ DTSCS44 +01627 T011-END-YRQ DTSCS44 +01628 T011-BATCH-NO DTSCS44 +01629 T011-ITEM-NO DTSCS44 +01630 *SRJ MOVE L062-OP-ID TO T011-RESP-OP-ID CL**4 +01631 MOVE MLIN-ESTB-ABSTIME TO T011-ESTB-ABSTIME DTSCS44 +01632 MOVE LENGTH OF T011-REC TO T011-LENGTH DTSCS44 +01633 MOVE T011-REC TO RSKL-REC DTSCS44 +01634 PERFORM S825-WRITE THRU S825-EXIT. DTSCS44 01635 DTSCS44 -01636 SET MTCK-DEST-SYSTEM-88 TO TRUE DTSCS44 -01637 DTSCS44 -01638 MOVE MLIN-ESTB-ABSTIME TO MTCK-L01-ESTB-ABSTIME DTSCS44 -01639 DTSCS44 -01640 SET MTCK-NOT-CONVERTED-88 TO TRUE DTSCS44 +01636 IF MLIN-CERTIFICATE-DATE = +0 DTSCS44 +01637 MOVE LOW-VALUES TO MTCK-REC DTSCS44 +01638 MOVE MPRF-EMP-NO TO MTCK-EMP-NO DTSCS44 +01639 SET MTCK-TCK-88 TO TRUE DTSCS44 +01640 MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME DTSCS44 01641 DTSCS44 -01642 MOVE +0 TO MTCK-TEXT-CNT DTSCS44 +01642 SET MTCK-TYPE-LIEN-88 TO TRUE DTSCS44 01643 DTSCS44 -01644 MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSCS44 -01645 MTCK-CHNG-DATE DTSCS44 -01646 DTSCS44 -01647 MOVE MTCK-REC TO MSKL-REC DTSCS44 -01648 DTSCS44 -01649 PERFORM S810-WRITE THRU S810-EXIT. DTSCS44 -01650 P8112-EXIT. DTSCS44 -01651 EXIT. DTSCS44 -01652 DTSCS44 -01653 P8113-WRITE-R901. DTSCS44 -01654 DTSCS44 -01655 SET R901-ON-REQUEST-88 TO TRUE. DTSCS44 -01656 MOVE +1 TO R901-LABEL-CNT. DTSCS44 -01657 MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS44 -01658 MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS44 -01659 R901-EMP-NO. DTSCS44 -01660 MOVE MAP-FLD-REP-ID-CD-DSCR TO R901-GRP1-OP-ID. DTSCS44 -01661 MOVE MAP-LIEN-ADDR-LINE-1 TO R901-FMT-LINE(1). DTSCS44 -01662 MOVE MAP-LIEN-ADDR-LINE-2 TO R901-FMT-LINE(2). DTSCS44 -01663 MOVE MAP-LIEN-ADDR-LINE-3 TO R901-FMT-LINE(3). DTSCS44 -01664 MOVE MAP-LIEN-ADDR-LINE-4 TO R901-FMT-LINE(4). DTSCS44 -01665 MOVE MAP-LIEN-ADDR-LINE-5 TO R901-FMT-LINE(5). DTSCS44 -01666 MOVE LENGTH OF R901-REC TO R901-LENGTH. DTSCS44 -01667 MOVE R901-REC TO RSKL-REC. DTSCS44 -01668 PERFORM S825-WRITE THRU S825-EXIT. DTSCS44 -01669 P8113-EXIT. DTSCS44 -01670 EXIT. DTSCS44 -01671 DTSCS44 -01672 P8120-UPDATE-MPRF. DTSCS44 -01673 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS44 -01674 DTSCS44 -01675 SET MPRF-MLIN-EXISTS-88 TO TRUE. DTSCS44 -01676 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS44 -01677 MOVE MPRF-REC TO MSKL-REC. DTSCS44 -01678 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS44 -01679 P8120-EXIT. DTSCS44 -01680 EXIT. DTSCS44 -01681 DTSCS44 -01682 P8190-GET-CERT-NUM. DTSCS44 -01683 IF MAP-STATUS-CD = 'C' DTSCS44 -01684 GO TO P8190-EXIT. DTSCS44 -01685 DTSCS44 -01686 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSCS44 -01687 MOVE +0 TO MHDR-EMP-NO. DTSCS44 -01688 SET MHDR-HDR-88 TO TRUE. DTSCS44 -01689 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -01690 PERFORM S810-READ-UPDATE THRU S810-EXIT. DTSCS44 -01691 IF L810-NO-REC-88 DTSCS44 -01692 GO TO S899-ABEND. DTSCS44 +01644 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSCS44 +01645 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS44 +01646 ADD +14 TO L001-JUL-ABS-DAY DTSCS44 +01647 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSCS44 +01648 MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE DTSCS44 +01649 DTSCS44 +01650 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE DTSCS44 +01651 DTSCS44 +01652 SET MTCK-SOURCE-SYSTEM-88 TO TRUE DTSCS44 +01653 DTSCS44 +01654 SET MTCK-DEST-SYSTEM-88 TO TRUE DTSCS44 +01655 DTSCS44 +01656 MOVE MLIN-ESTB-ABSTIME TO MTCK-L01-ESTB-ABSTIME DTSCS44 +01657 DTSCS44 +01658 SET MTCK-NOT-CONVERTED-88 TO TRUE DTSCS44 +01659 DTSCS44 +01660 MOVE +0 TO MTCK-TEXT-CNT DTSCS44 +01661 DTSCS44 +01662 MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSCS44 +01663 MTCK-CHNG-DATE DTSCS44 +01664 DTSCS44 +01665 MOVE MTCK-REC TO MSKL-REC DTSCS44 +01666 DTSCS44 +01667 PERFORM S810-WRITE THRU S810-EXIT. DTSCS44 +01668 P8112-EXIT. DTSCS44 +01669 EXIT. DTSCS44 +01670 DTSCS44 +01671 P8113-WRITE-R901. DTSCS44 +01672 DTSCS44 +01673 SET R901-ON-REQUEST-88 TO TRUE. DTSCS44 +01674 MOVE +1 TO R901-LABEL-CNT. DTSCS44 +01675 MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS44 +01676 MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS44 +01677 R901-EMP-NO. DTSCS44 +01678 *SRJ MOVE MAP-FLD-REP-ID-CD-DSCR TO R901-GRP1-OP-ID. CL**4 +01679 MOVE SPACES TO R901-GRP1-OP-ID. CL**6 +01680 MOVE MAP-LIEN-ADDR-LINE-1 TO R901-FMT-LINE(1). DTSCS44 +01681 MOVE MAP-LIEN-ADDR-LINE-2 TO R901-FMT-LINE(2). DTSCS44 +01682 MOVE MAP-LIEN-ADDR-LINE-3 TO R901-FMT-LINE(3). DTSCS44 +01683 MOVE MAP-LIEN-ADDR-LINE-4 TO R901-FMT-LINE(4). DTSCS44 +01684 MOVE MAP-LIEN-ADDR-LINE-5 TO R901-FMT-LINE(5). DTSCS44 +01685 MOVE LENGTH OF R901-REC TO R901-LENGTH. DTSCS44 +01686 MOVE R901-REC TO RSKL-REC. DTSCS44 +01687 PERFORM S825-WRITE THRU S825-EXIT. DTSCS44 +01688 P8113-EXIT. DTSCS44 +01689 EXIT. DTSCS44 +01690 DTSCS44 +01691 P8120-UPDATE-MPRF. DTSCS44 +01692 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS44 01693 DTSCS44 -01694 MOVE MSKL-REC TO MHDR-REC. DTSCS44 -01695 DTSCS44 -01696 MOVE MHDR-LAST-USED-LIEN-NO TO WRK-CERT-NO. DTSCS44 -01697 DTSCS44 -01698 IF WRK-EDIT-CERT-NO2 = 9999 DTSCS44 -01699 MOVE 0000 TO WRK-EDIT-CERT-NO2 DTSCS44 -01700 MOVE WRK-CERT-NO TO MHDR-LAST-USED-LIEN-NO. DTSCS44 -01701 DTSCS44 -01702 ADD +1 TO MHDR-LAST-USED-LIEN-NO. DTSCS44 -01703 MOVE MHDR-LAST-USED-LIEN-NO TO WRK-CERT-NO. DTSCS44 -01704 MOVE WRK-CERT-NO TO WRK-DISPLAY. DTSCS44 -01705 MOVE WRK-DISPLAY-CERT-NO-1 TO MAP-CERT-NUM1. DTSCS44 -01706 MOVE WRK-DISPLAY-CERT-NO-2 TO MAP-CERT-NUM2. DTSCS44 -01707 DTSCS44 -01708 DTSCS44 -01709 MOVE MHDR-REC TO MSKL-REC. DTSCS44 -01710 DTSCS44 -01711 PERFORM S810-REWRITE-UPDATE THRU S810-EXIT. DTSCS44 +01694 SET MPRF-MLIN-EXISTS-88 TO TRUE. DTSCS44 +01695 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS44 +01696 MOVE MPRF-REC TO MSKL-REC. DTSCS44 +01697 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS44 +01698 P8120-EXIT. DTSCS44 +01699 EXIT. DTSCS44 +01700 DTSCS44 +01701 P8190-GET-CERT-NUM. DTSCS44 +01702 IF MAP-STATUS-CD = 'C' DTSCS44 +01703 GO TO P8190-EXIT. DTSCS44 +01704 DTSCS44 +01705 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSCS44 +01706 MOVE +0 TO MHDR-EMP-NO. DTSCS44 +01707 SET MHDR-HDR-88 TO TRUE. DTSCS44 +01708 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +01709 PERFORM S810-READ-UPDATE THRU S810-EXIT. DTSCS44 +01710 IF L810-NO-REC-88 DTSCS44 +01711 GO TO S899-ABEND. DTSCS44 01712 DTSCS44 -01713 P8190-EXIT. DTSCS44 -01714 EXIT. DTSCS44 -01715 DTSCS44 -01716 /*****************************************************************DTSCS44 -01717 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS44 -01718 ******************************************************************DTSCS44 -01719 DTSCS44 -01720 P8200-MOD. DTSCS44 -01721 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS44 -01722 DTSCS44 -01723 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 -01724 DTSCS44 -01725 IF LCCM-F12-88 DTSCS44 -01726 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS44 -01727 GO TO P8200-EXIT. DTSCS44 -01728 DTSCS44 -01729 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -01730 DTSCS44 -01731 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS44 -01732 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS44 -01733 IF LCCM-MSG DTSCS44 -01734 GO TO P8200-EXIT. DTSCS44 -01735 DTSCS44 -01736 PERFORM P8210-CONSTRUCT-MLIN THRU P8210-EXIT. DTSCS44 -01737 DTSCS44 -01738 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS44 -01739 DTSCS44 -01740 MOVE MLIN-KEY-AREA TO LCCM-SCR44-HOLD-AREA. DTSCS44 +01713 MOVE MSKL-REC TO MHDR-REC. DTSCS44 +01714 DTSCS44 +01715 MOVE MHDR-LAST-USED-LIEN-NO TO WRK-CERT-NO. DTSCS44 +01716 DTSCS44 +01717 IF WRK-EDIT-CERT-NO2 = 9999 DTSCS44 +01718 MOVE 0000 TO WRK-EDIT-CERT-NO2 DTSCS44 +01719 MOVE WRK-CERT-NO TO MHDR-LAST-USED-LIEN-NO. DTSCS44 +01720 DTSCS44 +01721 ADD +1 TO MHDR-LAST-USED-LIEN-NO. DTSCS44 +01722 MOVE MHDR-LAST-USED-LIEN-NO TO WRK-CERT-NO. DTSCS44 +01723 MOVE WRK-CERT-NO TO WRK-DISPLAY. DTSCS44 +01724 MOVE WRK-DISPLAY-CERT-NO-1 TO MAP-CERT-NUM1. DTSCS44 +01725 MOVE WRK-DISPLAY-CERT-NO-2 TO MAP-CERT-NUM2. DTSCS44 +01726 DTSCS44 +01727 DTSCS44 +01728 MOVE MHDR-REC TO MSKL-REC. DTSCS44 +01729 DTSCS44 +01730 PERFORM S810-REWRITE-UPDATE THRU S810-EXIT. DTSCS44 +01731 DTSCS44 +01732 P8190-EXIT. DTSCS44 +01733 EXIT. DTSCS44 +01734 DTSCS44 +01735 /*****************************************************************DTSCS44 +01736 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS44 +01737 ******************************************************************DTSCS44 +01738 DTSCS44 +01739 P8200-MOD. DTSCS44 +01740 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS44 01741 DTSCS44 -01742 SET LCCM-ENTER-88 TO TRUE. DTSCS44 +01742 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 01743 DTSCS44 -01744 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS44 -01745 DTSCS44 -01746 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS44 +01744 IF LCCM-F12-88 DTSCS44 +01745 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS44 +01746 GO TO P8200-EXIT. DTSCS44 01747 DTSCS44 -01748 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 -01749 P8200-EXIT. DTSCS44 -01750 EXIT. DTSCS44 -01751 EJECT DTSCS44 -01752 P8210-CONSTRUCT-MLIN. DTSCS44 -01753 MOVE LCCM-SCR44-HOLD-AREA TO MSKL-KEY-AREA. DTSCS44 -01754 PERFORM S810-READ THRU S810-EXIT. DTSCS44 -01755 IF L810-NO-REC-88 DTSCS44 -01756 GO TO S899-ABEND. DTSCS44 -01757 DTSCS44 -01758 MOVE MSKL-REC TO MLIN-REC. DTSCS44 -01759 DTSCS44 -01760 MOVE MLIN-STATUS-CD TO WRK-STATUS-CD. DTSCS44 -01761 DTSCS44 -01762 IF MAP-STATUS-CD NOT = MLIN-STATUS-CD DTSCS44 -01763 MOVE LCCM-OP-ID TO MLIN-STATUS-OP-ID DTSCS44 -01764 MOVE LCCM-CURR-RUN-DATE TO MLIN-STATUS-DATE DTSCS44 -01765 MLIN-CHNG-DATE. DTSCS44 +01748 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +01749 DTSCS44 +01750 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS44 +01751 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS44 +01752 IF LCCM-MSG DTSCS44 +01753 GO TO P8200-EXIT. DTSCS44 +01754 DTSCS44 +01755 PERFORM P8210-CONSTRUCT-MLIN THRU P8210-EXIT. DTSCS44 +01756 DTSCS44 +01757 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS44 +01758 DTSCS44 +01759 MOVE MLIN-KEY-AREA TO LCCM-SCR44-HOLD-AREA. DTSCS44 +01760 DTSCS44 +01761 SET LCCM-ENTER-88 TO TRUE. DTSCS44 +01762 DTSCS44 +01763 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS44 +01764 DTSCS44 +01765 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS44 01766 DTSCS44 -01767 MOVE MAP-STATUS-CD TO MLIN-STATUS-CD. DTSCS44 -01768 DTSCS44 -01769 IF (WRK-STATUS-CD = 'O' OR 'C' OR 'M') DTSCS44 -01770 AND DTSCS44 -01771 (MLIN-STATUS-RELEASED-88 OR MLIN-STATUS-WITHDRAWN-88) DTSCS44 -01772 IF MLIN-STATUS-RELEASED-88 DTSCS44 -01773 MOVE 'RELEASED.' TO EVL-STATUS-CD-DSCR DTSCS44 -01774 ELSE DTSCS44 -01775 MOVE 'WITHDRAWN.' TO EVL-STATUS-CD-DSCR DTSCS44 -01776 END-IF DTSCS44 -01777 MOVE MLIN-CERTIFICATE-NO TO EVL-CERTIFICATE-NO DTSCS44 -01778 PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS44 -01779 DTSCS44 -01780 IF MAP-MAIL-NO = MLIN-CERTFD-MAIL-NO DTSCS44 -01781 NEXT SENTENCE DTSCS44 -01782 ELSE DTSCS44 -01783 MOVE MAP-MAIL-NO TO MLIN-CERTFD-MAIL-NO DTSCS44 -01784 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 +01767 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 +01768 P8200-EXIT. DTSCS44 +01769 EXIT. DTSCS44 +01770 EJECT DTSCS44 +01771 P8210-CONSTRUCT-MLIN. DTSCS44 +01772 MOVE LCCM-SCR44-HOLD-AREA TO MSKL-KEY-AREA. DTSCS44 +01773 PERFORM S810-READ THRU S810-EXIT. DTSCS44 +01774 IF L810-NO-REC-88 DTSCS44 +01775 GO TO S899-ABEND. DTSCS44 +01776 DTSCS44 +01777 MOVE MSKL-REC TO MLIN-REC. DTSCS44 +01778 DTSCS44 +01779 MOVE MLIN-STATUS-CD TO WRK-STATUS-CD. DTSCS44 +01780 DTSCS44 +01781 IF MAP-STATUS-CD NOT = MLIN-STATUS-CD DTSCS44 +01782 MOVE LCCM-OP-ID TO MLIN-STATUS-OP-ID DTSCS44 +01783 MOVE LCCM-CURR-RUN-DATE TO MLIN-STATUS-DATE DTSCS44 +01784 MLIN-CHNG-DATE. DTSCS44 01785 DTSCS44 -01786 IF MAP-DEED-NO = MLIN-REC-DEEDS-NO DTSCS44 -01787 NEXT SENTENCE DTSCS44 -01788 ELSE DTSCS44 -01789 MOVE MAP-DEED-NO TO MLIN-REC-DEEDS-NO DTSCS44 -01790 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 -01791 DTSCS44 -01792 IF MAP-FLD-REP-ID-CD = MLIN-FLD-REP-ID DTSCS44 -01793 NEXT SENTENCE DTSCS44 -01794 ELSE DTSCS44 -01795 MOVE MAP-FLD-REP-ID-CD TO MLIN-FLD-REP-ID DTSCS44 -01796 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 -01797 DTSCS44 -01798 MOVE MAP-CERT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -01799 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -01800 DTSCS44 -01801 IF L015-DATE = MLIN-CERTIFICATE-DATE DTSCS44 -01802 NEXT SENTENCE DTSCS44 -01803 ELSE DTSCS44 -01804 MOVE L015-DATE TO MLIN-CERTIFICATE-DATE DTSCS44 -01805 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 -01806 DTSCS44 -01807 MOVE MAP-CERT-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -01808 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -01809 DTSCS44 -01810 IF L015-DATE = MLIN-CERTFD-MAIL-DATE DTSCS44 -01811 NEXT SENTENCE DTSCS44 -01812 ELSE DTSCS44 -01813 MOVE L015-DATE TO MLIN-CERTFD-MAIL-DATE DTSCS44 -01814 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 -01815 DTSCS44 -01816 MOVE MAP-MAIL-RETURN-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -01817 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -01818 DTSCS44 -01819 IF L015-DATE = MLIN-RECEIPT-RETURN-DATE DTSCS44 -01820 NEXT SENTENCE DTSCS44 -01821 ELSE DTSCS44 -01822 MOVE L015-DATE TO MLIN-RECEIPT-RETURN-DATE DTSCS44 -01823 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 -01824 DTSCS44 -01825 MOVE MLIN-REC TO MSKL-REC. DTSCS44 -01826 DTSCS44 -01827 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS44 -01828 P8210-EXIT. EXIT. DTSCS44 -01829 /*****************************************************************DTSCS44 -01830 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS44 -01831 ******************************************************************DTSCS44 -01832 *P8300-DEL. DTSCS44 -01833 * SET LCCM-SCR-INQUIRE TO TRUE. DTSCS44 -01834 * DTSCS44 -01835 * IF LCCM-F12-88 DTSCS44 -01836 * MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS44 -01837 * GO TO P8300-EXIT. DTSCS44 -01838 * DTSCS44 -01839 * PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 -01840 * DTSCS44 -01841 * MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS44 -01842 * PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS44 -01843 * IF LCCM-MSG DTSCS44 -01844 * GO TO P8300-EXIT. DTSCS44 -01845 * DTSCS44 -01846 * MOVE LCCM-SCR44-HOLD-AREA TO MSKL-KEY-AREA. DTSCS44 -01847 * PERFORM S810-READ THRU S810-EXIT. DTSCS44 -01848 * IF L810-NO-REC-88 DTSCS44 -01849 * GO TO S899-ABEND. DTSCS44 -01850 * MOVE MSKL-REC TO MLIN-REC. DTSCS44 -01851 * DTSCS44 -01852 * PERFORM S810-DELETE THRU S810-EXIT. DTSCS44 +01786 MOVE MAP-STATUS-CD TO MLIN-STATUS-CD. DTSCS44 +01787 DTSCS44 +01788 IF (WRK-STATUS-CD = 'O' OR 'C' OR 'M') DTSCS44 +01789 AND DTSCS44 +01790 (MLIN-STATUS-RELEASED-88 OR MLIN-STATUS-WITHDRAWN-88) DTSCS44 +01791 IF MLIN-STATUS-RELEASED-88 DTSCS44 +01792 MOVE 'RELEASED.' TO EVL-STATUS-CD-DSCR DTSCS44 +01793 ELSE DTSCS44 +01794 MOVE 'WITHDRAWN.' TO EVL-STATUS-CD-DSCR DTSCS44 +01795 END-IF DTSCS44 +01796 MOVE MLIN-CERTIFICATE-NO TO EVL-CERTIFICATE-NO DTSCS44 +01797 PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS44 +01798 DTSCS44 +01799 IF MAP-MAIL-NO = MLIN-CERTFD-MAIL-NO DTSCS44 +01800 NEXT SENTENCE DTSCS44 +01801 ELSE DTSCS44 +01802 MOVE MAP-MAIL-NO TO MLIN-CERTFD-MAIL-NO DTSCS44 +01803 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 +01804 DTSCS44 +01805 IF MAP-DEED-NO = MLIN-REC-DEEDS-NO DTSCS44 +01806 NEXT SENTENCE DTSCS44 +01807 ELSE DTSCS44 +01808 MOVE MAP-DEED-NO TO MLIN-REC-DEEDS-NO DTSCS44 +01809 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 +01810 DTSCS44 +01811 *SRJ IF MAP-FLD-REP-ID-CD = MLIN-FLD-REP-ID CL**4 +01812 *SRJ NEXT SENTENCE CL**4 +01813 *SRJ ELSE CL**4 +01814 *SRJ MOVE MAP-FLD-REP-ID-CD TO MLIN-FLD-REP-ID CL**4 +01815 *SRJ MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. CL**4 +01816 DTSCS44 +01817 MOVE MAP-CERT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +01818 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +01819 DTSCS44 +01820 IF L015-DATE = MLIN-CERTIFICATE-DATE DTSCS44 +01821 NEXT SENTENCE DTSCS44 +01822 ELSE DTSCS44 +01823 MOVE L015-DATE TO MLIN-CERTIFICATE-DATE DTSCS44 +01824 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 +01825 DTSCS44 +01826 MOVE MAP-CERT-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +01827 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +01828 DTSCS44 +01829 IF L015-DATE = MLIN-CERTFD-MAIL-DATE DTSCS44 +01830 NEXT SENTENCE DTSCS44 +01831 ELSE DTSCS44 +01832 MOVE L015-DATE TO MLIN-CERTFD-MAIL-DATE DTSCS44 +01833 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 +01834 DTSCS44 +01835 MOVE MAP-MAIL-RETURN-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +01836 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +01837 DTSCS44 +01838 IF L015-DATE = MLIN-RECEIPT-RETURN-DATE DTSCS44 +01839 NEXT SENTENCE DTSCS44 +01840 ELSE DTSCS44 +01841 MOVE L015-DATE TO MLIN-RECEIPT-RETURN-DATE DTSCS44 +01842 MOVE LCCM-CURR-RUN-DATE TO MLIN-CHNG-DATE. DTSCS44 +01843 DTSCS44 +01844 MOVE MLIN-REC TO MSKL-REC. DTSCS44 +01845 DTSCS44 +01846 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS44 +01847 P8210-EXIT. EXIT. DTSCS44 +01848 /*****************************************************************DTSCS44 +01849 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS44 +01850 ******************************************************************DTSCS44 +01851 *P8300-DEL. DTSCS44 +01852 * SET LCCM-SCR-INQUIRE TO TRUE. DTSCS44 01853 * DTSCS44 -01854 * MOVE 'DELETED.' TO EVL-STATUS-CD-DSCR. DTSCS44 -01855 * MOVE MLIN-CERTIFICATE-NO TO EVL-CERTIFICATE-NO. DTSCS44 -01856 * PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS44 +01854 * IF LCCM-F12-88 DTSCS44 +01855 * MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS44 +01856 * GO TO P8300-EXIT. DTSCS44 01857 * DTSCS44 -01858 * MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS44 -01859 * MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 -01860 * SET MSKL-LIN-88 TO TRUE. DTSCS44 -01861 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 -01862 * IF L810-NO-REC-88 DTSCS44 -01863 * PERFORM S1110-READ-MPRF THRU S1110-EXIT DTSCS44 -01864 * SET MPRF-NO-MLIN-88 TO TRUE DTSCS44 -01865 * MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS44 -01866 * MOVE MPRF-REC TO MSKL-REC DTSCS44 -01867 * PERFORM S810-REWRITE THRU S810-EXIT DTSCS44 -01868 * ELSE DTSCS44 -01869 * PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 +01858 * PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS44 +01859 * DTSCS44 +01860 * MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS44 +01861 * PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS44 +01862 * IF LCCM-MSG DTSCS44 +01863 * GO TO P8300-EXIT. DTSCS44 +01864 * DTSCS44 +01865 * MOVE LCCM-SCR44-HOLD-AREA TO MSKL-KEY-AREA. DTSCS44 +01866 * PERFORM S810-READ THRU S810-EXIT. DTSCS44 +01867 * IF L810-NO-REC-88 DTSCS44 +01868 * GO TO S899-ABEND. DTSCS44 +01869 * MOVE MSKL-REC TO MLIN-REC. DTSCS44 01870 * DTSCS44 -01871 * PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS44 +01871 * PERFORM S810-DELETE THRU S810-EXIT. DTSCS44 01872 * DTSCS44 -01873 * SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 -01874 * MOVE LOW-VALUE TO MAP-AREA. DTSCS44 -01875 * PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 +01873 * MOVE 'DELETED.' TO EVL-STATUS-CD-DSCR. DTSCS44 +01874 * MOVE MLIN-CERTIFICATE-NO TO EVL-CERTIFICATE-NO. DTSCS44 +01875 * PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS44 01876 * DTSCS44 -01877 * MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS44 -01878 * MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS44 -01879 * MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS44 -01880 * DTSCS44 -01881 * MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS44 -01882 * DTSCS44 -01883 * MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 -01884 * DTSCS44 -01885 *P8300-EXIT. EXIT. DTSCS44 -01886 * EJECT DTSCS44 -01887 P8810-LOCK-EMPLOYER. DTSCS44 -01888 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS44 -01889 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS44 -01890 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS44 -01891 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS44 -01892 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS44 -01893 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS44 -01894 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS44 -01895 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS44 -01896 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS44 -01897 DTSCS44 -01898 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS44 -01899 P8810-EXIT. DTSCS44 -01900 EXIT. DTSCS44 -01901 DTSCS44 -01902 DTSCS44 -01903 P8820-CREATE-MEVL. DTSCS44 -01904 MOVE LOW-VALUES TO MEVL-REC. DTSCS44 -01905 DTSCS44 -01906 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS44 -01907 SET MEVL-EVL-88 TO TRUE. DTSCS44 -01908 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS44 -01909 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS44 -01910 DTSCS44 -01911 MOVE EVL-TEXT TO MEVL-TEXT. DTSCS44 -01912 DTSCS44 -01913 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS44 -01914 DTSCS44 -01915 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS44 +01877 * MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS44 +01878 * MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS44 +01879 * SET MSKL-LIN-88 TO TRUE. DTSCS44 +01880 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 +01881 * IF L810-NO-REC-88 DTSCS44 +01882 * PERFORM S1110-READ-MPRF THRU S1110-EXIT DTSCS44 +01883 * SET MPRF-NO-MLIN-88 TO TRUE DTSCS44 +01884 * MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS44 +01885 * MOVE MPRF-REC TO MSKL-REC DTSCS44 +01886 * PERFORM S810-REWRITE THRU S810-EXIT DTSCS44 +01887 * ELSE DTSCS44 +01888 * PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 +01889 * DTSCS44 +01890 * PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS44 +01891 * DTSCS44 +01892 * SET LCCM-SCR-CLEAR TO TRUE. DTSCS44 +01893 * MOVE LOW-VALUE TO MAP-AREA. DTSCS44 +01894 * PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS44 +01895 * DTSCS44 +01896 * MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS44 +01897 * MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS44 +01898 * MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS44 +01899 * DTSCS44 +01900 * MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS44 +01901 * DTSCS44 +01902 * MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS44 +01903 * DTSCS44 +01904 *P8300-EXIT. EXIT. DTSCS44 +01905 * EJECT DTSCS44 +01906 P8810-LOCK-EMPLOYER. DTSCS44 +01907 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS44 +01908 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS44 +01909 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS44 +01910 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS44 +01911 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS44 +01912 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS44 +01913 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS44 +01914 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS44 +01915 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS44 01916 DTSCS44 -01917 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS44 -01918 MEVL-CHNG-DATE. DTSCS44 -01919 DTSCS44 -01920 MOVE MEVL-REC TO MSKL-REC. DTSCS44 -01921 PERFORM S810-WRITE THRU S810-EXIT. DTSCS44 -01922 P8820-EXIT. DTSCS44 -01923 EXIT. DTSCS44 -01924 /*****************************************************************DTSCS44 -01925 * LINKS TO UTILITY MODULES DTSCS44 -01926 ******************************************************************DTSCS44 -01927 DTSCS44 -01928 S001-FROM-FED-8. DTSCS44 -01929 SET L001-FROM-FED-8 TO TRUE. DTSCS44 -01930 GO TO S001-DATE. DTSCS44 +01917 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS44 +01918 P8810-EXIT. DTSCS44 +01919 EXIT. DTSCS44 +01920 DTSCS44 +01921 DTSCS44 +01922 P8820-CREATE-MEVL. DTSCS44 +01923 MOVE LOW-VALUES TO MEVL-REC. DTSCS44 +01924 DTSCS44 +01925 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS44 +01926 SET MEVL-EVL-88 TO TRUE. DTSCS44 +01927 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS44 +01928 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS44 +01929 DTSCS44 +01930 MOVE EVL-TEXT TO MEVL-TEXT. DTSCS44 01931 DTSCS44 -01932 S001-FROM-ABS-DAY. DTSCS44 -01933 SET L001-FROM-ABS-DAY TO TRUE. DTSCS44 -01934 GO TO S001-DATE. DTSCS44 +01932 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS44 +01933 DTSCS44 +01934 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS44 01935 DTSCS44 -01936 S001-DATE. DTSCS44 -01937 EXEC CICS LINK DTSCS44 -01938 PROGRAM('DTSCU001') DTSCS44 -01939 COMMAREA(L001-COMM-AREA) DTSCS44 -01940 END-EXEC. DTSCS44 -01941 S001-EXIT. DTSCS44 +01936 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS44 +01937 MEVL-CHNG-DATE. DTSCS44 +01938 DTSCS44 +01939 MOVE MEVL-REC TO MSKL-REC. DTSCS44 +01940 PERFORM S810-WRITE THRU S810-EXIT. DTSCS44 +01941 P8820-EXIT. DTSCS44 01942 EXIT. DTSCS44 -01943 DTSCS44 -01944 *S004-FROM-5. DTSCS44 -01945 *****SET L004-FROM-5 TO TRUE. DTSCS44 -01946 *****GO TO S004-LINK. DTSCS44 -01947 ***** DTSCS44 -01948 *S004-FROM-3. DTSCS44 -01949 *****SET L004-FROM-3 TO TRUE. DTSCS44 -01950 *****GO TO S004-LINK. DTSCS44 -01951 ***** DTSCS44 -01952 S005-CDATE-TIME. DTSCS44 -01953 EXEC CICS LINK DTSCS44 -01954 PROGRAM ('DTSCU005') DTSCS44 -01955 COMMAREA (L005-COMM-AREA) DTSCS44 -01956 END-EXEC. DTSCS44 -01957 S005-EXIT. DTSCS44 -01958 EXIT. DTSCS44 -01959 DTSCS44 -01960 S011-AMT-FROM-SCREEN. DTSCS44 -01961 MOVE +0.01 TO L011-MIN-AMT DTSCS44 -01962 MOVE +9999999.99 TO L011-MAX-AMT DTSCS44 -01963 EXEC CICS LINK DTSCS44 -01964 PROGRAM ('DTSCU011') DTSCS44 -01965 COMMAREA (L011-COMM-AREA) DTSCS44 -01966 END-EXEC. DTSCS44 -01967 S011-EXIT. DTSCS44 -01968 EXIT. DTSCS44 -01969 DTSCS44 -01970 S015-DATE-FROM-SCREEN. DTSCS44 -01971 EXEC CICS LINK DTSCS44 -01972 PROGRAM ('DTSCU015') DTSCS44 -01973 COMMAREA (L015-COMM-AREA) DTSCS44 -01974 END-EXEC. DTSCS44 -01975 S015-EXIT. DTSCS44 -01976 EXIT. DTSCS44 -01977 DTSCS44 -01978 *S013-ADDR-NUM. DTSCS44 -01979 *****MOVE +1 TO L013-MIN-CNT. DTSCS44 -01980 *****MOVE +999 TO L013-MAX-CNT. DTSCS44 -01981 *****GO TO S013-COUNT-FROM-SCREEN. DTSCS44 -01982 ***** DTSCS44 -01983 *S013-COPY-CNT. DTSCS44 -01984 *****MOVE +1 TO L013-MIN-CNT. DTSCS44 -01985 *****MOVE +99 TO L013-MAX-CNT. DTSCS44 -01986 *****GO TO S013-COUNT-FROM-SCREEN. DTSCS44 -01987 DTSCS44 -01988 S013-COUNT-FROM-SCREEN. DTSCS44 -01989 EXEC CICS LINK DTSCS44 -01990 PROGRAM('DTSCU013') DTSCS44 -01991 COMMAREA(L013-COMM-AREA) DTSCS44 -01992 END-EXEC. DTSCS44 -01993 S013-EXIT. DTSCS44 -01994 EXIT. DTSCS44 -01995 DTSCS44 -01996 S018-EMP-NO-FROM-SCREEN. DTSCS44 -01997 EXEC CICS LINK DTSCS44 -01998 PROGRAM('DTSCU018') DTSCS44 -01999 COMMAREA(L018-COMM-AREA) DTSCS44 -02000 END-EXEC. DTSCS44 -02001 S018-EXIT. DTSCS44 -02002 EXIT. DTSCS44 -02003 DTSCS44 -02004 DTSCS44 -02005 S028-CERT-NO-FROM-SCREEN. DTSCS44 -02006 EXEC CICS LINK DTSCS44 -02007 PROGRAM('DTSCU028') DTSCS44 -02008 COMMAREA(L028-COMM-AREA) DTSCS44 -02009 END-EXEC. DTSCS44 -02010 S028-EXIT. DTSCS44 -02011 EXIT. DTSCS44 -02012 DTSCS44 -02013 DTSCS44 -02014 S029-YRQ-FROM-SCREEN. DTSCS44 -02015 EXEC CICS LINK DTSCS44 -02016 PROGRAM('DTSCU029') DTSCS44 -02017 COMMAREA(L029-COMM-AREA) DTSCS44 -02018 END-EXEC. DTSCS44 -02019 S029-EXIT. DTSCS44 -02020 EXIT. DTSCS44 -02021 DTSCS44 +01943 /*****************************************************************DTSCS44 +01944 * LINKS TO UTILITY MODULES DTSCS44 +01945 ******************************************************************DTSCS44 +01946 DTSCS44 +01947 S001-FROM-FED-8. DTSCS44 +01948 SET L001-FROM-FED-8 TO TRUE. DTSCS44 +01949 GO TO S001-DATE. DTSCS44 +01950 DTSCS44 +01951 S001-FROM-ABS-DAY. DTSCS44 +01952 SET L001-FROM-ABS-DAY TO TRUE. DTSCS44 +01953 GO TO S001-DATE. DTSCS44 +01954 DTSCS44 +01955 S001-DATE. DTSCS44 +01956 EXEC CICS LINK DTSCS44 +01957 PROGRAM('DTSCU001') DTSCS44 +01958 COMMAREA(L001-COMM-AREA) DTSCS44 +01959 END-EXEC. DTSCS44 +01960 S001-EXIT. DTSCS44 +01961 EXIT. DTSCS44 +01962 DTSCS44 +01963 *S004-FROM-5. DTSCS44 +01964 *****SET L004-FROM-5 TO TRUE. DTSCS44 +01965 *****GO TO S004-LINK. DTSCS44 +01966 ***** DTSCS44 +01967 *S004-FROM-3. DTSCS44 +01968 *****SET L004-FROM-3 TO TRUE. DTSCS44 +01969 *****GO TO S004-LINK. DTSCS44 +01970 ***** DTSCS44 +01971 S005-CDATE-TIME. DTSCS44 +01972 EXEC CICS LINK DTSCS44 +01973 PROGRAM ('DTSCU005') DTSCS44 +01974 COMMAREA (L005-COMM-AREA) DTSCS44 +01975 END-EXEC. DTSCS44 +01976 S005-EXIT. DTSCS44 +01977 EXIT. DTSCS44 +01978 DTSCS44 +01979 S011-AMT-FROM-SCREEN. DTSCS44 +01980 MOVE +0.01 TO L011-MIN-AMT DTSCS44 +01981 MOVE +9999999.99 TO L011-MAX-AMT DTSCS44 +01982 EXEC CICS LINK DTSCS44 +01983 PROGRAM ('DTSCU011') DTSCS44 +01984 COMMAREA (L011-COMM-AREA) DTSCS44 +01985 END-EXEC. DTSCS44 +01986 S011-EXIT. DTSCS44 +01987 EXIT. DTSCS44 +01988 DTSCS44 +01989 S015-DATE-FROM-SCREEN. DTSCS44 +01990 EXEC CICS LINK DTSCS44 +01991 PROGRAM ('DTSCU015') DTSCS44 +01992 COMMAREA (L015-COMM-AREA) DTSCS44 +01993 END-EXEC. DTSCS44 +01994 S015-EXIT. DTSCS44 +01995 EXIT. DTSCS44 +01996 DTSCS44 +01997 *S013-ADDR-NUM. DTSCS44 +01998 *****MOVE +1 TO L013-MIN-CNT. DTSCS44 +01999 *****MOVE +999 TO L013-MAX-CNT. DTSCS44 +02000 *****GO TO S013-COUNT-FROM-SCREEN. DTSCS44 +02001 ***** DTSCS44 +02002 *S013-COPY-CNT. DTSCS44 +02003 *****MOVE +1 TO L013-MIN-CNT. DTSCS44 +02004 *****MOVE +99 TO L013-MAX-CNT. DTSCS44 +02005 *****GO TO S013-COUNT-FROM-SCREEN. DTSCS44 +02006 DTSCS44 +02007 S013-COUNT-FROM-SCREEN. DTSCS44 +02008 EXEC CICS LINK DTSCS44 +02009 PROGRAM('DTSCU013') DTSCS44 +02010 COMMAREA(L013-COMM-AREA) DTSCS44 +02011 END-EXEC. DTSCS44 +02012 S013-EXIT. DTSCS44 +02013 EXIT. DTSCS44 +02014 DTSCS44 +02015 S018-EMP-NO-FROM-SCREEN. DTSCS44 +02016 EXEC CICS LINK DTSCS44 +02017 PROGRAM('DTSCU018') DTSCS44 +02018 COMMAREA(L018-COMM-AREA) DTSCS44 +02019 END-EXEC. DTSCS44 +02020 S018-EXIT. DTSCS44 +02021 EXIT. DTSCS44 02022 DTSCS44 -02023 S034-MLIN-STATUS-CD. DTSCS44 -02024 SET L034-MLIN-STATUS-CD TO TRUE. DTSCS44 -02025 GO TO S034-LINK. DTSCS44 -02026 DTSCS44 -02027 S034-LINK. DTSCS44 -02028 EXEC CICS LINK DTSCS44 -02029 PROGRAM ('DTSCU034') DTSCS44 -02030 COMMAREA (L034-COMM-AREA) DTSCS44 -02031 END-EXEC. DTSCS44 -02032 S034-EXIT. DTSCS44 -02033 EXIT. DTSCS44 -02034 DTSCS44 -02035 S062-FLD-REP-ID-DESC. DTSCS44 -02036 EXEC CICS LINK DTSCS44 -02037 PROGRAM('DTSCU062') DTSCS44 -02038 COMMAREA(L062-COMM-AREA) DTSCS44 -02039 END-EXEC. DTSCS44 -02040 S062-EXIT. DTSCS44 -02041 EXIT. DTSCS44 -02042 DTSCS44 -02043 S101-PER-MONTH-NO. DTSCS44 -02044 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS44 -02045 GO TO S101-INT-PEN-COMP. DTSCS44 -02046 DTSCS44 -02047 S101-INT-PEN-COMP. DTSCS44 -02048 EXEC CICS LINK DTSCS44 -02049 PROGRAM ('DTSCU101') DTSCS44 -02050 COMMAREA (L101-COMM-AREA) DTSCS44 -02051 END-EXEC. DTSCS44 -02052 S101-EXIT. DTSCS44 -02053 EXIT. DTSCS44 -02054 DTSCS44 -02055 S111-ADDR-LOOKUP. DTSCS44 -02056 EXEC CICS LINK DTSCS44 -02057 PROGRAM('DTSCU111') DTSCS44 -02058 COMMAREA(L111-COMM-AREA) DTSCS44 -02059 END-EXEC. DTSCS44 -02060 DTSCS44 -02061 IF L111-FILE-CLOSED-88 DTSCS44 -02062 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02063 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 -02064 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 -02065 GO TO MAINLINE-EXIT. DTSCS44 -02066 S111-EXIT. DTSCS44 -02067 EXIT. DTSCS44 -02068 DTSCS44 -02069 S109-SUR-TAX-QTR. DTSCS44 -02070 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS44 -02071 EXEC CICS LINK DTSCS44 -02072 PROGRAM('DTSCU109') DTSCS44 -02073 COMMAREA(L109-COMM-AREA) DTSCS44 -02074 END-EXEC. DTSCS44 -02075 S109-EXIT. DTSCS44 -02076 EXIT. DTSCS44 -02077 DTSCS44 -02078 DTSCS44 -02079 S112-ADDR-FORMAT. DTSCS44 -02080 EXEC CICS LINK DTSCS44 -02081 PROGRAM('DTSCU112') DTSCS44 -02082 COMMAREA(L112-COMM-AREA) DTSCS44 -02083 END-EXEC. DTSCS44 -02084 S112-EXIT. DTSCS44 -02085 EXIT. DTSCS44 -02086 DTSCS44 -02087 S221-EMP-LOCK. DTSCS44 -02088 SET L221-START-UPDATE TO TRUE. DTSCS44 -02089 GO TO S221-EMP-LOCK-UNLOCK. DTSCS44 -02090 DTSCS44 -02091 S221-EMP-UNLOCK. DTSCS44 -02092 SET L221-END-UPDATE TO TRUE. DTSCS44 -02093 GO TO S221-EMP-LOCK-UNLOCK. DTSCS44 -02094 DTSCS44 -02095 S221-EMP-LOCK-UNLOCK. DTSCS44 -02096 EXEC CICS LINK DTSCS44 -02097 PROGRAM('DTSCU221') DTSCS44 -02098 COMMAREA(L221-COMM-AREA) DTSCS44 -02099 END-EXEC. DTSCS44 -02100 DTSCS44 -02101 IF L221-FILE-CLOSED DTSCS44 -02102 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02103 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 -02104 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 -02105 GO TO MAINLINE-EXIT. DTSCS44 -02106 DTSCS44 -02107 IF L221-NOT-OK DTSCS44 -02108 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS44 -02109 S221-EXIT. DTSCS44 -02110 EXIT. DTSCS44 -02111 DTSCS44 -02112 DTSCS44 -02113 S803-REQ-SCR-ID-EDIT. DTSCS44 -02114 EXEC CICS LINK DTSCS44 -02115 PROGRAM ('DTSCU803') DTSCS44 -02116 COMMAREA (DFHCOMMAREA) DTSCS44 -02117 END-EXEC. DTSCS44 -02118 S803-EXIT. DTSCS44 -02119 EXIT. DTSCS44 -02120 DTSCS44 -02121 S804-INVALID-KEY. DTSCS44 -02122 EXEC CICS LINK DTSCS44 -02123 PROGRAM ('DTSCU804') DTSCS44 -02124 COMMAREA (DFHCOMMAREA) DTSCS44 -02125 END-EXEC. DTSCS44 -02126 S804-EXIT. DTSCS44 -02127 EXIT. DTSCS44 -02128 DTSCS44 -02129 S805-MSG-AREA. DTSCS44 -02130 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS44 +02023 DTSCS44 +02024 S028-CERT-NO-FROM-SCREEN. DTSCS44 +02025 EXEC CICS LINK DTSCS44 +02026 PROGRAM('DTSCU028') DTSCS44 +02027 COMMAREA(L028-COMM-AREA) DTSCS44 +02028 END-EXEC. DTSCS44 +02029 S028-EXIT. DTSCS44 +02030 EXIT. DTSCS44 +02031 DTSCS44 +02032 DTSCS44 +02033 S029-YRQ-FROM-SCREEN. DTSCS44 +02034 EXEC CICS LINK DTSCS44 +02035 PROGRAM('DTSCU029') DTSCS44 +02036 COMMAREA(L029-COMM-AREA) DTSCS44 +02037 END-EXEC. DTSCS44 +02038 S029-EXIT. DTSCS44 +02039 EXIT. DTSCS44 +02040 DTSCS44 +02041 DTSCS44 +02042 S034-MLIN-STATUS-CD. DTSCS44 +02043 SET L034-MLIN-STATUS-CD TO TRUE. DTSCS44 +02044 GO TO S034-LINK. DTSCS44 +02045 DTSCS44 +02046 S034-LINK. DTSCS44 +02047 EXEC CICS LINK DTSCS44 +02048 PROGRAM ('DTSCU034') DTSCS44 +02049 COMMAREA (L034-COMM-AREA) DTSCS44 +02050 END-EXEC. DTSCS44 +02051 S034-EXIT. DTSCS44 +02052 EXIT. DTSCS44 +02053 DTSCS44 +02054 S062-FLD-REP-ID-DESC. DTSCS44 +02055 EXEC CICS LINK DTSCS44 +02056 PROGRAM('DTSCU062') DTSCS44 +02057 COMMAREA(L062-COMM-AREA) DTSCS44 +02058 END-EXEC. DTSCS44 +02059 S062-EXIT. DTSCS44 +02060 EXIT. DTSCS44 +02061 DTSCS44 +02062 S101-PER-MONTH-NO. DTSCS44 +02063 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS44 +02064 GO TO S101-INT-PEN-COMP. DTSCS44 +02065 DTSCS44 +02066 S101-INT-PEN-COMP. DTSCS44 +02067 EXEC CICS LINK DTSCS44 +02068 PROGRAM ('DTSCU101') DTSCS44 +02069 COMMAREA (L101-COMM-AREA) DTSCS44 +02070 END-EXEC. DTSCS44 +02071 S101-EXIT. DTSCS44 +02072 EXIT. DTSCS44 +02073 DTSCS44 +02074 S111-ADDR-LOOKUP. DTSCS44 +02075 EXEC CICS LINK DTSCS44 +02076 PROGRAM('DTSCU111') DTSCS44 +02077 COMMAREA(L111-COMM-AREA) DTSCS44 +02078 END-EXEC. DTSCS44 +02079 DTSCS44 +02080 IF L111-FILE-CLOSED-88 DTSCS44 +02081 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02082 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 +02083 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 +02084 GO TO MAINLINE-EXIT. DTSCS44 +02085 S111-EXIT. DTSCS44 +02086 EXIT. DTSCS44 +02087 DTSCS44 +02088 S109-SUR-TAX-QTR. DTSCS44 +02089 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS44 +02090 EXEC CICS LINK DTSCS44 +02091 PROGRAM('DTSCU109') DTSCS44 +02092 COMMAREA(L109-COMM-AREA) DTSCS44 +02093 END-EXEC. DTSCS44 +02094 S109-EXIT. DTSCS44 +02095 EXIT. DTSCS44 +02096 DTSCS44 +02097 DTSCS44 +02098 S112-ADDR-FORMAT. DTSCS44 +02099 EXEC CICS LINK DTSCS44 +02100 PROGRAM('DTSCU112') DTSCS44 +02101 COMMAREA(L112-COMM-AREA) DTSCS44 +02102 END-EXEC. DTSCS44 +02103 S112-EXIT. DTSCS44 +02104 EXIT. DTSCS44 +02105 DTSCS44 +02106 S221-EMP-LOCK. DTSCS44 +02107 SET L221-START-UPDATE TO TRUE. DTSCS44 +02108 GO TO S221-EMP-LOCK-UNLOCK. DTSCS44 +02109 DTSCS44 +02110 S221-EMP-UNLOCK. DTSCS44 +02111 SET L221-END-UPDATE TO TRUE. DTSCS44 +02112 GO TO S221-EMP-LOCK-UNLOCK. DTSCS44 +02113 DTSCS44 +02114 S221-EMP-LOCK-UNLOCK. DTSCS44 +02115 EXEC CICS LINK DTSCS44 +02116 PROGRAM('DTSCU221') DTSCS44 +02117 COMMAREA(L221-COMM-AREA) DTSCS44 +02118 END-EXEC. DTSCS44 +02119 DTSCS44 +02120 IF L221-FILE-CLOSED DTSCS44 +02121 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02122 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 +02123 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 +02124 GO TO MAINLINE-EXIT. DTSCS44 +02125 DTSCS44 +02126 IF L221-NOT-OK DTSCS44 +02127 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS44 +02128 S221-EXIT. DTSCS44 +02129 EXIT. DTSCS44 +02130 DTSCS44 02131 DTSCS44 -02132 EXEC CICS LINK DTSCS44 -02133 PROGRAM ('DTSCU805') DTSCS44 -02134 COMMAREA (L805-COMM-AREA) DTSCS44 -02135 END-EXEC. DTSCS44 -02136 DTSCS44 -02137 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS44 -02138 S805-EXIT. DTSCS44 -02139 EXIT. DTSCS44 -02140 EJECT DTSCS44 -02141 S810-READ. DTSCS44 -02142 SET L810-READ-88 TO TRUE. DTSCS44 -02143 GO TO S810-IO. DTSCS44 -02144 DTSCS44 -02145 S810-START-BROWSE. DTSCS44 -02146 SET L810-START-BROWSE-88 TO TRUE. DTSCS44 -02147 GO TO S810-IO. DTSCS44 -02148 DTSCS44 -02149 S810-READ-NEXT. DTSCS44 -02150 SET L810-READ-NEXT-88 TO TRUE. DTSCS44 -02151 GO TO S810-IO. DTSCS44 -02152 DTSCS44 -02153 S810-READ-PREV. DTSCS44 -02154 SET L810-READ-PREV-88 TO TRUE. DTSCS44 -02155 GO TO S810-IO. DTSCS44 -02156 DTSCS44 -02157 S810-END-BROWSE. DTSCS44 -02158 SET L810-END-BROWSE-88 TO TRUE. DTSCS44 -02159 GO TO S810-IO. DTSCS44 -02160 DTSCS44 -02161 S810-COUNT. DTSCS44 -02162 SET L810-COUNT-88 TO TRUE. DTSCS44 -02163 GO TO S810-IO. DTSCS44 -02164 DTSCS44 -02165 S810-REWRITE. DTSCS44 -02166 SET L810-REWRITE-88 TO TRUE. DTSCS44 -02167 GO TO S810-IO. DTSCS44 -02168 DTSCS44 -02169 S810-READ-UPDATE. DTSCS44 -02170 SET L810-READ-UPDATE-88 TO TRUE. DTSCS44 -02171 GO TO S810-IO. DTSCS44 -02172 DTSCS44 -02173 S810-REWRITE-UPDATE. DTSCS44 -02174 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS44 -02175 GO TO S810-IO. DTSCS44 -02176 DTSCS44 -02177 S810-WRITE. DTSCS44 -02178 SET L810-WRITE-88 TO TRUE. DTSCS44 -02179 GO TO S810-IO. DTSCS44 -02180 DTSCS44 -02181 S810-DELETE. DTSCS44 -02182 SET L810-DELETE-88 TO TRUE. DTSCS44 -02183 GO TO S810-IO. DTSCS44 -02184 DTSCS44 -02185 S810-IO. DTSCS44 -02186 DTSCS44 -02187 EXEC CICS LINK DTSCS44 -02188 PROGRAM ('DTSCU810') DTSCS44 -02189 COMMAREA (L810-COMM-AREA) DTSCS44 -02190 END-EXEC. DTSCS44 +02132 S803-REQ-SCR-ID-EDIT. DTSCS44 +02133 EXEC CICS LINK DTSCS44 +02134 PROGRAM ('DTSCU803') DTSCS44 +02135 COMMAREA (DFHCOMMAREA) DTSCS44 +02136 END-EXEC. DTSCS44 +02137 S803-EXIT. DTSCS44 +02138 EXIT. DTSCS44 +02139 DTSCS44 +02140 S804-INVALID-KEY. DTSCS44 +02141 EXEC CICS LINK DTSCS44 +02142 PROGRAM ('DTSCU804') DTSCS44 +02143 COMMAREA (DFHCOMMAREA) DTSCS44 +02144 END-EXEC. DTSCS44 +02145 S804-EXIT. DTSCS44 +02146 EXIT. DTSCS44 +02147 DTSCS44 +02148 S805-MSG-AREA. DTSCS44 +02149 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS44 +02150 DTSCS44 +02151 EXEC CICS LINK DTSCS44 +02152 PROGRAM ('DTSCU805') DTSCS44 +02153 COMMAREA (L805-COMM-AREA) DTSCS44 +02154 END-EXEC. DTSCS44 +02155 DTSCS44 +02156 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS44 +02157 S805-EXIT. DTSCS44 +02158 EXIT. DTSCS44 +02159 EJECT DTSCS44 +02160 S810-READ. DTSCS44 +02161 SET L810-READ-88 TO TRUE. DTSCS44 +02162 GO TO S810-IO. DTSCS44 +02163 DTSCS44 +02164 S810-START-BROWSE. DTSCS44 +02165 SET L810-START-BROWSE-88 TO TRUE. DTSCS44 +02166 GO TO S810-IO. DTSCS44 +02167 DTSCS44 +02168 S810-READ-NEXT. DTSCS44 +02169 SET L810-READ-NEXT-88 TO TRUE. DTSCS44 +02170 GO TO S810-IO. DTSCS44 +02171 DTSCS44 +02172 S810-READ-PREV. DTSCS44 +02173 SET L810-READ-PREV-88 TO TRUE. DTSCS44 +02174 GO TO S810-IO. DTSCS44 +02175 DTSCS44 +02176 S810-END-BROWSE. DTSCS44 +02177 SET L810-END-BROWSE-88 TO TRUE. DTSCS44 +02178 GO TO S810-IO. DTSCS44 +02179 DTSCS44 +02180 S810-COUNT. DTSCS44 +02181 SET L810-COUNT-88 TO TRUE. DTSCS44 +02182 GO TO S810-IO. DTSCS44 +02183 DTSCS44 +02184 S810-REWRITE. DTSCS44 +02185 SET L810-REWRITE-88 TO TRUE. DTSCS44 +02186 GO TO S810-IO. DTSCS44 +02187 DTSCS44 +02188 S810-READ-UPDATE. DTSCS44 +02189 SET L810-READ-UPDATE-88 TO TRUE. DTSCS44 +02190 GO TO S810-IO. DTSCS44 02191 DTSCS44 -02192 IF L810-FILE-CLOSED-88 DTSCS44 -02193 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02194 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 -02195 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 -02196 GO TO MAINLINE-EXIT. DTSCS44 -02197 S810-EXIT. DTSCS44 -02198 EXIT. DTSCS44 -02199 EJECT DTSCS44 -02200 S825-WRITE. DTSCS44 -02201 SET L825-WRITE-88 TO TRUE. DTSCS44 -02202 GO TO S825-O. DTSCS44 +02192 S810-REWRITE-UPDATE. DTSCS44 +02193 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS44 +02194 GO TO S810-IO. DTSCS44 +02195 DTSCS44 +02196 S810-WRITE. DTSCS44 +02197 SET L810-WRITE-88 TO TRUE. DTSCS44 +02198 GO TO S810-IO. DTSCS44 +02199 DTSCS44 +02200 S810-DELETE. DTSCS44 +02201 SET L810-DELETE-88 TO TRUE. DTSCS44 +02202 GO TO S810-IO. DTSCS44 02203 DTSCS44 -02204 S825-O. DTSCS44 +02204 S810-IO. DTSCS44 02205 DTSCS44 02206 EXEC CICS LINK DTSCS44 -02207 PROGRAM ('DTSCU825') DTSCS44 -02208 COMMAREA (L825-COMM-AREA) DTSCS44 +02207 PROGRAM ('DTSCU810') DTSCS44 +02208 COMMAREA (L810-COMM-AREA) DTSCS44 02209 END-EXEC. DTSCS44 02210 DTSCS44 -02211 IF L825-FILE-CLOSED-88 DTSCS44 -02212 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02211 IF L810-FILE-CLOSED-88 DTSCS44 +02212 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS44 02213 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 02214 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 02215 GO TO MAINLINE-EXIT. DTSCS44 -02216 S825-EXIT. DTSCS44 +02216 S810-EXIT. DTSCS44 02217 EXIT. DTSCS44 02218 EJECT DTSCS44 -02219 S851-SCREEN-PROCESSING. DTSCS44 -02220 EXEC CICS LINK DTSCS44 -02221 PROGRAM ('DTSCU851') DTSCS44 -02222 COMMAREA (L851-COMM-AREA) DTSCS44 -02223 END-EXEC. DTSCS44 -02224 S851-EXIT. DTSCS44 -02225 EXIT. DTSCS44 -02226 DTSCS44 -02227 S899-ABEND. DTSCS44 -02228 EXEC CICS ABEND DTSCS44 -02229 ABCODE(WRK-ABEND-CD) DTSCS44 -02230 END-EXEC. DTSCS44 -02231 S899-EXIT. DTSCS44 -02232 EXIT. DTSCS44 -02233 /*****************************************************************DTSCS44 -02234 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS44 -02235 ******************************************************************DTSCS44 -02236 DTSCS44 -02237 S1000-SCREEN-EDITS. DTSCS44 -02238 DTSCS44 -02239 IF LCCM-F09-88 DTSCS44 -02240 PERFORM S1200-LIEN-STATUS THRU S1200-EXIT DTSCS44 -02241 PERFORM S1300-FIELD-REP-ID THRU S1300-EXIT DTSCS44 -02242 PERFORM S1400-STMT-DATE THRU S1400-EXIT DTSCS44 -02243 PERFORM S1500-STMT-COMP-DATE THRU S1500-EXIT DTSCS44 -02244 PERFORM S1600-STMT-DUE-AMT THRU S1600-EXIT DTSCS44 -02245 PERFORM S1700-LICENSE THRU S1700-EXIT DTSCS44 -02246 PERFORM S1900-MAIL-ADDRESS THRU S1900-EXIT DTSCS44 -02247 PERFORM S2000-CERTIFICATE-NUM THRU S2000-EXIT DTSCS44 -02248 PERFORM S2600-CURR-COMP-DATE THRU S2600-EXIT DTSCS44 -02249 PERFORM S2700-COVERED-YRQ THRU S2700-EXIT DTSCS44 -02250 ELSE DTSCS44 -02251 PERFORM S1120-READ-MLIN THRU S1120-EXIT DTSCS44 -02252 IF WRK-MLIN-YES-88 DTSCS44 -02253 PERFORM S1200-LIEN-STATUS THRU S1200-EXIT DTSCS44 -02254 PERFORM S1300-FIELD-REP-ID THRU S1300-EXIT DTSCS44 -02255 PERFORM S2100-RECORDR-OF-DEEDS-NO THRU S2100-EXIT DTSCS44 -02256 PERFORM S2200-CERTIFICATE-DATE THRU S2200-EXIT DTSCS44 -02257 PERFORM S2300-CERTIFIED-MAIL-NO THRU S2300-EXIT DTSCS44 -02258 PERFORM S2400-CERTIFIED-MAIL-DATE THRU S2400-EXIT DTSCS44 -02259 PERFORM S2500-RETURN-MAIL-DATE THRU S2500-EXIT DTSCS44 -02260 PERFORM S2600-CURR-COMP-DATE THRU S2600-EXIT DTSCS44 -02261 END-IF DTSCS44 -02262 END-IF. DTSCS44 -02263 DTSCS44 -02264 IF LCCM-MSG DTSCS44 -02265 GO TO S1000-EXIT. DTSCS44 -02266 DTSCS44 -02267 PERFORM S3000-MISC-EDITS THRU S3000-EXIT. DTSCS44 -02268 S1000-EXIT. EXIT. DTSCS44 -02269 EJECT DTSCS44 -02270 DTSCS44 -02271 S1100-EDIT-KEY. DTSCS44 -02272 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS44 -02273 S1100-EXIT. EXIT. DTSCS44 -02274 /*****************************************************************DTSCS44 -02275 * DTSCS44 -02276 ******************************************************************DTSCS44 -02277 S1101-EMP-NO. DTSCS44 -02278 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS44 -02279 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS44 -02280 DTSCS44 -02281 IF L018-NO-ENTRY DTSCS44 -02282 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02283 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -02284 GO TO S1101-EXIT. DTSCS44 +02219 S825-WRITE. DTSCS44 +02220 SET L825-WRITE-88 TO TRUE. DTSCS44 +02221 GO TO S825-O. DTSCS44 +02222 DTSCS44 +02223 S825-O. DTSCS44 +02224 DTSCS44 +02225 EXEC CICS LINK DTSCS44 +02226 PROGRAM ('DTSCU825') DTSCS44 +02227 COMMAREA (L825-COMM-AREA) DTSCS44 +02228 END-EXEC. DTSCS44 +02229 DTSCS44 +02230 IF L825-FILE-CLOSED-88 DTSCS44 +02231 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02232 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS44 +02233 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS44 +02234 GO TO MAINLINE-EXIT. DTSCS44 +02235 S825-EXIT. DTSCS44 +02236 EXIT. DTSCS44 +02237 EJECT DTSCS44 +02238 S851-SCREEN-PROCESSING. DTSCS44 +02239 EXEC CICS LINK DTSCS44 +02240 PROGRAM ('DTSCU851') DTSCS44 +02241 COMMAREA (L851-COMM-AREA) DTSCS44 +02242 END-EXEC. DTSCS44 +02243 S851-EXIT. DTSCS44 +02244 EXIT. DTSCS44 +02245 DTSCS44 +02246 S899-ABEND. DTSCS44 +02247 EXEC CICS ABEND DTSCS44 +02248 ABCODE(WRK-ABEND-CD) DTSCS44 +02249 END-EXEC. DTSCS44 +02250 S899-EXIT. DTSCS44 +02251 EXIT. DTSCS44 +02252 /*****************************************************************DTSCS44 +02253 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS44 +02254 ******************************************************************DTSCS44 +02255 DTSCS44 +02256 S1000-SCREEN-EDITS. DTSCS44 +02257 DTSCS44 +02258 IF LCCM-F09-88 DTSCS44 +02259 PERFORM S1200-LIEN-STATUS THRU S1200-EXIT DTSCS44 +02260 *SRJ PERFORM S1300-FIELD-REP-ID THRU S1300-EXIT CL**4 +02261 PERFORM S1400-STMT-DATE THRU S1400-EXIT DTSCS44 +02262 PERFORM S1500-STMT-COMP-DATE THRU S1500-EXIT DTSCS44 +02263 PERFORM S1600-STMT-DUE-AMT THRU S1600-EXIT DTSCS44 +02264 PERFORM S1700-LICENSE THRU S1700-EXIT DTSCS44 +02265 PERFORM S1900-MAIL-ADDRESS THRU S1900-EXIT DTSCS44 +02266 PERFORM S2000-CERTIFICATE-NUM THRU S2000-EXIT DTSCS44 +02267 PERFORM S2600-CURR-COMP-DATE THRU S2600-EXIT DTSCS44 +02268 PERFORM S2700-COVERED-YRQ THRU S2700-EXIT DTSCS44 +02269 ELSE DTSCS44 +02270 PERFORM S1120-READ-MLIN THRU S1120-EXIT DTSCS44 +02271 IF WRK-MLIN-YES-88 DTSCS44 +02272 PERFORM S1200-LIEN-STATUS THRU S1200-EXIT DTSCS44 +02273 *SRJ PERFORM S1300-FIELD-REP-ID THRU S1300-EXIT CL**4 +02274 PERFORM S2100-RECORDR-OF-DEEDS-NO THRU S2100-EXIT DTSCS44 +02275 PERFORM S2200-CERTIFICATE-DATE THRU S2200-EXIT DTSCS44 +02276 PERFORM S2300-CERTIFIED-MAIL-NO THRU S2300-EXIT DTSCS44 +02277 PERFORM S2400-CERTIFIED-MAIL-DATE THRU S2400-EXIT DTSCS44 +02278 PERFORM S2500-RETURN-MAIL-DATE THRU S2500-EXIT DTSCS44 +02279 PERFORM S2600-CURR-COMP-DATE THRU S2600-EXIT DTSCS44 +02280 END-IF DTSCS44 +02281 END-IF. DTSCS44 +02282 DTSCS44 +02283 IF LCCM-MSG DTSCS44 +02284 GO TO S1000-EXIT. DTSCS44 02285 DTSCS44 -02286 IF L018-NOT-VALID DTSCS44 -02287 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02288 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -02289 GO TO S1101-EXIT. DTSCS44 -02290 DTSCS44 -02291 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS44 -02292 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS44 -02293 S1101-EXIT. EXIT. DTSCS44 -02294 DTSCS44 -02295 S1110-READ-MPRF. DTSCS44 -02296 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS44 -02297 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS44 -02298 SET MPRF-PRF-88 TO TRUE. DTSCS44 -02299 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -02300 PERFORM S810-READ THRU S810-EXIT. DTSCS44 -02301 IF L810-NO-REC-88 DTSCS44 -02302 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS44 -02303 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -02304 ELSE DTSCS44 -02305 MOVE MSKL-REC TO MPRF-REC DTSCS44 -02306 SET WRK-MPRF-YES-88 TO TRUE. DTSCS44 -02307 S1110-EXIT. DTSCS44 -02308 EXIT. DTSCS44 +02286 PERFORM S3000-MISC-EDITS THRU S3000-EXIT. DTSCS44 +02287 S1000-EXIT. EXIT. DTSCS44 +02288 EJECT DTSCS44 +02289 DTSCS44 +02290 S1100-EDIT-KEY. DTSCS44 +02291 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS44 +02292 S1100-EXIT. EXIT. DTSCS44 +02293 /*****************************************************************DTSCS44 +02294 * DTSCS44 +02295 ******************************************************************DTSCS44 +02296 S1101-EMP-NO. DTSCS44 +02297 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS44 +02298 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS44 +02299 DTSCS44 +02300 IF L018-NO-ENTRY DTSCS44 +02301 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02302 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +02303 GO TO S1101-EXIT. DTSCS44 +02304 DTSCS44 +02305 IF L018-NOT-VALID DTSCS44 +02306 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02307 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +02308 GO TO S1101-EXIT. DTSCS44 02309 DTSCS44 -02310 S1120-READ-MLIN. DTSCS44 -02311 MOVE LCCM-SCR44-HOLD-AREA TO MSKL-KEY-AREA. DTSCS44 -02312 DTSCS44 -02313 PERFORM S810-READ THRU S810-EXIT. DTSCS44 -02314 DTSCS44 -02315 IF L810-NO-REC-88 DTSCS44 -02316 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -02317 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -02318 ELSE DTSCS44 -02319 MOVE MSKL-REC TO MLIN-REC DTSCS44 -02320 SET WRK-MLIN-YES-88 TO TRUE. DTSCS44 -02321 S1120-EXIT. DTSCS44 -02322 EXIT. DTSCS44 -02323 DTSCS44 -02324 S1199-ERROR. DTSCS44 -02325 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS44 -02326 MAP-EMP-NO-2-A. DTSCS44 -02327 IF LCCM-NO-MSG DTSCS44 -02328 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02329 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS44 -02330 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02331 S1199-EXIT. EXIT. DTSCS44 -02332 DTSCS44 -02333 /*****************************************************************DTSCS44 -02334 * *DTSCS44 -02335 ******************************************************************DTSCS44 -02336 S1200-LIEN-STATUS. DTSCS44 -02337 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS44 -02338 MOVE 'O' TO MAP-STATUS-CD DTSCS44 -02339 ELSE DTSCS44 -02340 MOVE MAP-STATUS-CD TO L034-CD DTSCS44 -02341 PERFORM S034-MLIN-STATUS-CD THRU S034-EXIT DTSCS44 -02342 IF NOT L034-VALID DTSCS44 -02343 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02344 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 -02345 GO TO S1200-EXIT. DTSCS44 -02346 DTSCS44 -02347 IF LCCM-F09-88 DTSCS44 -02348 PERFORM S1210-ADD THRU S1210-EXIT DTSCS44 -02349 ELSE DTSCS44 -02350 PERFORM S1220-MOD THRU S1220-EXIT. DTSCS44 -02351 S1200-EXIT. EXIT. DTSCS44 -02352 DTSCS44 -02353 S1201-ERROR. DTSCS44 -02354 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS44 -02355 TO MAP-STATUS-CD-A. DTSCS44 -02356 IF LCCM-NO-MSG DTSCS44 -02357 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02358 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS44 -02359 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02360 S1201-EXIT. EXIT. DTSCS44 -02361 DTSCS44 -02362 S1210-ADD. DTSCS44 -02363 IF MAP-STATUS-CD = 'O' OR 'C' OR 'M' DTSCS44 -02364 NEXT SENTENCE DTSCS44 -02365 ELSE DTSCS44 -02366 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02367 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS44 -02368 S1210-EXIT. DTSCS44 -02369 EXIT. DTSCS44 -02370 DTSCS44 -02371 S1220-MOD. DTSCS44 -02372 IF MAP-STATUS-CD = MLIN-STATUS-CD DTSCS44 -02373 GO TO S1220-EXIT. DTSCS44 -02374 DTSCS44 -02375 IF MAP-STATUS-CD = 'O' OR 'C' OR 'M' DTSCS44 -02376 MOVE MSG-E443-AREA TO WRK-MSG-AREA DTSCS44 -02377 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 -02378 GO TO S1220-EXIT. DTSCS44 -02379 DTSCS44 -02380 IF MLIN-STATUS-ACTIVE-88 DTSCS44 -02381 IF MLIN-STMT-DUE-AMT = +0 DTSCS44 -02382 IF MAP-STATUS-CD = 'W' DTSCS44 -02383 NEXT SENTENCE DTSCS44 -02384 ELSE DTSCS44 -02385 MOVE MSG-E444-AREA TO WRK-MSG-AREA DTSCS44 -02386 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 -02387 ELSE DTSCS44 -02388 NEXT SENTENCE DTSCS44 -02389 ELSE DTSCS44 -02390 MOVE MSG-E443-AREA TO WRK-MSG-AREA DTSCS44 -02391 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS44 -02392 S1220-EXIT. DTSCS44 -02393 EXIT. DTSCS44 -02394 DTSCS44 -02395 S1300-FIELD-REP-ID. DTSCS44 -02396 DTSCS44 -02397 IF LCCM-F09-88 DTSCS44 -02398 PERFORM S1310-ADD-FIELD-REP THRU S1310-EXIT DTSCS44 -02399 ELSE DTSCS44 -02400 PERFORM S1320-MODIFY-FIELD-REP THRU S1320-EXIT. DTSCS44 -02401 S1300-EXIT. EXIT. DTSCS44 -02402 DTSCS44 -02403 S1301-ERROR. DTSCS44 -02404 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-CD-A. DTSCS44 -02405 IF LCCM-NO-MSG DTSCS44 -02406 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02407 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-CD-L DTSCS44 -02408 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02409 S1301-EXIT. EXIT. DTSCS44 -02410 DTSCS44 -02411 S1310-ADD-FIELD-REP. DTSCS44 -02412 IF MAP-FLD-REP-ID-CD EQUAL LOW-VALUES OR SPACES DTSCS44 -02413 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02414 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS44 -02415 ELSE DTSCS44 -02416 MOVE MAP-FLD-REP-ID-CD TO L062-FLD-REP-ID DTSCS44 -02417 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS44 -02418 IF L062-NOT-VALID DTSCS44 -02419 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02420 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS44 -02421 ELSE DTSCS44 -02422 MOVE L062-OP-ID TO MAP-FLD-REP-ID-CD-DSCR DTSCS44 -02423 END-IF DTSCS44 -02424 END-IF. DTSCS44 -02425 S1310-EXIT. EXIT. DTSCS44 -02426 DTSCS44 -02427 S1320-MODIFY-FIELD-REP. DTSCS44 -02428 IF LCCM-OP-IS-FLD-DESK-88 DTSCS44 -02429 MOVE MAP-FLD-REP-ID-CD TO L062-FLD-REP-ID DTSCS44 -02430 PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT DTSCS44 -02431 IF L062-NOT-VALID DTSCS44 -02432 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02433 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS44 -02434 ELSE DTSCS44 -02435 NEXT SENTENCE DTSCS44 -02436 END-IF DTSCS44 -02437 ELSE DTSCS44 -02438 MOVE MLIN-FLD-REP-ID TO MAP-FLD-REP-ID-CD DTSCS44 -02439 END-IF. DTSCS44 -02440 S1320-EXIT. EXIT. DTSCS44 -02441 DTSCS44 -02442 /*****************************************************************DTSCS44 -02443 * *DTSCS44 -02444 ******************************************************************DTSCS44 -02445 S1400-STMT-DATE. DTSCS44 -02446 MOVE +0 TO WRK-STMT-DATE. DTSCS44 -02447 MOVE MAP-STMT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -02448 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -02449 DTSCS44 -02450 IF L015-NO-ENTRY DTSCS44 -02451 IF MAP-STATUS-CD = 'C' DTSCS44 -02452 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02453 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 -02454 ELSE DTSCS44 -02455 MOVE LCCM-CURR-MAIL-DATE TO WRK-DISPLAY DTSCS44 -02456 WRK-STMT-DATE DTSCS44 -02457 MOVE WRK-DISPLAY-MO TO MAP-STMT-MO DTSCS44 -02458 MOVE WRK-DISPLAY-DA TO MAP-STMT-DA DTSCS44 -02459 MOVE WRK-DISPLAY-YR TO MAP-STMT-YR DTSCS44 -02460 ELSE DTSCS44 -02461 IF L015-NOT-VALID DTSCS44 -02462 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02463 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 -02464 ELSE DTSCS44 -02465 IF (MAP-STATUS-CD = 'O') DTSCS44 -02466 AND (L015-DATE < LCCM-CURR-RUN-DATE) DTSCS44 -02467 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS44 -02468 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 -02469 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 -02470 ELSE DTSCS44 -02471 IF (MAP-STATUS-CD = 'C') DTSCS44 -02472 AND (L015-DATE > LCCM-CURR-RUN-DATE) DTSCS44 -02473 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS44 -02474 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 -02475 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 -02476 ELSE DTSCS44 -02477 MOVE L015-DATE TO WRK-STMT-DATE. DTSCS44 -02478 S1400-EXIT. DTSCS44 -02479 EXIT. DTSCS44 -02480 DTSCS44 -02481 S1401-ERROR. DTSCS44 -02482 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 -02483 TO MAP-STMT-MO-A DTSCS44 -02484 MAP-STMT-DA-A DTSCS44 -02485 MAP-STMT-YR-A. DTSCS44 -02486 IF LCCM-NO-MSG DTSCS44 -02487 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02488 MOVE CATB-CURSOR TO MAP-STMT-MO-L DTSCS44 -02489 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02490 S1401-EXIT. EXIT. DTSCS44 -02491 DTSCS44 -02492 /*****************************************************************DTSCS44 -02493 * *DTSCS44 -02494 ******************************************************************DTSCS44 -02495 S1500-STMT-COMP-DATE. DTSCS44 -02496 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -02497 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -02498 DTSCS44 -02499 IF L015-NO-ENTRY DTSCS44 -02500 IF MAP-STATUS-CD = 'O' DTSCS44 -02501 IF WRK-STMT-DATE = +0 DTSCS44 -02502 NEXT SENTENCE DTSCS44 -02503 ELSE DTSCS44 -02504 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSCS44 -02505 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS44 -02506 ADD +14 TO L001-JUL-ABS-DAY DTSCS44 -02507 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSCS44 -02508 MOVE L001-CAL-6-MO TO MAP-COMP-MO DTSCS44 -02509 MOVE L001-CAL-6-DA TO MAP-COMP-DA DTSCS44 -02510 MOVE L001-CAL-6-YR TO MAP-COMP-YR DTSCS44 -02511 ELSE DTSCS44 -02512 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02513 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS44 -02514 ELSE DTSCS44 -02515 IF L015-NOT-VALID DTSCS44 -02516 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02517 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS44 -02518 S1500-EXIT. DTSCS44 -02519 EXIT. DTSCS44 -02520 DTSCS44 -02521 S1501-ERROR. DTSCS44 -02522 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 -02523 TO MAP-COMP-MO-A DTSCS44 -02524 MAP-COMP-DA-A DTSCS44 -02525 MAP-COMP-YR-A. DTSCS44 -02526 IF LCCM-NO-MSG DTSCS44 -02527 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02528 MOVE CATB-CURSOR TO MAP-COMP-MO-L DTSCS44 -02529 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02530 S1501-EXIT. EXIT. DTSCS44 -02531 DTSCS44 -02532 /*****************************************************************DTSCS44 -02533 * *DTSCS44 -02534 ******************************************************************DTSCS44 -02535 S1600-STMT-DUE-AMT. DTSCS44 -02536 IF MAP-STATUS-CD = 'O' DTSCS44 -02537 MOVE LOW-VALUES TO MAP-STMT-DUE-AMT DTSCS44 -02538 GO TO S1600-EXIT. DTSCS44 -02539 DTSCS44 -02540 MOVE MAP-STMT-DUE-AMT-AREA TO L011-S-AMT-AREA. DTSCS44 -02541 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS44 -02542 DTSCS44 -02543 IF L011-NO-ENTRY DTSCS44 -02544 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02545 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 -02546 GO TO S1600-EXIT. DTSCS44 -02547 DTSCS44 -02548 IF L011-INVALID-NEGATIVE DTSCS44 -02549 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS44 -02550 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 -02551 GO TO S1600-EXIT. DTSCS44 -02552 DTSCS44 -02553 IF L011-EXCEEDS-MIN-MAX DTSCS44 -02554 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS44 -02555 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 -02556 GO TO S1600-EXIT. DTSCS44 -02557 DTSCS44 -02558 IF L011-NOT-VALID DTSCS44 -02559 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02560 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 -02561 GO TO S1600-EXIT. DTSCS44 -02562 DTSCS44 -02563 MOVE L011-AMT TO MAP-STMT-DUE-AMT-Z. DTSCS44 -02564 S1600-EXIT. DTSCS44 -02565 EXIT. DTSCS44 -02566 DTSCS44 -02567 S1601-ERROR. DTSCS44 -02568 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-DUE-AMT-A. DTSCS44 -02569 IF LCCM-NO-MSG DTSCS44 -02570 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02571 MOVE CATB-CURSOR TO MAP-STMT-DUE-AMT-L DTSCS44 -02572 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02573 S1601-EXIT. EXIT. DTSCS44 -02574 /*****************************************************************DTSCS44 -02575 * *DTSCS44 -02576 ******************************************************************DTSCS44 -02577 S1700-LICENSE. DTSCS44 -02578 IF MAP-LICENSE-IND = LOW-VALUES OR SPACES DTSCS44 -02579 SET MAP-LICENSE-IND-NO TO TRUE DTSCS44 -02580 ELSE DTSCS44 -02581 IF NOT MAP-LICENSE-IND-VALID DTSCS44 -02582 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02583 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS44 -02584 S1700-EXIT. DTSCS44 -02585 EXIT. DTSCS44 -02586 DTSCS44 -02587 S1701-ERROR. DTSCS44 -02588 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LICENSE-IND-A. DTSCS44 -02589 IF LCCM-NO-MSG DTSCS44 -02590 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02591 MOVE CATB-CURSOR TO MAP-LICENSE-IND-L DTSCS44 -02592 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02593 S1701-EXIT. EXIT. DTSCS44 -02594 /*****************************************************************DTSCS44 -02595 * *DTSCS44 -02596 ******************************************************************DTSCS44 -02597 S1900-MAIL-ADDRESS. DTSCS44 -02598 PERFORM S1910-ADDR-TYPE THRU S1910-EXIT. DTSCS44 -02599 DTSCS44 -02600 PERFORM S1920-ADDR-ID-NO THRU S1920-EXIT. DTSCS44 -02601 S1900-EXIT. DTSCS44 -02602 EXIT. DTSCS44 -02603 /*****************************************************************DTSCS44 -02604 * DTSCS44 -02605 ******************************************************************DTSCS44 -02606 S1910-ADDR-TYPE. DTSCS44 -02607 ** IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS44 -02608 ** SET MAP-ADDR-TAX-88 TO TRUE DTSCS44 -02609 ** ELSE DTSCS44 -02610 IF MAP-ADDR-VALID-88 DTSCS44 -02611 NEXT SENTENCE DTSCS44 -02612 ELSE DTSCS44 -02613 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02614 PERFORM S1911-ERROR THRU S1911-EXIT. DTSCS44 -02615 S1910-EXIT. EXIT. DTSCS44 -02616 DTSCS44 -02617 S1911-ERROR. DTSCS44 -02618 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS44 -02619 IF LCCM-NO-MSG DTSCS44 -02620 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02621 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS44 -02622 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02623 S1911-EXIT. EXIT. DTSCS44 -02624 /*****************************************************************DTSCS44 -02625 * DTSCS44 -02626 ******************************************************************DTSCS44 -02627 S1920-ADDR-ID-NO. DTSCS44 -02628 INSPECT MAP-ADDR-ID-NO DTSCS44 -02629 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02630 DTSCS44 -02631 IF MAP-ADDR-ID-NO = SPACES DTSCS44 -02632 IF MAP-ADDR-TAD-88 DTSCS44 -02633 PERFORM S1930-ADDR-TAD THRU S1930-EXIT DTSCS44 -02634 GO TO S1920-EXIT DTSCS44 -02635 ELSE DTSCS44 -02636 IF MAP-ADDR-NONE-88 DTSCS44 -02637 PERFORM S1940-REQUIRE-ADDRESS THRU S1940-EXIT DTSCS44 -02638 GO TO S1920-EXIT DTSCS44 -02639 ELSE DTSCS44 -02640 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02641 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 -02642 GO TO S1920-EXIT. DTSCS44 -02643 DTSCS44 -02644 IF MAP-ADDR-NONE-88 OR MAP-ADDR-TAD-88 DTSCS44 -02645 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 -02646 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 -02647 GO TO S1920-EXIT. DTSCS44 -02648 DTSCS44 -02649 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS44 -02650 MOVE +1 TO L013-MIN-CNT DTSCS44 -02651 MOVE +999 TO L013-MAX-CNT. DTSCS44 +02310 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS44 +02311 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS44 +02312 S1101-EXIT. EXIT. DTSCS44 +02313 DTSCS44 +02314 S1110-READ-MPRF. DTSCS44 +02315 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS44 +02316 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS44 +02317 SET MPRF-PRF-88 TO TRUE. DTSCS44 +02318 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +02319 PERFORM S810-READ THRU S810-EXIT. DTSCS44 +02320 IF L810-NO-REC-88 DTSCS44 +02321 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS44 +02322 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +02323 ELSE DTSCS44 +02324 MOVE MSKL-REC TO MPRF-REC DTSCS44 +02325 SET WRK-MPRF-YES-88 TO TRUE. DTSCS44 +02326 S1110-EXIT. DTSCS44 +02327 EXIT. DTSCS44 +02328 DTSCS44 +02329 S1120-READ-MLIN. DTSCS44 +02330 MOVE LCCM-SCR44-HOLD-AREA TO MSKL-KEY-AREA. DTSCS44 +02331 DTSCS44 +02332 PERFORM S810-READ THRU S810-EXIT. DTSCS44 +02333 DTSCS44 +02334 IF L810-NO-REC-88 DTSCS44 +02335 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +02336 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +02337 ELSE DTSCS44 +02338 MOVE MSKL-REC TO MLIN-REC DTSCS44 +02339 SET WRK-MLIN-YES-88 TO TRUE. DTSCS44 +02340 S1120-EXIT. DTSCS44 +02341 EXIT. DTSCS44 +02342 DTSCS44 +02343 S1199-ERROR. DTSCS44 +02344 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS44 +02345 MAP-EMP-NO-2-A. DTSCS44 +02346 IF LCCM-NO-MSG DTSCS44 +02347 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02348 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS44 +02349 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02350 S1199-EXIT. EXIT. DTSCS44 +02351 DTSCS44 +02352 /*****************************************************************DTSCS44 +02353 * *DTSCS44 +02354 ******************************************************************DTSCS44 +02355 S1200-LIEN-STATUS. DTSCS44 +02356 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS44 +02357 MOVE 'O' TO MAP-STATUS-CD DTSCS44 +02358 ELSE DTSCS44 +02359 MOVE MAP-STATUS-CD TO L034-CD DTSCS44 +02360 PERFORM S034-MLIN-STATUS-CD THRU S034-EXIT DTSCS44 +02361 IF NOT L034-VALID DTSCS44 +02362 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02363 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 +02364 GO TO S1200-EXIT. DTSCS44 +02365 CL*18 +02366 IF MLIN-STATUS-CD = 'R' CL*23 +02367 IF MAP-STATUS-CD = 'R' CL*23 +02368 NEXT SENTENCE CL*23 +02369 ELSE CL*23 +02370 MOVE MSG-E44B-AREA TO WRK-MSG-AREA CL*23 +02371 PERFORM S1201-ERROR THRU S1201-EXIT CL*23 +02372 GO TO S1200-EXIT CL*24 +02373 END-IF CL*26 +02374 END-IF. CL*24 +02375 CL*27 +02376 IF MLIN-STATUS-CD NOT EQUAL TO 'R' CL*27 +02377 IF MAP-STATUS-CD = 'R' CL*27 +02378 MOVE MSG-E44C-AREA TO WRK-MSG-AREA CL*27 +02379 PERFORM S1201-ERROR THRU S1201-EXIT CL*27 +02380 GO TO S1200-EXIT CL*27 +02381 END-IF CL*27 +02382 END-IF. CL*27 +02383 * MOVE MAP-CURR-TOT-DUE TO WRK-STRING CL*23 +02384 CL*21 +02385 * INSPECT WRK-STRING CL*23 +02386 * REPLACING ALL ',' BY '' CL*23 +02387 * ALL '.' BY '' CL*23 +02388 * ALL SPACES BY ZERO CL*23 +02389 CL*21 +02390 * MOVE WRK-STRING TO WRK-MAP-CURR-TOT-DUE CL*23 +02391 CL*21 +02392 * MOVE MAP-CURR-TOT-DUE TO WRK-MAP-CURR-TOT-DUE CL*21 +02393 DTSCS44 +02394 * IF MAP-STATUS-CD = 'R' AND WRK-MAP-CURR-TOT-DUE > 0 CL*23 +02395 * MOVE 'LIEN CANNOT BE RELEASED WHEN CURR-TOT-DUE > 0' CL*23 +02396 * TO WRK-MSG-AREA CL*23 +02397 * PERFORM S1201-ERROR THRU S1201-EXIT CL*23 +02398 * GO TO S1200-EXIT. CL*23 +02399 CL*13 +02400 IF LCCM-F09-88 DTSCS44 +02401 PERFORM S1210-ADD THRU S1210-EXIT DTSCS44 +02402 ELSE DTSCS44 +02403 PERFORM S1220-MOD THRU S1220-EXIT. DTSCS44 +02404 S1200-EXIT. EXIT. DTSCS44 +02405 DTSCS44 +02406 S1201-ERROR. DTSCS44 +02407 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS44 +02408 TO MAP-STATUS-CD-A. DTSCS44 +02409 IF LCCM-NO-MSG DTSCS44 +02410 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02411 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS44 +02412 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02413 S1201-EXIT. EXIT. DTSCS44 +02414 DTSCS44 +02415 S1210-ADD. DTSCS44 +02416 IF MAP-STATUS-CD = 'O' OR 'C' OR 'M' DTSCS44 +02417 NEXT SENTENCE DTSCS44 +02418 ELSE DTSCS44 +02419 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02420 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS44 +02421 S1210-EXIT. DTSCS44 +02422 EXIT. DTSCS44 +02423 DTSCS44 +02424 S1220-MOD. DTSCS44 +02425 IF MAP-STATUS-CD = MLIN-STATUS-CD DTSCS44 +02426 GO TO S1220-EXIT. DTSCS44 +02427 DTSCS44 +02428 IF MAP-STATUS-CD = 'O' OR 'C' OR 'M' DTSCS44 +02429 MOVE MSG-E443-AREA TO WRK-MSG-AREA DTSCS44 +02430 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 +02431 GO TO S1220-EXIT. DTSCS44 +02432 DTSCS44 +02433 IF MLIN-STATUS-ACTIVE-88 DTSCS44 +02434 IF MLIN-STMT-DUE-AMT = +0 DTSCS44 +02435 IF MAP-STATUS-CD = 'W' DTSCS44 +02436 NEXT SENTENCE DTSCS44 +02437 ELSE DTSCS44 +02438 MOVE MSG-E444-AREA TO WRK-MSG-AREA DTSCS44 +02439 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 +02440 ELSE DTSCS44 +02441 NEXT SENTENCE DTSCS44 +02442 ELSE DTSCS44 +02443 MOVE MSG-E443-AREA TO WRK-MSG-AREA DTSCS44 +02444 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS44 +02445 S1220-EXIT. DTSCS44 +02446 EXIT. DTSCS44 +02447 DTSCS44 +02448 *S1300-FIELD-REP-ID. CL**9 +02449 * CL**9 +02450 * IF LCCM-F09-88 CL**9 +02451 * PERFORM S1310-ADD-FIELD-REP THRU S1310-EXIT CL**9 +02452 * ELSE CL**9 +02453 * PERFORM S1320-MODIFY-FIELD-REP THRU S1320-EXIT. CL**9 +02454 *S1300-EXIT. EXIT. CL**9 +02455 DTSCS44 +02456 *S1301-ERROR. CL**7 +02457 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-CD-A. CL**7 +02458 * IF LCCM-NO-MSG CL**7 +02459 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL**7 +02460 * MOVE CATB-CURSOR TO MAP-FLD-REP-ID-CD-L CL**7 +02461 * SET CURSOR-SET-YES TO TRUE. CL**7 +02462 *S1301-EXIT. EXIT. CL**7 +02463 DTSCS44 +02464 *S1310-ADD-FIELD-REP. CL**7 +02465 * IF MAP-FLD-REP-ID-CD EQUAL LOW-VALUES OR SPACES CL**7 +02466 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA CL**7 +02467 * PERFORM S1301-ERROR THRU S1301-EXIT CL**7 +02468 * ELSE CL**7 +02469 * MOVE MAP-FLD-REP-ID-CD TO L062-FLD-REP-ID CL**7 +02470 * PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT CL**7 +02471 * IF L062-NOT-VALID CL**7 +02472 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL**7 +02473 * PERFORM S1301-ERROR THRU S1301-EXIT CL**7 +02474 * ELSE CL**7 +02475 * MOVE L062-OP-ID TO MAP-FLD-REP-ID-CD-DSCR CL**7 +02476 * END-IF CL**7 +02477 * END-IF. CL**7 +02478 *S1310-EXIT. EXIT. CL**7 +02479 * CL**7 +02480 *S1320-MODIFY-FIELD-REP. CL**7 +02481 * IF LCCM-OP-IS-FLD-DESK-88 CL**7 +02482 * MOVE MAP-FLD-REP-ID-CD TO L062-FLD-REP-ID CL**7 +02483 * PERFORM S062-FLD-REP-ID-DESC THRU S062-EXIT CL**7 +02484 * IF L062-NOT-VALID CL**7 +02485 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL**7 +02486 * PERFORM S1301-ERROR THRU S1301-EXIT CL**7 +02487 * ELSE CL**7 +02488 * NEXT SENTENCE CL**7 +02489 * END-IF CL**7 +02490 * ELSE CL**7 +02491 * MOVE MLIN-FLD-REP-ID TO MAP-FLD-REP-ID-CD CL**7 +02492 * END-IF. CL**7 +02493 *S1320-EXIT. EXIT. CL**7 +02494 * CL**7 +02495 /*****************************************************************DTSCS44 +02496 * *DTSCS44 +02497 ******************************************************************DTSCS44 +02498 S1400-STMT-DATE. DTSCS44 +02499 MOVE +0 TO WRK-STMT-DATE. DTSCS44 +02500 MOVE MAP-STMT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +02501 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +02502 DTSCS44 +02503 IF L015-NO-ENTRY DTSCS44 +02504 IF MAP-STATUS-CD = 'C' DTSCS44 +02505 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02506 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 +02507 ELSE DTSCS44 +02508 MOVE LCCM-CURR-MAIL-DATE TO WRK-DISPLAY DTSCS44 +02509 WRK-STMT-DATE DTSCS44 +02510 MOVE WRK-DISPLAY-MO TO MAP-STMT-MO DTSCS44 +02511 MOVE WRK-DISPLAY-DA TO MAP-STMT-DA DTSCS44 +02512 MOVE WRK-DISPLAY-YR TO MAP-STMT-YR DTSCS44 +02513 ELSE DTSCS44 +02514 IF L015-NOT-VALID DTSCS44 +02515 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02516 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 +02517 ELSE DTSCS44 +02518 IF (MAP-STATUS-CD = 'O') DTSCS44 +02519 AND (L015-DATE < LCCM-CURR-RUN-DATE) DTSCS44 +02520 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS44 +02521 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 +02522 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 +02523 ELSE DTSCS44 +02524 IF (MAP-STATUS-CD = 'C') DTSCS44 +02525 AND (L015-DATE > LCCM-CURR-RUN-DATE) DTSCS44 +02526 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS44 +02527 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS44 +02528 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS44 +02529 ELSE DTSCS44 +02530 MOVE L015-DATE TO WRK-STMT-DATE. DTSCS44 +02531 S1400-EXIT. DTSCS44 +02532 EXIT. DTSCS44 +02533 DTSCS44 +02534 S1401-ERROR. DTSCS44 +02535 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 +02536 TO MAP-STMT-MO-A DTSCS44 +02537 MAP-STMT-DA-A DTSCS44 +02538 MAP-STMT-YR-A. DTSCS44 +02539 IF LCCM-NO-MSG DTSCS44 +02540 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02541 MOVE CATB-CURSOR TO MAP-STMT-MO-L DTSCS44 +02542 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02543 S1401-EXIT. EXIT. DTSCS44 +02544 DTSCS44 +02545 /*****************************************************************DTSCS44 +02546 * *DTSCS44 +02547 ******************************************************************DTSCS44 +02548 S1500-STMT-COMP-DATE. DTSCS44 +02549 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +02550 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +02551 DTSCS44 +02552 IF L015-NO-ENTRY DTSCS44 +02553 IF MAP-STATUS-CD = 'O' DTSCS44 +02554 IF WRK-STMT-DATE = +0 DTSCS44 +02555 NEXT SENTENCE DTSCS44 +02556 ELSE DTSCS44 +02557 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSCS44 +02558 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS44 +02559 ADD +14 TO L001-JUL-ABS-DAY DTSCS44 +02560 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSCS44 +02561 MOVE L001-CAL-6-MO TO MAP-COMP-MO DTSCS44 +02562 MOVE L001-CAL-6-DA TO MAP-COMP-DA DTSCS44 +02563 MOVE L001-CAL-6-YR TO MAP-COMP-YR DTSCS44 +02564 ELSE DTSCS44 +02565 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02566 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS44 +02567 ELSE DTSCS44 +02568 IF L015-NOT-VALID DTSCS44 +02569 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02570 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS44 +02571 S1500-EXIT. DTSCS44 +02572 EXIT. DTSCS44 +02573 DTSCS44 +02574 S1501-ERROR. DTSCS44 +02575 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 +02576 TO MAP-COMP-MO-A DTSCS44 +02577 MAP-COMP-DA-A DTSCS44 +02578 MAP-COMP-YR-A. DTSCS44 +02579 IF LCCM-NO-MSG DTSCS44 +02580 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02581 MOVE CATB-CURSOR TO MAP-COMP-MO-L DTSCS44 +02582 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02583 S1501-EXIT. EXIT. DTSCS44 +02584 DTSCS44 +02585 /*****************************************************************DTSCS44 +02586 * *DTSCS44 +02587 ******************************************************************DTSCS44 +02588 S1600-STMT-DUE-AMT. DTSCS44 +02589 IF MAP-STATUS-CD = 'O' DTSCS44 +02590 MOVE LOW-VALUES TO MAP-STMT-DUE-AMT DTSCS44 +02591 GO TO S1600-EXIT. DTSCS44 +02592 DTSCS44 +02593 MOVE MAP-STMT-DUE-AMT-AREA TO L011-S-AMT-AREA. DTSCS44 +02594 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS44 +02595 DTSCS44 +02596 IF L011-NO-ENTRY DTSCS44 +02597 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02598 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 +02599 GO TO S1600-EXIT. DTSCS44 +02600 DTSCS44 +02601 IF L011-INVALID-NEGATIVE DTSCS44 +02602 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS44 +02603 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 +02604 GO TO S1600-EXIT. DTSCS44 +02605 DTSCS44 +02606 IF L011-EXCEEDS-MIN-MAX DTSCS44 +02607 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS44 +02608 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 +02609 GO TO S1600-EXIT. DTSCS44 +02610 DTSCS44 +02611 IF L011-NOT-VALID DTSCS44 +02612 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02613 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS44 +02614 GO TO S1600-EXIT. DTSCS44 +02615 DTSCS44 +02616 MOVE L011-AMT TO MAP-STMT-DUE-AMT-Z. DTSCS44 +02617 S1600-EXIT. DTSCS44 +02618 EXIT. DTSCS44 +02619 DTSCS44 +02620 S1601-ERROR. DTSCS44 +02621 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-DUE-AMT-A. DTSCS44 +02622 IF LCCM-NO-MSG DTSCS44 +02623 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02624 MOVE CATB-CURSOR TO MAP-STMT-DUE-AMT-L DTSCS44 +02625 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02626 S1601-EXIT. EXIT. DTSCS44 +02627 /*****************************************************************DTSCS44 +02628 * *DTSCS44 +02629 ******************************************************************DTSCS44 +02630 S1700-LICENSE. DTSCS44 +02631 IF MAP-LICENSE-IND = LOW-VALUES OR SPACES DTSCS44 +02632 SET MAP-LICENSE-IND-NO TO TRUE DTSCS44 +02633 ELSE DTSCS44 +02634 IF NOT MAP-LICENSE-IND-VALID DTSCS44 +02635 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02636 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS44 +02637 S1700-EXIT. DTSCS44 +02638 EXIT. DTSCS44 +02639 DTSCS44 +02640 S1701-ERROR. DTSCS44 +02641 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LICENSE-IND-A. DTSCS44 +02642 IF LCCM-NO-MSG DTSCS44 +02643 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02644 MOVE CATB-CURSOR TO MAP-LICENSE-IND-L DTSCS44 +02645 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02646 S1701-EXIT. EXIT. DTSCS44 +02647 /*****************************************************************DTSCS44 +02648 * *DTSCS44 +02649 ******************************************************************DTSCS44 +02650 S1900-MAIL-ADDRESS. DTSCS44 +02651 PERFORM S1910-ADDR-TYPE THRU S1910-EXIT. DTSCS44 02652 DTSCS44 -02653 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS44 -02654 DTSCS44 -02655 IF L013-VALID DTSCS44 -02656 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS44 -02657 IF MAP-ADDR-TAA-OPO-88 DTSCS44 -02658 PERFORM S1950-ADDR-TAA-OPO THRU S1950-EXIT DTSCS44 -02659 ELSE DTSCS44 -02660 NEXT SENTENCE DTSCS44 -02661 ELSE DTSCS44 -02662 IF L013-NO-ENTRY DTSCS44 -02663 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02664 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02653 PERFORM S1920-ADDR-ID-NO THRU S1920-EXIT. DTSCS44 +02654 S1900-EXIT. DTSCS44 +02655 EXIT. DTSCS44 +02656 /*****************************************************************DTSCS44 +02657 * DTSCS44 +02658 ******************************************************************DTSCS44 +02659 S1910-ADDR-TYPE. DTSCS44 +02660 ** IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS44 +02661 ** SET MAP-ADDR-TAX-88 TO TRUE DTSCS44 +02662 ** ELSE DTSCS44 +02663 IF MAP-ADDR-VALID-88 DTSCS44 +02664 NEXT SENTENCE DTSCS44 02665 ELSE DTSCS44 -02666 IF L013-INVALID-NEGATIVE DTSCS44 -02667 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS44 -02668 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 -02669 ELSE DTSCS44 -02670 IF L013-EXCEEDS-MIN-MAX DTSCS44 -02671 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS44 -02672 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 -02673 ELSE DTSCS44 -02674 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02675 PERFORM S1921-ERROR THRU S1921-EXIT. DTSCS44 -02676 S1920-EXIT. EXIT. DTSCS44 -02677 DTSCS44 -02678 S1921-ERROR. DTSCS44 -02679 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A DTSCS44 -02680 IF LCCM-NO-MSG DTSCS44 -02681 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02682 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS44 -02683 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02684 S1921-EXIT. EXIT. DTSCS44 -02685 DTSCS44 -02686 S1930-ADDR-TAD. DTSCS44 -02687 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS44 -02688 IF MAP-ADDR-TAX-88 DTSCS44 -02689 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS44 -02690 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS44 -02691 ELSE DTSCS44 -02692 IF MAP-ADDR-PHY-88 DTSCS44 -02693 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS44 -02694 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS44 -02695 ELSE DTSCS44 -02696 GO TO S899-ABEND. DTSCS44 -02697 DTSCS44 -02698 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS44 -02699 DTSCS44 -02700 IF L111-ADDR-NOT-FOUND-88 DTSCS44 -02701 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS44 -02702 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 -02703 GO TO S1930-EXIT. DTSCS44 -02704 DTSCS44 -02705 PERFORM S1960-FORMAT-ADDR THRU S1960-EXIT. DTSCS44 -02706 S1930-EXIT. DTSCS44 -02707 EXIT. DTSCS44 -02708 S1940-REQUIRE-ADDRESS. DTSCS44 -02709 INSPECT MAP-LIEN-ADDR-LINE-1 DTSCS44 -02710 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02711 INSPECT MAP-LIEN-ADDR-LINE-2 DTSCS44 -02712 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02713 INSPECT MAP-LIEN-ADDR-LINE-3 DTSCS44 -02714 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02715 INSPECT MAP-LIEN-ADDR-LINE-4 DTSCS44 -02716 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02717 INSPECT MAP-LIEN-ADDR-LINE-5 DTSCS44 -02718 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02719 DTSCS44 -02720 IF (MAP-LIEN-ADDR-LINE-1 = SPACES) DTSCS44 -02721 AND DTSCS44 -02722 (MAP-LIEN-ADDR-LINE-2 = SPACES) DTSCS44 -02723 AND DTSCS44 -02724 (MAP-LIEN-ADDR-LINE-3 = SPACES) DTSCS44 -02725 AND DTSCS44 -02726 (MAP-LIEN-ADDR-LINE-4 = SPACES) DTSCS44 -02727 AND DTSCS44 -02728 (MAP-LIEN-ADDR-LINE-5 = SPACES) DTSCS44 -02729 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02730 PERFORM S1941-ERROR THRU S1941-EXIT. DTSCS44 -02731 S1940-EXIT. DTSCS44 -02732 EXIT. DTSCS44 -02733 DTSCS44 -02734 S1941-ERROR. DTSCS44 -02735 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS44 -02736 TO MAP-LIEN-ADDR-LINE-1-A DTSCS44 -02737 MAP-LIEN-ADDR-LINE-2-A DTSCS44 -02738 MAP-LIEN-ADDR-LINE-3-A DTSCS44 -02739 MAP-LIEN-ADDR-LINE-4-A DTSCS44 -02740 MAP-LIEN-ADDR-LINE-5-A. DTSCS44 -02741 IF LCCM-NO-MSG DTSCS44 -02742 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02743 MOVE CATB-CURSOR TO MAP-LIEN-ADDR-LINE-1-L DTSCS44 -02744 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02745 S1941-EXIT. EXIT. DTSCS44 -02746 DTSCS44 -02747 S1950-ADDR-TAA-OPO. DTSCS44 -02748 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS44 -02749 IF MAP-ADDR-TAX-ALT-88 DTSCS44 -02750 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS44 -02751 ELSE DTSCS44 -02752 IF MAP-ADDR-OPO-88 DTSCS44 -02753 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS44 -02754 ELSE DTSCS44 -02755 GO TO S899-ABEND. DTSCS44 -02756 DTSCS44 -02757 IF L013-CNT = 0 DTSCS44 -02758 MOVE 1 TO L111-ID-NO DTSCS44 -02759 ELSE DTSCS44 -02760 MOVE L013-CNT TO L111-ID-NO. DTSCS44 -02761 DTSCS44 -02762 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS44 -02763 DTSCS44 -02764 IF L111-ADDR-NOT-FOUND-88 DTSCS44 -02765 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS44 -02766 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 -02767 GO TO S1950-EXIT. DTSCS44 -02768 DTSCS44 -02769 PERFORM S1960-FORMAT-ADDR THRU S1960-EXIT. DTSCS44 -02770 S1950-EXIT. DTSCS44 -02771 EXIT. DTSCS44 -02772 S1960-FORMAT-ADDR. DTSCS44 -02773 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS44 -02774 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS44 -02775 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS44 -02776 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS44 -02777 DTSCS44 -02778 ***** PER A MEMO FROM RUDY, WHEN USING AN OPO ADDRESS DTSCS44 -02779 ***** AS A "LIEN DOCUMENT" ADDRESS, USE THE TAD ADDRESS DTSCS44 -02780 ***** FORMATTING RULES (RATHER THAN THE OPO ADDRESS DTSCS44 -02781 ***** FORMATTING RULES. 03/28/95 DTSCS44 -02782 DTSCS44 -02783 IF L112-OPO-ADDR-88 DTSCS44 -02784 SET L112-TAD-ADDR-88 TO TRUE. DTSCS44 -02785 DTSCS44 -02786 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS44 -02787 DTSCS44 -02788 MOVE L112-MAILING-LINE-1 TO MAP-LIEN-ADDR-LINE-1. DTSCS44 -02789 MOVE L112-MAILING-LINE-2 TO MAP-LIEN-ADDR-LINE-2. DTSCS44 -02790 MOVE L112-MAILING-LINE-3 TO MAP-LIEN-ADDR-LINE-3. DTSCS44 -02791 MOVE L112-MAILING-LINE-4 TO MAP-LIEN-ADDR-LINE-4. DTSCS44 -02792 MOVE L112-MAILING-LINE-5 TO MAP-LIEN-ADDR-LINE-5. DTSCS44 -02793 S1960-EXIT. EXIT. DTSCS44 -02794 /*****************************************************************DTSCS44 -02795 * DTSCS44 -02796 ******************************************************************DTSCS44 -02797 S2000-CERTIFICATE-NUM. DTSCS44 -02798 INSPECT MAP-CERT-NUM1 DTSCS44 -02799 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02800 DTSCS44 -02801 INSPECT MAP-CERT-NUM2 DTSCS44 -02802 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02803 DTSCS44 -02804 IF MAP-STATUS-CD = 'O' OR 'M' DTSCS44 -02805 IF MAP-CERT-NUM1 = SPACES AND MAP-CERT-NUM2 = SPACES DTSCS44 -02806 GO TO S2000-EXIT DTSCS44 -02807 ELSE DTSCS44 -02808 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 -02809 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 -02810 GO TO S2000-EXIT. DTSCS44 -02811 DTSCS44 -02812 DTSCS44 -02813 MOVE MAP-CERTIFICATE-NUM-AREA TO L028-S-NO-AREA. DTSCS44 +02666 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02667 PERFORM S1911-ERROR THRU S1911-EXIT. DTSCS44 +02668 S1910-EXIT. EXIT. DTSCS44 +02669 DTSCS44 +02670 S1911-ERROR. DTSCS44 +02671 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS44 +02672 IF LCCM-NO-MSG DTSCS44 +02673 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02674 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS44 +02675 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02676 S1911-EXIT. EXIT. DTSCS44 +02677 /*****************************************************************DTSCS44 +02678 * DTSCS44 +02679 ******************************************************************DTSCS44 +02680 S1920-ADDR-ID-NO. DTSCS44 +02681 INSPECT MAP-ADDR-ID-NO DTSCS44 +02682 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02683 DTSCS44 +02684 IF MAP-ADDR-ID-NO = SPACES DTSCS44 +02685 IF MAP-ADDR-TAD-88 DTSCS44 +02686 PERFORM S1930-ADDR-TAD THRU S1930-EXIT DTSCS44 +02687 GO TO S1920-EXIT DTSCS44 +02688 ELSE DTSCS44 +02689 IF MAP-ADDR-NONE-88 DTSCS44 +02690 PERFORM S1940-REQUIRE-ADDRESS THRU S1940-EXIT DTSCS44 +02691 GO TO S1920-EXIT DTSCS44 +02692 ELSE DTSCS44 +02693 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02694 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02695 GO TO S1920-EXIT. DTSCS44 +02696 DTSCS44 +02697 IF MAP-ADDR-NONE-88 OR MAP-ADDR-TAD-88 DTSCS44 +02698 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 +02699 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02700 GO TO S1920-EXIT. DTSCS44 +02701 DTSCS44 +02702 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS44 +02703 MOVE +1 TO L013-MIN-CNT DTSCS44 +02704 MOVE +999 TO L013-MAX-CNT. DTSCS44 +02705 DTSCS44 +02706 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS44 +02707 DTSCS44 +02708 IF L013-VALID DTSCS44 +02709 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS44 +02710 IF MAP-ADDR-TAA-OPO-88 DTSCS44 +02711 PERFORM S1950-ADDR-TAA-OPO THRU S1950-EXIT DTSCS44 +02712 ELSE DTSCS44 +02713 NEXT SENTENCE DTSCS44 +02714 ELSE DTSCS44 +02715 IF L013-NO-ENTRY DTSCS44 +02716 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02717 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02718 ELSE DTSCS44 +02719 IF L013-INVALID-NEGATIVE DTSCS44 +02720 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS44 +02721 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02722 ELSE DTSCS44 +02723 IF L013-EXCEEDS-MIN-MAX DTSCS44 +02724 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS44 +02725 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02726 ELSE DTSCS44 +02727 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02728 PERFORM S1921-ERROR THRU S1921-EXIT. DTSCS44 +02729 S1920-EXIT. EXIT. DTSCS44 +02730 DTSCS44 +02731 S1921-ERROR. DTSCS44 +02732 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A DTSCS44 +02733 IF LCCM-NO-MSG DTSCS44 +02734 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02735 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS44 +02736 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02737 S1921-EXIT. EXIT. DTSCS44 +02738 DTSCS44 +02739 S1930-ADDR-TAD. DTSCS44 +02740 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS44 +02741 IF MAP-ADDR-TAX-88 DTSCS44 +02742 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS44 +02743 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS44 +02744 ELSE DTSCS44 +02745 IF MAP-ADDR-PHY-88 DTSCS44 +02746 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS44 +02747 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS44 +02748 ELSE DTSCS44 +02749 GO TO S899-ABEND. DTSCS44 +02750 DTSCS44 +02751 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS44 +02752 DTSCS44 +02753 IF L111-ADDR-NOT-FOUND-88 DTSCS44 +02754 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS44 +02755 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02756 GO TO S1930-EXIT. DTSCS44 +02757 DTSCS44 +02758 PERFORM S1960-FORMAT-ADDR THRU S1960-EXIT. DTSCS44 +02759 S1930-EXIT. DTSCS44 +02760 EXIT. DTSCS44 +02761 S1940-REQUIRE-ADDRESS. DTSCS44 +02762 INSPECT MAP-LIEN-ADDR-LINE-1 DTSCS44 +02763 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02764 INSPECT MAP-LIEN-ADDR-LINE-2 DTSCS44 +02765 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02766 INSPECT MAP-LIEN-ADDR-LINE-3 DTSCS44 +02767 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02768 INSPECT MAP-LIEN-ADDR-LINE-4 DTSCS44 +02769 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02770 INSPECT MAP-LIEN-ADDR-LINE-5 DTSCS44 +02771 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02772 DTSCS44 +02773 IF (MAP-LIEN-ADDR-LINE-1 = SPACES) DTSCS44 +02774 AND DTSCS44 +02775 (MAP-LIEN-ADDR-LINE-2 = SPACES) DTSCS44 +02776 AND DTSCS44 +02777 (MAP-LIEN-ADDR-LINE-3 = SPACES) DTSCS44 +02778 AND DTSCS44 +02779 (MAP-LIEN-ADDR-LINE-4 = SPACES) DTSCS44 +02780 AND DTSCS44 +02781 (MAP-LIEN-ADDR-LINE-5 = SPACES) DTSCS44 +02782 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02783 PERFORM S1941-ERROR THRU S1941-EXIT. DTSCS44 +02784 S1940-EXIT. DTSCS44 +02785 EXIT. DTSCS44 +02786 DTSCS44 +02787 S1941-ERROR. DTSCS44 +02788 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS44 +02789 TO MAP-LIEN-ADDR-LINE-1-A DTSCS44 +02790 MAP-LIEN-ADDR-LINE-2-A DTSCS44 +02791 MAP-LIEN-ADDR-LINE-3-A DTSCS44 +02792 MAP-LIEN-ADDR-LINE-4-A DTSCS44 +02793 MAP-LIEN-ADDR-LINE-5-A. DTSCS44 +02794 IF LCCM-NO-MSG DTSCS44 +02795 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02796 MOVE CATB-CURSOR TO MAP-LIEN-ADDR-LINE-1-L DTSCS44 +02797 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02798 S1941-EXIT. EXIT. DTSCS44 +02799 DTSCS44 +02800 S1950-ADDR-TAA-OPO. DTSCS44 +02801 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS44 +02802 IF MAP-ADDR-TAX-ALT-88 DTSCS44 +02803 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS44 +02804 ELSE DTSCS44 +02805 IF MAP-ADDR-OPO-88 DTSCS44 +02806 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS44 +02807 ELSE DTSCS44 +02808 GO TO S899-ABEND. DTSCS44 +02809 DTSCS44 +02810 IF L013-CNT = 0 DTSCS44 +02811 MOVE 1 TO L111-ID-NO DTSCS44 +02812 ELSE DTSCS44 +02813 MOVE L013-CNT TO L111-ID-NO. DTSCS44 02814 DTSCS44 -02815 PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT. DTSCS44 +02815 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS44 02816 DTSCS44 -02817 IF L028-VALID DTSCS44 -02818 NEXT SENTENCE DTSCS44 -02819 ELSE DTSCS44 -02820 IF L028-NO-ENTRY DTSCS44 -02821 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02822 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 -02823 GO TO S2000-EXIT DTSCS44 -02824 ELSE DTSCS44 -02825 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02826 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 -02827 GO TO S2000-EXIT. DTSCS44 -02828 DTSCS44 -02829 DTSCS44 -02830 MOVE L028-NO TO WRK-CERT-NO. DTSCS44 -02831 DTSCS44 -02832 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS44 -02833 DTSCS44 -02834 IF L001-FED-8-MO > 09 DTSCS44 -02835 ADD 1 TO L001-FED-8-YR. DTSCS44 -02836 DTSCS44 -02837 IF WRK-EDIT-CERT-NO1 > L001-FED-8-YR DTSCS44 -02838 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02839 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 -02840 GO TO S2000-EXIT. DTSCS44 -02841 S2000-EXIT. DTSCS44 -02842 EXIT. DTSCS44 -02843 DTSCS44 -02844 S2001-ERROR. DTSCS44 -02845 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CERT-NUM1-A DTSCS44 -02846 MAP-CERT-NUM2-A. DTSCS44 -02847 DTSCS44 -02848 IF LCCM-NO-MSG DTSCS44 -02849 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02850 MOVE CATB-CURSOR TO MAP-CERT-NUM1-L DTSCS44 -02851 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02852 S2001-EXIT. EXIT. DTSCS44 +02817 IF L111-ADDR-NOT-FOUND-88 DTSCS44 +02818 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS44 +02819 PERFORM S1921-ERROR THRU S1921-EXIT DTSCS44 +02820 GO TO S1950-EXIT. DTSCS44 +02821 DTSCS44 +02822 PERFORM S1960-FORMAT-ADDR THRU S1960-EXIT. DTSCS44 +02823 S1950-EXIT. DTSCS44 +02824 EXIT. DTSCS44 +02825 S1960-FORMAT-ADDR. DTSCS44 +02826 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS44 +02827 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS44 +02828 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS44 +02829 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS44 +02830 DTSCS44 +02831 ***** PER A MEMO FROM RUDY, WHEN USING AN OPO ADDRESS DTSCS44 +02832 ***** AS A "LIEN DOCUMENT" ADDRESS, USE THE TAD ADDRESS DTSCS44 +02833 ***** FORMATTING RULES (RATHER THAN THE OPO ADDRESS DTSCS44 +02834 ***** FORMATTING RULES. 03/28/95 DTSCS44 +02835 DTSCS44 +02836 IF L112-OPO-ADDR-88 DTSCS44 +02837 SET L112-TAD-ADDR-88 TO TRUE. DTSCS44 +02838 DTSCS44 +02839 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS44 +02840 DTSCS44 +02841 MOVE L112-MAILING-LINE-1 TO MAP-LIEN-ADDR-LINE-1. DTSCS44 +02842 MOVE L112-MAILING-LINE-2 TO MAP-LIEN-ADDR-LINE-2. DTSCS44 +02843 MOVE L112-MAILING-LINE-3 TO MAP-LIEN-ADDR-LINE-3. DTSCS44 +02844 MOVE L112-MAILING-LINE-4 TO MAP-LIEN-ADDR-LINE-4. DTSCS44 +02845 MOVE L112-MAILING-LINE-5 TO MAP-LIEN-ADDR-LINE-5. DTSCS44 +02846 S1960-EXIT. EXIT. DTSCS44 +02847 /*****************************************************************DTSCS44 +02848 * DTSCS44 +02849 ******************************************************************DTSCS44 +02850 S2000-CERTIFICATE-NUM. DTSCS44 +02851 INSPECT MAP-CERT-NUM1 DTSCS44 +02852 CONVERTING LOW-VALUES TO SPACES. DTSCS44 02853 DTSCS44 -02854 S2100-RECORDR-OF-DEEDS-NO. DTSCS44 -02855 INSPECT MAP-DEED-NO DTSCS44 -02856 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02857 DTSCS44 -02858 S2100-EXIT. EXIT. DTSCS44 -02859 DTSCS44 -02860 S2101-ERROR. DTSCS44 -02861 DTSCS44 -02862 S2101-EXIT. EXIT. DTSCS44 -02863 DTSCS44 -02864 /*****************************************************************DTSCS44 -02865 * DTSCS44 -02866 ******************************************************************DTSCS44 -02867 S2200-CERTIFICATE-DATE. DTSCS44 -02868 MOVE +0 TO WRK-CERT-DATE. DTSCS44 -02869 MOVE MAP-CERT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -02870 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -02871 DTSCS44 -02872 IF L015-NO-ENTRY DTSCS44 -02873 IF MAP-DEED-NO NOT = SPACES DTSCS44 -02874 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02875 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS44 -02876 ELSE DTSCS44 -02877 GO TO S2200-EXIT DTSCS44 -02878 ELSE DTSCS44 -02879 IF L015-NOT-VALID DTSCS44 -02880 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02881 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS44 -02882 ELSE DTSCS44 -02883 MOVE L015-DATE TO WRK-CERT-DATE DTSCS44 -02884 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS44 -02885 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02886 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS44 -02887 ELSE DTSCS44 -02888 PERFORM S2210-FILE-LIEN-CROSS-EDIT THRU S2210-EXIT DTSCS44 -02889 PERFORM S2220-DEED-NO-CROSS-EDIT THRU S2220-EXIT. DTSCS44 -02890 DTSCS44 -02891 S2200-EXIT. DTSCS44 -02892 EXIT. DTSCS44 -02893 DTSCS44 -02894 S2201-ERROR. DTSCS44 -02895 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 -02896 TO MAP-CERT-MO-A DTSCS44 -02897 MAP-CERT-DA-A DTSCS44 -02898 MAP-CERT-YR-A. DTSCS44 -02899 IF LCCM-NO-MSG DTSCS44 -02900 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02901 MOVE CATB-CURSOR TO MAP-CERT-MO-L DTSCS44 -02902 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02903 S2201-EXIT. EXIT. DTSCS44 -02904 DTSCS44 -02905 S2210-FILE-LIEN-CROSS-EDIT. DTSCS44 -02906 IF LCCM-F09-88 DTSCS44 -02907 NEXT SENTENCE DTSCS44 -02908 ELSE DTSCS44 -02909 MOVE MLIN-STMT-DATE TO WRK-STMT-DATE. DTSCS44 +02854 INSPECT MAP-CERT-NUM2 DTSCS44 +02855 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02856 DTSCS44 +02857 IF MAP-STATUS-CD = 'O' OR 'M' DTSCS44 +02858 IF MAP-CERT-NUM1 = SPACES AND MAP-CERT-NUM2 = SPACES DTSCS44 +02859 GO TO S2000-EXIT DTSCS44 +02860 ELSE DTSCS44 +02861 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 +02862 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 +02863 GO TO S2000-EXIT. DTSCS44 +02864 DTSCS44 +02865 DTSCS44 +02866 MOVE MAP-CERTIFICATE-NUM-AREA TO L028-S-NO-AREA. DTSCS44 +02867 DTSCS44 +02868 PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT. DTSCS44 +02869 DTSCS44 +02870 IF L028-VALID DTSCS44 +02871 NEXT SENTENCE DTSCS44 +02872 ELSE DTSCS44 +02873 IF L028-NO-ENTRY DTSCS44 +02874 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02875 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 +02876 GO TO S2000-EXIT DTSCS44 +02877 ELSE DTSCS44 +02878 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02879 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 +02880 GO TO S2000-EXIT. DTSCS44 +02881 DTSCS44 +02882 DTSCS44 +02883 MOVE L028-NO TO WRK-CERT-NO. DTSCS44 +02884 DTSCS44 +02885 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS44 +02886 DTSCS44 +02887 IF L001-FED-8-MO > 09 DTSCS44 +02888 ADD 1 TO L001-FED-8-YR. DTSCS44 +02889 DTSCS44 +02890 IF WRK-EDIT-CERT-NO1 > L001-FED-8-YR DTSCS44 +02891 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02892 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS44 +02893 GO TO S2000-EXIT. DTSCS44 +02894 S2000-EXIT. DTSCS44 +02895 EXIT. DTSCS44 +02896 DTSCS44 +02897 S2001-ERROR. DTSCS44 +02898 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CERT-NUM1-A DTSCS44 +02899 MAP-CERT-NUM2-A. DTSCS44 +02900 DTSCS44 +02901 IF LCCM-NO-MSG DTSCS44 +02902 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02903 MOVE CATB-CURSOR TO MAP-CERT-NUM1-L DTSCS44 +02904 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02905 S2001-EXIT. EXIT. DTSCS44 +02906 DTSCS44 +02907 S2100-RECORDR-OF-DEEDS-NO. DTSCS44 +02908 INSPECT MAP-DEED-NO DTSCS44 +02909 CONVERTING LOW-VALUES TO SPACES. DTSCS44 02910 DTSCS44 -02911 IF WRK-STMT-DATE = +0 DTSCS44 -02912 GO TO S2210-EXIT. DTSCS44 -02913 DTSCS44 -02914 IF L015-DATE < WRK-STMT-DATE DTSCS44 -02915 MOVE MSG-E446-AREA TO WRK-MSG-AREA DTSCS44 -02916 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS44 -02917 S2210-EXIT. EXIT. DTSCS44 -02918 DTSCS44 -02919 S2220-DEED-NO-CROSS-EDIT. DTSCS44 -02920 IF L015-DATE > 0 AND MAP-DEED-NO = SPACES DTSCS44 -02921 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 -02922 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS44 -02923 S2220-EXIT. EXIT. DTSCS44 +02911 S2100-EXIT. EXIT. DTSCS44 +02912 DTSCS44 +02913 S2101-ERROR. DTSCS44 +02914 DTSCS44 +02915 S2101-EXIT. EXIT. DTSCS44 +02916 DTSCS44 +02917 /*****************************************************************DTSCS44 +02918 * DTSCS44 +02919 ******************************************************************DTSCS44 +02920 S2200-CERTIFICATE-DATE. DTSCS44 +02921 MOVE +0 TO WRK-CERT-DATE. DTSCS44 +02922 MOVE MAP-CERT-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +02923 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 02924 DTSCS44 -02925 S2300-CERTIFIED-MAIL-NO. DTSCS44 -02926 INSPECT MAP-MAIL-NO DTSCS44 -02927 CONVERTING LOW-VALUES TO SPACES. DTSCS44 -02928 DTSCS44 -02929 IF MAP-MAIL-NO > SPACES AND MAP-DEED-NO = SPACES DTSCS44 -02930 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02931 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS44 -02932 DTSCS44 -02933 S2300-EXIT. EXIT. DTSCS44 -02934 DTSCS44 -02935 S2301-ERROR. DTSCS44 -02936 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-NO-A. DTSCS44 -02937 DTSCS44 -02938 IF LCCM-NO-MSG DTSCS44 -02939 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02940 MOVE CATB-CURSOR TO MAP-MAIL-NO-L DTSCS44 -02941 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02942 S2301-EXIT. EXIT. DTSCS44 +02925 IF L015-NO-ENTRY DTSCS44 +02926 IF MAP-DEED-NO NOT = SPACES DTSCS44 +02927 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +02928 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS44 +02929 ELSE DTSCS44 +02930 GO TO S2200-EXIT DTSCS44 +02931 ELSE DTSCS44 +02932 IF L015-NOT-VALID DTSCS44 +02933 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02934 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS44 +02935 ELSE DTSCS44 +02936 MOVE L015-DATE TO WRK-CERT-DATE DTSCS44 +02937 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS44 +02938 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02939 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS44 +02940 ELSE DTSCS44 +02941 PERFORM S2210-FILE-LIEN-CROSS-EDIT THRU S2210-EXIT DTSCS44 +02942 PERFORM S2220-DEED-NO-CROSS-EDIT THRU S2220-EXIT. DTSCS44 02943 DTSCS44 -02944 /*****************************************************************DTSCS44 -02945 * DTSCS44 -02946 ******************************************************************DTSCS44 -02947 S2400-CERTIFIED-MAIL-DATE. DTSCS44 -02948 MOVE +0 TO WRK-MAIL-DATE. DTSCS44 -02949 MOVE MAP-CERT-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -02950 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -02951 DTSCS44 -02952 IF L015-NO-ENTRY DTSCS44 -02953 IF MAP-MAIL-NO NOT = SPACES DTSCS44 -02954 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -02955 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 -02956 ELSE DTSCS44 -02957 GO TO S2400-EXIT DTSCS44 -02958 ELSE DTSCS44 -02959 IF L015-NOT-VALID DTSCS44 -02960 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02961 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 -02962 ELSE DTSCS44 -02963 MOVE L015-DATE TO WRK-MAIL-DATE DTSCS44 -02964 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS44 -02965 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -02966 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 -02967 ELSE DTSCS44 -02968 IF L015-DATE < WRK-CERT-DATE DTSCS44 -02969 MOVE MSG-E448-AREA TO WRK-MSG-AREA DTSCS44 -02970 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 -02971 ELSE DTSCS44 -02972 IF L015-DATE > 0 AND MAP-DEED-NO = SPACES DTSCS44 -02973 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 -02974 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 -02975 ELSE DTSCS44 -02976 IF L015-DATE > 0 AND MAP-MAIL-NO = SPACES DTSCS44 -02977 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 -02978 PERFORM S2401-ERROR THRU S2401-EXIT. DTSCS44 -02979 DTSCS44 -02980 DTSCS44 -02981 S2400-EXIT. DTSCS44 -02982 EXIT. DTSCS44 -02983 DTSCS44 -02984 S2401-ERROR. DTSCS44 -02985 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 -02986 TO MAP-CERT-DATE-MO-A DTSCS44 -02987 MAP-CERT-DATE-DA-A DTSCS44 -02988 MAP-CERT-DATE-YR-A. DTSCS44 -02989 IF LCCM-NO-MSG DTSCS44 -02990 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -02991 MOVE CATB-CURSOR TO MAP-CERT-DATE-MO-L DTSCS44 -02992 SET CURSOR-SET-YES TO TRUE. DTSCS44 -02993 S2401-EXIT. EXIT. DTSCS44 -02994 DTSCS44 -02995 /*****************************************************************DTSCS44 -02996 * DTSCS44 -02997 ******************************************************************DTSCS44 -02998 S2500-RETURN-MAIL-DATE. DTSCS44 -02999 MOVE MAP-MAIL-RETURN-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -03000 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -03001 DTSCS44 -03002 IF L015-NO-ENTRY DTSCS44 -03003 GO TO S2500-EXIT DTSCS44 -03004 ELSE DTSCS44 -03005 IF L015-NOT-VALID DTSCS44 -03006 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -03007 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 -03008 ELSE DTSCS44 -03009 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS44 -03010 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -03011 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 -03012 ELSE DTSCS44 -03013 IF L015-DATE NOT > WRK-MAIL-DATE DTSCS44 -03014 MOVE MSG-E449-AREA TO WRK-MSG-AREA DTSCS44 -03015 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 -03016 ELSE DTSCS44 -03017 IF L015-DATE > 0 AND WRK-MAIL-DATE = 0 DTSCS44 -03018 MOVE MSG-E449-AREA TO WRK-MSG-AREA DTSCS44 -03019 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 -03020 ELSE DTSCS44 -03021 IF L015-DATE > 0 AND MAP-DEED-NO = SPACES DTSCS44 -03022 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 -03023 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS44 -03024 DTSCS44 -03025 DTSCS44 -03026 S2500-EXIT. DTSCS44 -03027 EXIT. DTSCS44 -03028 DTSCS44 -03029 S2501-ERROR. DTSCS44 -03030 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 -03031 TO MAP-RETURN-DATE-MO-A DTSCS44 -03032 MAP-RETURN-DATE-DA-A DTSCS44 -03033 MAP-RETURN-DATE-YR-A. DTSCS44 -03034 IF LCCM-NO-MSG DTSCS44 -03035 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -03036 MOVE CATB-CURSOR TO MAP-RETURN-DATE-MO-L DTSCS44 -03037 SET CURSOR-SET-YES TO TRUE. DTSCS44 -03038 S2501-EXIT. EXIT. DTSCS44 -03039 /*****************************************************************DTSCS44 -03040 * *DTSCS44 -03041 ******************************************************************DTSCS44 -03042 S2600-CURR-COMP-DATE. DTSCS44 -03043 IF LCCM-F09-88 DTSCS44 -03044 MOVE MAP-COMP-MO TO MAP-CURR-COMP-MO DTSCS44 -03045 MOVE MAP-COMP-DA TO MAP-CURR-COMP-DA DTSCS44 -03046 MOVE MAP-COMP-YR TO MAP-CURR-COMP-YR. DTSCS44 +02944 S2200-EXIT. DTSCS44 +02945 EXIT. DTSCS44 +02946 DTSCS44 +02947 S2201-ERROR. DTSCS44 +02948 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 +02949 TO MAP-CERT-MO-A DTSCS44 +02950 MAP-CERT-DA-A DTSCS44 +02951 MAP-CERT-YR-A. DTSCS44 +02952 IF LCCM-NO-MSG DTSCS44 +02953 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02954 MOVE CATB-CURSOR TO MAP-CERT-MO-L DTSCS44 +02955 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02956 S2201-EXIT. EXIT. DTSCS44 +02957 DTSCS44 +02958 S2210-FILE-LIEN-CROSS-EDIT. DTSCS44 +02959 IF LCCM-F09-88 DTSCS44 +02960 NEXT SENTENCE DTSCS44 +02961 ELSE DTSCS44 +02962 MOVE MLIN-STMT-DATE TO WRK-STMT-DATE. DTSCS44 +02963 DTSCS44 +02964 IF WRK-STMT-DATE = +0 DTSCS44 +02965 GO TO S2210-EXIT. DTSCS44 +02966 DTSCS44 +02967 IF L015-DATE < WRK-STMT-DATE DTSCS44 +02968 MOVE MSG-E446-AREA TO WRK-MSG-AREA DTSCS44 +02969 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS44 +02970 S2210-EXIT. EXIT. DTSCS44 +02971 DTSCS44 +02972 S2220-DEED-NO-CROSS-EDIT. DTSCS44 +02973 IF L015-DATE > 0 AND MAP-DEED-NO = SPACES DTSCS44 +02974 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 +02975 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS44 +02976 S2220-EXIT. EXIT. DTSCS44 +02977 DTSCS44 +02978 S2300-CERTIFIED-MAIL-NO. DTSCS44 +02979 INSPECT MAP-MAIL-NO DTSCS44 +02980 CONVERTING LOW-VALUES TO SPACES. DTSCS44 +02981 DTSCS44 +02982 IF MAP-MAIL-NO > SPACES AND MAP-DEED-NO = SPACES DTSCS44 +02983 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +02984 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS44 +02985 DTSCS44 +02986 S2300-EXIT. EXIT. DTSCS44 +02987 DTSCS44 +02988 S2301-ERROR. DTSCS44 +02989 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-NO-A. DTSCS44 +02990 DTSCS44 +02991 IF LCCM-NO-MSG DTSCS44 +02992 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +02993 MOVE CATB-CURSOR TO MAP-MAIL-NO-L DTSCS44 +02994 SET CURSOR-SET-YES TO TRUE. DTSCS44 +02995 S2301-EXIT. EXIT. DTSCS44 +02996 DTSCS44 +02997 /*****************************************************************DTSCS44 +02998 * DTSCS44 +02999 ******************************************************************DTSCS44 +03000 S2400-CERTIFIED-MAIL-DATE. DTSCS44 +03001 MOVE +0 TO WRK-MAIL-DATE. DTSCS44 +03002 MOVE MAP-CERT-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +03003 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +03004 DTSCS44 +03005 IF L015-NO-ENTRY DTSCS44 +03006 IF MAP-MAIL-NO NOT = SPACES DTSCS44 +03007 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +03008 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 +03009 ELSE DTSCS44 +03010 GO TO S2400-EXIT DTSCS44 +03011 ELSE DTSCS44 +03012 IF L015-NOT-VALID DTSCS44 +03013 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +03014 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 +03015 ELSE DTSCS44 +03016 MOVE L015-DATE TO WRK-MAIL-DATE DTSCS44 +03017 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS44 +03018 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +03019 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 +03020 ELSE DTSCS44 +03021 IF L015-DATE < WRK-CERT-DATE DTSCS44 +03022 MOVE MSG-E448-AREA TO WRK-MSG-AREA DTSCS44 +03023 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 +03024 ELSE DTSCS44 +03025 IF L015-DATE > 0 AND MAP-DEED-NO = SPACES DTSCS44 +03026 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 +03027 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS44 +03028 ELSE DTSCS44 +03029 IF L015-DATE > 0 AND MAP-MAIL-NO = SPACES DTSCS44 +03030 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 +03031 PERFORM S2401-ERROR THRU S2401-EXIT. DTSCS44 +03032 DTSCS44 +03033 DTSCS44 +03034 S2400-EXIT. DTSCS44 +03035 EXIT. DTSCS44 +03036 DTSCS44 +03037 S2401-ERROR. DTSCS44 +03038 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 +03039 TO MAP-CERT-DATE-MO-A DTSCS44 +03040 MAP-CERT-DATE-DA-A DTSCS44 +03041 MAP-CERT-DATE-YR-A. DTSCS44 +03042 IF LCCM-NO-MSG DTSCS44 +03043 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +03044 MOVE CATB-CURSOR TO MAP-CERT-DATE-MO-L DTSCS44 +03045 SET CURSOR-SET-YES TO TRUE. DTSCS44 +03046 S2401-EXIT. EXIT. DTSCS44 03047 DTSCS44 -03048 MOVE MAP-CURR-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 -03049 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 -03050 DTSCS44 -03051 IF L015-NO-ENTRY DTSCS44 -03052 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS44 -03053 MOVE WRK-DISPLAY-MO TO MAP-CURR-COMP-MO DTSCS44 -03054 MOVE WRK-DISPLAY-DA TO MAP-CURR-COMP-DA DTSCS44 -03055 MOVE WRK-DISPLAY-YR TO MAP-CURR-COMP-YR DTSCS44 -03056 ELSE DTSCS44 -03057 IF L015-NOT-VALID DTSCS44 -03058 IF MAP-CURR-COMP-MO = '99' DTSCS44 -03059 AND MAP-CURR-COMP-DA = '99' DTSCS44 -03060 AND MAP-CURR-COMP-YR = '99' DTSCS44 -03061 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS44 -03062 ELSE DTSCS44 -03063 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -03064 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS44 -03065 ELSE DTSCS44 -03066 MOVE L015-DATE TO LCCM-COMP-DATE. DTSCS44 -03067 S2600-EXIT. DTSCS44 -03068 EXIT. DTSCS44 -03069 DTSCS44 -03070 S2601-ERROR. DTSCS44 -03071 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 -03072 TO MAP-CURR-COMP-MO-A DTSCS44 -03073 MAP-CURR-COMP-DA-A DTSCS44 -03074 MAP-CURR-COMP-YR-A. DTSCS44 -03075 IF LCCM-NO-MSG DTSCS44 -03076 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -03077 MOVE CATB-CURSOR TO MAP-CURR-COMP-MO-L DTSCS44 -03078 SET CURSOR-SET-YES TO TRUE. DTSCS44 -03079 S2601-EXIT. EXIT. DTSCS44 -03080 DTSCS44 -03081 /*****************************************************************DTSCS44 -03082 * *DTSCS44 -03083 ******************************************************************DTSCS44 -03084 S2700-COVERED-YRQ. DTSCS44 -03085 * *---------------------------------- DTSCS44 -03086 *--------------------------* NOT SURE IF NEEDED IN MT DTSCS44 -03087 ****** *---------------------------------- DTSCS44 -03088 ******MOVE LCCM-LAST-UI5-DEL-MAIL-YRQ TO L004-QTR-5-9. DTSCS44 -03089 ******PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS44 -03090 ******COMPUTE L004-ABS-QTR = L004-ABS-QTR - 11. DTSCS44 -03091 ******MOVE '3' TO L004-OPTION. DTSCS44 -03092 ******PERFORM S004-LINK THRU S004-EXIT. DTSCS44 -03093 ******MOVE L004-QTR-5-9 TO WRK-STATUTE-YRQ. DTSCS44 -03094 ****** DTSCS44 -03095 ******MOVE '2' TO L101-OPTION. DTSCS44 -03096 ******MOVE MLIN-STMT-DATE TO L101-CALC-THRU-DATE. DTSCS44 -03097 DTSCS44 -03098 MOVE +0 TO WRK-TOT-BALANCE-AMT. DTSCS44 -03099 DTSCS44 -03100 MOVE +0 TO WRK-NO-ENTRY-CTR. DTSCS44 -03101 DTSCS44 -03102 * *---------------------------------- DTSCS44 -03103 *--------------------------* EDIT WHAT IS ON THE SCREEN DTSCS44 -03104 * *---------------------------------- DTSCS44 -03105 PERFORM S2710-YRQ-LOOP THRU S2710-EXIT DTSCS44 -03106 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 -03107 UNTIL (WRK-SUB > MMAX-LIN-COV-MAX). DTSCS44 -03108 DTSCS44 -03109 IF WRK-NO-ENTRY-CTR NOT < MMAX-LIN-COV-MAX DTSCS44 -03110 IF LCCM-MSG OR MAP-STATUS-CD = 'M' DTSCS44 -03111 NEXT SENTENCE DTSCS44 -03112 ELSE DTSCS44 -03113 PERFORM S2750-DEFAULT-QTRS THRU S2750-EXIT. DTSCS44 -03114 DTSCS44 -03115 IF LCCM-MSG DTSCS44 -03116 *********MOVE LOW-VALUES TO MAP-STMT-DUE-AMT DTSCS44 -03117 GO TO S2700-EXIT. DTSCS44 -03118 DTSCS44 -03119 MOVE WRK-TOT-BALANCE-AMT TO MAP-CURR-TOT-DUE-Z. DTSCS44 -03120 S2700-EXIT. DTSCS44 +03048 /*****************************************************************DTSCS44 +03049 * DTSCS44 +03050 ******************************************************************DTSCS44 +03051 S2500-RETURN-MAIL-DATE. DTSCS44 +03052 MOVE MAP-MAIL-RETURN-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +03053 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +03054 DTSCS44 +03055 IF L015-NO-ENTRY DTSCS44 +03056 GO TO S2500-EXIT DTSCS44 +03057 ELSE DTSCS44 +03058 IF L015-NOT-VALID DTSCS44 +03059 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +03060 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 +03061 ELSE DTSCS44 +03062 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS44 +03063 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +03064 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 +03065 ELSE DTSCS44 +03066 IF L015-DATE NOT > WRK-MAIL-DATE DTSCS44 +03067 MOVE MSG-E449-AREA TO WRK-MSG-AREA DTSCS44 +03068 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 +03069 ELSE DTSCS44 +03070 IF L015-DATE > 0 AND WRK-MAIL-DATE = 0 DTSCS44 +03071 MOVE MSG-E449-AREA TO WRK-MSG-AREA DTSCS44 +03072 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS44 +03073 ELSE DTSCS44 +03074 IF L015-DATE > 0 AND MAP-DEED-NO = SPACES DTSCS44 +03075 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS44 +03076 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS44 +03077 DTSCS44 +03078 DTSCS44 +03079 S2500-EXIT. DTSCS44 +03080 EXIT. DTSCS44 +03081 DTSCS44 +03082 S2501-ERROR. DTSCS44 +03083 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 +03084 TO MAP-RETURN-DATE-MO-A DTSCS44 +03085 MAP-RETURN-DATE-DA-A DTSCS44 +03086 MAP-RETURN-DATE-YR-A. DTSCS44 +03087 IF LCCM-NO-MSG DTSCS44 +03088 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +03089 MOVE CATB-CURSOR TO MAP-RETURN-DATE-MO-L DTSCS44 +03090 SET CURSOR-SET-YES TO TRUE. DTSCS44 +03091 S2501-EXIT. EXIT. DTSCS44 +03092 /*****************************************************************DTSCS44 +03093 * *DTSCS44 +03094 ******************************************************************DTSCS44 +03095 S2600-CURR-COMP-DATE. DTSCS44 +03096 IF LCCM-F09-88 DTSCS44 +03097 MOVE MAP-COMP-MO TO MAP-CURR-COMP-MO DTSCS44 +03098 MOVE MAP-COMP-DA TO MAP-CURR-COMP-DA DTSCS44 +03099 MOVE MAP-COMP-YR TO MAP-CURR-COMP-YR. DTSCS44 +03100 DTSCS44 +03101 MOVE MAP-CURR-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS44 +03102 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS44 +03103 DTSCS44 +03104 IF L015-NO-ENTRY DTSCS44 +03105 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS44 +03106 MOVE WRK-DISPLAY-MO TO MAP-CURR-COMP-MO DTSCS44 +03107 MOVE WRK-DISPLAY-DA TO MAP-CURR-COMP-DA DTSCS44 +03108 MOVE WRK-DISPLAY-YR TO MAP-CURR-COMP-YR DTSCS44 +03109 ELSE DTSCS44 +03110 IF L015-NOT-VALID DTSCS44 +03111 IF MAP-CURR-COMP-MO = '99' DTSCS44 +03112 AND MAP-CURR-COMP-DA = '99' DTSCS44 +03113 AND MAP-CURR-COMP-YR = '99' DTSCS44 +03114 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS44 +03115 ELSE DTSCS44 +03116 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +03117 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS44 +03118 ELSE DTSCS44 +03119 MOVE L015-DATE TO LCCM-COMP-DATE. DTSCS44 +03120 S2600-EXIT. DTSCS44 03121 EXIT. DTSCS44 -03122 EJECT DTSCS44 -03123 * CHECK TO SEE WHAT WAS ENTERED ON THE SCREEN DTSCS44 -03124 S2710-YRQ-LOOP. DTSCS44 -03125 MOVE LOW-VALUE TO MAP-AMT-DUE (WRK-SUB) DTSCS44 -03126 MAP-CURR-RPT-TYPE (WRK-SUB). DTSCS44 -03127 DTSCS44 -03128 MOVE +0 TO MLIN-COVERED-YRQ (WRK-SUB). DTSCS44 -03129 DTSCS44 -03130 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS44 -03131 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS44 -03132 IF L029-NOT-VALID DTSCS44 -03133 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 -03134 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03135 ELSE DTSCS44 -03136 IF L029-NO-ENTRY DTSCS44 -03137 PERFORM S2720-NO-ENTRY THRU S2720-EXIT DTSCS44 -03138 ELSE DTSCS44 -03139 PERFORM S2730-YRQ-ENTERED THRU S2730-EXIT. DTSCS44 -03140 S2710-EXIT. DTSCS44 -03141 EXIT. DTSCS44 -03142 DTSCS44 -03143 S2720-NO-ENTRY. DTSCS44 -03144 ADD +1 TO WRK-NO-ENTRY-CTR. DTSCS44 -03145 S2720-EXIT. DTSCS44 -03146 EXIT. DTSCS44 -03147 DTSCS44 -03148 S2730-YRQ-ENTERED. DTSCS44 -03149 MOVE L029-YRQ TO MLIN-COVERED-YRQ (WRK-SUB). DTSCS44 -03150 * QTRS MUST BE ASCENDING SEQ DTSCS44 -03151 IF WRK-SUB > +1 DTSCS44 -03152 COMPUTE WRK-SUB-MINUS-ONE = WRK-SUB - 1 DTSCS44 -03153 IF (MLIN-COVERED-YRQ (WRK-SUB-MINUS-ONE) = +0) DTSCS44 -03154 OR DTSCS44 -03155 (MLIN-COVERED-YRQ (WRK-SUB) DTSCS44 -03156 NOT > MLIN-COVERED-YRQ (WRK-SUB-MINUS-ONE)) DTSCS44 -03157 MOVE MSG-E441-AREA TO WRK-MSG-AREA DTSCS44 -03158 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03159 GO TO S2730-EXIT. DTSCS44 -03160 DTSCS44 -03161 * *---------------------------------- DTSCS44 -03162 *--------------------------* NOT SURE IF NEEDED IN MT DTSCS44 -03163 * *---------------------------------- DTSCS44 -03164 *****IF MAP-STATUS-CD NOT = 'C' DTSCS44 -03165 ***** IF MLIN-COVERED-YRQ (WRK-SUB) < WRK-STATUTE-YRQ DTSCS44 -03166 ***** MOVE MSG03-AREA TO WRK-MSG-AREA DTSCS44 -03167 ***** PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03168 ***** GO TO S2730-EXIT. DTSCS44 -03169 DTSCS44 -03170 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS44 -03171 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSCS44 -03172 SET MQTR-QTR-88 TO TRUE. DTSCS44 -03173 MOVE MLIN-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS44 -03174 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -03175 DTSCS44 -03176 PERFORM S810-READ THRU S810-EXIT. DTSCS44 -03177 DTSCS44 -03178 IF L810-NO-REC-88 DTSCS44 -03179 IF MAP-STATUS-CD = 'O' DTSCS44 -03180 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 -03181 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03182 GO TO S2730-EXIT DTSCS44 -03183 ELSE DTSCS44 -03184 GO TO S2730-EXIT. DTSCS44 -03185 DTSCS44 -03186 MOVE MSKL-REC TO MQTR-REC. DTSCS44 -03187 DTSCS44 -03188 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS44 -03189 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS44 -03190 PERFORM S4000-INTEREST THRU S4000-EXIT. DTSCS44 -03191 DTSCS44 -03192 IF WRK-YRQ-BALANCE-AMT = +0 DTSCS44 -03193 AND MAP-STATUS-CD = 'O' DTSCS44 -03194 MOVE MSG-E442-AREA TO WRK-MSG-AREA DTSCS44 -03195 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03196 GO TO S2730-EXIT. DTSCS44 -03197 DTSCS44 -03198 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS44 -03199 MOVE ' WRITTEN OFF' TO MAP-AMT-DUE (WRK-SUB) DTSCS44 -03200 ELSE DTSCS44 -03201 MOVE WRK-YRQ-BALANCE-AMT TO MAP-AMT-DUE-Z (WRK-SUB). DTSCS44 -03202 DTSCS44 -03203 MOVE MQTR-CURR-RPT-TYPE TO MAP-CURR-RPT-TYPE (WRK-SUB). DTSCS44 -03204 DTSCS44 -03205 PERFORM P6913-TRANSLATE THRU P6913-EXIT. DTSCS44 -03206 DTSCS44 -03207 S2730-EXIT. DTSCS44 -03208 EXIT. DTSCS44 -03209 DTSCS44 -03210 S2750-DEFAULT-QTRS. DTSCS44 -03211 MOVE ZERO TO WRK-TBL-SUB. DTSCS44 -03212 DTSCS44 -03213 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS44 -03214 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSCS44 -03215 **** MOVE WRK-STATUTE-YRQ TO MQTR-YRQ. DTSCS44 -03216 SET MQTR-QTR-88 TO TRUE. DTSCS44 -03217 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -03218 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 -03219 DTSCS44 -03220 PERFORM S2752-PROCESS-QTRS THRU S2752-EXIT DTSCS44 -03221 UNTIL L810-NO-REC-88 DTSCS44 -03222 OR WRK-TBL-SUB > MMAX-LIN-COV-MAX. DTSCS44 -03223 DTSCS44 -03224 IF L810-OK-88 DTSCS44 -03225 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 -03226 DTSCS44 -03227 IF WRK-TBL-SUB > MMAX-LIN-COV-MAX DTSCS44 -03228 MOVE 1 TO WRK-SUB DTSCS44 -03229 MOVE MSG-E445-AREA TO WRK-MSG-AREA DTSCS44 -03230 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03231 GO TO S2750-EXIT. DTSCS44 -03232 DTSCS44 -03233 IF WRK-TBL-SUB = +0 DTSCS44 -03234 IF MAP-STATUS-CD = 'C' DTSCS44 -03235 MOVE +1 TO WRK-SUB DTSCS44 -03236 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 -03237 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 -03238 ELSE DTSCS44 -03239 MOVE MSG-E447-AREA TO WRK-MSG-AREA DTSCS44 -03240 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS44 -03241 DTSCS44 -03242 PERFORM S2753-ON-SCREEN THRU S2753-EXIT DTSCS44 -03243 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 -03244 UNTIL WRK-SUB > WRK-TBL-SUB. DTSCS44 -03245 S2750-EXIT. EXIT. DTSCS44 -03246 DTSCS44 -03247 S2752-PROCESS-QTRS. DTSCS44 -03248 MOVE MSKL-REC TO MQTR-REC. DTSCS44 -03249 DTSCS44 -03250 MOVE +0 TO WRK-YRQ-BALANCE-AMT. DTSCS44 -03251 DTSCS44 -03252 PERFORM S4000-INTEREST THRU S4000-EXIT. DTSCS44 -03253 DTSCS44 -03254 IF WRK-YRQ-BALANCE-AMT > 0 DTSCS44 -03255 ADD 1 TO WRK-TBL-SUB DTSCS44 -03256 MOVE WRK-YRQ-BALANCE-AMT TO WRK-TBL-BALANCE(WRK-TBL-SUB) DTSCS44 -03257 MOVE MQTR-YRQ TO WRK-TBL-QTR(WRK-TBL-SUB) DTSCS44 -03258 MOVE MQTR-CURR-RPT-TYPE TO WRK-TBL-RPT-TYPE(WRK-TBL-SUB). DTSCS44 +03122 DTSCS44 +03123 S2601-ERROR. DTSCS44 +03124 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS44 +03125 TO MAP-CURR-COMP-MO-A DTSCS44 +03126 MAP-CURR-COMP-DA-A DTSCS44 +03127 MAP-CURR-COMP-YR-A. DTSCS44 +03128 IF LCCM-NO-MSG DTSCS44 +03129 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +03130 MOVE CATB-CURSOR TO MAP-CURR-COMP-MO-L DTSCS44 +03131 SET CURSOR-SET-YES TO TRUE. DTSCS44 +03132 S2601-EXIT. EXIT. DTSCS44 +03133 DTSCS44 +03134 /*****************************************************************DTSCS44 +03135 * *DTSCS44 +03136 ******************************************************************DTSCS44 +03137 S2700-COVERED-YRQ. DTSCS44 +03138 * *---------------------------------- DTSCS44 +03139 *--------------------------* NOT SURE IF NEEDED IN MT DTSCS44 +03140 ****** *---------------------------------- DTSCS44 +03141 ******MOVE LCCM-LAST-UI5-DEL-MAIL-YRQ TO L004-QTR-5-9. DTSCS44 +03142 ******PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS44 +03143 ******COMPUTE L004-ABS-QTR = L004-ABS-QTR - 11. DTSCS44 +03144 ******MOVE '3' TO L004-OPTION. DTSCS44 +03145 ******PERFORM S004-LINK THRU S004-EXIT. DTSCS44 +03146 ******MOVE L004-QTR-5-9 TO WRK-STATUTE-YRQ. DTSCS44 +03147 ****** DTSCS44 +03148 ******MOVE '2' TO L101-OPTION. DTSCS44 +03149 ******MOVE MLIN-STMT-DATE TO L101-CALC-THRU-DATE. DTSCS44 +03150 DTSCS44 +03151 MOVE +0 TO WRK-TOT-BALANCE-AMT. DTSCS44 +03152 DTSCS44 +03153 MOVE +0 TO WRK-NO-ENTRY-CTR. DTSCS44 +03154 DTSCS44 +03155 * *---------------------------------- DTSCS44 +03156 *--------------------------* EDIT WHAT IS ON THE SCREEN DTSCS44 +03157 * *---------------------------------- DTSCS44 +03158 PERFORM S2710-YRQ-LOOP THRU S2710-EXIT DTSCS44 +03159 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 +03160 UNTIL (WRK-SUB > MMAX-LIN-COV-MAX). DTSCS44 +03161 DTSCS44 +03162 IF WRK-NO-ENTRY-CTR NOT < MMAX-LIN-COV-MAX DTSCS44 +03163 IF LCCM-MSG OR MAP-STATUS-CD = 'M' DTSCS44 +03164 NEXT SENTENCE DTSCS44 +03165 ELSE DTSCS44 +03166 PERFORM S2750-DEFAULT-QTRS THRU S2750-EXIT. DTSCS44 +03167 DTSCS44 +03168 IF LCCM-MSG DTSCS44 +03169 *********MOVE LOW-VALUES TO MAP-STMT-DUE-AMT DTSCS44 +03170 GO TO S2700-EXIT. DTSCS44 +03171 DTSCS44 +03172 MOVE WRK-TOT-BALANCE-AMT TO MAP-CURR-TOT-DUE-Z. DTSCS44 +03173 S2700-EXIT. DTSCS44 +03174 EXIT. DTSCS44 +03175 EJECT DTSCS44 +03176 * CHECK TO SEE WHAT WAS ENTERED ON THE SCREEN DTSCS44 +03177 S2710-YRQ-LOOP. DTSCS44 +03178 MOVE LOW-VALUE TO MAP-AMT-DUE (WRK-SUB) DTSCS44 +03179 MAP-CURR-RPT-TYPE (WRK-SUB). DTSCS44 +03180 DTSCS44 +03181 MOVE +0 TO MLIN-COVERED-YRQ (WRK-SUB). DTSCS44 +03182 DTSCS44 +03183 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS44 +03184 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS44 +03185 IF L029-NOT-VALID DTSCS44 +03186 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS44 +03187 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03188 ELSE DTSCS44 +03189 IF L029-NO-ENTRY DTSCS44 +03190 PERFORM S2720-NO-ENTRY THRU S2720-EXIT DTSCS44 +03191 ELSE DTSCS44 +03192 PERFORM S2730-YRQ-ENTERED THRU S2730-EXIT. DTSCS44 +03193 S2710-EXIT. DTSCS44 +03194 EXIT. DTSCS44 +03195 DTSCS44 +03196 S2720-NO-ENTRY. DTSCS44 +03197 ADD +1 TO WRK-NO-ENTRY-CTR. DTSCS44 +03198 S2720-EXIT. DTSCS44 +03199 EXIT. DTSCS44 +03200 DTSCS44 +03201 S2730-YRQ-ENTERED. DTSCS44 +03202 MOVE L029-YRQ TO MLIN-COVERED-YRQ (WRK-SUB). DTSCS44 +03203 * QTRS MUST BE ASCENDING SEQ DTSCS44 +03204 IF WRK-SUB > +1 DTSCS44 +03205 COMPUTE WRK-SUB-MINUS-ONE = WRK-SUB - 1 DTSCS44 +03206 IF (MLIN-COVERED-YRQ (WRK-SUB-MINUS-ONE) = +0) DTSCS44 +03207 OR DTSCS44 +03208 (MLIN-COVERED-YRQ (WRK-SUB) DTSCS44 +03209 NOT > MLIN-COVERED-YRQ (WRK-SUB-MINUS-ONE)) DTSCS44 +03210 MOVE MSG-E441-AREA TO WRK-MSG-AREA DTSCS44 +03211 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03212 GO TO S2730-EXIT. DTSCS44 +03213 DTSCS44 +03214 * *---------------------------------- DTSCS44 +03215 *--------------------------* NOT SURE IF NEEDED IN MT DTSCS44 +03216 * *---------------------------------- DTSCS44 +03217 *****IF MAP-STATUS-CD NOT = 'C' DTSCS44 +03218 ***** IF MLIN-COVERED-YRQ (WRK-SUB) < WRK-STATUTE-YRQ DTSCS44 +03219 ***** MOVE MSG03-AREA TO WRK-MSG-AREA DTSCS44 +03220 ***** PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03221 ***** GO TO S2730-EXIT. DTSCS44 +03222 DTSCS44 +03223 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS44 +03224 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSCS44 +03225 SET MQTR-QTR-88 TO TRUE. DTSCS44 +03226 MOVE MLIN-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS44 +03227 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +03228 DTSCS44 +03229 PERFORM S810-READ THRU S810-EXIT. DTSCS44 +03230 DTSCS44 +03231 IF L810-NO-REC-88 DTSCS44 +03232 IF MAP-STATUS-CD = 'O' DTSCS44 +03233 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS44 +03234 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03235 GO TO S2730-EXIT DTSCS44 +03236 ELSE DTSCS44 +03237 GO TO S2730-EXIT. DTSCS44 +03238 DTSCS44 +03239 MOVE MSKL-REC TO MQTR-REC. DTSCS44 +03240 DTSCS44 +03241 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS44 +03242 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS44 +03243 PERFORM S4000-INTEREST THRU S4000-EXIT. DTSCS44 +03244 DTSCS44 +03245 IF WRK-YRQ-BALANCE-AMT = +0 DTSCS44 +03246 AND MAP-STATUS-CD = 'O' DTSCS44 +03247 MOVE MSG-E442-AREA TO WRK-MSG-AREA DTSCS44 +03248 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03249 GO TO S2730-EXIT. DTSCS44 +03250 DTSCS44 +03251 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS44 +03252 MOVE ' WRITTEN OFF' TO MAP-AMT-DUE (WRK-SUB) DTSCS44 +03253 ELSE DTSCS44 +03254 MOVE WRK-YRQ-BALANCE-AMT TO MAP-AMT-DUE-Z (WRK-SUB). DTSCS44 +03255 DTSCS44 +03256 MOVE MQTR-CURR-RPT-TYPE TO MAP-CURR-RPT-TYPE (WRK-SUB). DTSCS44 +03257 DTSCS44 +03258 PERFORM P6913-TRANSLATE THRU P6913-EXIT. DTSCS44 03259 DTSCS44 -03260 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 -03261 DTSCS44 -03262 S2752-EXIT. EXIT. DTSCS44 -03263 DTSCS44 -03264 S2753-ON-SCREEN. DTSCS44 -03265 IF WRK-TBL-QTR (WRK-SUB) = LCCM-PICKUP-YRQ DTSCS44 -03266 MOVE 'PU' TO MAP-COVERED-YRQ-YR (WRK-SUB) DTSCS44 -03267 MOVE ' ' TO MAP-COVERED-YRQ-Q (WRK-SUB) DTSCS44 -03268 ELSE DTSCS44 -03269 MOVE WRK-TBL-QTR (WRK-SUB) TO WRK-DISPLAY DTSCS44 -03270 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR (WRK-SUB) DTSCS44 -03271 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q (WRK-SUB). DTSCS44 +03260 S2730-EXIT. DTSCS44 +03261 EXIT. DTSCS44 +03262 DTSCS44 +03263 S2750-DEFAULT-QTRS. DTSCS44 +03264 MOVE ZERO TO WRK-TBL-SUB. DTSCS44 +03265 DTSCS44 +03266 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS44 +03267 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSCS44 +03268 **** MOVE WRK-STATUTE-YRQ TO MQTR-YRQ. DTSCS44 +03269 SET MQTR-QTR-88 TO TRUE. DTSCS44 +03270 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +03271 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 03272 DTSCS44 -03273 MOVE WRK-TBL-BALANCE (WRK-SUB) DTSCS44 -03274 TO MAP-AMT-DUE-Z (WRK-SUB). DTSCS44 -03275 DTSCS44 -03276 MOVE WRK-TBL-RPT-TYPE (WRK-SUB) DTSCS44 -03277 TO MAP-CURR-RPT-TYPE (WRK-SUB). DTSCS44 -03278 DTSCS44 -03279 PERFORM P6913-TRANSLATE THRU P6913-EXIT. DTSCS44 -03280 DTSCS44 -03281 SUBTRACT 1 FROM WRK-NO-ENTRY-CTR. DTSCS44 -03282 DTSCS44 -03283 S2753-EXIT. EXIT. DTSCS44 -03284 DTSCS44 +03273 PERFORM S2752-PROCESS-QTRS THRU S2752-EXIT DTSCS44 +03274 UNTIL L810-NO-REC-88 DTSCS44 +03275 OR WRK-TBL-SUB > MMAX-LIN-COV-MAX. DTSCS44 +03276 DTSCS44 +03277 IF L810-OK-88 DTSCS44 +03278 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 +03279 DTSCS44 +03280 IF WRK-TBL-SUB > MMAX-LIN-COV-MAX DTSCS44 +03281 MOVE 1 TO WRK-SUB DTSCS44 +03282 MOVE MSG-E445-AREA TO WRK-MSG-AREA DTSCS44 +03283 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03284 GO TO S2750-EXIT. DTSCS44 03285 DTSCS44 -03286 DTSCS44 -03287 S2799-ERROR. DTSCS44 -03288 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS44 -03289 TO MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS44 -03290 MAP-COVERED-YRQ-Q-A(WRK-SUB). DTSCS44 -03291 DTSCS44 -03292 IF LCCM-NO-MSG DTSCS44 -03293 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 -03294 MOVE CATB-CURSOR TO MAP-COVERED-YRQ-YR-L(WRK-SUB) DTSCS44 -03295 SET CURSOR-SET-YES TO TRUE. DTSCS44 -03296 S2799-EXIT. DTSCS44 -03297 EXIT. DTSCS44 -03298 /*****************************************************************DTSCS44 -03299 * *DTSCS44 -03300 ******************************************************************DTSCS44 -03301 S3000-MISC-EDITS. DTSCS44 -03302 PERFORM S3100-CHECK-DPC THRU S3100-EXIT. DTSCS44 -03303 DTSCS44 -03304 S3000-EXIT. EXIT. DTSCS44 -03305 DTSCS44 -03306 S3100-CHECK-DPC. DTSCS44 -03307 MOVE LOW-VALUES TO MDPC-KEY-AREA. DTSCS44 -03308 MOVE MPRF-EMP-NO TO MDPC-EMP-NO. DTSCS44 -03309 SET MDPC-DPC-88 TO TRUE. DTSCS44 -03310 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 -03311 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 +03286 IF WRK-TBL-SUB = +0 DTSCS44 +03287 IF MAP-STATUS-CD = 'C' DTSCS44 +03288 MOVE +1 TO WRK-SUB DTSCS44 +03289 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS44 +03290 PERFORM S2799-ERROR THRU S2799-EXIT DTSCS44 +03291 ELSE DTSCS44 +03292 MOVE MSG-E447-AREA TO WRK-MSG-AREA DTSCS44 +03293 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS44 +03294 DTSCS44 +03295 PERFORM S2753-ON-SCREEN THRU S2753-EXIT DTSCS44 +03296 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 +03297 UNTIL WRK-SUB > WRK-TBL-SUB. DTSCS44 +03298 S2750-EXIT. EXIT. DTSCS44 +03299 DTSCS44 +03300 S2752-PROCESS-QTRS. DTSCS44 +03301 MOVE MSKL-REC TO MQTR-REC. DTSCS44 +03302 DTSCS44 +03303 MOVE +0 TO WRK-YRQ-BALANCE-AMT. DTSCS44 +03304 DTSCS44 +03305 PERFORM S4000-INTEREST THRU S4000-EXIT. DTSCS44 +03306 DTSCS44 +03307 IF WRK-YRQ-BALANCE-AMT > 0 DTSCS44 +03308 ADD 1 TO WRK-TBL-SUB DTSCS44 +03309 MOVE WRK-YRQ-BALANCE-AMT TO WRK-TBL-BALANCE(WRK-TBL-SUB) DTSCS44 +03310 MOVE MQTR-YRQ TO WRK-TBL-QTR(WRK-TBL-SUB) DTSCS44 +03311 MOVE MQTR-CURR-RPT-TYPE TO WRK-TBL-RPT-TYPE(WRK-TBL-SUB). DTSCS44 03312 DTSCS44 -03313 PERFORM DTSCS44 -03314 UNTIL L810-NO-REC-88 DTSCS44 -03315 MOVE MSKL-REC TO MQTR-REC DTSCS44 -03316 IF MDPC-STATUS-PENDING-88 DTSCS44 -03317 MOVE MSG-E44A-AREA TO WRK-MSG-AREA DTSCS44 -03318 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 -03319 SET L810-NO-REC-88 TO TRUE DTSCS44 -03320 ELSE DTSCS44 -03321 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS44 -03322 END-IF DTSCS44 -03323 END-PERFORM. DTSCS44 -03324 DTSCS44 -03325 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 -03326 DTSCS44 -03327 S3100-EXIT. EXIT. DTSCS44 +03313 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS44 +03314 DTSCS44 +03315 S2752-EXIT. EXIT. DTSCS44 +03316 DTSCS44 +03317 S2753-ON-SCREEN. DTSCS44 +03318 IF WRK-TBL-QTR (WRK-SUB) = LCCM-PICKUP-YRQ DTSCS44 +03319 MOVE 'PU' TO MAP-COVERED-YRQ-YR (WRK-SUB) DTSCS44 +03320 MOVE ' ' TO MAP-COVERED-YRQ-Q (WRK-SUB) DTSCS44 +03321 ELSE DTSCS44 +03322 MOVE WRK-TBL-QTR (WRK-SUB) TO WRK-DISPLAY DTSCS44 +03323 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR (WRK-SUB) DTSCS44 +03324 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q (WRK-SUB). DTSCS44 +03325 DTSCS44 +03326 MOVE WRK-TBL-BALANCE (WRK-SUB) DTSCS44 +03327 TO MAP-AMT-DUE-Z (WRK-SUB). DTSCS44 03328 DTSCS44 -03329 S3110-PROCESS-DPC. DTSCS44 -03330 S3110-EXIT. EXIT. DTSCS44 +03329 MOVE WRK-TBL-RPT-TYPE (WRK-SUB) DTSCS44 +03330 TO MAP-CURR-RPT-TYPE (WRK-SUB). DTSCS44 03331 DTSCS44 -03332 S4000-INTEREST. DTSCS44 -03333 ****************************************************** DTSCS44 -03334 * INCLUDE SUR TAX IN CALCULATION OF INTEREST. DTSCS44 -03335 ****************************************************** DTSCS44 -03336 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS44 -03337 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS44 +03332 PERFORM P6913-TRANSLATE THRU P6913-EXIT. DTSCS44 +03333 DTSCS44 +03334 SUBTRACT 1 FROM WRK-NO-ENTRY-CTR. DTSCS44 +03335 DTSCS44 +03336 S2753-EXIT. EXIT. DTSCS44 +03337 DTSCS44 03338 DTSCS44 -03339 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS44 -03340 DTSCS44 -03341 MOVE +0 TO L101-PAID-CHNG. DTSCS44 -03342 DTSCS44 -03343 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS44 -03344 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS44 -03345 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS44 -03346 TO WRK-TOT-BALANCE-AMT DTSCS44 -03347 WRK-YRQ-BALANCE-AMT DTSCS44 -03348 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS44 -03349 TO WRK-YRQ-WRITTEN-OFF-AMT DTSCS44 -03350 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS44 -03351 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS44 -03352 TO L101-PAID-CHNG DTSCS44 -03353 END-IF DTSCS44 -03354 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS44 -03355 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS44 -03356 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS44 -03357 TO L101-PAID-CHNG DTSCS44 -03358 END-IF DTSCS44 -03359 END-PERFORM. DTSCS44 -03360 DTSCS44 -03361 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS44 -03362 GO TO S4000-EXIT. DTSCS44 -03363 DTSCS44 -03364 IF L101-PAID-CHNG > +0 DTSCS44 -03365 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE DTSCS44 -03366 SET L101-WAIVE-INT-NO-88 TO TRUE DTSCS44 -03367 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSCS44 -03368 MOVE MQTR-INT-AREA TO L101-INT-AREA DTSCS44 -03369 DTSCS44 -03370 PERFORM S101-PER-MONTH-NO THRU S101-EXIT DTSCS44 -03371 DTSCS44 -03372 ADD L101-INT-CHARGE-CHNG DTSCS44 -03373 TO WRK-TOT-BALANCE-AMT DTSCS44 -03374 WRK-YRQ-BALANCE-AMT DTSCS44 -03375 DTSCS44 -03376 SUBTRACT L101-INT-WAIVE-CHNG DTSCS44 -03377 FROM WRK-TOT-BALANCE-AMT DTSCS44 -03378 WRK-YRQ-BALANCE-AMT. DTSCS44 +03339 DTSCS44 +03340 S2799-ERROR. DTSCS44 +03341 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS44 +03342 TO MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS44 +03343 MAP-COVERED-YRQ-Q-A(WRK-SUB). DTSCS44 +03344 DTSCS44 +03345 IF LCCM-NO-MSG DTSCS44 +03346 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS44 +03347 MOVE CATB-CURSOR TO MAP-COVERED-YRQ-YR-L(WRK-SUB) DTSCS44 +03348 SET CURSOR-SET-YES TO TRUE. DTSCS44 +03349 S2799-EXIT. DTSCS44 +03350 EXIT. DTSCS44 +03351 /*****************************************************************DTSCS44 +03352 * *DTSCS44 +03353 ******************************************************************DTSCS44 +03354 S3000-MISC-EDITS. DTSCS44 +03355 PERFORM S3100-CHECK-DPC THRU S3100-EXIT. DTSCS44 +03356 DTSCS44 +03357 S3000-EXIT. EXIT. DTSCS44 +03358 DTSCS44 +03359 S3100-CHECK-DPC. DTSCS44 +03360 MOVE LOW-VALUES TO MDPC-KEY-AREA. DTSCS44 +03361 MOVE MPRF-EMP-NO TO MDPC-EMP-NO. DTSCS44 +03362 SET MDPC-DPC-88 TO TRUE. DTSCS44 +03363 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. DTSCS44 +03364 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS44 +03365 DTSCS44 +03366 PERFORM DTSCS44 +03367 UNTIL L810-NO-REC-88 DTSCS44 +03368 MOVE MSKL-REC TO MQTR-REC DTSCS44 +03369 IF MDPC-STATUS-PENDING-88 DTSCS44 +03370 MOVE MSG-E44A-AREA TO WRK-MSG-AREA DTSCS44 +03371 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS44 +03372 SET L810-NO-REC-88 TO TRUE DTSCS44 +03373 ELSE DTSCS44 +03374 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS44 +03375 END-IF DTSCS44 +03376 END-PERFORM. DTSCS44 +03377 DTSCS44 +03378 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS44 03379 DTSCS44 -03380 S4000-EXIT. DTSCS44 -03381 EXIT. DTSCS44 -03382 /*****************************************************************DTSCS44 -03383 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS44 -03384 ******************************************************************DTSCS44 -03385 S5100-SET-LOCK-ATTRB. DTSCS44 -03386 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS44 -03387 WRK-ATB-NUM. DTSCS44 -03388 DTSCS44 -03389 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS44 -03390 DTSCS44 -03391 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS44 -03392 MAP-EMP-NO-2-A DTSCS44 -03393 MAP-GOTO-A. DTSCS44 -03394 S5100-EXIT. DTSCS44 -03395 EXIT. DTSCS44 -03396 DTSCS44 -03397 ******************************************************************DTSCS44 -03398 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS44 -03399 ******************************************************************DTSCS44 -03400 S5200-SET-UPDATE-ATTRB. DTSCS44 -03401 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS44 -03402 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS44 -03403 DTSCS44 -03404 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS44 -03405 DTSCS44 -03406 DTSCS44 -03407 S5200-EXIT. DTSCS44 -03408 EXIT. DTSCS44 -03409 DTSCS44 -03410 ******************************************************************DTSCS44 -03411 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS44 -03412 ******************************************************************DTSCS44 -03413 S5300-SET-INQ-ATTRB. DTSCS44 -03414 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS44 -03415 WRK-ATB-NUM. DTSCS44 +03380 S3100-EXIT. EXIT. DTSCS44 +03381 DTSCS44 +03382 S3110-PROCESS-DPC. DTSCS44 +03383 S3110-EXIT. EXIT. DTSCS44 +03384 DTSCS44 +03385 S4000-INTEREST. DTSCS44 +03386 ****************************************************** DTSCS44 +03387 * INCLUDE SUR TAX IN CALCULATION OF INTEREST. DTSCS44 +03388 ****************************************************** DTSCS44 +03389 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS44 +03390 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS44 +03391 DTSCS44 +03392 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS44 +03393 DTSCS44 +03394 MOVE +0 TO L101-PAID-CHNG. DTSCS44 +03395 DTSCS44 +03396 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS44 +03397 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS44 +03398 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS44 +03399 TO WRK-TOT-BALANCE-AMT DTSCS44 +03400 WRK-YRQ-BALANCE-AMT DTSCS44 +03401 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS44 +03402 TO WRK-YRQ-WRITTEN-OFF-AMT DTSCS44 +03403 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS44 +03404 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS44 +03405 TO L101-PAID-CHNG DTSCS44 +03406 END-IF DTSCS44 +03407 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS44 +03408 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS44 +03409 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS44 +03410 TO L101-PAID-CHNG DTSCS44 +03411 END-IF DTSCS44 +03412 END-PERFORM. DTSCS44 +03413 DTSCS44 +03414 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS44 +03415 GO TO S4000-EXIT. DTSCS44 03416 DTSCS44 -03417 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS44 -03418 S5300-EXIT. DTSCS44 -03419 EXIT. DTSCS44 -03420 DTSCS44 -03421 S5900-SET-ATTRB. DTSCS44 -03422 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS44 -03423 MAP-EMP-NO-2-A. DTSCS44 -03424 IF LCCM-SCR-CLEAR DTSCS44 -03425 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 -03426 MAP-MAIL-NO-A DTSCS44 -03427 MAP-DEED-NO-A DTSCS44 -03428 MAP-CERT-DATE-DA-A DTSCS44 -03429 MAP-CERT-DATE-MO-A DTSCS44 -03430 MAP-CERT-DATE-YR-A DTSCS44 -03431 MAP-RETURN-DATE-DA-A DTSCS44 -03432 MAP-RETURN-DATE-MO-A DTSCS44 -03433 MAP-RETURN-DATE-YR-A DTSCS44 -03434 MOVE WRK-ATB-AN TO DTSCS44 -03435 MAP-STATUS-CD-A DTSCS44 -03436 MAP-FLD-REP-ID-CD-A DTSCS44 -03437 MAP-ADDR-TYPE-A DTSCS44 -03438 MAP-ADDR-ID-NO-A DTSCS44 -03439 MAP-LICENSE-IND-A DTSCS44 -03440 MAP-LIEN-ADDR-LINE-1-A DTSCS44 -03441 MAP-LIEN-ADDR-LINE-2-A DTSCS44 -03442 MAP-LIEN-ADDR-LINE-3-A DTSCS44 -03443 MAP-LIEN-ADDR-LINE-4-A DTSCS44 -03444 MAP-LIEN-ADDR-LINE-5-A DTSCS44 -03445 MAP-STATUS-CD-A DTSCS44 -03446 MOVE WRK-ATB-NUM TO DTSCS44 -03447 MAP-CERT-NUM1-A DTSCS44 -03448 MAP-CERT-NUM2-A DTSCS44 -03449 MAP-COMP-DA-A DTSCS44 -03450 MAP-COMP-MO-A DTSCS44 -03451 MAP-COMP-YR-A DTSCS44 -03452 MAP-CERT-DA-A DTSCS44 -03453 MAP-CERT-MO-A DTSCS44 -03454 MAP-CERT-YR-A DTSCS44 -03455 MAP-STMT-DA-A DTSCS44 -03456 MAP-STMT-MO-A DTSCS44 -03457 MAP-STMT-YR-A DTSCS44 -03458 MAP-STMT-DUE-AMT-A DTSCS44 -03459 MAP-CURR-COMP-MO-A DTSCS44 -03460 MAP-CURR-COMP-DA-A DTSCS44 -03461 MAP-CURR-COMP-YR-A DTSCS44 +03417 IF L101-PAID-CHNG > +0 DTSCS44 +03418 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE DTSCS44 +03419 SET L101-WAIVE-INT-NO-88 TO TRUE DTSCS44 +03420 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSCS44 +03421 MOVE MQTR-INT-AREA TO L101-INT-AREA DTSCS44 +03422 DTSCS44 +03423 PERFORM S101-PER-MONTH-NO THRU S101-EXIT DTSCS44 +03424 DTSCS44 +03425 ADD L101-INT-CHARGE-CHNG DTSCS44 +03426 TO WRK-TOT-BALANCE-AMT DTSCS44 +03427 WRK-YRQ-BALANCE-AMT DTSCS44 +03428 DTSCS44 +03429 SUBTRACT L101-INT-WAIVE-CHNG DTSCS44 +03430 FROM WRK-TOT-BALANCE-AMT DTSCS44 +03431 WRK-YRQ-BALANCE-AMT. DTSCS44 +03432 DTSCS44 +03433 S4000-EXIT. DTSCS44 +03434 EXIT. DTSCS44 +03435 /*****************************************************************DTSCS44 +03436 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS44 +03437 ******************************************************************DTSCS44 +03438 S5100-SET-LOCK-ATTRB. DTSCS44 +03439 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS44 +03440 WRK-ATB-NUM. DTSCS44 +03441 DTSCS44 +03442 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS44 +03443 DTSCS44 +03444 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS44 +03445 MAP-EMP-NO-2-A DTSCS44 +03446 MAP-GOTO-A. DTSCS44 +03447 S5100-EXIT. DTSCS44 +03448 EXIT. DTSCS44 +03449 DTSCS44 +03450 ******************************************************************DTSCS44 +03451 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS44 +03452 ******************************************************************DTSCS44 +03453 S5200-SET-UPDATE-ATTRB. DTSCS44 +03454 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS44 +03455 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS44 +03456 DTSCS44 +03457 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS44 +03458 DTSCS44 +03459 DTSCS44 +03460 S5200-EXIT. DTSCS44 +03461 EXIT. DTSCS44 03462 DTSCS44 -03463 PERFORM DTSCS44 -03464 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 -03465 UNTIL WRK-SUB > MMAX-LIN-COV-MAX DTSCS44 -03466 MOVE WRK-ATB-AN TO DTSCS44 -03467 MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS44 -03468 MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS44 -03469 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 -03470 MAP-AMT-DUE-A(WRK-SUB) DTSCS44 -03471 MAP-CURR-RPT-TYPE-A(WRK-SUB) DTSCS44 -03472 END-PERFORM DTSCS44 -03473 ELSE DTSCS44 -03474 MOVE WRK-ATB-AN TO DTSCS44 -03475 MAP-STATUS-CD-A DTSCS44 -03476 MAP-MAIL-NO-A DTSCS44 -03477 MAP-DEED-NO-A DTSCS44 -03478 MAP-FLD-REP-ID-CD-A DTSCS44 -03479 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 -03480 MAP-CERT-NUM1-A DTSCS44 -03481 MAP-CERT-NUM2-A DTSCS44 -03482 MAP-ADDR-TYPE-A DTSCS44 -03483 MAP-LICENSE-IND-A DTSCS44 -03484 MAP-LIEN-ADDR-LINE-1-A DTSCS44 -03485 MAP-LIEN-ADDR-LINE-2-A DTSCS44 -03486 MAP-LIEN-ADDR-LINE-3-A DTSCS44 -03487 MAP-LIEN-ADDR-LINE-4-A DTSCS44 -03488 MAP-LIEN-ADDR-LINE-5-A DTSCS44 -03489 MAP-CREATE-DATE-TIME-A DTSCS44 -03490 MOVE WRK-ATB-NUM TO DTSCS44 -03491 MAP-CERT-DATE-DA-A DTSCS44 -03492 MAP-CERT-DATE-MO-A DTSCS44 -03493 MAP-CERT-DATE-YR-A DTSCS44 -03494 MAP-RETURN-DATE-DA-A DTSCS44 -03495 MAP-RETURN-DATE-MO-A DTSCS44 -03496 MAP-RETURN-DATE-YR-A DTSCS44 -03497 MAP-CURR-COMP-MO-A DTSCS44 -03498 MAP-CURR-COMP-DA-A DTSCS44 -03499 MAP-CURR-COMP-YR-A DTSCS44 -03500 MAP-CERT-DA-A DTSCS44 -03501 MAP-CERT-MO-A DTSCS44 -03502 MAP-CERT-YR-A DTSCS44 -03503 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 -03504 MAP-ADDR-ID-NO-A DTSCS44 -03505 MAP-COMP-DA-A DTSCS44 -03506 MAP-COMP-MO-A DTSCS44 -03507 MAP-COMP-YR-A DTSCS44 +03463 ******************************************************************DTSCS44 +03464 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS44 +03465 ******************************************************************DTSCS44 +03466 S5300-SET-INQ-ATTRB. DTSCS44 +03467 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS44 +03468 WRK-ATB-NUM. DTSCS44 +03469 DTSCS44 +03470 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS44 +03471 S5300-EXIT. DTSCS44 +03472 EXIT. DTSCS44 +03473 DTSCS44 +03474 S5900-SET-ATTRB. DTSCS44 +03475 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS44 +03476 MAP-EMP-NO-2-A. DTSCS44 +03477 IF LCCM-SCR-CLEAR DTSCS44 +03478 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 +03479 MAP-MAIL-NO-A DTSCS44 +03480 MAP-DEED-NO-A DTSCS44 +03481 MAP-CERT-DATE-DA-A DTSCS44 +03482 MAP-CERT-DATE-MO-A DTSCS44 +03483 MAP-CERT-DATE-YR-A DTSCS44 +03484 MAP-RETURN-DATE-DA-A DTSCS44 +03485 MAP-RETURN-DATE-MO-A DTSCS44 +03486 MAP-RETURN-DATE-YR-A DTSCS44 +03487 MOVE WRK-ATB-AN TO DTSCS44 +03488 MAP-STATUS-CD-A DTSCS44 +03489 *SRJ MAP-FLD-REP-ID-CD-A CL**5 +03490 MAP-ADDR-TYPE-A DTSCS44 +03491 MAP-ADDR-ID-NO-A DTSCS44 +03492 MAP-LICENSE-IND-A DTSCS44 +03493 MAP-LIEN-ADDR-LINE-1-A DTSCS44 +03494 MAP-LIEN-ADDR-LINE-2-A DTSCS44 +03495 MAP-LIEN-ADDR-LINE-3-A DTSCS44 +03496 MAP-LIEN-ADDR-LINE-4-A DTSCS44 +03497 MAP-LIEN-ADDR-LINE-5-A DTSCS44 +03498 MAP-STATUS-CD-A DTSCS44 +03499 MOVE WRK-ATB-NUM TO DTSCS44 +03500 MAP-CERT-NUM1-A DTSCS44 +03501 MAP-CERT-NUM2-A DTSCS44 +03502 MAP-COMP-DA-A DTSCS44 +03503 MAP-COMP-MO-A DTSCS44 +03504 MAP-COMP-YR-A DTSCS44 +03505 MAP-CERT-DA-A DTSCS44 +03506 MAP-CERT-MO-A DTSCS44 +03507 MAP-CERT-YR-A DTSCS44 03508 MAP-STMT-DA-A DTSCS44 03509 MAP-STMT-MO-A DTSCS44 03510 MAP-STMT-YR-A DTSCS44 03511 MAP-STMT-DUE-AMT-A DTSCS44 -03512 DTSCS44 -03513 PERFORM DTSCS44 -03514 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 -03515 UNTIL WRK-SUB > MMAX-LIN-COV-MAX DTSCS44 -03516 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 -03517 MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS44 -03518 MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS44 -03519 MAP-AMT-DUE-A(WRK-SUB) DTSCS44 -03520 MAP-CURR-RPT-TYPE-A(WRK-SUB) DTSCS44 -03521 END-PERFORM DTSCS44 -03522 END-IF. DTSCS44 -03523 DTSCS44 -03524 DTSCS44 -03525 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS44 -03526 MAP-FLD-REP-ID-CD-DSCR-A DTSCS44 -03527 MAP-STATUS-DATE-A DTSCS44 -03528 MAP-STATUS-OP-ID-A DTSCS44 -03529 MAP-CURR-PAGE-A DTSCS44 -03530 MAP-LAST-PAGE-A DTSCS44 -03531 MAP-CURR-TOT-DUE-A. DTSCS44 -03532 DTSCS44 -03533 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS44 -03534 S5900-EXIT. DTSCS44 -03535 EXIT. DTSCS44 -03536 EJECT DTSCS44 -03537 /*****************************************************************DTSCS44 -03538 * MAP ROUTINES *DTSCS44 -03539 ******************************************************************DTSCS44 -03540 S9100-RECEIVE. DTSCS44 -03541 SET L851-RECEIVE-88 TO TRUE. DTSCS44 -03542 DTSCS44 -03543 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS44 -03544 DTSCS44 -03545 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS44 -03546 DTSCS44 -03547 MOVE L851-AID TO LCCM-AID. DTSCS44 -03548 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS44 -03549 S9100-EXIT. DTSCS44 -03550 EXIT. DTSCS44 -03551 DTSCS44 -03552 S9200-SEND-DATAONLY. DTSCS44 -03553 MOVE LOW-VALUES TO MAP-AREA. DTSCS44 -03554 DTSCS44 -03555 IF LCCM-NO-MSG DTSCS44 -03556 NEXT SENTENCE DTSCS44 -03557 ELSE DTSCS44 -03558 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS44 -03559 DTSCS44 -03560 IF CURSOR-SET-GOTO DTSCS44 -03561 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS44 -03562 ELSE DTSCS44 -03563 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS44 -03564 DTSCS44 -03565 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS44 -03566 DTSCS44 -03567 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS44 -03568 DTSCS44 -03569 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS44 -03570 S9200-EXIT. DTSCS44 -03571 EXIT. DTSCS44 -03572 DTSCS44 -03573 S9300-SEND-MAP. DTSCS44 -03574 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS44 -03575 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS44 -03576 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS44 +03512 MAP-CURR-COMP-MO-A DTSCS44 +03513 MAP-CURR-COMP-DA-A DTSCS44 +03514 MAP-CURR-COMP-YR-A DTSCS44 +03515 DTSCS44 +03516 PERFORM DTSCS44 +03517 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 +03518 UNTIL WRK-SUB > MMAX-LIN-COV-MAX DTSCS44 +03519 MOVE WRK-ATB-AN TO DTSCS44 +03520 MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS44 +03521 MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS44 +03522 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 +03523 MAP-AMT-DUE-A(WRK-SUB) DTSCS44 +03524 MAP-CURR-RPT-TYPE-A(WRK-SUB) DTSCS44 +03525 END-PERFORM DTSCS44 +03526 ELSE DTSCS44 +03527 MOVE WRK-ATB-AN TO DTSCS44 +03528 MAP-STATUS-CD-A DTSCS44 +03529 MAP-MAIL-NO-A DTSCS44 +03530 MAP-DEED-NO-A DTSCS44 +03531 *SRJ MAP-FLD-REP-ID-CD-A CL**5 +03532 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 +03533 MAP-CERT-NUM1-A DTSCS44 +03534 MAP-CERT-NUM2-A DTSCS44 +03535 MAP-ADDR-TYPE-A DTSCS44 +03536 MAP-LICENSE-IND-A DTSCS44 +03537 MAP-LIEN-ADDR-LINE-1-A DTSCS44 +03538 MAP-LIEN-ADDR-LINE-2-A DTSCS44 +03539 MAP-LIEN-ADDR-LINE-3-A DTSCS44 +03540 MAP-LIEN-ADDR-LINE-4-A DTSCS44 +03541 MAP-LIEN-ADDR-LINE-5-A DTSCS44 +03542 MAP-CREATE-DATE-TIME-A DTSCS44 +03543 MOVE WRK-ATB-NUM TO DTSCS44 +03544 MAP-CERT-DATE-DA-A DTSCS44 +03545 MAP-CERT-DATE-MO-A DTSCS44 +03546 MAP-CERT-DATE-YR-A DTSCS44 +03547 MAP-RETURN-DATE-DA-A DTSCS44 +03548 MAP-RETURN-DATE-MO-A DTSCS44 +03549 MAP-RETURN-DATE-YR-A DTSCS44 +03550 MAP-CURR-COMP-MO-A DTSCS44 +03551 MAP-CURR-COMP-DA-A DTSCS44 +03552 MAP-CURR-COMP-YR-A DTSCS44 +03553 MAP-CERT-DA-A DTSCS44 +03554 MAP-CERT-MO-A DTSCS44 +03555 MAP-CERT-YR-A DTSCS44 +03556 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 +03557 MAP-ADDR-ID-NO-A DTSCS44 +03558 MAP-COMP-DA-A DTSCS44 +03559 MAP-COMP-MO-A DTSCS44 +03560 MAP-COMP-YR-A DTSCS44 +03561 MAP-STMT-DA-A DTSCS44 +03562 MAP-STMT-MO-A DTSCS44 +03563 MAP-STMT-YR-A DTSCS44 +03564 MAP-STMT-DUE-AMT-A DTSCS44 +03565 DTSCS44 +03566 PERFORM DTSCS44 +03567 VARYING WRK-SUB FROM 1 BY 1 DTSCS44 +03568 UNTIL WRK-SUB > MMAX-LIN-COV-MAX DTSCS44 +03569 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS44 +03570 MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS44 +03571 MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS44 +03572 MAP-AMT-DUE-A(WRK-SUB) DTSCS44 +03573 MAP-CURR-RPT-TYPE-A(WRK-SUB) DTSCS44 +03574 END-PERFORM DTSCS44 +03575 END-IF. DTSCS44 +03576 DTSCS44 03577 DTSCS44 -03578 IF SCR-ACCESS-UPDATE DTSCS44 -03579 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS44 -03580 ELSE DTSCS44 -03581 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS44 -03582 DTSCS44 -03583 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS44 -03584 DTSCS44 -03585 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS44 -03586 DTSCS44 -03587 IF CURSOR-SET-NO DTSCS44 -03588 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS44 -03589 DTSCS44 -03590 SET L851-SEND-88 TO TRUE. DTSCS44 -03591 DTSCS44 -03592 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS44 -03593 DTSCS44 -03594 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS44 -03595 S9300-EXIT. DTSCS44 -03596 EXIT. DTSCS44 +03578 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS44 +03579 *SRJ MAP-FLD-REP-ID-CD-DSCR-A CL**5 +03580 MAP-STATUS-DATE-A DTSCS44 +03581 MAP-STATUS-OP-ID-A DTSCS44 +03582 MAP-CURR-PAGE-A DTSCS44 +03583 MAP-LAST-PAGE-A DTSCS44 +03584 MAP-CURR-TOT-DUE-A. DTSCS44 +03585 DTSCS44 +03586 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS44 +03587 S5900-EXIT. DTSCS44 +03588 EXIT. DTSCS44 +03589 EJECT DTSCS44 +03590 /*****************************************************************DTSCS44 +03591 * MAP ROUTINES *DTSCS44 +03592 ******************************************************************DTSCS44 +03593 S9100-RECEIVE. DTSCS44 +03594 SET L851-RECEIVE-88 TO TRUE. DTSCS44 +03595 DTSCS44 +03596 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS44 03597 DTSCS44 -03598 S9310-UPDATE-FKEYS. DTSCS44 -03599 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS44 -03600 DTSCS44 -03601 DTSCS44 -03602 IF LCCM-SCR-CLEAR DTSCS44 -03603 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS44 -03604 ELSE DTSCS44 -03605 IF LCCM-SCR-INQUIRE DTSCS44 -03606 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS44 -03607 *** MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS44 -03608 ELSE DTSCS44 -03609 IF LCCM-SCR-UPDATE-LOCKED DTSCS44 -03610 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS44 -03611 MAP-KEY-LAST DTSCS44 -03612 MAP-KEY-BACK DTSCS44 -03613 MAP-KEY-FWRD. DTSCS44 -03614 S9310-EXIT. DTSCS44 -03615 EXIT. DTSCS44 -03616 DTSCS44 -03617 S9320-INQUIRY-FKEYS. DTSCS44 -03618 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS44 -03619 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS44 -03620 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS44 -03621 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS44 -03622 DTSCS44 -03623 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS44 -03624 MAP-KEY-MOD DTSCS44 -03625 MAP-KEY-DEL. DTSCS44 -03626 DTSCS44 -03627 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS44 -03628 S9320-EXIT. DTSCS44 -03629 EXIT. DTSCS44 +03598 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS44 +03599 DTSCS44 +03600 MOVE L851-AID TO LCCM-AID. DTSCS44 +03601 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS44 +03602 S9100-EXIT. DTSCS44 +03603 EXIT. DTSCS44 +03604 DTSCS44 +03605 S9200-SEND-DATAONLY. DTSCS44 +03606 MOVE LOW-VALUES TO MAP-AREA. DTSCS44 +03607 DTSCS44 +03608 IF LCCM-NO-MSG DTSCS44 +03609 NEXT SENTENCE DTSCS44 +03610 ELSE DTSCS44 +03611 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS44 +03612 DTSCS44 +03613 IF CURSOR-SET-GOTO DTSCS44 +03614 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS44 +03615 ELSE DTSCS44 +03616 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS44 +03617 DTSCS44 +03618 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS44 +03619 DTSCS44 +03620 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS44 +03621 DTSCS44 +03622 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS44 +03623 S9200-EXIT. DTSCS44 +03624 EXIT. DTSCS44 +03625 DTSCS44 +03626 S9300-SEND-MAP. DTSCS44 +03627 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS44 +03628 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS44 +03629 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS44 03630 DTSCS44 -03631 *S9321-JUMP-KEYS. DTSCS44 -03632 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS44 -03633 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS44 -03634 * MOVE 'F21=OPO' TO MAP-KEY-OPO. DTSCS44 -03635 *S9321-EXIT. DTSCS44 -03636 * EXIT. DTSCS44 -03637 * DTSCS44 -03638 S9330-DSCR-FIELDS. DTSCS44 -03639 IF WRK-MPRF-YES-88 DTSCS44 -03640 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS44 -03641 DTSCS44 -03642 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS44 -03643 MOVE LOW-VALUES TO MAP-STATUS-CD-DSCR DTSCS44 -03644 ELSE DTSCS44 -03645 MOVE MAP-STATUS-CD TO L034-CD DTSCS44 -03646 PERFORM S034-MLIN-STATUS-CD THRU S034-EXIT DTSCS44 -03647 MOVE L034-SHORT-DSCR TO MAP-STATUS-CD-DSCR. DTSCS44 -03648 DTSCS44 -03649 S9330-EXIT. EXIT. DTSCS44 +03631 IF SCR-ACCESS-UPDATE DTSCS44 +03632 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS44 +03633 ELSE DTSCS44 +03634 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS44 +03635 DTSCS44 +03636 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS44 +03637 DTSCS44 +03638 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS44 +03639 DTSCS44 +03640 IF CURSOR-SET-NO DTSCS44 +03641 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS44 +03642 DTSCS44 +03643 SET L851-SEND-88 TO TRUE. DTSCS44 +03644 DTSCS44 +03645 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS44 +03646 DTSCS44 +03647 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS44 +03648 S9300-EXIT. DTSCS44 +03649 EXIT. DTSCS44 03650 DTSCS44 -03651 S9900-PREPARE-SEND. DTSCS44 -03652 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS44 -03653 LCCM-SCR-ID. DTSCS44 -03654 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS44 -03655 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS44 -03656 S9900-EXIT. DTSCS44 -03657 EXIT. DTSCS44 +03651 S9310-UPDATE-FKEYS. DTSCS44 +03652 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS44 +03653 DTSCS44 +03654 DTSCS44 +03655 IF LCCM-SCR-CLEAR DTSCS44 +03656 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS44 +03657 ELSE DTSCS44 +03658 IF LCCM-SCR-INQUIRE DTSCS44 +03659 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS44 +03660 *** MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS44 +03661 ELSE DTSCS44 +03662 IF LCCM-SCR-UPDATE-LOCKED DTSCS44 +03663 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS44 +03664 MAP-KEY-LAST DTSCS44 +03665 MAP-KEY-BACK DTSCS44 +03666 MAP-KEY-FWRD. DTSCS44 +03667 S9310-EXIT. DTSCS44 +03668 EXIT. DTSCS44 +03669 DTSCS44 +03670 S9320-INQUIRY-FKEYS. DTSCS44 +03671 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS44 +03672 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS44 +03673 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS44 +03674 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS44 +03675 DTSCS44 +03676 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS44 +03677 MAP-KEY-MOD DTSCS44 +03678 MAP-KEY-DEL. DTSCS44 +03679 DTSCS44 +03680 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS44 +03681 S9320-EXIT. DTSCS44 +03682 EXIT. DTSCS44 +03683 DTSCS44 +03684 *S9321-JUMP-KEYS. DTSCS44 +03685 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS44 +03686 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS44 +03687 * MOVE 'F21=OPO' TO MAP-KEY-OPO. DTSCS44 +03688 *S9321-EXIT. DTSCS44 +03689 * EXIT. DTSCS44 +03690 * DTSCS44 +03691 S9330-DSCR-FIELDS. DTSCS44 +03692 IF WRK-MPRF-YES-88 DTSCS44 +03693 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS44 +03694 DTSCS44 +03695 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS44 +03696 MOVE LOW-VALUES TO MAP-STATUS-CD-DSCR DTSCS44 +03697 ELSE DTSCS44 +03698 MOVE MAP-STATUS-CD TO L034-CD DTSCS44 +03699 PERFORM S034-MLIN-STATUS-CD THRU S034-EXIT DTSCS44 +03700 MOVE L034-SHORT-DSCR TO MAP-STATUS-CD-DSCR. DTSCS44 +03701 DTSCS44 +03702 S9330-EXIT. EXIT. DTSCS44 +03703 DTSCS44 +03704 S9900-PREPARE-SEND. DTSCS44 +03705 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS44 +03706 LCCM-SCR-ID. DTSCS44 +03707 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS44 +03708 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS44 +03709 S9900-EXIT. DTSCS44 +03710 EXIT. DTSCS44 diff --git a/CICS/DTSCS82.cob b/CICS/DTSCS82.cob index bd602d4..508a94e 100644 --- a/CICS/DTSCS82.cob +++ b/CICS/DTSCS82.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 09/01/16 +00001 IDENTIFICATION DIVISION. 08/14/25 00002 PROGRAM-ID. DTSCS82. DTSCS82 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV030 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV011 00004 DATE-WRITTEN. SEPTEMBER 1998. DTSCS82 00005 DATE-COMPILED. DTSCS82 00006 SKIP3 DTSCS82 @@ -153,1733 +153,1746 @@ 00153 DATA DIVISION. DTSCS82 00154 SKIP3 DTSCS82 00155 WORKING-STORAGE SECTION. DTSCS82 -001555 77 PAN-VALET PICTURE X(24) VALUE '030DTSCS82 09/01/16'. DTSCS82 -00156 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS82 09/01/16'. DTSCS82 -00157 77 PAN-VALET PICTURE X(24) VALUE '028DTSCS82 04/01/13'. DTSCS82 -00158 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS82 02/21/13'. DTSCS82 -00159 77 PAN-VALET PICTURE X(24) VALUE '026DTSCS82 10/19/10'. DTSCS82 -00160 SKIP3 DTSCS82 -00161 01 WRK-AREA. DTSCS82 -00162 05 WRK-ABEND-CD PIC X(04) VALUE 'S82 '. DTSCS82 -00163 SKIP1 DTSCS82 -00164 05 WRK-SCR-ID. DTSCS82 -00165 10 WRK-SCR-ID-9 PIC 9(02) VALUE 82. DTSCS82 -00166 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS82 -00167 SKIP1 DTSCS82 -00168 05 WRK-KEY-AREA. DTSCS82 -00169 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS82 -00170 10 WRK-QTR PIC S9(05) COMP-3. DTSCS82 -00171 10 FILLER PIC X(11). DTSCS82 -00172 SKIP1 DTSCS82 -00173 05 WRK-DISP-DATE PIC 9(08). DTSCS82 -00174 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS82 -00175 10 WRK-DISP-CC PIC X(02). DTSCS82 -00176 10 WRK-DISP-YY PIC X(02). DTSCS82 -00177 10 WRK-DISP-MM PIC X(02). DTSCS82 -00178 10 WRK-DISP-DD PIC X(02). DTSCS82 -00179 SKIP1 DTSCS82 -00180 05 WRK-NO-ENTRY PIC S9(09) COMP-3 DTSCS82 -00181 VALUE +999999999. DTSCS82 -00182 05 WRK-UC30-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCS82 -00183 05 WRK-UC30-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCS82 -00184 05 WRK-UC30-FINAL-DEL-DATE PIC S9(09) COMP-3. DTSCS82 -00185 05 WRK-UC30-ESTIMATED-DATE PIC S9(09) COMP-3. DTSCS82 -00186 05 WRK-DELQ-LTR-SENT-DATE PIC S9(09) COMP-3. DTSCS82 -00187 05 WRK-SELF-INS-CHG-RUN-DATE PIC S9(09) COMP-3. DTSCS82 -00188 05 WRK-YRQ-START-DATE PIC S9(09) COMP-3. DTSCS82 -00189 05 WRK-YRQ-END-DATE PIC S9(09) COMP-3. DTSCS82 -00190 05 WRK-YRQ-PLUS1-START-DATE PIC S9(09) COMP-3. DTSCS82 -00191 05 WRK-YRQ-PLUS1-END-DATE PIC S9(09) COMP-3. DTSCS82 -00192 05 WRK-DEFAULT-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCS82 -00193 EJECT DTSCS82 -00194 01 SCREEN-PROCESSING. DTSCS82 -00195 05 SCR-ACCESS-IND PIC X(01). DTSCS82 -00196 88 SCR-ACCESS-INQ VALUE '1'. DTSCS82 -00197 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS82 -00198 SKIP1 DTSCS82 -00199 05 CURSOR-SET-IND PIC X(01). DTSCS82 -00200 88 CURSOR-SET-YES VALUE 'Y'. DTSCS82 -00201 88 CURSOR-SET-NO VALUE 'N'. DTSCS82 -00202 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS82 -00203 SKIP1 DTSCS82 -00204 05 REQ-IND PIC X(01). DTSCS82 -00205 88 REQ-ERROR VALUE 'O'. DTSCS82 -00206 88 REQ-JUMP VALUE 'J'. DTSCS82 -00207 88 REQ-INQUIRE VALUE 'I'. DTSCS82 -00208 88 REQ-CLEAR VALUE 'C'. DTSCS82 -00209 88 REQ-EDIT VALUE 'E'. DTSCS82 -00210 88 REQ-UPDATE VALUE 'U'. DTSCS82 -00211 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS82 -00212 SKIP1 DTSCS82 -00213 05 RESP-IND PIC X(01). DTSCS82 -00214 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS82 -00215 88 RESP-SEND-MAP VALUE 'M'. DTSCS82 -00216 88 RESP-JUMP VALUE 'J'. DTSCS82 -00217 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS82 -00218 SKIP1 DTSCS82 -00219 05 WRK-NEW-KEY-IND PIC X(01). DTSCS82 +001555 77 PAN-VALET PICTURE X(24) VALUE '011DTSCS82 08/14/25'. DTSCS82 +00156 77 PAN-VALET PICTURE X(24) VALUE '030DTSCS82 09/01/16'. DTSCS82 +00157 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS82 09/01/16'. DTSCS82 +00158 77 PAN-VALET PICTURE X(24) VALUE '028DTSCS82 04/01/13'. DTSCS82 +00159 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS82 02/21/13'. DTSCS82 +00160 77 PAN-VALET PICTURE X(24) VALUE '026DTSCS82 10/19/10'. DTSCS82 +00161 SKIP3 DTSCS82 +00162 01 WRK-AREA. DTSCS82 +00163 05 WRK-ABEND-CD PIC X(04) VALUE 'S82 '. DTSCS82 +00164 SKIP1 DTSCS82 +00165 05 WRK-SCR-ID. DTSCS82 +00166 10 WRK-SCR-ID-9 PIC 9(02) VALUE 82. DTSCS82 +00167 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS82 +00168 SKIP1 DTSCS82 +00169 05 WRK-KEY-AREA. DTSCS82 +00170 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS82 +00171 10 WRK-QTR PIC S9(05) COMP-3. DTSCS82 +00172 10 FILLER PIC X(11). DTSCS82 +00173 SKIP1 DTSCS82 +00174 05 WRK-DISP-DATE PIC 9(08). DTSCS82 +00175 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS82 +00176 10 WRK-DISP-CC PIC X(02). DTSCS82 +00177 10 WRK-DISP-YY PIC X(02). DTSCS82 +00178 10 WRK-DISP-MM PIC X(02). DTSCS82 +00179 10 WRK-DISP-DD PIC X(02). DTSCS82 +00180 SKIP1 DTSCS82 +00181 05 WRK-NO-ENTRY PIC S9(09) COMP-3 DTSCS82 +00182 VALUE +999999999. DTSCS82 +00183 05 WRK-UC30-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCS82 +00184 05 WRK-UC30-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCS82 +00185 05 WRK-UC30-FINAL-DEL-DATE PIC S9(09) COMP-3. DTSCS82 +00186 05 WRK-UC30-ESTIMATED-DATE PIC S9(09) COMP-3. DTSCS82 +00187 05 WRK-DELQ-LTR-SENT-DATE PIC S9(09) COMP-3. DTSCS82 +00188 05 WRK-SELF-INS-CHG-RUN-DATE PIC S9(09) COMP-3. DTSCS82 +00189 05 WRK-YRQ-START-DATE PIC S9(09) COMP-3. DTSCS82 +00190 05 WRK-YRQ-END-DATE PIC S9(09) COMP-3. DTSCS82 +00191 05 WRK-YRQ-PLUS1-START-DATE PIC S9(09) COMP-3. DTSCS82 +00192 05 WRK-YRQ-PLUS1-END-DATE PIC S9(09) COMP-3. DTSCS82 +00193 05 WRK-DEFAULT-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCS82 +00194 05 WRK-LAST-MTH-SOA-RUN-DATE PIC S9(09) COMP-3. CL**2 +00195 EJECT DTSCS82 +00196 01 SCREEN-PROCESSING. DTSCS82 +00197 05 SCR-ACCESS-IND PIC X(01). DTSCS82 +00198 88 SCR-ACCESS-INQ VALUE '1'. DTSCS82 +00199 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS82 +00200 SKIP1 DTSCS82 +00201 05 CURSOR-SET-IND PIC X(01). DTSCS82 +00202 88 CURSOR-SET-YES VALUE 'Y'. DTSCS82 +00203 88 CURSOR-SET-NO VALUE 'N'. DTSCS82 +00204 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS82 +00205 SKIP1 DTSCS82 +00206 05 REQ-IND PIC X(01). DTSCS82 +00207 88 REQ-ERROR VALUE 'O'. DTSCS82 +00208 88 REQ-JUMP VALUE 'J'. DTSCS82 +00209 88 REQ-INQUIRE VALUE 'I'. DTSCS82 +00210 88 REQ-CLEAR VALUE 'C'. DTSCS82 +00211 88 REQ-EDIT VALUE 'E'. DTSCS82 +00212 88 REQ-UPDATE VALUE 'U'. DTSCS82 +00213 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS82 +00214 SKIP1 DTSCS82 +00215 05 RESP-IND PIC X(01). DTSCS82 +00216 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS82 +00217 88 RESP-SEND-MAP VALUE 'M'. DTSCS82 +00218 88 RESP-JUMP VALUE 'J'. DTSCS82 +00219 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS82 00220 SKIP1 DTSCS82 -00221 05 WRK-MSG-ID PIC X(04). DTSCS82 +00221 05 WRK-NEW-KEY-IND PIC X(01). DTSCS82 00222 SKIP1 DTSCS82 -00223 05 WRK-ATB-AN PIC X(01). DTSCS82 -00224 05 WRK-ATB-NUM PIC X(01). DTSCS82 -00225 EJECT DTSCS82 -00226 01 L001-COMM-AREA. DTSCS82 -00227 ++INCLUDE DTSIL001 DTSCS82 -00228 EJECT DTSCS82 -00229 01 L004-COMM-AREA. DTSCS82 -00230 ++INCLUDE DTSIL004 DTSCS82 -00231 EJECT DTSCS82 -00232 01 L015-COMM-AREA. DTSCS82 -00233 ++INCLUDE DTSIL015 DTSCS82 -00234 EJECT DTSCS82 -00235 01 L016-COMM-AREA. DTSCS82 -00236 ++INCLUDE DTSIL016 DTSCS82 -00237 EJECT DTSCS82 -00238 * ERROR MSG MODULE DTSCS82 -00239 01 L805-COMM-AREA. DTSCS82 -00240 ++INCLUDE DTSIL805 DTSCS82 -00241 EJECT DTSCS82 -00242 * REFERENCE FILE I-O LINKAGE DTSCS82 -00243 01 L831-COMM-AREA. DTSCS82 -00244 05 L831-CONTROL-BLOCK. DTSCS82 -00245 ++INCLUDE DTSIL831 DTSCS82 -00246 EJECT DTSCS82 -00247 * COMMON SKELETAL RECORD DTSCS82 -00248 05 FCOMM-REC. DTSCS82 -00249 ++INCLUDE DTSIFSKL DTSCS82 -00250 EJECT DTSCS82 -00251 * CALENDAR YEAR RECORD LAYOUT DTSCS82 -00252 05 FQTR-REC REDEFINES FCOMM-REC. DTSCS82 -00253 ++INCLUDE DTSIFQTR DTSCS82 -00254 EJECT DTSCS82 -00255 * MAP DEFINITION DTSCS82 -00256 01 L851-COMM-AREA. DTSCS82 -00257 ++INCLUDE DTSIL851 DTSCS82 -00258 SKIP3 DTSCS82 -00259 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS82 -00260 ++INCLUDE DTSIS82 DTSCS82 -00261 EJECT DTSCS82 -00262 * ATTRIBUTE LITERALS DTSCS82 -00263 01 CATB-LITERALS. DTSCS82 -00264 ++INCLUDE DTSICATB DTSCS82 -00265 SKIP3 DTSCS82 -00266 * FUNCTION KEY DESCRIPTION LITERALS DTSCS82 -00267 01 CFKD-LITERALS. DTSCS82 -00268 ++INCLUDE DTSICFKD DTSCS82 -00269 SKIP3 DTSCS82 -00270 * ERROR CODE MESSAGE LITERALS DTSCS82 -00271 01 CECD-LITERALS. DTSCS82 -00272 ++INCLUDE DTSICECD DTSCS82 -00273 SKIP3 DTSCS82 -00274 * PROMPT CODE MESSAGE LITERALS DTSCS82 -00275 01 CPCD-LITERALS. DTSCS82 -00276 ++INCLUDE DTSICPCD DTSCS82 -00277 EJECT DTSCS82 -00278 LINKAGE SECTION. DTSCS82 -00279 SKIP3 DTSCS82 -00280 01 DFHCOMMAREA. DTSCS82 -00281 ++INCLUDE DTSILCCM DTSCS82 -00282 SKIP3 DTSCS82 -00283 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS82 -00284 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS82 -00285 EJECT DTSCS82 -00286 ******************************************************************DTSCS82 -00287 * *DTSCS82 +00223 05 WRK-MSG-ID PIC X(04). DTSCS82 +00224 SKIP1 DTSCS82 +00225 05 WRK-ATB-AN PIC X(01). DTSCS82 +00226 05 WRK-ATB-NUM PIC X(01). DTSCS82 +00227 EJECT DTSCS82 +00228 01 L001-COMM-AREA. DTSCS82 +00229 ++INCLUDE DTSIL001 DTSCS82 +00230 EJECT DTSCS82 +00231 01 L004-COMM-AREA. DTSCS82 +00232 ++INCLUDE DTSIL004 DTSCS82 +00233 EJECT DTSCS82 +00234 01 L015-COMM-AREA. DTSCS82 +00235 ++INCLUDE DTSIL015 DTSCS82 +00236 EJECT DTSCS82 +00237 01 L016-COMM-AREA. DTSCS82 +00238 ++INCLUDE DTSIL016 DTSCS82 +00239 EJECT DTSCS82 +00240 * ERROR MSG MODULE DTSCS82 +00241 01 L805-COMM-AREA. DTSCS82 +00242 ++INCLUDE DTSIL805 DTSCS82 +00243 EJECT DTSCS82 +00244 * REFERENCE FILE I-O LINKAGE DTSCS82 +00245 01 L831-COMM-AREA. DTSCS82 +00246 05 L831-CONTROL-BLOCK. DTSCS82 +00247 ++INCLUDE DTSIL831 DTSCS82 +00248 EJECT DTSCS82 +00249 * COMMON SKELETAL RECORD DTSCS82 +00250 05 FCOMM-REC. DTSCS82 +00251 ++INCLUDE DTSIFSKL DTSCS82 +00252 EJECT DTSCS82 +00253 * CALENDAR YEAR RECORD LAYOUT DTSCS82 +00254 05 FQTR-REC REDEFINES FCOMM-REC. DTSCS82 +00255 ++INCLUDE DTSIFQTR DTSCS82 +00256 EJECT DTSCS82 +00257 * MAP DEFINITION DTSCS82 +00258 01 L851-COMM-AREA. DTSCS82 +00259 ++INCLUDE DTSIL851 DTSCS82 +00260 SKIP3 DTSCS82 +00261 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS82 +00262 ++INCLUDE DTSIS82 DTSCS82 +00263 EJECT DTSCS82 +00264 * ATTRIBUTE LITERALS DTSCS82 +00265 01 CATB-LITERALS. DTSCS82 +00266 ++INCLUDE DTSICATB DTSCS82 +00267 SKIP3 DTSCS82 +00268 * FUNCTION KEY DESCRIPTION LITERALS DTSCS82 +00269 01 CFKD-LITERALS. DTSCS82 +00270 ++INCLUDE DTSICFKD DTSCS82 +00271 SKIP3 DTSCS82 +00272 * ERROR CODE MESSAGE LITERALS DTSCS82 +00273 01 CECD-LITERALS. DTSCS82 +00274 ++INCLUDE DTSICECD DTSCS82 +00275 SKIP3 DTSCS82 +00276 * PROMPT CODE MESSAGE LITERALS DTSCS82 +00277 01 CPCD-LITERALS. DTSCS82 +00278 ++INCLUDE DTSICPCD DTSCS82 +00279 EJECT DTSCS82 +00280 LINKAGE SECTION. DTSCS82 +00281 SKIP3 DTSCS82 +00282 01 DFHCOMMAREA. DTSCS82 +00283 ++INCLUDE DTSILCCM DTSCS82 +00284 SKIP3 DTSCS82 +00285 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS82 +00286 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS82 +00287 EJECT DTSCS82 00288 ******************************************************************DTSCS82 -00289 SKIP1 DTSCS82 -00290 PROCEDURE DIVISION. DTSCS82 -00291 SKIP2 DTSCS82 -00292 SET CURSOR-SET-NO TO TRUE. DTSCS82 -00293 SKIP1 DTSCS82 -00294 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 +00289 * *DTSCS82 +00290 ******************************************************************DTSCS82 +00291 SKIP1 DTSCS82 +00292 PROCEDURE DIVISION. DTSCS82 +00293 SKIP2 DTSCS82 +00294 SET CURSOR-SET-NO TO TRUE. DTSCS82 00295 SKIP1 DTSCS82 -00296 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS82 -00297 TO SCR-ACCESS-IND. DTSCS82 -00298 SKIP3 DTSCS82 -00299 MOVE SPACE TO REQ-IND. DTSCS82 -00300 SKIP1 DTSCS82 -00301 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS82 +00296 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 +00297 SKIP1 DTSCS82 +00298 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS82 +00299 TO SCR-ACCESS-IND. DTSCS82 +00300 SKIP3 DTSCS82 +00301 MOVE SPACE TO REQ-IND. DTSCS82 00302 SKIP1 DTSCS82 -00303 *----------------------------------------------------- DTSCS82 -00304 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS82 -00305 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS82 -00306 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS82 -00307 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS82 -00308 * DTSCS82 -00309 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS82 -00310 * PROCESSED. DTSCS82 -00311 * DTSCS82 -00312 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS82 -00313 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS82 -00314 * WORK STATION OPERATOR. DTSCS82 -00315 *----------------------------------------------------- DTSCS82 -00316 SKIP1 DTSCS82 -00317 MOVE SPACE TO RESP-IND. DTSCS82 +00303 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS82 +00304 SKIP1 DTSCS82 +00305 *----------------------------------------------------- DTSCS82 +00306 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS82 +00307 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS82 +00308 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS82 +00309 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS82 +00310 * DTSCS82 +00311 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS82 +00312 * PROCESSED. DTSCS82 +00313 * DTSCS82 +00314 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS82 +00315 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS82 +00316 * WORK STATION OPERATOR. DTSCS82 +00317 *----------------------------------------------------- DTSCS82 00318 SKIP1 DTSCS82 -00319 IF REQ-ERROR DTSCS82 -00320 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS82 -00321 ELSE DTSCS82 -00322 IF REQ-JUMP DTSCS82 -00323 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS82 -00324 ELSE DTSCS82 -00325 IF REQ-CLEAR DTSCS82 -00326 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS82 -00327 ELSE DTSCS82 -00328 IF REQ-CURSOR-TO-GOTO DTSCS82 -00329 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS82 -00330 ELSE DTSCS82 -00331 IF REQ-INQUIRE DTSCS82 -00332 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS82 -00333 ELSE DTSCS82 -00334 IF REQ-EDIT DTSCS82 -00335 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS82 -00336 ELSE DTSCS82 -00337 IF REQ-UPDATE DTSCS82 -00338 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS82 -00339 ELSE DTSCS82 -00340 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00341 SKIP3 DTSCS82 -00342 *----------------------------------------------------- DTSCS82 -00343 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS82 -00344 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS82 -00345 *----------------------------------------------------- DTSCS82 -00346 SKIP1 DTSCS82 -00347 IF RESP-SEND-MAP DTSCS82 -00348 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS82 -00349 SET LCCM-END-TASK-88 TO TRUE DTSCS82 -00350 ELSE DTSCS82 -00351 IF RESP-SEND-MSGONLY DTSCS82 -00352 OR RESP-CURSOR-TO-GOTO DTSCS82 -00353 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS82 -00354 SET LCCM-END-TASK-88 TO TRUE DTSCS82 -00355 ELSE DTSCS82 -00356 IF RESP-JUMP DTSCS82 -00357 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS82 -00358 ELSE DTSCS82 -00359 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00360 SKIP3 DTSCS82 -00361 MAINLINE-EXIT. DTSCS82 -00362 SKIP1 DTSCS82 -00363 EXEC CICS DTSCS82 -00364 RETURN DTSCS82 -00365 END-EXEC. DTSCS82 -00366 SKIP2 DTSCS82 -00367 GOBACK. DTSCS82 -00368 /*****************************************************************DTSCS82 -00369 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS82 -00370 ******************************************************************DTSCS82 -00371 P1000-ANALYZE-REQUEST. DTSCS82 -00372 SKIP1 DTSCS82 -00373 *----------------------------------------------------- DTSCS82 -00374 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS82 -00375 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS82 -00376 * REPLACED WITH ENTER) DTSCS82 -00377 *----------------------------------------------------- DTSCS82 -00378 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS82 -00379 SET LCCM-ENTER-88 TO TRUE DTSCS82 -00380 SET REQ-CLEAR TO TRUE DTSCS82 -00381 GO TO P1000-EXIT. DTSCS82 -00382 SKIP3 DTSCS82 -00383 *----------------------------------------------------- DTSCS82 -00384 * MAP IS RECEIVED DTSCS82 +00319 MOVE SPACE TO RESP-IND. DTSCS82 +00320 SKIP1 DTSCS82 +00321 IF REQ-ERROR DTSCS82 +00322 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS82 +00323 ELSE DTSCS82 +00324 IF REQ-JUMP DTSCS82 +00325 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS82 +00326 ELSE DTSCS82 +00327 IF REQ-CLEAR DTSCS82 +00328 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS82 +00329 ELSE DTSCS82 +00330 IF REQ-CURSOR-TO-GOTO DTSCS82 +00331 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS82 +00332 ELSE DTSCS82 +00333 IF REQ-INQUIRE DTSCS82 +00334 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS82 +00335 ELSE DTSCS82 +00336 IF REQ-EDIT DTSCS82 +00337 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS82 +00338 ELSE DTSCS82 +00339 IF REQ-UPDATE DTSCS82 +00340 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS82 +00341 ELSE DTSCS82 +00342 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00343 SKIP3 DTSCS82 +00344 *----------------------------------------------------- DTSCS82 +00345 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS82 +00346 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS82 +00347 *----------------------------------------------------- DTSCS82 +00348 SKIP1 DTSCS82 +00349 IF RESP-SEND-MAP DTSCS82 +00350 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS82 +00351 SET LCCM-END-TASK-88 TO TRUE DTSCS82 +00352 ELSE DTSCS82 +00353 IF RESP-SEND-MSGONLY DTSCS82 +00354 OR RESP-CURSOR-TO-GOTO DTSCS82 +00355 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS82 +00356 SET LCCM-END-TASK-88 TO TRUE DTSCS82 +00357 ELSE DTSCS82 +00358 IF RESP-JUMP DTSCS82 +00359 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS82 +00360 ELSE DTSCS82 +00361 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00362 SKIP3 DTSCS82 +00363 MAINLINE-EXIT. DTSCS82 +00364 SKIP1 DTSCS82 +00365 EXEC CICS DTSCS82 +00366 RETURN DTSCS82 +00367 END-EXEC. DTSCS82 +00368 SKIP2 DTSCS82 +00369 GOBACK. DTSCS82 +00370 /*****************************************************************DTSCS82 +00371 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS82 +00372 ******************************************************************DTSCS82 +00373 P1000-ANALYZE-REQUEST. DTSCS82 +00374 SKIP1 DTSCS82 +00375 *----------------------------------------------------- DTSCS82 +00376 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS82 +00377 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS82 +00378 * REPLACED WITH ENTER) DTSCS82 +00379 *----------------------------------------------------- DTSCS82 +00380 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS82 +00381 SET LCCM-ENTER-88 TO TRUE DTSCS82 +00382 SET REQ-CLEAR TO TRUE DTSCS82 +00383 GO TO P1000-EXIT. DTSCS82 +00384 SKIP3 DTSCS82 00385 *----------------------------------------------------- DTSCS82 -00386 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS82 -00387 SKIP3 DTSCS82 -00388 *----------------------------------------------------- DTSCS82 -00389 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS82 -00390 * WORK STATION DTSCS82 -00391 *----------------------------------------------------- DTSCS82 -00392 IF LCCM-CLEAR-88 DTSCS82 -00393 SET REQ-CLEAR TO TRUE DTSCS82 -00394 GO TO P1000-EXIT. DTSCS82 -00395 SKIP3 DTSCS82 -00396 *----------------------------------------------------- DTSCS82 -00397 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS82 +00386 * MAP IS RECEIVED DTSCS82 +00387 *----------------------------------------------------- DTSCS82 +00388 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS82 +00389 SKIP3 DTSCS82 +00390 *----------------------------------------------------- DTSCS82 +00391 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS82 +00392 * WORK STATION DTSCS82 +00393 *----------------------------------------------------- DTSCS82 +00394 IF LCCM-CLEAR-88 DTSCS82 +00395 SET REQ-CLEAR TO TRUE DTSCS82 +00396 GO TO P1000-EXIT. DTSCS82 +00397 SKIP3 DTSCS82 00398 *----------------------------------------------------- DTSCS82 -00399 IF LCCM-SCR-UPDATE-LOCKED DTSCS82 -00400 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS82 -00401 GO TO P1000-EXIT. DTSCS82 -00402 SKIP3 DTSCS82 -00403 *----------------------------------------------------- DTSCS82 -00404 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS82 +00399 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS82 +00400 *----------------------------------------------------- DTSCS82 +00401 IF LCCM-SCR-UPDATE-LOCKED DTSCS82 +00402 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS82 +00403 GO TO P1000-EXIT. DTSCS82 +00404 SKIP3 DTSCS82 00405 *----------------------------------------------------- DTSCS82 -00406 IF LCCM-PA2-88 DTSCS82 -00407 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS82 -00408 GO TO P1000-EXIT. DTSCS82 -00409 SKIP3 DTSCS82 -00410 *----------------------------------------------------- DTSCS82 -00411 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS82 +00406 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS82 +00407 *----------------------------------------------------- DTSCS82 +00408 IF LCCM-PA2-88 DTSCS82 +00409 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS82 +00410 GO TO P1000-EXIT. DTSCS82 +00411 SKIP3 DTSCS82 00412 *----------------------------------------------------- DTSCS82 -00413 IF LCCM-PA-88 DTSCS82 -00414 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS82 -00415 SET REQ-ERROR TO TRUE DTSCS82 -00416 GO TO P1000-EXIT. DTSCS82 -00417 SKIP3 DTSCS82 -00418 *----------------------------------------------------- DTSCS82 -00419 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS82 -00420 * REQUEST TO CLEAR THE SCREEN. DTSCS82 -00421 *----------------------------------------------------- DTSCS82 -00422 IF LCCM-F12-88 DTSCS82 -00423 MOVE LOW-VALUES TO MAP-AREA DTSCS82 -00424 SET REQ-CLEAR TO TRUE DTSCS82 -00425 GO TO P1000-EXIT. DTSCS82 -00426 SKIP3 DTSCS82 -00427 *----------------------------------------------------- DTSCS82 -00428 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS82 +00413 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS82 +00414 *----------------------------------------------------- DTSCS82 +00415 IF LCCM-PA-88 DTSCS82 +00416 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS82 +00417 SET REQ-ERROR TO TRUE DTSCS82 +00418 GO TO P1000-EXIT. DTSCS82 +00419 SKIP3 DTSCS82 +00420 *----------------------------------------------------- DTSCS82 +00421 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS82 +00422 * REQUEST TO CLEAR THE SCREEN. DTSCS82 +00423 *----------------------------------------------------- DTSCS82 +00424 IF LCCM-F12-88 DTSCS82 +00425 MOVE LOW-VALUES TO MAP-AREA DTSCS82 +00426 SET REQ-CLEAR TO TRUE DTSCS82 +00427 GO TO P1000-EXIT. DTSCS82 +00428 SKIP3 DTSCS82 00429 *----------------------------------------------------- DTSCS82 -00430 IF LCCM-F03-88 DTSCS82 -00431 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS82 -00432 SET REQ-JUMP TO TRUE DTSCS82 -00433 GO TO P1000-EXIT. DTSCS82 -00434 SKIP3 DTSCS82 -00435 *----------------------------------------------------- DTSCS82 -00436 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS82 +00430 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS82 +00431 *----------------------------------------------------- DTSCS82 +00432 IF LCCM-F03-88 DTSCS82 +00433 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS82 +00434 SET REQ-JUMP TO TRUE DTSCS82 +00435 GO TO P1000-EXIT. DTSCS82 +00436 SKIP3 DTSCS82 00437 *----------------------------------------------------- DTSCS82 -00438 IF LCCM-F04-88 DTSCS82 -00439 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS82 -00440 SET REQ-JUMP TO TRUE DTSCS82 -00441 GO TO P1000-EXIT. DTSCS82 -00442 SKIP3 DTSCS82 -00443 *----------------------------------------------------- DTSCS82 -00444 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS82 -00445 * CORRESPONDENCE SCREEN DTSCS82 -00446 *----------------------------------------------------- DTSCS82 -00447 IF LCCM-F14-88 DTSCS82 -00448 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS82 -00449 SET REQ-JUMP TO TRUE DTSCS82 -00450 GO TO P1000-EXIT. DTSCS82 -00451 SKIP3 DTSCS82 -00452 *----------------------------------------------------- DTSCS82 -00453 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS82 -00454 * REQUESTED SCREEN TYPE DTSCS82 -00455 *----------------------------------------------------- DTSCS82 -00456 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS82 -00457 NEXT SENTENCE DTSCS82 -00458 ELSE DTSCS82 -00459 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS82 -00460 SET REQ-JUMP TO TRUE DTSCS82 -00461 GO TO P1000-EXIT. DTSCS82 -00462 SKIP3 DTSCS82 -00463 *----------------------------------------------------- DTSCS82 -00464 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS82 -00465 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS82 -00466 *----------------------------------------------------- DTSCS82 -00467 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS82 -00468 IF SCR-ACCESS-UPDATE DTSCS82 -00469 SET REQ-EDIT TO TRUE DTSCS82 -00470 GO TO P1000-EXIT DTSCS82 -00471 ELSE DTSCS82 -00472 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS82 -00473 SET REQ-ERROR TO TRUE DTSCS82 -00474 GO TO P1000-EXIT. DTSCS82 -00475 SKIP3 DTSCS82 -00476 *----------------------------------------------------- DTSCS82 -00477 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS82 -00478 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS82 -00479 *----------------------------------------------------- DTSCS82 -00480 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS82 -00481 SET REQ-INQUIRE TO TRUE DTSCS82 -00482 GO TO P1000-EXIT. DTSCS82 -00483 SKIP3 DTSCS82 -00484 *----------------------------------------------------- DTSCS82 -00485 * ANY OTHER KEY IS INVALID DTSCS82 +00438 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS82 +00439 *----------------------------------------------------- DTSCS82 +00440 IF LCCM-F04-88 DTSCS82 +00441 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS82 +00442 SET REQ-JUMP TO TRUE DTSCS82 +00443 GO TO P1000-EXIT. DTSCS82 +00444 SKIP3 DTSCS82 +00445 *----------------------------------------------------- DTSCS82 +00446 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS82 +00447 * CORRESPONDENCE SCREEN DTSCS82 +00448 *----------------------------------------------------- DTSCS82 +00449 IF LCCM-F14-88 DTSCS82 +00450 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS82 +00451 SET REQ-JUMP TO TRUE DTSCS82 +00452 GO TO P1000-EXIT. DTSCS82 +00453 SKIP3 DTSCS82 +00454 *----------------------------------------------------- DTSCS82 +00455 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS82 +00456 * REQUESTED SCREEN TYPE DTSCS82 +00457 *----------------------------------------------------- DTSCS82 +00458 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS82 +00459 NEXT SENTENCE DTSCS82 +00460 ELSE DTSCS82 +00461 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS82 +00462 SET REQ-JUMP TO TRUE DTSCS82 +00463 GO TO P1000-EXIT. DTSCS82 +00464 SKIP3 DTSCS82 +00465 *----------------------------------------------------- DTSCS82 +00466 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS82 +00467 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS82 +00468 *----------------------------------------------------- DTSCS82 +00469 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS82 +00470 IF SCR-ACCESS-UPDATE DTSCS82 +00471 SET REQ-EDIT TO TRUE DTSCS82 +00472 GO TO P1000-EXIT DTSCS82 +00473 ELSE DTSCS82 +00474 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS82 +00475 SET REQ-ERROR TO TRUE DTSCS82 +00476 GO TO P1000-EXIT. DTSCS82 +00477 SKIP3 DTSCS82 +00478 *----------------------------------------------------- DTSCS82 +00479 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS82 +00480 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS82 +00481 *----------------------------------------------------- DTSCS82 +00482 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS82 +00483 SET REQ-INQUIRE TO TRUE DTSCS82 +00484 GO TO P1000-EXIT. DTSCS82 +00485 SKIP3 DTSCS82 00486 *----------------------------------------------------- DTSCS82 -00487 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS82 -00488 SET REQ-ERROR TO TRUE. DTSCS82 -00489 P1000-EXIT. DTSCS82 -00490 EXIT. DTSCS82 -00491 SKIP3 DTSCS82 -00492 ******************************************************************DTSCS82 -00493 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS82 +00487 * ANY OTHER KEY IS INVALID DTSCS82 +00488 *----------------------------------------------------- DTSCS82 +00489 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS82 +00490 SET REQ-ERROR TO TRUE. DTSCS82 +00491 P1000-EXIT. DTSCS82 +00492 EXIT. DTSCS82 +00493 SKIP3 DTSCS82 00494 ******************************************************************DTSCS82 -00495 SKIP1 DTSCS82 -00496 P1100-UPDATE-LOCKED. DTSCS82 -00497 *----------------------------------------------------- DTSCS82 -00498 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS82 -00499 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS82 -00500 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS82 -00501 *----------------------------------------------------- DTSCS82 -00502 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS82 -00503 SET REQ-UPDATE TO TRUE DTSCS82 -00504 ELSE DTSCS82 -00505 SET REQ-ERROR TO TRUE DTSCS82 -00506 IF LCCM-SCR-ADD-LOCKED DTSCS82 -00507 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS82 -00508 ELSE DTSCS82 -00509 IF LCCM-SCR-MOD-LOCKED DTSCS82 -00510 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS82 -00511 ELSE DTSCS82 -00512 IF LCCM-SCR-DEL-LOCKED DTSCS82 -00513 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS82 -00514 ELSE DTSCS82 -00515 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00516 P1100-EXIT. DTSCS82 -00517 EXIT. DTSCS82 -00518 /*****************************************************************DTSCS82 -00519 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS82 -00520 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS82 -00521 ******************************************************************DTSCS82 -00522 SKIP1 DTSCS82 -00523 P2000-REQUEST-ERROR. DTSCS82 -00524 IF LCCM-MSG DTSCS82 -00525 SET RESP-SEND-MSGONLY TO TRUE DTSCS82 -00526 ELSE DTSCS82 -00527 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00528 P2000-EXIT. DTSCS82 -00529 EXIT. DTSCS82 -00530 /*****************************************************************DTSCS82 -00531 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS82 -00532 ******************************************************************DTSCS82 -00533 SKIP1 DTSCS82 -00534 P3000-REQUEST-JUMP. DTSCS82 -00535 *----------------------------------------------------- DTSCS82 -00536 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS82 -00537 * BY USER DTSCS82 -00538 *----------------------------------------------------- DTSCS82 -00539 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS82 -00540 SKIP3 DTSCS82 -00541 *----------------------------------------------------- DTSCS82 -00542 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS82 +00495 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS82 +00496 ******************************************************************DTSCS82 +00497 SKIP1 DTSCS82 +00498 P1100-UPDATE-LOCKED. DTSCS82 +00499 *----------------------------------------------------- DTSCS82 +00500 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS82 +00501 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS82 +00502 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS82 +00503 *----------------------------------------------------- DTSCS82 +00504 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS82 +00505 SET REQ-UPDATE TO TRUE DTSCS82 +00506 ELSE DTSCS82 +00507 SET REQ-ERROR TO TRUE DTSCS82 +00508 IF LCCM-SCR-ADD-LOCKED DTSCS82 +00509 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS82 +00510 ELSE DTSCS82 +00511 IF LCCM-SCR-MOD-LOCKED DTSCS82 +00512 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS82 +00513 ELSE DTSCS82 +00514 IF LCCM-SCR-DEL-LOCKED DTSCS82 +00515 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS82 +00516 ELSE DTSCS82 +00517 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00518 P1100-EXIT. DTSCS82 +00519 EXIT. DTSCS82 +00520 /*****************************************************************DTSCS82 +00521 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS82 +00522 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS82 +00523 ******************************************************************DTSCS82 +00524 SKIP1 DTSCS82 +00525 P2000-REQUEST-ERROR. DTSCS82 +00526 IF LCCM-MSG DTSCS82 +00527 SET RESP-SEND-MSGONLY TO TRUE DTSCS82 +00528 ELSE DTSCS82 +00529 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00530 P2000-EXIT. DTSCS82 +00531 EXIT. DTSCS82 +00532 /*****************************************************************DTSCS82 +00533 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS82 +00534 ******************************************************************DTSCS82 +00535 SKIP1 DTSCS82 +00536 P3000-REQUEST-JUMP. DTSCS82 +00537 *----------------------------------------------------- DTSCS82 +00538 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS82 +00539 * BY USER DTSCS82 +00540 *----------------------------------------------------- DTSCS82 +00541 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS82 +00542 SKIP3 DTSCS82 00543 *----------------------------------------------------- DTSCS82 -00544 IF LCCM-MSG DTSCS82 -00545 SET RESP-SEND-MSGONLY TO TRUE DTSCS82 -00546 SET CURSOR-SET-GOTO TO TRUE DTSCS82 -00547 GO TO P3000-EXIT. DTSCS82 -00548 SKIP3 DTSCS82 -00549 *----------------------------------------------------- DTSCS82 -00550 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS82 +00544 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS82 +00545 *----------------------------------------------------- DTSCS82 +00546 IF LCCM-MSG DTSCS82 +00547 SET RESP-SEND-MSGONLY TO TRUE DTSCS82 +00548 SET CURSOR-SET-GOTO TO TRUE DTSCS82 +00549 GO TO P3000-EXIT. DTSCS82 +00550 SKIP3 DTSCS82 00551 *----------------------------------------------------- DTSCS82 -00552 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS82 -00553 LCCM-SCR-HOLD-AREA. DTSCS82 -00554 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS82 -00555 SET RESP-JUMP TO TRUE. DTSCS82 -00556 P3000-EXIT. DTSCS82 -00557 EXIT. DTSCS82 -00558 /*****************************************************************DTSCS82 -00559 * CLEAR KEY WAS PRESSED *DTSCS82 -00560 ******************************************************************DTSCS82 -00561 SKIP1 DTSCS82 -00562 P4000-REQUEST-CLEAR. DTSCS82 -00563 IF SCR-ACCESS-UPDATE DTSCS82 -00564 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS82 -00565 ELSE DTSCS82 -00566 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS82 -00567 SKIP3 DTSCS82 -00568 *----------------------------------------------------- DTSCS82 -00569 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS82 -00570 * FIELDS FROM EARLIER REQUESTS DTSCS82 -00571 *----------------------------------------------------- DTSCS82 -00572 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS82 -00573 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS82 -00574 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 -00575 SET RESP-SEND-MAP TO TRUE. DTSCS82 -00576 P4000-EXIT. DTSCS82 -00577 EXIT. DTSCS82 -00578 /*****************************************************************DTSCS82 -00579 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS82 -00580 ******************************************************************DTSCS82 -00581 SKIP1 DTSCS82 -00582 P5000-CURSOR-TO-GOTO. DTSCS82 -00583 SET CURSOR-SET-GOTO TO TRUE. DTSCS82 -00584 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS82 -00585 P5000-EXIT. DTSCS82 -00586 EXIT. DTSCS82 -00587 /*****************************************************************DTSCS82 -00588 * INQUIRY WAS REQUESTED *DTSCS82 -00589 ******************************************************************DTSCS82 -00590 SKIP1 DTSCS82 -00591 P6000-REQUEST-INQUIRE. DTSCS82 -00592 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSCS82 -00593 SET FQTR-QTR-88 TO TRUE. DTSCS82 -00594 SKIP1 DTSCS82 -00595 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 -00596 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 -00597 MOVE L016-S-YRQ-AREA TO MAP-YRQ-AREA. DTSCS82 -00598 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 -00599 IF L016-NO-ENTRY DTSCS82 -00600 MOVE +0 TO FQTR-YRQ DTSCS82 -00601 ELSE DTSCS82 -00602 IF L016-VALID DTSCS82 -00603 MOVE L016-YRQ TO FQTR-YRQ DTSCS82 -00604 ELSE DTSCS82 -00605 MOVE +0 TO FQTR-YRQ DTSCS82 -00606 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -00607 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 -00608 IF LCCM-SCR-INQUIRE DTSCS82 -00609 AND FQTR-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS82 -00610 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS82 -00611 ELSE DTSCS82 -00612 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS82 -00613 SKIP1 DTSCS82 -00614 IF SCR-ACCESS-UPDATE DTSCS82 -00615 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS82 -00616 ELSE DTSCS82 -00617 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS82 -00618 SKIP1 DTSCS82 -00619 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 -00620 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS82 -00621 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS82 -00622 SKIP1 DTSCS82 -00623 IF LCCM-MSG DTSCS82 -00624 NEXT SENTENCE DTSCS82 -00625 ELSE DTSCS82 -00626 IF LCCM-ENTER-88 DTSCS82 -00627 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS82 -00628 ELSE DTSCS82 -00629 IF LCCM-F07-88 DTSCS82 -00630 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS82 -00631 ELSE DTSCS82 -00632 IF LCCM-F08-88 DTSCS82 -00633 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS82 -00634 ELSE DTSCS82 -00635 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00636 SKIP1 DTSCS82 -00637 SET RESP-SEND-MAP TO TRUE. DTSCS82 -00638 P6000-EXIT. DTSCS82 -00639 EXIT. DTSCS82 -00640 EJECT DTSCS82 -00641 P6100-NO-PAGE. DTSCS82 -00642 IF L016-NO-ENTRY DTSCS82 -00643 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS82 -00644 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00645 GO TO P6100-EXIT. DTSCS82 -00646 SKIP1 DTSCS82 -00647 PERFORM S831-READ THRU S831-EXIT. DTSCS82 -00648 IF L831-NO-REC-88 DTSCS82 -00649 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -00650 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00651 GO TO P6100-EXIT. DTSCS82 -00652 SKIP1 DTSCS82 -00653 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS82 -00654 P6100-EXIT. DTSCS82 -00655 EXIT. DTSCS82 -00656 EJECT DTSCS82 -00657 P6200-PAGE-BACK. DTSCS82 -00658 MOVE FQTR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 -00659 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS82 -00660 IF L831-NO-REC-88 DTSCS82 -00661 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -00662 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00663 GO TO P6200-EXIT. DTSCS82 -00664 SKIP1 DTSCS82 -00665 IF (WRK-NEW-KEY-IND = 'Y') DTSCS82 -00666 AND DTSCS82 -00667 (WRK-KEY-AREA = FQTR-KEY-AREA) DTSCS82 -00668 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 -00669 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 -00670 GO TO P6200-EXIT. DTSCS82 -00671 SKIP1 DTSCS82 -00672 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS82 -00673 IF L831-NO-REC-88 DTSCS82 -00674 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -00675 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00676 GO TO P6200-EXIT. DTSCS82 -00677 SKIP1 DTSCS82 -00678 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS82 -00679 IF L831-NO-REC-88 DTSCS82 -00680 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 -00681 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS82 -00682 ELSE DTSCS82 -00683 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 -00684 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS82 -00685 P6200-EXIT. DTSCS82 -00686 EXIT. DTSCS82 -00687 EJECT DTSCS82 -00688 P6300-PAGE-NEXT. DTSCS82 -00689 MOVE FQTR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 -00690 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS82 -00691 IF L831-NO-REC-88 DTSCS82 -00692 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -00693 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00694 GO TO P6300-EXIT. DTSCS82 -00695 SKIP1 DTSCS82 -00696 IF (WRK-NEW-KEY-IND = 'N') DTSCS82 -00697 AND DTSCS82 -00698 (WRK-KEY-AREA = FQTR-KEY-AREA) DTSCS82 -00699 NEXT SENTENCE DTSCS82 -00700 ELSE DTSCS82 -00701 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 -00702 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 -00703 GO TO P6300-EXIT. DTSCS82 -00704 SKIP1 DTSCS82 -00705 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS82 -00706 IF L831-NO-REC-88 DTSCS82 -00707 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 -00708 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS82 -00709 ELSE DTSCS82 -00710 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 -00711 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS82 -00712 P6300-EXIT. DTSCS82 -00713 EXIT. DTSCS82 -00714 /*****************************************************************DTSCS82 -00715 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS82 -00716 ******************************************************************DTSCS82 -00717 SKIP1 DTSCS82 -00718 P6900-CONSTRUCT-SCREEN. DTSCS82 -00719 MOVE FQTR-YRQ TO L004-QTR-5-9. DTSCS82 -00720 SET L004-FROM-5 TO TRUE. DTSCS82 -00721 PERFORM S004-YRQ-CONVERT THROUGH S004-EXIT. DTSCS82 -00722 IF L004-VALID-QTR DTSCS82 -00723 MOVE L004-QTR-3-YR TO MAP-YR DTSCS82 -00724 MOVE L004-QTR-3-Q TO MAP-Q DTSCS82 -00725 ELSE DTSCS82 -00726 GO TO S899-ABEND. DTSCS82 -00727 SKIP1 DTSCS82 -00728 IF FQTR-UC30-MASS-MAIL-DATE NUMERIC DTSCS82 -00729 IF FQTR-UC30-MASS-MAIL-DATE NOT = +0 DTSCS82 -00730 MOVE FQTR-UC30-MASS-MAIL-DATE TO WRK-DISP-DATE DTSCS82 -00731 MOVE WRK-DISP-MM TO MAP-UC30-MASS-MAIL-MM DTSCS82 -00732 MOVE WRK-DISP-DD TO MAP-UC30-MASS-MAIL-DD DTSCS82 -00733 MOVE WRK-DISP-YY TO MAP-UC30-MASS-MAIL-YY. DTSCS82 -00734 SKIP1 DTSCS82 -00735 IF FQTR-LATE-PEN-ASSESSED-DATE NUMERIC DTSCS82 -00736 IF FQTR-LATE-PEN-ASSESSED-DATE NOT = +0 DTSCS82 -00737 MOVE FQTR-LATE-PEN-ASSESSED-DATE TO WRK-DISP-DATE DTSCS82 -00738 MOVE WRK-DISP-MM TO MAP-LATE-PEN-ASSESSED-MM DTSCS82 -00739 MOVE WRK-DISP-DD TO MAP-LATE-PEN-ASSESSED-DD DTSCS82 -00740 MOVE WRK-DISP-YY TO MAP-LATE-PEN-ASSESSED-YY. DTSCS82 -00741 SKIP1 DTSCS82 -00742 IF FQTR-UC30-FIRST-DEL-DATE NUMERIC DTSCS82 -00743 IF FQTR-UC30-FIRST-DEL-DATE NOT = +0 DTSCS82 -00744 MOVE FQTR-UC30-FIRST-DEL-DATE TO WRK-DISP-DATE DTSCS82 -00745 MOVE WRK-DISP-MM TO MAP-UC30-FIRST-DEL-MM DTSCS82 -00746 MOVE WRK-DISP-DD TO MAP-UC30-FIRST-DEL-DD DTSCS82 -00747 MOVE WRK-DISP-YY TO MAP-UC30-FIRST-DEL-YY. DTSCS82 -00748 SKIP1 DTSCS82 -00749 IF FQTR-UC30-FINAL-DEL-DATE NUMERIC DTSCS82 -00750 IF FQTR-UC30-FINAL-DEL-DATE NOT = +0 DTSCS82 -00751 MOVE FQTR-UC30-FINAL-DEL-DATE TO WRK-DISP-DATE DTSCS82 -00752 MOVE WRK-DISP-MM TO MAP-UC30-FINAL-DEL-MM DTSCS82 -00753 MOVE WRK-DISP-DD TO MAP-UC30-FINAL-DEL-DD DTSCS82 -00754 MOVE WRK-DISP-YY TO MAP-UC30-FINAL-DEL-YY. DTSCS82 -00755 SKIP1 DTSCS82 -00756 IF FQTR-UC30-FINAL-ACTION-DATE NUMERIC DTSCS82 -00757 IF FQTR-UC30-FINAL-ACTION-DATE NOT = +0 DTSCS82 -00758 MOVE FQTR-UC30-FINAL-ACTION-DATE TO WRK-DISP-DATE DTSCS82 -00759 MOVE WRK-DISP-MM TO MAP-UC30-FINAL-ACTION-MM DTSCS82 -00760 MOVE WRK-DISP-DD TO MAP-UC30-FINAL-ACTION-DD DTSCS82 -00761 MOVE WRK-DISP-YY TO MAP-UC30-FINAL-ACTION-YY.DTSCS82 -00762 SKIP1 DTSCS82 -00763 IF FQTR-DELQ-LTR-SENT-DATE NUMERIC DTSCS82 -00764 IF FQTR-DELQ-LTR-SENT-DATE NOT = +0 DTSCS82 -00765 MOVE FQTR-DELQ-LTR-SENT-DATE TO WRK-DISP-DATE DTSCS82 -00766 MOVE WRK-DISP-MM TO MAP-DELQ-LTR-SENT-MM DTSCS82 -00767 MOVE WRK-DISP-DD TO MAP-DELQ-LTR-SENT-DD DTSCS82 -00768 MOVE WRK-DISP-YY TO MAP-DELQ-LTR-SENT-YY. DTSCS82 -00769 SKIP1 DTSCS82 -00770 IF FQTR-ESTIMATED-DATE NUMERIC DTSCS82 -00771 IF FQTR-ESTIMATED-DATE NOT = +0 DTSCS82 -00772 MOVE FQTR-ESTIMATED-DATE TO WRK-DISP-DATE DTSCS82 -00773 MOVE WRK-DISP-MM TO MAP-UC30-ESTIMATED-MM DTSCS82 -00774 MOVE WRK-DISP-DD TO MAP-UC30-ESTIMATED-DD DTSCS82 -00775 MOVE WRK-DISP-YY TO MAP-UC30-ESTIMATED-YY. DTSCS82 -00776 SKIP1 DTSCS82 -00777 IF FQTR-SELF-INS-TAX-DUE-DATE NUMERIC DTSCS82 -00778 IF FQTR-SELF-INS-TAX-DUE-DATE NOT = +0 DTSCS82 -00779 MOVE FQTR-SELF-INS-TAX-DUE-DATE TO WRK-DISP-DATE DTSCS82 -00780 MOVE WRK-DISP-MM TO MAP-SELF-INS-TAX-DUE-MM DTSCS82 -00781 MOVE WRK-DISP-DD TO MAP-SELF-INS-TAX-DUE-DD DTSCS82 -00782 MOVE WRK-DISP-YY TO MAP-SELF-INS-TAX-DUE-YY. DTSCS82 -00783 SKIP1 DTSCS82 -00784 IF FQTR-SELF-INS-2ND-LETTER-DATE NUMERIC DTSCS82 -00785 IF FQTR-SELF-INS-2ND-LETTER-DATE NOT = +0 DTSCS82 -00786 MOVE FQTR-SELF-INS-2ND-LETTER-DATE TO WRK-DISP-DATE DTSCS82 -00787 MOVE WRK-DISP-MM TO MAP-SELF-INS-2ND-LTR-MM DTSCS82 -00788 MOVE WRK-DISP-DD TO MAP-SELF-INS-2ND-LTR-DD DTSCS82 -00789 MOVE WRK-DISP-YY TO MAP-SELF-INS-2ND-LTR-YY. DTSCS82 -00790 SKIP1 DTSCS82 -00791 IF FQTR-SELF-INS-CHG-RUN-DATE NUMERIC DTSCS82 -00792 IF FQTR-SELF-INS-CHG-RUN-DATE NOT = +0 DTSCS82 -00793 MOVE FQTR-SELF-INS-CHG-RUN-DATE TO WRK-DISP-DATE DTSCS82 -00794 MOVE WRK-DISP-MM TO MAP-SELF-INS-CHG-RUN-MM DTSCS82 -00795 MOVE WRK-DISP-DD TO MAP-SELF-INS-CHG-RUN-DD DTSCS82 -00796 MOVE WRK-DISP-YY TO MAP-SELF-INS-CHG-RUN-YY. DTSCS82 -00797 SKIP1 DTSCS82 -00798 IF FQTR-ESTB-DATE NOT = +0 DTSCS82 -00799 MOVE FQTR-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS82 -00800 SET L001-FROM-FED-8 TO TRUE DTSCS82 -00801 PERFORM S001-DATE THRU S001-EXIT DTSCS82 -00802 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS82 -00803 SKIP1 DTSCS82 -00804 IF FQTR-CHNG-DATE NOT = +0 DTSCS82 -00805 MOVE FQTR-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS82 -00806 SET L001-FROM-FED-8 TO TRUE DTSCS82 -00807 PERFORM S001-DATE THRU S001-EXIT DTSCS82 -00808 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS82 -00809 SKIP1 DTSCS82 -00810 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS82 -00811 MOVE FQTR-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS82 -00812 P6900-EXIT. DTSCS82 -00813 EXIT. DTSCS82 -00814 /*****************************************************************DTSCS82 -00815 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS82 -00816 ******************************************************************DTSCS82 -00817 SKIP1 DTSCS82 -00818 P7000-REQUEST-EDIT. DTSCS82 -00819 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 -00820 SKIP1 DTSCS82 -00821 IF LCCM-F09-88 DTSCS82 -00822 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS82 -00823 ELSE DTSCS82 -00824 IF LCCM-F10-88 DTSCS82 -00825 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS82 -00826 ELSE DTSCS82 -00827 IF LCCM-F23-88 DTSCS82 -00828 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS82 -00829 ELSE DTSCS82 -00830 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00831 SKIP3 DTSCS82 -00832 *------------------------------------------------------ DTSCS82 -00833 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS82 -00834 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS82 -00835 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS82 -00836 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS82 -00837 *------------------------------------------------------ DTSCS82 -00838 SKIP1 DTSCS82 -00839 IF LCCM-MSG DTSCS82 -00840 NEXT SENTENCE DTSCS82 -00841 ELSE DTSCS82 -00842 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS82 -00843 IF LCCM-F09-88 DTSCS82 -00844 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS82 -00845 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS82 -00846 ELSE DTSCS82 -00847 IF LCCM-F10-88 DTSCS82 -00848 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS82 -00849 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS82 -00850 ELSE DTSCS82 -00851 IF LCCM-F23-88 DTSCS82 -00852 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS82 -00853 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS82 -00854 SKIP1 DTSCS82 -00855 SET RESP-SEND-MAP TO TRUE. DTSCS82 -00856 P7000-EXIT. DTSCS82 -00857 EXIT. DTSCS82 -00858 /*****************************************************************DTSCS82 -00859 * ADD FUNCTION WAS REQUESTED *DTSCS82 -00860 ******************************************************************DTSCS82 -00861 SKIP1 DTSCS82 -00862 P7100-EDIT-ADD. DTSCS82 -00863 *------------------------------------------------------ DTSCS82 -00864 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS82 -00865 *------------------------------------------------------ DTSCS82 -00866 IF NOT LCCM-SCR-CLEAR DTSCS82 -00867 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS82 -00868 GO TO P7100-EXIT. DTSCS82 -00869 SKIP1 DTSCS82 -00870 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS82 -00871 SKIP1 DTSCS82 -00872 IF LCCM-NO-MSG DTSCS82 -00873 PERFORM S8010-READ-FQTR THRU S8010-EXIT DTSCS82 -00874 IF L831-OK-88 DTSCS82 -00875 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS82 -00876 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00877 ELSE DTSCS82 -00878 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS82 -00879 P7100-EXIT. DTSCS82 -00880 EXIT. DTSCS82 -00881 /*****************************************************************DTSCS82 -00882 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS82 -00883 ******************************************************************DTSCS82 -00884 SKIP1 DTSCS82 -00885 P7200-EDIT-MOD. DTSCS82 -00886 *----------------------------------------------------- DTSCS82 -00887 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS82 -00888 * INQUIRED DTSCS82 -00889 *----------------------------------------------------- DTSCS82 -00890 IF NOT LCCM-SCR-INQUIRE DTSCS82 -00891 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS82 -00892 GO TO P7200-EXIT. DTSCS82 -00893 SKIP3 DTSCS82 -00894 *----------------------------------------------------- DTSCS82 -00895 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS82 -00896 *----------------------------------------------------- DTSCS82 -00897 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 -00898 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 -00899 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 -00900 IF L016-NOT-VALID DTSCS82 -00901 OR L016-YRQ NOT = WRK-QTR DTSCS82 -00902 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS82 -00903 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00904 GO TO P7200-EXIT. DTSCS82 -00905 SKIP1 DTSCS82 -00906 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS82 -00907 SKIP1 DTSCS82 -00908 IF LCCM-NO-MSG DTSCS82 -00909 PERFORM S8010-READ-FQTR THRU S8010-EXIT DTSCS82 -00910 IF L831-NO-REC-88 DTSCS82 -00911 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -00912 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00913 ELSE DTSCS82 -00914 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS82 -00915 P7200-EXIT. DTSCS82 -00916 EXIT. DTSCS82 -00917 /*****************************************************************DTSCS82 -00918 * DELETE FUNCTION WAS REQUESTED *DTSCS82 -00919 ******************************************************************DTSCS82 -00920 SKIP1 DTSCS82 -00921 P7300-EDIT-DEL. DTSCS82 -00922 *----------------------------------------------------- DTSCS82 -00923 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS82 -00924 * INQUIRED DTSCS82 -00925 *----------------------------------------------------- DTSCS82 -00926 IF NOT LCCM-SCR-INQUIRE DTSCS82 -00927 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS82 -00928 GO TO P7300-EXIT. DTSCS82 -00929 SKIP3 DTSCS82 -00930 *----------------------------------------------------- DTSCS82 -00931 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS82 -00932 *----------------------------------------------------- DTSCS82 -00933 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 -00934 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 -00935 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 -00936 IF L016-NOT-VALID DTSCS82 -00937 OR L016-YRQ NOT = WRK-QTR DTSCS82 -00938 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS82 -00939 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 -00940 SKIP1 DTSCS82 -00941 IF LCCM-NO-MSG DTSCS82 -00942 PERFORM S8010-READ-FQTR THRU S8010-EXIT DTSCS82 -00943 IF L831-NO-REC-88 DTSCS82 -00944 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -00945 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 -00946 P7300-EXIT. DTSCS82 -00947 EXIT. DTSCS82 -00948 /*****************************************************************DTSCS82 -00949 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS82 -00950 ******************************************************************DTSCS82 -00951 SKIP1 DTSCS82 -00952 P8000-REQUEST-UPDATE. DTSCS82 -00953 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 -00954 SKIP1 DTSCS82 -00955 IF LCCM-SCR-ADD-LOCKED DTSCS82 -00956 PERFORM P8100-ADD THRU P8100-EXIT DTSCS82 -00957 ELSE DTSCS82 -00958 IF LCCM-SCR-MOD-LOCKED DTSCS82 -00959 PERFORM P8200-MOD THRU P8200-EXIT DTSCS82 -00960 ELSE DTSCS82 -00961 IF LCCM-SCR-DEL-LOCKED DTSCS82 -00962 PERFORM P8300-DEL THRU P8300-EXIT DTSCS82 -00963 ELSE DTSCS82 -00964 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 -00965 SKIP1 DTSCS82 -00966 SET RESP-SEND-MAP TO TRUE. DTSCS82 -00967 P8000-EXIT. DTSCS82 -00968 EXIT. DTSCS82 -00969 /*****************************************************************DTSCS82 -00970 * *DTSCS82 -00971 ******************************************************************DTSCS82 -00972 SKIP1 DTSCS82 -00973 P8100-ADD. DTSCS82 -00974 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 -00975 SKIP1 DTSCS82 -00976 IF LCCM-F12-88 DTSCS82 -00977 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS82 -00978 GO TO P8100-EXIT. DTSCS82 -00979 SKIP1 DTSCS82 -00980 PERFORM S8010-READ-FQTR THRU S8010-EXIT. DTSCS82 -00981 IF L831-OK-88 DTSCS82 -00982 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS82 -00983 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -00984 GO TO P8100-EXIT. DTSCS82 -00985 SKIP1 DTSCS82 -00986 MOVE LOW-VALUES TO FQTR-DATA-AREA. DTSCS82 -00987 SKIP1 DTSCS82 -00988 PERFORM P8900-CONSTRUCT-FQTR THRU P8900-EXIT. DTSCS82 -00989 SKIP1 DTSCS82 -00990 MOVE LCCM-CURR-RUN-DATE TO FQTR-ESTB-DATE. DTSCS82 -00991 MOVE LCCM-CURR-RUN-DATE TO FQTR-CHNG-DATE. DTSCS82 -00992 SKIP1 DTSCS82 -00993 PERFORM S831-WRITE THRU S831-EXIT. DTSCS82 +00552 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS82 +00553 *----------------------------------------------------- DTSCS82 +00554 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS82 +00555 LCCM-SCR-HOLD-AREA. DTSCS82 +00556 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS82 +00557 SET RESP-JUMP TO TRUE. DTSCS82 +00558 P3000-EXIT. DTSCS82 +00559 EXIT. DTSCS82 +00560 /*****************************************************************DTSCS82 +00561 * CLEAR KEY WAS PRESSED *DTSCS82 +00562 ******************************************************************DTSCS82 +00563 SKIP1 DTSCS82 +00564 P4000-REQUEST-CLEAR. DTSCS82 +00565 IF SCR-ACCESS-UPDATE DTSCS82 +00566 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS82 +00567 ELSE DTSCS82 +00568 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS82 +00569 SKIP3 DTSCS82 +00570 *----------------------------------------------------- DTSCS82 +00571 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS82 +00572 * FIELDS FROM EARLIER REQUESTS DTSCS82 +00573 *----------------------------------------------------- DTSCS82 +00574 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS82 +00575 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS82 +00576 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 +00577 SET RESP-SEND-MAP TO TRUE. DTSCS82 +00578 P4000-EXIT. DTSCS82 +00579 EXIT. DTSCS82 +00580 /*****************************************************************DTSCS82 +00581 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS82 +00582 ******************************************************************DTSCS82 +00583 SKIP1 DTSCS82 +00584 P5000-CURSOR-TO-GOTO. DTSCS82 +00585 SET CURSOR-SET-GOTO TO TRUE. DTSCS82 +00586 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS82 +00587 P5000-EXIT. DTSCS82 +00588 EXIT. DTSCS82 +00589 /*****************************************************************DTSCS82 +00590 * INQUIRY WAS REQUESTED *DTSCS82 +00591 ******************************************************************DTSCS82 +00592 SKIP1 DTSCS82 +00593 P6000-REQUEST-INQUIRE. DTSCS82 +00594 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSCS82 +00595 SET FQTR-QTR-88 TO TRUE. DTSCS82 +00596 SKIP1 DTSCS82 +00597 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 +00598 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 +00599 MOVE L016-S-YRQ-AREA TO MAP-YRQ-AREA. DTSCS82 +00600 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 +00601 IF L016-NO-ENTRY DTSCS82 +00602 MOVE +0 TO FQTR-YRQ DTSCS82 +00603 ELSE DTSCS82 +00604 IF L016-VALID DTSCS82 +00605 MOVE L016-YRQ TO FQTR-YRQ DTSCS82 +00606 ELSE DTSCS82 +00607 MOVE +0 TO FQTR-YRQ DTSCS82 +00608 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +00609 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 +00610 IF LCCM-SCR-INQUIRE DTSCS82 +00611 AND FQTR-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS82 +00612 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS82 +00613 ELSE DTSCS82 +00614 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS82 +00615 SKIP1 DTSCS82 +00616 IF SCR-ACCESS-UPDATE DTSCS82 +00617 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS82 +00618 ELSE DTSCS82 +00619 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS82 +00620 SKIP1 DTSCS82 +00621 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 +00622 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS82 +00623 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS82 +00624 SKIP1 DTSCS82 +00625 IF LCCM-MSG DTSCS82 +00626 NEXT SENTENCE DTSCS82 +00627 ELSE DTSCS82 +00628 IF LCCM-ENTER-88 DTSCS82 +00629 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS82 +00630 ELSE DTSCS82 +00631 IF LCCM-F07-88 DTSCS82 +00632 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS82 +00633 ELSE DTSCS82 +00634 IF LCCM-F08-88 DTSCS82 +00635 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS82 +00636 ELSE DTSCS82 +00637 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00638 SKIP1 DTSCS82 +00639 SET RESP-SEND-MAP TO TRUE. DTSCS82 +00640 P6000-EXIT. DTSCS82 +00641 EXIT. DTSCS82 +00642 EJECT DTSCS82 +00643 P6100-NO-PAGE. DTSCS82 +00644 IF L016-NO-ENTRY DTSCS82 +00645 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS82 +00646 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00647 GO TO P6100-EXIT. DTSCS82 +00648 SKIP1 DTSCS82 +00649 PERFORM S831-READ THRU S831-EXIT. DTSCS82 +00650 IF L831-NO-REC-88 DTSCS82 +00651 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +00652 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00653 GO TO P6100-EXIT. DTSCS82 +00654 SKIP1 DTSCS82 +00655 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS82 +00656 P6100-EXIT. DTSCS82 +00657 EXIT. DTSCS82 +00658 EJECT DTSCS82 +00659 P6200-PAGE-BACK. DTSCS82 +00660 MOVE FQTR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 +00661 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS82 +00662 IF L831-NO-REC-88 DTSCS82 +00663 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +00664 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00665 GO TO P6200-EXIT. DTSCS82 +00666 SKIP1 DTSCS82 +00667 IF (WRK-NEW-KEY-IND = 'Y') DTSCS82 +00668 AND DTSCS82 +00669 (WRK-KEY-AREA = FQTR-KEY-AREA) DTSCS82 +00670 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 +00671 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 +00672 GO TO P6200-EXIT. DTSCS82 +00673 SKIP1 DTSCS82 +00674 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS82 +00675 IF L831-NO-REC-88 DTSCS82 +00676 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +00677 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00678 GO TO P6200-EXIT. DTSCS82 +00679 SKIP1 DTSCS82 +00680 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS82 +00681 IF L831-NO-REC-88 DTSCS82 +00682 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 +00683 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS82 +00684 ELSE DTSCS82 +00685 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 +00686 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS82 +00687 P6200-EXIT. DTSCS82 +00688 EXIT. DTSCS82 +00689 EJECT DTSCS82 +00690 P6300-PAGE-NEXT. DTSCS82 +00691 MOVE FQTR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 +00692 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS82 +00693 IF L831-NO-REC-88 DTSCS82 +00694 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +00695 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00696 GO TO P6300-EXIT. DTSCS82 +00697 SKIP1 DTSCS82 +00698 IF (WRK-NEW-KEY-IND = 'N') DTSCS82 +00699 AND DTSCS82 +00700 (WRK-KEY-AREA = FQTR-KEY-AREA) DTSCS82 +00701 NEXT SENTENCE DTSCS82 +00702 ELSE DTSCS82 +00703 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 +00704 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 +00705 GO TO P6300-EXIT. DTSCS82 +00706 SKIP1 DTSCS82 +00707 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS82 +00708 IF L831-NO-REC-88 DTSCS82 +00709 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS82 +00710 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS82 +00711 ELSE DTSCS82 +00712 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS82 +00713 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS82 +00714 P6300-EXIT. DTSCS82 +00715 EXIT. DTSCS82 +00716 /*****************************************************************DTSCS82 +00717 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS82 +00718 ******************************************************************DTSCS82 +00719 SKIP1 DTSCS82 +00720 P6900-CONSTRUCT-SCREEN. DTSCS82 +00721 MOVE FQTR-YRQ TO L004-QTR-5-9. DTSCS82 +00722 SET L004-FROM-5 TO TRUE. DTSCS82 +00723 PERFORM S004-YRQ-CONVERT THROUGH S004-EXIT. DTSCS82 +00724 IF L004-VALID-QTR DTSCS82 +00725 MOVE L004-QTR-3-YR TO MAP-YR DTSCS82 +00726 MOVE L004-QTR-3-Q TO MAP-Q DTSCS82 +00727 ELSE DTSCS82 +00728 GO TO S899-ABEND. DTSCS82 +00729 SKIP1 DTSCS82 +00730 IF FQTR-UC30-MASS-MAIL-DATE NUMERIC DTSCS82 +00731 IF FQTR-UC30-MASS-MAIL-DATE NOT = +0 DTSCS82 +00732 MOVE FQTR-UC30-MASS-MAIL-DATE TO WRK-DISP-DATE DTSCS82 +00733 MOVE WRK-DISP-MM TO MAP-UC30-MASS-MAIL-MM DTSCS82 +00734 MOVE WRK-DISP-DD TO MAP-UC30-MASS-MAIL-DD DTSCS82 +00735 MOVE WRK-DISP-YY TO MAP-UC30-MASS-MAIL-YY. DTSCS82 +00736 SKIP1 DTSCS82 +00737 IF FQTR-LATE-PEN-ASSESSED-DATE NUMERIC DTSCS82 +00738 IF FQTR-LATE-PEN-ASSESSED-DATE NOT = +0 DTSCS82 +00739 MOVE FQTR-LATE-PEN-ASSESSED-DATE TO WRK-DISP-DATE DTSCS82 +00740 MOVE WRK-DISP-MM TO MAP-LATE-PEN-ASSESSED-MM DTSCS82 +00741 MOVE WRK-DISP-DD TO MAP-LATE-PEN-ASSESSED-DD DTSCS82 +00742 MOVE WRK-DISP-YY TO MAP-LATE-PEN-ASSESSED-YY. DTSCS82 +00743 SKIP1 DTSCS82 +00744 IF FQTR-UC30-FIRST-DEL-DATE NUMERIC DTSCS82 +00745 IF FQTR-UC30-FIRST-DEL-DATE NOT = +0 DTSCS82 +00746 MOVE FQTR-UC30-FIRST-DEL-DATE TO WRK-DISP-DATE DTSCS82 +00747 MOVE WRK-DISP-MM TO MAP-UC30-FIRST-DEL-MM DTSCS82 +00748 MOVE WRK-DISP-DD TO MAP-UC30-FIRST-DEL-DD DTSCS82 +00749 MOVE WRK-DISP-YY TO MAP-UC30-FIRST-DEL-YY. DTSCS82 +00750 SKIP1 DTSCS82 +00751 IF FQTR-UC30-FINAL-DEL-DATE NUMERIC DTSCS82 +00752 IF FQTR-UC30-FINAL-DEL-DATE NOT = +0 DTSCS82 +00753 MOVE FQTR-UC30-FINAL-DEL-DATE TO WRK-DISP-DATE DTSCS82 +00754 MOVE WRK-DISP-MM TO MAP-UC30-FINAL-DEL-MM DTSCS82 +00755 MOVE WRK-DISP-DD TO MAP-UC30-FINAL-DEL-DD DTSCS82 +00756 MOVE WRK-DISP-YY TO MAP-UC30-FINAL-DEL-YY. DTSCS82 +00757 SKIP1 DTSCS82 +00758 IF FQTR-UC30-FINAL-ACTION-DATE NUMERIC DTSCS82 +00759 IF FQTR-UC30-FINAL-ACTION-DATE NOT = +0 DTSCS82 +00760 MOVE FQTR-UC30-FINAL-ACTION-DATE TO WRK-DISP-DATE DTSCS82 +00761 MOVE WRK-DISP-MM TO MAP-UC30-FINAL-ACTION-MM DTSCS82 +00762 MOVE WRK-DISP-DD TO MAP-UC30-FINAL-ACTION-DD DTSCS82 +00763 MOVE WRK-DISP-YY TO MAP-UC30-FINAL-ACTION-YY.DTSCS82 +00764 SKIP1 DTSCS82 +00765 * IF FQTR-DELQ-LTR-SENT-DATE NUMERIC CL**8 +00766 * IF FQTR-DELQ-LTR-SENT-DATE NOT = +0 CL**8 +00767 * MOVE FQTR-DELQ-LTR-SENT-DATE TO WRK-DISP-DATE CL**8 +00768 * MOVE WRK-DISP-MM TO MAP-DELQ-LTR-SENT-MM CL**8 +00769 * MOVE WRK-DISP-DD TO MAP-DELQ-LTR-SENT-DD CL**8 +00770 * MOVE WRK-DISP-YY TO MAP-DELQ-LTR-SENT-YY. CL**8 +00771 SKIP1 DTSCS82 +00772 IF FQTR-ESTIMATED-DATE NUMERIC DTSCS82 +00773 IF FQTR-ESTIMATED-DATE NOT = +0 DTSCS82 +00774 MOVE FQTR-ESTIMATED-DATE TO WRK-DISP-DATE DTSCS82 +00775 MOVE WRK-DISP-MM TO MAP-UC30-ESTIMATED-MM DTSCS82 +00776 MOVE WRK-DISP-DD TO MAP-UC30-ESTIMATED-DD DTSCS82 +00777 MOVE WRK-DISP-YY TO MAP-UC30-ESTIMATED-YY. DTSCS82 +00778 SKIP1 DTSCS82 +00779 IF FQTR-SELF-INS-TAX-DUE-DATE NUMERIC DTSCS82 +00780 IF FQTR-SELF-INS-TAX-DUE-DATE NOT = +0 DTSCS82 +00781 MOVE FQTR-SELF-INS-TAX-DUE-DATE TO WRK-DISP-DATE DTSCS82 +00782 MOVE WRK-DISP-MM TO MAP-SELF-INS-TAX-DUE-MM DTSCS82 +00783 MOVE WRK-DISP-DD TO MAP-SELF-INS-TAX-DUE-DD DTSCS82 +00784 MOVE WRK-DISP-YY TO MAP-SELF-INS-TAX-DUE-YY. DTSCS82 +00785 SKIP1 DTSCS82 +00786 * IF FQTR-SELF-INS-2ND-LETTER-DATE NUMERIC CL**8 +00787 * IF FQTR-SELF-INS-2ND-LETTER-DATE NOT = +0 CL**8 +00788 * MOVE FQTR-SELF-INS-2ND-LETTER-DATE TO WRK-DISP-DATE CL**8 +00789 * MOVE WRK-DISP-MM TO MAP-SELF-INS-2ND-LTR-MM CL**8 +00790 * MOVE WRK-DISP-DD TO MAP-SELF-INS-2ND-LTR-DD CL**8 +00791 * MOVE WRK-DISP-YY TO MAP-SELF-INS-2ND-LTR-YY. CL**8 +00792 SKIP1 DTSCS82 +00793 IF FQTR-SELF-INS-CHG-RUN-DATE NUMERIC DTSCS82 +00794 IF FQTR-SELF-INS-CHG-RUN-DATE NOT = +0 DTSCS82 +00795 MOVE FQTR-SELF-INS-CHG-RUN-DATE TO WRK-DISP-DATE DTSCS82 +00796 MOVE WRK-DISP-MM TO MAP-SELF-INS-CHG-RUN-MM DTSCS82 +00797 MOVE WRK-DISP-DD TO MAP-SELF-INS-CHG-RUN-DD DTSCS82 +00798 MOVE WRK-DISP-YY TO MAP-SELF-INS-CHG-RUN-YY. DTSCS82 +00799 SKIP1 DTSCS82 +00800 * IF FQTR-MONTHLY-SOA-RUN-DATE NUMERIC CL**8 +00801 * IF FQTR-MONTHLY-SOA-RUN-DATE NOT = +0 CL**8 +00802 * MOVE FQTR-MONTHLY-SOA-RUN-DATE TO WRK-DISP-DATE CL**8 +00803 * MOVE WRK-DISP-MM TO MAP-MONTHLY-SOA-RUN-MM CL**8 +00804 * MOVE WRK-DISP-DD TO MAP-MONTHLY-SOA-RUN-DD CL**8 +00805 * MOVE WRK-DISP-YY TO MAP-MONTHLY-SOA-RUN-YY. CL**8 +00806 SKIP1 CL**3 +00807 IF FQTR-ESTB-DATE NOT = +0 DTSCS82 +00808 MOVE FQTR-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS82 +00809 SET L001-FROM-FED-8 TO TRUE DTSCS82 +00810 PERFORM S001-DATE THRU S001-EXIT DTSCS82 +00811 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS82 +00812 SKIP1 DTSCS82 +00813 IF FQTR-CHNG-DATE NOT = +0 DTSCS82 +00814 MOVE FQTR-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS82 +00815 SET L001-FROM-FED-8 TO TRUE DTSCS82 +00816 PERFORM S001-DATE THRU S001-EXIT DTSCS82 +00817 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS82 +00818 SKIP1 DTSCS82 +00819 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS82 +00820 MOVE FQTR-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS82 +00821 P6900-EXIT. DTSCS82 +00822 EXIT. DTSCS82 +00823 /*****************************************************************DTSCS82 +00824 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS82 +00825 ******************************************************************DTSCS82 +00826 SKIP1 DTSCS82 +00827 P7000-REQUEST-EDIT. DTSCS82 +00828 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 +00829 SKIP1 DTSCS82 +00830 IF LCCM-F09-88 DTSCS82 +00831 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS82 +00832 ELSE DTSCS82 +00833 IF LCCM-F10-88 DTSCS82 +00834 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS82 +00835 ELSE DTSCS82 +00836 IF LCCM-F23-88 DTSCS82 +00837 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS82 +00838 ELSE DTSCS82 +00839 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00840 SKIP3 DTSCS82 +00841 *------------------------------------------------------ DTSCS82 +00842 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS82 +00843 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS82 +00844 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS82 +00845 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS82 +00846 *------------------------------------------------------ DTSCS82 +00847 SKIP1 DTSCS82 +00848 IF LCCM-MSG DTSCS82 +00849 NEXT SENTENCE DTSCS82 +00850 ELSE DTSCS82 +00851 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS82 +00852 IF LCCM-F09-88 DTSCS82 +00853 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS82 +00854 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS82 +00855 ELSE DTSCS82 +00856 IF LCCM-F10-88 DTSCS82 +00857 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS82 +00858 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS82 +00859 ELSE DTSCS82 +00860 IF LCCM-F23-88 DTSCS82 +00861 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS82 +00862 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS82 +00863 SKIP1 DTSCS82 +00864 SET RESP-SEND-MAP TO TRUE. DTSCS82 +00865 P7000-EXIT. DTSCS82 +00866 EXIT. DTSCS82 +00867 /*****************************************************************DTSCS82 +00868 * ADD FUNCTION WAS REQUESTED *DTSCS82 +00869 ******************************************************************DTSCS82 +00870 SKIP1 DTSCS82 +00871 P7100-EDIT-ADD. DTSCS82 +00872 *------------------------------------------------------ DTSCS82 +00873 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS82 +00874 *------------------------------------------------------ DTSCS82 +00875 IF NOT LCCM-SCR-CLEAR DTSCS82 +00876 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS82 +00877 GO TO P7100-EXIT. DTSCS82 +00878 SKIP1 DTSCS82 +00879 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS82 +00880 SKIP1 DTSCS82 +00881 IF LCCM-NO-MSG DTSCS82 +00882 PERFORM S8010-READ-FQTR THRU S8010-EXIT DTSCS82 +00883 IF L831-OK-88 DTSCS82 +00884 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS82 +00885 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00886 ELSE DTSCS82 +00887 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS82 +00888 P7100-EXIT. DTSCS82 +00889 EXIT. DTSCS82 +00890 /*****************************************************************DTSCS82 +00891 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS82 +00892 ******************************************************************DTSCS82 +00893 SKIP1 DTSCS82 +00894 P7200-EDIT-MOD. DTSCS82 +00895 *----------------------------------------------------- DTSCS82 +00896 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS82 +00897 * INQUIRED DTSCS82 +00898 *----------------------------------------------------- DTSCS82 +00899 IF NOT LCCM-SCR-INQUIRE DTSCS82 +00900 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS82 +00901 GO TO P7200-EXIT. DTSCS82 +00902 SKIP3 DTSCS82 +00903 *----------------------------------------------------- DTSCS82 +00904 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS82 +00905 *----------------------------------------------------- DTSCS82 +00906 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 +00907 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 +00908 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 +00909 IF L016-NOT-VALID DTSCS82 +00910 OR L016-YRQ NOT = WRK-QTR DTSCS82 +00911 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS82 +00912 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00913 GO TO P7200-EXIT. DTSCS82 +00914 SKIP1 DTSCS82 +00915 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS82 +00916 SKIP1 DTSCS82 +00917 IF LCCM-NO-MSG DTSCS82 +00918 PERFORM S8010-READ-FQTR THRU S8010-EXIT DTSCS82 +00919 IF L831-NO-REC-88 DTSCS82 +00920 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +00921 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00922 ELSE DTSCS82 +00923 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS82 +00924 P7200-EXIT. DTSCS82 +00925 EXIT. DTSCS82 +00926 /*****************************************************************DTSCS82 +00927 * DELETE FUNCTION WAS REQUESTED *DTSCS82 +00928 ******************************************************************DTSCS82 +00929 SKIP1 DTSCS82 +00930 P7300-EDIT-DEL. DTSCS82 +00931 *----------------------------------------------------- DTSCS82 +00932 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS82 +00933 * INQUIRED DTSCS82 +00934 *----------------------------------------------------- DTSCS82 +00935 IF NOT LCCM-SCR-INQUIRE DTSCS82 +00936 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS82 +00937 GO TO P7300-EXIT. DTSCS82 +00938 SKIP3 DTSCS82 +00939 *----------------------------------------------------- DTSCS82 +00940 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS82 +00941 *----------------------------------------------------- DTSCS82 +00942 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS82 +00943 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 +00944 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 +00945 IF L016-NOT-VALID DTSCS82 +00946 OR L016-YRQ NOT = WRK-QTR DTSCS82 +00947 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS82 +00948 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 +00949 SKIP1 DTSCS82 +00950 IF LCCM-NO-MSG DTSCS82 +00951 PERFORM S8010-READ-FQTR THRU S8010-EXIT DTSCS82 +00952 IF L831-NO-REC-88 DTSCS82 +00953 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +00954 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 +00955 P7300-EXIT. DTSCS82 +00956 EXIT. DTSCS82 +00957 /*****************************************************************DTSCS82 +00958 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS82 +00959 ******************************************************************DTSCS82 +00960 SKIP1 DTSCS82 +00961 P8000-REQUEST-UPDATE. DTSCS82 +00962 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 +00963 SKIP1 DTSCS82 +00964 IF LCCM-SCR-ADD-LOCKED DTSCS82 +00965 PERFORM P8100-ADD THRU P8100-EXIT DTSCS82 +00966 ELSE DTSCS82 +00967 IF LCCM-SCR-MOD-LOCKED DTSCS82 +00968 PERFORM P8200-MOD THRU P8200-EXIT DTSCS82 +00969 ELSE DTSCS82 +00970 IF LCCM-SCR-DEL-LOCKED DTSCS82 +00971 PERFORM P8300-DEL THRU P8300-EXIT DTSCS82 +00972 ELSE DTSCS82 +00973 PERFORM S899-ABEND THRU S899-EXIT. DTSCS82 +00974 SKIP1 DTSCS82 +00975 SET RESP-SEND-MAP TO TRUE. DTSCS82 +00976 P8000-EXIT. DTSCS82 +00977 EXIT. DTSCS82 +00978 /*****************************************************************DTSCS82 +00979 * *DTSCS82 +00980 ******************************************************************DTSCS82 +00981 SKIP1 DTSCS82 +00982 P8100-ADD. DTSCS82 +00983 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 +00984 SKIP1 DTSCS82 +00985 IF LCCM-F12-88 DTSCS82 +00986 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS82 +00987 GO TO P8100-EXIT. DTSCS82 +00988 SKIP1 DTSCS82 +00989 PERFORM S8010-READ-FQTR THRU S8010-EXIT. DTSCS82 +00990 IF L831-OK-88 DTSCS82 +00991 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS82 +00992 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +00993 GO TO P8100-EXIT. DTSCS82 00994 SKIP1 DTSCS82 -00995 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 -00996 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 -00997 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS82 -00998 P8100-EXIT. DTSCS82 -00999 EXIT. DTSCS82 -01000 /*****************************************************************DTSCS82 -01001 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS82 -01002 ******************************************************************DTSCS82 +00995 MOVE LOW-VALUES TO FQTR-DATA-AREA. DTSCS82 +00996 SKIP1 DTSCS82 +00997 PERFORM P8900-CONSTRUCT-FQTR THRU P8900-EXIT. DTSCS82 +00998 SKIP1 DTSCS82 +00999 MOVE LCCM-CURR-RUN-DATE TO FQTR-ESTB-DATE. DTSCS82 +01000 MOVE LCCM-CURR-RUN-DATE TO FQTR-CHNG-DATE. DTSCS82 +01001 SKIP1 DTSCS82 +01002 PERFORM S831-WRITE THRU S831-EXIT. DTSCS82 01003 SKIP1 DTSCS82 -01004 P8200-MOD. DTSCS82 -01005 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS82 -01006 SKIP1 DTSCS82 -01007 IF LCCM-F12-88 DTSCS82 -01008 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS82 -01009 GO TO P8200-EXIT. DTSCS82 -01010 SKIP1 DTSCS82 -01011 PERFORM S8010-READ-FQTR THRU S8010-EXIT. DTSCS82 -01012 IF L831-NO-REC-88 DTSCS82 -01013 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -01014 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -01015 GO TO P8200-EXIT. DTSCS82 -01016 SKIP1 DTSCS82 -01017 PERFORM P8900-CONSTRUCT-FQTR THRU P8900-EXIT. DTSCS82 -01018 SKIP1 DTSCS82 -01019 MOVE LCCM-CURR-RUN-DATE TO FQTR-CHNG-DATE. DTSCS82 -01020 SKIP1 DTSCS82 -01021 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS82 -01022 SKIP1 DTSCS82 -01023 MOVE FQTR-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS82 -01024 SET L001-FROM-FED-8 TO TRUE. DTSCS82 -01025 PERFORM S001-DATE THRU S001-EXIT. DTSCS82 -01026 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS82 +01004 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 +01005 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 +01006 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS82 +01007 P8100-EXIT. DTSCS82 +01008 EXIT. DTSCS82 +01009 /*****************************************************************DTSCS82 +01010 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS82 +01011 ******************************************************************DTSCS82 +01012 SKIP1 DTSCS82 +01013 P8200-MOD. DTSCS82 +01014 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS82 +01015 SKIP1 DTSCS82 +01016 IF LCCM-F12-88 DTSCS82 +01017 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS82 +01018 GO TO P8200-EXIT. DTSCS82 +01019 SKIP1 DTSCS82 +01020 PERFORM S8010-READ-FQTR THRU S8010-EXIT. DTSCS82 +01021 IF L831-NO-REC-88 DTSCS82 +01022 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +01023 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +01024 GO TO P8200-EXIT. DTSCS82 +01025 SKIP1 DTSCS82 +01026 PERFORM P8900-CONSTRUCT-FQTR THRU P8900-EXIT. DTSCS82 01027 SKIP1 DTSCS82 -01028 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS82 -01029 P8200-EXIT. DTSCS82 -01030 EXIT. DTSCS82 -01031 /*****************************************************************DTSCS82 -01032 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS82 -01033 ******************************************************************DTSCS82 -01034 SKIP1 DTSCS82 -01035 P8300-DEL. DTSCS82 -01036 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS82 -01037 SKIP1 DTSCS82 -01038 IF LCCM-F12-88 DTSCS82 -01039 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS82 -01040 GO TO P8300-EXIT. DTSCS82 -01041 SKIP1 DTSCS82 -01042 PERFORM S8010-READ-FQTR THRU S8010-EXIT. DTSCS82 -01043 IF NOT L831-OK-88 DTSCS82 -01044 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 -01045 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -01046 GO TO P8300-EXIT. DTSCS82 -01047 SKIP1 DTSCS82 -01048 PERFORM S831-DELETE THRU S831-EXIT. DTSCS82 -01049 SKIP1 DTSCS82 -01050 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS82 -01051 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 -01052 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS82 -01053 SKIP1 DTSCS82 -01054 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 -01055 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 +01028 MOVE LCCM-CURR-RUN-DATE TO FQTR-CHNG-DATE. DTSCS82 +01029 SKIP1 DTSCS82 +01030 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS82 +01031 SKIP1 DTSCS82 +01032 MOVE FQTR-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS82 +01033 SET L001-FROM-FED-8 TO TRUE. DTSCS82 +01034 PERFORM S001-DATE THRU S001-EXIT. DTSCS82 +01035 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS82 +01036 SKIP1 DTSCS82 +01037 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS82 +01038 P8200-EXIT. DTSCS82 +01039 EXIT. DTSCS82 +01040 /*****************************************************************DTSCS82 +01041 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS82 +01042 ******************************************************************DTSCS82 +01043 SKIP1 DTSCS82 +01044 P8300-DEL. DTSCS82 +01045 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS82 +01046 SKIP1 DTSCS82 +01047 IF LCCM-F12-88 DTSCS82 +01048 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS82 +01049 GO TO P8300-EXIT. DTSCS82 +01050 SKIP1 DTSCS82 +01051 PERFORM S8010-READ-FQTR THRU S8010-EXIT. DTSCS82 +01052 IF NOT L831-OK-88 DTSCS82 +01053 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS82 +01054 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +01055 GO TO P8300-EXIT. DTSCS82 01056 SKIP1 DTSCS82 -01057 MOVE FQTR-YRQ TO L004-QTR-5-9. DTSCS82 -01058 SET L004-FROM-5 TO TRUE. DTSCS82 -01059 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS82 -01060 IF L004-VALID-QTR DTSCS82 -01061 MOVE L004-QTR-3-YR TO MAP-YR DTSCS82 -01062 MOVE L004-QTR-3-Q TO MAP-Q DTSCS82 -01063 ELSE DTSCS82 -01064 GO TO S899-ABEND. DTSCS82 +01057 PERFORM S831-DELETE THRU S831-EXIT. DTSCS82 +01058 SKIP1 DTSCS82 +01059 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS82 +01060 SET LCCM-SCR-CLEAR TO TRUE. DTSCS82 +01061 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS82 +01062 SKIP1 DTSCS82 +01063 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 +01064 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS82 01065 SKIP1 DTSCS82 -01066 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS82 -01067 P8300-EXIT. DTSCS82 -01068 EXIT. DTSCS82 -01069 EJECT DTSCS82 -01070 P8900-CONSTRUCT-FQTR. DTSCS82 -01071 SKIP1 DTSCS82 -01072 MOVE MAP-UC30-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01073 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01074 MOVE L015-DATE TO FQTR-UC30-MASS-MAIL-DATE.DTSCS82 -01075 SKIP1 DTSCS82 -01076 MOVE MAP-SELF-INS-TAX-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01077 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01078 MOVE L015-DATE TO FQTR-SELF-INS-TAX-DUE-DATE. DTSCS82 -01079 SKIP1 DTSCS82 -01080 MOVE MAP-SELF-INS-2ND-LTR-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01081 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01082 MOVE L015-DATE TO FQTR-SELF-INS-2ND-LETTER-DATE. DTSCS82 -01083 SKIP1 DTSCS82 -01084 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01085 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01086 MOVE L015-DATE TO FQTR-LATE-PEN-ASSESSED-DATE. DTSCS82 -01087 SKIP1 DTSCS82 -01088 MOVE MAP-UC30-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01089 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01090 MOVE L015-DATE TO FQTR-UC30-FIRST-DEL-DATE.DTSCS82 -01091 SKIP1 DTSCS82 -01092 MOVE MAP-UC30-FINAL-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01093 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01094 MOVE L015-DATE TO FQTR-UC30-FINAL-DEL-DATE.DTSCS82 -01095 SKIP1 DTSCS82 -01096 MOVE MAP-DELQ-LTR-SENT-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01097 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01098 MOVE L015-DATE TO FQTR-DELQ-LTR-SENT-DATE. DTSCS82 -01099 SKIP1 DTSCS82 -01100 MOVE MAP-UC30-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01101 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01102 MOVE L015-DATE TO FQTR-ESTIMATED-DATE. DTSCS82 -01103 SKIP1 DTSCS82 -01104 MOVE MAP-UC30-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01105 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01106 MOVE L015-DATE TO FQTR-UC30-FINAL-ACTION-DATE. DTSCS82 -01107 SKIP1 DTSCS82 -01108 MOVE MAP-SELF-INS-CHG-RUN-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01109 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01110 MOVE L015-DATE TO FQTR-SELF-INS-CHG-RUN-DATE. DTSCS82 -01111 P8900-EXIT. DTSCS82 -01112 EXIT. DTSCS82 -01113 /*****************************************************************DTSCS82 -01114 * LINKS TO UTILITY MODULES DTSCS82 -01115 ******************************************************************DTSCS82 -01116 SKIP1 DTSCS82 -01117 S001-DATE. DTSCS82 -01118 EXEC CICS LINK DTSCS82 -01119 PROGRAM ('DTSCU001') DTSCS82 -01120 COMMAREA (L001-COMM-AREA) DTSCS82 -01121 END-EXEC. DTSCS82 -01122 S001-EXIT. DTSCS82 -01123 EXIT. DTSCS82 -01124 SKIP3 DTSCS82 -01125 S004-YRQ-CONVERT. DTSCS82 -01126 EXEC CICS LINK DTSCS82 -01127 PROGRAM ('DTSCU004') DTSCS82 -01128 COMMAREA (L004-COMM-AREA) DTSCS82 -01129 END-EXEC. DTSCS82 -01130 S004-EXIT. DTSCS82 -01131 EXIT. DTSCS82 -01132 SKIP3 DTSCS82 -01133 S015-DATE-AREA. DTSCS82 -01134 EXEC CICS LINK DTSCS82 -01135 PROGRAM ('DTSCU015') DTSCS82 -01136 COMMAREA (L015-COMM-AREA) DTSCS82 -01137 END-EXEC. DTSCS82 -01138 S015-EXIT. DTSCS82 -01139 EXIT. DTSCS82 -01140 SKIP3 DTSCS82 -01141 S016-CHECK-MAP-YR-Q. DTSCS82 -01142 EXEC CICS LINK DTSCS82 -01143 PROGRAM ('DTSCU016') DTSCS82 -01144 COMMAREA (L016-COMM-AREA) DTSCS82 -01145 END-EXEC. DTSCS82 -01146 S016-EXIT. DTSCS82 -01147 EXIT. DTSCS82 -01148 EJECT DTSCS82 -01149 S803-REQ-SCR-ID-EDIT. DTSCS82 -01150 EXEC CICS LINK DTSCS82 -01151 PROGRAM ('DTSCU803') DTSCS82 -01152 COMMAREA (DFHCOMMAREA) DTSCS82 -01153 END-EXEC. DTSCS82 -01154 S803-EXIT. DTSCS82 -01155 EXIT. DTSCS82 -01156 SKIP3 DTSCS82 -01157 S804-INVALID-KEY. DTSCS82 -01158 EXEC CICS LINK DTSCS82 -01159 PROGRAM ('DTSCU804') DTSCS82 -01160 COMMAREA (DFHCOMMAREA) DTSCS82 -01161 END-EXEC. DTSCS82 -01162 S804-EXIT. DTSCS82 -01163 EXIT. DTSCS82 -01164 SKIP3 DTSCS82 -01165 S805-MSG-AREA. DTSCS82 -01166 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS82 -01167 SKIP1 DTSCS82 +01066 MOVE FQTR-YRQ TO L004-QTR-5-9. DTSCS82 +01067 SET L004-FROM-5 TO TRUE. DTSCS82 +01068 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS82 +01069 IF L004-VALID-QTR DTSCS82 +01070 MOVE L004-QTR-3-YR TO MAP-YR DTSCS82 +01071 MOVE L004-QTR-3-Q TO MAP-Q DTSCS82 +01072 ELSE DTSCS82 +01073 GO TO S899-ABEND. DTSCS82 +01074 SKIP1 DTSCS82 +01075 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS82 +01076 P8300-EXIT. DTSCS82 +01077 EXIT. DTSCS82 +01078 EJECT DTSCS82 +01079 P8900-CONSTRUCT-FQTR. DTSCS82 +01080 SKIP1 DTSCS82 +01081 MOVE MAP-UC30-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01082 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01083 MOVE L015-DATE TO FQTR-UC30-MASS-MAIL-DATE.DTSCS82 +01084 SKIP1 DTSCS82 +01085 MOVE MAP-SELF-INS-TAX-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01086 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01087 MOVE L015-DATE TO FQTR-SELF-INS-TAX-DUE-DATE. DTSCS82 +01088 SKIP1 DTSCS82 +01089 * MOVE MAP-SELF-INS-2ND-LTR-DATE-AREA TO L015-S-DATE-AREA. CL**8 +01090 * PERFORM S015-DATE-AREA THRU S015-EXIT. CL**8 +01091 * MOVE L015-DATE TO FQTR-SELF-INS-2ND-LETTER-DATE. CL**8 +01092 MOVE ZEROS TO FQTR-SELF-INS-2ND-LETTER-DATE. CL**8 +01093 SKIP1 DTSCS82 +01094 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01095 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01096 MOVE L015-DATE TO FQTR-LATE-PEN-ASSESSED-DATE. DTSCS82 +01097 SKIP1 DTSCS82 +01098 MOVE MAP-UC30-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01099 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01100 MOVE L015-DATE TO FQTR-UC30-FIRST-DEL-DATE.DTSCS82 +01101 SKIP1 DTSCS82 +01102 MOVE MAP-UC30-FINAL-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01103 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01104 MOVE L015-DATE TO FQTR-UC30-FINAL-DEL-DATE.DTSCS82 +01105 SKIP1 DTSCS82 +01106 * MOVE MAP-DELQ-LTR-SENT-DATE-AREA TO L015-S-DATE-AREA. CL**8 +01107 * PERFORM S015-DATE-AREA THRU S015-EXIT. CL**8 +01108 * MOVE L015-DATE TO FQTR-DELQ-LTR-SENT-DATE. CL**8 +01109 SKIP1 DTSCS82 +01110 MOVE MAP-UC30-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01111 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01112 MOVE L015-DATE TO FQTR-ESTIMATED-DATE. DTSCS82 +01113 SKIP1 DTSCS82 +01114 MOVE MAP-UC30-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01115 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01116 MOVE L015-DATE TO FQTR-UC30-FINAL-ACTION-DATE. DTSCS82 +01117 SKIP1 DTSCS82 +01118 MOVE MAP-SELF-INS-CHG-RUN-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01119 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01120 MOVE L015-DATE TO FQTR-SELF-INS-CHG-RUN-DATE. DTSCS82 +01121 P8900-EXIT. DTSCS82 +01122 EXIT. DTSCS82 +01123 /*****************************************************************DTSCS82 +01124 * LINKS TO UTILITY MODULES DTSCS82 +01125 ******************************************************************DTSCS82 +01126 SKIP1 DTSCS82 +01127 S001-DATE. DTSCS82 +01128 EXEC CICS LINK DTSCS82 +01129 PROGRAM ('DTSCU001') DTSCS82 +01130 COMMAREA (L001-COMM-AREA) DTSCS82 +01131 END-EXEC. DTSCS82 +01132 S001-EXIT. DTSCS82 +01133 EXIT. DTSCS82 +01134 SKIP3 DTSCS82 +01135 S004-YRQ-CONVERT. DTSCS82 +01136 EXEC CICS LINK DTSCS82 +01137 PROGRAM ('DTSCU004') DTSCS82 +01138 COMMAREA (L004-COMM-AREA) DTSCS82 +01139 END-EXEC. DTSCS82 +01140 S004-EXIT. DTSCS82 +01141 EXIT. DTSCS82 +01142 SKIP3 DTSCS82 +01143 S015-DATE-AREA. DTSCS82 +01144 EXEC CICS LINK DTSCS82 +01145 PROGRAM ('DTSCU015') DTSCS82 +01146 COMMAREA (L015-COMM-AREA) DTSCS82 +01147 END-EXEC. DTSCS82 +01148 S015-EXIT. DTSCS82 +01149 EXIT. DTSCS82 +01150 SKIP3 DTSCS82 +01151 S016-CHECK-MAP-YR-Q. DTSCS82 +01152 EXEC CICS LINK DTSCS82 +01153 PROGRAM ('DTSCU016') DTSCS82 +01154 COMMAREA (L016-COMM-AREA) DTSCS82 +01155 END-EXEC. DTSCS82 +01156 S016-EXIT. DTSCS82 +01157 EXIT. DTSCS82 +01158 EJECT DTSCS82 +01159 S803-REQ-SCR-ID-EDIT. DTSCS82 +01160 EXEC CICS LINK DTSCS82 +01161 PROGRAM ('DTSCU803') DTSCS82 +01162 COMMAREA (DFHCOMMAREA) DTSCS82 +01163 END-EXEC. DTSCS82 +01164 S803-EXIT. DTSCS82 +01165 EXIT. DTSCS82 +01166 SKIP3 DTSCS82 +01167 S804-INVALID-KEY. DTSCS82 01168 EXEC CICS LINK DTSCS82 -01169 PROGRAM ('DTSCU805') DTSCS82 -01170 COMMAREA (L805-COMM-AREA) DTSCS82 +01169 PROGRAM ('DTSCU804') DTSCS82 +01170 COMMAREA (DFHCOMMAREA) DTSCS82 01171 END-EXEC. DTSCS82 -01172 SKIP1 DTSCS82 -01173 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS82 -01174 S805-EXIT. DTSCS82 -01175 EXIT. DTSCS82 -01176 EJECT DTSCS82 -01177 S831-READ. DTSCS82 -01178 SET L831-READ-88 TO TRUE. DTSCS82 -01179 GO TO S831-IO. DTSCS82 -01180 SKIP1 DTSCS82 -01181 S831-START-BROWSE. DTSCS82 -01182 SET L831-START-BROWSE-88 TO TRUE. DTSCS82 -01183 GO TO S831-IO. DTSCS82 -01184 SKIP1 DTSCS82 -01185 S831-READ-NEXT. DTSCS82 -01186 SET L831-READ-NEXT-88 TO TRUE. DTSCS82 -01187 GO TO S831-IO. DTSCS82 -01188 SKIP1 DTSCS82 -01189 S831-READ-PREV. DTSCS82 -01190 SET L831-READ-PREV-88 TO TRUE. DTSCS82 -01191 GO TO S831-IO. DTSCS82 -01192 SKIP1 DTSCS82 -01193 S831-END-BROWSE. DTSCS82 -01194 SET L831-END-BROWSE-88 TO TRUE. DTSCS82 -01195 GO TO S831-IO. DTSCS82 -01196 SKIP1 DTSCS82 -01197 S831-REWRITE. DTSCS82 -01198 SET L831-REWRITE-88 TO TRUE. DTSCS82 -01199 GO TO S831-IO. DTSCS82 -01200 SKIP1 DTSCS82 -01201 S831-WRITE. DTSCS82 -01202 SET L831-WRITE-88 TO TRUE. DTSCS82 -01203 GO TO S831-IO. DTSCS82 -01204 SKIP1 DTSCS82 -01205 S831-DELETE. DTSCS82 -01206 SET L831-DELETE-88 TO TRUE. DTSCS82 -01207 GO TO S831-IO. DTSCS82 -01208 SKIP1 DTSCS82 -01209 S831-IO. DTSCS82 +01172 S804-EXIT. DTSCS82 +01173 EXIT. DTSCS82 +01174 SKIP3 DTSCS82 +01175 S805-MSG-AREA. DTSCS82 +01176 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS82 +01177 SKIP1 DTSCS82 +01178 EXEC CICS LINK DTSCS82 +01179 PROGRAM ('DTSCU805') DTSCS82 +01180 COMMAREA (L805-COMM-AREA) DTSCS82 +01181 END-EXEC. DTSCS82 +01182 SKIP1 DTSCS82 +01183 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS82 +01184 S805-EXIT. DTSCS82 +01185 EXIT. DTSCS82 +01186 EJECT DTSCS82 +01187 S831-READ. DTSCS82 +01188 SET L831-READ-88 TO TRUE. DTSCS82 +01189 GO TO S831-IO. DTSCS82 +01190 SKIP1 DTSCS82 +01191 S831-START-BROWSE. DTSCS82 +01192 SET L831-START-BROWSE-88 TO TRUE. DTSCS82 +01193 GO TO S831-IO. DTSCS82 +01194 SKIP1 DTSCS82 +01195 S831-READ-NEXT. DTSCS82 +01196 SET L831-READ-NEXT-88 TO TRUE. DTSCS82 +01197 GO TO S831-IO. DTSCS82 +01198 SKIP1 DTSCS82 +01199 S831-READ-PREV. DTSCS82 +01200 SET L831-READ-PREV-88 TO TRUE. DTSCS82 +01201 GO TO S831-IO. DTSCS82 +01202 SKIP1 DTSCS82 +01203 S831-END-BROWSE. DTSCS82 +01204 SET L831-END-BROWSE-88 TO TRUE. DTSCS82 +01205 GO TO S831-IO. DTSCS82 +01206 SKIP1 DTSCS82 +01207 S831-REWRITE. DTSCS82 +01208 SET L831-REWRITE-88 TO TRUE. DTSCS82 +01209 GO TO S831-IO. DTSCS82 01210 SKIP1 DTSCS82 -01211 EXEC CICS LINK DTSCS82 -01212 PROGRAM ('DTSCU831') DTSCS82 -01213 COMMAREA (L831-COMM-AREA) DTSCS82 -01214 END-EXEC. DTSCS82 -01215 SKIP1 DTSCS82 -01216 IF L831-FILE-CLOSED-88 DTSCS82 -01217 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS82 -01218 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS82 -01219 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS82 -01220 GO TO MAINLINE-EXIT. DTSCS82 -01221 S831-EXIT. DTSCS82 -01222 EXIT. DTSCS82 -01223 SKIP3 DTSCS82 -01224 S851-SCREEN-PROCESSING. DTSCS82 -01225 EXEC CICS LINK DTSCS82 -01226 PROGRAM ('DTSCU851') DTSCS82 -01227 COMMAREA (L851-COMM-AREA) DTSCS82 -01228 END-EXEC. DTSCS82 -01229 S851-EXIT. DTSCS82 -01230 EXIT. DTSCS82 -01231 SKIP3 DTSCS82 -01232 S899-ABEND. DTSCS82 -01233 EXEC CICS ABEND DTSCS82 -01234 ABCODE(WRK-ABEND-CD) DTSCS82 -01235 END-EXEC. DTSCS82 -01236 S899-EXIT. DTSCS82 -01237 EXIT. DTSCS82 -01238 /*****************************************************************DTSCS82 -01239 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS82 -01240 ******************************************************************DTSCS82 -01241 SKIP1 DTSCS82 -01242 S1001-SCREEN-KEY-EDITS. DTSCS82 -01243 SKIP1 DTSCS82 -01244 PERFORM S1100-YR-Q THRU S1100-EXIT. DTSCS82 -01245 SKIP1 DTSCS82 -01246 S1001-EXIT. DTSCS82 +01211 S831-WRITE. DTSCS82 +01212 SET L831-WRITE-88 TO TRUE. DTSCS82 +01213 GO TO S831-IO. DTSCS82 +01214 SKIP1 DTSCS82 +01215 S831-DELETE. DTSCS82 +01216 SET L831-DELETE-88 TO TRUE. DTSCS82 +01217 GO TO S831-IO. DTSCS82 +01218 SKIP1 DTSCS82 +01219 S831-IO. DTSCS82 +01220 SKIP1 DTSCS82 +01221 EXEC CICS LINK DTSCS82 +01222 PROGRAM ('DTSCU831') DTSCS82 +01223 COMMAREA (L831-COMM-AREA) DTSCS82 +01224 END-EXEC. DTSCS82 +01225 SKIP1 DTSCS82 +01226 IF L831-FILE-CLOSED-88 DTSCS82 +01227 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS82 +01228 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS82 +01229 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS82 +01230 GO TO MAINLINE-EXIT. DTSCS82 +01231 S831-EXIT. DTSCS82 +01232 EXIT. DTSCS82 +01233 SKIP3 DTSCS82 +01234 S851-SCREEN-PROCESSING. DTSCS82 +01235 EXEC CICS LINK DTSCS82 +01236 PROGRAM ('DTSCU851') DTSCS82 +01237 COMMAREA (L851-COMM-AREA) DTSCS82 +01238 END-EXEC. DTSCS82 +01239 S851-EXIT. DTSCS82 +01240 EXIT. DTSCS82 +01241 SKIP3 DTSCS82 +01242 S899-ABEND. DTSCS82 +01243 EXEC CICS ABEND DTSCS82 +01244 ABCODE(WRK-ABEND-CD) DTSCS82 +01245 END-EXEC. DTSCS82 +01246 S899-EXIT. DTSCS82 01247 EXIT. DTSCS82 -01248 SKIP3 DTSCS82 -01249 S1002-SCREEN-DATA-EDITS. DTSCS82 -01250 SKIP1 DTSCS82 -01251 MOVE +0 TO WRK-UC30-MASS-MAIL-DATE DTSCS82 -01252 WRK-UC30-FIRST-DEL-DATE DTSCS82 -01253 WRK-DELQ-LTR-SENT-DATE DTSCS82 -01254 WRK-UC30-ESTIMATED-DATE DTSCS82 -01255 WRK-UC30-FINAL-DEL-DATE DTSCS82 -01256 WRK-SELF-INS-CHG-RUN-DATE. DTSCS82 -01257 DTSCS82 -01258 MOVE FQTR-YRQ TO L004-QTR-5-9. DTSCS82 -01259 SET L004-FROM-5 TO TRUE. DTSCS82 -01260 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS82 -01261 MOVE L004-QTR-START-DATE TO WRK-YRQ-START-DATE. DTSCS82 -01262 MOVE L004-QTR-END-DATE TO WRK-YRQ-END-DATE. DTSCS82 -01263 SKIP1 DTSCS82 -01264 ADD +1 TO L004-ABS-QTR. DTSCS82 -01265 SET L004-FROM-ABS TO TRUE. DTSCS82 -01266 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS82 -01267 MOVE L004-QTR-START-DATE TO WRK-YRQ-PLUS1-START-DATE. DTSCS82 -01268 MOVE L004-QTR-END-DATE TO WRK-YRQ-PLUS1-END-DATE. DTSCS82 -01269 SKIP1 DTSCS82 -01270 ******************************************************************DTSCS82 -01271 * DEFAULT LATE PENALTY DATE IS THE FIRST DAY OF THE SECOND *DTSCS82 -01272 * MONTH OF THE QUARTER FOLLOWING THE QUARTER FOR WHICH THE *DTSCS82 -01273 * REPORT WAS DUE. DTSCS82 -01274 ******************************************************************DTSCS82 -01275 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS82 -01276 ADD 1 TO L001-FED-8-MO. DTSCS82 -01277 MOVE 01 TO L001-FED-8-DA. DTSCS82 -01278 SET L001-FROM-FED-8 TO TRUE DTSCS82 -01279 PERFORM S001-DATE THRU S001-EXIT DTSCS82 -01280 IF L001-VALID-DATE DTSCS82 -01281 MOVE L001-FED-8-DATE-9 TO WRK-DEFAULT-LATE-PEN-DATE DTSCS82 -01282 ELSE DTSCS82 -01283 MOVE ZERO TO WRK-DEFAULT-LATE-PEN-DATE. DTSCS82 -01284 SKIP1 DTSCS82 -01285 PERFORM S1200-UC30-MASS-MAIL-DATE THRU S1200-EXIT. DTSCS82 -01286 PERFORM S1300-UC30-FIRST-DEL-DATE THRU S1300-EXIT. DTSCS82 -01287 PERFORM S1400-UC30-FINAL-DEL-DATE THRU S1400-EXIT. DTSCS82 -01288 PERFORM S1500-SELF-INS-TAX-DUE-DATE THRU S1500-EXIT. DTSCS82 -01289 PERFORM S1600-LATE-PEN-ASSESSED-DATE THRU S1600-EXIT. DTSCS82 -01290 PERFORM S1650-SELF-INS-LATE-PEN-DATE THRU S1650-EXIT. DTSCS82 -01291 PERFORM S1675-UC30-ESTIMATED-DATE THRU S1675-EXIT. DTSCS82 -01292 PERFORM S1700-UC30-FINAL-ACTION-DATE THRU S1700-EXIT. DTSCS82 -01293 PERFORM S1800-SELF-INS-CHG-RUN-DATE THRU S1800-EXIT. DTSCS82 -01294 PERFORM S1900-SELF-INS-2ND-LTR-DATE THRU S1900-EXIT. DTSCS82 -01295 SKIP1 DTSCS82 -01296 S1002-EXIT. DTSCS82 -01297 EXIT. DTSCS82 -01298 EJECT DTSCS82 -01299 S1100-YR-Q. DTSCS82 -01300 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 -01301 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 -01302 IF L016-NO-ENTRY DTSCS82 -01303 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS82 -01304 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 -01305 ELSE DTSCS82 -01306 IF (L016-NOT-VALID) DTSCS82 -01307 OR DTSCS82 -01308 (L016-YRQ <= LCCM-PICKUP-YRQ) DTSCS82 -01309 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01310 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 -01311 S1100-EXIT. DTSCS82 -01312 EXIT. DTSCS82 -01313 SKIP3 DTSCS82 -01314 S1101-ERROR. DTSCS82 -01315 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A DTSCS82 -01316 MAP-Q-A. DTSCS82 -01317 IF LCCM-NO-MSG DTSCS82 -01318 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01319 MOVE CATB-CURSOR TO MAP-YR-L DTSCS82 -01320 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01321 S1101-EXIT. DTSCS82 +01248 /*****************************************************************DTSCS82 +01249 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS82 +01250 ******************************************************************DTSCS82 +01251 SKIP1 DTSCS82 +01252 S1001-SCREEN-KEY-EDITS. DTSCS82 +01253 SKIP1 DTSCS82 +01254 PERFORM S1100-YR-Q THRU S1100-EXIT. DTSCS82 +01255 SKIP1 DTSCS82 +01256 S1001-EXIT. DTSCS82 +01257 EXIT. DTSCS82 +01258 SKIP3 DTSCS82 +01259 S1002-SCREEN-DATA-EDITS. DTSCS82 +01260 SKIP1 DTSCS82 +01261 MOVE +0 TO WRK-UC30-MASS-MAIL-DATE DTSCS82 +01262 WRK-UC30-FIRST-DEL-DATE DTSCS82 +01263 WRK-DELQ-LTR-SENT-DATE DTSCS82 +01264 WRK-UC30-ESTIMATED-DATE DTSCS82 +01265 WRK-UC30-FINAL-DEL-DATE DTSCS82 +01266 WRK-SELF-INS-CHG-RUN-DATE. DTSCS82 +01267 DTSCS82 +01268 MOVE FQTR-YRQ TO L004-QTR-5-9. DTSCS82 +01269 SET L004-FROM-5 TO TRUE. DTSCS82 +01270 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS82 +01271 MOVE L004-QTR-START-DATE TO WRK-YRQ-START-DATE. DTSCS82 +01272 MOVE L004-QTR-END-DATE TO WRK-YRQ-END-DATE. DTSCS82 +01273 SKIP1 DTSCS82 +01274 ADD +1 TO L004-ABS-QTR. DTSCS82 +01275 SET L004-FROM-ABS TO TRUE. DTSCS82 +01276 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS82 +01277 MOVE L004-QTR-START-DATE TO WRK-YRQ-PLUS1-START-DATE. DTSCS82 +01278 MOVE L004-QTR-END-DATE TO WRK-YRQ-PLUS1-END-DATE. DTSCS82 +01279 SKIP1 DTSCS82 +01280 ******************************************************************DTSCS82 +01281 * DEFAULT LATE PENALTY DATE IS THE FIRST DAY OF THE SECOND *DTSCS82 +01282 * MONTH OF THE QUARTER FOLLOWING THE QUARTER FOR WHICH THE *DTSCS82 +01283 * REPORT WAS DUE. DTSCS82 +01284 ******************************************************************DTSCS82 +01285 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS82 +01286 ADD 1 TO L001-FED-8-MO. DTSCS82 +01287 MOVE 01 TO L001-FED-8-DA. DTSCS82 +01288 SET L001-FROM-FED-8 TO TRUE DTSCS82 +01289 PERFORM S001-DATE THRU S001-EXIT DTSCS82 +01290 IF L001-VALID-DATE DTSCS82 +01291 MOVE L001-FED-8-DATE-9 TO WRK-DEFAULT-LATE-PEN-DATE DTSCS82 +01292 ELSE DTSCS82 +01293 MOVE ZERO TO WRK-DEFAULT-LATE-PEN-DATE. DTSCS82 +01294 SKIP1 DTSCS82 +01295 PERFORM S1200-UC30-MASS-MAIL-DATE THRU S1200-EXIT. DTSCS82 +01296 PERFORM S1300-UC30-FIRST-DEL-DATE THRU S1300-EXIT. DTSCS82 +01297 PERFORM S1400-UC30-FINAL-DEL-DATE THRU S1400-EXIT. DTSCS82 +01298 PERFORM S1500-SELF-INS-TAX-DUE-DATE THRU S1500-EXIT. DTSCS82 +01299 PERFORM S1600-LATE-PEN-ASSESSED-DATE THRU S1600-EXIT. DTSCS82 +01300 PERFORM S1650-SELF-INS-LATE-PEN-DATE THRU S1650-EXIT. DTSCS82 +01301 PERFORM S1675-UC30-ESTIMATED-DATE THRU S1675-EXIT. DTSCS82 +01302 PERFORM S1700-UC30-FINAL-ACTION-DATE THRU S1700-EXIT. DTSCS82 +01303 PERFORM S1800-SELF-INS-CHG-RUN-DATE THRU S1800-EXIT. DTSCS82 +01304 PERFORM S1900-SELF-INS-2ND-LTR-DATE THRU S1900-EXIT. DTSCS82 +01305 SKIP1 DTSCS82 +01306 S1002-EXIT. DTSCS82 +01307 EXIT. DTSCS82 +01308 EJECT DTSCS82 +01309 S1100-YR-Q. DTSCS82 +01310 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 +01311 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 +01312 IF L016-NO-ENTRY DTSCS82 +01313 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS82 +01314 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS82 +01315 ELSE DTSCS82 +01316 IF (L016-NOT-VALID) DTSCS82 +01317 OR DTSCS82 +01318 (L016-YRQ <= LCCM-PICKUP-YRQ) DTSCS82 +01319 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01320 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS82 +01321 S1100-EXIT. DTSCS82 01322 EXIT. DTSCS82 -01323 EJECT DTSCS82 -01324 S1200-UC30-MASS-MAIL-DATE. DTSCS82 -01325 MOVE MAP-UC30-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01326 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01327 IF L015-NO-ENTRY DTSCS82 -01328 MOVE WRK-NO-ENTRY TO WRK-UC30-MASS-MAIL-DATE DTSCS82 -01329 GO TO S1200-EXIT. DTSCS82 -01330 IF L015-NOT-VALID DTSCS82 -01331 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01332 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS82 -01333 GO TO S1200-EXIT. DTSCS82 -01334 SKIP1 DTSCS82 -01335 IF L015-DATE < WRK-YRQ-START-DATE DTSCS82 -01336 OR L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS82 -01337 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01338 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS82 -01339 ELSE DTSCS82 -01340 MOVE L015-DATE TO WRK-UC30-MASS-MAIL-DATE. DTSCS82 -01341 S1200-EXIT. DTSCS82 -01342 EXIT. DTSCS82 -01343 SKIP3 DTSCS82 -01344 S1201-ERROR. DTSCS82 -01345 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-MASS-MAIL-MM-A DTSCS82 -01346 MAP-UC30-MASS-MAIL-DD-A DTSCS82 -01347 MAP-UC30-MASS-MAIL-YY-A. DTSCS82 -01348 IF LCCM-NO-MSG DTSCS82 -01349 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01350 MOVE CATB-CURSOR TO MAP-UC30-MASS-MAIL-MM-L DTSCS82 -01351 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01352 S1201-EXIT. DTSCS82 -01353 EXIT. DTSCS82 -01354 /*****************************************************************DTSCS82 -01355 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1300 *DTSCS82 -01356 ******************************************************************DTSCS82 -01357 S1300-UC30-FIRST-DEL-DATE. DTSCS82 -01358 MOVE MAP-UC30-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01359 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01360 IF L015-NO-ENTRY DTSCS82 -01361 MOVE WRK-NO-ENTRY TO WRK-UC30-FIRST-DEL-DATE DTSCS82 -01362 ELSE DTSCS82 -01363 IF L015-NOT-VALID DTSCS82 -01364 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01365 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS82 -01366 ELSE DTSCS82 -01367 IF L015-DATE < WRK-YRQ-PLUS1-START-DATE DTSCS82 -01368 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01369 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS82 -01370 ELSE DTSCS82 -01371 IF L015-DATE > WRK-UC30-MASS-MAIL-DATE DTSCS82 -01372 MOVE L015-DATE TO WRK-UC30-FIRST-DEL-DATE DTSCS82 -01373 ELSE DTSCS82 -01374 IF WRK-UC30-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS82 -01375 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01376 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS82 -01377 ELSE DTSCS82 +01323 SKIP3 DTSCS82 +01324 S1101-ERROR. DTSCS82 +01325 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A DTSCS82 +01326 MAP-Q-A. DTSCS82 +01327 IF LCCM-NO-MSG DTSCS82 +01328 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01329 MOVE CATB-CURSOR TO MAP-YR-L DTSCS82 +01330 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01331 S1101-EXIT. DTSCS82 +01332 EXIT. DTSCS82 +01333 EJECT DTSCS82 +01334 S1200-UC30-MASS-MAIL-DATE. DTSCS82 +01335 MOVE MAP-UC30-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01336 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01337 IF L015-NO-ENTRY DTSCS82 +01338 MOVE WRK-NO-ENTRY TO WRK-UC30-MASS-MAIL-DATE DTSCS82 +01339 GO TO S1200-EXIT. DTSCS82 +01340 IF L015-NOT-VALID DTSCS82 +01341 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01342 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS82 +01343 GO TO S1200-EXIT. DTSCS82 +01344 SKIP1 DTSCS82 +01345 IF L015-DATE < WRK-YRQ-START-DATE DTSCS82 +01346 OR L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS82 +01347 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01348 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS82 +01349 ELSE DTSCS82 +01350 MOVE L015-DATE TO WRK-UC30-MASS-MAIL-DATE. DTSCS82 +01351 S1200-EXIT. DTSCS82 +01352 EXIT. DTSCS82 +01353 SKIP3 DTSCS82 +01354 S1201-ERROR. DTSCS82 +01355 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-MASS-MAIL-MM-A DTSCS82 +01356 MAP-UC30-MASS-MAIL-DD-A DTSCS82 +01357 MAP-UC30-MASS-MAIL-YY-A. DTSCS82 +01358 IF LCCM-NO-MSG DTSCS82 +01359 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01360 MOVE CATB-CURSOR TO MAP-UC30-MASS-MAIL-MM-L DTSCS82 +01361 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01362 S1201-EXIT. DTSCS82 +01363 EXIT. DTSCS82 +01364 /*****************************************************************DTSCS82 +01365 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1300 *DTSCS82 +01366 ******************************************************************DTSCS82 +01367 S1300-UC30-FIRST-DEL-DATE. DTSCS82 +01368 MOVE MAP-UC30-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01369 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01370 IF L015-NO-ENTRY DTSCS82 +01371 MOVE WRK-NO-ENTRY TO WRK-UC30-FIRST-DEL-DATE DTSCS82 +01372 ELSE DTSCS82 +01373 IF L015-NOT-VALID DTSCS82 +01374 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01375 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS82 +01376 ELSE DTSCS82 +01377 IF L015-DATE < WRK-YRQ-PLUS1-START-DATE DTSCS82 01378 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01379 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS82 -01380 S1300-EXIT. DTSCS82 -01381 EXIT. DTSCS82 -01382 SKIP3 DTSCS82 -01383 S1301-ERROR. DTSCS82 -01384 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-FIRST-DEL-MM-A DTSCS82 -01385 MAP-UC30-FIRST-DEL-DD-A DTSCS82 -01386 MAP-UC30-FIRST-DEL-YY-A. DTSCS82 -01387 IF LCCM-NO-MSG DTSCS82 -01388 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01389 MOVE CATB-CURSOR TO MAP-UC30-FIRST-DEL-MM-L DTSCS82 -01390 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01391 S1301-EXIT. DTSCS82 -01392 EXIT. DTSCS82 -01393 /*****************************************************************DTSCS82 -01394 * WORK FIELDS MUST BE SET BY S1300 BEFORE PERFORMING S1400 *DTSCS82 -01395 ******************************************************************DTSCS82 -01396 S1400-UC30-FINAL-DEL-DATE. DTSCS82 -01397 MOVE MAP-UC30-FINAL-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01398 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01399 IF L015-NO-ENTRY DTSCS82 -01400 MOVE WRK-NO-ENTRY TO WRK-UC30-FINAL-DEL-DATE DTSCS82 -01401 ELSE DTSCS82 -01402 IF L015-NOT-VALID DTSCS82 -01403 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01404 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS82 -01405 ELSE DTSCS82 -01406 IF L015-DATE > WRK-UC30-FIRST-DEL-DATE DTSCS82 -01407 MOVE L015-DATE TO WRK-UC30-FINAL-DEL-DATE DTSCS82 -01408 ELSE DTSCS82 -01409 IF WRK-UC30-FIRST-DEL-DATE = WRK-NO-ENTRY DTSCS82 -01410 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01411 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS82 -01412 ELSE DTSCS82 +01379 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS82 +01380 ELSE DTSCS82 +01381 IF L015-DATE > WRK-UC30-MASS-MAIL-DATE DTSCS82 +01382 MOVE L015-DATE TO WRK-UC30-FIRST-DEL-DATE DTSCS82 +01383 ELSE DTSCS82 +01384 IF WRK-UC30-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS82 +01385 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 +01386 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS82 +01387 ELSE DTSCS82 +01388 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01389 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS82 +01390 S1300-EXIT. DTSCS82 +01391 EXIT. DTSCS82 +01392 SKIP3 DTSCS82 +01393 S1301-ERROR. DTSCS82 +01394 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-FIRST-DEL-MM-A DTSCS82 +01395 MAP-UC30-FIRST-DEL-DD-A DTSCS82 +01396 MAP-UC30-FIRST-DEL-YY-A. DTSCS82 +01397 IF LCCM-NO-MSG DTSCS82 +01398 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01399 MOVE CATB-CURSOR TO MAP-UC30-FIRST-DEL-MM-L DTSCS82 +01400 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01401 S1301-EXIT. DTSCS82 +01402 EXIT. DTSCS82 +01403 /*****************************************************************DTSCS82 +01404 * WORK FIELDS MUST BE SET BY S1300 BEFORE PERFORMING S1400 *DTSCS82 +01405 ******************************************************************DTSCS82 +01406 S1400-UC30-FINAL-DEL-DATE. DTSCS82 +01407 MOVE MAP-UC30-FINAL-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01408 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01409 IF L015-NO-ENTRY DTSCS82 +01410 MOVE WRK-NO-ENTRY TO WRK-UC30-FINAL-DEL-DATE DTSCS82 +01411 ELSE DTSCS82 +01412 IF L015-NOT-VALID DTSCS82 01413 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01414 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS82 -01415 S1400-EXIT. DTSCS82 -01416 EXIT. DTSCS82 -01417 SKIP3 DTSCS82 -01418 S1401-ERROR. DTSCS82 -01419 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-FINAL-DEL-MM-A DTSCS82 -01420 MAP-UC30-FINAL-DEL-DD-A DTSCS82 -01421 MAP-UC30-FINAL-DEL-YY-A. DTSCS82 -01422 IF LCCM-NO-MSG DTSCS82 -01423 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01424 MOVE CATB-CURSOR TO MAP-UC30-FINAL-DEL-MM-L DTSCS82 -01425 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01426 S1401-EXIT. DTSCS82 -01427 EXIT. DTSCS82 -01428 /*****************************************************************DTSCS82 -01429 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1500 *DTSCS82 -01430 ******************************************************************DTSCS82 -01431 S1500-SELF-INS-TAX-DUE-DATE. DTSCS82 -01432 MOVE MAP-SELF-INS-TAX-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01433 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01434 IF L015-NO-ENTRY DTSCS82 -01435 NEXT SENTENCE DTSCS82 -01436 ELSE DTSCS82 -01437 IF L015-NOT-VALID DTSCS82 -01438 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01439 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS82 -01440 ELSE DTSCS82 -01441 IF WRK-UC30-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS82 -01442 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01443 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS82 -01444 ELSE DTSCS82 -01445 IF L015-DATE < WRK-UC30-MASS-MAIL-DATE DTSCS82 -01446 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01447 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS82 -01448 ELSE DTSCS82 -01449 IF L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS82 -01450 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01451 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS82 -01452 DTSCS82 -01453 IF FQTR-SELF-INS-CHG-RUN-DATE NOT NUMERIC DTSCS82 -01454 MOVE ZERO TO FQTR-SELF-INS-CHG-RUN-DATE DTSCS82 -01455 GO TO S1500-EXIT. DTSCS82 -01456 DTSCS82 -01457 IF FQTR-SELF-INS-CHG-RUN-DATE = ZERO DTSCS82 -01458 GO TO S1500-EXIT. DTSCS82 -01459 DTSCS82 -01460 MOVE FQTR-SELF-INS-CHG-RUN-DATE TO L001-FED-8-DATE-9. DTSCS82 -01461 SET L001-FROM-FED-8 TO TRUE. DTSCS82 -01462 PERFORM S001-DATE THRU S001-EXIT. DTSCS82 -01463 ADD +7 TO L001-JUL-ABS-DAY. DTSCS82 -01464 SET L001-FROM-ABS-DAY TO TRUE. DTSCS82 -01465 PERFORM S001-DATE THRU S001-EXIT. DTSCS82 +01414 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS82 +01415 ELSE DTSCS82 +01416 IF L015-DATE > WRK-UC30-FIRST-DEL-DATE DTSCS82 +01417 MOVE L015-DATE TO WRK-UC30-FINAL-DEL-DATE DTSCS82 +01418 ELSE DTSCS82 +01419 IF WRK-UC30-FIRST-DEL-DATE = WRK-NO-ENTRY DTSCS82 +01420 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 +01421 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS82 +01422 ELSE DTSCS82 +01423 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01424 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS82 +01425 S1400-EXIT. DTSCS82 +01426 EXIT. DTSCS82 +01427 SKIP3 DTSCS82 +01428 S1401-ERROR. DTSCS82 +01429 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-FINAL-DEL-MM-A DTSCS82 +01430 MAP-UC30-FINAL-DEL-DD-A DTSCS82 +01431 MAP-UC30-FINAL-DEL-YY-A. DTSCS82 +01432 IF LCCM-NO-MSG DTSCS82 +01433 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01434 MOVE CATB-CURSOR TO MAP-UC30-FINAL-DEL-MM-L DTSCS82 +01435 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01436 S1401-EXIT. DTSCS82 +01437 EXIT. DTSCS82 +01438 /*****************************************************************DTSCS82 +01439 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1500 *DTSCS82 +01440 ******************************************************************DTSCS82 +01441 S1500-SELF-INS-TAX-DUE-DATE. DTSCS82 +01442 MOVE MAP-SELF-INS-TAX-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01443 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01444 IF L015-NO-ENTRY DTSCS82 +01445 NEXT SENTENCE DTSCS82 +01446 ELSE DTSCS82 +01447 IF L015-NOT-VALID DTSCS82 +01448 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01449 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS82 +01450 ELSE DTSCS82 +01451 IF WRK-UC30-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS82 +01452 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 +01453 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS82 +01454 ELSE DTSCS82 +01455 IF L015-DATE < WRK-UC30-MASS-MAIL-DATE DTSCS82 +01456 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01457 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS82 +01458 ELSE DTSCS82 +01459 IF L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS82 +01460 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01461 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS82 +01462 DTSCS82 +01463 IF FQTR-SELF-INS-CHG-RUN-DATE NOT NUMERIC DTSCS82 +01464 MOVE ZERO TO FQTR-SELF-INS-CHG-RUN-DATE DTSCS82 +01465 GO TO S1500-EXIT. DTSCS82 01466 DTSCS82 -01467 IF L015-DATE < L001-FED-8-DATE-9 DTSCS82 -01468 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01469 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS82 -01470 DTSCS82 -01471 S1500-EXIT. DTSCS82 -01472 EXIT. DTSCS82 -01473 SKIP3 DTSCS82 -01474 S1501-ERROR. DTSCS82 -01475 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELF-INS-TAX-DUE-MM-A DTSCS82 -01476 MAP-SELF-INS-TAX-DUE-DD-A DTSCS82 -01477 MAP-SELF-INS-TAX-DUE-YY-A. DTSCS82 -01478 IF LCCM-NO-MSG DTSCS82 -01479 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01480 MOVE CATB-CURSOR TO MAP-SELF-INS-TAX-DUE-MM-L DTSCS82 -01481 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01482 S1501-EXIT. DTSCS82 -01483 EXIT. DTSCS82 -01484 /*****************************************************************DTSCS82 -01485 * WORK FIELDS MUST BE SET BY S1100 BEFORE PERFORMING S1600 *DTSCS82 -01486 ******************************************************************DTSCS82 -01487 S1600-LATE-PEN-ASSESSED-DATE. DTSCS82 -01488 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01489 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01490 IF L015-NO-ENTRY DTSCS82 -01491 NEXT SENTENCE DTSCS82 -01492 ELSE DTSCS82 -01493 IF L015-NOT-VALID DTSCS82 -01494 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01495 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS82 -01496 ELSE DTSCS82 -01497 IF WRK-DEFAULT-LATE-PEN-DATE NOT = ZERO DTSCS82 -01498 IF L015-DATE < WRK-DEFAULT-LATE-PEN-DATE DTSCS82 -01499 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01500 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS82 -01501 S1600-EXIT. DTSCS82 -01502 EXIT. DTSCS82 -01503 SKIP3 DTSCS82 -01504 S1601-ERROR. DTSCS82 -01505 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LATE-PEN-ASSESSED-MM-ADTSCS82 -01506 MAP-LATE-PEN-ASSESSED-DD-A DTSCS82 -01507 MAP-LATE-PEN-ASSESSED-YY-A. DTSCS82 -01508 IF LCCM-NO-MSG DTSCS82 -01509 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01510 MOVE CATB-CURSOR TO MAP-LATE-PEN-ASSESSED-MM-L DTSCS82 -01511 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01512 S1601-EXIT. DTSCS82 -01513 EXIT. DTSCS82 -01514 ******************************************************************DTSCS82 -01515 S1650-SELF-INS-LATE-PEN-DATE. DTSCS82 -01516 MOVE MAP-DELQ-LTR-SENT-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01517 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01518 IF L015-NO-ENTRY DTSCS82 -01519 MOVE WRK-NO-ENTRY TO WRK-DELQ-LTR-SENT-DATE DTSCS82 -01520 ELSE DTSCS82 -01521 IF L015-NOT-VALID DTSCS82 -01522 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01523 PERFORM S1651-ERROR THRU S1651-EXIT. DTSCS82 -01524 * ELSE DTSCS82 -01525 * IF L015-DATE > WRK-UC30-FINAL-DEL-DATE DTSCS82 -01526 * MOVE L015-DATE TO WRK-INTENT-2-ESTIM-DATE DTSCS82 -01527 * ELSE DTSCS82 -01528 * IF WRK-UC30-FINAL-DEL-DATE = WRK-NO-ENTRY DTSCS82 -01529 * MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01530 * PERFORM S1651-ERROR THRU S1651-EXIT DTSCS82 -01531 * ELSE DTSCS82 -01532 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01533 * PERFORM S1651-ERROR THRU S1651-EXIT. DTSCS82 -01534 S1650-EXIT. DTSCS82 -01535 EXIT. DTSCS82 -01536 SKIP3 DTSCS82 -01537 S1651-ERROR. DTSCS82 -01538 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DELQ-LTR-SENT-MM-A DTSCS82 -01539 MAP-DELQ-LTR-SENT-DD-A DTSCS82 -01540 MAP-DELQ-LTR-SENT-YY-A. DTSCS82 -01541 IF LCCM-NO-MSG DTSCS82 -01542 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01543 MOVE CATB-CURSOR TO MAP-DELQ-LTR-SENT-MM-L DTSCS82 -01544 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01545 S1651-EXIT. DTSCS82 -01546 EXIT. DTSCS82 -01547 DTSCS82 -01548 ******************************************************************DTSCS82 -01549 S1675-UC30-ESTIMATED-DATE. DTSCS82 -01550 MOVE MAP-UC30-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01551 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01552 IF L015-NO-ENTRY DTSCS82 -01553 MOVE WRK-NO-ENTRY TO WRK-UC30-ESTIMATED-DATE DTSCS82 -01554 ELSE DTSCS82 -01555 IF L015-NOT-VALID DTSCS82 -01556 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01557 PERFORM S1676-ERROR THRU S1676-EXIT. DTSCS82 -01558 * ELSE DTSCS82 -01559 * IF L015-DATE > WRK-INTENT-2-ESTIM-DATE DTSCS82 -01560 * MOVE L015-DATE TO WRK-UC30-ESTIMATED-DATE DTSCS82 -01561 * ELSE DTSCS82 -01562 * IF WRK-INTENT-2-ESTIM-DATE = WRK-NO-ENTRY DTSCS82 -01563 * MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01564 * PERFORM S1676-ERROR THRU S1676-EXIT DTSCS82 -01565 * ELSE DTSCS82 -01566 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01567 * PERFORM S1676-ERROR THRU S1676-EXIT. DTSCS82 -01568 S1675-EXIT. DTSCS82 -01569 EXIT. DTSCS82 -01570 SKIP3 DTSCS82 -01571 S1676-ERROR. DTSCS82 -01572 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-ESTIMATED-MM-A DTSCS82 -01573 MAP-UC30-ESTIMATED-DD-A DTSCS82 -01574 MAP-UC30-ESTIMATED-YY-A. DTSCS82 -01575 IF LCCM-NO-MSG DTSCS82 -01576 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01577 MOVE CATB-CURSOR TO MAP-UC30-ESTIMATED-MM-L DTSCS82 -01578 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01579 S1676-EXIT. DTSCS82 -01580 EXIT. DTSCS82 -01581 DTSCS82 -01582 /*****************************************************************DTSCS82 -01583 * WORK FIELDS MUST BE SET BY S1400 BEFORE PERFORMING S1500 *DTSCS82 -01584 ******************************************************************DTSCS82 -01585 S1700-UC30-FINAL-ACTION-DATE. DTSCS82 -01586 MOVE MAP-UC30-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01587 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01588 IF L015-NO-ENTRY DTSCS82 -01589 NEXT SENTENCE DTSCS82 -01590 ELSE DTSCS82 -01591 IF L015-NOT-VALID DTSCS82 -01592 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01593 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS82 -01594 ELSE DTSCS82 -01595 IF L015-DATE > WRK-UC30-FINAL-DEL-DATE DTSCS82 -01596 NEXT SENTENCE DTSCS82 -01597 ELSE DTSCS82 -01598 IF WRK-UC30-FINAL-DEL-DATE = WRK-NO-ENTRY DTSCS82 -01599 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01600 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS82 -01601 ELSE DTSCS82 +01467 IF FQTR-SELF-INS-CHG-RUN-DATE = ZERO DTSCS82 +01468 GO TO S1500-EXIT. DTSCS82 +01469 DTSCS82 +01470 MOVE FQTR-SELF-INS-CHG-RUN-DATE TO L001-FED-8-DATE-9. DTSCS82 +01471 SET L001-FROM-FED-8 TO TRUE. DTSCS82 +01472 PERFORM S001-DATE THRU S001-EXIT. DTSCS82 +01473 ADD +7 TO L001-JUL-ABS-DAY. DTSCS82 +01474 SET L001-FROM-ABS-DAY TO TRUE. DTSCS82 +01475 PERFORM S001-DATE THRU S001-EXIT. DTSCS82 +01476 DTSCS82 +01477 IF L015-DATE < L001-FED-8-DATE-9 DTSCS82 +01478 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01479 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS82 +01480 DTSCS82 +01481 S1500-EXIT. DTSCS82 +01482 EXIT. DTSCS82 +01483 SKIP3 DTSCS82 +01484 S1501-ERROR. DTSCS82 +01485 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELF-INS-TAX-DUE-MM-A DTSCS82 +01486 MAP-SELF-INS-TAX-DUE-DD-A DTSCS82 +01487 MAP-SELF-INS-TAX-DUE-YY-A. DTSCS82 +01488 IF LCCM-NO-MSG DTSCS82 +01489 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01490 MOVE CATB-CURSOR TO MAP-SELF-INS-TAX-DUE-MM-L DTSCS82 +01491 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01492 S1501-EXIT. DTSCS82 +01493 EXIT. DTSCS82 +01494 /*****************************************************************DTSCS82 +01495 * WORK FIELDS MUST BE SET BY S1100 BEFORE PERFORMING S1600 *DTSCS82 +01496 ******************************************************************DTSCS82 +01497 S1600-LATE-PEN-ASSESSED-DATE. DTSCS82 +01498 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01499 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01500 IF L015-NO-ENTRY DTSCS82 +01501 NEXT SENTENCE DTSCS82 +01502 ELSE DTSCS82 +01503 IF L015-NOT-VALID DTSCS82 +01504 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01505 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS82 +01506 ELSE DTSCS82 +01507 IF WRK-DEFAULT-LATE-PEN-DATE NOT = ZERO DTSCS82 +01508 IF L015-DATE < WRK-DEFAULT-LATE-PEN-DATE DTSCS82 +01509 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01510 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS82 +01511 S1600-EXIT. DTSCS82 +01512 EXIT. DTSCS82 +01513 SKIP3 DTSCS82 +01514 S1601-ERROR. DTSCS82 +01515 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LATE-PEN-ASSESSED-MM-ADTSCS82 +01516 MAP-LATE-PEN-ASSESSED-DD-A DTSCS82 +01517 MAP-LATE-PEN-ASSESSED-YY-A. DTSCS82 +01518 IF LCCM-NO-MSG DTSCS82 +01519 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01520 MOVE CATB-CURSOR TO MAP-LATE-PEN-ASSESSED-MM-L DTSCS82 +01521 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01522 S1601-EXIT. DTSCS82 +01523 EXIT. DTSCS82 +01524 ******************************************************************DTSCS82 +01525 S1650-SELF-INS-LATE-PEN-DATE. DTSCS82 +01526 * MOVE MAP-DELQ-LTR-SENT-DATE-AREA TO L015-S-DATE-AREA. CL**9 +01527 * PERFORM S015-DATE-AREA THRU S015-EXIT. CL**9 +01528 * IF L015-NO-ENTRY CL**9 +01529 * MOVE WRK-NO-ENTRY TO WRK-DELQ-LTR-SENT-DATE CL**9 +01530 * ELSE CL**9 +01531 * IF L015-NOT-VALID CL**9 +01532 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID CL**9 +01533 * PERFORM S1651-ERROR THRU S1651-EXIT. CL**9 +01534 * ELSE DTSCS82 +01535 * IF L015-DATE > WRK-UC30-FINAL-DEL-DATE DTSCS82 +01536 * MOVE L015-DATE TO WRK-INTENT-2-ESTIM-DATE DTSCS82 +01537 * ELSE DTSCS82 +01538 * IF WRK-UC30-FINAL-DEL-DATE = WRK-NO-ENTRY DTSCS82 +01539 * MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 +01540 * PERFORM S1651-ERROR THRU S1651-EXIT DTSCS82 +01541 * ELSE DTSCS82 +01542 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01543 * PERFORM S1651-ERROR THRU S1651-EXIT. DTSCS82 +01544 S1650-EXIT. DTSCS82 +01545 EXIT. DTSCS82 +01546 SKIP3 DTSCS82 +01547 S1651-ERROR. DTSCS82 +01548 * MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DELQ-LTR-SENT-MM-A CL**9 +01549 * MAP-DELQ-LTR-SENT-DD-A CL**9 +01550 * MAP-DELQ-LTR-SENT-YY-A. CL**9 +01551 * IF LCCM-NO-MSG CL**9 +01552 * MOVE WRK-MSG-ID TO LCCM-MSG-ID CL**9 +01553 * MOVE CATB-CURSOR TO MAP-DELQ-LTR-SENT-MM-L CL**9 +01554 * SET CURSOR-SET-YES TO TRUE. CL**9 +01555 S1651-EXIT. DTSCS82 +01556 EXIT. DTSCS82 +01557 DTSCS82 +01558 ******************************************************************DTSCS82 +01559 S1675-UC30-ESTIMATED-DATE. DTSCS82 +01560 MOVE MAP-UC30-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01561 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01562 IF L015-NO-ENTRY DTSCS82 +01563 MOVE WRK-NO-ENTRY TO WRK-UC30-ESTIMATED-DATE DTSCS82 +01564 ELSE DTSCS82 +01565 IF L015-NOT-VALID DTSCS82 +01566 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01567 PERFORM S1676-ERROR THRU S1676-EXIT. DTSCS82 +01568 * ELSE DTSCS82 +01569 * IF L015-DATE > WRK-INTENT-2-ESTIM-DATE DTSCS82 +01570 * MOVE L015-DATE TO WRK-UC30-ESTIMATED-DATE DTSCS82 +01571 * ELSE DTSCS82 +01572 * IF WRK-INTENT-2-ESTIM-DATE = WRK-NO-ENTRY DTSCS82 +01573 * MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 +01574 * PERFORM S1676-ERROR THRU S1676-EXIT DTSCS82 +01575 * ELSE DTSCS82 +01576 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01577 * PERFORM S1676-ERROR THRU S1676-EXIT. DTSCS82 +01578 S1675-EXIT. DTSCS82 +01579 EXIT. DTSCS82 +01580 SKIP3 DTSCS82 +01581 S1676-ERROR. DTSCS82 +01582 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-ESTIMATED-MM-A DTSCS82 +01583 MAP-UC30-ESTIMATED-DD-A DTSCS82 +01584 MAP-UC30-ESTIMATED-YY-A. DTSCS82 +01585 IF LCCM-NO-MSG DTSCS82 +01586 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01587 MOVE CATB-CURSOR TO MAP-UC30-ESTIMATED-MM-L DTSCS82 +01588 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01589 S1676-EXIT. DTSCS82 +01590 EXIT. DTSCS82 +01591 DTSCS82 +01592 /*****************************************************************DTSCS82 +01593 * WORK FIELDS MUST BE SET BY S1400 BEFORE PERFORMING S1500 *DTSCS82 +01594 ******************************************************************DTSCS82 +01595 S1700-UC30-FINAL-ACTION-DATE. DTSCS82 +01596 MOVE MAP-UC30-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01597 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01598 IF L015-NO-ENTRY DTSCS82 +01599 NEXT SENTENCE DTSCS82 +01600 ELSE DTSCS82 +01601 IF L015-NOT-VALID DTSCS82 01602 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01603 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS82 -01604 S1700-EXIT. DTSCS82 -01605 EXIT. DTSCS82 -01606 SKIP3 DTSCS82 -01607 S1701-ERROR. DTSCS82 -01608 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-FINAL-ACTION-MM-ADTSCS82 -01609 MAP-UC30-FINAL-ACTION-DD-A DTSCS82 -01610 MAP-UC30-FINAL-ACTION-YY-A. DTSCS82 -01611 IF LCCM-NO-MSG DTSCS82 -01612 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01613 MOVE CATB-CURSOR TO MAP-UC30-FINAL-ACTION-MM-L DTSCS82 -01614 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01615 S1701-EXIT. DTSCS82 -01616 EXIT. DTSCS82 -01617 DTSCS82 -01618 S1800-SELF-INS-CHG-RUN-DATE. DTSCS82 -01619 MOVE MAP-SELF-INS-CHG-RUN-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01620 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01621 IF L015-NO-ENTRY DTSCS82 -01622 MOVE WRK-NO-ENTRY TO WRK-SELF-INS-CHG-RUN-DATE DTSCS82 -01623 GO TO S1800-EXIT DTSCS82 -01624 ELSE DTSCS82 -01625 IF L015-DATE = ZERO DTSCS82 -01626 NEXT SENTENCE DTSCS82 -01627 ELSE DTSCS82 -01628 IF L015-NOT-VALID DTSCS82 -01629 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01630 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS82 -01631 ELSE DTSCS82 -01632 IF L015-DATE < WRK-YRQ-END-DATE DTSCS82 -01633 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01634 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS82 -01635 ELSE DTSCS82 -01636 MOVE L015-DATE TO WRK-SELF-INS-CHG-RUN-DATE. DTSCS82 -01637 DTSCS82 -01638 DTSCS82 -01639 S1800-EXIT. DTSCS82 -01640 EXIT. DTSCS82 -01641 SKIP3 DTSCS82 -01642 S1801-ERROR. DTSCS82 -01643 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELF-INS-CHG-RUN-MM-A DTSCS82 -01644 MAP-SELF-INS-CHG-RUN-DD-A DTSCS82 -01645 MAP-SELF-INS-CHG-RUN-YY-A. DTSCS82 -01646 IF LCCM-NO-MSG DTSCS82 -01647 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01648 MOVE CATB-CURSOR TO MAP-SELF-INS-CHG-RUN-MM-L DTSCS82 -01649 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01650 S1801-EXIT. DTSCS82 -01651 EXIT. DTSCS82 -01652 ******************************************************************DTSCS82 -01653 S1900-SELF-INS-2ND-LTR-DATE. DTSCS82 -01654 MOVE MAP-SELF-INS-2ND-LTR-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 -01655 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 -01656 IF L015-NO-ENTRY DTSCS82 -01657 GO TO S1900-EXIT DTSCS82 -01658 ELSE DTSCS82 -01659 IF L015-NOT-VALID DTSCS82 -01660 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01661 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS82 -01662 ELSE DTSCS82 -01663 IF WRK-SELF-INS-CHG-RUN-DATE = WRK-NO-ENTRY DTSCS82 -01664 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 -01665 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS82 -01666 GO TO S1900-EXIT. DTSCS82 -01667 DTSCS82 -01668 IF FQTR-SELF-INS-TAX-DUE-DATE > +0 DTSCS82 -01669 IF L015-DATE < FQTR-SELF-INS-TAX-DUE-DATE DTSCS82 -01670 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 -01671 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS82 -01672 END-IF DTSCS82 -01673 ELSE DTSCS82 -01674 GO TO S1900-EXIT DTSCS82 -01675 END-IF. DTSCS82 -01676 DTSCS82 -01677 S1900-EXIT. DTSCS82 -01678 EXIT. DTSCS82 -01679 SKIP3 DTSCS82 -01680 S1901-ERROR. DTSCS82 -01681 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELF-INS-2ND-LTR-MM-A DTSCS82 -01682 MAP-SELF-INS-2ND-LTR-DD-A DTSCS82 -01683 MAP-SELF-INS-2ND-LTR-YY-A. DTSCS82 -01684 IF LCCM-NO-MSG DTSCS82 -01685 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 -01686 MOVE CATB-CURSOR TO MAP-SELF-INS-2ND-LTR-MM-L DTSCS82 -01687 SET CURSOR-SET-YES TO TRUE. DTSCS82 -01688 S1901-EXIT. DTSCS82 -01689 EXIT. DTSCS82 -01690 DTSCS82 -01691 ******************************************************************DTSCS82 -01692 /*****************************************************************DTSCS82 -01693 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS82 -01694 ******************************************************************DTSCS82 -01695 S5100-SET-LOCK-ATTRB. DTSCS82 -01696 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS82 -01697 WRK-ATB-NUM. DTSCS82 -01698 SKIP1 DTSCS82 -01699 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS82 -01700 SKIP1 DTSCS82 -01701 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS82 -01702 MAP-Q-A DTSCS82 -01703 MAP-GOTO-A. DTSCS82 -01704 S5100-EXIT. DTSCS82 -01705 EXIT. DTSCS82 -01706 SKIP3 DTSCS82 -01707 ******************************************************************DTSCS82 -01708 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS82 -01709 ******************************************************************DTSCS82 -01710 S5200-SET-UPDATE-ATTRB. DTSCS82 -01711 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS82 -01712 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS82 -01713 SKIP1 DTSCS82 -01714 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS82 -01715 S5200-EXIT. DTSCS82 -01716 EXIT. DTSCS82 -01717 SKIP3 DTSCS82 -01718 ******************************************************************DTSCS82 -01719 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS82 -01720 ******************************************************************DTSCS82 -01721 S5300-SET-INQ-ATTRB. DTSCS82 -01722 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS82 -01723 WRK-ATB-NUM. DTSCS82 -01724 SKIP1 DTSCS82 -01725 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS82 -01726 S5300-EXIT. DTSCS82 -01727 EXIT. DTSCS82 -01728 SKIP3 DTSCS82 -01729 ******************************************************************DTSCS82 -01730 * DO IT *DTSCS82 -01731 ******************************************************************DTSCS82 -01732 S5900-SET-ATTRB. DTSCS82 -01733 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A DTSCS82 -01734 MAP-Q-A. DTSCS82 -01735 SKIP1 DTSCS82 -01736 MOVE WRK-ATB-NUM TO MAP-UC30-MASS-MAIL-MM-A DTSCS82 -01737 MAP-UC30-MASS-MAIL-DD-A DTSCS82 -01738 MAP-UC30-MASS-MAIL-YY-A DTSCS82 -01739 MAP-UC30-FIRST-DEL-MM-A DTSCS82 -01740 MAP-UC30-FIRST-DEL-DD-A DTSCS82 -01741 MAP-UC30-FIRST-DEL-YY-A DTSCS82 -01742 MAP-UC30-FINAL-DEL-MM-A DTSCS82 -01743 MAP-UC30-FINAL-DEL-DD-A DTSCS82 -01744 MAP-UC30-FINAL-DEL-YY-A DTSCS82 -01745 MAP-SELF-INS-2ND-LTR-MM-A DTSCS82 -01746 MAP-SELF-INS-2ND-LTR-DD-A DTSCS82 -01747 MAP-SELF-INS-2ND-LTR-YY-A DTSCS82 -01748 MAP-SELF-INS-TAX-DUE-MM-A DTSCS82 -01749 MAP-SELF-INS-TAX-DUE-DD-A DTSCS82 -01750 MAP-SELF-INS-TAX-DUE-YY-A DTSCS82 -01751 MAP-SELF-INS-CHG-RUN-MM-A DTSCS82 -01752 MAP-SELF-INS-CHG-RUN-DD-A DTSCS82 -01753 MAP-SELF-INS-CHG-RUN-YY-A DTSCS82 -01754 MAP-LATE-PEN-ASSESSED-MM-A DTSCS82 -01755 MAP-LATE-PEN-ASSESSED-DD-A DTSCS82 -01756 MAP-LATE-PEN-ASSESSED-YY-A DTSCS82 -01757 MAP-DELQ-LTR-SENT-MM-A DTSCS82 -01758 MAP-DELQ-LTR-SENT-DD-A DTSCS82 -01759 MAP-DELQ-LTR-SENT-YY-A DTSCS82 -01760 MAP-UC30-ESTIMATED-MM-A DTSCS82 -01761 MAP-UC30-ESTIMATED-DD-A DTSCS82 -01762 MAP-UC30-ESTIMATED-YY-A DTSCS82 -01763 MAP-UC30-FINAL-ACTION-MM-A DTSCS82 -01764 MAP-UC30-FINAL-ACTION-DD-A DTSCS82 -01765 MAP-UC30-FINAL-ACTION-YY-A. DTSCS82 -01766 SKIP1 DTSCS82 -01767 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS82 -01768 MAP-CHNG-DATE-A. DTSCS82 -01769 SKIP1 DTSCS82 -01770 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS82 -01771 S5900-EXIT. DTSCS82 -01772 EXIT. DTSCS82 -01773 /*****************************************************************DTSCS82 -01774 * READ PREPARATION ROUTINES *DTSCS82 -01775 ******************************************************************DTSCS82 -01776 S8010-READ-FQTR. DTSCS82 -01777 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 -01778 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 -01779 IF L016-VALID DTSCS82 -01780 MOVE LOW-VALUES TO FQTR-KEY-AREA DTSCS82 -01781 SET FQTR-QTR-88 TO TRUE DTSCS82 -01782 MOVE L016-YRQ TO FQTR-YRQ DTSCS82 -01783 PERFORM S831-READ THRU S831-EXIT DTSCS82 -01784 ELSE DTSCS82 -01785 GO TO S899-ABEND. DTSCS82 -01786 S8010-EXIT. DTSCS82 -01787 EXIT. DTSCS82 -01788 /*****************************************************************DTSCS82 -01789 * MAP ROUTINES *DTSCS82 -01790 ******************************************************************DTSCS82 -01791 S9100-RECEIVE. DTSCS82 -01792 SET L851-RECEIVE-88 TO TRUE. DTSCS82 -01793 SKIP1 DTSCS82 -01794 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS82 -01795 SKIP1 DTSCS82 -01796 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS82 -01797 SKIP1 DTSCS82 -01798 MOVE L851-AID TO LCCM-AID. DTSCS82 -01799 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS82 -01800 S9100-EXIT. DTSCS82 -01801 EXIT. DTSCS82 -01802 SKIP3 DTSCS82 -01803 S9200-SEND-DATAONLY. DTSCS82 -01804 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 -01805 SKIP1 DTSCS82 -01806 IF LCCM-NO-MSG DTSCS82 -01807 NEXT SENTENCE DTSCS82 -01808 ELSE DTSCS82 -01809 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS82 +01603 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS82 +01604 ELSE DTSCS82 +01605 IF L015-DATE > WRK-UC30-FINAL-DEL-DATE DTSCS82 +01606 NEXT SENTENCE DTSCS82 +01607 ELSE DTSCS82 +01608 IF WRK-UC30-FINAL-DEL-DATE = WRK-NO-ENTRY DTSCS82 +01609 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS82 +01610 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS82 +01611 ELSE DTSCS82 +01612 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01613 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS82 +01614 S1700-EXIT. DTSCS82 +01615 EXIT. DTSCS82 +01616 SKIP3 DTSCS82 +01617 S1701-ERROR. DTSCS82 +01618 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30-FINAL-ACTION-MM-ADTSCS82 +01619 MAP-UC30-FINAL-ACTION-DD-A DTSCS82 +01620 MAP-UC30-FINAL-ACTION-YY-A. DTSCS82 +01621 IF LCCM-NO-MSG DTSCS82 +01622 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01623 MOVE CATB-CURSOR TO MAP-UC30-FINAL-ACTION-MM-L DTSCS82 +01624 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01625 S1701-EXIT. DTSCS82 +01626 EXIT. DTSCS82 +01627 DTSCS82 +01628 S1800-SELF-INS-CHG-RUN-DATE. DTSCS82 +01629 MOVE MAP-SELF-INS-CHG-RUN-DATE-AREA TO L015-S-DATE-AREA. DTSCS82 +01630 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS82 +01631 IF L015-NO-ENTRY DTSCS82 +01632 MOVE WRK-NO-ENTRY TO WRK-SELF-INS-CHG-RUN-DATE DTSCS82 +01633 GO TO S1800-EXIT DTSCS82 +01634 ELSE DTSCS82 +01635 IF L015-DATE = ZERO DTSCS82 +01636 NEXT SENTENCE DTSCS82 +01637 ELSE DTSCS82 +01638 IF L015-NOT-VALID DTSCS82 +01639 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01640 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS82 +01641 ELSE DTSCS82 +01642 IF L015-DATE < WRK-YRQ-END-DATE DTSCS82 +01643 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS82 +01644 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS82 +01645 ELSE DTSCS82 +01646 MOVE L015-DATE TO WRK-SELF-INS-CHG-RUN-DATE. DTSCS82 +01647 DTSCS82 +01648 DTSCS82 +01649 S1800-EXIT. DTSCS82 +01650 EXIT. DTSCS82 +01651 SKIP3 DTSCS82 +01652 S1801-ERROR. DTSCS82 +01653 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELF-INS-CHG-RUN-MM-A DTSCS82 +01654 MAP-SELF-INS-CHG-RUN-DD-A DTSCS82 +01655 MAP-SELF-INS-CHG-RUN-YY-A. DTSCS82 +01656 IF LCCM-NO-MSG DTSCS82 +01657 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS82 +01658 MOVE CATB-CURSOR TO MAP-SELF-INS-CHG-RUN-MM-L DTSCS82 +01659 SET CURSOR-SET-YES TO TRUE. DTSCS82 +01660 S1801-EXIT. DTSCS82 +01661 EXIT. DTSCS82 +01662 ******************************************************************DTSCS82 +01663 S1900-SELF-INS-2ND-LTR-DATE. DTSCS82 +01664 * MOVE MAP-SELF-INS-2ND-LTR-DATE-AREA TO L015-S-DATE-AREA. CL*11 +01665 * PERFORM S015-DATE-AREA THRU S015-EXIT. CL*11 +01666 * IF L015-NO-ENTRY CL*11 +01667 * GO TO S1900-EXIT CL*11 +01668 * ELSE CL*11 +01669 * IF L015-NOT-VALID CL*11 +01670 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID CL*11 +01671 * PERFORM S1901-ERROR THRU S1901-EXIT CL*11 +01672 * ELSE CL*11 +01673 * IF WRK-SELF-INS-CHG-RUN-DATE = WRK-NO-ENTRY CL*11 +01674 * MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID CL*11 +01675 * PERFORM S1901-ERROR THRU S1901-EXIT CL*11 +01676 * GO TO S1900-EXIT. CL*11 +01677 DTSCS82 +01678 * IF FQTR-SELF-INS-TAX-DUE-DATE > +0 CL*11 +01679 * IF L015-DATE < FQTR-SELF-INS-TAX-DUE-DATE CL*11 +01680 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID CL*11 +01681 * PERFORM S1901-ERROR THRU S1901-EXIT CL*11 +01682 * END-IF CL*11 +01683 * ELSE CL*11 +01684 * GO TO S1900-EXIT CL*11 +01685 * END-IF. CL*11 +01686 DTSCS82 +01687 S1900-EXIT. DTSCS82 +01688 EXIT. DTSCS82 +01689 SKIP3 DTSCS82 +01690 S1901-ERROR. DTSCS82 +01691 * MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SELF-INS-2ND-LTR-MM-A CL*10 +01692 * MAP-SELF-INS-2ND-LTR-DD-A CL*10 +01693 * MAP-SELF-INS-2ND-LTR-YY-A. CL*10 +01694 * IF LCCM-NO-MSG CL*10 +01695 * MOVE WRK-MSG-ID TO LCCM-MSG-ID CL*10 +01696 * MOVE CATB-CURSOR TO MAP-SELF-INS-2ND-LTR-MM-L CL*10 +01697 * SET CURSOR-SET-YES TO TRUE. CL*10 +01698 S1901-EXIT. DTSCS82 +01699 EXIT. DTSCS82 +01700 DTSCS82 +01701 ******************************************************************DTSCS82 +01702 /*****************************************************************DTSCS82 +01703 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS82 +01704 ******************************************************************DTSCS82 +01705 S5100-SET-LOCK-ATTRB. DTSCS82 +01706 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS82 +01707 WRK-ATB-NUM. DTSCS82 +01708 SKIP1 DTSCS82 +01709 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS82 +01710 SKIP1 DTSCS82 +01711 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS82 +01712 MAP-Q-A DTSCS82 +01713 MAP-GOTO-A. DTSCS82 +01714 S5100-EXIT. DTSCS82 +01715 EXIT. DTSCS82 +01716 SKIP3 DTSCS82 +01717 ******************************************************************DTSCS82 +01718 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS82 +01719 ******************************************************************DTSCS82 +01720 S5200-SET-UPDATE-ATTRB. DTSCS82 +01721 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS82 +01722 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS82 +01723 SKIP1 DTSCS82 +01724 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS82 +01725 S5200-EXIT. DTSCS82 +01726 EXIT. DTSCS82 +01727 SKIP3 DTSCS82 +01728 ******************************************************************DTSCS82 +01729 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS82 +01730 ******************************************************************DTSCS82 +01731 S5300-SET-INQ-ATTRB. DTSCS82 +01732 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS82 +01733 WRK-ATB-NUM. DTSCS82 +01734 SKIP1 DTSCS82 +01735 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS82 +01736 S5300-EXIT. DTSCS82 +01737 EXIT. DTSCS82 +01738 SKIP3 DTSCS82 +01739 ******************************************************************DTSCS82 +01740 * DO IT *DTSCS82 +01741 ******************************************************************DTSCS82 +01742 S5900-SET-ATTRB. DTSCS82 +01743 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A DTSCS82 +01744 MAP-Q-A. DTSCS82 +01745 SKIP1 DTSCS82 +01746 MOVE WRK-ATB-NUM TO MAP-UC30-MASS-MAIL-MM-A DTSCS82 +01747 MAP-UC30-MASS-MAIL-DD-A DTSCS82 +01748 MAP-UC30-MASS-MAIL-YY-A DTSCS82 +01749 MAP-UC30-FIRST-DEL-MM-A DTSCS82 +01750 MAP-UC30-FIRST-DEL-DD-A DTSCS82 +01751 MAP-UC30-FIRST-DEL-YY-A DTSCS82 +01752 MAP-UC30-FINAL-DEL-MM-A DTSCS82 +01753 MAP-UC30-FINAL-DEL-DD-A DTSCS82 +01754 MAP-UC30-FINAL-DEL-YY-A DTSCS82 +01755 * MAP-SELF-INS-2ND-LTR-MM-A CL**9 +01756 * MAP-SELF-INS-2ND-LTR-DD-A CL**9 +01757 * MAP-SELF-INS-2ND-LTR-YY-A CL**9 +01758 MAP-MONTHLY-SOA-RUN-MM-A CL**9 +01759 MAP-MONTHLY-SOA-RUN-DD-A CL**9 +01760 MAP-MONTHLY-SOA-RUN-YY-A CL**9 +01761 MAP-SELF-INS-TAX-DUE-MM-A DTSCS82 +01762 MAP-SELF-INS-TAX-DUE-DD-A DTSCS82 +01763 MAP-SELF-INS-TAX-DUE-YY-A DTSCS82 +01764 MAP-SELF-INS-CHG-RUN-MM-A DTSCS82 +01765 MAP-SELF-INS-CHG-RUN-DD-A DTSCS82 +01766 MAP-SELF-INS-CHG-RUN-YY-A DTSCS82 +01767 MAP-LATE-PEN-ASSESSED-MM-A DTSCS82 +01768 MAP-LATE-PEN-ASSESSED-DD-A DTSCS82 +01769 MAP-LATE-PEN-ASSESSED-YY-A DTSCS82 +01770 * MAP-DELQ-LTR-SENT-MM-A CL**9 +01771 * MAP-DELQ-LTR-SENT-DD-A CL**9 +01772 * MAP-DELQ-LTR-SENT-YY-A CL**9 +01773 MAP-UC30-ESTIMATED-MM-A DTSCS82 +01774 MAP-UC30-ESTIMATED-DD-A DTSCS82 +01775 MAP-UC30-ESTIMATED-YY-A DTSCS82 +01776 MAP-UC30-FINAL-ACTION-MM-A DTSCS82 +01777 MAP-UC30-FINAL-ACTION-DD-A DTSCS82 +01778 MAP-UC30-FINAL-ACTION-YY-A. DTSCS82 +01779 SKIP1 DTSCS82 +01780 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS82 +01781 MAP-CHNG-DATE-A. DTSCS82 +01782 SKIP1 DTSCS82 +01783 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS82 +01784 S5900-EXIT. DTSCS82 +01785 EXIT. DTSCS82 +01786 /*****************************************************************DTSCS82 +01787 * READ PREPARATION ROUTINES *DTSCS82 +01788 ******************************************************************DTSCS82 +01789 S8010-READ-FQTR. DTSCS82 +01790 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS82 +01791 PERFORM S016-CHECK-MAP-YR-Q THRU S016-EXIT. DTSCS82 +01792 IF L016-VALID DTSCS82 +01793 MOVE LOW-VALUES TO FQTR-KEY-AREA DTSCS82 +01794 SET FQTR-QTR-88 TO TRUE DTSCS82 +01795 MOVE L016-YRQ TO FQTR-YRQ DTSCS82 +01796 PERFORM S831-READ THRU S831-EXIT DTSCS82 +01797 ELSE DTSCS82 +01798 GO TO S899-ABEND. DTSCS82 +01799 S8010-EXIT. DTSCS82 +01800 EXIT. DTSCS82 +01801 /*****************************************************************DTSCS82 +01802 * MAP ROUTINES *DTSCS82 +01803 ******************************************************************DTSCS82 +01804 S9100-RECEIVE. DTSCS82 +01805 SET L851-RECEIVE-88 TO TRUE. DTSCS82 +01806 SKIP1 DTSCS82 +01807 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS82 +01808 SKIP1 DTSCS82 +01809 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS82 01810 SKIP1 DTSCS82 -01811 IF CURSOR-SET-GOTO DTSCS82 -01812 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS82 -01813 ELSE DTSCS82 -01814 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS82 -01815 SKIP1 DTSCS82 -01816 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS82 -01817 SKIP1 DTSCS82 -01818 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS82 -01819 SKIP1 DTSCS82 -01820 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS82 -01821 S9200-EXIT. DTSCS82 -01822 EXIT. DTSCS82 -01823 SKIP3 DTSCS82 -01824 S9300-SEND-MAP. DTSCS82 -01825 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS82 -01826 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS82 -01827 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS82 +01811 MOVE L851-AID TO LCCM-AID. DTSCS82 +01812 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS82 +01813 S9100-EXIT. DTSCS82 +01814 EXIT. DTSCS82 +01815 SKIP3 DTSCS82 +01816 S9200-SEND-DATAONLY. DTSCS82 +01817 MOVE LOW-VALUES TO MAP-AREA. DTSCS82 +01818 SKIP1 DTSCS82 +01819 IF LCCM-NO-MSG DTSCS82 +01820 NEXT SENTENCE DTSCS82 +01821 ELSE DTSCS82 +01822 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS82 +01823 SKIP1 DTSCS82 +01824 IF CURSOR-SET-GOTO DTSCS82 +01825 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS82 +01826 ELSE DTSCS82 +01827 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS82 01828 SKIP1 DTSCS82 -01829 IF SCR-ACCESS-UPDATE DTSCS82 -01830 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS82 -01831 ELSE DTSCS82 -01832 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS82 -01833 SKIP1 DTSCS82 -01834 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS82 -01835 SKIP1 DTSCS82 -01836 IF CURSOR-SET-NO DTSCS82 -01837 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS82 -01838 SKIP1 DTSCS82 -01839 SET L851-SEND-88 TO TRUE. DTSCS82 -01840 SKIP1 DTSCS82 -01841 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS82 -01842 SKIP1 DTSCS82 -01843 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS82 -01844 S9300-EXIT. DTSCS82 -01845 EXIT. DTSCS82 -01846 SKIP3 DTSCS82 -01847 S9310-UPDATE-FKEYS. DTSCS82 -01848 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS82 -01849 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS82 -01850 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS82 -01851 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS82 -01852 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS82 +01829 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS82 +01830 SKIP1 DTSCS82 +01831 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS82 +01832 SKIP1 DTSCS82 +01833 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS82 +01834 S9200-EXIT. DTSCS82 +01835 EXIT. DTSCS82 +01836 SKIP3 DTSCS82 +01837 S9300-SEND-MAP. DTSCS82 +01838 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS82 +01839 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS82 +01840 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS82 +01841 SKIP1 DTSCS82 +01842 IF SCR-ACCESS-UPDATE DTSCS82 +01843 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS82 +01844 ELSE DTSCS82 +01845 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS82 +01846 SKIP1 DTSCS82 +01847 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS82 +01848 SKIP1 DTSCS82 +01849 IF CURSOR-SET-NO DTSCS82 +01850 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS82 +01851 SKIP1 DTSCS82 +01852 SET L851-SEND-88 TO TRUE. DTSCS82 01853 SKIP1 DTSCS82 -01854 IF LCCM-SCR-CLEAR DTSCS82 -01855 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS82 -01856 MAP-KEY-DEL DTSCS82 -01857 ELSE DTSCS82 -01858 IF LCCM-SCR-UPDATE-LOCKED DTSCS82 -01859 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS82 -01860 MAP-KEY-FWRD DTSCS82 -01861 MAP-KEY-ADD DTSCS82 -01862 MAP-KEY-MOD DTSCS82 -01863 MAP-KEY-DEL DTSCS82 -01864 ELSE DTSCS82 -01865 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS82 -01866 S9310-EXIT. DTSCS82 -01867 EXIT. DTSCS82 -01868 SKIP3 DTSCS82 -01869 S9320-INQUIRY-FKEYS. DTSCS82 -01870 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS82 -01871 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS82 -01872 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS82 -01873 MAP-KEY-MOD DTSCS82 -01874 MAP-KEY-DEL. DTSCS82 -01875 S9320-EXIT. DTSCS82 -01876 EXIT. DTSCS82 -01877 SKIP3 DTSCS82 -01878 S9900-PREPARE-SEND. DTSCS82 -01879 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS82 -01880 LCCM-SCR-ID. DTSCS82 -01881 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS82 -01882 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS82 -01883 S9900-EXIT. DTSCS82 -01884 EXIT. DTSCS82 +01854 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS82 +01855 SKIP1 DTSCS82 +01856 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS82 +01857 S9300-EXIT. DTSCS82 +01858 EXIT. DTSCS82 +01859 SKIP3 DTSCS82 +01860 S9310-UPDATE-FKEYS. DTSCS82 +01861 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS82 +01862 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS82 +01863 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS82 +01864 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS82 +01865 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS82 +01866 SKIP1 DTSCS82 +01867 IF LCCM-SCR-CLEAR DTSCS82 +01868 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS82 +01869 MAP-KEY-DEL DTSCS82 +01870 ELSE DTSCS82 +01871 IF LCCM-SCR-UPDATE-LOCKED DTSCS82 +01872 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS82 +01873 MAP-KEY-FWRD DTSCS82 +01874 MAP-KEY-ADD DTSCS82 +01875 MAP-KEY-MOD DTSCS82 +01876 MAP-KEY-DEL DTSCS82 +01877 ELSE DTSCS82 +01878 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS82 +01879 S9310-EXIT. DTSCS82 +01880 EXIT. DTSCS82 +01881 SKIP3 DTSCS82 +01882 S9320-INQUIRY-FKEYS. DTSCS82 +01883 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS82 +01884 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS82 +01885 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS82 +01886 MAP-KEY-MOD DTSCS82 +01887 MAP-KEY-DEL. DTSCS82 +01888 S9320-EXIT. DTSCS82 +01889 EXIT. DTSCS82 +01890 SKIP3 DTSCS82 +01891 S9900-PREPARE-SEND. DTSCS82 +01892 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS82 +01893 LCCM-SCR-ID. DTSCS82 +01894 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS82 +01895 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS82 +01896 S9900-EXIT. DTSCS82 +01897 EXIT. DTSCS82 diff --git a/CICS/DTSCS89.cob b/CICS/DTSCS89.cob index 91a6839..59c1b5c 100644 --- a/CICS/DTSCS89.cob +++ b/CICS/DTSCS89.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 11/11/02 +00001 IDENTIFICATION DIVISION. 04/09/13 00002 PROGRAM-ID. DTSCS89. DTSCS89 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV001 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002 00004 DATE-WRITTEN. APRIL 2002. DTSCS89 00005 DATE-COMPILED. DTSCS89 00006 SKIP3 DTSCS89 @@ -16,1676 +16,1681 @@ 00016 * WORK ORDER: PROGRAMMER: Z1L DTSCS89 00017 * DTSCS89 00018 * DTSCS89 -00019 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS89 -00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS89 -00021 * REFERENCE: PROGRAMMER: XXX DTSCS89 -00022 * DTSCS89 -00023 * DTSCS89 -00024 * DESCRIPTION: DTSCS89 -00025 * DTSCS89 -00026 * CLEAR: DTSCS89 +00019 * 04/10/2013 MODIFIED TO CHANGE FINAL DATE TO ESTIMATED DATE. CL**2 +00020 * WORK ORDER: PROGRAMMER: Z1L CL**2 +00021 * CL**2 +00022 * CL**2 +00023 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS89 +00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS89 +00025 * REFERENCE: PROGRAMMER: XXX DTSCS89 +00026 * DTSCS89 00027 * DTSCS89 -00028 * DATA FIELDS DISPLAYED: NONE. DTSCS89 -00029 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS89 -00030 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89 +00028 * DESCRIPTION: DTSCS89 +00029 * DTSCS89 +00030 * CLEAR: DTSCS89 00031 * DTSCS89 -00032 * DTSCS89 -00033 * INQUIRY: DTSCS89 -00034 * DTSCS89 -00035 * CONTROL FIELD(S): MAP-YR, MAP-Q. DTSCS89 +00032 * DATA FIELDS DISPLAYED: NONE. DTSCS89 +00033 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS89 +00034 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89 +00035 * DTSCS89 00036 * DTSCS89 -00037 * JUMP IN: USE CLEAR LOGIC. DTSCS89 +00037 * INQUIRY: DTSCS89 00038 * DTSCS89 -00039 * ENTER: DISPLAY FAFD RECORD ASSOCIATED WITH MAP-YR DTSCS89 +00039 * CONTROL FIELD(S): MAP-YR, MAP-Q. DTSCS89 00040 * DTSCS89 -00041 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS89 -00042 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS89 -00043 * DTSCS89 -00044 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS89 -00045 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS89 -00046 * DTSCS89 -00047 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS89 -00048 * DO NOT "WRAP" PAGING. DTSCS89 -00049 * DTSCS89 -00050 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS89 -00051 * FAFD-KEY-AREA OF THE DISPLAYED FAFD RECORD IN DTSCS89 -00052 * LCCM-SCR-KEY-AREA. DTSCS89 +00041 * JUMP IN: USE CLEAR LOGIC. DTSCS89 +00042 * DTSCS89 +00043 * ENTER: DISPLAY FAFD RECORD ASSOCIATED WITH MAP-YR DTSCS89 +00044 * DTSCS89 +00045 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS89 +00046 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS89 +00047 * DTSCS89 +00048 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS89 +00049 * MODIFICATION TO MAP-YR (RATHER THAN EMP-NO). DTSCS89 +00050 * DTSCS89 +00051 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS89 +00052 * DO NOT "WRAP" PAGING. DTSCS89 00053 * DTSCS89 -00054 * DTSCS89 -00055 * UPDATE: DTSCS89 -00056 * DTSCS89 -00057 * ADD DTSCS89 -00058 * MOD DTSCS89 -00059 * DEL DTSCS89 +00054 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS89 +00055 * FAFD-KEY-AREA OF THE DISPLAYED FAFD RECORD IN DTSCS89 +00056 * LCCM-SCR-KEY-AREA. DTSCS89 +00057 * DTSCS89 +00058 * DTSCS89 +00059 * UPDATE: DTSCS89 00060 * DTSCS89 -00061 * DTSCS89 -00062 * RECORDS READ: DTSCS89 -00063 * DTSCS89 -00064 * MASTER: DTSCS89 +00061 * ADD DTSCS89 +00062 * MOD DTSCS89 +00063 * DEL DTSCS89 +00064 * DTSCS89 00065 * DTSCS89 -00066 * NONE. DTSCS89 +00066 * RECORDS READ: DTSCS89 00067 * DTSCS89 -00068 * DTSCS89 -00069 * ALTERNATE INDEX: DTSCS89 -00070 * DTSCS89 -00071 * NONE. DTSCS89 +00068 * MASTER: DTSCS89 +00069 * DTSCS89 +00070 * NONE. DTSCS89 +00071 * DTSCS89 00072 * DTSCS89 -00073 * DTSCS89 -00074 * REFERENCE: DTSCS89 -00075 * DTSCS89 -00076 * FAFD. DTSCS89 +00073 * ALTERNATE INDEX: DTSCS89 +00074 * DTSCS89 +00075 * NONE. DTSCS89 +00076 * DTSCS89 00077 * DTSCS89 -00078 * DTSCS89 -00079 * ACCOUNTING TRANSACTION COLLECTION: DTSCS89 -00080 * DTSCS89 -00081 * NONE. DTSCS89 +00078 * REFERENCE: DTSCS89 +00079 * DTSCS89 +00080 * FAFD. DTSCS89 +00081 * DTSCS89 00082 * DTSCS89 -00083 * DTSCS89 -00084 * RECORDS UPDATED: DTSCS89 -00085 * DTSCS89 -00086 * MASTER: DTSCS89 +00083 * ACCOUNTING TRANSACTION COLLECTION: DTSCS89 +00084 * DTSCS89 +00085 * NONE. DTSCS89 +00086 * DTSCS89 00087 * DTSCS89 -00088 * NONE. DTSCS89 +00088 * RECORDS UPDATED: DTSCS89 00089 * DTSCS89 -00090 * DTSCS89 -00091 * REFERENCE: DTSCS89 -00092 * DTSCS89 -00093 * FAFD (ADD, MOD, DEL). DTSCS89 +00090 * MASTER: DTSCS89 +00091 * DTSCS89 +00092 * NONE. DTSCS89 +00093 * DTSCS89 00094 * DTSCS89 -00095 * DTSCS89 -00096 * ACCOUNTING TRANSACTION COLLECTION: DTSCS89 -00097 * DTSCS89 -00098 * NONE. DTSCS89 +00095 * REFERENCE: DTSCS89 +00096 * DTSCS89 +00097 * FAFD (ADD, MOD, DEL). DTSCS89 +00098 * DTSCS89 00099 * DTSCS89 -00100 * DTSCS89 -00101 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS89 -00102 * DTSCS89 -00103 * NONE. DTSCS89 +00100 * ACCOUNTING TRANSACTION COLLECTION: DTSCS89 +00101 * DTSCS89 +00102 * NONE. DTSCS89 +00103 * DTSCS89 00104 * DTSCS89 -00105 * DTSCS89 -00106 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS89 -00107 * UTILITY MODULES) LINKED TO: DTSCS89 +00105 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS89 +00106 * DTSCS89 +00107 * NONE. DTSCS89 00108 * DTSCS89 -00109 * DTSCU001 DATE EDIT/CONVERSION. DTSCS89 -00110 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS89 -00111 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS89 -00112 * DTSCU016 QUARTER FROM SCREEN FORMAT/EDIT. DTSCS89 -00113 * DTSCU831 REFERENCE FILE I/O. DTSCS89 -00114 * DTSCS89 -00115 * DTSCS89 -00116 * MAINTENANCE NOTES: DTSCS89 -00117 * DTSCS89 -00118 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS89 -00119 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS89 -00120 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS89 -00121 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS89 -00122 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS89), DTSCS89 -00123 * ALTER THE MAP (DTDM89) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS89 -00124 * DTSCS89 -00125 ***** DTSCS89 -00126 SKIP3 DTSCS89 -00127 ENVIRONMENT DIVISION. DTSCS89 -00128 SKIP3 DTSCS89 -00129 DATA DIVISION. DTSCS89 +00109 * DTSCS89 +00110 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS89 +00111 * UTILITY MODULES) LINKED TO: DTSCS89 +00112 * DTSCS89 +00113 * DTSCU001 DATE EDIT/CONVERSION. DTSCS89 +00114 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS89 +00115 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS89 +00116 * DTSCU016 QUARTER FROM SCREEN FORMAT/EDIT. DTSCS89 +00117 * DTSCU831 REFERENCE FILE I/O. DTSCS89 +00118 * DTSCS89 +00119 * DTSCS89 +00120 * MAINTENANCE NOTES: DTSCS89 +00121 * DTSCS89 +00122 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS89 +00123 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS89 +00124 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS89 +00125 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS89 +00126 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS89), DTSCS89 +00127 * ALTER THE MAP (DTDM89) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS89 +00128 * DTSCS89 +00129 ***** DTSCS89 00130 SKIP3 DTSCS89 -00131 WORKING-STORAGE SECTION. DTSCS89 -001315 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS89 11/11/02'. DTSCS89 +00131 ENVIRONMENT DIVISION. DTSCS89 00132 SKIP3 DTSCS89 -00133 01 WRK-AREA. DTSCS89 -00134 05 WRK-ABEND-CD PIC X(04) VALUE 'S89 '. DTSCS89 -00135 SKIP1 DTSCS89 -00136 05 WRK-SCR-ID. DTSCS89 -00137 10 WRK-SCR-ID-9 PIC 9(02) VALUE 89. DTSCS89 -00138 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS89 -00139 SKIP1 DTSCS89 -00140 05 WRK-KEY-AREA. DTSCS89 -00141 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS89 -00142 10 WRK-YR PIC S9(05) COMP-3. DTSCS89 -00143 10 FILLER PIC X(11). DTSCS89 +00133 DATA DIVISION. DTSCS89 +00134 SKIP3 DTSCS89 +00135 WORKING-STORAGE SECTION. DTSCS89 +001355 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS89 04/09/13'. DTSCS89 +00136 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS89 11/11/02'. DTSCS89 +00137 SKIP3 DTSCS89 +00138 01 WRK-AREA. DTSCS89 +00139 05 WRK-ABEND-CD PIC X(04) VALUE 'S89 '. DTSCS89 +00140 SKIP1 DTSCS89 +00141 05 WRK-SCR-ID. DTSCS89 +00142 10 WRK-SCR-ID-9 PIC 9(02) VALUE 89. DTSCS89 +00143 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS89 00144 SKIP1 DTSCS89 -00145 05 WRK-DISP-DATE PIC 9(08). DTSCS89 -00146 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS89 -00147 10 WRK-DISP-CC PIC X(02). DTSCS89 -00148 10 WRK-DISP-YY PIC X(02). DTSCS89 -00149 10 WRK-DISP-MM PIC X(02). DTSCS89 -00150 10 WRK-DISP-DD PIC X(02). DTSCS89 -00151 SKIP1 DTSCS89 -00152 05 WRK-NO-ENTRY PIC S9(09) COMP-3 DTSCS89 -00153 VALUE +999999999. DTSCS89 -00154 05 WRK-UC30H-FINAL-ACT-DATE PIC S9(09) COMP-3. DTSCS89 -00155 05 WRK-UC30H-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCS89 -00156 05 WRK-UC30H-RPT-DUE-DATE PIC S9(09) COMP-3. DTSCS89 -00157 05 WRK-UC30H-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCS89 -00158 05 WRK-UC30H-FINAL-DEL-DATE PIC S9(09) COMP-3. DTSCS89 -00159 05 WRK-YRQ-START-DATE PIC S9(09) COMP-3. DTSCS89 -00160 05 WRK-ANN-START-YR PIC S9(02) VALUE +01. DTSCS89 -00161 05 WRK-YRQ-END-DATE PIC S9(09) COMP-3. DTSCS89 -00162 05 WRK-UC30H-PLUS1-1ST-DEL-DATE PIC S9(09) COMP-3. DTSCS89 -00163 05 WRK-UC30H-PLUS1-RPT-DUE-DATE PIC S9(09) COMP-3. DTSCS89 -00164 05 WRK-YRQ-PLUS1-START-DATE PIC S9(09) COMP-3. DTSCS89 -00165 05 WRK-YRQ-PLUS1-END-DATE PIC S9(09) COMP-3. DTSCS89 -00166 05 WRK-UC30H-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCS89 -00167 EJECT DTSCS89 -00168 01 SCREEN-PROCESSING. DTSCS89 -00169 05 SCR-ACCESS-IND PIC X(01). DTSCS89 -00170 88 SCR-ACCESS-INQ VALUE '1'. DTSCS89 -00171 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS89 -00172 SKIP1 DTSCS89 -00173 05 CURSOR-SET-IND PIC X(01). DTSCS89 -00174 88 CURSOR-SET-YES VALUE 'Y'. DTSCS89 -00175 88 CURSOR-SET-NO VALUE 'N'. DTSCS89 -00176 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS89 +00145 05 WRK-KEY-AREA. DTSCS89 +00146 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS89 +00147 10 WRK-YR PIC S9(05) COMP-3. DTSCS89 +00148 10 FILLER PIC X(11). DTSCS89 +00149 SKIP1 DTSCS89 +00150 05 WRK-DISP-DATE PIC 9(08). DTSCS89 +00151 05 FILLER REDEFINES WRK-DISP-DATE. DTSCS89 +00152 10 WRK-DISP-CC PIC X(02). DTSCS89 +00153 10 WRK-DISP-YY PIC X(02). DTSCS89 +00154 10 WRK-DISP-MM PIC X(02). DTSCS89 +00155 10 WRK-DISP-DD PIC X(02). DTSCS89 +00156 SKIP1 DTSCS89 +00157 05 WRK-NO-ENTRY PIC S9(09) COMP-3 DTSCS89 +00158 VALUE +999999999. DTSCS89 +00159 05 WRK-UC30H-FINAL-ACT-DATE PIC S9(09) COMP-3. DTSCS89 +00160 05 WRK-UC30H-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCS89 +00161 05 WRK-UC30H-RPT-DUE-DATE PIC S9(09) COMP-3. DTSCS89 +00162 05 WRK-UC30H-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCS89 +00163 05 WRK-UC30H-ESTIMATED-DATE PIC S9(09) COMP-3. CL**2 +00164 05 WRK-YRQ-START-DATE PIC S9(09) COMP-3. DTSCS89 +00165 05 WRK-ANN-START-YR PIC S9(02) VALUE +01. DTSCS89 +00166 05 WRK-YRQ-END-DATE PIC S9(09) COMP-3. DTSCS89 +00167 05 WRK-UC30H-PLUS1-1ST-DEL-DATE PIC S9(09) COMP-3. DTSCS89 +00168 05 WRK-UC30H-PLUS1-RPT-DUE-DATE PIC S9(09) COMP-3. DTSCS89 +00169 05 WRK-YRQ-PLUS1-START-DATE PIC S9(09) COMP-3. DTSCS89 +00170 05 WRK-YRQ-PLUS1-END-DATE PIC S9(09) COMP-3. DTSCS89 +00171 05 WRK-UC30H-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCS89 +00172 EJECT DTSCS89 +00173 01 SCREEN-PROCESSING. DTSCS89 +00174 05 SCR-ACCESS-IND PIC X(01). DTSCS89 +00175 88 SCR-ACCESS-INQ VALUE '1'. DTSCS89 +00176 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS89 00177 SKIP1 DTSCS89 -00178 05 REQ-IND PIC X(01). DTSCS89 -00179 88 REQ-ERROR VALUE 'O'. DTSCS89 -00180 88 REQ-JUMP VALUE 'J'. DTSCS89 -00181 88 REQ-INQUIRE VALUE 'I'. DTSCS89 -00182 88 REQ-CLEAR VALUE 'C'. DTSCS89 -00183 88 REQ-EDIT VALUE 'E'. DTSCS89 -00184 88 REQ-UPDATE VALUE 'U'. DTSCS89 -00185 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS89 -00186 SKIP1 DTSCS89 -00187 05 RESP-IND PIC X(01). DTSCS89 -00188 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS89 -00189 88 RESP-SEND-MAP VALUE 'M'. DTSCS89 -00190 88 RESP-JUMP VALUE 'J'. DTSCS89 -00191 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS89 -00192 SKIP1 DTSCS89 -00193 05 WRK-NEW-KEY-IND PIC X(01). DTSCS89 -00194 SKIP1 DTSCS89 -00195 05 WRK-MSG-ID PIC X(04). DTSCS89 -00196 SKIP1 DTSCS89 -00197 05 WRK-ATB-AN PIC X(01). DTSCS89 -00198 05 WRK-ATB-NUM PIC X(01). DTSCS89 -00199 EJECT DTSCS89 -00200 01 L001-COMM-AREA. DTSCS89 -00201 ++INCLUDE DTSIL001 DTSCS89 -00202 EJECT DTSCS89 -00203 01 L004-COMM-AREA. DTSCS89 -00204 ++INCLUDE DTSIL004 DTSCS89 -00205 EJECT DTSCS89 -00206 01 L015-COMM-AREA. DTSCS89 -00207 ++INCLUDE DTSIL015 DTSCS89 -00208 EJECT DTSCS89 -00209 01 L007-COMM-AREA. DTSCS89 -00210 ++INCLUDE DTSIL007 DTSCS89 -00211 EJECT DTSCS89 -00212 01 L016-COMM-AREA. DTSCS89 -00213 ++INCLUDE DTSIL016 DTSCS89 -00214 EJECT DTSCS89 -00215 * ERROR MSG MODULE DTSCS89 -00216 01 L805-COMM-AREA. DTSCS89 -00217 ++INCLUDE DTSIL805 DTSCS89 -00218 EJECT DTSCS89 -00219 * REFERENCE FILE I-O LINKAGE DTSCS89 -00220 01 L831-COMM-AREA. DTSCS89 -00221 05 L831-CONTROL-BLOCK. DTSCS89 -00222 ++INCLUDE DTSIL831 DTSCS89 +00178 05 CURSOR-SET-IND PIC X(01). DTSCS89 +00179 88 CURSOR-SET-YES VALUE 'Y'. DTSCS89 +00180 88 CURSOR-SET-NO VALUE 'N'. DTSCS89 +00181 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS89 +00182 SKIP1 DTSCS89 +00183 05 REQ-IND PIC X(01). DTSCS89 +00184 88 REQ-ERROR VALUE 'O'. DTSCS89 +00185 88 REQ-JUMP VALUE 'J'. DTSCS89 +00186 88 REQ-INQUIRE VALUE 'I'. DTSCS89 +00187 88 REQ-CLEAR VALUE 'C'. DTSCS89 +00188 88 REQ-EDIT VALUE 'E'. DTSCS89 +00189 88 REQ-UPDATE VALUE 'U'. DTSCS89 +00190 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS89 +00191 SKIP1 DTSCS89 +00192 05 RESP-IND PIC X(01). DTSCS89 +00193 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS89 +00194 88 RESP-SEND-MAP VALUE 'M'. DTSCS89 +00195 88 RESP-JUMP VALUE 'J'. DTSCS89 +00196 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS89 +00197 SKIP1 DTSCS89 +00198 05 WRK-NEW-KEY-IND PIC X(01). DTSCS89 +00199 SKIP1 DTSCS89 +00200 05 WRK-MSG-ID PIC X(04). DTSCS89 +00201 SKIP1 DTSCS89 +00202 05 WRK-ATB-AN PIC X(01). DTSCS89 +00203 05 WRK-ATB-NUM PIC X(01). DTSCS89 +00204 EJECT DTSCS89 +00205 01 L001-COMM-AREA. DTSCS89 +00206 ++INCLUDE DTSIL001 DTSCS89 +00207 EJECT DTSCS89 +00208 01 L004-COMM-AREA. DTSCS89 +00209 ++INCLUDE DTSIL004 DTSCS89 +00210 EJECT DTSCS89 +00211 01 L015-COMM-AREA. DTSCS89 +00212 ++INCLUDE DTSIL015 DTSCS89 +00213 EJECT DTSCS89 +00214 01 L007-COMM-AREA. DTSCS89 +00215 ++INCLUDE DTSIL007 DTSCS89 +00216 EJECT DTSCS89 +00217 01 L016-COMM-AREA. DTSCS89 +00218 ++INCLUDE DTSIL016 DTSCS89 +00219 EJECT DTSCS89 +00220 * ERROR MSG MODULE DTSCS89 +00221 01 L805-COMM-AREA. DTSCS89 +00222 ++INCLUDE DTSIL805 DTSCS89 00223 EJECT DTSCS89 -00224 * COMMON SKELETAL RECORD DTSCS89 -00225 05 FCOMM-REC. DTSCS89 -00226 ++INCLUDE DTSIFSKL DTSCS89 -00227 EJECT DTSCS89 -00228 * CALENDAR YEAR RECORD LAYOUT DTSCS89 -00229 05 FAFD-REC REDEFINES FCOMM-REC. DTSCS89 -00230 ++INCLUDE DTSIFAFD DTSCS89 -00231 EJECT DTSCS89 -00232 * MAP DEFINITION DTSCS89 -00233 01 L851-COMM-AREA. DTSCS89 -00234 ++INCLUDE DTSIL851 DTSCS89 -00235 SKIP3 DTSCS89 -00236 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS89 -00237 ++INCLUDE DTSIS89 DTSCS89 -00238 EJECT DTSCS89 -00239 * ATTRIBUTE LITERALS DTSCS89 -00240 01 CATB-LITERALS. DTSCS89 -00241 ++INCLUDE DTSICATB DTSCS89 -00242 SKIP3 DTSCS89 -00243 * FUNCTION KEY DESCRIPTION LITERALS DTSCS89 -00244 01 CFKD-LITERALS. DTSCS89 -00245 ++INCLUDE DTSICFKD DTSCS89 -00246 SKIP3 DTSCS89 -00247 * ERROR CODE MESSAGE LITERALS DTSCS89 -00248 01 CECD-LITERALS. DTSCS89 -00249 ++INCLUDE DTSICECD DTSCS89 -00250 SKIP3 DTSCS89 -00251 * PROMPT CODE MESSAGE LITERALS DTSCS89 -00252 01 CPCD-LITERALS. DTSCS89 -00253 ++INCLUDE DTSICPCD DTSCS89 -00254 EJECT DTSCS89 -00255 LINKAGE SECTION. DTSCS89 -00256 SKIP3 DTSCS89 -00257 01 DFHCOMMAREA. DTSCS89 -00258 ++INCLUDE DTSILCCM DTSCS89 -00259 SKIP3 DTSCS89 -00260 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS89 -00261 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS89 -00262 EJECT DTSCS89 -00263 ******************************************************************DTSCS89 -00264 * *DTSCS89 -00265 ******************************************************************DTSCS89 -00266 SKIP1 DTSCS89 -00267 PROCEDURE DIVISION. DTSCS89 -00268 SKIP2 DTSCS89 -00269 SET CURSOR-SET-NO TO TRUE. DTSCS89 -00270 SKIP1 DTSCS89 -00271 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 -00272 SKIP1 DTSCS89 -00273 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS89 -00274 TO SCR-ACCESS-IND. DTSCS89 -00275 SKIP3 DTSCS89 -00276 MOVE SPACE TO REQ-IND. DTSCS89 +00224 * REFERENCE FILE I-O LINKAGE DTSCS89 +00225 01 L831-COMM-AREA. DTSCS89 +00226 05 L831-CONTROL-BLOCK. DTSCS89 +00227 ++INCLUDE DTSIL831 DTSCS89 +00228 EJECT DTSCS89 +00229 * COMMON SKELETAL RECORD DTSCS89 +00230 05 FCOMM-REC. DTSCS89 +00231 ++INCLUDE DTSIFSKL DTSCS89 +00232 EJECT DTSCS89 +00233 * CALENDAR YEAR RECORD LAYOUT DTSCS89 +00234 05 FAFD-REC REDEFINES FCOMM-REC. DTSCS89 +00235 ++INCLUDE DTSIFAFD DTSCS89 +00236 EJECT DTSCS89 +00237 * MAP DEFINITION DTSCS89 +00238 01 L851-COMM-AREA. DTSCS89 +00239 ++INCLUDE DTSIL851 DTSCS89 +00240 SKIP3 DTSCS89 +00241 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS89 +00242 ++INCLUDE DTSIS89 DTSCS89 +00243 EJECT DTSCS89 +00244 * ATTRIBUTE LITERALS DTSCS89 +00245 01 CATB-LITERALS. DTSCS89 +00246 ++INCLUDE DTSICATB DTSCS89 +00247 SKIP3 DTSCS89 +00248 * FUNCTION KEY DESCRIPTION LITERALS DTSCS89 +00249 01 CFKD-LITERALS. DTSCS89 +00250 ++INCLUDE DTSICFKD DTSCS89 +00251 SKIP3 DTSCS89 +00252 * ERROR CODE MESSAGE LITERALS DTSCS89 +00253 01 CECD-LITERALS. DTSCS89 +00254 ++INCLUDE DTSICECD DTSCS89 +00255 SKIP3 DTSCS89 +00256 * PROMPT CODE MESSAGE LITERALS DTSCS89 +00257 01 CPCD-LITERALS. DTSCS89 +00258 ++INCLUDE DTSICPCD DTSCS89 +00259 EJECT DTSCS89 +00260 LINKAGE SECTION. DTSCS89 +00261 SKIP3 DTSCS89 +00262 01 DFHCOMMAREA. DTSCS89 +00263 ++INCLUDE DTSILCCM DTSCS89 +00264 SKIP3 DTSCS89 +00265 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS89 +00266 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS89 +00267 EJECT DTSCS89 +00268 ******************************************************************DTSCS89 +00269 * *DTSCS89 +00270 ******************************************************************DTSCS89 +00271 SKIP1 DTSCS89 +00272 PROCEDURE DIVISION. DTSCS89 +00273 SKIP2 DTSCS89 +00274 SET CURSOR-SET-NO TO TRUE. DTSCS89 +00275 SKIP1 DTSCS89 +00276 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 00277 SKIP1 DTSCS89 -00278 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS89 -00279 SKIP1 DTSCS89 -00280 *----------------------------------------------------- DTSCS89 -00281 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS89 -00282 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS89 -00283 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS89 -00284 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS89 -00285 * DTSCS89 -00286 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS89 -00287 * PROCESSED. DTSCS89 -00288 * DTSCS89 -00289 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS89 -00290 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS89 -00291 * WORK STATION OPERATOR. DTSCS89 -00292 *----------------------------------------------------- DTSCS89 -00293 SKIP1 DTSCS89 -00294 MOVE SPACE TO RESP-IND. DTSCS89 -00295 SKIP1 DTSCS89 -00296 IF REQ-ERROR DTSCS89 -00297 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS89 -00298 ELSE DTSCS89 -00299 IF REQ-JUMP DTSCS89 -00300 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS89 -00301 ELSE DTSCS89 -00302 IF REQ-CLEAR DTSCS89 -00303 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS89 -00304 ELSE DTSCS89 -00305 IF REQ-CURSOR-TO-GOTO DTSCS89 -00306 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS89 -00307 ELSE DTSCS89 -00308 IF REQ-INQUIRE DTSCS89 -00309 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS89 -00310 ELSE DTSCS89 -00311 IF REQ-EDIT DTSCS89 -00312 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS89 -00313 ELSE DTSCS89 -00314 IF REQ-UPDATE DTSCS89 -00315 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS89 -00316 ELSE DTSCS89 -00317 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00318 SKIP3 DTSCS89 -00319 *----------------------------------------------------- DTSCS89 -00320 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS89 -00321 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS89 -00322 *----------------------------------------------------- DTSCS89 -00323 SKIP1 DTSCS89 -00324 IF RESP-SEND-MAP DTSCS89 -00325 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS89 -00326 SET LCCM-END-TASK-88 TO TRUE DTSCS89 -00327 ELSE DTSCS89 -00328 IF RESP-SEND-MSGONLY DTSCS89 -00329 OR RESP-CURSOR-TO-GOTO DTSCS89 -00330 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS89 +00278 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS89 +00279 TO SCR-ACCESS-IND. DTSCS89 +00280 SKIP3 DTSCS89 +00281 MOVE SPACE TO REQ-IND. DTSCS89 +00282 SKIP1 DTSCS89 +00283 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS89 +00284 SKIP1 DTSCS89 +00285 *----------------------------------------------------- DTSCS89 +00286 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS89 +00287 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS89 +00288 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS89 +00289 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS89 +00290 * DTSCS89 +00291 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS89 +00292 * PROCESSED. DTSCS89 +00293 * DTSCS89 +00294 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS89 +00295 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS89 +00296 * WORK STATION OPERATOR. DTSCS89 +00297 *----------------------------------------------------- DTSCS89 +00298 SKIP1 DTSCS89 +00299 MOVE SPACE TO RESP-IND. DTSCS89 +00300 SKIP1 DTSCS89 +00301 IF REQ-ERROR DTSCS89 +00302 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS89 +00303 ELSE DTSCS89 +00304 IF REQ-JUMP DTSCS89 +00305 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS89 +00306 ELSE DTSCS89 +00307 IF REQ-CLEAR DTSCS89 +00308 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS89 +00309 ELSE DTSCS89 +00310 IF REQ-CURSOR-TO-GOTO DTSCS89 +00311 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS89 +00312 ELSE DTSCS89 +00313 IF REQ-INQUIRE DTSCS89 +00314 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS89 +00315 ELSE DTSCS89 +00316 IF REQ-EDIT DTSCS89 +00317 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS89 +00318 ELSE DTSCS89 +00319 IF REQ-UPDATE DTSCS89 +00320 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS89 +00321 ELSE DTSCS89 +00322 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00323 SKIP3 DTSCS89 +00324 *----------------------------------------------------- DTSCS89 +00325 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS89 +00326 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS89 +00327 *----------------------------------------------------- DTSCS89 +00328 SKIP1 DTSCS89 +00329 IF RESP-SEND-MAP DTSCS89 +00330 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS89 00331 SET LCCM-END-TASK-88 TO TRUE DTSCS89 00332 ELSE DTSCS89 -00333 IF RESP-JUMP DTSCS89 -00334 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS89 -00335 ELSE DTSCS89 -00336 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00337 SKIP3 DTSCS89 -00338 MAINLINE-EXIT. DTSCS89 -00339 SKIP1 DTSCS89 -00340 EXEC CICS DTSCS89 -00341 RETURN DTSCS89 -00342 END-EXEC. DTSCS89 -00343 SKIP2 DTSCS89 -00344 GOBACK. DTSCS89 -00345 /*****************************************************************DTSCS89 -00346 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS89 -00347 ******************************************************************DTSCS89 -00348 P1000-ANALYZE-REQUEST. DTSCS89 -00349 SKIP1 DTSCS89 -00350 *----------------------------------------------------- DTSCS89 -00351 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS89 -00352 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS89 -00353 * REPLACED WITH ENTER) DTSCS89 -00354 *----------------------------------------------------- DTSCS89 -00355 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS89 -00356 SET LCCM-ENTER-88 TO TRUE DTSCS89 -00357 SET REQ-CLEAR TO TRUE DTSCS89 -00358 GO TO P1000-EXIT. DTSCS89 -00359 SKIP3 DTSCS89 -00360 *----------------------------------------------------- DTSCS89 -00361 * MAP IS RECEIVED DTSCS89 -00362 *----------------------------------------------------- DTSCS89 -00363 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS89 +00333 IF RESP-SEND-MSGONLY DTSCS89 +00334 OR RESP-CURSOR-TO-GOTO DTSCS89 +00335 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS89 +00336 SET LCCM-END-TASK-88 TO TRUE DTSCS89 +00337 ELSE DTSCS89 +00338 IF RESP-JUMP DTSCS89 +00339 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS89 +00340 ELSE DTSCS89 +00341 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00342 SKIP3 DTSCS89 +00343 MAINLINE-EXIT. DTSCS89 +00344 SKIP1 DTSCS89 +00345 EXEC CICS DTSCS89 +00346 RETURN DTSCS89 +00347 END-EXEC. DTSCS89 +00348 SKIP2 DTSCS89 +00349 GOBACK. DTSCS89 +00350 /*****************************************************************DTSCS89 +00351 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS89 +00352 ******************************************************************DTSCS89 +00353 P1000-ANALYZE-REQUEST. DTSCS89 +00354 SKIP1 DTSCS89 +00355 *----------------------------------------------------- DTSCS89 +00356 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS89 +00357 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS89 +00358 * REPLACED WITH ENTER) DTSCS89 +00359 *----------------------------------------------------- DTSCS89 +00360 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS89 +00361 SET LCCM-ENTER-88 TO TRUE DTSCS89 +00362 SET REQ-CLEAR TO TRUE DTSCS89 +00363 GO TO P1000-EXIT. DTSCS89 00364 SKIP3 DTSCS89 00365 *----------------------------------------------------- DTSCS89 -00366 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS89 -00367 * WORK STATION DTSCS89 -00368 *----------------------------------------------------- DTSCS89 -00369 IF LCCM-CLEAR-88 DTSCS89 -00370 SET REQ-CLEAR TO TRUE DTSCS89 -00371 GO TO P1000-EXIT. DTSCS89 -00372 SKIP3 DTSCS89 +00366 * MAP IS RECEIVED DTSCS89 +00367 *----------------------------------------------------- DTSCS89 +00368 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS89 +00369 SKIP3 DTSCS89 +00370 *----------------------------------------------------- DTSCS89 +00371 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS89 +00372 * WORK STATION DTSCS89 00373 *----------------------------------------------------- DTSCS89 -00374 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS89 -00375 *----------------------------------------------------- DTSCS89 -00376 IF LCCM-SCR-UPDATE-LOCKED DTSCS89 -00377 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS89 -00378 GO TO P1000-EXIT. DTSCS89 -00379 SKIP3 DTSCS89 +00374 IF LCCM-CLEAR-88 DTSCS89 +00375 SET REQ-CLEAR TO TRUE DTSCS89 +00376 GO TO P1000-EXIT. DTSCS89 +00377 SKIP3 DTSCS89 +00378 *----------------------------------------------------- DTSCS89 +00379 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS89 00380 *----------------------------------------------------- DTSCS89 -00381 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS89 -00382 *----------------------------------------------------- DTSCS89 -00383 IF LCCM-PA2-88 DTSCS89 -00384 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS89 -00385 GO TO P1000-EXIT. DTSCS89 -00386 SKIP3 DTSCS89 +00381 IF LCCM-SCR-UPDATE-LOCKED DTSCS89 +00382 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS89 +00383 GO TO P1000-EXIT. DTSCS89 +00384 SKIP3 DTSCS89 +00385 *----------------------------------------------------- DTSCS89 +00386 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS89 00387 *----------------------------------------------------- DTSCS89 -00388 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS89 -00389 *----------------------------------------------------- DTSCS89 -00390 IF LCCM-PA-88 DTSCS89 -00391 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS89 -00392 SET REQ-ERROR TO TRUE DTSCS89 -00393 GO TO P1000-EXIT. DTSCS89 -00394 SKIP3 DTSCS89 -00395 *----------------------------------------------------- DTSCS89 -00396 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS89 -00397 * REQUEST TO CLEAR THE SCREEN. DTSCS89 -00398 *----------------------------------------------------- DTSCS89 -00399 IF LCCM-F12-88 DTSCS89 -00400 MOVE LOW-VALUES TO MAP-AREA DTSCS89 -00401 SET REQ-CLEAR TO TRUE DTSCS89 -00402 GO TO P1000-EXIT. DTSCS89 -00403 SKIP3 DTSCS89 -00404 *----------------------------------------------------- DTSCS89 -00405 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS89 -00406 *----------------------------------------------------- DTSCS89 -00407 IF LCCM-F03-88 DTSCS89 -00408 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89 -00409 SET REQ-JUMP TO TRUE DTSCS89 -00410 GO TO P1000-EXIT. DTSCS89 -00411 SKIP3 DTSCS89 -00412 *----------------------------------------------------- DTSCS89 -00413 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS89 -00414 *----------------------------------------------------- DTSCS89 -00415 IF LCCM-F04-88 DTSCS89 -00416 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89 -00417 SET REQ-JUMP TO TRUE DTSCS89 -00418 GO TO P1000-EXIT. DTSCS89 -00419 SKIP3 DTSCS89 -00420 *----------------------------------------------------- DTSCS89 -00421 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS89 -00422 * CORRESPONDENCE SCREEN DTSCS89 -00423 *----------------------------------------------------- DTSCS89 -00424 IF LCCM-F14-88 DTSCS89 -00425 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89 -00426 SET REQ-JUMP TO TRUE DTSCS89 -00427 GO TO P1000-EXIT. DTSCS89 -00428 SKIP3 DTSCS89 -00429 *----------------------------------------------------- DTSCS89 -00430 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS89 -00431 * REQUESTED SCREEN TYPE DTSCS89 -00432 *----------------------------------------------------- DTSCS89 -00433 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS89 -00434 NEXT SENTENCE DTSCS89 -00435 ELSE DTSCS89 -00436 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS89 -00437 SET REQ-JUMP TO TRUE DTSCS89 -00438 GO TO P1000-EXIT. DTSCS89 -00439 SKIP3 DTSCS89 -00440 *----------------------------------------------------- DTSCS89 -00441 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS89 -00442 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS89 -00443 *----------------------------------------------------- DTSCS89 -00444 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS89 -00445 IF SCR-ACCESS-UPDATE DTSCS89 -00446 SET REQ-EDIT TO TRUE DTSCS89 -00447 GO TO P1000-EXIT DTSCS89 -00448 ELSE DTSCS89 -00449 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS89 -00450 SET REQ-ERROR TO TRUE DTSCS89 -00451 GO TO P1000-EXIT. DTSCS89 -00452 SKIP3 DTSCS89 -00453 *----------------------------------------------------- DTSCS89 -00454 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS89 -00455 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS89 -00456 *----------------------------------------------------- DTSCS89 -00457 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS89 -00458 SET REQ-INQUIRE TO TRUE DTSCS89 -00459 GO TO P1000-EXIT. DTSCS89 -00460 SKIP3 DTSCS89 +00388 IF LCCM-PA2-88 DTSCS89 +00389 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS89 +00390 GO TO P1000-EXIT. DTSCS89 +00391 SKIP3 DTSCS89 +00392 *----------------------------------------------------- DTSCS89 +00393 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS89 +00394 *----------------------------------------------------- DTSCS89 +00395 IF LCCM-PA-88 DTSCS89 +00396 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS89 +00397 SET REQ-ERROR TO TRUE DTSCS89 +00398 GO TO P1000-EXIT. DTSCS89 +00399 SKIP3 DTSCS89 +00400 *----------------------------------------------------- DTSCS89 +00401 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS89 +00402 * REQUEST TO CLEAR THE SCREEN. DTSCS89 +00403 *----------------------------------------------------- DTSCS89 +00404 IF LCCM-F12-88 DTSCS89 +00405 MOVE LOW-VALUES TO MAP-AREA DTSCS89 +00406 SET REQ-CLEAR TO TRUE DTSCS89 +00407 GO TO P1000-EXIT. DTSCS89 +00408 SKIP3 DTSCS89 +00409 *----------------------------------------------------- DTSCS89 +00410 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS89 +00411 *----------------------------------------------------- DTSCS89 +00412 IF LCCM-F03-88 DTSCS89 +00413 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89 +00414 SET REQ-JUMP TO TRUE DTSCS89 +00415 GO TO P1000-EXIT. DTSCS89 +00416 SKIP3 DTSCS89 +00417 *----------------------------------------------------- DTSCS89 +00418 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS89 +00419 *----------------------------------------------------- DTSCS89 +00420 IF LCCM-F04-88 DTSCS89 +00421 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89 +00422 SET REQ-JUMP TO TRUE DTSCS89 +00423 GO TO P1000-EXIT. DTSCS89 +00424 SKIP3 DTSCS89 +00425 *----------------------------------------------------- DTSCS89 +00426 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS89 +00427 * CORRESPONDENCE SCREEN DTSCS89 +00428 *----------------------------------------------------- DTSCS89 +00429 IF LCCM-F14-88 DTSCS89 +00430 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS89 +00431 SET REQ-JUMP TO TRUE DTSCS89 +00432 GO TO P1000-EXIT. DTSCS89 +00433 SKIP3 DTSCS89 +00434 *----------------------------------------------------- DTSCS89 +00435 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS89 +00436 * REQUESTED SCREEN TYPE DTSCS89 +00437 *----------------------------------------------------- DTSCS89 +00438 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS89 +00439 NEXT SENTENCE DTSCS89 +00440 ELSE DTSCS89 +00441 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS89 +00442 SET REQ-JUMP TO TRUE DTSCS89 +00443 GO TO P1000-EXIT. DTSCS89 +00444 SKIP3 DTSCS89 +00445 *----------------------------------------------------- DTSCS89 +00446 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS89 +00447 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS89 +00448 *----------------------------------------------------- DTSCS89 +00449 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS89 +00450 IF SCR-ACCESS-UPDATE DTSCS89 +00451 SET REQ-EDIT TO TRUE DTSCS89 +00452 GO TO P1000-EXIT DTSCS89 +00453 ELSE DTSCS89 +00454 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS89 +00455 SET REQ-ERROR TO TRUE DTSCS89 +00456 GO TO P1000-EXIT. DTSCS89 +00457 SKIP3 DTSCS89 +00458 *----------------------------------------------------- DTSCS89 +00459 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS89 +00460 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS89 00461 *----------------------------------------------------- DTSCS89 -00462 * ANY OTHER KEY IS INVALID DTSCS89 -00463 *----------------------------------------------------- DTSCS89 -00464 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS89 -00465 SET REQ-ERROR TO TRUE. DTSCS89 -00466 P1000-EXIT. DTSCS89 -00467 EXIT. DTSCS89 -00468 SKIP3 DTSCS89 -00469 ******************************************************************DTSCS89 -00470 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS89 -00471 ******************************************************************DTSCS89 -00472 SKIP1 DTSCS89 -00473 P1100-UPDATE-LOCKED. DTSCS89 -00474 *----------------------------------------------------- DTSCS89 -00475 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS89 -00476 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS89 -00477 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS89 -00478 *----------------------------------------------------- DTSCS89 -00479 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS89 -00480 SET REQ-UPDATE TO TRUE DTSCS89 -00481 ELSE DTSCS89 -00482 SET REQ-ERROR TO TRUE DTSCS89 -00483 IF LCCM-SCR-ADD-LOCKED DTSCS89 -00484 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS89 -00485 ELSE DTSCS89 -00486 IF LCCM-SCR-MOD-LOCKED DTSCS89 -00487 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS89 -00488 ELSE DTSCS89 -00489 IF LCCM-SCR-DEL-LOCKED DTSCS89 -00490 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS89 -00491 ELSE DTSCS89 -00492 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00493 P1100-EXIT. DTSCS89 -00494 EXIT. DTSCS89 -00495 /*****************************************************************DTSCS89 -00496 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS89 -00497 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS89 -00498 ******************************************************************DTSCS89 -00499 SKIP1 DTSCS89 -00500 P2000-REQUEST-ERROR. DTSCS89 -00501 IF LCCM-MSG DTSCS89 -00502 SET RESP-SEND-MSGONLY TO TRUE DTSCS89 -00503 ELSE DTSCS89 -00504 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00505 P2000-EXIT. DTSCS89 -00506 EXIT. DTSCS89 -00507 /*****************************************************************DTSCS89 -00508 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS89 -00509 ******************************************************************DTSCS89 -00510 SKIP1 DTSCS89 -00511 P3000-REQUEST-JUMP. DTSCS89 -00512 *----------------------------------------------------- DTSCS89 -00513 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS89 -00514 * BY USER DTSCS89 -00515 *----------------------------------------------------- DTSCS89 -00516 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS89 -00517 SKIP3 DTSCS89 -00518 *----------------------------------------------------- DTSCS89 -00519 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS89 +00462 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS89 +00463 SET REQ-INQUIRE TO TRUE DTSCS89 +00464 GO TO P1000-EXIT. DTSCS89 +00465 SKIP3 DTSCS89 +00466 *----------------------------------------------------- DTSCS89 +00467 * ANY OTHER KEY IS INVALID DTSCS89 +00468 *----------------------------------------------------- DTSCS89 +00469 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS89 +00470 SET REQ-ERROR TO TRUE. DTSCS89 +00471 P1000-EXIT. DTSCS89 +00472 EXIT. DTSCS89 +00473 SKIP3 DTSCS89 +00474 ******************************************************************DTSCS89 +00475 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS89 +00476 ******************************************************************DTSCS89 +00477 SKIP1 DTSCS89 +00478 P1100-UPDATE-LOCKED. DTSCS89 +00479 *----------------------------------------------------- DTSCS89 +00480 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS89 +00481 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS89 +00482 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS89 +00483 *----------------------------------------------------- DTSCS89 +00484 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS89 +00485 SET REQ-UPDATE TO TRUE DTSCS89 +00486 ELSE DTSCS89 +00487 SET REQ-ERROR TO TRUE DTSCS89 +00488 IF LCCM-SCR-ADD-LOCKED DTSCS89 +00489 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS89 +00490 ELSE DTSCS89 +00491 IF LCCM-SCR-MOD-LOCKED DTSCS89 +00492 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS89 +00493 ELSE DTSCS89 +00494 IF LCCM-SCR-DEL-LOCKED DTSCS89 +00495 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS89 +00496 ELSE DTSCS89 +00497 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00498 P1100-EXIT. DTSCS89 +00499 EXIT. DTSCS89 +00500 /*****************************************************************DTSCS89 +00501 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS89 +00502 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS89 +00503 ******************************************************************DTSCS89 +00504 SKIP1 DTSCS89 +00505 P2000-REQUEST-ERROR. DTSCS89 +00506 IF LCCM-MSG DTSCS89 +00507 SET RESP-SEND-MSGONLY TO TRUE DTSCS89 +00508 ELSE DTSCS89 +00509 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00510 P2000-EXIT. DTSCS89 +00511 EXIT. DTSCS89 +00512 /*****************************************************************DTSCS89 +00513 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS89 +00514 ******************************************************************DTSCS89 +00515 SKIP1 DTSCS89 +00516 P3000-REQUEST-JUMP. DTSCS89 +00517 *----------------------------------------------------- DTSCS89 +00518 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS89 +00519 * BY USER DTSCS89 00520 *----------------------------------------------------- DTSCS89 -00521 IF LCCM-MSG DTSCS89 -00522 SET RESP-SEND-MSGONLY TO TRUE DTSCS89 -00523 SET CURSOR-SET-GOTO TO TRUE DTSCS89 -00524 GO TO P3000-EXIT. DTSCS89 -00525 SKIP3 DTSCS89 -00526 *----------------------------------------------------- DTSCS89 -00527 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS89 -00528 *----------------------------------------------------- DTSCS89 -00529 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS89 -00530 LCCM-SCR-HOLD-AREA. DTSCS89 -00531 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS89 -00532 SET RESP-JUMP TO TRUE. DTSCS89 -00533 P3000-EXIT. DTSCS89 -00534 EXIT. DTSCS89 -00535 /*****************************************************************DTSCS89 -00536 * CLEAR KEY WAS PRESSED *DTSCS89 -00537 ******************************************************************DTSCS89 -00538 SKIP1 DTSCS89 -00539 P4000-REQUEST-CLEAR. DTSCS89 -00540 IF SCR-ACCESS-UPDATE DTSCS89 -00541 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS89 -00542 ELSE DTSCS89 -00543 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS89 -00544 SKIP3 DTSCS89 -00545 *----------------------------------------------------- DTSCS89 -00546 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS89 -00547 * FIELDS FROM EARLIER REQUESTS DTSCS89 -00548 *----------------------------------------------------- DTSCS89 -00549 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS89 -00550 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89 -00551 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 -00552 SET RESP-SEND-MAP TO TRUE. DTSCS89 -00553 P4000-EXIT. DTSCS89 -00554 EXIT. DTSCS89 -00555 /*****************************************************************DTSCS89 -00556 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS89 -00557 ******************************************************************DTSCS89 -00558 SKIP1 DTSCS89 -00559 P5000-CURSOR-TO-GOTO. DTSCS89 -00560 SET CURSOR-SET-GOTO TO TRUE. DTSCS89 -00561 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS89 -00562 P5000-EXIT. DTSCS89 -00563 EXIT. DTSCS89 -00564 /*****************************************************************DTSCS89 -00565 * INQUIRY WAS REQUESTED *DTSCS89 -00566 ******************************************************************DTSCS89 -00567 SKIP1 DTSCS89 -00568 P6000-REQUEST-INQUIRE. DTSCS89 -00569 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCS89 -00570 SET FAFD-AFD-88 TO TRUE. DTSCS89 -00571 SKIP1 DTSCS89 -00572 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 -00573 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 -00574 MOVE L007-YR-2-X TO MAP-YR. DTSCS89 -00575 IF MAP-YR = LOW-VALUES OR SPACES DTSCS89 -00576 MOVE +0 TO FAFD-YR DTSCS89 -00577 ELSE DTSCS89 -00578 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS89 -00579 IF L007-VALID-YR AND DTSCS89 -00580 L007-YR-2-9 > WRK-ANN-START-YR DTSCS89 -00581 MOVE L007-YR-4-9 TO FAFD-YR DTSCS89 -00582 ELSE DTSCS89 -00583 MOVE +0 TO FAFD-YR DTSCS89 -00584 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -00585 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 -00586 DTSCS89 -00587 IF LCCM-SCR-INQUIRE DTSCS89 -00588 AND FAFD-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS89 -00589 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS89 -00590 ELSE DTSCS89 -00591 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS89 -00592 SKIP1 DTSCS89 -00593 IF SCR-ACCESS-UPDATE DTSCS89 -00594 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS89 +00521 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS89 +00522 SKIP3 DTSCS89 +00523 *----------------------------------------------------- DTSCS89 +00524 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS89 +00525 *----------------------------------------------------- DTSCS89 +00526 IF LCCM-MSG DTSCS89 +00527 SET RESP-SEND-MSGONLY TO TRUE DTSCS89 +00528 SET CURSOR-SET-GOTO TO TRUE DTSCS89 +00529 GO TO P3000-EXIT. DTSCS89 +00530 SKIP3 DTSCS89 +00531 *----------------------------------------------------- DTSCS89 +00532 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS89 +00533 *----------------------------------------------------- DTSCS89 +00534 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS89 +00535 LCCM-SCR-HOLD-AREA. DTSCS89 +00536 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS89 +00537 SET RESP-JUMP TO TRUE. DTSCS89 +00538 P3000-EXIT. DTSCS89 +00539 EXIT. DTSCS89 +00540 /*****************************************************************DTSCS89 +00541 * CLEAR KEY WAS PRESSED *DTSCS89 +00542 ******************************************************************DTSCS89 +00543 SKIP1 DTSCS89 +00544 P4000-REQUEST-CLEAR. DTSCS89 +00545 IF SCR-ACCESS-UPDATE DTSCS89 +00546 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS89 +00547 ELSE DTSCS89 +00548 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS89 +00549 SKIP3 DTSCS89 +00550 *----------------------------------------------------- DTSCS89 +00551 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS89 +00552 * FIELDS FROM EARLIER REQUESTS DTSCS89 +00553 *----------------------------------------------------- DTSCS89 +00554 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS89 +00555 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89 +00556 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 +00557 SET RESP-SEND-MAP TO TRUE. DTSCS89 +00558 P4000-EXIT. DTSCS89 +00559 EXIT. DTSCS89 +00560 /*****************************************************************DTSCS89 +00561 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS89 +00562 ******************************************************************DTSCS89 +00563 SKIP1 DTSCS89 +00564 P5000-CURSOR-TO-GOTO. DTSCS89 +00565 SET CURSOR-SET-GOTO TO TRUE. DTSCS89 +00566 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS89 +00567 P5000-EXIT. DTSCS89 +00568 EXIT. DTSCS89 +00569 /*****************************************************************DTSCS89 +00570 * INQUIRY WAS REQUESTED *DTSCS89 +00571 ******************************************************************DTSCS89 +00572 SKIP1 DTSCS89 +00573 P6000-REQUEST-INQUIRE. DTSCS89 +00574 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCS89 +00575 SET FAFD-AFD-88 TO TRUE. DTSCS89 +00576 SKIP1 DTSCS89 +00577 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 +00578 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 +00579 MOVE L007-YR-2-X TO MAP-YR. DTSCS89 +00580 IF MAP-YR = LOW-VALUES OR SPACES DTSCS89 +00581 MOVE +0 TO FAFD-YR DTSCS89 +00582 ELSE DTSCS89 +00583 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT DTSCS89 +00584 IF L007-VALID-YR AND DTSCS89 +00585 L007-YR-2-9 > WRK-ANN-START-YR DTSCS89 +00586 MOVE L007-YR-4-9 TO FAFD-YR DTSCS89 +00587 ELSE DTSCS89 +00588 MOVE +0 TO FAFD-YR DTSCS89 +00589 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +00590 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 +00591 DTSCS89 +00592 IF LCCM-SCR-INQUIRE DTSCS89 +00593 AND FAFD-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS89 +00594 MOVE 'N' TO WRK-NEW-KEY-IND DTSCS89 00595 ELSE DTSCS89 -00596 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS89 +00596 MOVE 'Y' TO WRK-NEW-KEY-IND. DTSCS89 00597 SKIP1 DTSCS89 -00598 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 -00599 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89 -00600 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89 -00601 SKIP1 DTSCS89 -00602 IF LCCM-MSG DTSCS89 -00603 NEXT SENTENCE DTSCS89 -00604 ELSE DTSCS89 -00605 IF LCCM-ENTER-88 DTSCS89 -00606 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS89 -00607 ELSE DTSCS89 -00608 IF LCCM-F07-88 DTSCS89 -00609 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS89 -00610 ELSE DTSCS89 -00611 IF LCCM-F08-88 DTSCS89 -00612 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS89 -00613 ELSE DTSCS89 -00614 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00615 SKIP1 DTSCS89 -00616 SET RESP-SEND-MAP TO TRUE. DTSCS89 -00617 P6000-EXIT. DTSCS89 -00618 EXIT. DTSCS89 -00619 EJECT DTSCS89 -00620 P6100-NO-PAGE. DTSCS89 -00621 IF L007-NOT-VALID-YR DTSCS89 -00622 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS89 -00623 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00624 GO TO P6100-EXIT. DTSCS89 -00625 SKIP1 DTSCS89 -00626 PERFORM S831-READ THRU S831-EXIT. DTSCS89 -00627 IF L831-NO-REC-88 DTSCS89 -00628 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00629 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00630 GO TO P6100-EXIT. DTSCS89 -00631 SKIP1 DTSCS89 -00632 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89 -00633 P6100-EXIT. DTSCS89 -00634 EXIT. DTSCS89 -00635 EJECT DTSCS89 -00636 P6200-PAGE-BACK. DTSCS89 -00637 MOVE FAFD-KEY-AREA TO WRK-KEY-AREA. DTSCS89 -00638 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS89 -00639 IF L831-NO-REC-88 DTSCS89 -00640 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00641 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00642 GO TO P6200-EXIT. DTSCS89 -00643 SKIP1 DTSCS89 -00644 IF (WRK-NEW-KEY-IND = 'Y') DTSCS89 -00645 AND DTSCS89 -00646 (WRK-KEY-AREA = FAFD-KEY-AREA) DTSCS89 -00647 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 -00648 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 -00649 GO TO P6200-EXIT. DTSCS89 -00650 SKIP1 DTSCS89 -00651 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS89 -00652 IF L831-NO-REC-88 DTSCS89 -00653 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00654 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00655 GO TO P6200-EXIT. DTSCS89 -00656 SKIP1 DTSCS89 -00657 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS89 -00658 IF L831-NO-REC-88 DTSCS89 -00659 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 -00660 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS89 -00661 ELSE DTSCS89 -00662 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 -00663 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89 -00664 P6200-EXIT. DTSCS89 -00665 EXIT. DTSCS89 -00666 EJECT DTSCS89 -00667 P6300-PAGE-NEXT. DTSCS89 -00668 MOVE FAFD-KEY-AREA TO WRK-KEY-AREA. DTSCS89 -00669 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS89 -00670 IF L831-NO-REC-88 DTSCS89 -00671 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00672 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00673 GO TO P6300-EXIT. DTSCS89 -00674 SKIP1 DTSCS89 -00675 IF (WRK-NEW-KEY-IND = 'N') DTSCS89 -00676 AND DTSCS89 -00677 (WRK-KEY-AREA = FAFD-KEY-AREA) DTSCS89 -00678 NEXT SENTENCE DTSCS89 -00679 ELSE DTSCS89 -00680 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 -00681 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 -00682 GO TO P6300-EXIT. DTSCS89 -00683 SKIP1 DTSCS89 -00684 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS89 -00685 IF L831-NO-REC-88 DTSCS89 +00598 IF SCR-ACCESS-UPDATE DTSCS89 +00599 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS89 +00600 ELSE DTSCS89 +00601 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS89 +00602 SKIP1 DTSCS89 +00603 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 +00604 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89 +00605 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89 +00606 SKIP1 DTSCS89 +00607 IF LCCM-MSG DTSCS89 +00608 NEXT SENTENCE DTSCS89 +00609 ELSE DTSCS89 +00610 IF LCCM-ENTER-88 DTSCS89 +00611 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS89 +00612 ELSE DTSCS89 +00613 IF LCCM-F07-88 DTSCS89 +00614 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS89 +00615 ELSE DTSCS89 +00616 IF LCCM-F08-88 DTSCS89 +00617 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS89 +00618 ELSE DTSCS89 +00619 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00620 SKIP1 DTSCS89 +00621 SET RESP-SEND-MAP TO TRUE. DTSCS89 +00622 P6000-EXIT. DTSCS89 +00623 EXIT. DTSCS89 +00624 EJECT DTSCS89 +00625 P6100-NO-PAGE. DTSCS89 +00626 IF L007-NOT-VALID-YR DTSCS89 +00627 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS89 +00628 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00629 GO TO P6100-EXIT. DTSCS89 +00630 SKIP1 DTSCS89 +00631 PERFORM S831-READ THRU S831-EXIT. DTSCS89 +00632 IF L831-NO-REC-88 DTSCS89 +00633 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00634 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00635 GO TO P6100-EXIT. DTSCS89 +00636 SKIP1 DTSCS89 +00637 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89 +00638 P6100-EXIT. DTSCS89 +00639 EXIT. DTSCS89 +00640 EJECT DTSCS89 +00641 P6200-PAGE-BACK. DTSCS89 +00642 MOVE FAFD-KEY-AREA TO WRK-KEY-AREA. DTSCS89 +00643 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS89 +00644 IF L831-NO-REC-88 DTSCS89 +00645 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00646 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00647 GO TO P6200-EXIT. DTSCS89 +00648 SKIP1 DTSCS89 +00649 IF (WRK-NEW-KEY-IND = 'Y') DTSCS89 +00650 AND DTSCS89 +00651 (WRK-KEY-AREA = FAFD-KEY-AREA) DTSCS89 +00652 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 +00653 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 +00654 GO TO P6200-EXIT. DTSCS89 +00655 SKIP1 DTSCS89 +00656 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS89 +00657 IF L831-NO-REC-88 DTSCS89 +00658 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00659 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00660 GO TO P6200-EXIT. DTSCS89 +00661 SKIP1 DTSCS89 +00662 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS89 +00663 IF L831-NO-REC-88 DTSCS89 +00664 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 +00665 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS89 +00666 ELSE DTSCS89 +00667 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 +00668 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89 +00669 P6200-EXIT. DTSCS89 +00670 EXIT. DTSCS89 +00671 EJECT DTSCS89 +00672 P6300-PAGE-NEXT. DTSCS89 +00673 MOVE FAFD-KEY-AREA TO WRK-KEY-AREA. DTSCS89 +00674 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS89 +00675 IF L831-NO-REC-88 DTSCS89 +00676 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00677 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00678 GO TO P6300-EXIT. DTSCS89 +00679 SKIP1 DTSCS89 +00680 IF (WRK-NEW-KEY-IND = 'N') DTSCS89 +00681 AND DTSCS89 +00682 (WRK-KEY-AREA = FAFD-KEY-AREA) DTSCS89 +00683 NEXT SENTENCE DTSCS89 +00684 ELSE DTSCS89 +00685 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 00686 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 -00687 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS89 -00688 ELSE DTSCS89 -00689 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 -00690 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89 -00691 P6300-EXIT. DTSCS89 -00692 EXIT. DTSCS89 -00693 /*****************************************************************DTSCS89 -00694 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS89 -00695 ******************************************************************DTSCS89 -00696 SKIP1 DTSCS89 -00697 P6900-CONSTRUCT-SCREEN. DTSCS89 -00698 PERFORM S007-CONVERT-FAFD-YR THROUGH S007-EXIT. DTSCS89 -00699 IF L007-VALID-YR DTSCS89 -00700 MOVE L007-YR-2-X TO MAP-YR DTSCS89 -00701 ELSE DTSCS89 -00702 GO TO S899-ABEND. DTSCS89 -00703 * SKIP1 DTSCS89 -00704 IF FAFD-UC30H-MASS-MAIL-DATE NOT = +0 DTSCS89 -00705 MOVE FAFD-UC30H-MASS-MAIL-DATE TO WRK-DISP-DATE DTSCS89 -00706 MOVE WRK-DISP-MM TO MAP-UC30H-MASS-MAIL-MM DTSCS89 -00707 MOVE WRK-DISP-DD TO MAP-UC30H-MASS-MAIL-DD DTSCS89 -00708 MOVE WRK-DISP-YY TO MAP-UC30H-MASS-MAIL-YY. DTSCS89 -00709 * SKIP1 DTSCS89 -00710 IF FAFD-UC30H-RPT-DUE-DATE NOT = +0 DTSCS89 -00711 MOVE FAFD-UC30H-RPT-DUE-DATE TO WRK-DISP-DATE DTSCS89 -00712 MOVE WRK-DISP-MM TO MAP-UC30H-RPT-DUE-MM DTSCS89 -00713 MOVE WRK-DISP-DD TO MAP-UC30H-RPT-DUE-DD DTSCS89 -00714 MOVE WRK-DISP-YY TO MAP-UC30H-RPT-DUE-YY. DTSCS89 -00715 SKIP1 DTSCS89 -00716 IF FAFD-LATE-PEN-ASSESSED-DATE NOT = +0 DTSCS89 -00717 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO WRK-DISP-DATE DTSCS89 -00718 MOVE WRK-DISP-MM TO MAP-LATE-PEN-ASSESSED-MM DTSCS89 -00719 MOVE WRK-DISP-DD TO MAP-LATE-PEN-ASSESSED-DD DTSCS89 -00720 MOVE WRK-DISP-YY TO MAP-LATE-PEN-ASSESSED-YY. DTSCS89 -00721 SKIP1 DTSCS89 -00722 IF FAFD-UC30H-FIRST-DEL-DATE NOT = +0 DTSCS89 -00723 MOVE FAFD-UC30H-FIRST-DEL-DATE TO WRK-DISP-DATE DTSCS89 -00724 MOVE WRK-DISP-MM TO MAP-UC30H-FIRST-DEL-MM DTSCS89 -00725 MOVE WRK-DISP-DD TO MAP-UC30H-FIRST-DEL-DD DTSCS89 -00726 MOVE WRK-DISP-YY TO MAP-UC30H-FIRST-DEL-YY. DTSCS89 -00727 SKIP1 DTSCS89 -00728 IF FAFD-UC30H-FINAL-DEL-DATE NOT = +0 DTSCS89 -00729 MOVE FAFD-UC30H-FINAL-DEL-DATE TO WRK-DISP-DATE DTSCS89 -00730 MOVE WRK-DISP-MM TO MAP-UC30H-FINAL-DEL-MM DTSCS89 -00731 MOVE WRK-DISP-DD TO MAP-UC30H-FINAL-DEL-DD DTSCS89 -00732 MOVE WRK-DISP-YY TO MAP-UC30H-FINAL-DEL-YY. DTSCS89 -00733 SKIP1 DTSCS89 -00734 IF FAFD-UC30H-FINAL-ACTION-DATE NOT = +0 DTSCS89 -00735 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO WRK-DISP-DATE DTSCS89 -00736 MOVE WRK-DISP-MM TO MAP-UC30H-FINAL-ACTION-MM DTSCS89 -00737 MOVE WRK-DISP-DD TO MAP-UC30H-FINAL-ACTION-DD DTSCS89 -00738 MOVE WRK-DISP-YY TO MAP-UC30H-FINAL-ACTION-YY. DTSCS89 -00739 SKIP1 DTSCS89 -00740 IF FAFD-ESTB-DATE NOT = +0 DTSCS89 -00741 MOVE FAFD-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS89 -00742 SET L001-FROM-FED-8 TO TRUE DTSCS89 -00743 PERFORM S001-DATE THRU S001-EXIT DTSCS89 -00744 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS89 -00745 SKIP1 DTSCS89 -00746 IF FAFD-CHNG-DATE NOT = +0 DTSCS89 -00747 MOVE FAFD-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS89 -00748 SET L001-FROM-FED-8 TO TRUE DTSCS89 -00749 PERFORM S001-DATE THRU S001-EXIT DTSCS89 -00750 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS89 -00751 SKIP1 DTSCS89 -00752 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89 -00753 MOVE FAFD-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS89 -00754 P6900-EXIT. DTSCS89 -00755 EXIT. DTSCS89 -00756 /*****************************************************************DTSCS89 -00757 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS89 -00758 ******************************************************************DTSCS89 -00759 SKIP1 DTSCS89 -00760 P7000-REQUEST-EDIT. DTSCS89 -00761 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 -00762 SKIP1 DTSCS89 -00763 IF LCCM-F09-88 DTSCS89 -00764 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS89 -00765 ELSE DTSCS89 -00766 IF LCCM-F10-88 DTSCS89 -00767 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS89 -00768 ELSE DTSCS89 -00769 IF LCCM-F23-88 DTSCS89 -00770 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS89 -00771 ELSE DTSCS89 -00772 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00773 SKIP3 DTSCS89 -00774 *------------------------------------------------------ DTSCS89 -00775 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS89 -00776 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS89 -00777 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS89 -00778 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS89 +00687 GO TO P6300-EXIT. DTSCS89 +00688 SKIP1 DTSCS89 +00689 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS89 +00690 IF L831-NO-REC-88 DTSCS89 +00691 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS89 +00692 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS89 +00693 ELSE DTSCS89 +00694 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS89 +00695 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS89 +00696 P6300-EXIT. DTSCS89 +00697 EXIT. DTSCS89 +00698 /*****************************************************************DTSCS89 +00699 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS89 +00700 ******************************************************************DTSCS89 +00701 SKIP1 DTSCS89 +00702 P6900-CONSTRUCT-SCREEN. DTSCS89 +00703 PERFORM S007-CONVERT-FAFD-YR THROUGH S007-EXIT. DTSCS89 +00704 IF L007-VALID-YR DTSCS89 +00705 MOVE L007-YR-2-X TO MAP-YR DTSCS89 +00706 ELSE DTSCS89 +00707 GO TO S899-ABEND. DTSCS89 +00708 * SKIP1 DTSCS89 +00709 IF FAFD-UC30H-MASS-MAIL-DATE NOT = +0 DTSCS89 +00710 MOVE FAFD-UC30H-MASS-MAIL-DATE TO WRK-DISP-DATE DTSCS89 +00711 MOVE WRK-DISP-MM TO MAP-UC30H-MASS-MAIL-MM DTSCS89 +00712 MOVE WRK-DISP-DD TO MAP-UC30H-MASS-MAIL-DD DTSCS89 +00713 MOVE WRK-DISP-YY TO MAP-UC30H-MASS-MAIL-YY. DTSCS89 +00714 * SKIP1 DTSCS89 +00715 IF FAFD-UC30H-RPT-DUE-DATE NOT = +0 DTSCS89 +00716 MOVE FAFD-UC30H-RPT-DUE-DATE TO WRK-DISP-DATE DTSCS89 +00717 MOVE WRK-DISP-MM TO MAP-UC30H-RPT-DUE-MM DTSCS89 +00718 MOVE WRK-DISP-DD TO MAP-UC30H-RPT-DUE-DD DTSCS89 +00719 MOVE WRK-DISP-YY TO MAP-UC30H-RPT-DUE-YY. DTSCS89 +00720 SKIP1 DTSCS89 +00721 IF FAFD-LATE-PEN-ASSESSED-DATE NOT = +0 DTSCS89 +00722 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO WRK-DISP-DATE DTSCS89 +00723 MOVE WRK-DISP-MM TO MAP-LATE-PEN-ASSESSED-MM DTSCS89 +00724 MOVE WRK-DISP-DD TO MAP-LATE-PEN-ASSESSED-DD DTSCS89 +00725 MOVE WRK-DISP-YY TO MAP-LATE-PEN-ASSESSED-YY. DTSCS89 +00726 SKIP1 DTSCS89 +00727 IF FAFD-UC30H-FIRST-DEL-DATE NOT = +0 DTSCS89 +00728 MOVE FAFD-UC30H-FIRST-DEL-DATE TO WRK-DISP-DATE DTSCS89 +00729 MOVE WRK-DISP-MM TO MAP-UC30H-FIRST-DEL-MM DTSCS89 +00730 MOVE WRK-DISP-DD TO MAP-UC30H-FIRST-DEL-DD DTSCS89 +00731 MOVE WRK-DISP-YY TO MAP-UC30H-FIRST-DEL-YY. DTSCS89 +00732 SKIP1 DTSCS89 +00733 IF FAFD-UC30H-ESTIMATED-DATE NOT = +0 CL**2 +00734 MOVE FAFD-UC30H-ESTIMATED-DATE TO WRK-DISP-DATE CL**2 +00735 MOVE WRK-DISP-MM TO MAP-UC30H-ESTIMATED-MM CL**2 +00736 MOVE WRK-DISP-DD TO MAP-UC30H-ESTIMATED-DD CL**2 +00737 MOVE WRK-DISP-YY TO MAP-UC30H-ESTIMATED-YY. CL**2 +00738 SKIP1 DTSCS89 +00739 IF FAFD-UC30H-FINAL-ACTION-DATE NOT = +0 DTSCS89 +00740 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO WRK-DISP-DATE DTSCS89 +00741 MOVE WRK-DISP-MM TO MAP-UC30H-FINAL-ACTION-MM DTSCS89 +00742 MOVE WRK-DISP-DD TO MAP-UC30H-FINAL-ACTION-DD DTSCS89 +00743 MOVE WRK-DISP-YY TO MAP-UC30H-FINAL-ACTION-YY. DTSCS89 +00744 SKIP1 DTSCS89 +00745 IF FAFD-ESTB-DATE NOT = +0 DTSCS89 +00746 MOVE FAFD-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS89 +00747 SET L001-FROM-FED-8 TO TRUE DTSCS89 +00748 PERFORM S001-DATE THRU S001-EXIT DTSCS89 +00749 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS89 +00750 SKIP1 DTSCS89 +00751 IF FAFD-CHNG-DATE NOT = +0 DTSCS89 +00752 MOVE FAFD-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS89 +00753 SET L001-FROM-FED-8 TO TRUE DTSCS89 +00754 PERFORM S001-DATE THRU S001-EXIT DTSCS89 +00755 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS89 +00756 SKIP1 DTSCS89 +00757 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89 +00758 MOVE FAFD-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS89 +00759 P6900-EXIT. DTSCS89 +00760 EXIT. DTSCS89 +00761 /*****************************************************************DTSCS89 +00762 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS89 +00763 ******************************************************************DTSCS89 +00764 SKIP1 DTSCS89 +00765 P7000-REQUEST-EDIT. DTSCS89 +00766 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 +00767 SKIP1 DTSCS89 +00768 IF LCCM-F09-88 DTSCS89 +00769 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS89 +00770 ELSE DTSCS89 +00771 IF LCCM-F10-88 DTSCS89 +00772 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS89 +00773 ELSE DTSCS89 +00774 IF LCCM-F23-88 DTSCS89 +00775 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS89 +00776 ELSE DTSCS89 +00777 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00778 SKIP3 DTSCS89 00779 *------------------------------------------------------ DTSCS89 -00780 SKIP1 DTSCS89 -00781 IF LCCM-MSG DTSCS89 -00782 NEXT SENTENCE DTSCS89 -00783 ELSE DTSCS89 -00784 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS89 -00785 IF LCCM-F09-88 DTSCS89 -00786 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS89 -00787 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS89 -00788 ELSE DTSCS89 -00789 IF LCCM-F10-88 DTSCS89 -00790 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS89 -00791 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS89 -00792 ELSE DTSCS89 -00793 IF LCCM-F23-88 DTSCS89 -00794 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS89 -00795 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS89 -00796 SKIP1 DTSCS89 -00797 SET RESP-SEND-MAP TO TRUE. DTSCS89 -00798 P7000-EXIT. DTSCS89 -00799 EXIT. DTSCS89 -00800 /*****************************************************************DTSCS89 -00801 * ADD FUNCTION WAS REQUESTED *DTSCS89 -00802 ******************************************************************DTSCS89 -00803 SKIP1 DTSCS89 -00804 P7100-EDIT-ADD. DTSCS89 -00805 *------------------------------------------------------ DTSCS89 -00806 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS89 -00807 *------------------------------------------------------ DTSCS89 -00808 IF NOT LCCM-SCR-CLEAR DTSCS89 -00809 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS89 -00810 GO TO P7100-EXIT. DTSCS89 -00811 SKIP1 DTSCS89 -00812 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS89 -00813 SKIP1 DTSCS89 -00814 IF LCCM-NO-MSG DTSCS89 -00815 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89 -00816 IF L831-OK-88 DTSCS89 -00817 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS89 -00818 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00819 ELSE DTSCS89 -00820 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS89 -00821 P7100-EXIT. DTSCS89 -00822 EXIT. DTSCS89 -00823 /*****************************************************************DTSCS89 -00824 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS89 -00825 ******************************************************************DTSCS89 -00826 SKIP1 DTSCS89 -00827 P7200-EDIT-MOD. DTSCS89 -00828 *----------------------------------------------------- DTSCS89 -00829 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS89 -00830 * INQUIRED DTSCS89 -00831 *----------------------------------------------------- DTSCS89 -00832 IF NOT LCCM-SCR-INQUIRE DTSCS89 -00833 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS89 -00834 GO TO P7200-EXIT. DTSCS89 -00835 SKIP3 DTSCS89 +00780 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS89 +00781 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS89 +00782 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS89 +00783 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS89 +00784 *------------------------------------------------------ DTSCS89 +00785 SKIP1 DTSCS89 +00786 IF LCCM-MSG DTSCS89 +00787 NEXT SENTENCE DTSCS89 +00788 ELSE DTSCS89 +00789 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS89 +00790 IF LCCM-F09-88 DTSCS89 +00791 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS89 +00792 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS89 +00793 ELSE DTSCS89 +00794 IF LCCM-F10-88 DTSCS89 +00795 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS89 +00796 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS89 +00797 ELSE DTSCS89 +00798 IF LCCM-F23-88 DTSCS89 +00799 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS89 +00800 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS89 +00801 SKIP1 DTSCS89 +00802 SET RESP-SEND-MAP TO TRUE. DTSCS89 +00803 P7000-EXIT. DTSCS89 +00804 EXIT. DTSCS89 +00805 /*****************************************************************DTSCS89 +00806 * ADD FUNCTION WAS REQUESTED *DTSCS89 +00807 ******************************************************************DTSCS89 +00808 SKIP1 DTSCS89 +00809 P7100-EDIT-ADD. DTSCS89 +00810 *------------------------------------------------------ DTSCS89 +00811 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS89 +00812 *------------------------------------------------------ DTSCS89 +00813 IF NOT LCCM-SCR-CLEAR DTSCS89 +00814 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS89 +00815 GO TO P7100-EXIT. DTSCS89 +00816 SKIP1 DTSCS89 +00817 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS89 +00818 SKIP1 DTSCS89 +00819 IF LCCM-NO-MSG DTSCS89 +00820 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89 +00821 IF L831-OK-88 DTSCS89 +00822 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS89 +00823 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00824 ELSE DTSCS89 +00825 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS89 +00826 P7100-EXIT. DTSCS89 +00827 EXIT. DTSCS89 +00828 /*****************************************************************DTSCS89 +00829 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS89 +00830 ******************************************************************DTSCS89 +00831 SKIP1 DTSCS89 +00832 P7200-EDIT-MOD. DTSCS89 +00833 *----------------------------------------------------- DTSCS89 +00834 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS89 +00835 * INQUIRED DTSCS89 00836 *----------------------------------------------------- DTSCS89 -00837 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS89 -00838 *----------------------------------------------------- DTSCS89 -00839 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS89 -00840 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 -00841 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 -00842 IF L007-NOT-VALID-YR DTSCS89 -00843 OR L007-YR-4-9 NOT = WRK-YR DTSCS89 -00844 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS89 -00845 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00846 GO TO P7200-EXIT. DTSCS89 -00847 SKIP1 DTSCS89 -00848 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS89 -00849 SKIP1 DTSCS89 -00850 IF LCCM-NO-MSG DTSCS89 -00851 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89 -00852 IF L831-NO-REC-88 DTSCS89 -00853 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00854 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00855 ELSE DTSCS89 -00856 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS89 -00857 P7200-EXIT. DTSCS89 -00858 EXIT. DTSCS89 -00859 /*****************************************************************DTSCS89 -00860 * DELETE FUNCTION WAS REQUESTED *DTSCS89 -00861 ******************************************************************DTSCS89 -00862 SKIP1 DTSCS89 -00863 P7300-EDIT-DEL. DTSCS89 -00864 *----------------------------------------------------- DTSCS89 -00865 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS89 -00866 * INQUIRED DTSCS89 -00867 *----------------------------------------------------- DTSCS89 -00868 IF NOT LCCM-SCR-INQUIRE DTSCS89 -00869 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS89 -00870 GO TO P7300-EXIT. DTSCS89 -00871 SKIP3 DTSCS89 +00837 IF NOT LCCM-SCR-INQUIRE DTSCS89 +00838 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS89 +00839 GO TO P7200-EXIT. DTSCS89 +00840 SKIP3 DTSCS89 +00841 *----------------------------------------------------- DTSCS89 +00842 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS89 +00843 *----------------------------------------------------- DTSCS89 +00844 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS89 +00845 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 +00846 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 +00847 IF L007-NOT-VALID-YR DTSCS89 +00848 OR L007-YR-4-9 NOT = WRK-YR DTSCS89 +00849 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS89 +00850 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00851 GO TO P7200-EXIT. DTSCS89 +00852 SKIP1 DTSCS89 +00853 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS89 +00854 SKIP1 DTSCS89 +00855 IF LCCM-NO-MSG DTSCS89 +00856 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89 +00857 IF L831-NO-REC-88 DTSCS89 +00858 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00859 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00860 ELSE DTSCS89 +00861 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS89 +00862 P7200-EXIT. DTSCS89 +00863 EXIT. DTSCS89 +00864 /*****************************************************************DTSCS89 +00865 * DELETE FUNCTION WAS REQUESTED *DTSCS89 +00866 ******************************************************************DTSCS89 +00867 SKIP1 DTSCS89 +00868 P7300-EDIT-DEL. DTSCS89 +00869 *----------------------------------------------------- DTSCS89 +00870 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS89 +00871 * INQUIRED DTSCS89 00872 *----------------------------------------------------- DTSCS89 -00873 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS89 -00874 *----------------------------------------------------- DTSCS89 -00875 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS89 -00876 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 -00877 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 -00878 IF L007-NOT-VALID-YR DTSCS89 -00879 OR L007-YR-4-9 NOT = WRK-YR DTSCS89 -00880 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS89 -00881 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 -00882 SKIP1 DTSCS89 -00883 IF LCCM-NO-MSG DTSCS89 -00884 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89 -00885 IF L831-NO-REC-88 DTSCS89 -00886 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00887 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 -00888 P7300-EXIT. DTSCS89 -00889 EXIT. DTSCS89 -00890 /*****************************************************************DTSCS89 -00891 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS89 -00892 ******************************************************************DTSCS89 -00893 SKIP1 DTSCS89 -00894 P8000-REQUEST-UPDATE. DTSCS89 -00895 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 -00896 SKIP1 DTSCS89 -00897 IF LCCM-SCR-ADD-LOCKED DTSCS89 -00898 PERFORM P8100-ADD THRU P8100-EXIT DTSCS89 -00899 ELSE DTSCS89 -00900 IF LCCM-SCR-MOD-LOCKED DTSCS89 -00901 PERFORM P8200-MOD THRU P8200-EXIT DTSCS89 -00902 ELSE DTSCS89 -00903 IF LCCM-SCR-DEL-LOCKED DTSCS89 -00904 PERFORM P8300-DEL THRU P8300-EXIT DTSCS89 -00905 ELSE DTSCS89 -00906 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 -00907 SKIP1 DTSCS89 -00908 SET RESP-SEND-MAP TO TRUE. DTSCS89 -00909 P8000-EXIT. DTSCS89 -00910 EXIT. DTSCS89 -00911 /*****************************************************************DTSCS89 -00912 * *DTSCS89 -00913 ******************************************************************DTSCS89 -00914 SKIP1 DTSCS89 -00915 P8100-ADD. DTSCS89 -00916 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 -00917 SKIP1 DTSCS89 -00918 IF LCCM-F12-88 DTSCS89 -00919 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS89 -00920 GO TO P8100-EXIT. DTSCS89 -00921 SKIP1 DTSCS89 -00922 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89 -00923 IF L831-OK-88 DTSCS89 -00924 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS89 -00925 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00926 GO TO P8100-EXIT. DTSCS89 -00927 SKIP1 DTSCS89 -00928 MOVE LOW-VALUES TO FAFD-DATA-AREA. DTSCS89 -00929 SKIP1 DTSCS89 -00930 PERFORM P8900-CONSTRUCT-FAFD THRU P8900-EXIT. DTSCS89 -00931 SKIP1 DTSCS89 -00932 MOVE LCCM-CURR-RUN-DATE TO FAFD-ESTB-DATE. DTSCS89 -00933 MOVE LCCM-CURR-RUN-DATE TO FAFD-CHNG-DATE. DTSCS89 +00873 IF NOT LCCM-SCR-INQUIRE DTSCS89 +00874 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS89 +00875 GO TO P7300-EXIT. DTSCS89 +00876 SKIP3 DTSCS89 +00877 *----------------------------------------------------- DTSCS89 +00878 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS89 +00879 *----------------------------------------------------- DTSCS89 +00880 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS89 +00881 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 +00882 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 +00883 IF L007-NOT-VALID-YR DTSCS89 +00884 OR L007-YR-4-9 NOT = WRK-YR DTSCS89 +00885 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-ID DTSCS89 +00886 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 +00887 SKIP1 DTSCS89 +00888 IF LCCM-NO-MSG DTSCS89 +00889 PERFORM S8010-READ-FAFD THRU S8010-EXIT DTSCS89 +00890 IF L831-NO-REC-88 DTSCS89 +00891 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00892 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 +00893 P7300-EXIT. DTSCS89 +00894 EXIT. DTSCS89 +00895 /*****************************************************************DTSCS89 +00896 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS89 +00897 ******************************************************************DTSCS89 +00898 SKIP1 DTSCS89 +00899 P8000-REQUEST-UPDATE. DTSCS89 +00900 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 +00901 SKIP1 DTSCS89 +00902 IF LCCM-SCR-ADD-LOCKED DTSCS89 +00903 PERFORM P8100-ADD THRU P8100-EXIT DTSCS89 +00904 ELSE DTSCS89 +00905 IF LCCM-SCR-MOD-LOCKED DTSCS89 +00906 PERFORM P8200-MOD THRU P8200-EXIT DTSCS89 +00907 ELSE DTSCS89 +00908 IF LCCM-SCR-DEL-LOCKED DTSCS89 +00909 PERFORM P8300-DEL THRU P8300-EXIT DTSCS89 +00910 ELSE DTSCS89 +00911 PERFORM S899-ABEND THRU S899-EXIT. DTSCS89 +00912 SKIP1 DTSCS89 +00913 SET RESP-SEND-MAP TO TRUE. DTSCS89 +00914 P8000-EXIT. DTSCS89 +00915 EXIT. DTSCS89 +00916 /*****************************************************************DTSCS89 +00917 * *DTSCS89 +00918 ******************************************************************DTSCS89 +00919 SKIP1 DTSCS89 +00920 P8100-ADD. DTSCS89 +00921 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 +00922 SKIP1 DTSCS89 +00923 IF LCCM-F12-88 DTSCS89 +00924 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS89 +00925 GO TO P8100-EXIT. DTSCS89 +00926 SKIP1 DTSCS89 +00927 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89 +00928 IF L831-OK-88 DTSCS89 +00929 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-ID DTSCS89 +00930 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00931 GO TO P8100-EXIT. DTSCS89 +00932 SKIP1 DTSCS89 +00933 MOVE LOW-VALUES TO FAFD-DATA-AREA. DTSCS89 00934 SKIP1 DTSCS89 -00935 PERFORM S831-WRITE THRU S831-EXIT. DTSCS89 +00935 PERFORM P8900-CONSTRUCT-FAFD THRU P8900-EXIT. DTSCS89 00936 SKIP1 DTSCS89 -00937 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 -00938 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 -00939 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89 -00940 P8100-EXIT. DTSCS89 -00941 EXIT. DTSCS89 -00942 /*****************************************************************DTSCS89 -00943 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS89 -00944 ******************************************************************DTSCS89 -00945 SKIP1 DTSCS89 -00946 P8200-MOD. DTSCS89 -00947 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89 -00948 SKIP1 DTSCS89 -00949 IF LCCM-F12-88 DTSCS89 -00950 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS89 -00951 GO TO P8200-EXIT. DTSCS89 -00952 SKIP1 DTSCS89 -00953 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89 -00954 IF L831-NO-REC-88 DTSCS89 -00955 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00956 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00957 GO TO P8200-EXIT. DTSCS89 -00958 SKIP1 DTSCS89 -00959 PERFORM P8900-CONSTRUCT-FAFD THRU P8900-EXIT. DTSCS89 -00960 SKIP1 DTSCS89 -00961 MOVE LCCM-CURR-RUN-DATE TO FAFD-CHNG-DATE. DTSCS89 -00962 SKIP1 DTSCS89 -00963 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS89 -00964 SKIP1 DTSCS89 -00965 MOVE FAFD-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS89 -00966 SET L001-FROM-FED-8 TO TRUE. DTSCS89 -00967 PERFORM S001-DATE THRU S001-EXIT. DTSCS89 -00968 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS89 +00937 MOVE LCCM-CURR-RUN-DATE TO FAFD-ESTB-DATE. DTSCS89 +00938 MOVE LCCM-CURR-RUN-DATE TO FAFD-CHNG-DATE. DTSCS89 +00939 SKIP1 DTSCS89 +00940 PERFORM S831-WRITE THRU S831-EXIT. DTSCS89 +00941 SKIP1 DTSCS89 +00942 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 +00943 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 +00944 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89 +00945 P8100-EXIT. DTSCS89 +00946 EXIT. DTSCS89 +00947 /*****************************************************************DTSCS89 +00948 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS89 +00949 ******************************************************************DTSCS89 +00950 SKIP1 DTSCS89 +00951 P8200-MOD. DTSCS89 +00952 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89 +00953 SKIP1 DTSCS89 +00954 IF LCCM-F12-88 DTSCS89 +00955 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS89 +00956 GO TO P8200-EXIT. DTSCS89 +00957 SKIP1 DTSCS89 +00958 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89 +00959 IF L831-NO-REC-88 DTSCS89 +00960 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00961 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00962 GO TO P8200-EXIT. DTSCS89 +00963 SKIP1 DTSCS89 +00964 PERFORM P8900-CONSTRUCT-FAFD THRU P8900-EXIT. DTSCS89 +00965 SKIP1 DTSCS89 +00966 MOVE LCCM-CURR-RUN-DATE TO FAFD-CHNG-DATE. DTSCS89 +00967 SKIP1 DTSCS89 +00968 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS89 00969 SKIP1 DTSCS89 -00970 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89 -00971 P8200-EXIT. DTSCS89 -00972 EXIT. DTSCS89 -00973 /*****************************************************************DTSCS89 -00974 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS89 -00975 ******************************************************************DTSCS89 -00976 SKIP1 DTSCS89 -00977 P8300-DEL. DTSCS89 -00978 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89 -00979 SKIP1 DTSCS89 -00980 IF LCCM-F12-88 DTSCS89 -00981 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS89 -00982 GO TO P8300-EXIT. DTSCS89 -00983 SKIP1 DTSCS89 -00984 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89 -00985 IF NOT L831-OK-88 DTSCS89 -00986 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 -00987 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -00988 GO TO P8300-EXIT. DTSCS89 -00989 SKIP1 DTSCS89 -00990 PERFORM S831-DELETE THRU S831-EXIT. DTSCS89 -00991 SKIP1 DTSCS89 -00992 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89 -00993 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 -00994 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89 -00995 SKIP1 DTSCS89 -00996 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 -00997 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 -00998 SKIP1 DTSCS89 -00999 PERFORM S007-CONVERT-FAFD-YR THRU S007-EXIT. DTSCS89 -01000 IF L007-VALID-YR DTSCS89 -01001 MOVE L007-YR-2-X TO MAP-YR DTSCS89 -01002 ELSE DTSCS89 -01003 GO TO S899-ABEND. DTSCS89 -01004 SKIP1 DTSCS89 -01005 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89 -01006 P8300-EXIT. DTSCS89 -01007 EXIT. DTSCS89 -01008 EJECT DTSCS89 -01009 P8900-CONSTRUCT-FAFD. DTSCS89 -01010 SKIP1 DTSCS89 -01011 MOVE MAP-UC30H-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01012 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01013 MOVE L015-DATE TO FAFD-UC30H-MASS-MAIL-DATEDTSCS89 -01014 SKIP1 DTSCS89 -01015 MOVE MAP-UC30H-RPT-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01016 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01017 MOVE L015-DATE TO FAFD-UC30H-RPT-DUE-DATE. DTSCS89 -01018 SKIP1 DTSCS89 -01019 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01020 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01021 MOVE L015-DATE TO FAFD-LATE-PEN-ASSESSED-DATE. DTSCS89 -01022 SKIP1 DTSCS89 -01023 MOVE MAP-UC30H-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01024 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01025 MOVE L015-DATE TO FAFD-UC30H-FIRST-DEL-DATEDTSCS89 -01026 SKIP1 DTSCS89 -01027 MOVE MAP-UC30H-FINAL-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01028 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01029 MOVE L015-DATE TO FAFD-UC30H-FINAL-DEL-DATEDTSCS89 -01030 SKIP1 DTSCS89 -01031 MOVE MAP-UC30H-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01032 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01033 MOVE L015-DATE TO FAFD-UC30H-FINAL-ACTION-DATE. DTSCS89 -01034 SKIP1 DTSCS89 -01035 P8900-EXIT. DTSCS89 -01036 EXIT. DTSCS89 -01037 /*****************************************************************DTSCS89 -01038 * LINKS TO UTILITY MODULES DTSCS89 -01039 ******************************************************************DTSCS89 -01040 SKIP1 DTSCS89 -01041 S001-DATE. DTSCS89 -01042 EXEC CICS LINK DTSCS89 -01043 PROGRAM ('DTSCU001') DTSCS89 -01044 COMMAREA (L001-COMM-AREA) DTSCS89 -01045 END-EXEC. DTSCS89 -01046 S001-EXIT. DTSCS89 -01047 EXIT. DTSCS89 -01048 SKIP3 DTSCS89 -01049 S004-YRQ-CONVERT. DTSCS89 -01050 EXEC CICS LINK DTSCS89 -01051 PROGRAM ('DTSCU004') DTSCS89 -01052 COMMAREA (L004-COMM-AREA) DTSCS89 -01053 END-EXEC. DTSCS89 -01054 S004-EXIT. DTSCS89 -01055 EXIT. DTSCS89 -01056 SKIP3 DTSCS89 -01057 S015-DATE-AREA. DTSCS89 -01058 EXEC CICS LINK DTSCS89 -01059 PROGRAM ('DTSCU015') DTSCS89 -01060 COMMAREA (L015-COMM-AREA) DTSCS89 -01061 END-EXEC. DTSCS89 -01062 S015-EXIT. DTSCS89 -01063 EXIT. DTSCS89 -01064 SKIP3 DTSCS89 -01065 S016-YRQ-CONVERT. DTSCS89 -01066 EXEC CICS LINK DTSCS89 -01067 PROGRAM ('DTSCU016') DTSCS89 -01068 COMMAREA (L016-COMM-AREA) DTSCS89 -01069 END-EXEC. DTSCS89 -01070 S016-EXIT. DTSCS89 -01071 EXIT. DTSCS89 -01072 SKIP3 DTSCS89 -01073 S007-CHECK-MAP-YR. DTSCS89 -01074 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 -01075 SET L007-FROM-YR-2 TO TRUE. DTSCS89 -01076 GO TO S007-YR-CONVERT. DTSCS89 -01077 S007-CONVERT-FAFD-YR. DTSCS89 -01078 MOVE FAFD-YR TO L007-YR-4-9. DTSCS89 -01079 SET L007-FROM-YR-4 TO TRUE. DTSCS89 -01080 GO TO S007-YR-CONVERT. DTSCS89 -01081 S007-YR-CONVERT. DTSCS89 -01082 EXEC CICS LINK DTSCS89 -01083 PROGRAM ('DTSCU007') DTSCS89 -01084 COMMAREA (L007-COMM-AREA) DTSCS89 -01085 END-EXEC. DTSCS89 -01086 S007-EXIT. DTSCS89 -01087 EXIT. DTSCS89 -01088 SKIP3 DTSCS89 -01089 S803-REQ-SCR-ID-EDIT. DTSCS89 -01090 EXEC CICS LINK DTSCS89 -01091 PROGRAM ('DTSCU803') DTSCS89 -01092 COMMAREA (DFHCOMMAREA) DTSCS89 -01093 END-EXEC. DTSCS89 -01094 S803-EXIT. DTSCS89 -01095 EXIT. DTSCS89 -01096 SKIP3 DTSCS89 -01097 S804-INVALID-KEY. DTSCS89 -01098 EXEC CICS LINK DTSCS89 -01099 PROGRAM ('DTSCU804') DTSCS89 -01100 COMMAREA (DFHCOMMAREA) DTSCS89 -01101 END-EXEC. DTSCS89 -01102 S804-EXIT. DTSCS89 -01103 EXIT. DTSCS89 -01104 SKIP3 DTSCS89 -01105 S805-MSG-AREA. DTSCS89 -01106 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS89 -01107 SKIP1 DTSCS89 -01108 EXEC CICS LINK DTSCS89 -01109 PROGRAM ('DTSCU805') DTSCS89 -01110 COMMAREA (L805-COMM-AREA) DTSCS89 -01111 END-EXEC. DTSCS89 +00970 MOVE FAFD-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS89 +00971 SET L001-FROM-FED-8 TO TRUE. DTSCS89 +00972 PERFORM S001-DATE THRU S001-EXIT. DTSCS89 +00973 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS89 +00974 SKIP1 DTSCS89 +00975 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89 +00976 P8200-EXIT. DTSCS89 +00977 EXIT. DTSCS89 +00978 /*****************************************************************DTSCS89 +00979 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS89 +00980 ******************************************************************DTSCS89 +00981 SKIP1 DTSCS89 +00982 P8300-DEL. DTSCS89 +00983 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS89 +00984 SKIP1 DTSCS89 +00985 IF LCCM-F12-88 DTSCS89 +00986 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS89 +00987 GO TO P8300-EXIT. DTSCS89 +00988 SKIP1 DTSCS89 +00989 PERFORM S8010-READ-FAFD THRU S8010-EXIT. DTSCS89 +00990 IF NOT L831-OK-88 DTSCS89 +00991 MOVE EMSG-NO-RECORD TO WRK-MSG-ID DTSCS89 +00992 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +00993 GO TO P8300-EXIT. DTSCS89 +00994 SKIP1 DTSCS89 +00995 PERFORM S831-DELETE THRU S831-EXIT. DTSCS89 +00996 SKIP1 DTSCS89 +00997 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS89 +00998 SET LCCM-SCR-CLEAR TO TRUE. DTSCS89 +00999 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS89 +01000 SKIP1 DTSCS89 +01001 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 +01002 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS89 +01003 SKIP1 DTSCS89 +01004 PERFORM S007-CONVERT-FAFD-YR THRU S007-EXIT. DTSCS89 +01005 IF L007-VALID-YR DTSCS89 +01006 MOVE L007-YR-2-X TO MAP-YR DTSCS89 +01007 ELSE DTSCS89 +01008 GO TO S899-ABEND. DTSCS89 +01009 SKIP1 DTSCS89 +01010 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS89 +01011 P8300-EXIT. DTSCS89 +01012 EXIT. DTSCS89 +01013 EJECT DTSCS89 +01014 P8900-CONSTRUCT-FAFD. DTSCS89 +01015 SKIP1 DTSCS89 +01016 MOVE MAP-UC30H-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01017 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01018 MOVE L015-DATE TO FAFD-UC30H-MASS-MAIL-DATEDTSCS89 +01019 SKIP1 DTSCS89 +01020 MOVE MAP-UC30H-RPT-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01021 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01022 MOVE L015-DATE TO FAFD-UC30H-RPT-DUE-DATE. DTSCS89 +01023 SKIP1 DTSCS89 +01024 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01025 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01026 MOVE L015-DATE TO FAFD-LATE-PEN-ASSESSED-DATE. DTSCS89 +01027 SKIP1 DTSCS89 +01028 MOVE MAP-UC30H-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01029 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01030 MOVE L015-DATE TO FAFD-UC30H-FIRST-DEL-DATEDTSCS89 +01031 SKIP1 DTSCS89 +01032 MOVE MAP-UC30H-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. CL**2 +01033 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01034 MOVE L015-DATE TO FAFD-UC30H-ESTIMATED-DATE CL**2 +01035 SKIP1 DTSCS89 +01036 MOVE MAP-UC30H-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01037 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01038 MOVE L015-DATE TO FAFD-UC30H-FINAL-ACTION-DATE. DTSCS89 +01039 SKIP1 DTSCS89 +01040 P8900-EXIT. DTSCS89 +01041 EXIT. DTSCS89 +01042 /*****************************************************************DTSCS89 +01043 * LINKS TO UTILITY MODULES DTSCS89 +01044 ******************************************************************DTSCS89 +01045 SKIP1 DTSCS89 +01046 S001-DATE. DTSCS89 +01047 EXEC CICS LINK DTSCS89 +01048 PROGRAM ('DTSCU001') DTSCS89 +01049 COMMAREA (L001-COMM-AREA) DTSCS89 +01050 END-EXEC. DTSCS89 +01051 S001-EXIT. DTSCS89 +01052 EXIT. DTSCS89 +01053 SKIP3 DTSCS89 +01054 S004-YRQ-CONVERT. DTSCS89 +01055 EXEC CICS LINK DTSCS89 +01056 PROGRAM ('DTSCU004') DTSCS89 +01057 COMMAREA (L004-COMM-AREA) DTSCS89 +01058 END-EXEC. DTSCS89 +01059 S004-EXIT. DTSCS89 +01060 EXIT. DTSCS89 +01061 SKIP3 DTSCS89 +01062 S015-DATE-AREA. DTSCS89 +01063 EXEC CICS LINK DTSCS89 +01064 PROGRAM ('DTSCU015') DTSCS89 +01065 COMMAREA (L015-COMM-AREA) DTSCS89 +01066 END-EXEC. DTSCS89 +01067 S015-EXIT. DTSCS89 +01068 EXIT. DTSCS89 +01069 SKIP3 DTSCS89 +01070 S016-YRQ-CONVERT. DTSCS89 +01071 EXEC CICS LINK DTSCS89 +01072 PROGRAM ('DTSCU016') DTSCS89 +01073 COMMAREA (L016-COMM-AREA) DTSCS89 +01074 END-EXEC. DTSCS89 +01075 S016-EXIT. DTSCS89 +01076 EXIT. DTSCS89 +01077 SKIP3 DTSCS89 +01078 S007-CHECK-MAP-YR. DTSCS89 +01079 MOVE MAP-YR TO L007-YR-2-X. DTSCS89 +01080 SET L007-FROM-YR-2 TO TRUE. DTSCS89 +01081 GO TO S007-YR-CONVERT. DTSCS89 +01082 S007-CONVERT-FAFD-YR. DTSCS89 +01083 MOVE FAFD-YR TO L007-YR-4-9. DTSCS89 +01084 SET L007-FROM-YR-4 TO TRUE. DTSCS89 +01085 GO TO S007-YR-CONVERT. DTSCS89 +01086 S007-YR-CONVERT. DTSCS89 +01087 EXEC CICS LINK DTSCS89 +01088 PROGRAM ('DTSCU007') DTSCS89 +01089 COMMAREA (L007-COMM-AREA) DTSCS89 +01090 END-EXEC. DTSCS89 +01091 S007-EXIT. DTSCS89 +01092 EXIT. DTSCS89 +01093 SKIP3 DTSCS89 +01094 S803-REQ-SCR-ID-EDIT. DTSCS89 +01095 EXEC CICS LINK DTSCS89 +01096 PROGRAM ('DTSCU803') DTSCS89 +01097 COMMAREA (DFHCOMMAREA) DTSCS89 +01098 END-EXEC. DTSCS89 +01099 S803-EXIT. DTSCS89 +01100 EXIT. DTSCS89 +01101 SKIP3 DTSCS89 +01102 S804-INVALID-KEY. DTSCS89 +01103 EXEC CICS LINK DTSCS89 +01104 PROGRAM ('DTSCU804') DTSCS89 +01105 COMMAREA (DFHCOMMAREA) DTSCS89 +01106 END-EXEC. DTSCS89 +01107 S804-EXIT. DTSCS89 +01108 EXIT. DTSCS89 +01109 SKIP3 DTSCS89 +01110 S805-MSG-AREA. DTSCS89 +01111 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS89 01112 SKIP1 DTSCS89 -01113 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS89 -01114 S805-EXIT. DTSCS89 -01115 EXIT. DTSCS89 -01116 EJECT DTSCS89 -01117 S831-READ. DTSCS89 -01118 SET L831-READ-88 TO TRUE. DTSCS89 -01119 GO TO S831-IO. DTSCS89 -01120 SKIP1 DTSCS89 -01121 S831-START-BROWSE. DTSCS89 -01122 SET L831-START-BROWSE-88 TO TRUE. DTSCS89 -01123 GO TO S831-IO. DTSCS89 -01124 SKIP1 DTSCS89 -01125 S831-READ-NEXT. DTSCS89 -01126 SET L831-READ-NEXT-88 TO TRUE. DTSCS89 -01127 GO TO S831-IO. DTSCS89 -01128 SKIP1 DTSCS89 -01129 S831-READ-PREV. DTSCS89 -01130 SET L831-READ-PREV-88 TO TRUE. DTSCS89 -01131 GO TO S831-IO. DTSCS89 -01132 SKIP1 DTSCS89 -01133 S831-END-BROWSE. DTSCS89 -01134 SET L831-END-BROWSE-88 TO TRUE. DTSCS89 -01135 GO TO S831-IO. DTSCS89 -01136 SKIP1 DTSCS89 -01137 S831-REWRITE. DTSCS89 -01138 SET L831-REWRITE-88 TO TRUE. DTSCS89 -01139 GO TO S831-IO. DTSCS89 -01140 SKIP1 DTSCS89 -01141 S831-WRITE. DTSCS89 -01142 SET L831-WRITE-88 TO TRUE. DTSCS89 -01143 GO TO S831-IO. DTSCS89 -01144 SKIP1 DTSCS89 -01145 S831-DELETE. DTSCS89 -01146 SET L831-DELETE-88 TO TRUE. DTSCS89 -01147 GO TO S831-IO. DTSCS89 -01148 SKIP1 DTSCS89 -01149 S831-IO. DTSCS89 -01150 SKIP1 DTSCS89 -01151 EXEC CICS LINK DTSCS89 -01152 PROGRAM ('DTSCU831') DTSCS89 -01153 COMMAREA (L831-COMM-AREA) DTSCS89 -01154 END-EXEC. DTSCS89 +01113 EXEC CICS LINK DTSCS89 +01114 PROGRAM ('DTSCU805') DTSCS89 +01115 COMMAREA (L805-COMM-AREA) DTSCS89 +01116 END-EXEC. DTSCS89 +01117 SKIP1 DTSCS89 +01118 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS89 +01119 S805-EXIT. DTSCS89 +01120 EXIT. DTSCS89 +01121 EJECT DTSCS89 +01122 S831-READ. DTSCS89 +01123 SET L831-READ-88 TO TRUE. DTSCS89 +01124 GO TO S831-IO. DTSCS89 +01125 SKIP1 DTSCS89 +01126 S831-START-BROWSE. DTSCS89 +01127 SET L831-START-BROWSE-88 TO TRUE. DTSCS89 +01128 GO TO S831-IO. DTSCS89 +01129 SKIP1 DTSCS89 +01130 S831-READ-NEXT. DTSCS89 +01131 SET L831-READ-NEXT-88 TO TRUE. DTSCS89 +01132 GO TO S831-IO. DTSCS89 +01133 SKIP1 DTSCS89 +01134 S831-READ-PREV. DTSCS89 +01135 SET L831-READ-PREV-88 TO TRUE. DTSCS89 +01136 GO TO S831-IO. DTSCS89 +01137 SKIP1 DTSCS89 +01138 S831-END-BROWSE. DTSCS89 +01139 SET L831-END-BROWSE-88 TO TRUE. DTSCS89 +01140 GO TO S831-IO. DTSCS89 +01141 SKIP1 DTSCS89 +01142 S831-REWRITE. DTSCS89 +01143 SET L831-REWRITE-88 TO TRUE. DTSCS89 +01144 GO TO S831-IO. DTSCS89 +01145 SKIP1 DTSCS89 +01146 S831-WRITE. DTSCS89 +01147 SET L831-WRITE-88 TO TRUE. DTSCS89 +01148 GO TO S831-IO. DTSCS89 +01149 SKIP1 DTSCS89 +01150 S831-DELETE. DTSCS89 +01151 SET L831-DELETE-88 TO TRUE. DTSCS89 +01152 GO TO S831-IO. DTSCS89 +01153 SKIP1 DTSCS89 +01154 S831-IO. DTSCS89 01155 SKIP1 DTSCS89 -01156 IF L831-FILE-CLOSED-88 DTSCS89 -01157 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS89 -01158 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS89 -01159 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS89 -01160 GO TO MAINLINE-EXIT. DTSCS89 -01161 S831-EXIT. DTSCS89 -01162 EXIT. DTSCS89 -01163 SKIP3 DTSCS89 -01164 S851-SCREEN-PROCESSING. DTSCS89 -01165 EXEC CICS LINK DTSCS89 -01166 PROGRAM ('DTSCU851') DTSCS89 -01167 COMMAREA (L851-COMM-AREA) DTSCS89 -01168 END-EXEC. DTSCS89 -01169 S851-EXIT. DTSCS89 -01170 EXIT. DTSCS89 -01171 SKIP3 DTSCS89 -01172 S899-ABEND. DTSCS89 -01173 EXEC CICS ABEND DTSCS89 -01174 ABCODE(WRK-ABEND-CD) DTSCS89 -01175 END-EXEC. DTSCS89 -01176 S899-EXIT. DTSCS89 -01177 EXIT. DTSCS89 -01178 /*****************************************************************DTSCS89 -01179 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS89 -01180 ******************************************************************DTSCS89 -01181 SKIP1 DTSCS89 -01182 S1001-SCREEN-KEY-EDITS. DTSCS89 -01183 SKIP1 DTSCS89 -01184 PERFORM S1100-YR THRU S1100-EXIT. DTSCS89 -01185 SKIP1 DTSCS89 -01186 S1001-EXIT. DTSCS89 -01187 EXIT. DTSCS89 -01188 SKIP3 DTSCS89 -01189 S1002-SCREEN-DATA-EDITS. DTSCS89 +01156 EXEC CICS LINK DTSCS89 +01157 PROGRAM ('DTSCU831') DTSCS89 +01158 COMMAREA (L831-COMM-AREA) DTSCS89 +01159 END-EXEC. DTSCS89 +01160 SKIP1 DTSCS89 +01161 IF L831-FILE-CLOSED-88 DTSCS89 +01162 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS89 +01163 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS89 +01164 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS89 +01165 GO TO MAINLINE-EXIT. DTSCS89 +01166 S831-EXIT. DTSCS89 +01167 EXIT. DTSCS89 +01168 SKIP3 DTSCS89 +01169 S851-SCREEN-PROCESSING. DTSCS89 +01170 EXEC CICS LINK DTSCS89 +01171 PROGRAM ('DTSCU851') DTSCS89 +01172 COMMAREA (L851-COMM-AREA) DTSCS89 +01173 END-EXEC. DTSCS89 +01174 S851-EXIT. DTSCS89 +01175 EXIT. DTSCS89 +01176 SKIP3 DTSCS89 +01177 S899-ABEND. DTSCS89 +01178 EXEC CICS ABEND DTSCS89 +01179 ABCODE(WRK-ABEND-CD) DTSCS89 +01180 END-EXEC. DTSCS89 +01181 S899-EXIT. DTSCS89 +01182 EXIT. DTSCS89 +01183 /*****************************************************************DTSCS89 +01184 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS89 +01185 ******************************************************************DTSCS89 +01186 SKIP1 DTSCS89 +01187 S1001-SCREEN-KEY-EDITS. DTSCS89 +01188 SKIP1 DTSCS89 +01189 PERFORM S1100-YR THRU S1100-EXIT. DTSCS89 01190 SKIP1 DTSCS89 -01191 MOVE +0 TO WRK-UC30H-MASS-MAIL-DATE DTSCS89 -01192 WRK-UC30H-RPT-DUE-DATE DTSCS89 -01193 WRK-UC30H-LATE-PEN-DATE DTSCS89 -01194 WRK-UC30H-FIRST-DEL-DATE DTSCS89 -01195 WRK-UC30H-FINAL-DEL-DATE. DTSCS89 -01196 SKIP1 DTSCS89 -01197 MOVE FAFD-YR TO L004-QTR-5-YR. DTSCS89 -01198 MOVE 3 TO L004-QTR-5-Q. DTSCS89 -01199 SET L004-FROM-5 TO TRUE. DTSCS89 -01200 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS89 -01201 MOVE L004-QTR-START-DATE TO WRK-YRQ-START-DATE. DTSCS89 -01202 MOVE L004-QTR-END-DATE TO WRK-YRQ-END-DATE. DTSCS89 -01203 SKIP1 DTSCS89 -01204 MOVE FAFD-YR TO L004-QTR-5-YR. DTSCS89 -01205 ADD +1 TO L004-QTR-5-YR. DTSCS89 -01206 MOVE 1 TO L004-QTR-5-Q. DTSCS89 -01207 SET L004-FROM-5 TO TRUE. DTSCS89 -01208 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS89 -01209 MOVE L004-QTR-START-DATE TO WRK-YRQ-PLUS1-START-DATE. DTSCS89 -01210 MOVE L004-QTR-END-DATE TO WRK-YRQ-PLUS1-END-DATE. DTSCS89 -01211 SKIP1 DTSCS89 -01212 ******************************************************************DTSCS89 -01213 * REPORT DUE DATE CANNOT BE LESS THAN 4/15 OF THE YEAR *DTSCS89 -01214 * FOLLOWING THE REPORT YEAR OR MAY NOT BE GREATER THAN 4/15 *DTSCS89 -01215 * OF THE SECOND YEAR FOLLOWING THE REPORT YEAR DTSCS89 -01216 ******************************************************************DTSCS89 -01217 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS89 -01218 MOVE 4 TO L001-FED-8-MO. DTSCS89 -01219 MOVE 15 TO L001-FED-8-DA. DTSCS89 -01220 SET L001-FROM-FED-8 TO TRUE DTSCS89 -01221 PERFORM S001-DATE THRU S001-EXIT DTSCS89 -01222 IF L001-VALID-DATE DTSCS89 -01223 MOVE L001-FED-8-DATE-9 TO WRK-YRQ-PLUS1-START-DATE DTSCS89 -01224 ELSE DTSCS89 -01225 MOVE ZERO TO WRK-YRQ-PLUS1-START-DATE. DTSCS89 -01226 DTSCS89 -01227 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS89 -01228 ADD 1 TO L001-FED-8-YR. DTSCS89 -01229 SET L001-FROM-FED-8 TO TRUE DTSCS89 -01230 PERFORM S001-DATE THRU S001-EXIT DTSCS89 -01231 IF L001-VALID-DATE DTSCS89 -01232 MOVE L001-FED-8-DATE-9 TO WRK-YRQ-PLUS1-END-DATE DTSCS89 -01233 ELSE DTSCS89 -01234 MOVE ZERO TO WRK-YRQ-PLUS1-END-DATE. DTSCS89 -01235 SKIP1 DTSCS89 -01236 PERFORM S1200-UC30H-MASS-MAIL-DATE THRU S1200-EXIT. DTSCS89 -01237 PERFORM S1250-UC30H-RPT-DUE-DATE THRU S1250-EXIT. DTSCS89 -01238 PERFORM S1300-UC30H-FIRST-DEL-DATE THRU S1300-EXIT. DTSCS89 -01239 PERFORM S1400-UC30H-FINAL-DEL-DATE THRU S1400-EXIT. DTSCS89 -01240 PERFORM S1600-LATE-PEN-ASSESSED-DATE THRU S1600-EXIT. DTSCS89 -01241 PERFORM S1700-UC30H-FINAL-ACT-DATE THRU S1700-EXIT. DTSCS89 -01242 SKIP1 DTSCS89 -01243 S1002-EXIT. DTSCS89 -01244 EXIT. DTSCS89 -01245 EJECT DTSCS89 -01246 S1100-YR. DTSCS89 -01247 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 -01248 IF L007-NOT-VALID-YR DTSCS89 -01249 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS89 -01250 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 -01251 ELSE DTSCS89 -01252 IF (L007-START-YRQ <= LCCM-PICKUP-YRQ) DTSCS89 -01253 OR DTSCS89 -01254 (L007-YR-2-9 NOT > WRK-ANN-START-YR) DTSCS89 -01255 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01256 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 -01257 S1100-EXIT. DTSCS89 -01258 EXIT. DTSCS89 -01259 SKIP3 DTSCS89 -01260 S1101-ERROR. DTSCS89 -01261 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A. DTSCS89 -01262 DTSCS89 -01263 IF LCCM-NO-MSG DTSCS89 -01264 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01265 MOVE CATB-CURSOR TO MAP-YR-L DTSCS89 -01266 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01267 S1101-EXIT. DTSCS89 -01268 EXIT. DTSCS89 -01269 EJECT DTSCS89 -01270 S1200-UC30H-MASS-MAIL-DATE. DTSCS89 -01271 MOVE MAP-UC30H-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01272 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01273 IF L015-NO-ENTRY DTSCS89 -01274 MOVE WRK-NO-ENTRY TO WRK-UC30H-MASS-MAIL-DATE DTSCS89 -01275 GO TO S1200-EXIT. DTSCS89 -01276 IF L015-NOT-VALID DTSCS89 -01277 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01278 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS89 -01279 GO TO S1200-EXIT. DTSCS89 -01280 SKIP1 DTSCS89 -01281 IF L015-DATE < WRK-YRQ-END-DATE DTSCS89 -01282 OR L015-DATE > WRK-YRQ-PLUS1-START-DATE DTSCS89 -01283 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01284 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS89 -01285 ELSE DTSCS89 -01286 MOVE L015-DATE TO WRK-UC30H-MASS-MAIL-DATE. DTSCS89 -01287 S1200-EXIT. DTSCS89 -01288 EXIT. DTSCS89 -01289 SKIP3 DTSCS89 -01290 S1201-ERROR. DTSCS89 -01291 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-MASS-MAIL-MM-A DTSCS89 -01292 MAP-UC30H-MASS-MAIL-DD-A DTSCS89 -01293 MAP-UC30H-MASS-MAIL-YY-A. DTSCS89 -01294 IF LCCM-NO-MSG DTSCS89 -01295 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01296 MOVE CATB-CURSOR TO MAP-UC30H-MASS-MAIL-MM-L DTSCS89 -01297 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01298 S1201-EXIT. DTSCS89 -01299 EXIT. DTSCS89 -01300 /*****************************************************************DTSCS89 -01301 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1250 *DTSCS89 -01302 ******************************************************************DTSCS89 -01303 S1250-UC30H-RPT-DUE-DATE. DTSCS89 -01304 MOVE MAP-UC30H-RPT-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01305 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01306 IF L015-NO-ENTRY DTSCS89 -01307 NEXT SENTENCE DTSCS89 -01308 ELSE DTSCS89 -01309 IF L015-NOT-VALID DTSCS89 -01310 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01311 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 -01312 ELSE DTSCS89 -01313 IF WRK-UC30H-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS89 -01314 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 -01315 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 -01316 ELSE DTSCS89 -01317 IF L015-DATE < WRK-UC30H-MASS-MAIL-DATE DTSCS89 -01318 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01319 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 -01320 ELSE DTSCS89 -01321 IF L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS89 -01322 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01323 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 -01324 ELSE DTSCS89 -01325 MOVE L015-DATE TO WRK-UC30H-RPT-DUE-DATE. DTSCS89 -01326 * DTSCS89 -01327 MOVE WRK-UC30H-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSCS89 -01328 ADD 1 TO L001-FED-8-YR. DTSCS89 -01329 SET L001-FROM-FED-8 TO TRUE DTSCS89 -01330 PERFORM S001-DATE THRU S001-EXIT DTSCS89 -01331 IF L001-VALID-DATE DTSCS89 -01332 MOVE L001-FED-8-DATE-9 TO WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89 -01333 ELSE DTSCS89 -01334 MOVE ZERO TO WRK-UC30H-PLUS1-RPT-DUE-DATE. DTSCS89 -01335 DTSCS89 -01336 S1250-EXIT. DTSCS89 -01337 EXIT. DTSCS89 -01338 SKIP3 DTSCS89 -01339 S1251-ERROR. DTSCS89 -01340 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-RPT-DUE-MM-A DTSCS89 -01341 MAP-UC30H-RPT-DUE-DD-A DTSCS89 -01342 MAP-UC30H-RPT-DUE-YY-A. DTSCS89 -01343 IF LCCM-NO-MSG DTSCS89 -01344 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01345 MOVE CATB-CURSOR TO MAP-UC30H-RPT-DUE-MM-L DTSCS89 -01346 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01347 S1251-EXIT. DTSCS89 -01348 EXIT. DTSCS89 -01349 /*****************************************************************DTSCS89 -01350 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1300 *DTSCS89 -01351 ******************************************************************DTSCS89 -01352 S1300-UC30H-FIRST-DEL-DATE. DTSCS89 -01353 MOVE MAP-UC30H-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01354 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01355 IF L015-NO-ENTRY DTSCS89 -01356 MOVE WRK-NO-ENTRY TO WRK-UC30H-FIRST-DEL-DATE DTSCS89 -01357 ELSE DTSCS89 -01358 IF L015-NOT-VALID DTSCS89 -01359 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01360 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 -01361 ELSE DTSCS89 -01362 IF L015-DATE < WRK-UC30H-RPT-DUE-DATE DTSCS89 -01363 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01364 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 -01365 ELSE DTSCS89 -01366 IF L015-DATE > WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89 -01367 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01368 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 -01369 ELSE DTSCS89 -01370 IF WRK-UC30H-RPT-DUE-DATE = WRK-NO-ENTRY DTSCS89 -01371 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 -01372 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 -01373 ELSE DTSCS89 -01374 MOVE L015-DATE TO WRK-UC30H-FIRST-DEL-DATE. DTSCS89 -01375 * DTSCS89 -01376 MOVE WRK-UC30H-FIRST-DEL-DATE TO L001-FED-8-DATE-9. DTSCS89 -01377 ADD 1 TO L001-FED-8-YR. DTSCS89 -01378 SET L001-FROM-FED-8 TO TRUE DTSCS89 -01379 PERFORM S001-DATE THRU S001-EXIT DTSCS89 -01380 IF L001-VALID-DATE DTSCS89 -01381 MOVE L001-FED-8-DATE-9 TO WRK-UC30H-PLUS1-1ST-DEL-DATE DTSCS89 -01382 ELSE DTSCS89 -01383 MOVE ZERO TO WRK-UC30H-PLUS1-1ST-DEL-DATE. DTSCS89 -01384 DTSCS89 -01385 S1300-EXIT. DTSCS89 -01386 EXIT. DTSCS89 -01387 SKIP3 DTSCS89 -01388 S1301-ERROR. DTSCS89 -01389 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-FIRST-DEL-MM-A DTSCS89 -01390 MAP-UC30H-FIRST-DEL-DD-A DTSCS89 -01391 MAP-UC30H-FIRST-DEL-YY-A. DTSCS89 -01392 IF LCCM-NO-MSG DTSCS89 -01393 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01394 MOVE CATB-CURSOR TO MAP-UC30H-FIRST-DEL-MM-L DTSCS89 -01395 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01396 S1301-EXIT. DTSCS89 -01397 EXIT. DTSCS89 -01398 /*****************************************************************DTSCS89 -01399 * WORK FIELDS MUST BE SET BY S1300 BEFORE PERFORMING S1400 *DTSCS89 -01400 ******************************************************************DTSCS89 -01401 S1400-UC30H-FINAL-DEL-DATE. DTSCS89 -01402 MOVE MAP-UC30H-FINAL-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01403 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01404 IF L015-NO-ENTRY DTSCS89 -01405 MOVE WRK-NO-ENTRY TO WRK-UC30H-FINAL-DEL-DATE DTSCS89 -01406 ELSE DTSCS89 -01407 IF L015-NOT-VALID DTSCS89 -01408 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01409 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 -01410 ELSE DTSCS89 -01411 IF L015-DATE < WRK-UC30H-FIRST-DEL-DATE DTSCS89 -01412 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01413 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 -01414 ELSE DTSCS89 -01415 IF WRK-UC30H-FIRST-DEL-DATE = WRK-NO-ENTRY DTSCS89 -01416 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 -01417 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 -01418 ELSE DTSCS89 -01419 IF L015-DATE > WRK-UC30H-PLUS1-1ST-DEL-DATE DTSCS89 -01420 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01421 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 -01422 ELSE DTSCS89 -01423 MOVE L015-DATE TO WRK-UC30H-FINAL-DEL-DATE. DTSCS89 -01424 S1400-EXIT. DTSCS89 -01425 EXIT. DTSCS89 -01426 SKIP3 DTSCS89 -01427 S1401-ERROR. DTSCS89 -01428 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-FINAL-DEL-MM-A DTSCS89 -01429 MAP-UC30H-FINAL-DEL-DD-A DTSCS89 -01430 MAP-UC30H-FINAL-DEL-YY-A. DTSCS89 -01431 IF LCCM-NO-MSG DTSCS89 -01432 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01433 MOVE CATB-CURSOR TO MAP-UC30H-FINAL-DEL-MM-L DTSCS89 -01434 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01435 S1401-EXIT. DTSCS89 -01436 EXIT. DTSCS89 -01437 /*****************************************************************DTSCS89 -01438 * WORK FIELDS MUST BE SET BY S1100 BEFORE PERFORMING S1600 *DTSCS89 -01439 ******************************************************************DTSCS89 -01440 S1600-LATE-PEN-ASSESSED-DATE. DTSCS89 -01441 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01442 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01443 IF L015-NO-ENTRY DTSCS89 -01444 NEXT SENTENCE DTSCS89 -01445 ELSE DTSCS89 -01446 IF L015-NOT-VALID DTSCS89 -01447 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01448 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 -01449 ELSE DTSCS89 -01450 IF L015-DATE < WRK-UC30H-RPT-DUE-DATE DTSCS89 -01451 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01452 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 -01453 ELSE DTSCS89 -01454 IF L015-DATE > WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89 -01455 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01456 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 -01457 ELSE DTSCS89 -01458 IF WRK-UC30H-RPT-DUE-DATE = WRK-NO-ENTRY DTSCS89 -01459 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 -01460 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 -01461 ELSE DTSCS89 -01462 MOVE L015-DATE TO WRK-UC30H-LATE-PEN-DATE. DTSCS89 -01463 S1600-EXIT. DTSCS89 -01464 EXIT. DTSCS89 -01465 SKIP3 DTSCS89 -01466 S1601-ERROR. DTSCS89 -01467 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LATE-PEN-ASSESSED-MM-ADTSCS89 -01468 MAP-LATE-PEN-ASSESSED-DD-A DTSCS89 -01469 MAP-LATE-PEN-ASSESSED-YY-A. DTSCS89 -01470 IF LCCM-NO-MSG DTSCS89 -01471 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01472 MOVE CATB-CURSOR TO MAP-LATE-PEN-ASSESSED-MM-L DTSCS89 -01473 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01474 S1601-EXIT. DTSCS89 -01475 EXIT. DTSCS89 -01476 /*****************************************************************DTSCS89 -01477 * WORK FIELDS MUST BE SET BY S1400 BEFORE PERFORMING S1500 *DTSCS89 -01478 ******************************************************************DTSCS89 -01479 S1700-UC30H-FINAL-ACT-DATE. DTSCS89 -01480 MOVE MAP-UC30H-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 -01481 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 -01482 IF L015-NO-ENTRY DTSCS89 -01483 NEXT SENTENCE DTSCS89 -01484 ELSE DTSCS89 -01485 IF L015-NOT-VALID DTSCS89 -01486 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01487 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89 -01488 ELSE DTSCS89 -01489 IF L015-DATE < WRK-UC30H-FINAL-DEL-DATE DTSCS89 -01490 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 -01491 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89 -01492 ELSE DTSCS89 -01493 IF WRK-UC30H-FINAL-DEL-DATE = WRK-NO-ENTRY DTSCS89 -01494 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 -01495 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89 -01496 ELSE DTSCS89 -01497 MOVE L015-DATE TO WRK-UC30H-FINAL-ACT-DATE. DTSCS89 -01498 S1700-EXIT. DTSCS89 -01499 EXIT. DTSCS89 -01500 SKIP3 DTSCS89 -01501 S1701-ERROR. DTSCS89 -01502 MOVE CATB-UNPROT-NORM-NUM-MDTON TO DTSCS89 -01503 MAP-UC30H-FINAL-ACTION-MM-A DTSCS89 -01504 MAP-UC30H-FINAL-ACTION-DD-A DTSCS89 -01505 MAP-UC30H-FINAL-ACTION-YY-A. DTSCS89 -01506 IF LCCM-NO-MSG DTSCS89 -01507 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 -01508 MOVE CATB-CURSOR TO MAP-UC30H-FINAL-ACTION-MM-L DTSCS89 -01509 SET CURSOR-SET-YES TO TRUE. DTSCS89 -01510 S1701-EXIT. DTSCS89 -01511 EXIT. DTSCS89 -01512 DTSCS89 -01513 /*****************************************************************DTSCS89 -01514 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS89 -01515 ******************************************************************DTSCS89 -01516 S5100-SET-LOCK-ATTRB. DTSCS89 -01517 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS89 -01518 WRK-ATB-NUM. DTSCS89 -01519 SKIP1 DTSCS89 -01520 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89 -01521 SKIP1 DTSCS89 -01522 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS89 -01523 MAP-GOTO-A. DTSCS89 -01524 S5100-EXIT. DTSCS89 -01525 EXIT. DTSCS89 -01526 SKIP3 DTSCS89 -01527 ******************************************************************DTSCS89 -01528 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS89 -01529 ******************************************************************DTSCS89 -01530 S5200-SET-UPDATE-ATTRB. DTSCS89 -01531 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS89 -01532 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS89 -01533 SKIP1 DTSCS89 -01534 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89 -01535 S5200-EXIT. DTSCS89 -01536 EXIT. DTSCS89 -01537 SKIP3 DTSCS89 -01538 ******************************************************************DTSCS89 -01539 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS89 -01540 ******************************************************************DTSCS89 -01541 S5300-SET-INQ-ATTRB. DTSCS89 -01542 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS89 -01543 WRK-ATB-NUM. DTSCS89 -01544 SKIP1 DTSCS89 -01545 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89 -01546 S5300-EXIT. DTSCS89 -01547 EXIT. DTSCS89 -01548 SKIP3 DTSCS89 -01549 ******************************************************************DTSCS89 -01550 * DO IT *DTSCS89 -01551 ******************************************************************DTSCS89 -01552 S5900-SET-ATTRB. DTSCS89 -01553 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A. DTSCS89 -01554 SKIP1 DTSCS89 -01555 MOVE WRK-ATB-NUM TO MAP-UC30H-MASS-MAIL-MM-A DTSCS89 -01556 MAP-UC30H-MASS-MAIL-DD-A DTSCS89 -01557 MAP-UC30H-MASS-MAIL-YY-A DTSCS89 -01558 MAP-UC30H-RPT-DUE-MM-A DTSCS89 -01559 MAP-UC30H-RPT-DUE-DD-A DTSCS89 -01560 MAP-UC30H-RPT-DUE-YY-A DTSCS89 -01561 MAP-UC30H-FIRST-DEL-MM-A DTSCS89 -01562 MAP-UC30H-FIRST-DEL-DD-A DTSCS89 -01563 MAP-UC30H-FIRST-DEL-YY-A DTSCS89 -01564 MAP-UC30H-FINAL-DEL-MM-A DTSCS89 -01565 MAP-UC30H-FINAL-DEL-DD-A DTSCS89 -01566 MAP-UC30H-FINAL-DEL-YY-A DTSCS89 -01567 MAP-LATE-PEN-ASSESSED-MM-A DTSCS89 -01568 MAP-LATE-PEN-ASSESSED-DD-A DTSCS89 -01569 MAP-LATE-PEN-ASSESSED-YY-A DTSCS89 -01570 MAP-UC30H-FINAL-ACTION-MM-A DTSCS89 -01571 MAP-UC30H-FINAL-ACTION-DD-A DTSCS89 -01572 MAP-UC30H-FINAL-ACTION-YY-A. DTSCS89 -01573 SKIP1 DTSCS89 -01574 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS89 -01575 MAP-CHNG-DATE-A. DTSCS89 -01576 SKIP1 DTSCS89 -01577 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS89 -01578 S5900-EXIT. DTSCS89 -01579 EXIT. DTSCS89 -01580 /*****************************************************************DTSCS89 -01581 * READ PREPARATION ROUTINES *DTSCS89 -01582 ******************************************************************DTSCS89 -01583 S8010-READ-FAFD. DTSCS89 -01584 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 -01585 IF L007-VALID-YR DTSCS89 -01586 MOVE LOW-VALUES TO FAFD-KEY-AREA DTSCS89 -01587 SET FAFD-AFD-88 TO TRUE DTSCS89 -01588 MOVE L007-YR-4-9 TO FAFD-YR DTSCS89 -01589 PERFORM S831-READ THRU S831-EXIT DTSCS89 -01590 ELSE DTSCS89 -01591 GO TO S899-ABEND. DTSCS89 -01592 S8010-EXIT. DTSCS89 -01593 EXIT. DTSCS89 -01594 /*****************************************************************DTSCS89 -01595 * MAP ROUTINES *DTSCS89 -01596 ******************************************************************DTSCS89 -01597 S9100-RECEIVE. DTSCS89 -01598 SET L851-RECEIVE-88 TO TRUE. DTSCS89 -01599 SKIP1 DTSCS89 -01600 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS89 -01601 SKIP1 DTSCS89 -01602 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89 -01603 SKIP1 DTSCS89 -01604 MOVE L851-AID TO LCCM-AID. DTSCS89 -01605 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS89 -01606 S9100-EXIT. DTSCS89 -01607 EXIT. DTSCS89 -01608 SKIP3 DTSCS89 -01609 S9200-SEND-DATAONLY. DTSCS89 -01610 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 -01611 SKIP1 DTSCS89 -01612 IF LCCM-NO-MSG DTSCS89 -01613 NEXT SENTENCE DTSCS89 -01614 ELSE DTSCS89 -01615 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS89 +01191 S1001-EXIT. DTSCS89 +01192 EXIT. DTSCS89 +01193 SKIP3 DTSCS89 +01194 S1002-SCREEN-DATA-EDITS. DTSCS89 +01195 SKIP1 DTSCS89 +01196 MOVE +0 TO WRK-UC30H-MASS-MAIL-DATE DTSCS89 +01197 WRK-UC30H-RPT-DUE-DATE DTSCS89 +01198 WRK-UC30H-LATE-PEN-DATE DTSCS89 +01199 WRK-UC30H-FIRST-DEL-DATE DTSCS89 +01200 WRK-UC30H-ESTIMATED-DATE. CL**2 +01201 SKIP1 DTSCS89 +01202 MOVE FAFD-YR TO L004-QTR-5-YR. DTSCS89 +01203 MOVE 3 TO L004-QTR-5-Q. DTSCS89 +01204 SET L004-FROM-5 TO TRUE. DTSCS89 +01205 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS89 +01206 MOVE L004-QTR-START-DATE TO WRK-YRQ-START-DATE. DTSCS89 +01207 MOVE L004-QTR-END-DATE TO WRK-YRQ-END-DATE. DTSCS89 +01208 SKIP1 DTSCS89 +01209 MOVE FAFD-YR TO L004-QTR-5-YR. DTSCS89 +01210 ADD +1 TO L004-QTR-5-YR. DTSCS89 +01211 MOVE 1 TO L004-QTR-5-Q. DTSCS89 +01212 SET L004-FROM-5 TO TRUE. DTSCS89 +01213 PERFORM S004-YRQ-CONVERT THRU S004-EXIT. DTSCS89 +01214 MOVE L004-QTR-START-DATE TO WRK-YRQ-PLUS1-START-DATE. DTSCS89 +01215 MOVE L004-QTR-END-DATE TO WRK-YRQ-PLUS1-END-DATE. DTSCS89 +01216 SKIP1 DTSCS89 +01217 ******************************************************************DTSCS89 +01218 * REPORT DUE DATE CANNOT BE LESS THAN 4/15 OF THE YEAR *DTSCS89 +01219 * FOLLOWING THE REPORT YEAR OR MAY NOT BE GREATER THAN 4/15 *DTSCS89 +01220 * OF THE SECOND YEAR FOLLOWING THE REPORT YEAR DTSCS89 +01221 ******************************************************************DTSCS89 +01222 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS89 +01223 MOVE 4 TO L001-FED-8-MO. DTSCS89 +01224 MOVE 15 TO L001-FED-8-DA. DTSCS89 +01225 SET L001-FROM-FED-8 TO TRUE DTSCS89 +01226 PERFORM S001-DATE THRU S001-EXIT DTSCS89 +01227 IF L001-VALID-DATE DTSCS89 +01228 MOVE L001-FED-8-DATE-9 TO WRK-YRQ-PLUS1-START-DATE DTSCS89 +01229 ELSE DTSCS89 +01230 MOVE ZERO TO WRK-YRQ-PLUS1-START-DATE. DTSCS89 +01231 DTSCS89 +01232 MOVE WRK-YRQ-PLUS1-START-DATE TO L001-FED-8-DATE-9. DTSCS89 +01233 ADD 1 TO L001-FED-8-YR. DTSCS89 +01234 SET L001-FROM-FED-8 TO TRUE DTSCS89 +01235 PERFORM S001-DATE THRU S001-EXIT DTSCS89 +01236 IF L001-VALID-DATE DTSCS89 +01237 MOVE L001-FED-8-DATE-9 TO WRK-YRQ-PLUS1-END-DATE DTSCS89 +01238 ELSE DTSCS89 +01239 MOVE ZERO TO WRK-YRQ-PLUS1-END-DATE. DTSCS89 +01240 SKIP1 DTSCS89 +01241 PERFORM S1200-UC30H-MASS-MAIL-DATE THRU S1200-EXIT. DTSCS89 +01242 PERFORM S1250-UC30H-RPT-DUE-DATE THRU S1250-EXIT. DTSCS89 +01243 PERFORM S1300-UC30H-FIRST-DEL-DATE THRU S1300-EXIT. DTSCS89 +01244 PERFORM S1400-UC30H-ESTIMATED-DATE THRU S1400-EXIT. CL**2 +01245 PERFORM S1600-LATE-PEN-ASSESSED-DATE THRU S1600-EXIT. DTSCS89 +01246 PERFORM S1700-UC30H-FINAL-ACT-DATE THRU S1700-EXIT. DTSCS89 +01247 SKIP1 DTSCS89 +01248 S1002-EXIT. DTSCS89 +01249 EXIT. DTSCS89 +01250 EJECT DTSCS89 +01251 S1100-YR. DTSCS89 +01252 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 +01253 IF L007-NOT-VALID-YR DTSCS89 +01254 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-ID DTSCS89 +01255 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS89 +01256 ELSE DTSCS89 +01257 IF (L007-START-YRQ <= LCCM-PICKUP-YRQ) DTSCS89 +01258 OR DTSCS89 +01259 (L007-YR-2-9 NOT > WRK-ANN-START-YR) DTSCS89 +01260 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01261 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS89 +01262 S1100-EXIT. DTSCS89 +01263 EXIT. DTSCS89 +01264 SKIP3 DTSCS89 +01265 S1101-ERROR. DTSCS89 +01266 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-YR-A. DTSCS89 +01267 DTSCS89 +01268 IF LCCM-NO-MSG DTSCS89 +01269 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01270 MOVE CATB-CURSOR TO MAP-YR-L DTSCS89 +01271 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01272 S1101-EXIT. DTSCS89 +01273 EXIT. DTSCS89 +01274 EJECT DTSCS89 +01275 S1200-UC30H-MASS-MAIL-DATE. DTSCS89 +01276 MOVE MAP-UC30H-MASS-MAIL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01277 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01278 IF L015-NO-ENTRY DTSCS89 +01279 MOVE WRK-NO-ENTRY TO WRK-UC30H-MASS-MAIL-DATE DTSCS89 +01280 GO TO S1200-EXIT. DTSCS89 +01281 IF L015-NOT-VALID DTSCS89 +01282 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01283 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS89 +01284 GO TO S1200-EXIT. DTSCS89 +01285 SKIP1 DTSCS89 +01286 IF L015-DATE < WRK-YRQ-END-DATE DTSCS89 +01287 OR L015-DATE > WRK-YRQ-PLUS1-START-DATE DTSCS89 +01288 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01289 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS89 +01290 ELSE DTSCS89 +01291 MOVE L015-DATE TO WRK-UC30H-MASS-MAIL-DATE. DTSCS89 +01292 S1200-EXIT. DTSCS89 +01293 EXIT. DTSCS89 +01294 SKIP3 DTSCS89 +01295 S1201-ERROR. DTSCS89 +01296 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-MASS-MAIL-MM-A DTSCS89 +01297 MAP-UC30H-MASS-MAIL-DD-A DTSCS89 +01298 MAP-UC30H-MASS-MAIL-YY-A. DTSCS89 +01299 IF LCCM-NO-MSG DTSCS89 +01300 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01301 MOVE CATB-CURSOR TO MAP-UC30H-MASS-MAIL-MM-L DTSCS89 +01302 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01303 S1201-EXIT. DTSCS89 +01304 EXIT. DTSCS89 +01305 /*****************************************************************DTSCS89 +01306 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1250 *DTSCS89 +01307 ******************************************************************DTSCS89 +01308 S1250-UC30H-RPT-DUE-DATE. DTSCS89 +01309 MOVE MAP-UC30H-RPT-DUE-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01310 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01311 IF L015-NO-ENTRY DTSCS89 +01312 NEXT SENTENCE DTSCS89 +01313 ELSE DTSCS89 +01314 IF L015-NOT-VALID DTSCS89 +01315 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01316 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 +01317 ELSE DTSCS89 +01318 IF WRK-UC30H-MASS-MAIL-DATE = WRK-NO-ENTRY DTSCS89 +01319 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 +01320 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 +01321 ELSE DTSCS89 +01322 IF L015-DATE < WRK-UC30H-MASS-MAIL-DATE DTSCS89 +01323 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01324 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 +01325 ELSE DTSCS89 +01326 IF L015-DATE > WRK-YRQ-PLUS1-END-DATE DTSCS89 +01327 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01328 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS89 +01329 ELSE DTSCS89 +01330 MOVE L015-DATE TO WRK-UC30H-RPT-DUE-DATE. DTSCS89 +01331 * DTSCS89 +01332 MOVE WRK-UC30H-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSCS89 +01333 ADD 1 TO L001-FED-8-YR. DTSCS89 +01334 SET L001-FROM-FED-8 TO TRUE DTSCS89 +01335 PERFORM S001-DATE THRU S001-EXIT DTSCS89 +01336 IF L001-VALID-DATE DTSCS89 +01337 MOVE L001-FED-8-DATE-9 TO WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89 +01338 ELSE DTSCS89 +01339 MOVE ZERO TO WRK-UC30H-PLUS1-RPT-DUE-DATE. DTSCS89 +01340 DTSCS89 +01341 S1250-EXIT. DTSCS89 +01342 EXIT. DTSCS89 +01343 SKIP3 DTSCS89 +01344 S1251-ERROR. DTSCS89 +01345 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-RPT-DUE-MM-A DTSCS89 +01346 MAP-UC30H-RPT-DUE-DD-A DTSCS89 +01347 MAP-UC30H-RPT-DUE-YY-A. DTSCS89 +01348 IF LCCM-NO-MSG DTSCS89 +01349 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01350 MOVE CATB-CURSOR TO MAP-UC30H-RPT-DUE-MM-L DTSCS89 +01351 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01352 S1251-EXIT. DTSCS89 +01353 EXIT. DTSCS89 +01354 /*****************************************************************DTSCS89 +01355 * WORK FIELDS MUST BE SET BY S1200 BEFORE PERFORMING S1300 *DTSCS89 +01356 ******************************************************************DTSCS89 +01357 S1300-UC30H-FIRST-DEL-DATE. DTSCS89 +01358 MOVE MAP-UC30H-FIRST-DEL-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01359 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01360 IF L015-NO-ENTRY DTSCS89 +01361 MOVE WRK-NO-ENTRY TO WRK-UC30H-FIRST-DEL-DATE DTSCS89 +01362 ELSE DTSCS89 +01363 IF L015-NOT-VALID DTSCS89 +01364 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01365 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 +01366 ELSE DTSCS89 +01367 IF L015-DATE < WRK-UC30H-RPT-DUE-DATE DTSCS89 +01368 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01369 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 +01370 ELSE DTSCS89 +01371 IF L015-DATE > WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89 +01372 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01373 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 +01374 ELSE DTSCS89 +01375 IF WRK-UC30H-RPT-DUE-DATE = WRK-NO-ENTRY DTSCS89 +01376 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 +01377 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS89 +01378 ELSE DTSCS89 +01379 MOVE L015-DATE TO WRK-UC30H-FIRST-DEL-DATE. DTSCS89 +01380 * DTSCS89 +01381 MOVE WRK-UC30H-FIRST-DEL-DATE TO L001-FED-8-DATE-9. DTSCS89 +01382 ADD 1 TO L001-FED-8-YR. DTSCS89 +01383 SET L001-FROM-FED-8 TO TRUE DTSCS89 +01384 PERFORM S001-DATE THRU S001-EXIT DTSCS89 +01385 IF L001-VALID-DATE DTSCS89 +01386 MOVE L001-FED-8-DATE-9 TO WRK-UC30H-PLUS1-1ST-DEL-DATE DTSCS89 +01387 ELSE DTSCS89 +01388 MOVE ZERO TO WRK-UC30H-PLUS1-1ST-DEL-DATE. DTSCS89 +01389 DTSCS89 +01390 S1300-EXIT. DTSCS89 +01391 EXIT. DTSCS89 +01392 SKIP3 DTSCS89 +01393 S1301-ERROR. DTSCS89 +01394 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-FIRST-DEL-MM-A DTSCS89 +01395 MAP-UC30H-FIRST-DEL-DD-A DTSCS89 +01396 MAP-UC30H-FIRST-DEL-YY-A. DTSCS89 +01397 IF LCCM-NO-MSG DTSCS89 +01398 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01399 MOVE CATB-CURSOR TO MAP-UC30H-FIRST-DEL-MM-L DTSCS89 +01400 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01401 S1301-EXIT. DTSCS89 +01402 EXIT. DTSCS89 +01403 /*****************************************************************DTSCS89 +01404 * WORK FIELDS MUST BE SET BY S1300 BEFORE PERFORMING S1400 *DTSCS89 +01405 ******************************************************************DTSCS89 +01406 S1400-UC30H-ESTIMATED-DATE. CL**2 +01407 MOVE MAP-UC30H-ESTIMATED-DATE-AREA TO L015-S-DATE-AREA. CL**2 +01408 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01409 IF L015-NO-ENTRY DTSCS89 +01410 MOVE WRK-NO-ENTRY TO WRK-UC30H-ESTIMATED-DATE CL**2 +01411 ELSE DTSCS89 +01412 IF L015-NOT-VALID DTSCS89 +01413 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01414 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 +01415 ELSE DTSCS89 +01416 IF L015-DATE < WRK-UC30H-FIRST-DEL-DATE DTSCS89 +01417 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01418 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 +01419 ELSE DTSCS89 +01420 IF WRK-UC30H-FIRST-DEL-DATE = WRK-NO-ENTRY DTSCS89 +01421 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 +01422 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 +01423 ELSE DTSCS89 +01424 IF L015-DATE > WRK-UC30H-PLUS1-1ST-DEL-DATE DTSCS89 +01425 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01426 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS89 +01427 ELSE DTSCS89 +01428 MOVE L015-DATE TO WRK-UC30H-ESTIMATED-DATE. CL**2 +01429 S1400-EXIT. DTSCS89 +01430 EXIT. DTSCS89 +01431 SKIP3 DTSCS89 +01432 S1401-ERROR. DTSCS89 +01433 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UC30H-ESTIMATED-MM-A CL**2 +01434 MAP-UC30H-ESTIMATED-DD-A CL**2 +01435 MAP-UC30H-ESTIMATED-YY-A. CL**2 +01436 IF LCCM-NO-MSG DTSCS89 +01437 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01438 MOVE CATB-CURSOR TO MAP-UC30H-ESTIMATED-MM-L CL**2 +01439 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01440 S1401-EXIT. DTSCS89 +01441 EXIT. DTSCS89 +01442 /*****************************************************************DTSCS89 +01443 * WORK FIELDS MUST BE SET BY S1100 BEFORE PERFORMING S1600 *DTSCS89 +01444 ******************************************************************DTSCS89 +01445 S1600-LATE-PEN-ASSESSED-DATE. DTSCS89 +01446 MOVE MAP-LATE-PEN-ASSESS-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01447 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01448 IF L015-NO-ENTRY DTSCS89 +01449 NEXT SENTENCE DTSCS89 +01450 ELSE DTSCS89 +01451 IF L015-NOT-VALID DTSCS89 +01452 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01453 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 +01454 ELSE DTSCS89 +01455 IF L015-DATE < WRK-UC30H-RPT-DUE-DATE DTSCS89 +01456 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01457 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 +01458 ELSE DTSCS89 +01459 IF L015-DATE > WRK-UC30H-PLUS1-RPT-DUE-DATE DTSCS89 +01460 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01461 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 +01462 ELSE DTSCS89 +01463 IF WRK-UC30H-RPT-DUE-DATE = WRK-NO-ENTRY DTSCS89 +01464 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 +01465 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS89 +01466 ELSE DTSCS89 +01467 MOVE L015-DATE TO WRK-UC30H-LATE-PEN-DATE. DTSCS89 +01468 S1600-EXIT. DTSCS89 +01469 EXIT. DTSCS89 +01470 SKIP3 DTSCS89 +01471 S1601-ERROR. DTSCS89 +01472 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LATE-PEN-ASSESSED-MM-ADTSCS89 +01473 MAP-LATE-PEN-ASSESSED-DD-A DTSCS89 +01474 MAP-LATE-PEN-ASSESSED-YY-A. DTSCS89 +01475 IF LCCM-NO-MSG DTSCS89 +01476 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01477 MOVE CATB-CURSOR TO MAP-LATE-PEN-ASSESSED-MM-L DTSCS89 +01478 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01479 S1601-EXIT. DTSCS89 +01480 EXIT. DTSCS89 +01481 /*****************************************************************DTSCS89 +01482 * WORK FIELDS MUST BE SET BY S1400 BEFORE PERFORMING S1500 *DTSCS89 +01483 ******************************************************************DTSCS89 +01484 S1700-UC30H-FINAL-ACT-DATE. DTSCS89 +01485 MOVE MAP-UC30H-FINAL-ACT-DATE-AREA TO L015-S-DATE-AREA. DTSCS89 +01486 PERFORM S015-DATE-AREA THRU S015-EXIT. DTSCS89 +01487 IF L015-NO-ENTRY DTSCS89 +01488 NEXT SENTENCE DTSCS89 +01489 ELSE DTSCS89 +01490 IF L015-NOT-VALID DTSCS89 +01491 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01492 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89 +01493 ELSE DTSCS89 +01494 IF L015-DATE < WRK-UC30H-FIRST-DEL-DATE CL**2 +01495 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-ID DTSCS89 +01496 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89 +01497 ELSE DTSCS89 +01498 IF WRK-UC30H-ESTIMATED-DATE = WRK-NO-ENTRY CL**2 +01499 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-ID DTSCS89 +01500 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS89 +01501 ELSE DTSCS89 +01502 MOVE L015-DATE TO WRK-UC30H-FINAL-ACT-DATE. DTSCS89 +01503 S1700-EXIT. DTSCS89 +01504 EXIT. DTSCS89 +01505 SKIP3 DTSCS89 +01506 S1701-ERROR. DTSCS89 +01507 MOVE CATB-UNPROT-NORM-NUM-MDTON TO DTSCS89 +01508 MAP-UC30H-FINAL-ACTION-MM-A DTSCS89 +01509 MAP-UC30H-FINAL-ACTION-DD-A DTSCS89 +01510 MAP-UC30H-FINAL-ACTION-YY-A. DTSCS89 +01511 IF LCCM-NO-MSG DTSCS89 +01512 MOVE WRK-MSG-ID TO LCCM-MSG-ID DTSCS89 +01513 MOVE CATB-CURSOR TO MAP-UC30H-FINAL-ACTION-MM-L DTSCS89 +01514 SET CURSOR-SET-YES TO TRUE. DTSCS89 +01515 S1701-EXIT. DTSCS89 +01516 EXIT. DTSCS89 +01517 DTSCS89 +01518 /*****************************************************************DTSCS89 +01519 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS89 +01520 ******************************************************************DTSCS89 +01521 S5100-SET-LOCK-ATTRB. DTSCS89 +01522 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS89 +01523 WRK-ATB-NUM. DTSCS89 +01524 SKIP1 DTSCS89 +01525 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89 +01526 SKIP1 DTSCS89 +01527 MOVE CATB-ASKIP-BRT-MDTON TO MAP-YR-A DTSCS89 +01528 MAP-GOTO-A. DTSCS89 +01529 S5100-EXIT. DTSCS89 +01530 EXIT. DTSCS89 +01531 SKIP3 DTSCS89 +01532 ******************************************************************DTSCS89 +01533 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS89 +01534 ******************************************************************DTSCS89 +01535 S5200-SET-UPDATE-ATTRB. DTSCS89 +01536 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS89 +01537 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS89 +01538 SKIP1 DTSCS89 +01539 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89 +01540 S5200-EXIT. DTSCS89 +01541 EXIT. DTSCS89 +01542 SKIP3 DTSCS89 +01543 ******************************************************************DTSCS89 +01544 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS89 +01545 ******************************************************************DTSCS89 +01546 S5300-SET-INQ-ATTRB. DTSCS89 +01547 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS89 +01548 WRK-ATB-NUM. DTSCS89 +01549 SKIP1 DTSCS89 +01550 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS89 +01551 S5300-EXIT. DTSCS89 +01552 EXIT. DTSCS89 +01553 SKIP3 DTSCS89 +01554 ******************************************************************DTSCS89 +01555 * DO IT *DTSCS89 +01556 ******************************************************************DTSCS89 +01557 S5900-SET-ATTRB. DTSCS89 +01558 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-YR-A. DTSCS89 +01559 SKIP1 DTSCS89 +01560 MOVE WRK-ATB-NUM TO MAP-UC30H-MASS-MAIL-MM-A DTSCS89 +01561 MAP-UC30H-MASS-MAIL-DD-A DTSCS89 +01562 MAP-UC30H-MASS-MAIL-YY-A DTSCS89 +01563 MAP-UC30H-RPT-DUE-MM-A DTSCS89 +01564 MAP-UC30H-RPT-DUE-DD-A DTSCS89 +01565 MAP-UC30H-RPT-DUE-YY-A DTSCS89 +01566 MAP-UC30H-FIRST-DEL-MM-A DTSCS89 +01567 MAP-UC30H-FIRST-DEL-DD-A DTSCS89 +01568 MAP-UC30H-FIRST-DEL-YY-A DTSCS89 +01569 MAP-UC30H-ESTIMATED-MM-A CL**2 +01570 MAP-UC30H-ESTIMATED-DD-A CL**2 +01571 MAP-UC30H-ESTIMATED-YY-A CL**2 +01572 MAP-LATE-PEN-ASSESSED-MM-A DTSCS89 +01573 MAP-LATE-PEN-ASSESSED-DD-A DTSCS89 +01574 MAP-LATE-PEN-ASSESSED-YY-A DTSCS89 +01575 MAP-UC30H-FINAL-ACTION-MM-A DTSCS89 +01576 MAP-UC30H-FINAL-ACTION-DD-A DTSCS89 +01577 MAP-UC30H-FINAL-ACTION-YY-A. DTSCS89 +01578 SKIP1 DTSCS89 +01579 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS89 +01580 MAP-CHNG-DATE-A. DTSCS89 +01581 SKIP1 DTSCS89 +01582 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS89 +01583 S5900-EXIT. DTSCS89 +01584 EXIT. DTSCS89 +01585 /*****************************************************************DTSCS89 +01586 * READ PREPARATION ROUTINES *DTSCS89 +01587 ******************************************************************DTSCS89 +01588 S8010-READ-FAFD. DTSCS89 +01589 PERFORM S007-CHECK-MAP-YR THRU S007-EXIT. DTSCS89 +01590 IF L007-VALID-YR DTSCS89 +01591 MOVE LOW-VALUES TO FAFD-KEY-AREA DTSCS89 +01592 SET FAFD-AFD-88 TO TRUE DTSCS89 +01593 MOVE L007-YR-4-9 TO FAFD-YR DTSCS89 +01594 PERFORM S831-READ THRU S831-EXIT DTSCS89 +01595 ELSE DTSCS89 +01596 GO TO S899-ABEND. DTSCS89 +01597 S8010-EXIT. DTSCS89 +01598 EXIT. DTSCS89 +01599 /*****************************************************************DTSCS89 +01600 * MAP ROUTINES *DTSCS89 +01601 ******************************************************************DTSCS89 +01602 S9100-RECEIVE. DTSCS89 +01603 SET L851-RECEIVE-88 TO TRUE. DTSCS89 +01604 SKIP1 DTSCS89 +01605 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS89 +01606 SKIP1 DTSCS89 +01607 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89 +01608 SKIP1 DTSCS89 +01609 MOVE L851-AID TO LCCM-AID. DTSCS89 +01610 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS89 +01611 S9100-EXIT. DTSCS89 +01612 EXIT. DTSCS89 +01613 SKIP3 DTSCS89 +01614 S9200-SEND-DATAONLY. DTSCS89 +01615 MOVE LOW-VALUES TO MAP-AREA. DTSCS89 01616 SKIP1 DTSCS89 -01617 IF CURSOR-SET-GOTO DTSCS89 -01618 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS89 +01617 IF LCCM-NO-MSG DTSCS89 +01618 NEXT SENTENCE DTSCS89 01619 ELSE DTSCS89 -01620 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS89 +01620 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS89 01621 SKIP1 DTSCS89 -01622 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS89 -01623 SKIP1 DTSCS89 -01624 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS89 -01625 SKIP1 DTSCS89 -01626 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89 -01627 S9200-EXIT. DTSCS89 -01628 EXIT. DTSCS89 -01629 SKIP3 DTSCS89 -01630 S9300-SEND-MAP. DTSCS89 -01631 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS89 -01632 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS89 -01633 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS89 -01634 SKIP1 DTSCS89 -01635 IF SCR-ACCESS-UPDATE DTSCS89 -01636 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS89 -01637 ELSE DTSCS89 -01638 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS89 +01622 IF CURSOR-SET-GOTO DTSCS89 +01623 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS89 +01624 ELSE DTSCS89 +01625 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS89 +01626 SKIP1 DTSCS89 +01627 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS89 +01628 SKIP1 DTSCS89 +01629 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS89 +01630 SKIP1 DTSCS89 +01631 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89 +01632 S9200-EXIT. DTSCS89 +01633 EXIT. DTSCS89 +01634 SKIP3 DTSCS89 +01635 S9300-SEND-MAP. DTSCS89 +01636 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS89 +01637 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS89 +01638 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS89 01639 SKIP1 DTSCS89 -01640 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS89 -01641 SKIP1 DTSCS89 -01642 IF CURSOR-SET-NO DTSCS89 -01643 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS89 +01640 IF SCR-ACCESS-UPDATE DTSCS89 +01641 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS89 +01642 ELSE DTSCS89 +01643 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS89 01644 SKIP1 DTSCS89 -01645 SET L851-SEND-88 TO TRUE. DTSCS89 +01645 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS89 01646 SKIP1 DTSCS89 -01647 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS89 -01648 SKIP1 DTSCS89 -01649 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89 -01650 S9300-EXIT. DTSCS89 -01651 EXIT. DTSCS89 -01652 SKIP3 DTSCS89 -01653 S9310-UPDATE-FKEYS. DTSCS89 -01654 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS89 -01655 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS89 -01656 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS89 -01657 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS89 -01658 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS89 -01659 SKIP1 DTSCS89 -01660 IF LCCM-SCR-CLEAR DTSCS89 -01661 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS89 -01662 MAP-KEY-DEL DTSCS89 -01663 ELSE DTSCS89 -01664 IF LCCM-SCR-UPDATE-LOCKED DTSCS89 -01665 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS89 -01666 MAP-KEY-FWRD DTSCS89 -01667 MAP-KEY-ADD DTSCS89 -01668 MAP-KEY-MOD DTSCS89 -01669 MAP-KEY-DEL DTSCS89 -01670 ELSE DTSCS89 -01671 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS89 -01672 S9310-EXIT. DTSCS89 -01673 EXIT. DTSCS89 -01674 SKIP3 DTSCS89 -01675 S9320-INQUIRY-FKEYS. DTSCS89 -01676 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS89 -01677 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS89 -01678 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS89 -01679 MAP-KEY-MOD DTSCS89 -01680 MAP-KEY-DEL. DTSCS89 -01681 S9320-EXIT. DTSCS89 -01682 EXIT. DTSCS89 -01683 SKIP3 DTSCS89 -01684 S9900-PREPARE-SEND. DTSCS89 -01685 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS89 -01686 LCCM-SCR-ID. DTSCS89 -01687 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS89 -01688 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS89 -01689 S9900-EXIT. DTSCS89 -01690 EXIT. DTSCS89 +01647 IF CURSOR-SET-NO DTSCS89 +01648 MOVE CATB-CURSOR TO MAP-YR-L. DTSCS89 +01649 SKIP1 DTSCS89 +01650 SET L851-SEND-88 TO TRUE. DTSCS89 +01651 SKIP1 DTSCS89 +01652 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS89 +01653 SKIP1 DTSCS89 +01654 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS89 +01655 S9300-EXIT. DTSCS89 +01656 EXIT. DTSCS89 +01657 SKIP3 DTSCS89 +01658 S9310-UPDATE-FKEYS. DTSCS89 +01659 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS89 +01660 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS89 +01661 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS89 +01662 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS89 +01663 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS89 +01664 SKIP1 DTSCS89 +01665 IF LCCM-SCR-CLEAR DTSCS89 +01666 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS89 +01667 MAP-KEY-DEL DTSCS89 +01668 ELSE DTSCS89 +01669 IF LCCM-SCR-UPDATE-LOCKED DTSCS89 +01670 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS89 +01671 MAP-KEY-FWRD DTSCS89 +01672 MAP-KEY-ADD DTSCS89 +01673 MAP-KEY-MOD DTSCS89 +01674 MAP-KEY-DEL DTSCS89 +01675 ELSE DTSCS89 +01676 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS89 +01677 S9310-EXIT. DTSCS89 +01678 EXIT. DTSCS89 +01679 SKIP3 DTSCS89 +01680 S9320-INQUIRY-FKEYS. DTSCS89 +01681 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS89 +01682 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS89 +01683 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS89 +01684 MAP-KEY-MOD DTSCS89 +01685 MAP-KEY-DEL. DTSCS89 +01686 S9320-EXIT. DTSCS89 +01687 EXIT. DTSCS89 +01688 SKIP3 DTSCS89 +01689 S9900-PREPARE-SEND. DTSCS89 +01690 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS89 +01691 LCCM-SCR-ID. DTSCS89 +01692 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS89 +01693 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS89 +01694 S9900-EXIT. DTSCS89 +01695 EXIT. DTSCS89 diff --git a/CICS/DTSCSL1.cob b/CICS/DTSCSL1.cob index 8cf199e..f0adc9c 100644 --- a/CICS/DTSCSL1.cob +++ b/CICS/DTSCSL1.cob @@ -1,2406 +1,2354 @@ -00001 IDENTIFICATION DIVISION. 09/22/06 +00001 IDENTIFICATION DIVISION. 07/19/99 00002 PROGRAM-ID. DTSCSL1. DTSCSL1 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV023 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV021 00004 DATE-WRITTEN. MAY 1994. DTSCSL1 00005 DATE-COMPILED. DTSCSL1 00006 SKIP3 DTSCSL1 00007 ***** DTSCSL1 00008 * DTSCSL1 -00009 * FUNCTION: LMI INQUIRY/UPDATE DTSCSL1 +00009 * FUNCTION: LMI INQUIRY/UPDATE CL**2 00010 * SCREEN PROCESSOR. DTSCSL1 00011 * DTSCSL1 00012 * DTSCSL1 00013 * MODIFICATION LOG: DTSCSL1 00014 * DTSCSL1 -00015 * 03/28/99 INITIAL DEVELOPMENT COPIED FROM MACCSR1 DTSCSL1 -00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCSL1 +00015 * 03/28/99 INITIAL DEVELOPMENT COPIED FROM MACCSR1 CL**2 +00016 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00017 * DTSCSL1 00018 * DTSCSL1 -00019 * 05/27/1999 PICKUP MODIFICATIONS. ENTRY OF 'PU' IN YRQ. DTSCSL1 -00020 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCSL1 -00021 * DTSCSL1 -00022 * DTSCSL1 -00023 * 07/19/1999 DISPLAY AND UPDATE SIC AUX CD RATHER THAN DTSCSL1 -00024 * NAICS AUX CD. DTSCSL1 -00025 * REFERENCE: 07/16/1999 EMAIL PROGRAMMER: EHH DTSCSL1 -00026 * FROM GIL DTSCSL1 -00027 * DTSCSL1 -00028 * 07/19/1999 MODIFICATIONS FOR SEVEN DIGIT DC EMPLOYEE DTSCSL1 -00029 * COUNT DATA ELEMENTS. DTSCSL1 -00030 * REFERENCE: BUG FIX PROGRAMMER: EHH DTSCSL1 -00031 * DTSCSL1 -00032 * 07/19/1999 MODIFICATIONS TO BUGGY SIC CODE EDITS AND DTSCSL1 -00033 * TO BUGGY NAICS CODE EDITS. DTSCSL1 -00034 * REFERENCE: BUG FIX PROGRAMMER: EHH DTSCSL1 -00035 * DTSCSL1 -00036 * 09/21/2006 MODIFICATIONS TO ADD ALT NAIC CODE AND EDITS DTSCSL1 -00037 * REFERENCE: ALT NAIC PROGRAMMER: ZL1 DTSCSL1 -00038 * DTSCSL1 -00039 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSL1 -00040 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSL1 -00041 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCSL1 +00019 * 05/27/1999 PICKUP MODIFICATIONS. ENTRY OF 'PU' IN YRQ. CL*14 +00020 * REFERENCE: PICKUP DIR PROGRAMMER: EHH CL*14 +00021 * CL*14 +00022 * CL*14 +00023 * 07/19/1999 DISPLAY AND UPDATE SIC AUX CD RATHER THAN CL*16 +00024 * NAICS AUX CD. CL*16 +00025 * REFERENCE: 07/16/1999 EMAIL PROGRAMMER: EHH CL*16 +00026 * FROM GIL CL*16 +00027 * CL*16 +00028 * 07/19/1999 MODIFICATIONS FOR SEVEN DIGIT DC EMPLOYEE CL*17 +00029 * COUNT DATA ELEMENTS. CL*17 +00030 * REFERENCE: BUG FIX PROGRAMMER: EHH CL*17 +00031 * CL*17 +00032 * 07/19/1999 MODIFICATIONS TO BUGGY SIC CODE EDITS AND CL*17 +00033 * TO BUGGY NAICS CODE EDITS. CL*17 +00034 * REFERENCE: BUG FIX PROGRAMMER: EHH CL*17 +00035 * CL*17 +00036 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL*17 +00037 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL*17 +00038 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL*17 +00039 * DTSCSL1 +00040 * DTSCSL1 +00041 * DESCRIPTION: DTSCSL1 00042 * DTSCSL1 -00043 * DTSCSL1 -00044 * DESCRIPTION: DTSCSL1 -00045 * DTSCSL1 -00046 * CLEAR: DTSCSL1 +00043 * CLEAR: DTSCSL1 +00044 * DTSCSL1 +00045 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCSL1 +00046 * DTSCSL1 00047 * DTSCSL1 -00048 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCSL1 +00048 * JUMP: DTSCSL1 00049 * DTSCSL1 -00050 * DTSCSL1 -00051 * JUMP: DTSCSL1 +00050 * NONE. DTSCSL1 +00051 * DTSCSL1 00052 * DTSCSL1 -00053 * NONE. DTSCSL1 +00053 * INQUIRY: DTSCSL1 00054 * DTSCSL1 -00055 * DTSCSL1 -00056 * INQUIRY: DTSCSL1 +00055 * CONTROL FIELD(S): MAP-EMP-NO DTSCSL1 +00056 * MAP-YRQ. DTSCSL1 00057 * DTSCSL1 -00058 * CONTROL FIELD(S): MAP-EMP-NO DTSCSL1 -00059 * MAP-YRQ. DTSCSL1 +00058 * JUMP IN: DISPLAY PAGE OF DATA ASSOCIATED WITH DTSCSL1 +00059 * LCCM-EMP-NO AND LCCM-YRQ. DTSCSL1 00060 * DTSCSL1 -00061 * JUMP IN: DISPLAY PAGE OF DATA ASSOCIATED WITH DTSCSL1 -00062 * LCCM-EMP-NO AND LCCM-YRQ. DTSCSL1 -00063 * DTSCSL1 -00064 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCSL1 -00065 * DTSCSL1 -00066 * DISPLAY SEQUENCE: ASCENDING ON MQTR-YRQ. DTSCSL1 -00067 * DTSCSL1 -00068 * PAGE INITIALLY DISPLAYED: LAST. DTSCSL1 +00061 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCSL1 +00062 * DTSCSL1 +00063 * DISPLAY SEQUENCE: ASCENDING ON MQTR-YRQ. DTSCSL1 +00064 * DTSCSL1 +00065 * PAGE INITIALLY DISPLAYED: LAST. DTSCSL1 +00066 * DTSCSL1 +00067 * IF NO MQTR RECORD EXISTS, THEN SOME SPECIAL PROCESSING DTSCSL1 +00068 * IS NECESSARY. SEE THE SCREEN DESCRIPTION. DTSCSL1 00069 * DTSCSL1 -00070 * IF NO MQTR RECORD EXISTS, THEN SOME SPECIAL PROCESSING DTSCSL1 -00071 * IS NECESSARY. SEE THE SCREEN DESCRIPTION. DTSCSL1 +00070 * DTSCSL1 +00071 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCSL1 00072 * DTSCSL1 -00073 * DTSCSL1 -00074 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCSL1 +00073 * STANDARD LCCM-YRQ MAINTENANCE. DTSCSL1 +00074 * DTSCSL1 00075 * DTSCSL1 -00076 * STANDARD LCCM-YRQ MAINTENANCE. DTSCSL1 +00076 * STORE PAGING CONTROL INFORMATION IN LCCM-SCRL1-HOLD-AREA. CL**7 00077 * DTSCSL1 00078 * DTSCSL1 -00079 * STORE PAGING CONTROL INFORMATION IN LCCM-SCRL1-HOLD-AREA. DTSCSL1 +00079 * UPDATE: DTSCSL1 00080 * DTSCSL1 -00081 * DTSCSL1 -00082 * UPDATE: DTSCSL1 +00081 * MOD DTSCSL1 +00082 * DTSCSL1 00083 * DTSCSL1 -00084 * MOD DTSCSL1 +00084 * RECORDS READ: DTSCSL1 00085 * DTSCSL1 -00086 * DTSCSL1 -00087 * RECORDS READ: DTSCSL1 -00088 * DTSCSL1 -00089 * MASTER: DTSCSL1 +00086 * MASTER: DTSCSL1 +00087 * DTSCSL1 +00088 * MPRF DTSCSL1 +00089 * MQTR DTSCSL1 00090 * DTSCSL1 -00091 * MPRF DTSCSL1 -00092 * MQTR DTSCSL1 +00091 * DTSCSL1 +00092 * ALTERNATE INDEX: DTSCSL1 00093 * DTSCSL1 -00094 * DTSCSL1 -00095 * ALTERNATE INDEX: DTSCSL1 +00094 * NONE. DTSCSL1 +00095 * DTSCSL1 00096 * DTSCSL1 -00097 * NONE. DTSCSL1 +00097 * REFERENCE: DTSCSL1 00098 * DTSCSL1 -00099 * DTSCSL1 -00100 * REFERENCE: DTSCSL1 +00099 * NONE. DTSCSL1 +00100 * DTSCSL1 00101 * DTSCSL1 -00102 * NONE. DTSCSL1 +00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL1 00103 * DTSCSL1 -00104 * DTSCSL1 -00105 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL1 +00104 * NONE. DTSCSL1 +00105 * DTSCSL1 00106 * DTSCSL1 -00107 * NONE. DTSCSL1 +00107 * RECORDS UPDATED: DTSCSL1 00108 * DTSCSL1 -00109 * DTSCSL1 -00110 * RECORDS UPDATED: DTSCSL1 -00111 * DTSCSL1 -00112 * MASTER: DTSCSL1 +00109 * MASTER: DTSCSL1 +00110 * DTSCSL1 +00111 * MPRF (REWRITE) DTSCSL1 +00112 * MQTR (REWRITE) DTSCSL1 00113 * DTSCSL1 -00114 * MPRF (REWRITE) DTSCSL1 -00115 * MQTR (REWRITE) DTSCSL1 +00114 * DTSCSL1 +00115 * REFERENCE: DTSCSL1 00116 * DTSCSL1 -00117 * DTSCSL1 -00118 * REFERENCE: DTSCSL1 +00117 * NONE. DTSCSL1 +00118 * DTSCSL1 00119 * DTSCSL1 -00120 * NONE. DTSCSL1 +00120 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL1 00121 * DTSCSL1 -00122 * DTSCSL1 -00123 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL1 +00122 * NONE. DTSCSL1 +00123 * DTSCSL1 00124 * DTSCSL1 -00125 * NONE. DTSCSL1 +00125 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCSL1 00126 * DTSCSL1 -00127 * DTSCSL1 -00128 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCSL1 +00127 * IF MPRF-SIC-DIVISION IS MODIFIED DTSCSL1 +00128 * WRITE DTSIT006 (T006-TRN-CD = 02). CL**2 00129 * DTSCSL1 -00130 * IF MPRF-SIC-DIVISION IS MODIFIED DTSCSL1 -00131 * WRITE DTSIT006 (T006-TRN-CD = 02). DTSCSL1 +00130 * DTSCSL1 +00131 * TEMPORARY STORAGE USAGE: DTSCSL1 00132 * DTSCSL1 -00133 * DTSCSL1 -00134 * TEMPORARY STORAGE USAGE: DTSCSL1 +00133 * NONE DTSCSL1 +00134 * DTSCSL1 00135 * DTSCSL1 -00136 * NONE DTSCSL1 +00136 * MODULES LINKED TO: DTSCSL1 00137 * DTSCSL1 -00138 * DTSCSL1 -00139 * MODULES LINKED TO: DTSCSL1 -00140 * DTSCSL1 -00141 * DTSCU001 DATE EDIT/CONVERSION. DTSCSL1 -00142 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. DTSCSL1 -00143 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCSL1 -00144 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCSL1 -00145 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. DTSCSL1 -00146 * DTSCU038 R&A CODES EDIT/DESCRIPTION. DTSCSL1 -00147 * DTSCU039 R&A SIC EDIT/DESCRIPTION. DTSCSL1 -00148 * DTSSU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCSL1 -00149 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORD. DTSCSL1 -00150 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCSL1 -00151 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCSL1 -00152 * DTSCSL1 -00153 * DTSCSL1 -00154 ***** DTSCSL1 -00155 DTSCSL1 -00156 ENVIRONMENT DIVISION. DTSCSL1 -00157 DTSCSL1 -00158 DATA DIVISION. DTSCSL1 -00159 DTSCSL1 -00160 WORKING-STORAGE SECTION. DTSCSL1 -001605 77 PAN-VALET PICTURE X(24) VALUE '023DTSCSL1 09/22/06'. DTSCSL1 +00138 * DTSCU001 DATE EDIT/CONVERSION. CL**2 +00139 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. CL**2 +00140 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. CL*14 +00141 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. CL**2 +00142 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. CL**2 +00143 * DTSCU038 R&A CODES EDIT/DESCRIPTION. CL**2 +00144 * DTSCU039 R&A SIC EDIT/DESCRIPTION. CL**2 +00145 * DTSSU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. CL**2 +00146 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORD. CL**2 +00147 * DTSCU810 MASTER FILE INPUT/OUTPUT. CL**2 +00148 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. CL**2 +00149 * DTSCSL1 +00150 * DTSCSL1 +00151 ***** DTSCSL1 +00152 DTSCSL1 +00153 ENVIRONMENT DIVISION. DTSCSL1 +00154 DTSCSL1 +00155 DATA DIVISION. DTSCSL1 +00156 DTSCSL1 +00157 WORKING-STORAGE SECTION. DTSCSL1 +001575 77 PAN-VALET PICTURE X(24) VALUE '021DTSCSL1 07/19/99'. DTSCSL1 +00158 DTSCSL1 +00159 01 WRK-AREA. DTSCSL1 +00160 05 WRK-ABEND-CD PIC X(04) VALUE 'LM1 '. CL**2 00161 DTSCSL1 -00162 01 WRK-AREA. DTSCSL1 -00163 05 WRK-ABEND-CD PIC X(04) VALUE 'LM1 '. DTSCSL1 -00164 DTSCSL1 -00165 05 WRK-SCR-ID PIC X(02) VALUE 'L1'. DTSCSL1 -00166 05 FILLER REDEFINES WRK-SCR-ID. DTSCSL1 -00167 10 FILLER PIC X(01). DTSCSL1 -00168 10 WRK-SCR-ID-N PIC 9(01). DTSCSL1 -00169 DTSCSL1 -00170 05 WRK-F03-SCR-ID PIC X(02) VALUE 'L0'. DTSCSL1 +00162 05 WRK-SCR-ID PIC X(02) VALUE 'L1'. CL**2 +00163 05 FILLER REDEFINES WRK-SCR-ID. DTSCSL1 +00164 10 FILLER PIC X(01). DTSCSL1 +00165 10 WRK-SCR-ID-N PIC 9(01). DTSCSL1 +00166 DTSCSL1 +00167 05 WRK-F03-SCR-ID PIC X(02) VALUE 'L0'. CL**2 +00168 DTSCSL1 +00169 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCSL1 +00170 VALUE +99999. DTSCSL1 00171 DTSCSL1 -00172 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCSL1 -00173 VALUE +99999. DTSCSL1 -00174 DTSCSL1 -00175 05 SCR-ACCESS-IND PIC X(01). DTSCSL1 -00176 88 SCR-ACCESS-INQ VALUE '1'. DTSCSL1 -00177 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCSL1 -00178 DTSCSL1 -00179 05 CURSOR-SET-IND PIC X(01). DTSCSL1 -00180 88 CURSOR-SET-YES VALUE 'Y'. DTSCSL1 -00181 88 CURSOR-SET-NO VALUE 'N'. DTSCSL1 -00182 88 CURSOR-SET-GOTO VALUE 'G'. DTSCSL1 -00183 DTSCSL1 -00184 05 REQ-IND PIC X(01). DTSCSL1 -00185 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCSL1 -00186 88 REQ-ERROR VALUE 'O'. DTSCSL1 -00187 88 REQ-JUMP VALUE 'J'. DTSCSL1 -00188 88 REQ-UPDATE VALUE 'U'. DTSCSL1 -00189 88 REQ-INQUIRE VALUE 'I'. DTSCSL1 -00190 88 REQ-CLEAR VALUE 'C'. DTSCSL1 -00191 88 REQ-EDIT VALUE 'E'. DTSCSL1 -00192 DTSCSL1 -00193 05 RESP-IND PIC X(01). DTSCSL1 -00194 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCSL1 -00195 88 RESP-SEND-MAP VALUE 'M'. DTSCSL1 -00196 88 RESP-JUMP VALUE 'J'. DTSCSL1 -00197 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCSL1 -00198 DTSCSL1 -00199 05 WRK-MSG-AREA PIC X(64). DTSCSL1 +00172 05 SCR-ACCESS-IND PIC X(01). DTSCSL1 +00173 88 SCR-ACCESS-INQ VALUE '1'. DTSCSL1 +00174 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCSL1 +00175 DTSCSL1 +00176 05 CURSOR-SET-IND PIC X(01). DTSCSL1 +00177 88 CURSOR-SET-YES VALUE 'Y'. DTSCSL1 +00178 88 CURSOR-SET-NO VALUE 'N'. DTSCSL1 +00179 88 CURSOR-SET-GOTO VALUE 'G'. DTSCSL1 +00180 DTSCSL1 +00181 05 REQ-IND PIC X(01). DTSCSL1 +00182 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCSL1 +00183 88 REQ-ERROR VALUE 'O'. DTSCSL1 +00184 88 REQ-JUMP VALUE 'J'. DTSCSL1 +00185 88 REQ-UPDATE VALUE 'U'. DTSCSL1 +00186 88 REQ-INQUIRE VALUE 'I'. DTSCSL1 +00187 88 REQ-CLEAR VALUE 'C'. DTSCSL1 +00188 88 REQ-EDIT VALUE 'E'. DTSCSL1 +00189 DTSCSL1 +00190 05 RESP-IND PIC X(01). DTSCSL1 +00191 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCSL1 +00192 88 RESP-SEND-MAP VALUE 'M'. DTSCSL1 +00193 88 RESP-JUMP VALUE 'J'. DTSCSL1 +00194 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCSL1 +00195 DTSCSL1 +00196 05 WRK-MSG-AREA PIC X(64). DTSCSL1 +00197 DTSCSL1 +00198 05 WRK-ATB-AN PIC X(01). DTSCSL1 +00199 05 WRK-ATB-NUM PIC X(01). DTSCSL1 00200 DTSCSL1 -00201 05 WRK-ATB-AN PIC X(01). DTSCSL1 -00202 05 WRK-ATB-NUM PIC X(01). DTSCSL1 -00203 DTSCSL1 -00204 05 COMM-AREA-LENGTH PIC S9(04) COMP. DTSCSL1 -00205 DTSCSL1 -00206 05 JUID-MOD-IND PIC X(01). DTSCSL1 -00207 88 JUID-MOD-YES-88 VALUE 'Y'. DTSCSL1 -00208 88 JUID-MOD-NO-88 VALUE 'N'. DTSCSL1 -00209 DTSCSL1 -00210 05 WRK-KEY-INFO. DTSCSL1 -00211 10 WRK-EMP-NO PIC S9(07) COMP-3. DTSCSL1 -00212 10 WRK-YRQ PIC S9(05) COMP-3. DTSCSL1 -00213 DTSCSL1 -00214 05 WRK-MPRF-IND PIC X(01). DTSCSL1 -00215 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCSL1 -00216 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCSL1 -00217 05 WRK-MQTR-IND PIC X(01). DTSCSL1 -00218 88 WRK-MQTR-YES-88 VALUE 'Y'. DTSCSL1 -00219 88 WRK-MQTR-NO-88 VALUE 'N'. DTSCSL1 -00220 DTSCSL1 -00221 05 WRK-DISPLAY PIC 9(11). DTSCSL1 -00222 DTSCSL1 -00223 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 -00224 10 FILLER PIC X(05). DTSCSL1 -00225 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCSL1 -00226 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCSL1 -00227 DTSCSL1 -00228 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 -00229 10 FILLER PIC X(06). DTSCSL1 -00230 10 WRK-DISPLAY-YRQ PIC X(05). DTSCSL1 -00231 DTSCSL1 -00232 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 -00233 10 FILLER PIC X(05). DTSCSL1 -00234 10 WRK-DISPLAY-YR PIC X(02). DTSCSL1 -00235 10 WRK-DISPLAY-MO PIC X(02). DTSCSL1 -00236 10 WRK-DISPLAY-DA PIC X(02). DTSCSL1 -00237 DTSCSL1 -00238 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 -00239 10 FILLER PIC X(08). DTSCSL1 -00240 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCSL1 -00241 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCSL1 -00242 DTSCSL1 -00243 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 -00244 10 FILLER PIC X(02). DTSCSL1 -00245 10 WRK-CNT-DISPLAY PIC Z,ZZZ,ZZ9. DTSCSL1 -00246 10 WRK-CNT-DISPLAY-X REDEFINES DTSCSL1 -00247 WRK-CNT-DISPLAY PIC X(09). DTSCSL1 -00248 DTSCSL1 -00249 05 WRK-EMPL-DATA. DTSCSL1 -00250 10 WRK-1ST-MTH-EMPL-CNT DTSCSL1 -00251 PIC S9(07) COMP-3. DTSCSL1 -00252 88 WRK-1ST-MTH-NO-ENTRY-88 VALUE +9999999. DTSCSL1 -00253 10 WRK-2ND-MTH-EMPL-CNT DTSCSL1 -00254 PIC S9(07) COMP-3. DTSCSL1 -00255 88 WRK-2ND-MTH-NO-ENTRY-88 VALUE +9999999. DTSCSL1 -00256 10 WRK-3RD-MTH-EMPL-CNT DTSCSL1 -00257 PIC S9(07) COMP-3. DTSCSL1 -00258 88 WRK-3RD-MTH-NO-ENTRY-88 VALUE +9999999. DTSCSL1 +00201 05 COMM-AREA-LENGTH PIC S9(04) COMP. DTSCSL1 +00202 DTSCSL1 +00203 05 JUID-MOD-IND PIC X(01). DTSCSL1 +00204 88 JUID-MOD-YES-88 VALUE 'Y'. DTSCSL1 +00205 88 JUID-MOD-NO-88 VALUE 'N'. DTSCSL1 +00206 DTSCSL1 +00207 05 WRK-KEY-INFO. DTSCSL1 +00208 10 WRK-EMP-NO PIC S9(07) COMP-3. DTSCSL1 +00209 10 WRK-YRQ PIC S9(05) COMP-3. DTSCSL1 +00210 DTSCSL1 +00211 05 WRK-MPRF-IND PIC X(01). DTSCSL1 +00212 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCSL1 +00213 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCSL1 +00214 05 WRK-MQTR-IND PIC X(01). DTSCSL1 +00215 88 WRK-MQTR-YES-88 VALUE 'Y'. DTSCSL1 +00216 88 WRK-MQTR-NO-88 VALUE 'N'. DTSCSL1 +00217 DTSCSL1 +00218 05 WRK-DISPLAY PIC 9(11). DTSCSL1 +00219 DTSCSL1 +00220 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 +00221 10 FILLER PIC X(05). DTSCSL1 +00222 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCSL1 +00223 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCSL1 +00224 DTSCSL1 +00225 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 +00226 10 FILLER PIC X(06). DTSCSL1 +00227 10 WRK-DISPLAY-YRQ PIC X(05). DTSCSL1 +00228 DTSCSL1 +00229 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 +00230 10 FILLER PIC X(05). DTSCSL1 +00231 10 WRK-DISPLAY-YR PIC X(02). DTSCSL1 +00232 10 WRK-DISPLAY-MO PIC X(02). DTSCSL1 +00233 10 WRK-DISPLAY-DA PIC X(02). DTSCSL1 +00234 DTSCSL1 +00235 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 +00236 10 FILLER PIC X(08). DTSCSL1 +00237 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCSL1 +00238 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCSL1 +00239 DTSCSL1 +00240 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL1 +00241 10 FILLER PIC X(02). CL*17 +00242 10 WRK-CNT-DISPLAY PIC Z,ZZZ,ZZ9. CL*21 +00243 10 WRK-CNT-DISPLAY-X REDEFINES DTSCSL1 +00244 WRK-CNT-DISPLAY PIC X(09). CL*17 +00245 DTSCSL1 +00246 05 WRK-EMPL-DATA. DTSCSL1 +00247 10 WRK-1ST-MTH-EMPL-CNT DTSCSL1 +00248 PIC S9(07) COMP-3. CL*17 +00249 88 WRK-1ST-MTH-NO-ENTRY-88 VALUE +9999999. CL*17 +00250 10 WRK-2ND-MTH-EMPL-CNT DTSCSL1 +00251 PIC S9(07) COMP-3. CL*17 +00252 88 WRK-2ND-MTH-NO-ENTRY-88 VALUE +9999999. CL*17 +00253 10 WRK-3RD-MTH-EMPL-CNT DTSCSL1 +00254 PIC S9(07) COMP-3. CL*17 +00255 88 WRK-3RD-MTH-NO-ENTRY-88 VALUE +9999999. CL*17 +00256 DTSCSL1 +00257 05 INQUIRY-CONTROL-AREA. DTSCSL1 +00258 10 WS-REC-FOUND-IND PIC X(01). DTSCSL1 00259 DTSCSL1 -00260 05 INQUIRY-CONTROL-AREA. DTSCSL1 -00261 10 WS-REC-FOUND-IND PIC X(01). DTSCSL1 -00262 DTSCSL1 -00263 05 SCR-HOLD-AREA. DTSCSL1 -00264 10 SCR-HOLD-KEY-INFO. DTSCSL1 -00265 15 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCSL1 -00266 15 SCR-HOLD-YRQ PIC S9(05) COMP-3. DTSCSL1 -00267 10 SCR-HOLD-CURR-PAGE-NUM PIC S9(04) COMP. DTSCSL1 -00268 10 FILLER PIC X(11). DTSCSL1 -00269 SKIP3 DTSCSL1 -00270 05 CURR-PAGE-NUM PIC S9(04) COMP. DTSCSL1 -00271 EJECT DTSCSL1 -00272 01 MSG-LITERALS. DTSCSL1 -00273 05 MSG-PL11-AREA. DTSCSL1 -00274 10 FILLER PIC X(04) VALUE 'PL11'. DTSCSL1 -00275 10 FILLER PIC X(30) DTSCSL1 -00276 VALUE 'NO QUARTER DATA EXISTS '. DTSCSL1 -00277 10 FILLER PIC X(30) DTSCSL1 -00278 VALUE ' '. DTSCSL1 -00279 DTSCSL1 +00260 05 SCR-HOLD-AREA. DTSCSL1 +00261 10 SCR-HOLD-KEY-INFO. DTSCSL1 +00262 15 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCSL1 +00263 15 SCR-HOLD-YRQ PIC S9(05) COMP-3. DTSCSL1 +00264 10 SCR-HOLD-CURR-PAGE-NUM PIC S9(04) COMP. DTSCSL1 +00265 10 FILLER PIC X(11). DTSCSL1 +00266 SKIP3 DTSCSL1 +00267 05 CURR-PAGE-NUM PIC S9(04) COMP. DTSCSL1 +00268 EJECT DTSCSL1 +00269 01 MSG-LITERALS. DTSCSL1 +00270 05 MSG-PL11-AREA. CL**6 +00271 10 FILLER PIC X(04) VALUE 'PL11'. CL**6 +00272 10 FILLER PIC X(30) DTSCSL1 +00273 VALUE 'NO QUARTER DATA EXISTS '. DTSCSL1 +00274 10 FILLER PIC X(30) DTSCSL1 +00275 VALUE ' '. DTSCSL1 +00276 DTSCSL1 +00277 EJECT DTSCSL1 +00278 01 L001-COMM-AREA. DTSCSL1 +00279 ++INCLUDE DTSIL001 CL**2 00280 EJECT DTSCSL1 -00281 01 L001-COMM-AREA. DTSCSL1 -00282 ++INCLUDE DTSIL001 DTSCSL1 +00281 01 L013-COMM-AREA. DTSCSL1 +00282 ++INCLUDE DTSIL013 CL**2 00283 EJECT DTSCSL1 -00284 01 L013-COMM-AREA. DTSCSL1 -00285 ++INCLUDE DTSIL013 DTSCSL1 -00286 EJECT DTSCSL1 -00287 01 L018-COMM-AREA. DTSCSL1 -00288 ++INCLUDE DTSIL018 DTSCSL1 +00284 01 L018-COMM-AREA. DTSCSL1 +00285 ++INCLUDE DTSIL018 CL**2 +00286 EJECT CL*14 +00287 01 L029-COMM-AREA. CL*14 +00288 ++INCLUDE DTSIL029 CL*14 00289 EJECT DTSCSL1 -00290 01 L029-COMM-AREA. DTSCSL1 -00291 ++INCLUDE DTSIL029 DTSCSL1 +00290 01 L032-COMM-AREA. DTSCSL1 +00291 ++INCLUDE DTSIL032 CL**2 00292 EJECT DTSCSL1 -00293 01 L032-COMM-AREA. DTSCSL1 -00294 ++INCLUDE DTSIL032 DTSCSL1 +00293 01 L038-COMM-AREA. DTSCSL1 +00294 ++INCLUDE DTSIL038 CL**2 00295 EJECT DTSCSL1 -00296 01 L038-COMM-AREA. DTSCSL1 -00297 ++INCLUDE DTSIL038 DTSCSL1 +00296 01 L039-COMM-AREA. DTSCSL1 +00297 ++INCLUDE DTSIL039 CL**2 00298 EJECT DTSCSL1 -00299 01 L039-COMM-AREA. DTSCSL1 -00300 ++INCLUDE DTSIL039 DTSCSL1 -00301 EJECT DTSCSL1 -00302 01 L040-COMM-AREA. DTSCSL1 -00303 ++INCLUDE DTSIL040 DTSCSL1 +00299 01 L040-COMM-AREA. CL**7 +00300 ++INCLUDE DTSIL040 CL**7 +00301 EJECT CL**7 +00302 01 L221-COMM-AREA. DTSCSL1 +00303 ++INCLUDE DTSIL221 CL**2 00304 EJECT DTSCSL1 -00305 01 L221-COMM-AREA. DTSCSL1 -00306 ++INCLUDE DTSIL221 DTSCSL1 +00305 01 L331-COMM-AREA. DTSCSL1 +00306 ++INCLUDE DTSIL331 CL**2 00307 EJECT DTSCSL1 -00308 01 L331-COMM-AREA. DTSCSL1 -00309 ++INCLUDE DTSIL331 DTSCSL1 +00308 01 L805-COMM-AREA. DTSCSL1 +00309 ++INCLUDE DTSIL805 CL**2 00310 EJECT DTSCSL1 -00311 01 L805-COMM-AREA. DTSCSL1 -00312 ++INCLUDE DTSIL805 DTSCSL1 -00313 EJECT DTSCSL1 -00314 01 L810-COMM-AREA. DTSCSL1 -00315 05 L810-CONTROL-BLOCK. DTSCSL1 -00316 ++INCLUDE DTSIL810 DTSCSL1 +00311 01 L810-COMM-AREA. DTSCSL1 +00312 05 L810-CONTROL-BLOCK. DTSCSL1 +00313 ++INCLUDE DTSIL810 CL**2 +00314 EJECT DTSCSL1 +00315 05 MSKL-REC. DTSCSL1 +00316 ++INCLUDE DTSIMSKL CL**2 00317 EJECT DTSCSL1 -00318 05 MSKL-REC. DTSCSL1 -00319 ++INCLUDE DTSIMSKL DTSCSL1 +00318 01 MPRF-REC. DTSCSL1 +00319 ++INCLUDE DTSIMPRF CL**2 00320 EJECT DTSCSL1 -00321 01 MPRF-REC. DTSCSL1 -00322 ++INCLUDE DTSIMPRF DTSCSL1 +00321 01 MQTR-REC. DTSCSL1 +00322 ++INCLUDE DTSIMQTR CL**2 00323 EJECT DTSCSL1 -00324 01 MQTR-REC. DTSCSL1 -00325 ++INCLUDE DTSIMQTR DTSCSL1 -00326 EJECT DTSCSL1 -00327 01 L825-COMM-AREA. DTSCSL1 -00328 05 L825-CONTROL-BLOCK. DTSCSL1 -00329 ++INCLUDE DTSIL825 DTSCSL1 -00330 DTSCSL1 -00331 05 RSKL-REC. DTSCSL1 -00332 ++INCLUDE DTSIRSK1 DTSCSL1 +00324 01 L825-COMM-AREA. DTSCSL1 +00325 05 L825-CONTROL-BLOCK. DTSCSL1 +00326 ++INCLUDE DTSIL825 CL**2 +00327 DTSCSL1 +00328 05 RSKL-REC. DTSCSL1 +00329 ++INCLUDE DTSIRSK1 CL**2 +00330 EJECT DTSCSL1 +00331 01 T006-REC. DTSCSL1 +00332 ++INCLUDE DTSIT006 CL**2 00333 EJECT DTSCSL1 -00334 01 T006-REC. DTSCSL1 -00335 ++INCLUDE DTSIT006 DTSCSL1 -00336 EJECT DTSCSL1 -00337 01 L851-COMM-AREA. DTSCSL1 -00338 ++INCLUDE DTSIL851 DTSCSL1 -00339 DTSCSL1 -00340 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCSL1 -00341 ++INCLUDE DTSISL1 DTSCSL1 -00342 EJECT DTSCSL1 -00343 01 CATB-LITERALS. DTSCSL1 -00344 ++INCLUDE DTSICATB DTSCSL1 +00334 01 L851-COMM-AREA. DTSCSL1 +00335 ++INCLUDE DTSIL851 CL**2 +00336 DTSCSL1 +00337 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCSL1 +00338 ++INCLUDE DTSISL1 CL**2 +00339 EJECT DTSCSL1 +00340 01 CATB-LITERALS. DTSCSL1 +00341 ++INCLUDE DTSICATB CL**2 +00342 DTSCSL1 +00343 01 CFKD-LITERALS. DTSCSL1 +00344 ++INCLUDE DTSICFKD CL**2 00345 DTSCSL1 -00346 01 CFKD-LITERALS. DTSCSL1 -00347 ++INCLUDE DTSICFKD DTSCSL1 +00346 01 CECD-LITERALS. DTSCSL1 +00347 ++INCLUDE DTSICECD CL**2 00348 DTSCSL1 -00349 01 CECD-LITERALS. DTSCSL1 -00350 ++INCLUDE DTSICECD DTSCSL1 -00351 DTSCSL1 -00352 01 CPCD-LITERALS. DTSCSL1 -00353 ++INCLUDE DTSICPCD DTSCSL1 -00354 EJECT DTSCSL1 -00355 LINKAGE SECTION. DTSCSL1 -00356 DTSCSL1 -00357 01 DFHCOMMAREA. DTSCSL1 -00358 ++INCLUDE DTSILCCM DTSCSL1 -00359 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCSL1 -00360 20 LCCM-SCR-HOLD-CONTROL-AREA. DTSCSL1 -00361 25 LCCM-SCR-HOLD-EMP-NO DTSCSL1 -00362 PIC S9(07) COMP-3. DTSCSL1 -00363 25 LCCM-SCR-HOLD-ABSTIME DTSCSL1 -00364 PIC S9(15) COMP-3. DTSCSL1 -00365 25 LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 -00366 PIC S9(04) COMP. DTSCSL1 -00367 25 LCCM-SCR-HOLD-LAST-KEY-AREA DTSCSL1 -00368 PIC X(16). DTSCSL1 -00369 EJECT DTSCSL1 -00370 ******************************************************************DTSCSL1 -00371 * *DTSCSL1 -00372 ******************************************************************DTSCSL1 -00373 DTSCSL1 -00374 PROCEDURE DIVISION. DTSCSL1 -00375 DTSCSL1 -00376 MOVE +0 TO WRK-EMP-NO DTSCSL1 -00377 WRK-YRQ. DTSCSL1 -00378 SET WRK-MPRF-NO-88 TO TRUE. DTSCSL1 -00379 DTSCSL1 -00380 MOVE LOW-VALUES TO MAP-AREA. DTSCSL1 -00381 DTSCSL1 -00382 SET CURSOR-SET-NO TO TRUE. DTSCSL1 -00383 DTSCSL1 -00384 SET SCR-ACCESS-INQ TO TRUE. DTSCSL1 -00385 DTSCSL1 -00386 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCSL1 -00387 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCSL1 -00388 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCSL1 -00389 DTSCSL1 -00390 MOVE SPACE TO REQ-IND. DTSCSL1 -00391 DTSCSL1 -00392 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCSL1 -00393 DTSCSL1 -00394 *----------------------------------------------------- DTSCSL1 -00395 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCSL1 -00396 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCSL1 -00397 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCSL1 -00398 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCSL1 +00349 01 CPCD-LITERALS. DTSCSL1 +00350 ++INCLUDE DTSICPCD CL**2 +00351 EJECT DTSCSL1 +00352 LINKAGE SECTION. DTSCSL1 +00353 DTSCSL1 +00354 01 DFHCOMMAREA. DTSCSL1 +00355 ++INCLUDE DTSILCCM CL**2 +00356 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCSL1 +00357 20 LCCM-SCR-HOLD-CONTROL-AREA. DTSCSL1 +00358 25 LCCM-SCR-HOLD-EMP-NO DTSCSL1 +00359 PIC S9(07) COMP-3. DTSCSL1 +00360 25 LCCM-SCR-HOLD-ABSTIME DTSCSL1 +00361 PIC S9(15) COMP-3. DTSCSL1 +00362 25 LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 +00363 PIC S9(04) COMP. DTSCSL1 +00364 25 LCCM-SCR-HOLD-LAST-KEY-AREA DTSCSL1 +00365 PIC X(16). DTSCSL1 +00366 EJECT DTSCSL1 +00367 ******************************************************************DTSCSL1 +00368 * *DTSCSL1 +00369 ******************************************************************DTSCSL1 +00370 DTSCSL1 +00371 PROCEDURE DIVISION. DTSCSL1 +00372 DTSCSL1 +00373 MOVE +0 TO WRK-EMP-NO DTSCSL1 +00374 WRK-YRQ. DTSCSL1 +00375 SET WRK-MPRF-NO-88 TO TRUE. DTSCSL1 +00376 DTSCSL1 +00377 MOVE LOW-VALUES TO MAP-AREA. DTSCSL1 +00378 DTSCSL1 +00379 SET CURSOR-SET-NO TO TRUE. DTSCSL1 +00380 DTSCSL1 +00381 SET SCR-ACCESS-INQ TO TRUE. DTSCSL1 +00382 DTSCSL1 +00383 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCSL1 +00384 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCSL1 +00385 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCSL1 +00386 DTSCSL1 +00387 MOVE SPACE TO REQ-IND. DTSCSL1 +00388 DTSCSL1 +00389 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCSL1 +00390 DTSCSL1 +00391 *----------------------------------------------------- DTSCSL1 +00392 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCSL1 +00393 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCSL1 +00394 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCSL1 +00395 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCSL1 +00396 * DTSCSL1 +00397 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCSL1 +00398 * PROCESSED. DTSCSL1 00399 * DTSCSL1 -00400 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCSL1 -00401 * PROCESSED. DTSCSL1 -00402 * DTSCSL1 -00403 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCSL1 -00404 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCSL1 -00405 * WORK STATION OPERATOR. DTSCSL1 -00406 *----------------------------------------------------- DTSCSL1 -00407 DTSCSL1 -00408 MOVE SPACE TO RESP-IND. DTSCSL1 -00409 DTSCSL1 -00410 IF REQ-ERROR DTSCSL1 -00411 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCSL1 +00400 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCSL1 +00401 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCSL1 +00402 * WORK STATION OPERATOR. DTSCSL1 +00403 *----------------------------------------------------- DTSCSL1 +00404 DTSCSL1 +00405 MOVE SPACE TO RESP-IND. DTSCSL1 +00406 DTSCSL1 +00407 IF REQ-ERROR DTSCSL1 +00408 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCSL1 +00409 ELSE DTSCSL1 +00410 IF REQ-JUMP DTSCSL1 +00411 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCSL1 00412 ELSE DTSCSL1 -00413 IF REQ-JUMP DTSCSL1 -00414 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCSL1 +00413 IF REQ-CLEAR DTSCSL1 +00414 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCSL1 00415 ELSE DTSCSL1 -00416 IF REQ-CLEAR DTSCSL1 -00417 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCSL1 +00416 IF REQ-CURSOR-TO-GOTO DTSCSL1 +00417 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCSL1 00418 ELSE DTSCSL1 -00419 IF REQ-CURSOR-TO-GOTO DTSCSL1 -00420 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCSL1 +00419 IF REQ-INQUIRE DTSCSL1 +00420 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSL1 00421 ELSE DTSCSL1 -00422 IF REQ-INQUIRE DTSCSL1 -00423 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSL1 +00422 IF REQ-EDIT DTSCSL1 +00423 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCSL1 00424 ELSE DTSCSL1 -00425 IF REQ-EDIT DTSCSL1 -00426 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCSL1 +00425 IF REQ-UPDATE DTSCSL1 +00426 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCSL1 00427 ELSE DTSCSL1 -00428 IF REQ-UPDATE DTSCSL1 -00429 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCSL1 -00430 ELSE DTSCSL1 -00431 GO TO S899-ABEND. DTSCSL1 -00432 DTSCSL1 +00428 GO TO S899-ABEND. DTSCSL1 +00429 DTSCSL1 +00430 *----------------------------------------------------- DTSCSL1 +00431 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCSL1 +00432 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCSL1 00433 *----------------------------------------------------- DTSCSL1 -00434 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCSL1 -00435 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCSL1 -00436 *----------------------------------------------------- DTSCSL1 -00437 DTSCSL1 -00438 IF RESP-SEND-MAP DTSCSL1 -00439 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCSL1 -00440 SET LCCM-END-TASK-88 TO TRUE DTSCSL1 -00441 ELSE DTSCSL1 -00442 IF RESP-SEND-MSGONLY DTSCSL1 -00443 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL1 -00444 SET LCCM-END-TASK-88 TO TRUE DTSCSL1 +00434 DTSCSL1 +00435 IF RESP-SEND-MAP DTSCSL1 +00436 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCSL1 +00437 SET LCCM-END-TASK-88 TO TRUE DTSCSL1 +00438 ELSE DTSCSL1 +00439 IF RESP-SEND-MSGONLY DTSCSL1 +00440 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL1 +00441 SET LCCM-END-TASK-88 TO TRUE DTSCSL1 +00442 ELSE DTSCSL1 +00443 IF RESP-JUMP DTSCSL1 +00444 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 00445 ELSE DTSCSL1 -00446 IF RESP-JUMP DTSCSL1 -00447 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -00448 ELSE DTSCSL1 -00449 IF RESP-CURSOR-TO-GOTO DTSCSL1 -00450 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL1 -00451 SET LCCM-END-TASK-88 TO TRUE DTSCSL1 -00452 ELSE DTSCSL1 -00453 GO TO S899-ABEND. DTSCSL1 -00454 DTSCSL1 -00455 MAINLINE-EXIT. DTSCSL1 -00456 DTSCSL1 -00457 EXEC CICS DTSCSL1 -00458 RETURN DTSCSL1 -00459 END-EXEC. DTSCSL1 -00460 DTSCSL1 -00461 * GOBACK. DTSCSL1 -00462 SKIP3 DTSCSL1 -00463 P0100-ACCESS-SEARCH. DTSCSL1 -00464 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCSL1 -00465 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCSL1 -00466 TO SCR-ACCESS-IND. DTSCSL1 -00467 P0100-EXIT. DTSCSL1 -00468 EXIT. DTSCSL1 -00469 EJECT DTSCSL1 -00470 /*****************************************************************DTSCSL1 -00471 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCSL1 -00472 ******************************************************************DTSCSL1 -00473 P1000-ANALYZE-REQUEST. DTSCSL1 -00474 DTSCSL1 -00475 *----------------------------------------------------- DTSCSL1 -00476 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCSL1 -00477 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCSL1 -00478 * REPLACED WITH ENTER) DTSCSL1 -00479 *----------------------------------------------------- DTSCSL1 -00480 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCSL1 -00481 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCSL1 -00482 DTSCSL1 -00483 SET LCCM-ENTER-88 TO TRUE DTSCSL1 -00484 IF LCCM-EMP-NO = +0 DTSCSL1 -00485 MOVE +0 TO LCCM-YRQ DTSCSL1 -00486 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCSL1 -00487 SET REQ-CLEAR TO TRUE DTSCSL1 -00488 ELSE DTSCSL1 -00489 SET REQ-INQUIRE TO TRUE DTSCSL1 -00490 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCSL1 -00491 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCSL1 -00492 PERFORM P1200-CHECK-LCCM-YRQ THRU P1200-EXIT DTSCSL1 -00493 END-IF DTSCSL1 -00494 GO TO P1000-EXIT. DTSCSL1 -00495 DTSCSL1 -00496 *----------------------------------------------------- DTSCSL1 -00497 * MAP IS RECEIVED DTSCSL1 +00446 IF RESP-CURSOR-TO-GOTO DTSCSL1 +00447 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL1 +00448 SET LCCM-END-TASK-88 TO TRUE DTSCSL1 +00449 ELSE DTSCSL1 +00450 GO TO S899-ABEND. DTSCSL1 +00451 DTSCSL1 +00452 MAINLINE-EXIT. DTSCSL1 +00453 DTSCSL1 +00454 EXEC CICS DTSCSL1 +00455 RETURN DTSCSL1 +00456 END-EXEC. DTSCSL1 +00457 DTSCSL1 +00458 * GOBACK. DTSCSL1 +00459 SKIP3 DTSCSL1 +00460 P0100-ACCESS-SEARCH. DTSCSL1 +00461 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCSL1 +00462 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCSL1 +00463 TO SCR-ACCESS-IND. DTSCSL1 +00464 P0100-EXIT. DTSCSL1 +00465 EXIT. DTSCSL1 +00466 EJECT DTSCSL1 +00467 /*****************************************************************DTSCSL1 +00468 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCSL1 +00469 ******************************************************************DTSCSL1 +00470 P1000-ANALYZE-REQUEST. DTSCSL1 +00471 DTSCSL1 +00472 *----------------------------------------------------- DTSCSL1 +00473 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCSL1 +00474 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCSL1 +00475 * REPLACED WITH ENTER) DTSCSL1 +00476 *----------------------------------------------------- DTSCSL1 +00477 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCSL1 +00478 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCSL1 +00479 DTSCSL1 +00480 SET LCCM-ENTER-88 TO TRUE DTSCSL1 +00481 IF LCCM-EMP-NO = +0 DTSCSL1 +00482 MOVE +0 TO LCCM-YRQ DTSCSL1 +00483 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCSL1 +00484 SET REQ-CLEAR TO TRUE DTSCSL1 +00485 ELSE DTSCSL1 +00486 SET REQ-INQUIRE TO TRUE DTSCSL1 +00487 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCSL1 +00488 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCSL1 +00489 PERFORM P1200-CHECK-LCCM-YRQ THRU P1200-EXIT DTSCSL1 +00490 END-IF DTSCSL1 +00491 GO TO P1000-EXIT. DTSCSL1 +00492 DTSCSL1 +00493 *----------------------------------------------------- DTSCSL1 +00494 * MAP IS RECEIVED DTSCSL1 +00495 *----------------------------------------------------- DTSCSL1 +00496 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCSL1 +00497 DTSCSL1 00498 *----------------------------------------------------- DTSCSL1 -00499 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCSL1 -00500 DTSCSL1 +00499 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCSL1 +00500 * WORK STATION DTSCSL1 00501 *----------------------------------------------------- DTSCSL1 -00502 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCSL1 -00503 * WORK STATION DTSCSL1 -00504 *----------------------------------------------------- DTSCSL1 -00505 IF LCCM-CLEAR-88 DTSCSL1 -00506 SET REQ-CLEAR TO TRUE DTSCSL1 -00507 GO TO P1000-EXIT. DTSCSL1 -00508 DTSCSL1 -00509 *----------------------------------------------------- DTSCSL1 -00510 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCSL1 -00511 *----------------------------------------------------- DTSCSL1 -00512 IF LCCM-SCR-UPDATE-LOCKED DTSCSL1 -00513 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCSL1 -00514 GO TO P1000-EXIT. DTSCSL1 -00515 DTSCSL1 -00516 *----------------------------------------------------- DTSCSL1 -00517 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCSL1 -00518 *----------------------------------------------------- DTSCSL1 -00519 IF LCCM-PA2-88 DTSCSL1 -00520 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCSL1 -00521 GO TO P1000-EXIT. DTSCSL1 -00522 DTSCSL1 -00523 *----------------------------------------------------- DTSCSL1 -00524 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCSL1 -00525 *----------------------------------------------------- DTSCSL1 -00526 IF LCCM-PA-88 DTSCSL1 -00527 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL1 -00528 SET REQ-ERROR TO TRUE DTSCSL1 -00529 GO TO P1000-EXIT. DTSCSL1 -00530 DTSCSL1 -00531 *----------------------------------------------------- DTSCSL1 -00532 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCSL1 -00533 * CLEAR SCREEN DTSCSL1 -00534 *----------------------------------------------------- DTSCSL1 -00535 IF LCCM-F12-88 DTSCSL1 -00536 MOVE LOW-VALUES TO MAP-AREA DTSCSL1 -00537 SET REQ-CLEAR TO TRUE DTSCSL1 -00538 GO TO P1000-EXIT. DTSCSL1 -00539 DTSCSL1 -00540 *----------------------------------------------------- DTSCSL1 -00541 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSL1 -00542 *----------------------------------------------------- DTSCSL1 -00543 IF LCCM-F03-88 DTSCSL1 -00544 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL1 -00545 SET REQ-JUMP TO TRUE DTSCSL1 -00546 GO TO P1000-EXIT. DTSCSL1 -00547 DTSCSL1 -00548 *----------------------------------------------------- DTSCSL1 -00549 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCSL1 -00550 *----------------------------------------------------- DTSCSL1 -00551 IF LCCM-F04-88 DTSCSL1 -00552 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL1 -00553 SET REQ-JUMP TO TRUE DTSCSL1 -00554 GO TO P1000-EXIT. DTSCSL1 -00555 DTSCSL1 +00502 IF LCCM-CLEAR-88 DTSCSL1 +00503 SET REQ-CLEAR TO TRUE DTSCSL1 +00504 GO TO P1000-EXIT. DTSCSL1 +00505 DTSCSL1 +00506 *----------------------------------------------------- DTSCSL1 +00507 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCSL1 +00508 *----------------------------------------------------- DTSCSL1 +00509 IF LCCM-SCR-UPDATE-LOCKED DTSCSL1 +00510 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCSL1 +00511 GO TO P1000-EXIT. DTSCSL1 +00512 DTSCSL1 +00513 *----------------------------------------------------- DTSCSL1 +00514 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCSL1 +00515 *----------------------------------------------------- DTSCSL1 +00516 IF LCCM-PA2-88 DTSCSL1 +00517 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCSL1 +00518 GO TO P1000-EXIT. DTSCSL1 +00519 DTSCSL1 +00520 *----------------------------------------------------- DTSCSL1 +00521 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCSL1 +00522 *----------------------------------------------------- DTSCSL1 +00523 IF LCCM-PA-88 DTSCSL1 +00524 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL1 +00525 SET REQ-ERROR TO TRUE DTSCSL1 +00526 GO TO P1000-EXIT. DTSCSL1 +00527 DTSCSL1 +00528 *----------------------------------------------------- CL**2 +00529 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS CL**2 +00530 * CLEAR SCREEN CL**2 +00531 *----------------------------------------------------- CL**2 +00532 IF LCCM-F12-88 CL**2 +00533 MOVE LOW-VALUES TO MAP-AREA CL**2 +00534 SET REQ-CLEAR TO TRUE CL**2 +00535 GO TO P1000-EXIT. CL**2 +00536 CL**2 +00537 *----------------------------------------------------- DTSCSL1 +00538 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSL1 +00539 *----------------------------------------------------- DTSCSL1 +00540 IF LCCM-F03-88 DTSCSL1 +00541 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL1 +00542 SET REQ-JUMP TO TRUE DTSCSL1 +00543 GO TO P1000-EXIT. DTSCSL1 +00544 DTSCSL1 +00545 *----------------------------------------------------- DTSCSL1 +00546 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCSL1 +00547 *----------------------------------------------------- DTSCSL1 +00548 IF LCCM-F04-88 DTSCSL1 +00549 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL1 +00550 SET REQ-JUMP TO TRUE DTSCSL1 +00551 GO TO P1000-EXIT. DTSCSL1 +00552 DTSCSL1 +00553 *--------------------------------------------------------- DTSCSL1 +00554 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCSL1 +00555 * CORRESPONDENCE SCREEN. DTSCSL1 00556 *--------------------------------------------------------- DTSCSL1 -00557 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCSL1 -00558 * CORRESPONDENCE SCREEN. DTSCSL1 -00559 *--------------------------------------------------------- DTSCSL1 -00560 DTSCSL1 -00561 IF LCCM-F14-88 DTSCSL1 -00562 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL1 -00563 SET REQ-JUMP TO TRUE DTSCSL1 -00564 GO TO P1000-EXIT. DTSCSL1 -00565 DTSCSL1 +00557 CL*13 +00558 IF LCCM-F14-88 CL*13 +00559 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID CL*13 +00560 SET REQ-JUMP TO TRUE CL*13 +00561 GO TO P1000-EXIT. CL*13 +00562 CL*13 +00563 *----------------------------------------------------- DTSCSL1 +00564 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCSL1 +00565 * REQUESTED SCREEN TYPE DTSCSL1 00566 *----------------------------------------------------- DTSCSL1 -00567 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCSL1 -00568 * REQUESTED SCREEN TYPE DTSCSL1 -00569 *----------------------------------------------------- DTSCSL1 -00570 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCSL1 -00571 NEXT SENTENCE DTSCSL1 -00572 ELSE DTSCSL1 -00573 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCSL1 -00574 SET REQ-JUMP TO TRUE DTSCSL1 -00575 GO TO P1000-EXIT. DTSCSL1 -00576 DTSCSL1 +00567 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCSL1 +00568 NEXT SENTENCE DTSCSL1 +00569 ELSE DTSCSL1 +00570 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCSL1 +00571 SET REQ-JUMP TO TRUE DTSCSL1 +00572 GO TO P1000-EXIT. DTSCSL1 +00573 DTSCSL1 +00574 *----------------------------------------------------- DTSCSL1 +00575 * IF REQUEST TO UPDATE THE DATA (MOD) DTSCSL1 +00576 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCSL1 00577 *----------------------------------------------------- DTSCSL1 -00578 * IF REQUEST TO UPDATE THE DATA (MOD) DTSCSL1 -00579 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCSL1 -00580 *----------------------------------------------------- DTSCSL1 -00581 IF LCCM-F10-88 DTSCSL1 -00582 IF SCR-ACCESS-UPDATE DTSCSL1 -00583 SET REQ-EDIT TO TRUE DTSCSL1 -00584 GO TO P1000-EXIT DTSCSL1 -00585 ELSE DTSCSL1 -00586 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL1 -00587 SET REQ-ERROR TO TRUE DTSCSL1 -00588 GO TO P1000-EXIT. DTSCSL1 -00589 DTSCSL1 +00578 IF LCCM-F10-88 DTSCSL1 +00579 IF SCR-ACCESS-UPDATE DTSCSL1 +00580 SET REQ-EDIT TO TRUE DTSCSL1 +00581 GO TO P1000-EXIT DTSCSL1 +00582 ELSE DTSCSL1 +00583 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL1 +00584 SET REQ-ERROR TO TRUE DTSCSL1 +00585 GO TO P1000-EXIT. DTSCSL1 +00586 DTSCSL1 +00587 *----------------------------------------------------- DTSCSL1 +00588 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCSL1 +00589 * OR F8), INDICATE INQUIRY REQUEST DTSCSL1 00590 *----------------------------------------------------- DTSCSL1 -00591 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCSL1 -00592 * OR F8), INDICATE INQUIRY REQUEST DTSCSL1 -00593 *----------------------------------------------------- DTSCSL1 -00594 IF LCCM-INQUIRY-88 DTSCSL1 -00595 SET REQ-INQUIRE TO TRUE DTSCSL1 -00596 GO TO P1000-EXIT. DTSCSL1 -00597 DTSCSL1 -00598 *----------------------------------------------------- DTSCSL1 -00599 * ANY OTHER KEY IS INVALID DTSCSL1 -00600 *----------------------------------------------------- DTSCSL1 -00601 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCSL1 -00602 SET REQ-ERROR TO TRUE. DTSCSL1 -00603 P1000-EXIT. DTSCSL1 -00604 EXIT. DTSCSL1 -00605 SKIP3 DTSCSL1 -00606 P1100-UPDATE-LOCKED. DTSCSL1 -00607 *----------------------------------------------------- DTSCSL1 -00608 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCSL1 -00609 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCSL1 -00610 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCSL1 -00611 *----------------------------------------------------- DTSCSL1 -00612 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCSL1 -00613 SET REQ-UPDATE TO TRUE DTSCSL1 -00614 ELSE DTSCSL1 -00615 SET REQ-ERROR TO TRUE DTSCSL1 -00616 IF LCCM-SCR-MOD-LOCKED DTSCSL1 -00617 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCSL1 -00618 ELSE DTSCSL1 -00619 GO TO S899-ABEND. DTSCSL1 -00620 P1100-EXIT. DTSCSL1 -00621 EXIT. DTSCSL1 -00622 EJECT DTSCSL1 -00623 P1200-CHECK-LCCM-YRQ. DTSCSL1 -00624 IF LCCM-YRQ = ALL-NINES-YRQ DTSCSL1 -00625 MOVE +0 TO LCCM-YRQ DTSCSL1 -00626 GO TO P1200-EXIT. DTSCSL1 -00627 DTSCSL1 -00628 IF LCCM-YRQ > +0 DTSCSL1 -00629 IF LCCM-YRQ >= LCCM-PICKUP-YRQ DTSCSL1 -00630 PERFORM P1210-DISPLAY-YRQ THRU P1210-EXIT DTSCSL1 -00631 GO TO P1200-EXIT DTSCSL1 -00632 ELSE DTSCSL1 -00633 MOVE +0 TO LCCM-YRQ DTSCSL1 -00634 GO TO P1200-EXIT. DTSCSL1 -00635 DTSCSL1 -00636 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. DTSCSL1 -00637 DTSCSL1 -00638 IF SCR-HOLD-AREA NOT = LOW-VALUES DTSCSL1 -00639 IF SCR-HOLD-EMP-NO = LCCM-EMP-NO DTSCSL1 -00640 IF SCR-HOLD-YRQ > +0 DTSCSL1 -00641 MOVE SCR-HOLD-YRQ TO LCCM-YRQ DTSCSL1 -00642 PERFORM P1210-DISPLAY-YRQ THRU P1210-EXIT. DTSCSL1 -00643 P1200-EXIT. DTSCSL1 -00644 EXIT. DTSCSL1 -00645 DTSCSL1 -00646 P1210-DISPLAY-YRQ. DTSCSL1 -00647 IF LCCM-YRQ = LCCM-PICKUP-YRQ DTSCSL1 -00648 MOVE 'PU' TO MAP-YRQ-YR DTSCSL1 -00649 MOVE ' ' TO MAP-YRQ-Q DTSCSL1 -00650 ELSE DTSCSL1 -00651 MOVE LCCM-YRQ TO WRK-DISPLAY DTSCSL1 -00652 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR DTSCSL1 -00653 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. DTSCSL1 -00654 P1210-EXIT. DTSCSL1 -00655 EXIT. DTSCSL1 -00656 /*****************************************************************DTSCSL1 -00657 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSL1 -00658 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCSL1 -00659 ******************************************************************DTSCSL1 -00660 DTSCSL1 -00661 P2000-REQUEST-ERROR. DTSCSL1 -00662 IF LCCM-MSG DTSCSL1 -00663 SET RESP-SEND-MSGONLY TO TRUE DTSCSL1 -00664 ELSE DTSCSL1 -00665 GO TO S899-ABEND. DTSCSL1 -00666 P2000-EXIT. DTSCSL1 -00667 EXIT. DTSCSL1 -00668 /*****************************************************************DTSCSL1 -00669 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCSL1 -00670 ******************************************************************DTSCSL1 -00671 DTSCSL1 -00672 P3000-REQUEST-JUMP. DTSCSL1 +00591 IF LCCM-INQUIRY-88 DTSCSL1 +00592 SET REQ-INQUIRE TO TRUE DTSCSL1 +00593 GO TO P1000-EXIT. DTSCSL1 +00594 DTSCSL1 +00595 *----------------------------------------------------- DTSCSL1 +00596 * ANY OTHER KEY IS INVALID DTSCSL1 +00597 *----------------------------------------------------- DTSCSL1 +00598 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCSL1 +00599 SET REQ-ERROR TO TRUE. DTSCSL1 +00600 P1000-EXIT. DTSCSL1 +00601 EXIT. DTSCSL1 +00602 SKIP3 DTSCSL1 +00603 P1100-UPDATE-LOCKED. DTSCSL1 +00604 *----------------------------------------------------- DTSCSL1 +00605 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCSL1 +00606 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCSL1 +00607 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCSL1 +00608 *----------------------------------------------------- DTSCSL1 +00609 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCSL1 +00610 SET REQ-UPDATE TO TRUE DTSCSL1 +00611 ELSE DTSCSL1 +00612 SET REQ-ERROR TO TRUE DTSCSL1 +00613 IF LCCM-SCR-MOD-LOCKED DTSCSL1 +00614 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCSL1 +00615 ELSE DTSCSL1 +00616 GO TO S899-ABEND. DTSCSL1 +00617 P1100-EXIT. DTSCSL1 +00618 EXIT. DTSCSL1 +00619 EJECT DTSCSL1 +00620 P1200-CHECK-LCCM-YRQ. DTSCSL1 +00621 IF LCCM-YRQ = ALL-NINES-YRQ DTSCSL1 +00622 MOVE +0 TO LCCM-YRQ DTSCSL1 +00623 GO TO P1200-EXIT. DTSCSL1 +00624 DTSCSL1 +00625 IF LCCM-YRQ > +0 DTSCSL1 +00626 IF LCCM-YRQ >= LCCM-PICKUP-YRQ CL*15 +00627 PERFORM P1210-DISPLAY-YRQ THRU P1210-EXIT CL*15 +00628 GO TO P1200-EXIT CL*15 +00629 ELSE CL*15 +00630 MOVE +0 TO LCCM-YRQ CL*15 +00631 GO TO P1200-EXIT. CL*15 +00632 DTSCSL1 +00633 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. CL**7 +00634 DTSCSL1 +00635 IF SCR-HOLD-AREA NOT = LOW-VALUES DTSCSL1 +00636 IF SCR-HOLD-EMP-NO = LCCM-EMP-NO DTSCSL1 +00637 IF SCR-HOLD-YRQ > +0 DTSCSL1 +00638 MOVE SCR-HOLD-YRQ TO LCCM-YRQ DTSCSL1 +00639 PERFORM P1210-DISPLAY-YRQ THRU P1210-EXIT. DTSCSL1 +00640 P1200-EXIT. DTSCSL1 +00641 EXIT. DTSCSL1 +00642 DTSCSL1 +00643 P1210-DISPLAY-YRQ. DTSCSL1 +00644 IF LCCM-YRQ = LCCM-PICKUP-YRQ CL*15 +00645 MOVE 'PU' TO MAP-YRQ-YR CL*15 +00646 MOVE ' ' TO MAP-YRQ-Q CL*15 +00647 ELSE CL*15 +00648 MOVE LCCM-YRQ TO WRK-DISPLAY CL*15 +00649 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR CL*15 +00650 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. CL*15 +00651 P1210-EXIT. DTSCSL1 +00652 EXIT. DTSCSL1 +00653 /*****************************************************************DTSCSL1 +00654 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSL1 +00655 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCSL1 +00656 ******************************************************************DTSCSL1 +00657 DTSCSL1 +00658 P2000-REQUEST-ERROR. DTSCSL1 +00659 IF LCCM-MSG DTSCSL1 +00660 SET RESP-SEND-MSGONLY TO TRUE DTSCSL1 +00661 ELSE DTSCSL1 +00662 GO TO S899-ABEND. DTSCSL1 +00663 P2000-EXIT. DTSCSL1 +00664 EXIT. DTSCSL1 +00665 /*****************************************************************DTSCSL1 +00666 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCSL1 +00667 ******************************************************************DTSCSL1 +00668 DTSCSL1 +00669 P3000-REQUEST-JUMP. DTSCSL1 +00670 *----------------------------------------------------- DTSCSL1 +00671 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCSL1 +00672 * BY USER DTSCSL1 00673 *----------------------------------------------------- DTSCSL1 -00674 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCSL1 -00675 * BY USER DTSCSL1 +00674 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCSL1 +00675 DTSCSL1 00676 *----------------------------------------------------- DTSCSL1 -00677 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCSL1 -00678 DTSCSL1 -00679 *----------------------------------------------------- DTSCSL1 -00680 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCSL1 -00681 *----------------------------------------------------- DTSCSL1 -00682 IF LCCM-MSG DTSCSL1 -00683 SET RESP-SEND-MSGONLY TO TRUE DTSCSL1 -00684 SET CURSOR-SET-GOTO TO TRUE DTSCSL1 -00685 GO TO P3000-EXIT. DTSCSL1 -00686 SKIP3 DTSCSL1 -00687 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL1 -00688 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL1 -00689 IF L018-VALID DTSCSL1 -00690 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCSL1 -00691 DTSCSL1 -00692 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA DTSCSL1 -00693 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT DTSCSL1 -00694 IF L029-VALID DTSCSL1 -00695 MOVE L029-YRQ TO LCCM-YRQ. DTSCSL1 -00696 DTSCSL1 -00697 *----------------------------------------------------- DTSCSL1 -00698 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCSL1 -00699 *----------------------------------------------------- DTSCSL1 -00700 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCSL1 -00701 LCCM-SCR-HOLD-AREA. DTSCSL1 -00702 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCSL1 -00703 SET RESP-JUMP TO TRUE. DTSCSL1 -00704 P3000-EXIT. DTSCSL1 -00705 EXIT. DTSCSL1 -00706 /*****************************************************************DTSCSL1 -00707 * CLEAR KEY WAS PRESSED *DTSCSL1 -00708 ******************************************************************DTSCSL1 -00709 DTSCSL1 -00710 P4000-REQUEST-CLEAR. DTSCSL1 +00677 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCSL1 +00678 *----------------------------------------------------- DTSCSL1 +00679 IF LCCM-MSG DTSCSL1 +00680 SET RESP-SEND-MSGONLY TO TRUE DTSCSL1 +00681 SET CURSOR-SET-GOTO TO TRUE DTSCSL1 +00682 GO TO P3000-EXIT. DTSCSL1 +00683 SKIP3 DTSCSL1 +00684 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL1 +00685 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL1 +00686 IF L018-VALID DTSCSL1 +00687 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCSL1 +00688 DTSCSL1 +00689 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA CL*14 +00690 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT CL*14 +00691 IF L029-VALID CL*14 +00692 MOVE L029-YRQ TO LCCM-YRQ. CL*14 +00693 DTSCSL1 +00694 *----------------------------------------------------- DTSCSL1 +00695 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCSL1 +00696 *----------------------------------------------------- DTSCSL1 +00697 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCSL1 +00698 LCCM-SCR-HOLD-AREA. DTSCSL1 +00699 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCSL1 +00700 SET RESP-JUMP TO TRUE. DTSCSL1 +00701 P3000-EXIT. DTSCSL1 +00702 EXIT. DTSCSL1 +00703 /*****************************************************************DTSCSL1 +00704 * CLEAR KEY WAS PRESSED *DTSCSL1 +00705 ******************************************************************DTSCSL1 +00706 DTSCSL1 +00707 P4000-REQUEST-CLEAR. DTSCSL1 +00708 *----------------------------------------------------- DTSCSL1 +00709 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCSL1 +00710 * FIELDS FROM EARLIER REQUESTS DTSCSL1 00711 *----------------------------------------------------- DTSCSL1 -00712 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCSL1 -00713 * FIELDS FROM EARLIER REQUESTS DTSCSL1 -00714 *----------------------------------------------------- DTSCSL1 -00715 IF LCCM-EMP-NO > ZERO DTSCSL1 -00716 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCSL1 -00717 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCSL1 +00712 IF LCCM-EMP-NO > ZERO DTSCSL1 +00713 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCSL1 +00714 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCSL1 +00715 DTSCSL1 +00716 MOVE ZERO TO LCCM-EMP-NO DTSCSL1 +00717 LCCM-YRQ. DTSCSL1 00718 DTSCSL1 -00719 MOVE ZERO TO LCCM-EMP-NO DTSCSL1 -00720 LCCM-YRQ. DTSCSL1 -00721 DTSCSL1 -00722 MOVE LOW-VALUES TO LCCM-SCRL1-HOLD-AREA. DTSCSL1 -00723 DTSCSL1 -00724 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL1 -00725 DTSCSL1 -00726 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL1 -00727 DTSCSL1 -00728 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL1 -00729 DTSCSL1 -00730 SET RESP-SEND-MAP TO TRUE. DTSCSL1 -00731 P4000-EXIT. DTSCSL1 -00732 EXIT. DTSCSL1 -00733 /*****************************************************************DTSCSL1 -00734 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCSL1 -00735 ******************************************************************DTSCSL1 -00736 DTSCSL1 -00737 P5000-CURSOR-TO-GOTO. DTSCSL1 -00738 SET CURSOR-SET-GOTO TO TRUE. DTSCSL1 -00739 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCSL1 -00740 P5000-EXIT. DTSCSL1 -00741 EXIT. DTSCSL1 -00742 /*****************************************************************DTSCSL1 -00743 * INQUIRY WAS REQUESTED *DTSCSL1 -00744 ******************************************************************DTSCSL1 -00745 DTSCSL1 -00746 P6000-REQUEST-INQUIRE. DTSCSL1 -00747 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL1 -00748 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. DTSCSL1 -00749 MOVE LOW-VALUES TO MAP-AREA. DTSCSL1 -00750 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCSL1 -00751 MOVE L029-S-YRQ-AREA TO MAP-YRQ-AREA. DTSCSL1 -00752 DTSCSL1 -00753 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL1 -00754 DTSCSL1 -00755 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL1 -00756 DTSCSL1 -00757 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL1 -00758 DTSCSL1 -00759 SET RESP-SEND-MAP TO TRUE. DTSCSL1 -00760 DTSCSL1 -00761 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL1 -00762 DTSCSL1 -00763 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. DTSCSL1 -00764 DTSCSL1 -00765 MOVE LOW-VALUES TO LCCM-SCRL1-HOLD-AREA. DTSCSL1 -00766 DTSCSL1 -00767 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL1 -00768 IF LCCM-NO-MSG DTSCSL1 -00769 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCSL1 -00770 IF LCCM-NO-MSG DTSCSL1 -00771 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCSL1 -00772 DTSCSL1 -00773 PERFORM S2101-YRQ THRU S2101-EXIT. DTSCSL1 -00774 IF LCCM-MSG DTSCSL1 -00775 GO TO P6000-EXIT. DTSCSL1 -00776 DTSCSL1 -00777 MOVE WRK-YRQ TO LCCM-YRQ. DTSCSL1 -00778 SKIP3 DTSCSL1 -00779 IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES) DTSCSL1 -00780 OR DTSCSL1 -00781 (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO) DTSCSL1 -00782 OR DTSCSL1 -00783 (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME) DTSCSL1 -00784 PERFORM P6200-REFRESH-LCCM-SCR-HOLD THRU P6200-EXIT. DTSCSL1 -00785 SKIP3 DTSCSL1 -00786 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCSL1 -00787 DTSCSL1 -00788 IF LCCM-MSG DTSCSL1 -00789 GO TO P6000-EXIT. DTSCSL1 -00790 SKIP3 DTSCSL1 -00791 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCSL1 -00792 SKIP3 DTSCSL1 -00793 MOVE LOW-VALUES TO SCR-HOLD-AREA. DTSCSL1 -00794 DTSCSL1 -00795 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCSL1 +00719 MOVE LOW-VALUES TO LCCM-SCRL1-HOLD-AREA. CL**7 +00720 DTSCSL1 +00721 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL1 +00722 DTSCSL1 +00723 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL1 +00724 DTSCSL1 +00725 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL1 +00726 DTSCSL1 +00727 SET RESP-SEND-MAP TO TRUE. DTSCSL1 +00728 P4000-EXIT. DTSCSL1 +00729 EXIT. DTSCSL1 +00730 /*****************************************************************DTSCSL1 +00731 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCSL1 +00732 ******************************************************************DTSCSL1 +00733 DTSCSL1 +00734 P5000-CURSOR-TO-GOTO. DTSCSL1 +00735 SET CURSOR-SET-GOTO TO TRUE. DTSCSL1 +00736 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCSL1 +00737 P5000-EXIT. DTSCSL1 +00738 EXIT. DTSCSL1 +00739 /*****************************************************************DTSCSL1 +00740 * INQUIRY WAS REQUESTED *DTSCSL1 +00741 ******************************************************************DTSCSL1 +00742 DTSCSL1 +00743 P6000-REQUEST-INQUIRE. DTSCSL1 +00744 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL1 +00745 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. CL*14 +00746 MOVE LOW-VALUES TO MAP-AREA. DTSCSL1 +00747 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCSL1 +00748 MOVE L029-S-YRQ-AREA TO MAP-YRQ-AREA. CL*14 +00749 DTSCSL1 +00750 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL1 +00751 DTSCSL1 +00752 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL1 +00753 DTSCSL1 +00754 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL1 +00755 DTSCSL1 +00756 SET RESP-SEND-MAP TO TRUE. DTSCSL1 +00757 DTSCSL1 +00758 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL1 +00759 DTSCSL1 +00760 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. CL**7 +00761 DTSCSL1 +00762 MOVE LOW-VALUES TO LCCM-SCRL1-HOLD-AREA. CL**7 +00763 DTSCSL1 +00764 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL1 +00765 IF LCCM-NO-MSG DTSCSL1 +00766 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCSL1 +00767 IF LCCM-NO-MSG DTSCSL1 +00768 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCSL1 +00769 DTSCSL1 +00770 PERFORM S2101-YRQ THRU S2101-EXIT. DTSCSL1 +00771 IF LCCM-MSG DTSCSL1 +00772 GO TO P6000-EXIT. DTSCSL1 +00773 DTSCSL1 +00774 MOVE WRK-YRQ TO LCCM-YRQ. DTSCSL1 +00775 SKIP3 DTSCSL1 +00776 IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES) DTSCSL1 +00777 OR DTSCSL1 +00778 (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO) DTSCSL1 +00779 OR DTSCSL1 +00780 (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME) DTSCSL1 +00781 PERFORM P6200-REFRESH-LCCM-SCR-HOLD THRU P6200-EXIT. DTSCSL1 +00782 SKIP3 DTSCSL1 +00783 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCSL1 +00784 DTSCSL1 +00785 IF LCCM-MSG DTSCSL1 +00786 GO TO P6000-EXIT. DTSCSL1 +00787 SKIP3 DTSCSL1 +00788 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCSL1 +00789 SKIP3 DTSCSL1 +00790 MOVE LOW-VALUES TO SCR-HOLD-AREA. DTSCSL1 +00791 DTSCSL1 +00792 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCSL1 +00793 DTSCSL1 +00794 MOVE WRK-YRQ TO SCR-HOLD-YRQ DTSCSL1 +00795 LCCM-YRQ. DTSCSL1 00796 DTSCSL1 -00797 MOVE WRK-YRQ TO SCR-HOLD-YRQ DTSCSL1 -00798 LCCM-YRQ. DTSCSL1 -00799 DTSCSL1 -00800 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCSL1 -00801 DTSCSL1 -00802 MOVE SCR-HOLD-AREA TO LCCM-SCRL1-HOLD-AREA. DTSCSL1 -00803 SKIP3 DTSCSL1 -00804 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL1 -00805 DTSCSL1 -00806 IF SCR-ACCESS-UPDATE DTSCSL1 -00807 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSL1 -00808 P6000-EXIT. DTSCSL1 -00809 EXIT. DTSCSL1 -00810 EJECT DTSCSL1 -00811 P6100-LOCATE-REC. DTSCSL1 -00812 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0 DTSCSL1 -00813 MOVE +0 TO WRK-YRQ DTSCSL1 -00814 CURR-PAGE-NUM DTSCSL1 -00815 GO TO P6100-EXIT. DTSCSL1 -00816 SKIP3 DTSCSL1 -00817 IF LCCM-F05-88 DTSCSL1 -00818 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCSL1 -00819 GO TO P6100-EXIT. DTSCSL1 -00820 SKIP3 DTSCSL1 -00821 IF LCCM-F06-88 DTSCSL1 -00822 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCSL1 -00823 GO TO P6100-EXIT. DTSCSL1 -00824 SKIP3 DTSCSL1 -00825 IF WRK-YRQ = +0 DTSCSL1 -00826 PERFORM P6150-DEFAULT-REC THRU P6150-EXIT DTSCSL1 -00827 GO TO P6100-EXIT. DTSCSL1 -00828 SKIP3 DTSCSL1 -00829 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCSL1 -00830 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCSL1 -00831 SET MQTR-QTR-88 TO TRUE. DTSCSL1 -00832 MOVE WRK-YRQ TO MQTR-YRQ. DTSCSL1 -00833 DTSCSL1 -00834 IF (SCR-HOLD-KEY-INFO = WRK-KEY-INFO) DTSCSL1 -00835 AND DTSCSL1 -00836 (SCR-HOLD-CURR-PAGE-NUM NOT = +0) DTSCSL1 -00837 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCSL1 -00838 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCSL1 -00839 IF L810-OK-88 DTSCSL1 -00840 IF MSKL-KEY-AREA = MQTR-KEY-AREA DTSCSL1 -00841 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCSL1 -00842 MOVE MSKL-REC TO MQTR-REC DTSCSL1 -00843 IF LCCM-ENTER-88 DTSCSL1 -00844 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL1 -00845 GO TO P6100-EXIT DTSCSL1 -00846 ELSE DTSCSL1 -00847 IF LCCM-F07-88 DTSCSL1 -00848 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCSL1 -00849 GO TO P6100-EXIT DTSCSL1 -00850 ELSE DTSCSL1 -00851 IF LCCM-F08-88 DTSCSL1 -00852 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCSL1 -00853 GO TO P6100-EXIT DTSCSL1 -00854 ELSE DTSCSL1 -00855 GO TO S899-ABEND DTSCSL1 -00856 ELSE DTSCSL1 -00857 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 -00858 SKIP3 DTSCSL1 -00859 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCSL1 -00860 DTSCSL1 -00861 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL1 -00862 DTSCSL1 -00863 SET MSKL-QTR-88 TO TRUE. DTSCSL1 -00864 DTSCSL1 -00865 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL1 -00866 DTSCSL1 -00867 IF L810-NO-REC-88 DTSCSL1 -00868 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00869 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -00870 GO TO P6100-EXIT. DTSCSL1 -00871 SKIP3 DTSCSL1 -00872 MOVE +0 TO CURR-PAGE-NUM. DTSCSL1 -00873 DTSCSL1 -00874 MOVE 'N' TO WS-REC-FOUND-IND. DTSCSL1 -00875 DTSCSL1 -00876 PERFORM P6190-BROWSE-MQTR THRU P6190-EXIT DTSCSL1 -00877 UNTIL (L810-NO-REC-88) DTSCSL1 -00878 OR DTSCSL1 -00879 (WS-REC-FOUND-IND = 'Y'). DTSCSL1 -00880 SKIP3 DTSCSL1 -00881 IF L810-NO-REC-88 DTSCSL1 -00882 IF LCCM-ENTER-88 DTSCSL1 -00883 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00884 PERFORM S2199-ERROR THRU S2199-EXIT DTSCSL1 -00885 ELSE DTSCSL1 -00886 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCSL1 -00887 ELSE DTSCSL1 -00888 IF LCCM-ENTER-88 DTSCSL1 -00889 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL1 -00890 IF MQTR-YRQ = WRK-YRQ DTSCSL1 -00891 NEXT SENTENCE DTSCSL1 -00892 ELSE DTSCSL1 -00893 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00894 PERFORM S2199-ERROR THRU S2199-EXIT DTSCSL1 +00797 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCSL1 +00798 DTSCSL1 +00799 MOVE SCR-HOLD-AREA TO LCCM-SCRL1-HOLD-AREA. CL**7 +00800 SKIP3 DTSCSL1 +00801 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL1 +00802 DTSCSL1 +00803 IF SCR-ACCESS-UPDATE DTSCSL1 +00804 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSL1 +00805 P6000-EXIT. DTSCSL1 +00806 EXIT. DTSCSL1 +00807 EJECT DTSCSL1 +00808 P6100-LOCATE-REC. DTSCSL1 +00809 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0 DTSCSL1 +00810 MOVE +0 TO WRK-YRQ DTSCSL1 +00811 CURR-PAGE-NUM DTSCSL1 +00812 GO TO P6100-EXIT. DTSCSL1 +00813 SKIP3 DTSCSL1 +00814 IF LCCM-F05-88 DTSCSL1 +00815 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCSL1 +00816 GO TO P6100-EXIT. DTSCSL1 +00817 SKIP3 DTSCSL1 +00818 IF LCCM-F06-88 DTSCSL1 +00819 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCSL1 +00820 GO TO P6100-EXIT. DTSCSL1 +00821 SKIP3 DTSCSL1 +00822 IF WRK-YRQ = +0 DTSCSL1 +00823 PERFORM P6150-DEFAULT-REC THRU P6150-EXIT DTSCSL1 +00824 GO TO P6100-EXIT. DTSCSL1 +00825 SKIP3 DTSCSL1 +00826 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCSL1 +00827 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCSL1 +00828 SET MQTR-QTR-88 TO TRUE. DTSCSL1 +00829 MOVE WRK-YRQ TO MQTR-YRQ. DTSCSL1 +00830 DTSCSL1 +00831 IF (SCR-HOLD-KEY-INFO = WRK-KEY-INFO) DTSCSL1 +00832 AND DTSCSL1 +00833 (SCR-HOLD-CURR-PAGE-NUM NOT = +0) DTSCSL1 +00834 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCSL1 +00835 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCSL1 +00836 IF L810-OK-88 DTSCSL1 +00837 IF MSKL-KEY-AREA = MQTR-KEY-AREA DTSCSL1 +00838 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCSL1 +00839 MOVE MSKL-REC TO MQTR-REC DTSCSL1 +00840 IF LCCM-ENTER-88 DTSCSL1 +00841 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL1 +00842 GO TO P6100-EXIT DTSCSL1 +00843 ELSE DTSCSL1 +00844 IF LCCM-F07-88 DTSCSL1 +00845 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCSL1 +00846 GO TO P6100-EXIT DTSCSL1 +00847 ELSE DTSCSL1 +00848 IF LCCM-F08-88 DTSCSL1 +00849 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCSL1 +00850 GO TO P6100-EXIT DTSCSL1 +00851 ELSE DTSCSL1 +00852 GO TO S899-ABEND DTSCSL1 +00853 ELSE DTSCSL1 +00854 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 +00855 SKIP3 DTSCSL1 +00856 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCSL1 +00857 DTSCSL1 +00858 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL1 +00859 DTSCSL1 +00860 SET MSKL-QTR-88 TO TRUE. DTSCSL1 +00861 DTSCSL1 +00862 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL1 +00863 DTSCSL1 +00864 IF L810-NO-REC-88 DTSCSL1 +00865 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00866 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +00867 GO TO P6100-EXIT. DTSCSL1 +00868 SKIP3 DTSCSL1 +00869 MOVE +0 TO CURR-PAGE-NUM. DTSCSL1 +00870 DTSCSL1 +00871 MOVE 'N' TO WS-REC-FOUND-IND. DTSCSL1 +00872 DTSCSL1 +00873 PERFORM P6190-BROWSE-MQTR THRU P6190-EXIT DTSCSL1 +00874 UNTIL (L810-NO-REC-88) DTSCSL1 +00875 OR DTSCSL1 +00876 (WS-REC-FOUND-IND = 'Y'). DTSCSL1 +00877 SKIP3 DTSCSL1 +00878 IF L810-NO-REC-88 DTSCSL1 +00879 IF LCCM-ENTER-88 DTSCSL1 +00880 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00881 PERFORM S2199-ERROR THRU S2199-EXIT DTSCSL1 +00882 ELSE DTSCSL1 +00883 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCSL1 +00884 ELSE DTSCSL1 +00885 IF LCCM-ENTER-88 DTSCSL1 +00886 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL1 +00887 IF MQTR-YRQ = WRK-YRQ DTSCSL1 +00888 NEXT SENTENCE DTSCSL1 +00889 ELSE DTSCSL1 +00890 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00891 PERFORM S2199-ERROR THRU S2199-EXIT DTSCSL1 +00892 ELSE DTSCSL1 +00893 IF LCCM-F07-88 DTSCSL1 +00894 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCSL1 00895 ELSE DTSCSL1 -00896 IF LCCM-F07-88 DTSCSL1 -00897 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCSL1 +00896 IF LCCM-F08-88 DTSCSL1 +00897 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCSL1 00898 ELSE DTSCSL1 -00899 IF LCCM-F08-88 DTSCSL1 -00900 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCSL1 -00901 ELSE DTSCSL1 -00902 GO TO S899-ABEND. DTSCSL1 -00903 P6100-EXIT. DTSCSL1 -00904 EXIT. DTSCSL1 -00905 SKIP3 DTSCSL1 -00906 P6110-FIRST-REC. DTSCSL1 -00907 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCSL1 -00908 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL1 -00909 SET MSKL-QTR-88 TO TRUE. DTSCSL1 -00910 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL1 -00911 IF L810-NO-REC-88 DTSCSL1 -00912 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00913 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -00914 GO TO P6110-EXIT. DTSCSL1 -00915 SKIP3 DTSCSL1 -00916 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 -00917 DTSCSL1 -00918 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 -00919 DTSCSL1 -00920 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 -00921 DTSCSL1 -00922 MOVE +1 TO CURR-PAGE-NUM. DTSCSL1 -00923 P6110-EXIT. DTSCSL1 -00924 EXIT. DTSCSL1 -00925 SKIP3 DTSCSL1 -00926 P6120-PREV-REC. DTSCSL1 -00927 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL1 -00928 IF L810-NO-REC-88 DTSCSL1 -00929 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00930 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -00931 GO TO P6120-EXIT. DTSCSL1 -00932 SKIP3 DTSCSL1 -00933 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL1 -00934 IF L810-NO-REC-88 DTSCSL1 -00935 MOVE MQTR-YRQ TO WRK-YRQ DTSCSL1 -00936 GO TO P6120-EXIT. DTSCSL1 -00937 SKIP3 DTSCSL1 -00938 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 -00939 DTSCSL1 -00940 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +00899 GO TO S899-ABEND. DTSCSL1 +00900 P6100-EXIT. DTSCSL1 +00901 EXIT. DTSCSL1 +00902 SKIP3 DTSCSL1 +00903 P6110-FIRST-REC. DTSCSL1 +00904 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCSL1 +00905 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL1 +00906 SET MSKL-QTR-88 TO TRUE. DTSCSL1 +00907 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL1 +00908 IF L810-NO-REC-88 DTSCSL1 +00909 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00910 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +00911 GO TO P6110-EXIT. DTSCSL1 +00912 SKIP3 DTSCSL1 +00913 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 +00914 DTSCSL1 +00915 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +00916 DTSCSL1 +00917 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 +00918 DTSCSL1 +00919 MOVE +1 TO CURR-PAGE-NUM. DTSCSL1 +00920 P6110-EXIT. DTSCSL1 +00921 EXIT. DTSCSL1 +00922 SKIP3 DTSCSL1 +00923 P6120-PREV-REC. DTSCSL1 +00924 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL1 +00925 IF L810-NO-REC-88 DTSCSL1 +00926 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00927 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +00928 GO TO P6120-EXIT. DTSCSL1 +00929 SKIP3 DTSCSL1 +00930 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL1 +00931 IF L810-NO-REC-88 DTSCSL1 +00932 MOVE MQTR-YRQ TO WRK-YRQ DTSCSL1 +00933 GO TO P6120-EXIT. DTSCSL1 +00934 SKIP3 DTSCSL1 +00935 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 +00936 DTSCSL1 +00937 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +00938 DTSCSL1 +00939 IF CURR-PAGE-NUM > +0 DTSCSL1 +00940 SUBTRACT 1 FROM CURR-PAGE-NUM. DTSCSL1 00941 DTSCSL1 -00942 IF CURR-PAGE-NUM > +0 DTSCSL1 -00943 SUBTRACT 1 FROM CURR-PAGE-NUM. DTSCSL1 -00944 DTSCSL1 -00945 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 -00946 P6120-EXIT. DTSCSL1 -00947 EXIT. DTSCSL1 -00948 SKIP3 DTSCSL1 -00949 P6130-NEXT-REC. DTSCSL1 -00950 IF MQTR-YRQ > WRK-YRQ DTSCSL1 -00951 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL1 -00952 MOVE MQTR-YRQ TO WRK-YRQ DTSCSL1 -00953 GO TO P6130-EXIT. DTSCSL1 -00954 SKIP3 DTSCSL1 -00955 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCSL1 -00956 DTSCSL1 -00957 IF L810-NO-REC-88 DTSCSL1 -00958 MOVE MQTR-YRQ TO WRK-YRQ DTSCSL1 -00959 GO TO P6130-EXIT. DTSCSL1 -00960 SKIP3 DTSCSL1 -00961 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 +00942 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 +00943 P6120-EXIT. DTSCSL1 +00944 EXIT. DTSCSL1 +00945 SKIP3 DTSCSL1 +00946 P6130-NEXT-REC. DTSCSL1 +00947 IF MQTR-YRQ > WRK-YRQ DTSCSL1 +00948 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL1 +00949 MOVE MQTR-YRQ TO WRK-YRQ DTSCSL1 +00950 GO TO P6130-EXIT. DTSCSL1 +00951 SKIP3 DTSCSL1 +00952 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCSL1 +00953 DTSCSL1 +00954 IF L810-NO-REC-88 DTSCSL1 +00955 MOVE MQTR-YRQ TO WRK-YRQ DTSCSL1 +00956 GO TO P6130-EXIT. DTSCSL1 +00957 SKIP3 DTSCSL1 +00958 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL1 +00959 DTSCSL1 +00960 IF CURR-PAGE-NUM < LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 +00961 ADD +1 TO CURR-PAGE-NUM. DTSCSL1 00962 DTSCSL1 -00963 IF CURR-PAGE-NUM < LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 -00964 ADD +1 TO CURR-PAGE-NUM. DTSCSL1 -00965 DTSCSL1 -00966 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 -00967 DTSCSL1 -00968 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 -00969 P6130-EXIT. DTSCSL1 -00970 EXIT. DTSCSL1 -00971 SKIP3 DTSCSL1 -00972 P6140-LAST-REC. DTSCSL1 -00973 IF LCCM-SCR-HOLD-LAST-KEY-AREA = LOW-VALUES DTSCSL1 -00974 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00975 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -00976 GO TO P6140-EXIT. DTSCSL1 -00977 DTSCSL1 -00978 MOVE LCCM-SCR-HOLD-LAST-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 -00979 DTSCSL1 -00980 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 -00981 IF L810-NO-REC-88 DTSCSL1 -00982 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 -00983 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -00984 GO TO P6140-EXIT. DTSCSL1 -00985 SKIP3 DTSCSL1 -00986 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 -00987 DTSCSL1 -00988 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 -00989 DTSCSL1 -00990 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCSL1 -00991 P6140-EXIT. DTSCSL1 -00992 EXIT. DTSCSL1 -00993 SKIP3 DTSCSL1 -00994 P6150-DEFAULT-REC. DTSCSL1 -00995 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCSL1 -00996 P6150-EXIT. DTSCSL1 -00997 EXIT. DTSCSL1 -00998 SKIP3 DTSCSL1 -00999 P6190-BROWSE-MQTR. DTSCSL1 -01000 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 -01001 ADD +1 TO CURR-PAGE-NUM. DTSCSL1 -01002 IF MQTR-YRQ < WRK-YRQ DTSCSL1 -01003 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCSL1 -01004 ELSE DTSCSL1 -01005 MOVE 'Y' TO WS-REC-FOUND-IND. DTSCSL1 -01006 P6190-EXIT. DTSCSL1 -01007 EXIT. DTSCSL1 -01008 EJECT DTSCSL1 -01009 P6200-REFRESH-LCCM-SCR-HOLD. DTSCSL1 -01010 MOVE LOW-VALUES TO LCCM-SCR-HOLD-CONTROL-AREA. DTSCSL1 -01011 DTSCSL1 -01012 MOVE +0 TO SCR-HOLD-CURR-PAGE-NUM. DTSCSL1 -01013 DTSCSL1 -01014 MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO. DTSCSL1 -01015 DTSCSL1 -01016 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-HOLD-ABSTIME. DTSCSL1 -01017 SKIP3 DTSCSL1 -01018 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCSL1 -01019 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL1 -01020 SET MSKL-QTR-88 TO TRUE. DTSCSL1 -01021 PERFORM S810-COUNT THRU S810-EXIT. DTSCSL1 -01022 IF L810-RECORD-CNT > +0 DTSCSL1 -01023 MOVE L810-RECORD-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 -01024 MOVE MSKL-KEY-AREA TO LCCM-SCR-HOLD-LAST-KEY-AREA DTSCSL1 -01025 ELSE DTSCSL1 -01026 MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 -01027 MOVE LOW-VALUES TO LCCM-SCR-HOLD-LAST-KEY-AREA. DTSCSL1 -01028 P6200-EXIT. DTSCSL1 -01029 EXIT. DTSCSL1 -01030 /*****************************************************************DTSCSL1 -01031 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCSL1 -01032 ******************************************************************DTSCSL1 -01033 DTSCSL1 -01034 P6900-CONSTRUCT-SCREEN. DTSCSL1 -01035 IF WRK-YRQ > +0 DTSCSL1 -01036 PERFORM P6910-FROM-MQTR THRU P6910-EXIT DTSCSL1 -01037 ELSE DTSCSL1 -01038 MOVE LOW-VALUES TO MAP-YRQ-YR DTSCSL1 -01039 MAP-YRQ-Q. DTSCSL1 -01040 DTSCSL1 -01041 PERFORM P6920-FROM-MPRF THRU P6920-EXIT. DTSCSL1 -01042 DTSCSL1 -01043 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCSL1 -01044 P6900-EXIT. DTSCSL1 -01045 EXIT. DTSCSL1 -01046 SKIP3 DTSCSL1 -01047 P6910-FROM-MQTR. DTSCSL1 -01048 IF WRK-YRQ = LCCM-PICKUP-YRQ DTSCSL1 -01049 MOVE 'PU' TO MAP-YRQ-YR DTSCSL1 -01050 MOVE ' ' TO MAP-YRQ-Q DTSCSL1 -01051 ELSE DTSCSL1 -01052 MOVE WRK-YRQ TO WRK-DISPLAY DTSCSL1 -01053 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR DTSCSL1 -01054 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. DTSCSL1 -01055 DTSCSL1 -01056 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSCSL1 -01057 MOVE SPACES TO MAP-1ST-MTH-EMPL-CNT DTSCSL1 -01058 ELSE DTSCSL1 -01059 MOVE MQTR-1ST-MTH-EMPL-CNT DTSCSL1 -01060 TO MAP-1ST-MTH-EMPL-CNT-N DTSCSL1 -01061 END-IF. DTSCSL1 -01062 DTSCSL1 -01063 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSCSL1 -01064 MOVE SPACES TO MAP-2ND-MTH-EMPL-CNT DTSCSL1 -01065 ELSE DTSCSL1 -01066 MOVE MQTR-2ND-MTH-EMPL-CNT DTSCSL1 -01067 TO MAP-2ND-MTH-EMPL-CNT-N DTSCSL1 -01068 END-IF. DTSCSL1 -01069 DTSCSL1 -01070 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSCSL1 -01071 MOVE SPACES TO MAP-3RD-MTH-EMPL-CNT DTSCSL1 -01072 ELSE DTSCSL1 -01073 MOVE MQTR-3RD-MTH-EMPL-CNT DTSCSL1 -01074 TO MAP-3RD-MTH-EMPL-CNT-N DTSCSL1 -01075 END-IF. DTSCSL1 -01076 DTSCSL1 -01077 IF WRK-YRQ = LCCM-PICKUP-YRQ DTSCSL1 -01078 MOVE SPACES TO MAP-TOT-WAGE DTSCSL1 -01079 MAP-TAX-WAGE DTSCSL1 -01080 ELSE DTSCSL1 -01081 MOVE MQTR-TOT-WAGE TO MAP-TOT-WAGE-N DTSCSL1 -01082 MOVE MQTR-TAX-WAGE TO MAP-TAX-WAGE-N. DTSCSL1 -01083 DTSCSL1 -01084 IF MQTR-WAGE-CHNG-DATE > +0 DTSCSL1 -01085 MOVE MQTR-WAGE-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 -01086 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 -01087 MOVE L001-SLASH-DATE TO MAP-WAGE-CHNG-DATE DTSCSL1 -01088 END-IF. DTSCSL1 -01089 DTSCSL1 -01090 MOVE MQTR-CURR-RPT-TYPE TO L032-CD. DTSCSL1 -01091 PERFORM S032-MQTR-CURR-RPT-TYPE THRU S032-EXIT. DTSCSL1 -01092 MOVE L032-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR. DTSCSL1 -01093 DTSCSL1 -01094 IF MQTR-EMPL-CNT-CHNG-DATE > +0 DTSCSL1 -01095 MOVE MQTR-EMPL-CNT-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 -01096 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 -01097 MOVE L001-SLASH-DATE TO MAP-EMPL-CNT-CHNG-DATE DTSCSL1 -01098 END-IF. DTSCSL1 +00963 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +00964 DTSCSL1 +00965 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 +00966 P6130-EXIT. DTSCSL1 +00967 EXIT. DTSCSL1 +00968 SKIP3 DTSCSL1 +00969 P6140-LAST-REC. DTSCSL1 +00970 IF LCCM-SCR-HOLD-LAST-KEY-AREA = LOW-VALUES DTSCSL1 +00971 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00972 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +00973 GO TO P6140-EXIT. DTSCSL1 +00974 DTSCSL1 +00975 MOVE LCCM-SCR-HOLD-LAST-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 +00976 DTSCSL1 +00977 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 +00978 IF L810-NO-REC-88 DTSCSL1 +00979 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCSL1 +00980 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +00981 GO TO P6140-EXIT. DTSCSL1 +00982 SKIP3 DTSCSL1 +00983 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +00984 DTSCSL1 +00985 MOVE MQTR-YRQ TO WRK-YRQ. DTSCSL1 +00986 DTSCSL1 +00987 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCSL1 +00988 P6140-EXIT. DTSCSL1 +00989 EXIT. DTSCSL1 +00990 SKIP3 DTSCSL1 +00991 P6150-DEFAULT-REC. DTSCSL1 +00992 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCSL1 +00993 P6150-EXIT. DTSCSL1 +00994 EXIT. DTSCSL1 +00995 SKIP3 DTSCSL1 +00996 P6190-BROWSE-MQTR. DTSCSL1 +00997 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +00998 ADD +1 TO CURR-PAGE-NUM. DTSCSL1 +00999 IF MQTR-YRQ < WRK-YRQ DTSCSL1 +01000 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCSL1 +01001 ELSE DTSCSL1 +01002 MOVE 'Y' TO WS-REC-FOUND-IND. DTSCSL1 +01003 P6190-EXIT. DTSCSL1 +01004 EXIT. DTSCSL1 +01005 EJECT DTSCSL1 +01006 P6200-REFRESH-LCCM-SCR-HOLD. DTSCSL1 +01007 MOVE LOW-VALUES TO LCCM-SCR-HOLD-CONTROL-AREA. DTSCSL1 +01008 DTSCSL1 +01009 MOVE +0 TO SCR-HOLD-CURR-PAGE-NUM. DTSCSL1 +01010 DTSCSL1 +01011 MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO. DTSCSL1 +01012 DTSCSL1 +01013 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-HOLD-ABSTIME. DTSCSL1 +01014 SKIP3 DTSCSL1 +01015 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCSL1 +01016 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL1 +01017 SET MSKL-QTR-88 TO TRUE. DTSCSL1 +01018 PERFORM S810-COUNT THRU S810-EXIT. DTSCSL1 +01019 IF L810-RECORD-CNT > +0 DTSCSL1 +01020 MOVE L810-RECORD-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 +01021 MOVE MSKL-KEY-AREA TO LCCM-SCR-HOLD-LAST-KEY-AREA DTSCSL1 +01022 ELSE DTSCSL1 +01023 MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 +01024 MOVE LOW-VALUES TO LCCM-SCR-HOLD-LAST-KEY-AREA. DTSCSL1 +01025 P6200-EXIT. DTSCSL1 +01026 EXIT. DTSCSL1 +01027 /*****************************************************************DTSCSL1 +01028 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCSL1 +01029 ******************************************************************DTSCSL1 +01030 DTSCSL1 +01031 P6900-CONSTRUCT-SCREEN. DTSCSL1 +01032 IF WRK-YRQ > +0 DTSCSL1 +01033 PERFORM P6910-FROM-MQTR THRU P6910-EXIT DTSCSL1 +01034 ELSE DTSCSL1 +01035 MOVE LOW-VALUES TO MAP-YRQ-YR DTSCSL1 +01036 MAP-YRQ-Q. DTSCSL1 +01037 DTSCSL1 +01038 PERFORM P6920-FROM-MPRF THRU P6920-EXIT. DTSCSL1 +01039 DTSCSL1 +01040 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCSL1 +01041 P6900-EXIT. DTSCSL1 +01042 EXIT. DTSCSL1 +01043 SKIP3 DTSCSL1 +01044 P6910-FROM-MQTR. DTSCSL1 +01045 IF WRK-YRQ = LCCM-PICKUP-YRQ CL*15 +01046 MOVE 'PU' TO MAP-YRQ-YR CL*15 +01047 MOVE ' ' TO MAP-YRQ-Q CL*15 +01048 ELSE CL*15 +01049 MOVE WRK-YRQ TO WRK-DISPLAY CL*15 +01050 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR CL*15 +01051 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. CL*15 +01052 DTSCSL1 +01053 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSCSL1 +01054 MOVE SPACES TO MAP-1ST-MTH-EMPL-CNT DTSCSL1 +01055 ELSE DTSCSL1 +01056 MOVE MQTR-1ST-MTH-EMPL-CNT DTSCSL1 +01057 TO MAP-1ST-MTH-EMPL-CNT-N DTSCSL1 +01058 END-IF. DTSCSL1 +01059 DTSCSL1 +01060 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSCSL1 +01061 MOVE SPACES TO MAP-2ND-MTH-EMPL-CNT DTSCSL1 +01062 ELSE DTSCSL1 +01063 MOVE MQTR-2ND-MTH-EMPL-CNT DTSCSL1 +01064 TO MAP-2ND-MTH-EMPL-CNT-N DTSCSL1 +01065 END-IF. DTSCSL1 +01066 DTSCSL1 +01067 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSCSL1 +01068 MOVE SPACES TO MAP-3RD-MTH-EMPL-CNT DTSCSL1 +01069 ELSE DTSCSL1 +01070 MOVE MQTR-3RD-MTH-EMPL-CNT DTSCSL1 +01071 TO MAP-3RD-MTH-EMPL-CNT-N DTSCSL1 +01072 END-IF. DTSCSL1 +01073 DTSCSL1 +01074 IF WRK-YRQ = LCCM-PICKUP-YRQ CL*15 +01075 MOVE SPACES TO MAP-TOT-WAGE CL*15 +01076 MAP-TAX-WAGE CL*15 +01077 ELSE CL*15 +01078 MOVE MQTR-TOT-WAGE TO MAP-TOT-WAGE-N CL*15 +01079 MOVE MQTR-TAX-WAGE TO MAP-TAX-WAGE-N. CL*15 +01080 DTSCSL1 +01081 IF MQTR-WAGE-CHNG-DATE > +0 DTSCSL1 +01082 MOVE MQTR-WAGE-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 +01083 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 +01084 MOVE L001-SLASH-DATE TO MAP-WAGE-CHNG-DATE DTSCSL1 +01085 END-IF. DTSCSL1 +01086 DTSCSL1 +01087 MOVE MQTR-CURR-RPT-TYPE TO L032-CD. DTSCSL1 +01088 PERFORM S032-MQTR-CURR-RPT-TYPE THRU S032-EXIT. DTSCSL1 +01089 MOVE L032-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR. DTSCSL1 +01090 DTSCSL1 +01091 IF MQTR-EMPL-CNT-CHNG-DATE > +0 DTSCSL1 +01092 MOVE MQTR-EMPL-CNT-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 +01093 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 +01094 MOVE L001-SLASH-DATE TO MAP-EMPL-CNT-CHNG-DATE DTSCSL1 +01095 END-IF. DTSCSL1 +01096 DTSCSL1 +01097 P6910-EXIT. DTSCSL1 +01098 EXIT. DTSCSL1 01099 DTSCSL1 -01100 P6910-EXIT. DTSCSL1 -01101 EXIT. DTSCSL1 -01102 DTSCSL1 -01103 P6920-FROM-MPRF. DTSCSL1 -01104 DTSCSL1 -01105 MOVE MPRF-SIC-CD TO MAP-SIC-CD. DTSCSL1 +01100 P6920-FROM-MPRF. DTSCSL1 +01101 DTSCSL1 +01102 MOVE MPRF-SIC-CD TO MAP-SIC-CD. DTSCSL1 +01103 CL**3 +01104 MOVE MPRF-OLD-SIC-CD TO MAP-OLD-SIC-CD CL**3 +01105 DTSCSL1 01106 DTSCSL1 -01107 MOVE MPRF-OLD-SIC-CD TO MAP-OLD-SIC-CD DTSCSL1 -01108 DTSCSL1 -01109 DTSCSL1 -01110 IF MPRF-SIC-CHNG-DATE > +0 DTSCSL1 -01111 MOVE MPRF-OLD-SIC-CD TO MAP-OLD-SIC-CD DTSCSL1 -01112 MOVE MPRF-SIC-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 -01113 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 -01114 MOVE L001-SLASH-DATE TO MAP-SIC-CD-CHNG-DATE DTSCSL1 -01115 END-IF. DTSCSL1 -01116 DTSCSL1 -01117 MOVE MPRF-SIC-AUXILIARY-CD TO MAP-SIC-AUX-CD. DTSCSL1 -01118 DTSCSL1 -01119 MOVE MPRF-NAICS-CD TO MAP-NAICS-CD. DTSCSL1 -01120 DTSCSL1 -01121 IF MPRF-NAICS-CHNG-DATE > +0 DTSCSL1 -01122 MOVE MPRF-OLD-NAICS-CD TO MAP-OLD-NAICS-CD DTSCSL1 -01123 MOVE MPRF-NAICS-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 -01124 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 -01125 MOVE L001-SLASH-DATE TO MAP-NAICS-CHNG-DATE DTSCSL1 -01126 END-IF. DTSCSL1 -01127 DTSCSL1 -01128 MOVE MPRF-ALT-NAICS-CD TO MAP-ALT-NAICS-CD. DTSCSL1 -01129 DTSCSL1 -01130 MOVE MPRF-OWN-CD TO MAP-OWN-CD. DTSCSL1 -01131 DTSCSL1 -01132 IF MPRF-OWN-CHNG-DATE > +0 DTSCSL1 -01133 MOVE MPRF-OLD-OWN-CD TO MAP-OLD-OWN-CD DTSCSL1 -01134 MOVE MPRF-OWN-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 -01135 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 -01136 MOVE L001-SLASH-DATE TO MAP-OWN-CHNG-DATE DTSCSL1 -01137 END-IF. DTSCSL1 -01138 DTSCSL1 -01139 MOVE MPRF-MULTI-IND TO MAP-MULTI-IND. DTSCSL1 -01140 DTSCSL1 -01141 MOVE MPRF-WARD-CD TO MAP-WARD-CD. DTSCSL1 -01142 DTSCSL1 -01143 P6920-EXIT. DTSCSL1 -01144 EXIT. DTSCSL1 -01145 EJECT DTSCSL1 -01146 P6990-PAGE-NUMBER. DTSCSL1 -01147 IF WRK-YRQ = +0 DTSCSL1 -01148 MOVE MSG-PL11-AREA TO LCCM-MSG-AREA DTSCSL1 -01149 GO TO P6990-EXIT. DTSCSL1 -01150 SKIP3 DTSCSL1 -01151 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCSL1 -01152 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCSL1 -01153 DTSCSL1 -01154 IF CURR-PAGE-NUM = +1 DTSCSL1 -01155 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1 DTSCSL1 -01156 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCSL1 -01157 ELSE DTSCSL1 -01158 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCSL1 -01159 ELSE DTSCSL1 -01160 IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 -01161 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCSL1 -01162 P6990-EXIT. DTSCSL1 -01163 EXIT. DTSCSL1 -01164 /*****************************************************************DTSCSL1 -01165 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED. *DTSCSL1 -01166 ******************************************************************DTSCSL1 +01107 IF MPRF-SIC-CHNG-DATE > +0 DTSCSL1 +01108 MOVE MPRF-OLD-SIC-CD TO MAP-OLD-SIC-CD DTSCSL1 +01109 MOVE MPRF-SIC-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 +01110 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 +01111 MOVE L001-SLASH-DATE TO MAP-SIC-CD-CHNG-DATE CL**8 +01112 END-IF. DTSCSL1 +01113 DTSCSL1 +01114 MOVE MPRF-SIC-AUXILIARY-CD TO MAP-SIC-AUX-CD. CL*16 +01115 CL*16 +01116 MOVE MPRF-NAICS-CD TO MAP-NAICS-CD. CL**3 +01117 CL**3 +01118 IF MPRF-NAICS-CHNG-DATE > +0 CL**3 +01119 MOVE MPRF-OLD-NAICS-CD TO MAP-OLD-NAICS-CD CL**3 +01120 MOVE MPRF-NAICS-CHNG-DATE TO L001-FED-8-DATE-9 CL**3 +01121 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL**3 +01122 MOVE L001-SLASH-DATE TO MAP-NAICS-CHNG-DATE CL**3 +01123 END-IF. CL**3 +01124 CL**3 +01125 MOVE MPRF-OWN-CD TO MAP-OWN-CD. CL**3 +01126 CL**3 +01127 IF MPRF-OWN-CHNG-DATE > +0 DTSCSL1 +01128 MOVE MPRF-OLD-OWN-CD TO MAP-OLD-OWN-CD DTSCSL1 +01129 MOVE MPRF-OWN-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL1 +01130 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL1 +01131 MOVE L001-SLASH-DATE TO MAP-OWN-CHNG-DATE DTSCSL1 +01132 END-IF. DTSCSL1 +01133 DTSCSL1 +01134 MOVE MPRF-MULTI-IND TO MAP-MULTI-IND. DTSCSL1 +01135 DTSCSL1 +01136 MOVE MPRF-WARD-CD TO MAP-WARD-CD. CL**3 +01137 CL**3 +01138 P6920-EXIT. DTSCSL1 +01139 EXIT. DTSCSL1 +01140 EJECT DTSCSL1 +01141 P6990-PAGE-NUMBER. DTSCSL1 +01142 IF WRK-YRQ = +0 DTSCSL1 +01143 MOVE MSG-PL11-AREA TO LCCM-MSG-AREA CL**7 +01144 GO TO P6990-EXIT. DTSCSL1 +01145 SKIP3 DTSCSL1 +01146 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCSL1 +01147 MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE. DTSCSL1 +01148 DTSCSL1 +01149 IF CURR-PAGE-NUM = +1 DTSCSL1 +01150 IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1 DTSCSL1 +01151 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCSL1 +01152 ELSE DTSCSL1 +01153 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCSL1 +01154 ELSE DTSCSL1 +01155 IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM DTSCSL1 +01156 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCSL1 +01157 P6990-EXIT. DTSCSL1 +01158 EXIT. DTSCSL1 +01159 /*****************************************************************DTSCSL1 +01160 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED. *DTSCSL1 +01161 ******************************************************************DTSCSL1 +01162 DTSCSL1 +01163 P7000-REQUEST-EDIT. DTSCSL1 +01164 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. CL**7 +01165 DTSCSL1 +01166 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSL1 01167 DTSCSL1 -01168 P7000-REQUEST-EDIT. DTSCSL1 -01169 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. DTSCSL1 -01170 DTSCSL1 -01171 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSL1 +01168 IF LCCM-F10-88 DTSCSL1 +01169 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCSL1 +01170 ELSE DTSCSL1 +01171 GO TO S899-ABEND. DTSCSL1 01172 DTSCSL1 -01173 IF LCCM-F10-88 DTSCSL1 -01174 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCSL1 -01175 ELSE DTSCSL1 -01176 GO TO S899-ABEND. DTSCSL1 -01177 DTSCSL1 -01178 *------------------------------------------------------ DTSCSL1 -01179 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCSL1 -01180 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCSL1 -01181 * REMAIN IN 'INQUIRE' STATUS. DTSCSL1 -01182 *------------------------------------------------------ DTSCSL1 -01183 DTSCSL1 -01184 IF LCCM-MSG DTSCSL1 -01185 NEXT SENTENCE DTSCSL1 -01186 ELSE DTSCSL1 -01187 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCSL1 -01188 IF LCCM-F10-88 DTSCSL1 -01189 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCSL1 -01190 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA. DTSCSL1 -01191 DTSCSL1 -01192 SET RESP-SEND-MAP TO TRUE. DTSCSL1 -01193 P7000-EXIT. DTSCSL1 -01194 EXIT. DTSCSL1 -01195 /*****************************************************************DTSCSL1 -01196 * MODIFICATION FUNCTION WAS REQUESTED *DTSCSL1 -01197 ******************************************************************DTSCSL1 -01198 DTSCSL1 -01199 P7200-EDIT-MOD. DTSCSL1 -01200 *----------------------------------------------------- DTSCSL1 -01201 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCSL1 -01202 * INQUIRED DTSCSL1 +01173 *------------------------------------------------------ DTSCSL1 +01174 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCSL1 +01175 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCSL1 +01176 * REMAIN IN 'INQUIRE' STATUS. DTSCSL1 +01177 *------------------------------------------------------ DTSCSL1 +01178 DTSCSL1 +01179 IF LCCM-MSG DTSCSL1 +01180 NEXT SENTENCE DTSCSL1 +01181 ELSE DTSCSL1 +01182 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCSL1 +01183 IF LCCM-F10-88 DTSCSL1 +01184 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCSL1 +01185 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA. DTSCSL1 +01186 DTSCSL1 +01187 SET RESP-SEND-MAP TO TRUE. DTSCSL1 +01188 P7000-EXIT. DTSCSL1 +01189 EXIT. DTSCSL1 +01190 /*****************************************************************DTSCSL1 +01191 * MODIFICATION FUNCTION WAS REQUESTED *DTSCSL1 +01192 ******************************************************************DTSCSL1 +01193 DTSCSL1 +01194 P7200-EDIT-MOD. DTSCSL1 +01195 *----------------------------------------------------- DTSCSL1 +01196 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCSL1 +01197 * INQUIRED DTSCSL1 +01198 *----------------------------------------------------- DTSCSL1 +01199 IF NOT LCCM-SCR-INQUIRE DTSCSL1 +01200 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCSL1 +01201 GO TO P7200-EXIT. DTSCSL1 +01202 DTSCSL1 01203 *----------------------------------------------------- DTSCSL1 -01204 IF NOT LCCM-SCR-INQUIRE DTSCSL1 -01205 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCSL1 -01206 GO TO P7200-EXIT. DTSCSL1 -01207 DTSCSL1 -01208 *----------------------------------------------------- DTSCSL1 -01209 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCSL1 -01210 *----------------------------------------------------- DTSCSL1 -01211 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL1 -01212 IF LCCM-MSG DTSCSL1 -01213 GO TO P7200-EXIT. DTSCSL1 -01214 DTSCSL1 -01215 PERFORM S2101-YRQ THRU S2101-EXIT. DTSCSL1 -01216 IF LCCM-MSG DTSCSL1 +01204 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCSL1 +01205 *----------------------------------------------------- DTSCSL1 +01206 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL1 +01207 IF LCCM-MSG DTSCSL1 +01208 GO TO P7200-EXIT. DTSCSL1 +01209 DTSCSL1 +01210 PERFORM S2101-YRQ THRU S2101-EXIT. DTSCSL1 +01211 IF LCCM-MSG DTSCSL1 +01212 GO TO P7200-EXIT. DTSCSL1 +01213 DTSCSL1 +01214 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCSL1 +01215 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCSL1 +01216 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 01217 GO TO P7200-EXIT. DTSCSL1 01218 DTSCSL1 -01219 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCSL1 +01219 IF LCCM-YRQ NOT = WRK-YRQ DTSCSL1 01220 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCSL1 -01221 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +01221 PERFORM S2199-ERROR THRU S2199-EXIT DTSCSL1 01222 GO TO P7200-EXIT. DTSCSL1 01223 DTSCSL1 -01224 IF LCCM-YRQ NOT = WRK-YRQ DTSCSL1 -01225 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCSL1 -01226 PERFORM S2199-ERROR THRU S2199-EXIT DTSCSL1 -01227 GO TO P7200-EXIT. DTSCSL1 -01228 DTSCSL1 -01229 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCSL1 -01230 IF LCCM-MSG DTSCSL1 -01231 GO TO P7200-EXIT. DTSCSL1 -01232 DTSCSL1 -01233 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCSL1 -01234 P7200-EXIT. DTSCSL1 -01235 EXIT. DTSCSL1 -01236 /*****************************************************************DTSCSL1 -01237 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCSL1 -01238 ******************************************************************DTSCSL1 +01224 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCSL1 +01225 IF LCCM-MSG DTSCSL1 +01226 GO TO P7200-EXIT. DTSCSL1 +01227 DTSCSL1 +01228 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCSL1 +01229 P7200-EXIT. DTSCSL1 +01230 EXIT. DTSCSL1 +01231 /*****************************************************************DTSCSL1 +01232 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCSL1 +01233 ******************************************************************DTSCSL1 +01234 DTSCSL1 +01235 P8000-REQUEST-UPDATE. DTSCSL1 +01236 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. CL**7 +01237 DTSCSL1 +01238 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSL1 01239 DTSCSL1 -01240 P8000-REQUEST-UPDATE. DTSCSL1 -01241 MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA. DTSCSL1 -01242 DTSCSL1 -01243 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCSL1 +01240 IF LCCM-SCR-MOD-LOCKED DTSCSL1 +01241 PERFORM P8200-MOD THRU P8200-EXIT DTSCSL1 +01242 ELSE DTSCSL1 +01243 GO TO S899-ABEND. DTSCSL1 01244 DTSCSL1 -01245 IF LCCM-SCR-MOD-LOCKED DTSCSL1 -01246 PERFORM P8200-MOD THRU P8200-EXIT DTSCSL1 -01247 ELSE DTSCSL1 -01248 GO TO S899-ABEND. DTSCSL1 -01249 DTSCSL1 -01250 SET RESP-SEND-MAP TO TRUE. DTSCSL1 -01251 P8000-EXIT. DTSCSL1 -01252 EXIT. DTSCSL1 -01253 /*****************************************************************DTSCSL1 -01254 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCSL1 -01255 ******************************************************************DTSCSL1 -01256 DTSCSL1 -01257 P8200-MOD. DTSCSL1 -01258 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL1 -01259 DTSCSL1 -01260 IF LCCM-F12-88 DTSCSL1 -01261 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCSL1 -01262 GO TO P8200-EXIT. DTSCSL1 -01263 DTSCSL1 -01264 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL1 +01245 SET RESP-SEND-MAP TO TRUE. DTSCSL1 +01246 P8000-EXIT. DTSCSL1 +01247 EXIT. DTSCSL1 +01248 /*****************************************************************DTSCSL1 +01249 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCSL1 +01250 ******************************************************************DTSCSL1 +01251 DTSCSL1 +01252 P8200-MOD. DTSCSL1 +01253 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL1 +01254 DTSCSL1 +01255 IF LCCM-F12-88 DTSCSL1 +01256 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCSL1 +01257 GO TO P8200-EXIT. DTSCSL1 +01258 DTSCSL1 +01259 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL1 +01260 DTSCSL1 +01261 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCSL1 +01262 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCSL1 +01263 IF LCCM-MSG DTSCSL1 +01264 GO TO P8200-EXIT. DTSCSL1 01265 DTSCSL1 -01266 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCSL1 -01267 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCSL1 -01268 IF LCCM-MSG DTSCSL1 -01269 GO TO P8200-EXIT. DTSCSL1 -01270 DTSCSL1 -01271 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCSL1 -01272 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCSL1 -01273 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCSL1 -01274 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCSL1 -01275 DTSCSL1 -01276 PERFORM P8210-MPRF-UPDATE THRU P8210-EXIT. DTSCSL1 -01277 DTSCSL1 -01278 PERFORM P8220-MQTR-UPDATE THRU P8220-EXIT. DTSCSL1 -01279 DTSCSL1 -01280 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCSL1 -01281 DTSCSL1 -01282 SET LCCM-ENTER-88 TO TRUE. DTSCSL1 -01283 DTSCSL1 -01284 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCSL1 -01285 DTSCSL1 -01286 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL1 -01287 DTSCSL1 -01288 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCSL1 -01289 P8200-EXIT. DTSCSL1 -01290 EXIT. DTSCSL1 -01291 P8210-MPRF-UPDATE. DTSCSL1 -01292 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL1 -01293 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCSL1 -01294 SET MPRF-PRF-88 TO TRUE. DTSCSL1 -01295 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 -01296 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 -01297 IF L810-NO-REC-88 DTSCSL1 -01298 GO TO S899-ABEND. DTSCSL1 -01299 DTSCSL1 -01300 MOVE MSKL-REC TO MPRF-REC. DTSCSL1 -01301 IF MPRF-SIC-CD = MAP-SIC-CD DTSCSL1 -01302 AND MPRF-OWN-CD = MAP-OWN-CD DTSCSL1 -01303 AND MPRF-NAICS-CD = MAP-NAICS-CD DTSCSL1 -01304 AND MPRF-WARD-CD = MAP-WARD-CD DTSCSL1 -01305 AND MPRF-MULTI-IND = MAP-MULTI-IND DTSCSL1 -01306 AND MPRF-SIC-AUXILIARY-CD = MAP-SIC-AUX-CD DTSCSL1 -01307 AND MPRF-ALT-NAICS-CD = MAP-ALT-NAICS-CD DTSCSL1 -01308 GO TO P8210-EXIT. DTSCSL1 -01309 DTSCSL1 -01310 MOVE SPACES TO L331-REC-OCC-ID. DTSCSL1 -01311 DTSCSL1 -01312 IF MPRF-NAICS-CD NOT = MAP-NAICS-CD DTSCSL1 -01313 MOVE MPRF-NAICS-CD TO MPRF-OLD-NAICS-CD DTSCSL1 -01314 MOVE LCCM-CURR-RUN-DATE TO MPRF-NAICS-CHNG-DATE DTSCSL1 -01315 MOVE 'MPRF-NAICS-CD ' TO L331-FIELD-NAME DTSCSL1 -01316 MOVE MPRF-NAICS-CD TO L331-FROM-VALUE DTSCSL1 -01317 MOVE MAP-NAICS-CD TO L331-TO-VALUE DTSCSL1 -01318 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01319 MOVE MAP-NAICS-CD TO MPRF-NAICS-CD DTSCSL1 -01320 END-IF. DTSCSL1 -01321 DTSCSL1 -01322 IF MPRF-ALT-NAICS-CD NOT = MAP-ALT-NAICS-CD DTSCSL1 -01323 MOVE 'MPRF-ALT-NAICS-CD ' TO L331-FIELD-NAME DTSCSL1 -01324 MOVE MPRF-ALT-NAICS-CD TO L331-FROM-VALUE DTSCSL1 -01325 MOVE MAP-ALT-NAICS-CD TO L331-TO-VALUE DTSCSL1 -01326 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01327 MOVE MAP-ALT-NAICS-CD TO MPRF-ALT-NAICS-CD DTSCSL1 -01328 END-IF. DTSCSL1 -01329 DTSCSL1 -01330 DTSCSL1 -01331 IF MPRF-SIC-CD NOT = MAP-SIC-CD DTSCSL1 -01332 MOVE MPRF-SIC-CD TO MPRF-OLD-SIC-CD DTSCSL1 -01333 MOVE LCCM-CURR-RUN-DATE TO MPRF-SIC-CHNG-DATE DTSCSL1 -01334 MOVE 'MPRF-SIC-CD ' TO L331-FIELD-NAME DTSCSL1 -01335 MOVE MPRF-SIC-CD TO L331-FROM-VALUE DTSCSL1 -01336 MOVE MAP-SIC-CD TO L331-TO-VALUE DTSCSL1 -01337 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01338 MOVE MAP-SIC-CD TO MPRF-SIC-CD DTSCSL1 -01339 END-IF. DTSCSL1 -01340 DTSCSL1 -01341 IF MPRF-OWN-CD NOT = MAP-OWN-CD DTSCSL1 -01342 MOVE MPRF-OWN-CD TO MPRF-OLD-OWN-CD DTSCSL1 -01343 MOVE LCCM-CURR-RUN-DATE TO MPRF-OWN-CHNG-DATE DTSCSL1 -01344 MOVE 'MPRF-OWN-CD ' TO L331-FIELD-NAME DTSCSL1 -01345 MOVE MPRF-OWN-CD TO L331-FROM-VALUE DTSCSL1 -01346 MOVE MAP-OWN-CD TO L331-TO-VALUE DTSCSL1 -01347 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01348 MOVE MAP-OWN-CD TO MPRF-OWN-CD DTSCSL1 -01349 END-IF. DTSCSL1 -01350 DTSCSL1 -01351 IF MAP-MULTI-IND NOT = MPRF-MULTI-IND DTSCSL1 -01352 MOVE 'MPRF-MULTI-IND ' TO L331-FIELD-NAME DTSCSL1 -01353 MOVE MPRF-MULTI-IND TO L331-FROM-VALUE DTSCSL1 -01354 MOVE MAP-MULTI-IND TO L331-TO-VALUE DTSCSL1 -01355 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01356 MOVE MAP-MULTI-IND TO MPRF-MULTI-IND DTSCSL1 -01357 END-IF. DTSCSL1 -01358 DTSCSL1 -01359 IF MAP-WARD-CD NOT = MPRF-WARD-CD DTSCSL1 -01360 MOVE 'MPRF-WARD-CD ' TO L331-FIELD-NAME DTSCSL1 -01361 MOVE MPRF-WARD-CD TO L331-FROM-VALUE DTSCSL1 -01362 MOVE MAP-WARD-CD TO L331-TO-VALUE DTSCSL1 -01363 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01364 MOVE MAP-WARD-CD TO MPRF-WARD-CD DTSCSL1 -01365 END-IF. DTSCSL1 +01266 MOVE WRK-EMP-NO TO L331-EMP-NO. CL**6 +01267 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. CL**6 +01268 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. CL**6 +01269 MOVE LCCM-OP-ID TO L331-OP-ID. CL**6 +01270 CL**6 +01271 PERFORM P8210-MPRF-UPDATE THRU P8210-EXIT. DTSCSL1 +01272 DTSCSL1 +01273 PERFORM P8220-MQTR-UPDATE THRU P8220-EXIT. DTSCSL1 +01274 DTSCSL1 +01275 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCSL1 +01276 DTSCSL1 +01277 SET LCCM-ENTER-88 TO TRUE. DTSCSL1 +01278 DTSCSL1 +01279 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCSL1 +01280 DTSCSL1 +01281 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL1 +01282 DTSCSL1 +01283 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCSL1 +01284 P8200-EXIT. DTSCSL1 +01285 EXIT. DTSCSL1 +01286 P8210-MPRF-UPDATE. DTSCSL1 +01287 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL1 +01288 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCSL1 +01289 SET MPRF-PRF-88 TO TRUE. DTSCSL1 +01290 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 +01291 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 +01292 IF L810-NO-REC-88 DTSCSL1 +01293 GO TO S899-ABEND. DTSCSL1 +01294 DTSCSL1 +01295 MOVE MSKL-REC TO MPRF-REC. DTSCSL1 +01296 IF MPRF-SIC-CD = MAP-SIC-CD DTSCSL1 +01297 AND MPRF-OWN-CD = MAP-OWN-CD DTSCSL1 +01298 AND MPRF-NAICS-CD = MAP-NAICS-CD CL**4 +01299 AND MPRF-WARD-CD = MAP-WARD-CD CL**6 +01300 AND MPRF-MULTI-IND = MAP-MULTI-IND DTSCSL1 +01301 AND MPRF-SIC-AUXILIARY-CD = MAP-SIC-AUX-CD CL*16 +01302 GO TO P8210-EXIT. DTSCSL1 +01303 DTSCSL1 +01304 MOVE SPACES TO L331-REC-OCC-ID. CL**6 +01305 DTSCSL1 +01306 IF MPRF-NAICS-CD NOT = MAP-NAICS-CD CL**6 +01307 MOVE MPRF-NAICS-CD TO MPRF-OLD-NAICS-CD CL**6 +01308 MOVE LCCM-CURR-RUN-DATE TO MPRF-NAICS-CHNG-DATE CL**6 +01309 MOVE 'MPRF-NAICS-CD ' TO L331-FIELD-NAME CL**6 +01310 MOVE MPRF-NAICS-CD TO L331-FROM-VALUE CL**6 +01311 MOVE MAP-NAICS-CD TO L331-TO-VALUE CL**6 +01312 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01313 MOVE MAP-NAICS-CD TO MPRF-NAICS-CD CL**6 +01314 END-IF. CL**6 +01315 CL**6 +01316 DTSCSL1 +01317 IF MPRF-SIC-CD NOT = MAP-SIC-CD DTSCSL1 +01318 MOVE MPRF-SIC-CD TO MPRF-OLD-SIC-CD DTSCSL1 +01319 MOVE LCCM-CURR-RUN-DATE TO MPRF-SIC-CHNG-DATE DTSCSL1 +01320 MOVE 'MPRF-SIC-CD ' TO L331-FIELD-NAME DTSCSL1 +01321 MOVE MPRF-SIC-CD TO L331-FROM-VALUE DTSCSL1 +01322 MOVE MAP-SIC-CD TO L331-TO-VALUE DTSCSL1 +01323 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01324 MOVE MAP-SIC-CD TO MPRF-SIC-CD DTSCSL1 +01325 END-IF. DTSCSL1 +01326 DTSCSL1 +01327 IF MPRF-OWN-CD NOT = MAP-OWN-CD DTSCSL1 +01328 MOVE MPRF-OWN-CD TO MPRF-OLD-OWN-CD DTSCSL1 +01329 MOVE LCCM-CURR-RUN-DATE TO MPRF-OWN-CHNG-DATE DTSCSL1 +01330 MOVE 'MPRF-OWN-CD ' TO L331-FIELD-NAME DTSCSL1 +01331 MOVE MPRF-OWN-CD TO L331-FROM-VALUE DTSCSL1 +01332 MOVE MAP-OWN-CD TO L331-TO-VALUE DTSCSL1 +01333 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01334 MOVE MAP-OWN-CD TO MPRF-OWN-CD DTSCSL1 +01335 END-IF. DTSCSL1 +01336 DTSCSL1 +01337 IF MAP-MULTI-IND NOT = MPRF-MULTI-IND DTSCSL1 +01338 MOVE 'MPRF-MULTI-IND ' TO L331-FIELD-NAME DTSCSL1 +01339 MOVE MPRF-MULTI-IND TO L331-FROM-VALUE DTSCSL1 +01340 MOVE MAP-MULTI-IND TO L331-TO-VALUE DTSCSL1 +01341 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01342 MOVE MAP-MULTI-IND TO MPRF-MULTI-IND DTSCSL1 +01343 END-IF. DTSCSL1 +01344 CL**6 +01345 IF MAP-WARD-CD NOT = MPRF-WARD-CD CL**6 +01346 MOVE 'MPRF-WARD-CD ' TO L331-FIELD-NAME CL**6 +01347 MOVE MPRF-WARD-CD TO L331-FROM-VALUE CL**6 +01348 MOVE MAP-WARD-CD TO L331-TO-VALUE CL**6 +01349 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01350 MOVE MAP-WARD-CD TO MPRF-WARD-CD CL**6 +01351 END-IF. CL**6 +01352 DTSCSL1 +01353 IF MAP-SIC-AUX-CD NOT = MPRF-SIC-AUXILIARY-CD CL*16 +01354 MOVE 'MPRF-SIC-AUXILIARY-CD ' TO L331-FIELD-NAME CL*16 +01355 MOVE MPRF-SIC-AUXILIARY-CD TO L331-FROM-VALUE CL*16 +01356 MOVE MAP-SIC-AUX-CD TO L331-TO-VALUE CL*16 +01357 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL*16 +01358 MOVE MAP-SIC-AUX-CD TO MPRF-SIC-AUXILIARY-CD CL*16 +01359 END-IF. DTSCSL1 +01360 DTSCSL1 +01361 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCSL1 +01362 DTSCSL1 +01363 MOVE MPRF-REC TO MSKL-REC. DTSCSL1 +01364 DTSCSL1 +01365 PERFORM S810-REWRITE THRU S810-EXIT. DTSCSL1 01366 DTSCSL1 -01367 IF MAP-SIC-AUX-CD NOT = MPRF-SIC-AUXILIARY-CD DTSCSL1 -01368 MOVE 'MPRF-SIC-AUXILIARY-CD ' TO L331-FIELD-NAME DTSCSL1 -01369 MOVE MPRF-SIC-AUXILIARY-CD TO L331-FROM-VALUE DTSCSL1 -01370 MOVE MAP-SIC-AUX-CD TO L331-TO-VALUE DTSCSL1 -01371 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01372 MOVE MAP-SIC-AUX-CD TO MPRF-SIC-AUXILIARY-CD DTSCSL1 -01373 END-IF. DTSCSL1 -01374 DTSCSL1 -01375 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCSL1 -01376 DTSCSL1 -01377 MOVE MPRF-REC TO MSKL-REC. DTSCSL1 -01378 DTSCSL1 -01379 PERFORM S810-REWRITE THRU S810-EXIT. DTSCSL1 -01380 DTSCSL1 -01381 P8210-EXIT. DTSCSL1 -01382 EXIT. DTSCSL1 -01383 EJECT DTSCSL1 -01384 P8220-MQTR-UPDATE. DTSCSL1 -01385 IF SCR-HOLD-YRQ = +0 OR LCCM-PICKUP-YRQ DTSCSL1 -01386 GO TO P8220-EXIT. DTSCSL1 -01387 SKIP3 DTSCSL1 -01388 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSCSL1 -01389 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCSL1 -01390 SET MQTR-QTR-88 TO TRUE. DTSCSL1 -01391 MOVE SCR-HOLD-YRQ TO MQTR-YRQ. DTSCSL1 -01392 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 -01393 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 -01394 IF L810-NO-REC-88 DTSCSL1 -01395 GO TO S899-ABEND. DTSCSL1 -01396 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 -01397 DTSCSL1 -01398 MOVE MAP-1ST-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 -01399 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 -01400 IF L013-NO-ENTRY DTSCSL1 -01401 SET WRK-1ST-MTH-NO-ENTRY-88 TO TRUE DTSCSL1 -01402 ELSE DTSCSL1 -01403 MOVE L013-CNT TO WRK-1ST-MTH-EMPL-CNT DTSCSL1 -01404 END-IF. DTSCSL1 -01405 DTSCSL1 -01406 MOVE MAP-2ND-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 -01407 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 -01408 IF L013-NO-ENTRY DTSCSL1 -01409 SET WRK-2ND-MTH-NO-ENTRY-88 TO TRUE DTSCSL1 -01410 ELSE DTSCSL1 -01411 MOVE L013-CNT TO WRK-2ND-MTH-EMPL-CNT DTSCSL1 -01412 END-IF. DTSCSL1 -01413 DTSCSL1 -01414 MOVE MAP-3RD-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 -01415 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 -01416 IF L013-NO-ENTRY DTSCSL1 -01417 SET WRK-3RD-MTH-NO-ENTRY-88 TO TRUE DTSCSL1 -01418 ELSE DTSCSL1 -01419 MOVE L013-CNT TO WRK-3RD-MTH-EMPL-CNT DTSCSL1 -01420 END-IF. DTSCSL1 -01421 DTSCSL1 -01422 IF (MQTR-1ST-MTH-EMPL-CNT DTSCSL1 -01423 = WRK-1ST-MTH-EMPL-CNT) DTSCSL1 -01424 AND (MQTR-2ND-MTH-EMPL-CNT DTSCSL1 -01425 = WRK-2ND-MTH-EMPL-CNT) DTSCSL1 -01426 AND (MQTR-3RD-MTH-EMPL-CNT DTSCSL1 -01427 = WRK-3RD-MTH-EMPL-CNT) DTSCSL1 -01428 GO TO P8220-EXIT DTSCSL1 -01429 END-IF. DTSCSL1 -01430 DTSCSL1 -01431 MOVE MQTR-YRQ TO WRK-DISPLAY-YRQ. DTSCSL1 -01432 MOVE WRK-DISPLAY-YRQ TO L331-REC-OCC-ID. DTSCSL1 -01433 DTSCSL1 -01434 IF WRK-1ST-MTH-EMPL-CNT DTSCSL1 -01435 NOT = MQTR-1ST-MTH-EMPL-CNT DTSCSL1 -01436 MOVE 'MQTR-1ST-MTH-EMPL-CNT' TO L331-FIELD-NAME DTSCSL1 -01437 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSCSL1 -01438 MOVE SPACES TO L331-FROM-VALUE DTSCSL1 -01439 ELSE DTSCSL1 -01440 MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-CNT-DISPLAY DTSCSL1 -01441 MOVE WRK-CNT-DISPLAY-X TO L331-FROM-VALUE DTSCSL1 -01442 END-IF DTSCSL1 -01443 MOVE MAP-1ST-MTH-EMPL-CNT TO L331-TO-VALUE DTSCSL1 -01444 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01445 MOVE WRK-1ST-MTH-EMPL-CNT DTSCSL1 -01446 TO MQTR-1ST-MTH-EMPL-CNT DTSCSL1 -01447 END-IF. DTSCSL1 -01448 DTSCSL1 -01449 IF WRK-2ND-MTH-EMPL-CNT DTSCSL1 -01450 NOT = MQTR-2ND-MTH-EMPL-CNT DTSCSL1 -01451 MOVE 'MQTR-2ND-MTH-EMPL-CNT' TO L331-FIELD-NAME DTSCSL1 -01452 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSCSL1 -01453 MOVE SPACES TO L331-FROM-VALUE DTSCSL1 -01454 ELSE DTSCSL1 -01455 MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-CNT-DISPLAY DTSCSL1 -01456 MOVE WRK-CNT-DISPLAY-X TO L331-FROM-VALUE DTSCSL1 -01457 END-IF DTSCSL1 -01458 MOVE MAP-2ND-MTH-EMPL-CNT TO L331-TO-VALUE DTSCSL1 -01459 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01460 MOVE WRK-2ND-MTH-EMPL-CNT DTSCSL1 -01461 TO MQTR-2ND-MTH-EMPL-CNT DTSCSL1 -01462 END-IF. DTSCSL1 -01463 DTSCSL1 -01464 IF WRK-3RD-MTH-EMPL-CNT DTSCSL1 -01465 NOT = MQTR-3RD-MTH-EMPL-CNT DTSCSL1 -01466 MOVE 'MQTR-3RD-MTH-EMPL-CNT' TO L331-FIELD-NAME DTSCSL1 -01467 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSCSL1 -01468 MOVE SPACES TO L331-FROM-VALUE DTSCSL1 -01469 ELSE DTSCSL1 -01470 MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-CNT-DISPLAY DTSCSL1 -01471 MOVE WRK-CNT-DISPLAY-X TO L331-FROM-VALUE DTSCSL1 -01472 END-IF DTSCSL1 -01473 MOVE MAP-3RD-MTH-EMPL-CNT TO L331-TO-VALUE DTSCSL1 -01474 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCSL1 -01475 MOVE WRK-3RD-MTH-EMPL-CNT DTSCSL1 -01476 TO MQTR-3RD-MTH-EMPL-CNT DTSCSL1 -01477 END-IF. DTSCSL1 -01478 DTSCSL1 -01479 MOVE LCCM-CURR-RUN-DATE TO MQTR-CHNG-DATE DTSCSL1 -01480 MQTR-EMPL-CNT-CHNG-DATE. DTSCSL1 -01481 DTSCSL1 -01482 MOVE MQTR-REC TO MSKL-REC. DTSCSL1 -01483 PERFORM S810-REWRITE THRU S810-EXIT. DTSCSL1 -01484 P8220-EXIT. DTSCSL1 -01485 EXIT. DTSCSL1 -01486 DTSCSL1 -01487 P8810-LOCK-EMPLOYER. DTSCSL1 -01488 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCSL1 -01489 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCSL1 -01490 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCSL1 -01491 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCSL1 -01492 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCSL1 -01493 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCSL1 -01494 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCSL1 -01495 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCSL1 -01496 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCSL1 -01497 DTSCSL1 -01498 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCSL1 -01499 P8810-EXIT. DTSCSL1 -01500 EXIT. DTSCSL1 -01501 DTSCSL1 -01502 /*****************************************************************DTSCSL1 -01503 * LINKS TO UTILITY MODULES DTSCSL1 -01504 ******************************************************************DTSCSL1 -01505 DTSCSL1 -01506 S001-FROM-FED-8. DTSCSL1 -01507 SET L001-FROM-FED-8 TO TRUE. DTSCSL1 -01508 GO TO S001-DATE. DTSCSL1 -01509 DTSCSL1 -01510 *S001-FROM-ABS-DATE. DTSCSL1 -01511 * SET L001-FROM-ABS-DAY TO TRUE. DTSCSL1 -01512 * GO TO S001-DATE. DTSCSL1 -01513 DTSCSL1 -01514 S001-DATE. DTSCSL1 -01515 EXEC CICS LINK DTSCSL1 -01516 PROGRAM('DTSCU001') DTSCSL1 -01517 COMMAREA(L001-COMM-AREA) DTSCSL1 -01518 END-EXEC. DTSCSL1 -01519 S001-EXIT. DTSCSL1 -01520 EXIT. DTSCSL1 -01521 DTSCSL1 -01522 S013-COUNT-FROM-SCREEN. DTSCSL1 -01523 MOVE +0 TO L013-MIN-CNT DTSCSL1 -01524 MOVE +9999998 TO L013-MAX-CNT DTSCSL1 -01525 EXEC CICS LINK DTSCSL1 -01526 PROGRAM('DTSCU013') DTSCSL1 -01527 COMMAREA(L013-COMM-AREA) DTSCSL1 -01528 END-EXEC. DTSCSL1 -01529 S013-EXIT. DTSCSL1 -01530 EXIT. DTSCSL1 -01531 DTSCSL1 -01532 S018-EMP-NO-FROM-SCREEN. DTSCSL1 -01533 EXEC CICS LINK DTSCSL1 -01534 PROGRAM('DTSCU018') DTSCSL1 -01535 COMMAREA(L018-COMM-AREA) DTSCSL1 -01536 END-EXEC. DTSCSL1 -01537 S018-EXIT. DTSCSL1 -01538 EXIT. DTSCSL1 -01539 DTSCSL1 -01540 S029-YRQ-FROM-SCREEN. DTSCSL1 -01541 EXEC CICS LINK DTSCSL1 -01542 PROGRAM('DTSCU029') DTSCSL1 -01543 COMMAREA(L029-COMM-AREA) DTSCSL1 -01544 END-EXEC. DTSCSL1 -01545 S029-EXIT. DTSCSL1 -01546 EXIT. DTSCSL1 -01547 DTSCSL1 -01548 S032-MQTR-CURR-RPT-TYPE. DTSCSL1 -01549 SET L032-MQTR-CURR-RPT-TYPE TO TRUE. DTSCSL1 -01550 GO TO S032-LINK. DTSCSL1 -01551 DTSCSL1 -01552 S032-LINK. DTSCSL1 -01553 EXEC CICS LINK DTSCSL1 -01554 PROGRAM ('DTSCU032') DTSCSL1 -01555 COMMAREA (L032-COMM-AREA) DTSCSL1 -01556 END-EXEC. DTSCSL1 -01557 S032-EXIT. DTSCSL1 -01558 EXIT. DTSCSL1 -01559 DTSCSL1 -01560 S038-MPRF-OWN-CD. DTSCSL1 -01561 SET L038-MPRF-OWN-CD TO TRUE. DTSCSL1 -01562 GO TO S038-LINK. DTSCSL1 -01563 DTSCSL1 -01564 S038-MPRF-MULTI-IND. DTSCSL1 -01565 SET L038-MPRF-MULTI-IND TO TRUE. DTSCSL1 -01566 GO TO S038-LINK. DTSCSL1 -01567 DTSCSL1 -01568 S038-MPRF-WARD-CD. DTSCSL1 -01569 SET L038-MPRF-WARD-CD TO TRUE. DTSCSL1 -01570 GO TO S038-LINK. DTSCSL1 -01571 DTSCSL1 -01572 S038-MPRF-SIC-AUXILIARY-CD. DTSCSL1 -01573 SET L038-MPRF-SIC-AUXILIARY-CD TO TRUE. DTSCSL1 -01574 GO TO S038-LINK. DTSCSL1 +01367 P8210-EXIT. DTSCSL1 +01368 EXIT. DTSCSL1 +01369 EJECT DTSCSL1 +01370 P8220-MQTR-UPDATE. DTSCSL1 +01371 IF SCR-HOLD-YRQ = +0 OR LCCM-PICKUP-YRQ CL*15 +01372 GO TO P8220-EXIT. DTSCSL1 +01373 SKIP3 DTSCSL1 +01374 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSCSL1 +01375 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCSL1 +01376 SET MQTR-QTR-88 TO TRUE. DTSCSL1 +01377 MOVE SCR-HOLD-YRQ TO MQTR-YRQ. DTSCSL1 +01378 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 +01379 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 +01380 IF L810-NO-REC-88 DTSCSL1 +01381 GO TO S899-ABEND. DTSCSL1 +01382 MOVE MSKL-REC TO MQTR-REC. DTSCSL1 +01383 DTSCSL1 +01384 MOVE MAP-1ST-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 +01385 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 +01386 IF L013-NO-ENTRY DTSCSL1 +01387 SET WRK-1ST-MTH-NO-ENTRY-88 TO TRUE DTSCSL1 +01388 ELSE DTSCSL1 +01389 MOVE L013-CNT TO WRK-1ST-MTH-EMPL-CNT DTSCSL1 +01390 END-IF. DTSCSL1 +01391 DTSCSL1 +01392 MOVE MAP-2ND-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 +01393 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 +01394 IF L013-NO-ENTRY DTSCSL1 +01395 SET WRK-2ND-MTH-NO-ENTRY-88 TO TRUE DTSCSL1 +01396 ELSE DTSCSL1 +01397 MOVE L013-CNT TO WRK-2ND-MTH-EMPL-CNT DTSCSL1 +01398 END-IF. DTSCSL1 +01399 DTSCSL1 +01400 MOVE MAP-3RD-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 +01401 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 +01402 IF L013-NO-ENTRY DTSCSL1 +01403 SET WRK-3RD-MTH-NO-ENTRY-88 TO TRUE DTSCSL1 +01404 ELSE DTSCSL1 +01405 MOVE L013-CNT TO WRK-3RD-MTH-EMPL-CNT DTSCSL1 +01406 END-IF. DTSCSL1 +01407 DTSCSL1 +01408 IF (MQTR-1ST-MTH-EMPL-CNT DTSCSL1 +01409 = WRK-1ST-MTH-EMPL-CNT) DTSCSL1 +01410 AND (MQTR-2ND-MTH-EMPL-CNT DTSCSL1 +01411 = WRK-2ND-MTH-EMPL-CNT) DTSCSL1 +01412 AND (MQTR-3RD-MTH-EMPL-CNT DTSCSL1 +01413 = WRK-3RD-MTH-EMPL-CNT) DTSCSL1 +01414 GO TO P8220-EXIT DTSCSL1 +01415 END-IF. DTSCSL1 +01416 DTSCSL1 +01417 MOVE MQTR-YRQ TO WRK-DISPLAY-YRQ. DTSCSL1 +01418 MOVE WRK-DISPLAY-YRQ TO L331-REC-OCC-ID. CL**6 +01419 DTSCSL1 +01420 IF WRK-1ST-MTH-EMPL-CNT DTSCSL1 +01421 NOT = MQTR-1ST-MTH-EMPL-CNT DTSCSL1 +01422 MOVE 'MQTR-1ST-MTH-EMPL-CNT' TO L331-FIELD-NAME DTSCSL1 +01423 IF MQTR-1ST-MTH-NO-ENTRY-88 DTSCSL1 +01424 MOVE SPACES TO L331-FROM-VALUE DTSCSL1 +01425 ELSE DTSCSL1 +01426 MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-CNT-DISPLAY DTSCSL1 +01427 MOVE WRK-CNT-DISPLAY-X TO L331-FROM-VALUE DTSCSL1 +01428 END-IF DTSCSL1 +01429 MOVE MAP-1ST-MTH-EMPL-CNT TO L331-TO-VALUE DTSCSL1 +01430 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01431 MOVE WRK-1ST-MTH-EMPL-CNT DTSCSL1 +01432 TO MQTR-1ST-MTH-EMPL-CNT DTSCSL1 +01433 END-IF. DTSCSL1 +01434 DTSCSL1 +01435 IF WRK-2ND-MTH-EMPL-CNT DTSCSL1 +01436 NOT = MQTR-2ND-MTH-EMPL-CNT DTSCSL1 +01437 MOVE 'MQTR-2ND-MTH-EMPL-CNT' TO L331-FIELD-NAME DTSCSL1 +01438 IF MQTR-2ND-MTH-NO-ENTRY-88 DTSCSL1 +01439 MOVE SPACES TO L331-FROM-VALUE DTSCSL1 +01440 ELSE DTSCSL1 +01441 MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-CNT-DISPLAY DTSCSL1 +01442 MOVE WRK-CNT-DISPLAY-X TO L331-FROM-VALUE DTSCSL1 +01443 END-IF DTSCSL1 +01444 MOVE MAP-2ND-MTH-EMPL-CNT TO L331-TO-VALUE DTSCSL1 +01445 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01446 MOVE WRK-2ND-MTH-EMPL-CNT DTSCSL1 +01447 TO MQTR-2ND-MTH-EMPL-CNT DTSCSL1 +01448 END-IF. DTSCSL1 +01449 DTSCSL1 +01450 IF WRK-3RD-MTH-EMPL-CNT DTSCSL1 +01451 NOT = MQTR-3RD-MTH-EMPL-CNT DTSCSL1 +01452 MOVE 'MQTR-3RD-MTH-EMPL-CNT' TO L331-FIELD-NAME DTSCSL1 +01453 IF MQTR-3RD-MTH-NO-ENTRY-88 DTSCSL1 +01454 MOVE SPACES TO L331-FROM-VALUE DTSCSL1 +01455 ELSE DTSCSL1 +01456 MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-CNT-DISPLAY DTSCSL1 +01457 MOVE WRK-CNT-DISPLAY-X TO L331-FROM-VALUE DTSCSL1 +01458 END-IF DTSCSL1 +01459 MOVE MAP-3RD-MTH-EMPL-CNT TO L331-TO-VALUE DTSCSL1 +01460 PERFORM S331-WRITE-MLOG THRU S331-EXIT CL**6 +01461 MOVE WRK-3RD-MTH-EMPL-CNT CL*21 +01462 TO MQTR-3RD-MTH-EMPL-CNT CL*21 +01463 END-IF. DTSCSL1 +01464 DTSCSL1 +01465 MOVE LCCM-CURR-RUN-DATE TO MQTR-CHNG-DATE DTSCSL1 +01466 MQTR-EMPL-CNT-CHNG-DATE. DTSCSL1 +01467 DTSCSL1 +01468 MOVE MQTR-REC TO MSKL-REC. DTSCSL1 +01469 PERFORM S810-REWRITE THRU S810-EXIT. DTSCSL1 +01470 P8220-EXIT. DTSCSL1 +01471 EXIT. DTSCSL1 +01472 DTSCSL1 +01473 P8810-LOCK-EMPLOYER. DTSCSL1 +01474 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCSL1 +01475 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCSL1 +01476 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCSL1 +01477 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCSL1 +01478 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCSL1 +01479 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. CL**4 +01480 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCSL1 +01481 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCSL1 +01482 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCSL1 +01483 DTSCSL1 +01484 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCSL1 +01485 P8810-EXIT. DTSCSL1 +01486 EXIT. DTSCSL1 +01487 DTSCSL1 +01488 /*****************************************************************DTSCSL1 +01489 * LINKS TO UTILITY MODULES DTSCSL1 +01490 ******************************************************************DTSCSL1 +01491 DTSCSL1 +01492 S001-FROM-FED-8. DTSCSL1 +01493 SET L001-FROM-FED-8 TO TRUE. DTSCSL1 +01494 GO TO S001-DATE. DTSCSL1 +01495 DTSCSL1 +01496 *S001-FROM-ABS-DATE. DTSCSL1 +01497 * SET L001-FROM-ABS-DAY TO TRUE. DTSCSL1 +01498 * GO TO S001-DATE. DTSCSL1 +01499 DTSCSL1 +01500 S001-DATE. DTSCSL1 +01501 EXEC CICS LINK DTSCSL1 +01502 PROGRAM('DTSCU001') CL**4 +01503 COMMAREA(L001-COMM-AREA) DTSCSL1 +01504 END-EXEC. DTSCSL1 +01505 S001-EXIT. DTSCSL1 +01506 EXIT. DTSCSL1 +01507 DTSCSL1 +01508 S013-COUNT-FROM-SCREEN. DTSCSL1 +01509 MOVE +0 TO L013-MIN-CNT DTSCSL1 +01510 MOVE +9999998 TO L013-MAX-CNT CL*17 +01511 EXEC CICS LINK DTSCSL1 +01512 PROGRAM('DTSCU013') CL**4 +01513 COMMAREA(L013-COMM-AREA) DTSCSL1 +01514 END-EXEC. DTSCSL1 +01515 S013-EXIT. DTSCSL1 +01516 EXIT. DTSCSL1 +01517 DTSCSL1 +01518 S018-EMP-NO-FROM-SCREEN. DTSCSL1 +01519 EXEC CICS LINK DTSCSL1 +01520 PROGRAM('DTSCU018') CL**4 +01521 COMMAREA(L018-COMM-AREA) DTSCSL1 +01522 END-EXEC. DTSCSL1 +01523 S018-EXIT. DTSCSL1 +01524 EXIT. DTSCSL1 +01525 CL*14 +01526 S029-YRQ-FROM-SCREEN. CL*14 +01527 EXEC CICS LINK CL*14 +01528 PROGRAM('DTSCU029') CL*14 +01529 COMMAREA(L029-COMM-AREA) CL*14 +01530 END-EXEC. CL*14 +01531 S029-EXIT. CL*14 +01532 EXIT. CL*14 +01533 DTSCSL1 +01534 S032-MQTR-CURR-RPT-TYPE. CL*17 +01535 SET L032-MQTR-CURR-RPT-TYPE TO TRUE. DTSCSL1 +01536 GO TO S032-LINK. DTSCSL1 +01537 DTSCSL1 +01538 S032-LINK. DTSCSL1 +01539 EXEC CICS LINK DTSCSL1 +01540 PROGRAM ('DTSCU032') CL**4 +01541 COMMAREA (L032-COMM-AREA) DTSCSL1 +01542 END-EXEC. DTSCSL1 +01543 S032-EXIT. DTSCSL1 +01544 EXIT. DTSCSL1 +01545 CL**6 +01546 S038-MPRF-OWN-CD. CL**6 +01547 SET L038-MPRF-OWN-CD TO TRUE. CL**6 +01548 GO TO S038-LINK. CL**6 +01549 DTSCSL1 +01550 S038-MPRF-MULTI-IND. CL**6 +01551 SET L038-MPRF-MULTI-IND TO TRUE. DTSCSL1 +01552 GO TO S038-LINK. DTSCSL1 +01553 CL**6 +01554 S038-MPRF-WARD-CD. CL**6 +01555 SET L038-MPRF-WARD-CD TO TRUE. CL**6 +01556 GO TO S038-LINK. CL**6 +01557 DTSCSL1 +01558 S038-MPRF-SIC-AUXILIARY-CD. CL*16 +01559 SET L038-MPRF-SIC-AUXILIARY-CD TO TRUE. CL*16 +01560 GO TO S038-LINK. DTSCSL1 +01561 DTSCSL1 +01562 S038-LINK. DTSCSL1 +01563 EXEC CICS LINK DTSCSL1 +01564 PROGRAM ('DTSCU038') CL**4 +01565 COMMAREA (L038-COMM-AREA) DTSCSL1 +01566 END-EXEC. DTSCSL1 +01567 S038-EXIT. DTSCSL1 +01568 EXIT. DTSCSL1 +01569 DTSCSL1 +01570 S039-SIC-CD-DSCR. CL**6 +01571 EXEC CICS LINK DTSCSL1 +01572 PROGRAM ('DTSCU039') CL**4 +01573 COMMAREA (L039-COMM-AREA) DTSCSL1 +01574 END-EXEC. DTSCSL1 01575 DTSCSL1 -01576 S038-LINK. DTSCSL1 -01577 EXEC CICS LINK DTSCSL1 -01578 PROGRAM ('DTSCU038') DTSCSL1 -01579 COMMAREA (L038-COMM-AREA) DTSCSL1 -01580 END-EXEC. DTSCSL1 -01581 S038-EXIT. DTSCSL1 -01582 EXIT. DTSCSL1 -01583 DTSCSL1 -01584 S039-SIC-CD-DSCR. DTSCSL1 -01585 EXEC CICS LINK DTSCSL1 -01586 PROGRAM ('DTSCU039') DTSCSL1 -01587 COMMAREA (L039-COMM-AREA) DTSCSL1 -01588 END-EXEC. DTSCSL1 -01589 DTSCSL1 -01590 IF L039-SIC-FILE-CLOSED DTSCSL1 -01591 MOVE L039-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01592 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 -01593 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -01594 GO TO MAINLINE-EXIT. DTSCSL1 -01595 DTSCSL1 -01596 S039-EXIT. DTSCSL1 -01597 EXIT. DTSCSL1 -01598 SKIP3 DTSCSL1 -01599 DTSCSL1 -01600 S040-NAICS-CD-DSCR. DTSCSL1 -01601 EXEC CICS LINK DTSCSL1 -01602 PROGRAM ('DTSCU040') DTSCSL1 -01603 COMMAREA (L040-COMM-AREA) DTSCSL1 -01604 END-EXEC. DTSCSL1 -01605 DTSCSL1 -01606 IF L040-NAICS-FILE-CLOSED DTSCSL1 -01607 MOVE L040-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01608 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 -01609 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -01610 GO TO MAINLINE-EXIT. DTSCSL1 -01611 DTSCSL1 -01612 S040-EXIT. DTSCSL1 -01613 EXIT. DTSCSL1 -01614 SKIP3 DTSCSL1 -01615 S221-EMP-LOCK. DTSCSL1 -01616 SET L221-START-UPDATE TO TRUE. DTSCSL1 -01617 GO TO S221-EMP-LOCK-UNLOCK. DTSCSL1 -01618 DTSCSL1 -01619 S221-EMP-UNLOCK. DTSCSL1 -01620 SET L221-END-UPDATE TO TRUE. DTSCSL1 -01621 GO TO S221-EMP-LOCK-UNLOCK. DTSCSL1 -01622 DTSCSL1 -01623 S221-EMP-LOCK-UNLOCK. DTSCSL1 -01624 EXEC CICS LINK DTSCSL1 -01625 PROGRAM('DTSCU221') DTSCSL1 -01626 COMMAREA(L221-COMM-AREA) DTSCSL1 -01627 END-EXEC. DTSCSL1 -01628 DTSCSL1 -01629 IF L221-FILE-CLOSED DTSCSL1 -01630 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01631 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 -01632 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -01633 GO TO MAINLINE-EXIT. DTSCSL1 -01634 DTSCSL1 -01635 IF L221-NOT-OK DTSCSL1 -01636 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCSL1 -01637 S221-EXIT. DTSCSL1 -01638 EXIT. DTSCSL1 -01639 DTSCSL1 -01640 S331-WRITE-MLOG. DTSCSL1 -01641 DTSCSL1 +01576 IF L039-SIC-FILE-CLOSED DTSCSL1 +01577 MOVE L039-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01578 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 +01579 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 +01580 GO TO MAINLINE-EXIT. DTSCSL1 +01581 DTSCSL1 +01582 S039-EXIT. DTSCSL1 +01583 EXIT. DTSCSL1 +01584 SKIP3 DTSCSL1 +01585 CL**5 +01586 S040-NAICS-CD-DSCR. CL**5 +01587 EXEC CICS LINK CL**5 +01588 PROGRAM ('DTSCU040') CL**5 +01589 COMMAREA (L040-COMM-AREA) CL**5 +01590 END-EXEC. CL**5 +01591 CL**5 +01592 IF L040-NAICS-FILE-CLOSED CL**5 +01593 MOVE L040-MSG-AREA TO LCCM-MSG-AREA CL**5 +01594 SET LCCM-REQ-SCR-SF-88 TO TRUE CL**5 +01595 SET LCCM-LINK-SCREEN-88 TO TRUE CL**5 +01596 GO TO MAINLINE-EXIT. CL**5 +01597 CL**5 +01598 S040-EXIT. CL**5 +01599 EXIT. CL**5 +01600 SKIP3 CL**5 +01601 S221-EMP-LOCK. DTSCSL1 +01602 SET L221-START-UPDATE TO TRUE. DTSCSL1 +01603 GO TO S221-EMP-LOCK-UNLOCK. DTSCSL1 +01604 DTSCSL1 +01605 S221-EMP-UNLOCK. DTSCSL1 +01606 SET L221-END-UPDATE TO TRUE. DTSCSL1 +01607 GO TO S221-EMP-LOCK-UNLOCK. DTSCSL1 +01608 DTSCSL1 +01609 S221-EMP-LOCK-UNLOCK. DTSCSL1 +01610 EXEC CICS LINK DTSCSL1 +01611 PROGRAM('DTSCU221') CL**4 +01612 COMMAREA(L221-COMM-AREA) DTSCSL1 +01613 END-EXEC. DTSCSL1 +01614 DTSCSL1 +01615 IF L221-FILE-CLOSED DTSCSL1 +01616 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01617 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 +01618 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 +01619 GO TO MAINLINE-EXIT. DTSCSL1 +01620 DTSCSL1 +01621 IF L221-NOT-OK DTSCSL1 +01622 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCSL1 +01623 S221-EXIT. DTSCSL1 +01624 EXIT. DTSCSL1 +01625 DTSCSL1 +01626 S331-WRITE-MLOG. CL**6 +01627 DTSCSL1 +01628 EXEC CICS LINK DTSCSL1 +01629 PROGRAM('DTSCU331') CL**4 +01630 COMMAREA(L331-COMM-AREA) DTSCSL1 +01631 END-EXEC. DTSCSL1 +01632 DTSCSL1 +01633 IF L331-FILE-CLOSED DTSCSL1 +01634 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01635 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 +01636 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 +01637 GO TO MAINLINE-EXIT. DTSCSL1 +01638 S331-EXIT. DTSCSL1 +01639 EXIT. DTSCSL1 +01640 DTSCSL1 +01641 S803-REQ-SCR-ID-EDIT. DTSCSL1 01642 EXEC CICS LINK DTSCSL1 -01643 PROGRAM('DTSCU331') DTSCSL1 -01644 COMMAREA(L331-COMM-AREA) DTSCSL1 +01643 PROGRAM ('DTSCU803') CL**4 +01644 COMMAREA (DFHCOMMAREA) DTSCSL1 01645 END-EXEC. DTSCSL1 -01646 DTSCSL1 -01647 IF L331-FILE-CLOSED DTSCSL1 -01648 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01649 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 -01650 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -01651 GO TO MAINLINE-EXIT. DTSCSL1 -01652 S331-EXIT. DTSCSL1 -01653 EXIT. DTSCSL1 -01654 DTSCSL1 -01655 S803-REQ-SCR-ID-EDIT. DTSCSL1 -01656 EXEC CICS LINK DTSCSL1 -01657 PROGRAM ('DTSCU803') DTSCSL1 -01658 COMMAREA (DFHCOMMAREA) DTSCSL1 -01659 END-EXEC. DTSCSL1 -01660 S803-EXIT. DTSCSL1 -01661 EXIT. DTSCSL1 -01662 DTSCSL1 -01663 S804-INVALID-KEY. DTSCSL1 -01664 EXEC CICS LINK DTSCSL1 -01665 PROGRAM ('DTSCU804') DTSCSL1 -01666 COMMAREA (DFHCOMMAREA) DTSCSL1 -01667 END-EXEC. DTSCSL1 -01668 S804-EXIT. DTSCSL1 -01669 EXIT. DTSCSL1 -01670 DTSCSL1 -01671 S805-MSG-AREA. DTSCSL1 -01672 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCSL1 -01673 DTSCSL1 -01674 EXEC CICS LINK DTSCSL1 -01675 PROGRAM ('DTSCU805') DTSCSL1 -01676 COMMAREA (L805-COMM-AREA) DTSCSL1 -01677 END-EXEC. DTSCSL1 -01678 DTSCSL1 -01679 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCSL1 -01680 S805-EXIT. DTSCSL1 -01681 EXIT. DTSCSL1 -01682 EJECT DTSCSL1 -01683 S810-READ. DTSCSL1 -01684 SET L810-READ-88 TO TRUE. DTSCSL1 -01685 GO TO S810-IO. DTSCSL1 -01686 DTSCSL1 -01687 S810-START-BROWSE. DTSCSL1 -01688 SET L810-START-BROWSE-88 TO TRUE. DTSCSL1 -01689 GO TO S810-IO. DTSCSL1 -01690 DTSCSL1 -01691 S810-READ-NEXT. DTSCSL1 -01692 SET L810-READ-NEXT-88 TO TRUE. DTSCSL1 -01693 GO TO S810-IO. DTSCSL1 -01694 DTSCSL1 -01695 S810-READ-PREV. DTSCSL1 -01696 SET L810-READ-PREV-88 TO TRUE. DTSCSL1 -01697 GO TO S810-IO. DTSCSL1 -01698 DTSCSL1 -01699 S810-END-BROWSE. DTSCSL1 -01700 SET L810-END-BROWSE-88 TO TRUE. DTSCSL1 -01701 GO TO S810-IO. DTSCSL1 -01702 DTSCSL1 -01703 S810-COUNT. DTSCSL1 -01704 SET L810-COUNT-88 TO TRUE. DTSCSL1 -01705 GO TO S810-IO. DTSCSL1 +01646 S803-EXIT. DTSCSL1 +01647 EXIT. DTSCSL1 +01648 DTSCSL1 +01649 S804-INVALID-KEY. DTSCSL1 +01650 EXEC CICS LINK DTSCSL1 +01651 PROGRAM ('DTSCU804') CL**4 +01652 COMMAREA (DFHCOMMAREA) DTSCSL1 +01653 END-EXEC. DTSCSL1 +01654 S804-EXIT. DTSCSL1 +01655 EXIT. DTSCSL1 +01656 DTSCSL1 +01657 S805-MSG-AREA. DTSCSL1 +01658 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCSL1 +01659 DTSCSL1 +01660 EXEC CICS LINK DTSCSL1 +01661 PROGRAM ('DTSCU805') CL**4 +01662 COMMAREA (L805-COMM-AREA) DTSCSL1 +01663 END-EXEC. DTSCSL1 +01664 DTSCSL1 +01665 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCSL1 +01666 S805-EXIT. DTSCSL1 +01667 EXIT. DTSCSL1 +01668 EJECT DTSCSL1 +01669 S810-READ. DTSCSL1 +01670 SET L810-READ-88 TO TRUE. DTSCSL1 +01671 GO TO S810-IO. DTSCSL1 +01672 DTSCSL1 +01673 S810-START-BROWSE. DTSCSL1 +01674 SET L810-START-BROWSE-88 TO TRUE. DTSCSL1 +01675 GO TO S810-IO. DTSCSL1 +01676 DTSCSL1 +01677 S810-READ-NEXT. DTSCSL1 +01678 SET L810-READ-NEXT-88 TO TRUE. DTSCSL1 +01679 GO TO S810-IO. DTSCSL1 +01680 DTSCSL1 +01681 S810-READ-PREV. DTSCSL1 +01682 SET L810-READ-PREV-88 TO TRUE. DTSCSL1 +01683 GO TO S810-IO. DTSCSL1 +01684 DTSCSL1 +01685 S810-END-BROWSE. DTSCSL1 +01686 SET L810-END-BROWSE-88 TO TRUE. DTSCSL1 +01687 GO TO S810-IO. DTSCSL1 +01688 DTSCSL1 +01689 S810-COUNT. DTSCSL1 +01690 SET L810-COUNT-88 TO TRUE. DTSCSL1 +01691 GO TO S810-IO. DTSCSL1 +01692 DTSCSL1 +01693 S810-REWRITE. DTSCSL1 +01694 SET L810-REWRITE-88 TO TRUE. DTSCSL1 +01695 GO TO S810-IO. DTSCSL1 +01696 DTSCSL1 +01697 *S810-WRITE. DTSCSL1 +01698 * SET L810-WRITE-88 TO TRUE. DTSCSL1 +01699 * GO TO S810-IO. DTSCSL1 +01700 DTSCSL1 +01701 *S810-DELETE. DTSCSL1 +01702 * SET L810-DELETE-88 TO TRUE. DTSCSL1 +01703 * GO TO S810-IO. DTSCSL1 +01704 DTSCSL1 +01705 S810-IO. DTSCSL1 01706 DTSCSL1 -01707 S810-REWRITE. DTSCSL1 -01708 SET L810-REWRITE-88 TO TRUE. DTSCSL1 -01709 GO TO S810-IO. DTSCSL1 -01710 DTSCSL1 -01711 *S810-WRITE. DTSCSL1 -01712 * SET L810-WRITE-88 TO TRUE. DTSCSL1 -01713 * GO TO S810-IO. DTSCSL1 -01714 DTSCSL1 -01715 *S810-DELETE. DTSCSL1 -01716 * SET L810-DELETE-88 TO TRUE. DTSCSL1 -01717 * GO TO S810-IO. DTSCSL1 -01718 DTSCSL1 -01719 S810-IO. DTSCSL1 -01720 DTSCSL1 -01721 EXEC CICS LINK DTSCSL1 -01722 PROGRAM ('DTSCU810') DTSCSL1 -01723 COMMAREA (L810-COMM-AREA) DTSCSL1 -01724 END-EXEC. DTSCSL1 +01707 EXEC CICS LINK DTSCSL1 +01708 PROGRAM ('DTSCU810') CL**4 +01709 COMMAREA (L810-COMM-AREA) DTSCSL1 +01710 END-EXEC. DTSCSL1 +01711 DTSCSL1 +01712 IF L810-FILE-CLOSED-88 DTSCSL1 +01713 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01714 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 +01715 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 +01716 GO TO MAINLINE-EXIT. DTSCSL1 +01717 S810-EXIT. DTSCSL1 +01718 EXIT. DTSCSL1 +01719 EJECT DTSCSL1 +01720 S825-WRITE. DTSCSL1 +01721 SET L825-WRITE-88 TO TRUE. DTSCSL1 +01722 GO TO S825-O. DTSCSL1 +01723 DTSCSL1 +01724 S825-O. DTSCSL1 01725 DTSCSL1 -01726 IF L810-FILE-CLOSED-88 DTSCSL1 -01727 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01728 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 -01729 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -01730 GO TO MAINLINE-EXIT. DTSCSL1 -01731 S810-EXIT. DTSCSL1 -01732 EXIT. DTSCSL1 -01733 EJECT DTSCSL1 -01734 S825-WRITE. DTSCSL1 -01735 SET L825-WRITE-88 TO TRUE. DTSCSL1 -01736 GO TO S825-O. DTSCSL1 -01737 DTSCSL1 -01738 S825-O. DTSCSL1 +01726 EXEC CICS LINK DTSCSL1 +01727 PROGRAM ('DTSCU825') CL**4 +01728 COMMAREA (L825-COMM-AREA) DTSCSL1 +01729 END-EXEC. DTSCSL1 +01730 DTSCSL1 +01731 IF L825-FILE-CLOSED-88 DTSCSL1 +01732 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01733 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 +01734 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 +01735 GO TO MAINLINE-EXIT. DTSCSL1 +01736 S825-EXIT. DTSCSL1 +01737 EXIT. DTSCSL1 +01738 EJECT DTSCSL1 01739 DTSCSL1 -01740 EXEC CICS LINK DTSCSL1 -01741 PROGRAM ('DTSCU825') DTSCSL1 -01742 COMMAREA (L825-COMM-AREA) DTSCSL1 -01743 END-EXEC. DTSCSL1 -01744 DTSCSL1 -01745 IF L825-FILE-CLOSED-88 DTSCSL1 -01746 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01747 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL1 -01748 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL1 -01749 GO TO MAINLINE-EXIT. DTSCSL1 -01750 S825-EXIT. DTSCSL1 -01751 EXIT. DTSCSL1 -01752 EJECT DTSCSL1 -01753 DTSCSL1 -01754 S851-SCREEN-PROCESSING. DTSCSL1 -01755 EXEC CICS LINK DTSCSL1 -01756 PROGRAM ('DTSCU851') DTSCSL1 -01757 COMMAREA (L851-COMM-AREA) DTSCSL1 -01758 END-EXEC. DTSCSL1 -01759 S851-EXIT. DTSCSL1 -01760 EXIT. DTSCSL1 -01761 DTSCSL1 -01762 S899-ABEND. DTSCSL1 -01763 EXEC CICS ABEND DTSCSL1 -01764 ABCODE(WRK-ABEND-CD) DTSCSL1 -01765 END-EXEC. DTSCSL1 -01766 *S899-EXIT. DTSCSL1 -01767 * EXIT. DTSCSL1 -01768 /*****************************************************************DTSCSL1 -01769 * EDIT THE INFORMATION ON THE SCREEN. *DTSCSL1 -01770 ******************************************************************DTSCSL1 -01771 DTSCSL1 -01772 S1000-SCREEN-EDITS. DTSCSL1 -01773 PERFORM S1200-1ST-MTH-EMPL-CNT THRU S1200-EXIT. DTSCSL1 -01774 PERFORM S1300-2ND-MTH-EMPL-CNT THRU S1300-EXIT. DTSCSL1 -01775 PERFORM S1400-3RD-MTH-EMPL-CNT THRU S1400-EXIT. DTSCSL1 -01776 PERFORM S1500-SIC-CD THRU S1500-EXIT. DTSCSL1 -01777 PERFORM S1700-SIC-AUX-CD THRU S1700-EXIT. DTSCSL1 -01778 PERFORM S1600-NAICS-CD THRU S1600-EXIT. DTSCSL1 -01779 PERFORM S2200-ALT-NAICS-CD THRU S2200-EXIT. DTSCSL1 -01780 PERFORM S1800-OWN-CD THRU S1800-EXIT. DTSCSL1 -01781 PERFORM S1900-MULTI-IND THRU S1900-EXIT. DTSCSL1 -01782 PERFORM S2000-WARD-CD THRU S2000-EXIT. DTSCSL1 -01783 S1000-EXIT. EXIT. DTSCSL1 -01784 EJECT DTSCSL1 -01785 S1100-EDIT-KEY. DTSCSL1 -01786 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCSL1 -01787 S1100-EXIT. EXIT. DTSCSL1 -01788 /*****************************************************************DTSCSL1 -01789 * DTSCSL1 -01790 ******************************************************************DTSCSL1 -01791 S1101-EMP-NO. DTSCSL1 -01792 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL1 -01793 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL1 -01794 DTSCSL1 -01795 IF L018-NO-ENTRY DTSCSL1 -01796 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCSL1 -01797 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -01798 GO TO S1101-EXIT. DTSCSL1 -01799 DTSCSL1 -01800 IF L018-NOT-VALID DTSCSL1 -01801 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -01802 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -01803 GO TO S1101-EXIT. DTSCSL1 -01804 DTSCSL1 -01805 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCSL1 -01806 S1101-EXIT. EXIT. DTSCSL1 +01740 S851-SCREEN-PROCESSING. DTSCSL1 +01741 EXEC CICS LINK DTSCSL1 +01742 PROGRAM ('DTSCU851') CL**4 +01743 COMMAREA (L851-COMM-AREA) DTSCSL1 +01744 END-EXEC. DTSCSL1 +01745 S851-EXIT. DTSCSL1 +01746 EXIT. DTSCSL1 +01747 DTSCSL1 +01748 S899-ABEND. DTSCSL1 +01749 EXEC CICS ABEND DTSCSL1 +01750 ABCODE(WRK-ABEND-CD) DTSCSL1 +01751 END-EXEC. DTSCSL1 +01752 *S899-EXIT. DTSCSL1 +01753 * EXIT. DTSCSL1 +01754 /*****************************************************************DTSCSL1 +01755 * EDIT THE INFORMATION ON THE SCREEN. *DTSCSL1 +01756 ******************************************************************DTSCSL1 +01757 DTSCSL1 +01758 S1000-SCREEN-EDITS. DTSCSL1 +01759 PERFORM S1200-1ST-MTH-EMPL-CNT THRU S1200-EXIT. DTSCSL1 +01760 PERFORM S1300-2ND-MTH-EMPL-CNT THRU S1300-EXIT. DTSCSL1 +01761 PERFORM S1400-3RD-MTH-EMPL-CNT THRU S1400-EXIT. DTSCSL1 +01762 PERFORM S1500-SIC-CD THRU S1500-EXIT. CL**5 +01763 PERFORM S1700-SIC-AUX-CD THRU S1700-EXIT. CL*16 +01764 PERFORM S1600-NAICS-CD THRU S1600-EXIT. CL**5 +01765 PERFORM S1800-OWN-CD THRU S1800-EXIT. CL**5 +01766 PERFORM S1900-MULTI-IND THRU S1900-EXIT. CL**5 +01767 PERFORM S2000-WARD-CD THRU S2000-EXIT. CL**5 +01768 S1000-EXIT. EXIT. DTSCSL1 +01769 EJECT DTSCSL1 +01770 S1100-EDIT-KEY. DTSCSL1 +01771 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCSL1 +01772 S1100-EXIT. EXIT. DTSCSL1 +01773 /*****************************************************************DTSCSL1 +01774 * DTSCSL1 +01775 ******************************************************************DTSCSL1 +01776 S1101-EMP-NO. DTSCSL1 +01777 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL1 +01778 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL1 +01779 DTSCSL1 +01780 IF L018-NO-ENTRY DTSCSL1 +01781 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCSL1 +01782 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +01783 GO TO S1101-EXIT. DTSCSL1 +01784 DTSCSL1 +01785 IF L018-NOT-VALID DTSCSL1 +01786 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +01787 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +01788 GO TO S1101-EXIT. DTSCSL1 +01789 DTSCSL1 +01790 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCSL1 +01791 S1101-EXIT. EXIT. DTSCSL1 +01792 DTSCSL1 +01793 S1110-READ-MPRF. DTSCSL1 +01794 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL1 +01795 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCSL1 +01796 SET MPRF-PRF-88 TO TRUE. DTSCSL1 +01797 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 +01798 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 +01799 IF L810-NO-REC-88 DTSCSL1 +01800 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCSL1 +01801 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 +01802 ELSE DTSCSL1 +01803 MOVE MSKL-REC TO MPRF-REC DTSCSL1 +01804 SET WRK-MPRF-YES-88 TO TRUE. DTSCSL1 +01805 S1110-EXIT. DTSCSL1 +01806 EXIT. DTSCSL1 01807 DTSCSL1 -01808 S1110-READ-MPRF. DTSCSL1 -01809 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL1 -01810 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCSL1 -01811 SET MPRF-PRF-88 TO TRUE. DTSCSL1 -01812 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL1 -01813 PERFORM S810-READ THRU S810-EXIT. DTSCSL1 -01814 IF L810-NO-REC-88 DTSCSL1 -01815 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCSL1 -01816 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL1 -01817 ELSE DTSCSL1 -01818 MOVE MSKL-REC TO MPRF-REC DTSCSL1 -01819 SET WRK-MPRF-YES-88 TO TRUE. DTSCSL1 -01820 S1110-EXIT. DTSCSL1 -01821 EXIT. DTSCSL1 +01808 S1199-ERROR. DTSCSL1 +01809 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCSL1 +01810 MAP-EMP-NO-2-A. DTSCSL1 +01811 IF LCCM-NO-MSG DTSCSL1 +01812 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01813 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCSL1 +01814 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +01815 S1199-EXIT. EXIT. DTSCSL1 +01816 /*****************************************************************DTSCSL1 +01817 * DTSCSL1 +01818 ******************************************************************DTSCSL1 +01819 S1200-1ST-MTH-EMPL-CNT. DTSCSL1 +01820 MOVE MAP-1ST-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 +01821 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 01822 DTSCSL1 -01823 S1199-ERROR. DTSCSL1 -01824 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCSL1 -01825 MAP-EMP-NO-2-A. DTSCSL1 -01826 IF LCCM-NO-MSG DTSCSL1 -01827 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01828 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCSL1 -01829 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -01830 S1199-EXIT. EXIT. DTSCSL1 -01831 /*****************************************************************DTSCSL1 -01832 * DTSCSL1 -01833 ******************************************************************DTSCSL1 -01834 S1200-1ST-MTH-EMPL-CNT. DTSCSL1 -01835 MOVE MAP-1ST-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 -01836 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 -01837 DTSCSL1 -01838 IF L013-NO-ENTRY DTSCSL1 +01823 IF L013-NO-ENTRY DTSCSL1 +01824 GO TO S1200-EXIT. DTSCSL1 +01825 DTSCSL1 +01826 IF L013-INVALID-NEGATIVE DTSCSL1 +01827 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCSL1 +01828 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL1 +01829 GO TO S1200-EXIT. DTSCSL1 +01830 DTSCSL1 +01831 IF L013-EXCEEDS-MIN-MAX DTSCSL1 +01832 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCSL1 +01833 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL1 +01834 GO TO S1200-EXIT. DTSCSL1 +01835 DTSCSL1 +01836 IF L013-NOT-VALID DTSCSL1 +01837 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +01838 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL1 01839 GO TO S1200-EXIT. DTSCSL1 01840 DTSCSL1 -01841 IF L013-INVALID-NEGATIVE DTSCSL1 -01842 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCSL1 -01843 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL1 -01844 GO TO S1200-EXIT. DTSCSL1 -01845 DTSCSL1 -01846 IF L013-EXCEEDS-MIN-MAX DTSCSL1 -01847 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCSL1 -01848 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL1 -01849 GO TO S1200-EXIT. DTSCSL1 -01850 DTSCSL1 -01851 IF L013-NOT-VALID DTSCSL1 -01852 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -01853 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL1 -01854 GO TO S1200-EXIT. DTSCSL1 -01855 DTSCSL1 -01856 MOVE L013-CNT TO MAP-1ST-MTH-EMPL-CNT-N. DTSCSL1 -01857 S1200-EXIT. EXIT. DTSCSL1 -01858 DTSCSL1 -01859 S1201-ERROR. DTSCSL1 -01860 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-1ST-MTH-EMPL-CNT-A DTSCSL1 -01861 IF LCCM-NO-MSG DTSCSL1 -01862 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01863 MOVE CATB-CURSOR TO MAP-1ST-MTH-EMPL-CNT-L DTSCSL1 -01864 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -01865 S1201-EXIT. EXIT. DTSCSL1 -01866 /*****************************************************************DTSCSL1 -01867 * DTSCSL1 -01868 ******************************************************************DTSCSL1 -01869 S1300-2ND-MTH-EMPL-CNT. DTSCSL1 -01870 MOVE MAP-2ND-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 -01871 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 -01872 DTSCSL1 -01873 IF L013-NO-ENTRY DTSCSL1 +01841 MOVE L013-CNT TO MAP-1ST-MTH-EMPL-CNT-N. DTSCSL1 +01842 S1200-EXIT. EXIT. DTSCSL1 +01843 DTSCSL1 +01844 S1201-ERROR. DTSCSL1 +01845 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-1ST-MTH-EMPL-CNT-A DTSCSL1 +01846 IF LCCM-NO-MSG DTSCSL1 +01847 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01848 MOVE CATB-CURSOR TO MAP-1ST-MTH-EMPL-CNT-L DTSCSL1 +01849 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +01850 S1201-EXIT. EXIT. DTSCSL1 +01851 /*****************************************************************DTSCSL1 +01852 * DTSCSL1 +01853 ******************************************************************DTSCSL1 +01854 S1300-2ND-MTH-EMPL-CNT. DTSCSL1 +01855 MOVE MAP-2ND-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 +01856 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 +01857 DTSCSL1 +01858 IF L013-NO-ENTRY DTSCSL1 +01859 GO TO S1300-EXIT. DTSCSL1 +01860 DTSCSL1 +01861 IF L013-INVALID-NEGATIVE DTSCSL1 +01862 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCSL1 +01863 PERFORM S1301-ERROR THRU S1301-EXIT DTSCSL1 +01864 GO TO S1300-EXIT. DTSCSL1 +01865 DTSCSL1 +01866 IF L013-EXCEEDS-MIN-MAX DTSCSL1 +01867 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCSL1 +01868 PERFORM S1301-ERROR THRU S1301-EXIT DTSCSL1 +01869 GO TO S1300-EXIT. DTSCSL1 +01870 DTSCSL1 +01871 IF L013-NOT-VALID DTSCSL1 +01872 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +01873 PERFORM S1301-ERROR THRU S1301-EXIT DTSCSL1 01874 GO TO S1300-EXIT. DTSCSL1 01875 DTSCSL1 -01876 IF L013-INVALID-NEGATIVE DTSCSL1 -01877 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCSL1 -01878 PERFORM S1301-ERROR THRU S1301-EXIT DTSCSL1 -01879 GO TO S1300-EXIT. DTSCSL1 -01880 DTSCSL1 -01881 IF L013-EXCEEDS-MIN-MAX DTSCSL1 -01882 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCSL1 -01883 PERFORM S1301-ERROR THRU S1301-EXIT DTSCSL1 -01884 GO TO S1300-EXIT. DTSCSL1 -01885 DTSCSL1 -01886 IF L013-NOT-VALID DTSCSL1 -01887 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -01888 PERFORM S1301-ERROR THRU S1301-EXIT DTSCSL1 -01889 GO TO S1300-EXIT. DTSCSL1 -01890 DTSCSL1 -01891 MOVE L013-CNT TO MAP-2ND-MTH-EMPL-CNT-N. DTSCSL1 -01892 S1300-EXIT. EXIT. DTSCSL1 -01893 DTSCSL1 -01894 S1301-ERROR. DTSCSL1 -01895 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-2ND-MTH-EMPL-CNT-A DTSCSL1 -01896 IF LCCM-NO-MSG DTSCSL1 -01897 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01898 MOVE CATB-CURSOR TO MAP-2ND-MTH-EMPL-CNT-L DTSCSL1 -01899 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -01900 S1301-EXIT. EXIT. DTSCSL1 -01901 /*****************************************************************DTSCSL1 -01902 * DTSCSL1 -01903 ******************************************************************DTSCSL1 -01904 S1400-3RD-MTH-EMPL-CNT. DTSCSL1 -01905 MOVE MAP-3RD-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 -01906 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 -01907 DTSCSL1 -01908 IF L013-NO-ENTRY DTSCSL1 +01876 MOVE L013-CNT TO MAP-2ND-MTH-EMPL-CNT-N. DTSCSL1 +01877 S1300-EXIT. EXIT. DTSCSL1 +01878 DTSCSL1 +01879 S1301-ERROR. DTSCSL1 +01880 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-2ND-MTH-EMPL-CNT-A DTSCSL1 +01881 IF LCCM-NO-MSG DTSCSL1 +01882 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01883 MOVE CATB-CURSOR TO MAP-2ND-MTH-EMPL-CNT-L DTSCSL1 +01884 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +01885 S1301-EXIT. EXIT. DTSCSL1 +01886 /*****************************************************************DTSCSL1 +01887 * DTSCSL1 +01888 ******************************************************************DTSCSL1 +01889 S1400-3RD-MTH-EMPL-CNT. DTSCSL1 +01890 MOVE MAP-3RD-MTH-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCSL1 +01891 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL1 +01892 DTSCSL1 +01893 IF L013-NO-ENTRY DTSCSL1 +01894 GO TO S1400-EXIT. DTSCSL1 +01895 DTSCSL1 +01896 IF L013-INVALID-NEGATIVE DTSCSL1 +01897 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCSL1 +01898 PERFORM S1401-ERROR THRU S1401-EXIT DTSCSL1 +01899 GO TO S1400-EXIT. DTSCSL1 +01900 DTSCSL1 +01901 IF L013-EXCEEDS-MIN-MAX DTSCSL1 +01902 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCSL1 +01903 PERFORM S1401-ERROR THRU S1401-EXIT DTSCSL1 +01904 GO TO S1400-EXIT. DTSCSL1 +01905 DTSCSL1 +01906 IF L013-NOT-VALID DTSCSL1 +01907 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +01908 PERFORM S1401-ERROR THRU S1401-EXIT DTSCSL1 01909 GO TO S1400-EXIT. DTSCSL1 01910 DTSCSL1 -01911 IF L013-INVALID-NEGATIVE DTSCSL1 -01912 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCSL1 -01913 PERFORM S1401-ERROR THRU S1401-EXIT DTSCSL1 -01914 GO TO S1400-EXIT. DTSCSL1 -01915 DTSCSL1 -01916 IF L013-EXCEEDS-MIN-MAX DTSCSL1 -01917 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCSL1 -01918 PERFORM S1401-ERROR THRU S1401-EXIT DTSCSL1 -01919 GO TO S1400-EXIT. DTSCSL1 -01920 DTSCSL1 -01921 IF L013-NOT-VALID DTSCSL1 -01922 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -01923 PERFORM S1401-ERROR THRU S1401-EXIT DTSCSL1 -01924 GO TO S1400-EXIT. DTSCSL1 -01925 DTSCSL1 -01926 MOVE L013-CNT TO MAP-3RD-MTH-EMPL-CNT-N. DTSCSL1 -01927 S1400-EXIT. EXIT. DTSCSL1 -01928 DTSCSL1 -01929 S1401-ERROR. DTSCSL1 -01930 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-3RD-MTH-EMPL-CNT-A DTSCSL1 -01931 IF LCCM-NO-MSG DTSCSL1 -01932 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01933 MOVE CATB-CURSOR TO MAP-3RD-MTH-EMPL-CNT-L DTSCSL1 -01934 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -01935 S1401-EXIT. EXIT. DTSCSL1 -01936 /*****************************************************************DTSCSL1 -01937 * DTSCSL1 -01938 ******************************************************************DTSCSL1 -01939 S1500-SIC-CD. DTSCSL1 -01940 IF MAP-SIC-CD = LOW-VALUES OR SPACES DTSCSL1 -01941 SET MAP-SIC-CD-NONCLASSIF-88 TO TRUE. DTSCSL1 -01942 DTSCSL1 -01943 MOVE MAP-SIC-CD TO L039-SIC-CD. DTSCSL1 -01944 DTSCSL1 -01945 PERFORM S039-SIC-CD-DSCR THRU S039-EXIT. DTSCSL1 -01946 DTSCSL1 -01947 IF L039-SIC-NOT-VALID DTSCSL1 -01948 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -01949 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCSL1 -01950 S1500-EXIT. DTSCSL1 -01951 EXIT. DTSCSL1 -01952 DTSCSL1 -01953 DTSCSL1 -01954 DTSCSL1 -01955 S1501-ERROR. DTSCSL1 -01956 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SIC-CD-A. DTSCSL1 -01957 IF LCCM-NO-MSG DTSCSL1 -01958 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01959 MOVE CATB-CURSOR TO MAP-SIC-CD-L DTSCSL1 -01960 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -01961 S1501-EXIT. DTSCSL1 -01962 EXIT. DTSCSL1 -01963 /*****************************************************************DTSCSL1 -01964 * DTSCSL1 -01965 ******************************************************************DTSCSL1 -01966 S1600-NAICS-CD. DTSCSL1 -01967 IF MAP-NAICS-CD = LOW-VALUES OR SPACES DTSCSL1 -01968 SET MAP-NAICS-CD-NONCLASSIF-88 TO TRUE. DTSCSL1 -01969 DTSCSL1 -01970 MOVE MAP-NAICS-CD TO L040-NAICS-CD. DTSCSL1 -01971 DTSCSL1 -01972 PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT. DTSCSL1 -01973 DTSCSL1 -01974 IF L040-NAICS-NOT-VALID DTSCSL1 -01975 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -01976 PERFORM S1601-ERROR THRU S1601-EXIT DTSCSL1 -01977 GO TO S1600-EXIT. DTSCSL1 -01978 S1600-EXIT. DTSCSL1 -01979 EXIT. DTSCSL1 -01980 DTSCSL1 -01981 DTSCSL1 -01982 DTSCSL1 -01983 S1601-ERROR. DTSCSL1 -01984 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NAICS-CD-A. DTSCSL1 +01911 MOVE L013-CNT TO MAP-3RD-MTH-EMPL-CNT-N. DTSCSL1 +01912 S1400-EXIT. EXIT. DTSCSL1 +01913 DTSCSL1 +01914 S1401-ERROR. DTSCSL1 +01915 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-3RD-MTH-EMPL-CNT-A DTSCSL1 +01916 IF LCCM-NO-MSG DTSCSL1 +01917 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +01918 MOVE CATB-CURSOR TO MAP-3RD-MTH-EMPL-CNT-L DTSCSL1 +01919 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +01920 S1401-EXIT. EXIT. DTSCSL1 +01921 /*****************************************************************DTSCSL1 +01922 * DTSCSL1 +01923 ******************************************************************DTSCSL1 +01924 S1500-SIC-CD. CL**5 +01925 IF MAP-SIC-CD = LOW-VALUES OR SPACES CL*18 +01926 SET MAP-SIC-CD-NONCLASSIF-88 TO TRUE. CL*18 +01927 CL*18 +01928 MOVE MAP-SIC-CD TO L039-SIC-CD. CL*18 +01929 CL*18 +01930 PERFORM S039-SIC-CD-DSCR THRU S039-EXIT. CL*18 +01931 CL*18 +01932 IF L039-SIC-NOT-VALID DTSCSL1 +01933 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +01934 PERFORM S1501-ERROR THRU S1501-EXIT. CL**5 +01935 S1500-EXIT. CL*18 +01936 EXIT. CL*18 +01937 CL*18 +01938 CL*18 +01939 CL*18 +01940 S1501-ERROR. CL**5 +01941 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SIC-CD-A. DTSCSL1 +01942 IF LCCM-NO-MSG DTSCSL1 +01943 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*18 +01944 MOVE CATB-CURSOR TO MAP-SIC-CD-L CL*18 +01945 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +01946 S1501-EXIT. CL*18 +01947 EXIT. CL*18 +01948 /***************************************************************** CL*18 +01949 * CL*18 +01950 ****************************************************************** CL*18 +01951 S1600-NAICS-CD. CL**5 +01952 IF MAP-NAICS-CD = LOW-VALUES OR SPACES CL**5 +01953 SET MAP-NAICS-CD-NONCLASSIF-88 TO TRUE. CL*18 +01954 CL*18 +01955 MOVE MAP-NAICS-CD TO L040-NAICS-CD. CL*18 +01956 CL*18 +01957 PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT. CL*18 +01958 CL*18 +01959 IF L040-NAICS-NOT-VALID CL**8 +01960 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL**5 +01961 PERFORM S1601-ERROR THRU S1601-EXIT CL*18 +01962 GO TO S1600-EXIT. CL**5 +01963 S1600-EXIT. CL*18 +01964 EXIT. CL*18 +01965 CL*18 +01966 CL*18 +01967 CL*18 +01968 S1601-ERROR. CL**5 +01969 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NAICS-CD-A. CL*18 +01970 CL*18 +01971 IF LCCM-NO-MSG CL**5 +01972 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*18 +01973 MOVE CATB-CURSOR TO MAP-NAICS-CD-L CL*18 +01974 SET CURSOR-SET-YES TO TRUE. CL**5 +01975 S1601-EXIT. CL*18 +01976 EXIT. CL*18 +01977 /*****************************************************************DTSCSL1 +01978 * DTSCSL1 +01979 ******************************************************************DTSCSL1 +01980 S1700-SIC-AUX-CD. CL*16 +01981 IF MAP-SIC-AUX-CD = LOW-VALUES OR SPACES CL*16 +01982 SET MAP-SIC-AUX-UNK-88 TO TRUE. CL*18 +01983 DTSCSL1 +01984 MOVE MAP-SIC-AUX-CD TO L038-CD-1. CL*16 01985 DTSCSL1 -01986 IF LCCM-NO-MSG DTSCSL1 -01987 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -01988 MOVE CATB-CURSOR TO MAP-NAICS-CD-L DTSCSL1 -01989 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -01990 S1601-EXIT. DTSCSL1 -01991 EXIT. DTSCSL1 -01992 /*****************************************************************DTSCSL1 -01993 * DTSCSL1 -01994 ******************************************************************DTSCSL1 -01995 S1700-SIC-AUX-CD. DTSCSL1 -01996 IF MAP-SIC-AUX-CD = LOW-VALUES OR SPACES DTSCSL1 -01997 SET MAP-SIC-AUX-UNK-88 TO TRUE. DTSCSL1 -01998 DTSCSL1 -01999 MOVE MAP-SIC-AUX-CD TO L038-CD-1. DTSCSL1 -02000 DTSCSL1 -02001 PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT. DTSCSL1 -02002 DTSCSL1 -02003 IF L038-NOT-VALID DTSCSL1 -02004 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -02005 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCSL1 -02006 S1700-EXIT. DTSCSL1 -02007 EXIT. DTSCSL1 -02008 DTSCSL1 -02009 DTSCSL1 -02010 DTSCSL1 -02011 S1701-ERROR. DTSCSL1 -02012 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SIC-AUX-CD-A. DTSCSL1 -02013 DTSCSL1 -02014 IF LCCM-NO-MSG DTSCSL1 -02015 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -02016 MOVE CATB-CURSOR TO MAP-SIC-AUX-CD-L DTSCSL1 -02017 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -02018 S1701-EXIT. DTSCSL1 -02019 EXIT. DTSCSL1 -02020 /*****************************************************************DTSCSL1 -02021 * DTSCSL1 -02022 ******************************************************************DTSCSL1 -02023 S1800-OWN-CD. DTSCSL1 -02024 IF MAP-OWN-CD = LOW-VALUES OR SPACES DTSCSL1 -02025 SET MAP-OWN-CD-NONCLASSIF-88 TO TRUE. DTSCSL1 -02026 DTSCSL1 -02027 MOVE MAP-OWN-CD TO L038-CD-2. DTSCSL1 -02028 DTSCSL1 -02029 PERFORM S038-MPRF-OWN-CD THRU S038-EXIT. DTSCSL1 -02030 DTSCSL1 -02031 IF L038-NOT-VALID DTSCSL1 -02032 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -02033 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCSL1 -02034 S1800-EXIT. DTSCSL1 -02035 EXIT. DTSCSL1 -02036 DTSCSL1 -02037 DTSCSL1 -02038 DTSCSL1 -02039 S1801-ERROR. DTSCSL1 -02040 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-OWN-CD-A. DTSCSL1 +01986 PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT. CL*16 +01987 CL*18 +01988 IF L038-NOT-VALID DTSCSL1 +01989 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +01990 PERFORM S1701-ERROR THRU S1701-EXIT. CL*18 +01991 S1700-EXIT. CL*18 +01992 EXIT. CL*18 +01993 CL*18 +01994 CL*18 +01995 CL*18 +01996 S1701-ERROR. DTSCSL1 +01997 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SIC-AUX-CD-A. CL*18 +01998 CL*18 +01999 IF LCCM-NO-MSG DTSCSL1 +02000 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*18 +02001 MOVE CATB-CURSOR TO MAP-SIC-AUX-CD-L CL*18 +02002 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +02003 S1701-EXIT. CL*18 +02004 EXIT. CL*18 +02005 /***************************************************************** CL**5 +02006 * CL**5 +02007 ****************************************************************** CL**5 +02008 S1800-OWN-CD. CL**5 +02009 IF MAP-OWN-CD = LOW-VALUES OR SPACES CL*19 +02010 SET MAP-OWN-CD-NONCLASSIF-88 TO TRUE. CL*19 +02011 CL*19 +02012 MOVE MAP-OWN-CD TO L038-CD-2. CL*19 +02013 CL*19 +02014 PERFORM S038-MPRF-OWN-CD THRU S038-EXIT. CL*19 +02015 CL*19 +02016 IF L038-NOT-VALID CL**7 +02017 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL**5 +02018 PERFORM S1801-ERROR THRU S1801-EXIT. CL**5 +02019 S1800-EXIT. CL*19 +02020 EXIT. CL*19 +02021 CL*19 +02022 CL*19 +02023 CL*19 +02024 S1801-ERROR. CL**5 +02025 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-OWN-CD-A. CL**5 +02026 CL*19 +02027 IF LCCM-NO-MSG CL**5 +02028 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*19 +02029 MOVE CATB-CURSOR TO MAP-OWN-CD-L CL*19 +02030 SET CURSOR-SET-YES TO TRUE. CL**5 +02031 S1801-EXIT. CL*19 +02032 EXIT. CL*19 +02033 /*****************************************************************DTSCSL1 +02034 * DTSCSL1 +02035 ******************************************************************DTSCSL1 +02036 S1900-MULTI-IND. CL**5 +02037 IF MAP-MULTI-IND = LOW-VALUES OR SPACES DTSCSL1 +02038 MOVE 'N' TO MAP-MULTI-IND. CL*20 +02039 DTSCSL1 +02040 MOVE MAP-MULTI-IND TO L038-CD-1 CL*11 02041 DTSCSL1 -02042 IF LCCM-NO-MSG DTSCSL1 -02043 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -02044 MOVE CATB-CURSOR TO MAP-OWN-CD-L DTSCSL1 -02045 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -02046 S1801-EXIT. DTSCSL1 -02047 EXIT. DTSCSL1 -02048 /*****************************************************************DTSCSL1 -02049 * DTSCSL1 -02050 ******************************************************************DTSCSL1 -02051 S1900-MULTI-IND. DTSCSL1 -02052 IF MAP-MULTI-IND = LOW-VALUES OR SPACES DTSCSL1 -02053 MOVE 'N' TO MAP-MULTI-IND. DTSCSL1 -02054 DTSCSL1 -02055 MOVE MAP-MULTI-IND TO L038-CD-1 DTSCSL1 -02056 DTSCSL1 -02057 PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT. DTSCSL1 -02058 DTSCSL1 -02059 IF L038-NOT-VALID DTSCSL1 -02060 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -02061 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCSL1 -02062 S1900-EXIT. DTSCSL1 -02063 EXIT. DTSCSL1 -02064 DTSCSL1 -02065 DTSCSL1 -02066 DTSCSL1 -02067 S1901-ERROR. DTSCSL1 -02068 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MULTI-IND-A. DTSCSL1 -02069 DTSCSL1 -02070 IF LCCM-NO-MSG DTSCSL1 -02071 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -02072 MOVE CATB-CURSOR TO MAP-MULTI-IND-L DTSCSL1 -02073 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -02074 S1901-EXIT. DTSCSL1 -02075 EXIT. DTSCSL1 -02076 /*****************************************************************DTSCSL1 -02077 * DTSCSL1 -02078 ******************************************************************DTSCSL1 -02079 S2000-WARD-CD. DTSCSL1 -02080 IF MAP-WARD-CD = LOW-VALUES OR SPACES DTSCSL1 -02081 SET MAP-WARD-UNKOWN-88 TO TRUE. DTSCSL1 -02082 DTSCSL1 -02083 MOVE MAP-WARD-CD TO L038-CD-2. DTSCSL1 -02084 DTSCSL1 -02085 PERFORM S038-MPRF-WARD-CD THRU S038-EXIT. DTSCSL1 -02086 DTSCSL1 -02087 IF L038-NOT-VALID DTSCSL1 -02088 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -02089 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCSL1 -02090 S2000-EXIT. DTSCSL1 -02091 EXIT. DTSCSL1 -02092 DTSCSL1 -02093 DTSCSL1 -02094 DTSCSL1 -02095 S2001-ERROR. DTSCSL1 -02096 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-WARD-CD-A. DTSCSL1 -02097 DTSCSL1 -02098 IF LCCM-NO-MSG DTSCSL1 -02099 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -02100 MOVE CATB-CURSOR TO MAP-WARD-CD-L DTSCSL1 -02101 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -02102 S2001-EXIT. DTSCSL1 -02103 EXIT. DTSCSL1 -02104 /*****************************************************************DTSCSL1 -02105 * DTSCSL1 -02106 ******************************************************************DTSCSL1 -02107 S2200-ALT-NAICS-CD. DTSCSL1 -02108 IF MAP-ALT-NAICS-CD = LOW-VALUES OR SPACES DTSCSL1 -02109 SET MAP-ALT-NAICS-CD-NONCLASSIF-88 TO TRUE. DTSCSL1 -02110 DTSCSL1 -02111 MOVE MAP-ALT-NAICS-CD TO L040-NAICS-CD. DTSCSL1 -02112 DTSCSL1 -02113 PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT. DTSCSL1 -02114 DTSCSL1 -02115 IF L040-NAICS-NOT-VALID DTSCSL1 -02116 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -02117 PERFORM S2201-ERROR THRU S2201-EXIT DTSCSL1 -02118 GO TO S2200-EXIT. DTSCSL1 -02119 S2200-EXIT. DTSCSL1 -02120 EXIT. DTSCSL1 -02121 DTSCSL1 +02042 PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT. DTSCSL1 +02043 CL*20 +02044 IF L038-NOT-VALID DTSCSL1 +02045 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +02046 PERFORM S1901-ERROR THRU S1901-EXIT. CL*20 +02047 S1900-EXIT. CL*20 +02048 EXIT. CL*20 +02049 CL*20 +02050 CL*20 +02051 CL*20 +02052 S1901-ERROR. CL**5 +02053 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MULTI-IND-A. CL*20 +02054 CL*20 +02055 IF LCCM-NO-MSG DTSCSL1 +02056 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*20 +02057 MOVE CATB-CURSOR TO MAP-MULTI-IND-L CL*20 +02058 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +02059 S1901-EXIT. CL*20 +02060 EXIT. CL*20 +02061 /***************************************************************** CL**5 +02062 * CL**5 +02063 ****************************************************************** CL**5 +02064 S2000-WARD-CD. CL**5 +02065 IF MAP-WARD-CD = LOW-VALUES OR SPACES CL**5 +02066 SET MAP-WARD-UNKOWN-88 TO TRUE. CL*20 +02067 CL*20 +02068 MOVE MAP-WARD-CD TO L038-CD-2. CL*20 +02069 CL*20 +02070 PERFORM S038-MPRF-WARD-CD THRU S038-EXIT. CL*20 +02071 CL*20 +02072 IF L038-NOT-VALID CL**5 +02073 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL**5 +02074 PERFORM S2001-ERROR THRU S2001-EXIT. CL*20 +02075 S2000-EXIT. CL*19 +02076 EXIT. CL*19 +02077 CL*19 +02078 CL*19 +02079 CL*19 +02080 S2001-ERROR. CL**5 +02081 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-WARD-CD-A. CL*20 +02082 CL*20 +02083 IF LCCM-NO-MSG CL**5 +02084 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*20 +02085 MOVE CATB-CURSOR TO MAP-WARD-CD-L CL*20 +02086 SET CURSOR-SET-YES TO TRUE. CL**5 +02087 S2001-EXIT. CL*20 +02088 EXIT. CL*20 +02089 /*****************************************************************DTSCSL1 +02090 * 'EMPTY' IS LEGITIMATE. DTSCSL1 +02091 ******************************************************************DTSCSL1 +02092 S2101-YRQ. DTSCSL1 +02093 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. CL*14 +02094 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. CL*14 +02095 IF L029-NO-ENTRY CL*14 +02096 MOVE +0 TO WRK-YRQ DTSCSL1 +02097 ELSE DTSCSL1 +02098 IF L029-VALID CL*14 +02099 MOVE L029-YRQ TO WRK-YRQ CL*14 +02100 ELSE DTSCSL1 +02101 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 +02102 PERFORM S2199-ERROR THRU S2199-EXIT. DTSCSL1 +02103 S2101-EXIT. EXIT. DTSCSL1 +02104 DTSCSL1 +02105 S2199-ERROR. DTSCSL1 +02106 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A CL*14 +02107 MAP-YRQ-Q-A. CL*14 +02108 IF LCCM-NO-MSG DTSCSL1 +02109 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 +02110 MOVE CATB-CURSOR TO MAP-YRQ-YR-L DTSCSL1 +02111 SET CURSOR-SET-YES TO TRUE. DTSCSL1 +02112 S2199-EXIT. EXIT. DTSCSL1 +02113 EJECT DTSCSL1 +02114 /*****************************************************************DTSCSL1 +02115 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCSL1 +02116 ******************************************************************DTSCSL1 +02117 S5100-SET-LOCK-ATTRB. DTSCSL1 +02118 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCSL1 +02119 WRK-ATB-NUM. DTSCSL1 +02120 DTSCSL1 +02121 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL1 02122 DTSCSL1 -02123 DTSCSL1 -02124 S2201-ERROR. DTSCSL1 -02125 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ALT-NAICS-CD-A. DTSCSL1 -02126 DTSCSL1 -02127 IF LCCM-NO-MSG DTSCSL1 -02128 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -02129 MOVE CATB-CURSOR TO MAP-ALT-NAICS-CD-L DTSCSL1 -02130 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -02131 S2201-EXIT. DTSCSL1 -02132 EXIT. DTSCSL1 -02133 /*****************************************************************DTSCSL1 -02134 * 'EMPTY' IS LEGITIMATE. DTSCSL1 -02135 ******************************************************************DTSCSL1 -02136 S2101-YRQ. DTSCSL1 -02137 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA. DTSCSL1 -02138 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCSL1 -02139 IF L029-NO-ENTRY DTSCSL1 -02140 MOVE +0 TO WRK-YRQ DTSCSL1 -02141 ELSE DTSCSL1 -02142 IF L029-VALID DTSCSL1 -02143 MOVE L029-YRQ TO WRK-YRQ DTSCSL1 -02144 ELSE DTSCSL1 -02145 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL1 -02146 PERFORM S2199-ERROR THRU S2199-EXIT. DTSCSL1 -02147 S2101-EXIT. EXIT. DTSCSL1 -02148 DTSCSL1 -02149 S2199-ERROR. DTSCSL1 -02150 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A DTSCSL1 -02151 MAP-YRQ-Q-A. DTSCSL1 -02152 IF LCCM-NO-MSG DTSCSL1 -02153 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL1 -02154 MOVE CATB-CURSOR TO MAP-YRQ-YR-L DTSCSL1 -02155 SET CURSOR-SET-YES TO TRUE. DTSCSL1 -02156 S2199-EXIT. EXIT. DTSCSL1 -02157 EJECT DTSCSL1 -02158 /*****************************************************************DTSCSL1 -02159 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCSL1 -02160 ******************************************************************DTSCSL1 -02161 S5100-SET-LOCK-ATTRB. DTSCSL1 -02162 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCSL1 -02163 WRK-ATB-NUM. DTSCSL1 -02164 DTSCSL1 -02165 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL1 -02166 DTSCSL1 -02167 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCSL1 -02168 MAP-EMP-NO-2-A DTSCSL1 -02169 MAP-YRQ-YR-A DTSCSL1 -02170 MAP-YRQ-Q-A DTSCSL1 -02171 MAP-GOTO-A. DTSCSL1 -02172 S5100-EXIT. DTSCSL1 -02173 EXIT. DTSCSL1 -02174 DTSCSL1 -02175 ******************************************************************DTSCSL1 -02176 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCSL1 -02177 ******************************************************************DTSCSL1 -02178 S5200-SET-UPDATE-ATTRB. DTSCSL1 -02179 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCSL1 -02180 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCSL1 +02123 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCSL1 +02124 MAP-EMP-NO-2-A DTSCSL1 +02125 MAP-YRQ-YR-A DTSCSL1 +02126 MAP-YRQ-Q-A DTSCSL1 +02127 MAP-GOTO-A. DTSCSL1 +02128 S5100-EXIT. DTSCSL1 +02129 EXIT. DTSCSL1 +02130 DTSCSL1 +02131 ******************************************************************DTSCSL1 +02132 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCSL1 +02133 ******************************************************************DTSCSL1 +02134 S5200-SET-UPDATE-ATTRB. DTSCSL1 +02135 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCSL1 +02136 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCSL1 +02137 DTSCSL1 +02138 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL1 +02139 DTSCSL1 +02140 IF (SCR-HOLD-YRQ NOT NUMERIC) DTSCSL1 +02141 OR DTSCSL1 +02142 (SCR-HOLD-YRQ = +0) DTSCSL1 +02143 OR CL*14 +02144 (SCR-HOLD-YRQ = LCCM-PICKUP-YRQ) CL*14 +02145 MOVE CATB-ASKIP-BRT-MDTON TO CL*14 +02146 MAP-1ST-MTH-EMPL-CNT-A DTSCSL1 +02147 MAP-2ND-MTH-EMPL-CNT-A DTSCSL1 +02148 MAP-3RD-MTH-EMPL-CNT-A DTSCSL1 +02149 END-IF. DTSCSL1 +02150 S5200-EXIT. DTSCSL1 +02151 EXIT. DTSCSL1 +02152 DTSCSL1 +02153 ******************************************************************DTSCSL1 +02154 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCSL1 +02155 ******************************************************************DTSCSL1 +02156 S5300-SET-INQ-ATTRB. DTSCSL1 +02157 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCSL1 +02158 WRK-ATB-NUM. DTSCSL1 +02159 DTSCSL1 +02160 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL1 +02161 S5300-EXIT. DTSCSL1 +02162 EXIT. DTSCSL1 +02163 DTSCSL1 +02164 S5900-SET-ATTRB. DTSCSL1 +02165 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCSL1 +02166 MAP-EMP-NO-2-A. CL*14 +02167 CL*14 +02168 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A CL*14 +02169 MAP-YRQ-Q-A. CL*14 +02170 DTSCSL1 +02171 MOVE WRK-ATB-AN TO MAP-MULTI-IND-A DTSCSL1 +02172 MAP-SIC-AUX-CD-A CL*16 +02173 MAP-SIC-CD-A DTSCSL1 +02174 MAP-NAICS-CD-A CL**4 +02175 MAP-WARD-CD-A CL**4 +02176 MAP-OWN-CD-A. DTSCSL1 +02177 DTSCSL1 +02178 MOVE WRK-ATB-NUM TO MAP-1ST-MTH-EMPL-CNT-A DTSCSL1 +02179 MAP-2ND-MTH-EMPL-CNT-A DTSCSL1 +02180 MAP-3RD-MTH-EMPL-CNT-A. CL**4 02181 DTSCSL1 -02182 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL1 -02183 DTSCSL1 -02184 IF (SCR-HOLD-YRQ NOT NUMERIC) DTSCSL1 -02185 OR DTSCSL1 -02186 (SCR-HOLD-YRQ = +0) DTSCSL1 -02187 OR DTSCSL1 -02188 (SCR-HOLD-YRQ = LCCM-PICKUP-YRQ) DTSCSL1 -02189 MOVE CATB-ASKIP-BRT-MDTON TO DTSCSL1 -02190 MAP-1ST-MTH-EMPL-CNT-A DTSCSL1 -02191 MAP-2ND-MTH-EMPL-CNT-A DTSCSL1 -02192 MAP-3RD-MTH-EMPL-CNT-A DTSCSL1 -02193 END-IF. DTSCSL1 -02194 S5200-EXIT. DTSCSL1 -02195 EXIT. DTSCSL1 +02182 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A CL**4 +02183 MAP-CURR-PAGE-A DTSCSL1 +02184 MAP-LAST-PAGE-A DTSCSL1 +02185 MAP-TOT-WAGE-A DTSCSL1 +02186 MAP-TAX-WAGE-A DTSCSL1 +02187 MAP-WAGE-CHNG-DATE-A DTSCSL1 +02188 MAP-CURR-RPT-TYPE-DSCR-A DTSCSL1 +02189 MAP-EMPL-CNT-CHNG-DATE-A DTSCSL1 +02190 MAP-OLD-NAICS-CD-A CL**4 +02191 MAP-OLD-SIC-CD-A DTSCSL1 +02192 MAP-SIC-CD-CHNG-DATE-A CL**8 +02193 MAP-OLD-OWN-CD-A DTSCSL1 +02194 MAP-OWN-CHNG-DATE-A DTSCSL1 +02195 MAP-NAICS-CHNG-DATE-A. CL**9 02196 DTSCSL1 -02197 ******************************************************************DTSCSL1 -02198 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCSL1 -02199 ******************************************************************DTSCSL1 -02200 S5300-SET-INQ-ATTRB. DTSCSL1 -02201 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCSL1 -02202 WRK-ATB-NUM. DTSCSL1 -02203 DTSCSL1 -02204 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL1 -02205 S5300-EXIT. DTSCSL1 -02206 EXIT. DTSCSL1 -02207 DTSCSL1 -02208 S5900-SET-ATTRB. DTSCSL1 -02209 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCSL1 -02210 MAP-EMP-NO-2-A. DTSCSL1 +02197 MOVE CATB-ASKIP-NORM-MDTON TO MAP-NAICS-CD-DSCR-A CL**4 +02198 MAP-SIC-CD-DSCR-A DTSCSL1 +02199 MAP-OWN-CD-DSCR-A DTSCSL1 +02200 MAP-SIC-AUX-CD-DSCR-A CL*16 +02201 MAP-MULTI-IND-DSCR-A. DTSCSL1 +02202 DTSCSL1 +02203 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCSL1 +02204 S5900-EXIT. DTSCSL1 +02205 EXIT. DTSCSL1 +02206 /*****************************************************************DTSCSL1 +02207 * MAP ROUTINES *DTSCSL1 +02208 ******************************************************************DTSCSL1 +02209 S9100-RECEIVE. DTSCSL1 +02210 SET L851-RECEIVE-88 TO TRUE. DTSCSL1 02211 DTSCSL1 -02212 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A DTSCSL1 -02213 MAP-YRQ-Q-A. DTSCSL1 -02214 DTSCSL1 -02215 MOVE WRK-ATB-AN TO MAP-MULTI-IND-A DTSCSL1 -02216 MAP-SIC-AUX-CD-A DTSCSL1 -02217 MAP-SIC-CD-A DTSCSL1 -02218 MAP-NAICS-CD-A DTSCSL1 -02219 MAP-ALT-NAICS-CD-A DTSCSL1 -02220 MAP-WARD-CD-A DTSCSL1 -02221 MAP-OWN-CD-A. DTSCSL1 -02222 DTSCSL1 -02223 MOVE WRK-ATB-NUM TO MAP-1ST-MTH-EMPL-CNT-A DTSCSL1 -02224 MAP-2ND-MTH-EMPL-CNT-A DTSCSL1 -02225 MAP-3RD-MTH-EMPL-CNT-A. DTSCSL1 -02226 DTSCSL1 -02227 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCSL1 -02228 MAP-CURR-PAGE-A DTSCSL1 -02229 MAP-LAST-PAGE-A DTSCSL1 -02230 MAP-TOT-WAGE-A DTSCSL1 -02231 MAP-TAX-WAGE-A DTSCSL1 -02232 MAP-WAGE-CHNG-DATE-A DTSCSL1 -02233 MAP-CURR-RPT-TYPE-DSCR-A DTSCSL1 -02234 MAP-EMPL-CNT-CHNG-DATE-A DTSCSL1 -02235 MAP-OLD-NAICS-CD-A DTSCSL1 -02236 MAP-OLD-SIC-CD-A DTSCSL1 -02237 MAP-SIC-CD-CHNG-DATE-A DTSCSL1 -02238 MAP-OLD-OWN-CD-A DTSCSL1 -02239 MAP-OWN-CHNG-DATE-A DTSCSL1 -02240 MAP-NAICS-CHNG-DATE-A. DTSCSL1 +02212 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCSL1 +02213 DTSCSL1 +02214 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL1 +02215 DTSCSL1 +02216 MOVE L851-AID TO LCCM-AID. DTSCSL1 +02217 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCSL1 +02218 S9100-EXIT. DTSCSL1 +02219 EXIT. DTSCSL1 +02220 DTSCSL1 +02221 S9200-SEND-DATAONLY. DTSCSL1 +02222 MOVE LOW-VALUES TO MAP-AREA. DTSCSL1 +02223 DTSCSL1 +02224 IF LCCM-NO-MSG DTSCSL1 +02225 NEXT SENTENCE DTSCSL1 +02226 ELSE DTSCSL1 +02227 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL1 +02228 DTSCSL1 +02229 IF CURSOR-SET-GOTO DTSCSL1 +02230 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCSL1 +02231 ELSE DTSCSL1 +02232 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCSL1 +02233 DTSCSL1 +02234 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCSL1 +02235 DTSCSL1 +02236 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL1 +02237 DTSCSL1 +02238 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL1 +02239 S9200-EXIT. DTSCSL1 +02240 EXIT. DTSCSL1 02241 DTSCSL1 -02242 MOVE CATB-ASKIP-NORM-MDTON TO MAP-NAICS-CD-DSCR-A DTSCSL1 -02243 MAP-SIC-CD-DSCR-A DTSCSL1 -02244 MAP-OWN-CD-DSCR-A DTSCSL1 -02245 MAP-SIC-AUX-CD-DSCR-A DTSCSL1 -02246 MAP-MULTI-IND-DSCR-A. DTSCSL1 +02242 S9300-SEND-MAP. DTSCSL1 +02243 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCSL1 +02244 MOVE SPACES TO MAP-SYS-TIME. DTSCSL1 +02245 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCSL1 +02246 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCSL1 02247 DTSCSL1 -02248 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCSL1 -02249 S5900-EXIT. DTSCSL1 -02250 EXIT. DTSCSL1 -02251 /*****************************************************************DTSCSL1 -02252 * MAP ROUTINES *DTSCSL1 -02253 ******************************************************************DTSCSL1 -02254 S9100-RECEIVE. DTSCSL1 -02255 SET L851-RECEIVE-88 TO TRUE. DTSCSL1 +02248 IF SCR-ACCESS-UPDATE DTSCSL1 +02249 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCSL1 +02250 ELSE DTSCSL1 +02251 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL1 +02252 DTSCSL1 +02253 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCSL1 +02254 DTSCSL1 +02255 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL1 02256 DTSCSL1 -02257 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCSL1 -02258 DTSCSL1 -02259 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL1 -02260 DTSCSL1 -02261 MOVE L851-AID TO LCCM-AID. DTSCSL1 -02262 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCSL1 -02263 S9100-EXIT. DTSCSL1 -02264 EXIT. DTSCSL1 -02265 DTSCSL1 -02266 S9200-SEND-DATAONLY. DTSCSL1 -02267 MOVE LOW-VALUES TO MAP-AREA. DTSCSL1 -02268 DTSCSL1 -02269 IF LCCM-NO-MSG DTSCSL1 -02270 NEXT SENTENCE DTSCSL1 -02271 ELSE DTSCSL1 -02272 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL1 -02273 DTSCSL1 -02274 IF CURSOR-SET-GOTO DTSCSL1 -02275 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCSL1 -02276 ELSE DTSCSL1 -02277 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCSL1 -02278 DTSCSL1 -02279 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCSL1 -02280 DTSCSL1 -02281 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL1 -02282 DTSCSL1 -02283 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL1 -02284 S9200-EXIT. DTSCSL1 -02285 EXIT. DTSCSL1 -02286 DTSCSL1 -02287 S9300-SEND-MAP. DTSCSL1 -02288 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCSL1 -02289 MOVE SPACES TO MAP-SYS-TIME. DTSCSL1 -02290 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCSL1 -02291 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCSL1 -02292 DTSCSL1 -02293 IF SCR-ACCESS-UPDATE DTSCSL1 -02294 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCSL1 -02295 ELSE DTSCSL1 -02296 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL1 +02257 IF CURSOR-SET-NO DTSCSL1 +02258 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCSL1 +02259 DTSCSL1 +02260 SET L851-SEND-88 TO TRUE. DTSCSL1 +02261 DTSCSL1 +02262 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL1 +02263 DTSCSL1 +02264 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL1 +02265 S9300-EXIT. DTSCSL1 +02266 EXIT. DTSCSL1 +02267 DTSCSL1 +02268 S9310-UPDATE-FKEYS. DTSCSL1 +02269 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL1 +02270 DTSCSL1 +02271 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCSL1 +02272 DTSCSL1 +02273 IF LCCM-SCR-CLEAR DTSCSL1 +02274 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCSL1 +02275 ELSE DTSCSL1 +02276 IF LCCM-SCR-INQUIRE DTSCSL1 +02277 NEXT SENTENCE DTSCSL1 +02278 ELSE DTSCSL1 +02279 IF LCCM-SCR-UPDATE-LOCKED DTSCSL1 +02280 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCSL1 +02281 MAP-KEY-LAST DTSCSL1 +02282 MAP-KEY-BACK DTSCSL1 +02283 MAP-KEY-FWRD DTSCSL1 +02284 MAP-KEY-MOD DTSCSL1 +02285 ELSE DTSCSL1 +02286 NEXT SENTENCE. DTSCSL1 +02287 S9310-EXIT. DTSCSL1 +02288 EXIT. DTSCSL1 +02289 DTSCSL1 +02290 S9320-INQUIRY-FKEYS. DTSCSL1 +02291 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCSL1 +02292 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCSL1 +02293 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCSL1 +02294 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCSL1 +02295 DTSCSL1 +02296 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCSL1 02297 DTSCSL1 -02298 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCSL1 -02299 DTSCSL1 -02300 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL1 +02298 PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCSL1 +02299 S9320-EXIT. DTSCSL1 +02300 EXIT. DTSCSL1 02301 DTSCSL1 -02302 IF CURSOR-SET-NO DTSCSL1 -02303 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCSL1 -02304 DTSCSL1 -02305 SET L851-SEND-88 TO TRUE. DTSCSL1 -02306 DTSCSL1 -02307 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL1 -02308 DTSCSL1 -02309 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL1 -02310 S9300-EXIT. DTSCSL1 -02311 EXIT. DTSCSL1 -02312 DTSCSL1 -02313 S9310-UPDATE-FKEYS. DTSCSL1 -02314 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL1 -02315 DTSCSL1 -02316 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCSL1 -02317 DTSCSL1 -02318 IF LCCM-SCR-CLEAR DTSCSL1 -02319 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCSL1 -02320 ELSE DTSCSL1 -02321 IF LCCM-SCR-INQUIRE DTSCSL1 -02322 NEXT SENTENCE DTSCSL1 -02323 ELSE DTSCSL1 -02324 IF LCCM-SCR-UPDATE-LOCKED DTSCSL1 -02325 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCSL1 -02326 MAP-KEY-LAST DTSCSL1 -02327 MAP-KEY-BACK DTSCSL1 -02328 MAP-KEY-FWRD DTSCSL1 -02329 MAP-KEY-MOD DTSCSL1 -02330 ELSE DTSCSL1 -02331 NEXT SENTENCE. DTSCSL1 -02332 S9310-EXIT. DTSCSL1 -02333 EXIT. DTSCSL1 -02334 DTSCSL1 -02335 S9320-INQUIRY-FKEYS. DTSCSL1 -02336 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCSL1 -02337 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCSL1 -02338 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCSL1 -02339 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCSL1 -02340 DTSCSL1 -02341 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCSL1 -02342 DTSCSL1 -02343 PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCSL1 -02344 S9320-EXIT. DTSCSL1 -02345 EXIT. DTSCSL1 +02302 S9321-JUMP-KEYS. DTSCSL1 +02303 S9321-EXIT. DTSCSL1 +02304 EXIT. DTSCSL1 +02305 DTSCSL1 +02306 S9330-DSCR-FIELDS. DTSCSL1 +02307 IF WRK-MPRF-YES-88 DTSCSL1 +02308 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. CL**4 +02309 DTSCSL1 +02310 IF MAP-OWN-CD = SPACES OR LOW-VALUES CL**4 +02311 MOVE LOW-VALUES TO MAP-OWN-CD-DSCR CL**4 +02312 ELSE DTSCSL1 +02313 MOVE MAP-OWN-CD TO L038-CD-2 CL*11 +02314 PERFORM S038-MPRF-OWN-CD THRU S038-EXIT CL**4 +02315 MOVE L038-SHORT-DSCR TO MAP-OWN-CD-DSCR. CL**8 +02316 DTSCSL1 +02317 IF MAP-SIC-CD = SPACES OR LOW-VALUES CL**4 +02318 MOVE LOW-VALUES TO MAP-SIC-CD-DSCR DTSCSL1 +02319 ELSE DTSCSL1 +02320 MOVE MAP-SIC-CD TO L039-SIC-CD DTSCSL1 +02321 PERFORM S039-SIC-CD-DSCR THRU S039-EXIT CL**6 +02322 MOVE L039-SIC-LONG-DSCR TO MAP-SIC-CD-DSCR. CL**4 +02323 DTSCSL1 +02324 IF MAP-SIC-AUX-CD = SPACES OR LOW-VALUES CL*16 +02325 MOVE LOW-VALUES TO MAP-SIC-AUX-CD-DSCR CL*16 +02326 ELSE DTSCSL1 +02327 MOVE MAP-SIC-AUX-CD TO L038-CD-1 CL*16 +02328 PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT CL*16 +02329 MOVE L038-SHORT-DSCR TO MAP-SIC-AUX-CD-DSCR. CL*16 +02330 DTSCSL1 +02331 IF MAP-MULTI-IND = SPACES OR LOW-VALUES DTSCSL1 +02332 MOVE LOW-VALUES TO MAP-MULTI-IND-DSCR DTSCSL1 +02333 ELSE DTSCSL1 +02334 MOVE MAP-MULTI-IND TO L038-CD-1 CL*11 +02335 PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT DTSCSL1 +02336 MOVE L038-SHORT-DSCR TO MAP-MULTI-IND-DSCR. DTSCSL1 +02337 DTSCSL1 +02338 IF MAP-NAICS-CD = SPACES OR LOW-VALUES CL**4 +02339 MOVE LOW-VALUES TO MAP-NAICS-CD-DSCR CL**4 +02340 ELSE CL**4 +02341 MOVE MAP-NAICS-CD TO L040-NAICS-CD CL**4 +02342 PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT CL**6 +02343 MOVE L040-NAICS-LONG-DSCR TO MAP-NAICS-CD-DSCR. CL**4 +02344 CL**4 +02345 S9330-EXIT. EXIT. DTSCSL1 02346 DTSCSL1 -02347 S9321-JUMP-KEYS. DTSCSL1 -02348 S9321-EXIT. DTSCSL1 -02349 EXIT. DTSCSL1 -02350 DTSCSL1 -02351 S9330-DSCR-FIELDS. DTSCSL1 -02352 IF WRK-MPRF-YES-88 DTSCSL1 -02353 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCSL1 -02354 DTSCSL1 -02355 IF MAP-OWN-CD = SPACES OR LOW-VALUES DTSCSL1 -02356 MOVE LOW-VALUES TO MAP-OWN-CD-DSCR DTSCSL1 -02357 ELSE DTSCSL1 -02358 MOVE MAP-OWN-CD TO L038-CD-2 DTSCSL1 -02359 PERFORM S038-MPRF-OWN-CD THRU S038-EXIT DTSCSL1 -02360 MOVE L038-SHORT-DSCR TO MAP-OWN-CD-DSCR. DTSCSL1 -02361 DTSCSL1 -02362 IF MAP-SIC-CD = SPACES OR LOW-VALUES DTSCSL1 -02363 MOVE LOW-VALUES TO MAP-SIC-CD-DSCR DTSCSL1 -02364 ELSE DTSCSL1 -02365 MOVE MAP-SIC-CD TO L039-SIC-CD DTSCSL1 -02366 PERFORM S039-SIC-CD-DSCR THRU S039-EXIT DTSCSL1 -02367 MOVE L039-SIC-LONG-DSCR TO MAP-SIC-CD-DSCR. DTSCSL1 -02368 DTSCSL1 -02369 IF MAP-SIC-AUX-CD = SPACES OR LOW-VALUES DTSCSL1 -02370 MOVE LOW-VALUES TO MAP-SIC-AUX-CD-DSCR DTSCSL1 -02371 ELSE DTSCSL1 -02372 MOVE MAP-SIC-AUX-CD TO L038-CD-1 DTSCSL1 -02373 PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT DTSCSL1 -02374 MOVE L038-SHORT-DSCR TO MAP-SIC-AUX-CD-DSCR. DTSCSL1 -02375 DTSCSL1 -02376 IF MAP-MULTI-IND = SPACES OR LOW-VALUES DTSCSL1 -02377 MOVE LOW-VALUES TO MAP-MULTI-IND-DSCR DTSCSL1 -02378 ELSE DTSCSL1 -02379 MOVE MAP-MULTI-IND TO L038-CD-1 DTSCSL1 -02380 PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT DTSCSL1 -02381 MOVE L038-SHORT-DSCR TO MAP-MULTI-IND-DSCR. DTSCSL1 -02382 DTSCSL1 -02383 IF MAP-NAICS-CD = SPACES OR LOW-VALUES DTSCSL1 -02384 MOVE LOW-VALUES TO MAP-NAICS-CD-DSCR DTSCSL1 -02385 ELSE DTSCSL1 -02386 MOVE MAP-NAICS-CD TO L040-NAICS-CD DTSCSL1 -02387 PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT DTSCSL1 -02388 MOVE L040-NAICS-LONG-DSCR TO MAP-NAICS-CD-DSCR. DTSCSL1 -02389 DTSCSL1 -02390 IF MAP-ALT-NAICS-CD = SPACES OR LOW-VALUES DTSCSL1 -02391 MOVE LOW-VALUES TO MAP-ALT-NAICS-CD-DSCR DTSCSL1 -02392 ELSE DTSCSL1 -02393 MOVE MAP-ALT-NAICS-CD TO L040-NAICS-CD DTSCSL1 -02394 PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT DTSCSL1 -02395 MOVE L040-NAICS-LONG-DSCR TO MAP-ALT-NAICS-CD-DSCR. DTSCSL1 -02396 DTSCSL1 -02397 S9330-EXIT. EXIT. DTSCSL1 -02398 DTSCSL1 -02399 S9900-PREPARE-SEND. DTSCSL1 -02400 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCSL1 -02401 LCCM-SCR-ID. DTSCSL1 -02402 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCSL1 -02403 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCSL1 -02404 S9900-EXIT. DTSCSL1 -02405 EXIT. DTSCSL1 +02347 S9900-PREPARE-SEND. DTSCSL1 +02348 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCSL1 +02349 LCCM-SCR-ID. DTSCSL1 +02350 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCSL1 +02351 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCSL1 +02352 S9900-EXIT. DTSCSL1 +02353 EXIT. DTSCSL1 diff --git a/CICS/DTSCU351.cob b/CICS/DTSCU351.cob new file mode 100644 index 0000000..c2bb73e --- /dev/null +++ b/CICS/DTSCU351.cob @@ -0,0 +1,1059 @@ +00001 IDENTIFICATION DIVISION. 07/30/98 +00002 PROGRAM-ID. MACCU351. DTSCU351 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV001 +00004 DATE-WRITTEN. DECEMBER 1991. DTSCU351 +00005 DATE-COMPILED. DTSCU351 +00006 DTSCU351 +00007 ***** DTSCU351 +00008 * DTSCU351 +00009 * FUNCTION: FIELD ASSIGNMENT MEMORANDUM PRINT. DTSCU351 +00010 * DTSCU351 +00011 * DTSCU351 +00012 * MODIFICATION LOG: DTSCU351 +00013 * DTSCU351 +00014 * 12/08/91 INITIAL DEVELOPMENT. DTSCU351 +00015 * WORK ORDER: PROGRAMMER: TCL DTSCU351 +00016 * DTSCU351 +00017 * 11/07/97 MODIFICATIONS TO REFLECT TRANSFER OF UI TAX DTSCU351 +00018 * FUNCTIONS FROM DLI TO DOR. DTSCU351 +00019 * WORK ORDER: TCL 208 PROGRAMMER: EHH DTSCU351 +00020 * DTSCU351 +00021 * 03/24/92 DTSCU351 +00022 * WORK ORDER: PROGRAMMER: JME DTSCU351 +00023 * DTSCU351 +00024 * DTSCU351 +00025 * DESCRIPTION: DTSCU351 +00026 * DTSCU351 +00027 * MACCU351 IS PASSED L351-EMP-NO, L351-ASSGN-NO, DTSCU351 +00028 * L351-PRINTER-ID, L351-COPY-CNT, L351-TASK-START-DISP-DATE, DTSCU351 +00029 * AND L351-TASK-START-DISP-TIME. DTSCU351 +00030 * DTSCU351 +00031 * SEE \RAP\RPT\601R1 FOR FIELD ASSIGNMENT MEMORANDUM DESCRIPTIODTSCU351 +00032 * DESCRIPTION AND FORMAT. DTSCU351 +00033 * DTSCU351 +00034 * USE TS Q 'P' TO COMMUNICATE PRINT LINES TO MACIL357. DTSCU351 +00035 * DTSCU351 +00036 * DTSCU351 +00037 * RECORDS READ: DTSCU351 +00038 * DTSCU351 +00039 * MASTER: DTSCU351 +00040 * DTSCU351 +00041 * MPRF DTSCU351 +00042 * MFAS DTSCU351 +00043 * MTAD DTSCU351 +00044 * MOPO DTSCU351 +00045 * DTSCU351 +00046 * DTSCU351 +00047 * MODULES LINKED TO: DTSCU351 +00048 * DTSCU351 +00049 * MACCU036 FIELD SUPPORT CODES EDIT/DESCRIPTION. DTSCU351 +00050 * MACCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCU351 +00051 * MACCU063 FIELD ASSIGNMENT TYPE EDIT/DESCRIPTION. DTSCU351 +00052 * MACCU071 NAME EDIT/CONVERSION. DTSCU351 +00053 * MACCU112 FORMAT ADDRESS FOR MAILING. DTSCU351 +00054 * MACCU119 AGENCY FACTS. DTSCU351 +00055 * MACCU357 ON-LINE PRINTING. DTSCU351 +00056 * MACCU810 MASTER FILE INPUT/OUTPUT. DTSCU351 +00057 * MACCU829 TEMPORARY STORAGE INPUT/OUTPUT. DTSCU351 +00058 * DTSCU351 +00059 * DTSCU351 +00060 * VERMONT REFERENCE: DTSCU351 +00061 * DTSCU351 +00062 * TXCU351. DTSCU351 +00063 * DTSCU351 +00064 * DTSCU351 +00065 * NOTES TO JEFF: DTSCU351 +00066 * DTSCU351 +00067 * . SEE RPT601R1.* IN RPT.ZIP FOR DEFINITIONS AND LAYOUT OF DTSCU351 +00068 * THE REPORT. DTSCU351 +00069 * DTSCU351 +00070 * . DON'T GET TOO CUTE FLOATING PRINT LINES UP AND DOWN THE DTSCU351 +00071 * PAGE. JUST SO THE PRINT LOOKS REASONABLE. DTSCU351 +00072 * DTSCU351 +00073 * . YOU WON'T BE ABLE TO TEST THE MOPO RELATED LOGIC UNTIL DTSCU351 +00074 * WE GET MACCS15 WRITTEN. I WILL SEND YOU MACCS15 IN A DTSCU351 +00075 * WEEK OR TWO. DTSCU351 +00076 * DTSCU351 +00077 * DTSCU351 +00078 ***** DTSCU351 +00079 DTSCU351 +00080 ENVIRONMENT DIVISION. DTSCU351 +00081 DTSCU351 +00082 DATA DIVISION. DTSCU351 +00083 DTSCU351 +00084 WORKING-STORAGE SECTION. DTSCU351 +000845 77 PAN-VALET PICTURE X(24) VALUE '001DTSCU351 07/30/98'. DTSCU351 +00085 DTSCU351 +00086 01 WRK-AREA. DTSCU351 +00087 05 WRK-ABEND-CODE PIC X(04) VALUE 'U351'. DTSCU351 +00088 DTSCU351 +00089 05 LINE-CNT PIC S9(04) COMP. DTSCU351 +00090 DTSCU351 +00091 05 WRK-OCC PIC S9(04) COMP. DTSCU351 +00092 DTSCU351 +00093 05 WRK-OCC1 PIC S9(04) COMP. DTSCU351 +00094 DTSCU351 +00095 05 WRK-OCC2 PIC S9(04) COMP. DTSCU351 +00096 DTSCU351 +00097 05 WRK-COPY-CNT PIC S9(01) COMP-3. DTSCU351 +00098 DTSCU351 +00099 05 WRK-BLANK-LINE-IND PIC X(01). DTSCU351 +00100 88 WRK-BLANK-LINE-YES-88 VALUE 'Y'. DTSCU351 +00101 88 WRK-BLANK-LINE-NO-88 VALUE 'N'. DTSCU351 +00102 DTSCU351 +00103 05 WRK-CC PIC X(01). DTSCU351 +00104 88 WRK-CC-NONE VALUE ' '. DTSCU351 +00105 88 WRK-CC-SKIP-LINE VALUE '0'. DTSCU351 +00106 DTSCU351 +00107 01 WRK-ASSIGN-DESC. DTSCU351 +00108 05 WRK-ASSIGN-DESC1 PIC X(20). DTSCU351 +00109 05 WRK-ASSIGN-DESC2 PIC X(20). DTSCU351 +00110 DTSCU351 +00111 01 TS-AREA. DTSCU351 +00112 05 TS-LINE-CNT PIC S9(04) COMP. DTSCU351 +00113 05 TS-LINE OCCURS 66 TIMES DTSCU351 +00114 INDEXED BY TS-LINE-IDX. DTSCU351 +00115 10 TS-CC PIC X(01). DTSCU351 +00116 88 TS-CC-NEW-PAGE VALUE '1'. DTSCU351 +00117 88 TS-CC-SKIP-LINE VALUE '0'. DTSCU351 +00118 88 TS-CC-NONE VALUE ' '. DTSCU351 +00119 10 TS-TEXT PIC X(78). DTSCU351 +00120 DTSCU351 +00121 01 WRK-ADDRESSES. DTSCU351 +00122 05 WRK-ADDRESS OCCURS 6 TIMES. DTSCU351 +00123 10 WRK-MAILING-LINE OCCURS 6 TIMES PIC X(40). DTSCU351 +00124 DTSCU351 +00125 01 WRK-TELEPHONES. DTSCU351 +00126 * 05 WRK-PHONES OCCURS 6 TIMES. DTSCU351 +00127 10 WRK-TELEPHONE. DTSCU351 +00128 15 WRK-TELEPHONE-LEFT PIC X(01). DTSCU351 +00129 15 WRK-TELEPHONE-AREA-CD PIC X(03). DTSCU351 +00130 15 WRK-TELEPHONE-RIGHT PIC X(02). DTSCU351 +00131 15 WRK-TELEPHONE-PREFIX PIC X(03). DTSCU351 +00132 15 WRK-TELPHONE-DASH PIC X(01). DTSCU351 +00133 15 WRK-TELEPHONE-SUFFIX PIC X(04). DTSCU351 +00134 15 WRK-TELEPHONE-EXT-LBL PIC X(06). DTSCU351 +00135 15 WRK-TELEPHONE-EXT PIC X(04). DTSCU351 +00136 DTSCU351 +00137 01 WRK-HEADING-1. DTSCU351 +00138 05 WRK-PROGRAM PIC X(05) VALUE '601R1'. DTSCU351 +00139 05 FILLER PIC X(19) VALUE SPACES. DTSCU351 +00140 05 WRK-AGY-NAMEA-CNTR PIC X(40). DTSCU351 +00141 05 FILLER PIC X(06) VALUE SPACES. DTSCU351 +00142 05 WRK-SYS-DATE PIC X(08). DTSCU351 +00143 DTSCU351 +00144 01 WRK-HEADING-2. DTSCU351 +00145 05 FILLER PIC X(25) VALUE SPACES. DTSCU351 +00146 05 FILLER PIC X(27) VALUE DTSCU351 +00147 'FIELD ASSIGNMENT MEMORANDUM'. DTSCU351 +00148 05 FILLER PIC X(18) VALUE SPACES. DTSCU351 +00149 05 WRK-SYS-TIME PIC X(08). DTSCU351 +00150 DTSCU351 +00151 01 WRK-LINE-TO. DTSCU351 +00152 05 FILLER PIC X(13) VALUE ' TO: '. DTSCU351 +00153 05 WRK-FIELD-REP-NAME PIC X(32). DTSCU351 +00154 05 FILLER PIC X(13) VALUE ' ASSIGN NO: '. DTSCU351 +00155 05 WRK-ASSIGN-NO PIC 99B99999. DTSCU351 +00156 DTSCU351 +00157 01 WRK-LINE-FROM. DTSCU351 +00158 05 FILLER PIC X(13) DTSCU351 +00159 VALUE ' FROM: '. DTSCU351 +00160 05 WRK-ORIGINATOR PIC X(32). DTSCU351 +00161 05 FILLER PIC X(13) VALUE ' DUE DATE: '. DTSCU351 +00162 05 WRK-DUE-DATE PIC X(08). DTSCU351 +00163 DTSCU351 +00164 01 WRK-LINE-EMP-NO. DTSCU351 +00165 05 FILLER PIC X(13) VALUE ' EMP NO: '. DTSCU351 +00166 05 WRK-EMP-NO PIC 999B999. DTSCU351 +00167 05 FILLER PIC X(25) VALUE SPACES. DTSCU351 +00168 05 FILLER PIC X(13) VALUE 'ASSIGN TYPE: '. DTSCU351 +00169 05 WRK-ASSIGN-TYPE PIC X(02). DTSCU351 +00170 DTSCU351 +00171 01 WRK-LINE-ASSIGN-1. DTSCU351 +00172 05 FILLER PIC X(58) VALUE SPACES. DTSCU351 +00173 05 WRK-ASSIGN-TYPE-DESC1 PIC X(20). DTSCU351 +00174 DTSCU351 +00175 01 WRK-LINE-ASSIGN-2. DTSCU351 +00176 05 FILLER PIC X(13) VALUE ' SIC: '. DTSCU351 +00177 05 WRK-SIC-CD PIC X(07). DTSCU351 +00178 05 FILLER PIC X(01) VALUE SPACES. DTSCU351 +00179 05 WRK-OWN-CD PIC X(02). DTSCU351 +00180 05 FILLER PIC X(35) VALUE SPACES. DTSCU351 +00181 05 WRK-ASSIGN-TYPE-DESC2 PIC X(20). DTSCU351 +00182 DTSCU351 +00183 01 WRK-LINE-FEIN. DTSCU351 +00184 05 FILLER PIC X(13) VALUE ' FEIN: '. DTSCU351 +00185 05 WRK-FEIN-X PIC X(11). DTSCU351 +00186 05 WRK-FEIN REDEFINES WRK-FEIN-X DTSCU351 +00187 PIC 99B9999999B. DTSCU351 +00188 05 FILLER PIC X(20) VALUE SPACES. DTSCU351 +00189 05 FILLER PIC X(14) VALUE 'AUDIT PERIOD: '. DTSCU351 +00190 05 WRK-AUDIT-YRQ-START PIC X(04). DTSCU351 +00191 05 FILLER PIC X(03) VALUE ' - '. DTSCU351 +00192 05 WRK-AUDIT-YRQ-END PIC X(04). DTSCU351 +00193 DTSCU351 +00194 01 WRK-EMP-SIZE-LINE. DTSCU351 +00195 05 FILLER PIC X(43) VALUE SPACES. DTSCU351 +00196 05 FILLER PIC X(15) VALUE 'EMPLOYER SIZE: '.DTSCU351 +00197 05 WRK-EMP-SIZE PIC X(05). DTSCU351 +00198 DTSCU351 +00199 01 WRK-LINE-ADDRESS. DTSCU351 +00200 05 WRK-TAD-ADDRESS PIC X(40). DTSCU351 +00201 05 FILLER PIC X(01) VALUE SPACES. DTSCU351 +00202 05 WRK-OPO-ADDRESS PIC X(37). DTSCU351 +00203 DTSCU351 +00204 01 WRK-LINE-RE. DTSCU351 +00205 05 FILLER PIC X(13) VALUE 'RE CLAIMANT: '. DTSCU351 +00206 05 WRK-CLAIMANT-SSN PIC 999B99B9999. DTSCU351 +00207 05 FILLER PIC X(04) VALUE SPACES. DTSCU351 +00208 05 WRK-CLAIMANT-NAME PIC X(32). DTSCU351 +00209 DTSCU351 +00210 01 WRK-LINE-RELATED-EMP. DTSCU351 +00211 05 FILLER PIC X(13) VALUE 'RELATED EMP: '. DTSCU351 +00212 05 WRK-RELATED-EMP-NO PIC 999B999. DTSCU351 +00213 05 FILLER PIC X(04) VALUE SPACES. DTSCU351 +00214 05 WRK-RELATED-EMP-NAME PIC X(40). DTSCU351 +00215 DTSCU351 +00216 01 WRK-LINE-TEXT. DTSCU351 +00217 05 WRK-TEXT PIC X(72) VALUE SPACES. DTSCU351 +00218 DTSCU351 +00219 01 WRK-LINE-COPY. DTSCU351 +00220 05 FILLER PIC X(25) VALUE SPACES. DTSCU351 +00221 05 WRK-COPY-LIT PIC X(20). DTSCU351 +00222 EJECT DTSCU351 +00223 01 L001-COMM-AREA. DTSCU351 +00224 COPY MACIL001. DTSCU351 +00225 EJECT DTSCU351 +00226 01 L004-COMM-AREA. DTSCU351 +00227 COPY MACIL004. DTSCU351 +00228 EJECT DTSCU351 +00229 01 L056-COMM-AREA. DTSCU351 +00230 COPY MACIL056. DTSCU351 +00231 EJECT DTSCU351 +00232 01 L062-COMM-AREA. DTSCU351 +00233 COPY MACIL062. DTSCU351 +00234 EJECT DTSCU351 +00235 01 L063-COMM-AREA. DTSCU351 +00236 COPY MACIL063. DTSCU351 +00237 EJECT DTSCU351 +00238 01 L071-COMM-AREA. DTSCU351 +00239 COPY MACIL071. DTSCU351 +00240 EJECT DTSCU351 +00241 01 L082-COMM-AREA. DTSCU351 +00242 COPY MACIL082. DTSCU351 +00243 EJECT DTSCU351 +00244 01 L112-COMM-AREA. DTSCU351 +00245 COPY MACIL112. DTSCU351 +00246 EJECT DTSCU351 +00247 01 L119-COMM-AREA. DTSCU351 +00248 COPY MACIL119. DTSCU351 +00249 EJECT DTSCU351 +00250 01 L357-COMM-AREA. DTSCU351 +00251 COPY MACIL357. DTSCU351 +00252 EJECT DTSCU351 +00253 01 L829-COMM-AREA. DTSCU351 +00254 05 L829-CONTROL-BLOCK. DTSCU351 +00255 COPY MACIL829. DTSCU351 +00256 DTSCU351 +00257 05 L829-REC. DTSCU351 +00258 COPY MACIXPTS. DTSCU351 +00259 EJECT DTSCU351 +00260 01 L810-COMM-AREA. DTSCU351 +00261 05 L810-CONTROL-BLOCK. DTSCU351 +00262 COPY MACIL810. DTSCU351 +00263 DTSCU351 +00264 05 MSKL-REC. DTSCU351 +00265 COPY MACIMSKL. DTSCU351 +00266 EJECT DTSCU351 +00267 01 MPRF-REC. DTSCU351 +00268 COPY MACIMPRF. DTSCU351 +00269 EJECT DTSCU351 +00270 01 MTAD-REC. DTSCU351 +00271 COPY MACIMTAD. DTSCU351 +00272 EJECT DTSCU351 +00273 01 MFAS-REC. DTSCU351 +00274 COPY MACIMFAS. DTSCU351 +00275 EJECT DTSCU351 +00276 01 MOPO-REC. DTSCU351 +00277 COPY MACIMOPO. DTSCU351 +00278 EJECT DTSCU351 +00279 LINKAGE SECTION. DTSCU351 +00280 DTSCU351 +00281 01 DFHCOMMAREA. DTSCU351 +00282 COPY MACIL351. DTSCU351 +00283 DTSCU351 +00284 /*****************************************************************DTSCU351 +00285 * DTSCU351 +00286 ******************************************************************DTSCU351 +00287 PROCEDURE DIVISION. DTSCU351 +00288 *-----------------------------------------------------------------DTSCU351 +00289 * CLEAN UP AND INITIALIZE TS QUEUE AREA. DTSCU351 +00290 *-----------------------------------------------------------------DTSCU351 +00291 MOVE 0 TO L829-ITEM-NO. DTSCU351 +00292 DTSCU351 +00293 MOVE XPTS-LENGTH TO L829-REC-LENGTH. DTSCU351 +00294 DTSCU351 +00295 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCU351 +00296 DTSCU351 +00297 MOVE L351-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCU351 +00298 DTSCU351 +00299 MOVE 'P' TO L829-QUEUE-NAME-SUFFIX. DTSCU351 +00300 DTSCU351 +00301 COMPUTE L829-COMM-AREA-LENGTH DTSCU351 +00302 = L829-CONTROL-BLOCK-LENGTH + L829-REC-LENGTH. DTSCU351 +00303 DTSCU351 +00304 PERFORM S829-DELETE-QUEUE THRU S829-EXIT. DTSCU351 +00305 DTSCU351 +00306 MOVE L351-PRINTER-ID TO L357-PRINTER-ID. DTSCU351 +00307 DTSCU351 +00308 MOVE L829-QUEUE-NAME TO L357-QUEUE-NAME DTSCU351 +00309 DTSCU351 +00310 DTSCU351 +00311 *-----------------------------------------------------------------DTSCU351 +00312 * SET RESULT TO OK AND AND START PROCESS DTSCU351 +00313 *-----------------------------------------------------------------DTSCU351 +00314 SET L351-PRINT-OK TO TRUE. DTSCU351 +00315 DTSCU351 +00316 IF L351-COPY-CNT = 0 DTSCU351 +00317 SET L351-PRINT-FAILED TO TRUE DTSCU351 +00318 ELSE DTSCU351 +00319 PERFORM P1000-PROCESS THRU P1000-EXIT DTSCU351 +00320 IF L351-PRINT-FAILED DTSCU351 +00321 PERFORM S829-DELETE-QUEUE THRU S829-EXIT DTSCU351 +00322 ELSE DTSCU351 +00323 PERFORM S357-LINK-PRINT THRU S357-EXIT DTSCU351 +00324 IF L357-FAILED-88 DTSCU351 +00325 SET L351-PRINT-FAILED TO TRUE DTSCU351 +00326 END-IF. DTSCU351 +00327 DTSCU351 +00328 EXEC CICS DTSCU351 +00329 RETURN DTSCU351 +00330 END-EXEC. DTSCU351 +00331 DTSCU351 +00332 GOBACK. DTSCU351 +00333 /*****************************************************************DTSCU351 +00334 * DTSCU351 +00335 ******************************************************************DTSCU351 +00336 P1000-PROCESS. DTSCU351 +00337 PERFORM P1010-READ-PRF THRU P1010-EXIT DTSCU351 +00338 IF L351-PRINT-FAILED DTSCU351 +00339 GO TO P1000-EXIT DTSCU351 +00340 END-IF. DTSCU351 +00341 DTSCU351 +00342 PERFORM P1020-READ-FAS THRU P1020-EXIT. DTSCU351 +00343 IF L351-PRINT-FAILED DTSCU351 +00344 GO TO P1000-EXIT DTSCU351 +00345 END-IF. DTSCU351 +00346 DTSCU351 +00347 PERFORM P1100-HEADING THRU P1100-EXIT. DTSCU351 +00348 DTSCU351 +00349 PERFORM P1200-FAS-AREA THRU P1200-EXIT. DTSCU351 +00350 DTSCU351 +00351 PERFORM P1300-ADDRESSES THRU P1300-EXIT. DTSCU351 +00352 DTSCU351 +00353 PERFORM P1400-CLAIMANT THRU P1400-EXIT. DTSCU351 +00354 DTSCU351 +00355 PERFORM P1500-REL-EMP THRU P1500-EXIT. DTSCU351 +00356 DTSCU351 +00357 ADD +1 TO TS-LINE-CNT DTSCU351 +00358 MOVE ' ' TO TS-CC(TS-LINE-CNT) DTSCU351 +00359 MOVE SPACES TO TS-TEXT(TS-LINE-CNT). DTSCU351 +00360 ADD +1 TO LINE-CNT. DTSCU351 +00361 DTSCU351 +00362 IF MFAS-TEXT-CNT NOT EQUAL 0 DTSCU351 +00363 PERFORM P1600-FAS-TEXT THRU P1600-EXIT DTSCU351 +00364 VARYING MFAS-TEXT-IDX DTSCU351 +00365 FROM 1 BY 1 DTSCU351 +00366 UNTIL MFAS-TEXT-IDX > MFAS-TEXT-CNT. DTSCU351 +00367 DTSCU351 +00368 PERFORM P7000-COPY-LINE THRU P7000-EXIT. DTSCU351 +00369 DTSCU351 +00370 MOVE '(FIELD REP COPY)' TO WRK-COPY-LIT. DTSCU351 +00371 PERFORM P8000-TS-WRITE THRU P8000-EXIT. DTSCU351 +00372 DTSCU351 +00373 IF L351-PRINT-FAILED DTSCU351 +00374 GO TO P1000-EXIT DTSCU351 +00375 END-IF. DTSCU351 +00376 DTSCU351 +00377 MOVE +0 TO WRK-COPY-CNT. DTSCU351 +00378 PERFORM P2000-COPY-IND THRU P2000-EXIT. DTSCU351 +00379 DTSCU351 +00380 IF L351-COPY-CNT > 1 DTSCU351 +00381 MOVE '(EMPLOYER FILE COPY)' TO WRK-COPY-LIT DTSCU351 +00382 PERFORM P8000-TS-WRITE THRU P8000-EXIT DTSCU351 +00383 PERFORM P2000-COPY-IND THRU P2000-EXIT DTSCU351 +00384 END-IF. DTSCU351 +00385 DTSCU351 +00386 IF L351-PRINT-FAILED DTSCU351 +00387 GO TO P1000-EXIT DTSCU351 +00388 END-IF. DTSCU351 +00389 DTSCU351 +00390 IF L351-COPY-CNT > 2 DTSCU351 +00391 MOVE SPACES TO WRK-COPY-LIT DTSCU351 +00392 PERFORM P8000-TS-WRITE THRU P8000-EXIT DTSCU351 +00393 PERFORM P2000-COPY-IND THRU P2000-EXIT DTSCU351 +00394 END-IF. DTSCU351 +00395 DTSCU351 +00396 IF L351-PRINT-FAILED DTSCU351 +00397 GO TO P1000-EXIT DTSCU351 +00398 END-IF. DTSCU351 +00399 DTSCU351 +00400 IF L351-COPY-CNT > 3 DTSCU351 +00401 IF MFAS-RELATED-EMP-NO NOT = 0 DTSCU351 +00402 MOVE SPACES TO WRK-COPY-LIT DTSCU351 +00403 ELSE DTSCU351 +00404 MOVE SPACES TO WRK-COPY-LIT DTSCU351 +00405 END-IF DTSCU351 +00406 PERFORM P8000-TS-WRITE THRU P8000-EXIT DTSCU351 +00407 PERFORM P2000-COPY-IND THRU P2000-EXIT DTSCU351 +00408 END-IF DTSCU351 +00409 DTSCU351 +00410 IF L351-PRINT-FAILED DTSCU351 +00411 GO TO P1000-EXIT. DTSCU351 +00412 DTSCU351 +00413 PERFORM P1001-ADDL-COPIES THRU P1001-EXIT DTSCU351 +00414 UNTIL (WRK-COPY-CNT NOT < L351-COPY-CNT) DTSCU351 +00415 OR DTSCU351 +00416 (L351-PRINT-FAILED). DTSCU351 +00417 DTSCU351 +00418 P1000-EXIT. DTSCU351 +00419 EXIT. DTSCU351 +00420 DTSCU351 +00421 P1001-ADDL-COPIES. DTSCU351 +00422 MOVE SPACES TO WRK-COPY-LIT. DTSCU351 +00423 PERFORM P8000-TS-WRITE THRU P8000-EXIT. DTSCU351 +00424 PERFORM P2000-COPY-IND THRU P2000-EXIT. DTSCU351 +00425 P1001-EXIT. DTSCU351 +00426 EXIT. DTSCU351 +00427 /*****************************************************************DTSCU351 +00428 * READ EMPLOYER PROFILE DTSCU351 +00429 ******************************************************************DTSCU351 +00430 P1010-READ-PRF. DTSCU351 +00431 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCU351 +00432 MOVE L351-EMP-NO TO MPRF-EMP-NO. DTSCU351 +00433 SET MPRF-PRF-88 TO TRUE. DTSCU351 +00434 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCU351 +00435 PERFORM S810-READ THRU S810-EXIT. DTSCU351 +00436 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00437 SET L351-PRINT-FAILED TO TRUE DTSCU351 +00438 ELSE DTSCU351 +00439 MOVE MSKL-REC TO MPRF-REC DTSCU351 +00440 END-IF. DTSCU351 +00441 P1010-EXIT. DTSCU351 +00442 EXIT. DTSCU351 +00443 DTSCU351 +00444 /*****************************************************************DTSCU351 +00445 * READ FIELD ASSIGNMENT DTSCU351 +00446 ******************************************************************DTSCU351 +00447 P1020-READ-FAS. DTSCU351 +00448 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCU351 +00449 MOVE L351-EMP-NO TO MFAS-EMP-NO. DTSCU351 +00450 MOVE L351-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSCU351 +00451 SET MFAS-FAS-88 TO TRUE. DTSCU351 +00452 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCU351 +00453 PERFORM S810-READ THRU S810-EXIT. DTSCU351 +00454 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00455 SET L351-PRINT-FAILED TO TRUE DTSCU351 +00456 ELSE DTSCU351 +00457 MOVE MSKL-REC TO MFAS-REC DTSCU351 +00458 END-IF. DTSCU351 +00459 P1020-EXIT. DTSCU351 +00460 EXIT. DTSCU351 +00461 DTSCU351 +00462 /*****************************************************************DTSCU351 +00463 * BUILD FIELD ASSIGNMENT MEMO HEADING (FIRST 3 LINES) DTSCU351 +00464 ******************************************************************DTSCU351 +00465 P1100-HEADING. DTSCU351 +00466 MOVE L351-TASK-START-DISP-DATE TO WRK-SYS-DATE. DTSCU351 +00467 MOVE L351-TASK-START-DISP-TIME TO WRK-SYS-TIME. DTSCU351 +00468 DTSCU351 +00469 PERFORM S119-AGENCY-FACTS THRU S119-EXIT. DTSCU351 +00470 DTSCU351 +00471 MOVE L119-AGY-NAMEA TO WRK-AGY-NAMEA-CNTR. DTSCU351 +00472 SET TS-CC-NEW-PAGE(1) TO TRUE. DTSCU351 +00473 MOVE WRK-HEADING-1 TO TS-TEXT(1). DTSCU351 +00474 SET TS-CC-NONE(2) TO TRUE. DTSCU351 +00475 MOVE WRK-HEADING-2 TO TS-TEXT(2). DTSCU351 +00476 MOVE +02 TO TS-LINE-CNT. DTSCU351 +00477 MOVE +02 TO LINE-CNT. DTSCU351 +00478 P1100-EXIT. EXIT. DTSCU351 +00479 DTSCU351 +00480 /*****************************************************************DTSCU351 +00481 * BUILD FIELD ASSIGNMENT SPECIFIC INFORMATION DTSCU351 +00482 ******************************************************************DTSCU351 +00483 P1200-FAS-AREA. DTSCU351 +00484 SET TS-CC-SKIP-LINE(3) TO TRUE. DTSCU351 +00485 MOVE MFAS-FLD-REP-ID TO L062-FLD-REP-ID. DTSCU351 +00486 PERFORM S062-AUDIT-EDIT THRU S062-EXIT. DTSCU351 +00487 MOVE L062-NAME TO WRK-FIELD-REP-NAME. DTSCU351 +00488 MOVE MFAS-ASSIGN-NO TO WRK-ASSIGN-NO. DTSCU351 +00489 MOVE WRK-LINE-TO TO TS-TEXT(3). DTSCU351 +00490 DTSCU351 +00491 SET TS-CC-SKIP-LINE(4) TO TRUE. DTSCU351 +00492 MOVE MFAS-SOURCE-OP-ID TO L082-OP-ID. DTSCU351 +00493 PERFORM S082-OP-ID THRU S082-EXIT. DTSCU351 +00494 MOVE L082-NAME TO WRK-ORIGINATOR. DTSCU351 +00495 MOVE MFAS-DUE-DATE TO L001-FED-8-DATE-9. DTSCU351 +00496 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCU351 +00497 MOVE L001-SLASH-DATE TO WRK-DUE-DATE. DTSCU351 +00498 MOVE WRK-LINE-FROM TO TS-TEXT(4). DTSCU351 +00499 DTSCU351 +00500 SET TS-CC-SKIP-LINE(5) TO TRUE. DTSCU351 +00501 MOVE MFAS-ASSIGN-TYPE TO L063-TYPE. DTSCU351 +00502 PERFORM S063-ASSIGN-TYPE THRU S063-EXIT. DTSCU351 +00503 MOVE L063-TYPE TO WRK-ASSIGN-TYPE. DTSCU351 +00504 MOVE MFAS-EMP-NO TO WRK-EMP-NO. DTSCU351 +00505 MOVE WRK-LINE-EMP-NO TO TS-TEXT(5). DTSCU351 +00506 DTSCU351 +00507 SET TS-CC-NONE(6) TO TRUE. DTSCU351 +00508 MOVE L063-DESCRIPTION TO WRK-ASSIGN-DESC. DTSCU351 +00509 MOVE WRK-ASSIGN-DESC1 TO WRK-ASSIGN-TYPE-DESC1. DTSCU351 +00510 MOVE WRK-LINE-ASSIGN-1 TO TS-TEXT(6). DTSCU351 +00511 DTSCU351 +00512 SET TS-CC-NONE(7) TO TRUE. DTSCU351 +00513 MOVE MFAS-SIC-CD TO WRK-SIC-CD. DTSCU351 +00514 MOVE MFAS-OWN-CD TO WRK-OWN-CD. DTSCU351 +00515 DTSCU351 +00516 MOVE WRK-ASSIGN-DESC2 TO WRK-ASSIGN-TYPE-DESC2. DTSCU351 +00517 MOVE WRK-LINE-ASSIGN-2 TO TS-TEXT(7). DTSCU351 +00518 DTSCU351 +00519 SET TS-CC-NONE(8) TO TRUE. DTSCU351 +00520 IF MPRF-FEIN > 0 DTSCU351 +00521 MOVE MPRF-FEIN TO WRK-FEIN DTSCU351 +00522 ELSE DTSCU351 +00523 MOVE SPACES TO WRK-FEIN-X DTSCU351 +00524 END-IF. DTSCU351 +00525 DTSCU351 +00526 MOVE MFAS-AUDIT-START-YRQ TO L004-QTR-5-9. DTSCU351 +00527 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCU351 +00528 MOVE L004-SLASH-QTR TO WRK-AUDIT-YRQ-START. DTSCU351 +00529 MOVE MFAS-AUDIT-END-YRQ TO L004-QTR-5-9. DTSCU351 +00530 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCU351 +00531 MOVE L004-SLASH-QTR TO WRK-AUDIT-YRQ-END. DTSCU351 +00532 MOVE WRK-LINE-FEIN TO TS-TEXT(8). DTSCU351 +00533 DTSCU351 +00534 SET TS-CC-NONE(9) TO TRUE. DTSCU351 +00535 IF MFAS-AUDIT-88 DTSCU351 +00536 IF MFAS-EMP-LARGE-88 DTSCU351 +00537 MOVE 'LARGE' TO WRK-EMP-SIZE DTSCU351 +00538 ELSE DTSCU351 +00539 MOVE 'SMALL' TO WRK-EMP-SIZE DTSCU351 +00540 END-IF DTSCU351 +00541 ELSE DTSCU351 +00542 MOVE SPACES TO WRK-EMP-SIZE DTSCU351 +00543 END-IF. DTSCU351 +00544 MOVE WRK-EMP-SIZE-LINE TO TS-TEXT(9). DTSCU351 +00545 DTSCU351 +00546 MOVE +09 TO TS-LINE-CNT. DTSCU351 +00547 MOVE +12 TO LINE-CNT. DTSCU351 +00548 P1200-EXIT. DTSCU351 +00549 EXIT. DTSCU351 +00550 /*****************************************************************DTSCU351 +00551 * OBTAIN ADDRESS INFORMATION FROM FILE AND STORE IN TABLE DTSCU351 +00552 ******************************************************************DTSCU351 +00553 P1300-ADDRESSES. DTSCU351 +00554 MOVE SPACES TO WRK-ADDRESSES. DTSCU351 +00555 DTSCU351 +00556 PERFORM P1310-FORMAT-TAX-ADDR THRU P1310-EXIT. DTSCU351 +00557 DTSCU351 +00558 PERFORM P1320-FORMAT-OPO-ADDR THRU P1320-EXIT. DTSCU351 +00559 DTSCU351 +00560 MOVE SPACE TO WRK-TAD-ADDRESS. DTSCU351 +00561 DTSCU351 +00562 MOVE SPACE TO WRK-OPO-ADDRESS. DTSCU351 +00563 DTSCU351 +00564 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCU351 +00565 UNTIL WRK-OCC > 3 DTSCU351 +00566 DTSCU351 +00567 SET WRK-CC-SKIP-LINE TO TRUE DTSCU351 +00568 DTSCU351 +00569 ADD 3 TO WRK-OCC GIVING WRK-OCC2 DTSCU351 +00570 PERFORM VARYING WRK-OCC1 FROM 1 BY 1 DTSCU351 +00571 UNTIL WRK-OCC1 > 6 DTSCU351 +00572 IF WRK-MAILING-LINE (WRK-OCC, WRK-OCC1) = SPACES DTSCU351 +00573 AND WRK-MAILING-LINE (WRK-OCC2, WRK-OCC1) = SPACES DTSCU351 +00574 CONTINUE DTSCU351 +00575 ELSE DTSCU351 +00576 MOVE WRK-MAILING-LINE (WRK-OCC, WRK-OCC1) DTSCU351 +00577 TO WRK-TAD-ADDRESS DTSCU351 +00578 MOVE WRK-MAILING-LINE (WRK-OCC2, WRK-OCC1) DTSCU351 +00579 TO WRK-OPO-ADDRESS DTSCU351 +00580 ADD 1 TO TS-LINE-CNT DTSCU351 +00581 MOVE WRK-CC TO TS-CC (TS-LINE-CNT) DTSCU351 +00582 SET WRK-CC-NONE TO TRUE DTSCU351 +00583 MOVE WRK-LINE-ADDRESS TO TS-TEXT (TS-LINE-CNT) DTSCU351 +00584 PERFORM P1301-LINE-CNT THRU P1301-EXIT DTSCU351 +00585 END-IF DTSCU351 +00586 END-PERFORM DTSCU351 +00587 END-PERFORM. DTSCU351 +00588 P1300-EXIT. EXIT. DTSCU351 +00589 DTSCU351 +00590 P1301-LINE-CNT. DTSCU351 +00591 IF TS-CC-SKIP-LINE (TS-LINE-CNT) DTSCU351 +00592 ADD +2 TO LINE-CNT DTSCU351 +00593 ELSE DTSCU351 +00594 ADD +1 TO LINE-CNT. DTSCU351 +00595 P1301-EXIT. DTSCU351 +00596 EXIT. DTSCU351 +00597 /*****************************************************************DTSCU351 +00598 * READ AND FORMAT FROM TAD (REPETITIVE CODE USED FOR READABLILITY)DTSCU351 +00599 ******************************************************************DTSCU351 +00600 P1310-FORMAT-TAX-ADDR. DTSCU351 +00601 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCU351 +00602 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSCU351 +00603 SET MTAD-TAD-88 TO TRUE. DTSCU351 +00604 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCU351 +00605 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCU351 +00606 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00607 GO TO P1310-EXIT DTSCU351 +00608 END-IF. DTSCU351 +00609 MOVE +0 TO WRK-OCC. DTSCU351 +00610 PERFORM P1315-FORMAT THRU P1315-EXIT. DTSCU351 +00611 DTSCU351 +00612 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCU351 +00613 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00614 GO TO P1310-EXIT DTSCU351 +00615 END-IF. DTSCU351 +00616 PERFORM P1315-FORMAT THRU P1315-EXIT. DTSCU351 +00617 DTSCU351 +00618 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCU351 +00619 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00620 GO TO P1310-EXIT DTSCU351 +00621 END-IF. DTSCU351 +00622 PERFORM P1315-FORMAT THRU P1315-EXIT. DTSCU351 +00623 DTSCU351 +00624 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCU351 +00625 DTSCU351 +00626 P1310-EXIT. DTSCU351 +00627 EXIT. DTSCU351 +00628 EJECT DTSCU351 +00629 DTSCU351 +00630 /*****************************************************************DTSCU351 +00631 * DTSCU351 +00632 ******************************************************************DTSCU351 +00633 P1315-FORMAT. DTSCU351 +00634 ADD +1 TO WRK-OCC. DTSCU351 +00635 MOVE MSKL-REC TO MTAD-REC. DTSCU351 +00636 PERFORM S112-FORMAT-TAD THRU S112-EXIT. DTSCU351 +00637 DTSCU351 +00638 IF MTAD-VOICE = SPACES DTSCU351 +00639 MOVE SPACES TO WRK-TELEPHONE DTSCU351 +00640 ELSE DTSCU351 +00641 MOVE '(' TO WRK-TELEPHONE-LEFT DTSCU351 +00642 MOVE MTAD-VOICE-AREA-CD TO WRK-TELEPHONE-AREA-CD DTSCU351 +00643 MOVE ') ' TO WRK-TELEPHONE-RIGHT DTSCU351 +00644 MOVE MTAD-VOICE-PREFIX TO WRK-TELEPHONE-PREFIX DTSCU351 +00645 MOVE '-' TO WRK-TELPHONE-DASH DTSCU351 +00646 MOVE MTAD-VOICE-SUFFIX TO WRK-TELEPHONE-SUFFIX DTSCU351 +00647 IF MTAD-VOICE-EXT NOT = SPACES DTSCU351 +00648 MOVE ' EXT. ' TO WRK-TELEPHONE-EXT-LBL DTSCU351 +00649 MOVE MTAD-VOICE-EXT TO WRK-TELEPHONE-EXT DTSCU351 +00650 ELSE DTSCU351 +00651 MOVE SPACES TO WRK-TELEPHONE-EXT-LBL DTSCU351 +00652 MOVE SPACES TO WRK-TELEPHONE-EXT DTSCU351 +00653 END-IF. DTSCU351 +00654 MOVE L112-MAILING-ADDRESS TO WRK-ADDRESS(WRK-OCC). DTSCU351 +00655 MOVE WRK-TELEPHONE TO WRK-MAILING-LINE(WRK-OCC, 6).DTSCU351 +00656 PERFORM P1330-SCRUNCH THRU P1330-EXIT. DTSCU351 +00657 P1315-EXIT. DTSCU351 +00658 EXIT. DTSCU351 +00659 DTSCU351 +00660 /*****************************************************************DTSCU351 +00661 * READ AND FORMAT FROM OPO (REPETITIVE CODE USED FOR READABLILITY)DTSCU351 +00662 ******************************************************************DTSCU351 +00663 P1320-FORMAT-OPO-ADDR. DTSCU351 +00664 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCU351 +00665 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSCU351 +00666 SET MOPO-OPO-88 TO TRUE. DTSCU351 +00667 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCU351 +00668 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCU351 +00669 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00670 GO TO P1320-EXIT DTSCU351 +00671 END-IF. DTSCU351 +00672 DTSCU351 +00673 MOVE +3 TO WRK-OCC. DTSCU351 +00674 PERFORM P1325-FORMAT THRU P1325-EXIT. DTSCU351 +00675 DTSCU351 +00676 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCU351 +00677 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00678 GO TO P1320-EXIT DTSCU351 +00679 END-IF. DTSCU351 +00680 PERFORM P1325-FORMAT THRU P1325-EXIT. DTSCU351 +00681 DTSCU351 +00682 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCU351 +00683 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00684 GO TO P1320-EXIT DTSCU351 +00685 END-IF. DTSCU351 +00686 PERFORM P1325-FORMAT THRU P1325-EXIT. DTSCU351 +00687 DTSCU351 +00688 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCU351 +00689 DTSCU351 +00690 P1320-EXIT. DTSCU351 +00691 EXIT. DTSCU351 +00692 EJECT DTSCU351 +00693 /*****************************************************************DTSCU351 +00694 * DTSCU351 +00695 ******************************************************************DTSCU351 +00696 P1325-FORMAT. DTSCU351 +00697 ADD +1 TO WRK-OCC. DTSCU351 +00698 MOVE MSKL-REC TO MOPO-REC. DTSCU351 +00699 IF MOPO-VOICE = SPACES DTSCU351 +00700 MOVE SPACES TO WRK-TELEPHONE DTSCU351 +00701 ELSE DTSCU351 +00702 MOVE '(' TO WRK-TELEPHONE-LEFT DTSCU351 +00703 MOVE MOPO-VOICE-AREA-CD TO WRK-TELEPHONE-AREA-CD DTSCU351 +00704 MOVE ') ' TO WRK-TELEPHONE-RIGHT DTSCU351 +00705 MOVE MOPO-VOICE-PREFIX TO WRK-TELEPHONE-PREFIX DTSCU351 +00706 MOVE '-' TO WRK-TELPHONE-DASH DTSCU351 +00707 MOVE MOPO-VOICE-SUFFIX TO WRK-TELEPHONE-SUFFIX DTSCU351 +00708 IF MOPO-VOICE-EXT NOT = SPACES DTSCU351 +00709 MOVE ' EXT. ' TO WRK-TELEPHONE-EXT-LBL DTSCU351 +00710 MOVE MOPO-VOICE-EXT TO WRK-TELEPHONE-EXT DTSCU351 +00711 ELSE DTSCU351 +00712 MOVE SPACES TO WRK-TELEPHONE-EXT-LBL DTSCU351 +00713 MOVE SPACES TO WRK-TELEPHONE-EXT DTSCU351 +00714 END-IF. DTSCU351 +00715 DTSCU351 +00716 IF MOPO-ADDRESS = SPACES DTSCU351 +00717 MOVE MOPO-NAME TO L071-NAM DTSCU351 +00718 PERFORM S071-FROM-LAST-NAME-FIRST THRU S071-EXIT DTSCU351 +00719 MOVE SPACE TO WRK-ADDRESS (WRK-OCC) DTSCU351 +00720 IF MOPO-TITLE = SPACES DTSCU351 +00721 MOVE L071-NAM TO WRK-MAILING-LINE (WRK-OCC 1) DTSCU351 +00722 ELSE DTSCU351 +00723 STRING L071-NAM DELIMITED BY ' ' DTSCU351 +00724 ', ' DELIMITED BY SIZE DTSCU351 +00725 MOPO-TITLE DELIMITED BY ' ' DTSCU351 +00726 INTO DTSCU351 +00727 WRK-MAILING-LINE (WRK-OCC 1) DTSCU351 +00728 ELSE DTSCU351 +00729 PERFORM S112-FORMAT-OPO THRU S112-EXIT DTSCU351 +00730 MOVE L112-MAILING-ADDRESS TO WRK-ADDRESS (WRK-OCC). DTSCU351 +00731 DTSCU351 +00732 MOVE WRK-TELEPHONE TO WRK-MAILING-LINE(WRK-OCC, 6).DTSCU351 +00733 PERFORM P1330-SCRUNCH THRU P1330-EXIT. DTSCU351 +00734 P1325-EXIT. DTSCU351 +00735 EXIT. DTSCU351 +00736 DTSCU351 +00737 /*****************************************************************DTSCU351 +00738 * BUBBLE SORT THE BLANK LINES TO THE BOTTOM OF EACH GROUP DTSCU351 +00739 ******************************************************************DTSCU351 +00740 P1330-SCRUNCH. DTSCU351 +00741 SET WRK-BLANK-LINE-YES-88 TO TRUE. DTSCU351 +00742 DTSCU351 +00743 PERFORM DTSCU351 +00744 UNTIL WRK-BLANK-LINE-NO-88 DTSCU351 +00745 SET WRK-BLANK-LINE-NO-88 TO TRUE DTSCU351 +00746 DTSCU351 +00747 PERFORM VARYING WRK-OCC1 FROM 1 BY 1 DTSCU351 +00748 UNTIL WRK-OCC1 > 5 DTSCU351 +00749 DTSCU351 +00750 COMPUTE WRK-OCC2 = WRK-OCC1 + 1 DTSCU351 +00751 DTSCU351 +00752 IF WRK-MAILING-LINE(WRK-OCC, WRK-OCC1) = SPACES DTSCU351 +00753 AND WRK-MAILING-LINE(WRK-OCC, WRK-OCC2) NOT = SPACES DTSCU351 +00754 SET WRK-BLANK-LINE-YES-88 TO TRUE DTSCU351 +00755 MOVE WRK-MAILING-LINE(WRK-OCC, WRK-OCC2) DTSCU351 +00756 TO WRK-MAILING-LINE(WRK-OCC, WRK-OCC1) DTSCU351 +00757 MOVE SPACES TO WRK-MAILING-LINE(WRK-OCC, WRK-OCC2) DTSCU351 +00758 END-IF DTSCU351 +00759 DTSCU351 +00760 END-PERFORM DTSCU351 +00761 DTSCU351 +00762 END-PERFORM. DTSCU351 +00763 P1330-EXIT. DTSCU351 +00764 EXIT. DTSCU351 +00765 /*****************************************************************DTSCU351 +00766 * DTSCU351 +00767 ******************************************************************DTSCU351 +00768 P1400-CLAIMANT. DTSCU351 +00769 IF MFAS-CLAIMANT-SSN IS NOT EQUAL TO ZERO DTSCU351 +00770 ADD +1 TO TS-LINE-CNT DTSCU351 +00771 SET TS-CC-SKIP-LINE(TS-LINE-CNT) TO TRUE DTSCU351 +00772 MOVE MFAS-CLAIMANT-SSN TO WRK-CLAIMANT-SSN DTSCU351 +00773 MOVE MFAS-CLAIMANT-NAME TO WRK-CLAIMANT-NAME DTSCU351 +00774 MOVE WRK-LINE-RE TO TS-TEXT(TS-LINE-CNT) DTSCU351 +00775 ADD +2 TO LINE-CNT. DTSCU351 +00776 P1400-EXIT. DTSCU351 +00777 EXIT. DTSCU351 +00778 /*****************************************************************DTSCU351 +00779 * DTSCU351 +00780 ******************************************************************DTSCU351 +00781 P1500-REL-EMP. DTSCU351 +00782 IF MFAS-RELATED-EMP-NO NOT EQUAL TO ZERO DTSCU351 +00783 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCU351 +00784 MOVE MFAS-RELATED-EMP-NO TO MPRF-EMP-NO DTSCU351 +00785 SET MPRF-PRF-88 TO TRUE DTSCU351 +00786 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSCU351 +00787 PERFORM S810-READ THRU S810-EXIT DTSCU351 +00788 ADD +1 TO TS-LINE-CNT DTSCU351 +00789 SET TS-CC-SKIP-LINE(TS-LINE-CNT) TO TRUE DTSCU351 +00790 MOVE MFAS-RELATED-EMP-NO TO WRK-RELATED-EMP-NO DTSCU351 +00791 IF L810-NO-REC-88 OR L810-FILE-CLOSED-88 DTSCU351 +00792 MOVE '--NAME NO LONGER ON FILE--' DTSCU351 +00793 TO WRK-RELATED-EMP-NAME DTSCU351 +00794 ELSE DTSCU351 +00795 MOVE MSKL-REC TO MPRF-REC DTSCU351 +00796 MOVE MPRF-BUSINESS-NAME TO WRK-RELATED-EMP-NAME DTSCU351 +00797 END-IF DTSCU351 +00798 MOVE WRK-LINE-RELATED-EMP TO TS-TEXT(TS-LINE-CNT) DTSCU351 +00799 ADD +2 TO LINE-CNT. DTSCU351 +00800 P1500-EXIT. DTSCU351 +00801 EXIT. DTSCU351 +00802 /*****************************************************************DTSCU351 +00803 * DTSCU351 +00804 ******************************************************************DTSCU351 +00805 P1600-FAS-TEXT. DTSCU351 +00806 DTSCU351 +00807 ADD +1 TO TS-LINE-CNT. DTSCU351 +00808 MOVE ' ' TO TS-CC(TS-LINE-CNT). DTSCU351 +00809 MOVE MFAS-TEXT(MFAS-TEXT-IDX) TO WRK-TEXT. DTSCU351 +00810 MOVE WRK-LINE-TEXT TO TS-TEXT(TS-LINE-CNT). DTSCU351 +00811 ADD +1 TO LINE-CNT. DTSCU351 +00812 DTSCU351 +00813 P1600-EXIT. DTSCU351 +00814 EXIT. DTSCU351 +00815 DTSCU351 +00816 /*****************************************************************DTSCU351 +00817 * DTSCU351 +00818 ******************************************************************DTSCU351 +00819 P2000-COPY-IND. DTSCU351 +00820 DTSCU351 +00821 ADD +1 TO WRK-COPY-CNT. DTSCU351 +00822 DTSCU351 +00823 P2000-EXIT. DTSCU351 +00824 EXIT. DTSCU351 +00825 DTSCU351 +00826 /*****************************************************************DTSCU351 +00827 * GETS THE POINTER TO THE END OF THE PAGE DTSCU351 +00828 ******************************************************************DTSCU351 +00829 P7000-COPY-LINE. DTSCU351 +00830 PERFORM P7100-LOOP THRU P7100-EXIT DTSCU351 +00831 UNTIL LINE-CNT >= 60. DTSCU351 +00832 P7000-EXIT. DTSCU351 +00833 EXIT. DTSCU351 +00834 DTSCU351 +00835 P7100-LOOP. DTSCU351 +00836 ADD +1 TO LINE-CNT. DTSCU351 +00837 ADD +1 TO TS-LINE-CNT. DTSCU351 +00838 MOVE SPACE TO TS-CC(TS-LINE-CNT) DTSCU351 +00839 TS-TEXT(TS-LINE-CNT). DTSCU351 +00840 P7100-EXIT. DTSCU351 +00841 EXIT. DTSCU351 +00842 DTSCU351 +00843 P8000-TS-WRITE. DTSCU351 +00844 MOVE WRK-LINE-COPY TO TS-TEXT(TS-LINE-CNT). DTSCU351 +00845 PERFORM P8100-TS-LOOP THRU P8100-EXIT DTSCU351 +00846 VARYING WRK-OCC FROM 1 BY 1 DTSCU351 +00847 UNTIL WRK-OCC > TS-LINE-CNT DTSCU351 +00848 OR L351-PRINT-FAILED. DTSCU351 +00849 P8000-EXIT. DTSCU351 +00850 EXIT. DTSCU351 +00851 EJECT DTSCU351 +00852 /*****************************************************************DTSCU351 +00853 * DTSCU351 +00854 ******************************************************************DTSCU351 +00855 P8100-TS-LOOP. DTSCU351 +00856 MOVE TS-CC(WRK-OCC) TO XPTS-CC. DTSCU351 +00857 MOVE TS-TEXT(WRK-OCC) TO XPTS-DATA. DTSCU351 +00858 MOVE WRK-OCC TO L829-ITEM-NO. DTSCU351 +00859 PERFORM S829-WRITE-ITEM THRU S829-EXIT. DTSCU351 +00860 IF NOT L829-OK-88 DTSCU351 +00861 SET L351-PRINT-FAILED TO TRUE. DTSCU351 +00862 DTSCU351 +00863 P8100-EXIT. DTSCU351 +00864 EXIT. DTSCU351 +00865 /*****************************************************************DTSCU351 +00866 * SERVICE UTILITIES DTSCU351 +00867 ******************************************************************DTSCU351 +00868 S001-FROM-FED-8. DTSCU351 +00869 SET L001-FROM-FED-8 TO TRUE. DTSCU351 +00870 GO TO S001-DATE-EDIT. DTSCU351 +00871 DTSCU351 +00872 S001-DATE-EDIT. DTSCU351 +00873 EXEC CICS DTSCU351 +00874 LINK DTSCU351 +00875 PROGRAM ('MACCU001') DTSCU351 +00876 COMMAREA (L001-COMM-AREA) DTSCU351 +00877 LENGTH (L001-LENGTH) DTSCU351 +00878 END-EXEC. DTSCU351 +00879 S001-EXIT. DTSCU351 +00880 EXIT. DTSCU351 +00881 DTSCU351 +00882 S004-FROM-5. DTSCU351 +00883 SET L004-FROM-5 TO TRUE. DTSCU351 +00884 GO TO S004-QTR-EDIT. DTSCU351 +00885 DTSCU351 +00886 S004-QTR-EDIT. DTSCU351 +00887 EXEC CICS DTSCU351 +00888 LINK DTSCU351 +00889 PROGRAM ('MACCU004') DTSCU351 +00890 COMMAREA (L004-COMM-AREA) DTSCU351 +00891 LENGTH (L004-LENGTH) DTSCU351 +00892 END-EXEC. DTSCU351 +00893 S004-EXIT. DTSCU351 +00894 EXIT. DTSCU351 +00895 DTSCU351 +00896 S056-RATE. DTSCU351 +00897 EXEC CICS DTSCU351 +00898 LINK DTSCU351 +00899 PROGRAM ('MACCU056') DTSCU351 +00900 COMMAREA (L056-COMM-AREA) DTSCU351 +00901 LENGTH (L056-LENGTH) DTSCU351 +00902 END-EXEC. DTSCU351 +00903 S056-EXIT. DTSCU351 +00904 EXIT. DTSCU351 +00905 DTSCU351 +00906 S062-AUDIT-EDIT. DTSCU351 +00907 EXEC CICS DTSCU351 +00908 LINK DTSCU351 +00909 PROGRAM ('MACCU062') DTSCU351 +00910 COMMAREA (L062-COMM-AREA) DTSCU351 +00911 LENGTH (L062-LENGTH) DTSCU351 +00912 END-EXEC. DTSCU351 +00913 S062-EXIT. DTSCU351 +00914 EXIT. DTSCU351 +00915 DTSCU351 +00916 S063-ASSIGN-TYPE. DTSCU351 +00917 EXEC CICS DTSCU351 +00918 LINK DTSCU351 +00919 PROGRAM ('MACCU063') DTSCU351 +00920 COMMAREA (L063-COMM-AREA) DTSCU351 +00921 LENGTH (L063-LENGTH) DTSCU351 +00922 END-EXEC. DTSCU351 +00923 S063-EXIT. DTSCU351 +00924 EXIT. DTSCU351 +00925 DTSCU351 +00926 S071-FROM-LAST-NAME-FIRST. DTSCU351 +00927 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCU351 +00928 GO TO S071-FORMAT-NAME. DTSCU351 +00929 DTSCU351 +00930 S071-FORMAT-NAME. DTSCU351 +00931 EXEC CICS DTSCU351 +00932 LINK DTSCU351 +00933 PROGRAM ('MACCU071') DTSCU351 +00934 COMMAREA (L071-COMM-AREA) DTSCU351 +00935 LENGTH (L071-LENGTH) DTSCU351 +00936 END-EXEC. DTSCU351 +00937 S071-EXIT. DTSCU351 +00938 EXIT. DTSCU351 +00939 DTSCU351 +00940 S082-OP-ID. DTSCU351 +00941 EXEC CICS DTSCU351 +00942 LINK DTSCU351 +00943 PROGRAM ('MACCU082') DTSCU351 +00944 COMMAREA (L082-COMM-AREA) DTSCU351 +00945 LENGTH (L082-LENGTH) DTSCU351 +00946 END-EXEC. DTSCU351 +00947 S082-EXIT. DTSCU351 +00948 EXIT. DTSCU351 +00949 DTSCU351 +00950 S112-FORMAT-TAD. DTSCU351 +00951 SET L112-TAD-ADDR-88 TO TRUE. DTSCU351 +00952 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSCU351 +00953 IF MTAD-ID-NO = +1 DTSCU351 +00954 MOVE MPRF-BUSINESS-NAME TO L112-BUSINESS-NAME DTSCU351 +00955 ELSE DTSCU351 +00956 MOVE SPACES TO L112-BUSINESS-NAME. DTSCU351 +00957 MOVE MTAD-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND. DTSCU351 +00958 MOVE SPACES TO L112-NAME DTSCU351 +00959 L112-TITLE. DTSCU351 +00960 MOVE MTAD-ADDRESS TO L112-ADDRESS. DTSCU351 +00961 GO TO S112-FORMAT-ADDRESS. DTSCU351 +00962 DTSCU351 +00963 S112-FORMAT-OPO. DTSCU351 +00964 SET L112-OPO-ADDR-88 TO TRUE. DTSCU351 +00965 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSCU351 +00966 MOVE SPACES TO L112-BUSINESS-NAME. DTSCU351 +00967 MOVE MOPO-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND. DTSCU351 +00968 MOVE MOPO-NAME TO L112-NAME. DTSCU351 +00969 MOVE MOPO-TITLE TO L112-TITLE. DTSCU351 +00970 MOVE MOPO-ADDRESS TO L112-ADDRESS. DTSCU351 +00971 GO TO S112-FORMAT-ADDRESS. DTSCU351 +00972 DTSCU351 +00973 S112-FORMAT-ADDRESS. DTSCU351 +00974 EXEC CICS DTSCU351 +00975 LINK DTSCU351 +00976 PROGRAM ('MACCU112') DTSCU351 +00977 COMMAREA (L112-COMM-AREA) DTSCU351 +00978 LENGTH (L112-LENGTH) DTSCU351 +00979 END-EXEC. DTSCU351 +00980 S112-EXIT. DTSCU351 +00981 EXIT. DTSCU351 +00982 DTSCU351 +00983 S119-AGENCY-FACTS. DTSCU351 +00984 SET L119-REQ-CAPS-88 TO TRUE. DTSCU351 +00985 SET L119-REQ-NO-UNIT-88 TO TRUE. DTSCU351 +00986 EXEC CICS DTSCU351 +00987 LINK DTSCU351 +00988 PROGRAM ('MACCU119') DTSCU351 +00989 COMMAREA (L119-COMM-AREA) DTSCU351 +00990 LENGTH (L119-LENGTH) DTSCU351 +00991 END-EXEC. DTSCU351 +00992 S119-EXIT. DTSCU351 +00993 EXIT. DTSCU351 +00994 DTSCU351 +00995 S357-LINK-PRINT. DTSCU351 +00996 SET L357-EJECT-PAGE-88 TO TRUE. DTSCU351 +00997 DTSCU351 +00998 EXEC CICS DTSCU351 +00999 LINK DTSCU351 +01000 PROGRAM ('MACCU357') DTSCU351 +01001 COMMAREA (L357-COMM-AREA) DTSCU351 +01002 LENGTH (L357-LENGTH) DTSCU351 +01003 END-EXEC. DTSCU351 +01004 S357-EXIT. DTSCU351 +01005 EXIT. DTSCU351 +01006 DTSCU351 +01007 S810-START-BROWSE. DTSCU351 +01008 SET L810-START-BROWSE-88 TO TRUE DTSCU351 +01009 GO TO S810-MSTR-IO. DTSCU351 +01010 DTSCU351 +01011 S810-END-BROWSE. DTSCU351 +01012 SET L810-END-BROWSE-88 TO TRUE DTSCU351 +01013 GO TO S810-MSTR-IO. DTSCU351 +01014 DTSCU351 +01015 S810-READ-NEXT. DTSCU351 +01016 SET L810-READ-NEXT-88 TO TRUE DTSCU351 +01017 GO TO S810-MSTR-IO. DTSCU351 +01018 DTSCU351 +01019 S810-READ. DTSCU351 +01020 SET L810-READ-88 TO TRUE DTSCU351 +01021 GO TO S810-MSTR-IO. DTSCU351 +01022 DTSCU351 +01023 S810-MSTR-IO. DTSCU351 +01024 EXEC CICS DTSCU351 +01025 LINK DTSCU351 +01026 PROGRAM ('MACCU810') DTSCU351 +01027 COMMAREA (L810-COMM-AREA) DTSCU351 +01028 LENGTH (L810-LENGTH) DTSCU351 +01029 END-EXEC. DTSCU351 +01030 S810-EXIT. DTSCU351 +01031 EXIT. DTSCU351 +01032 DTSCU351 +01033 S829-DELETE-QUEUE. DTSCU351 +01034 DTSCU351 +01035 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCU351 +01036 GO TO S829-TS-IO. DTSCU351 +01037 DTSCU351 +01038 S829-WRITE-ITEM. DTSCU351 +01039 SET L829-WRITE-88 TO TRUE. DTSCU351 +01040 GO TO S829-TS-IO. DTSCU351 +01041 DTSCU351 +01042 S829-TS-IO. DTSCU351 +01043 EXEC CICS DTSCU351 +01044 LINK DTSCU351 +01045 PROGRAM ('MACCU829') DTSCU351 +01046 COMMAREA (L829-COMM-AREA) DTSCU351 +01047 LENGTH (L829-COMM-AREA-LENGTH) DTSCU351 +01048 END-EXEC. DTSCU351 +01049 S829-EXIT. DTSCU351 +01050 EXIT. DTSCU351 +01051 DTSCU351 +01052 S899-ABEND. DTSCU351 +01053 EXEC CICS DTSCU351 +01054 ABEND DTSCU351 +01055 ABCODE (WRK-ABEND-CODE) DTSCU351 +01056 END-EXEC. DTSCU351 +01057 S899-EXIT. DTSCU351 +01058 EXIT. DTSCU351 diff --git a/CICS/DTSCU415.cob b/CICS/DTSCU415.cob index e2c74de..b652c73 100644 --- a/CICS/DTSCU415.cob +++ b/CICS/DTSCU415.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 01/29/03 +00001 IDENTIFICATION DIVISION. 04/09/13 00002 PROGRAM-ID. DTSCU415. DTSCU415 -00003 AUTHOR. TRW. LV003 +00003 AUTHOR. TRW. LV002 00004 DATE-WRITTEN. OCTOBER 20001. DTSCU415 00005 DATE-COMPILED. DTSCU415 00006 DTSCU415 @@ -34,318 +34,319 @@ 00034 DATA DIVISION. DTSCU415 00035 SKIP3 DTSCU415 00036 WORKING-STORAGE SECTION. DTSCU415 -000365 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU415 01/29/03'. DTSCU415 -00037 SKIP3 DTSCU415 -00038 01 WRK-AREA. DTSCU415 -00039 05 WRK-ABEND-CODE PIC X(04) VALUE 'U415'. DTSCU415 -00040 DTSCU415 -00041 05 WRK-YR PIC S9(05) COMP-3. DTSCU415 -00042 05 WRK-FIRST-HSEHLD-YR PIC S9(05) COMP-3 DTSCU415 -00043 VALUE +2002. DTSCU415 -00044 DTSCU415 -00045 05 WRK-YRQ-AREA PIC 9(05). DTSCU415 -00046 05 FILLER REDEFINES WRK-YRQ-AREA. DTSCU415 -00047 10 WRK-YRQ-CCYY PIC 9(04). DTSCU415 -00048 10 WRK-YRQ-Q PIC 9(01). DTSCU415 -00049 DTSCU415 -00050 05 WRK-LAST-YRQ PIC 9(05). DTSCU415 -00051 05 FILLER REDEFINES WRK-LAST-YRQ. DTSCU415 -00052 10 WRK-LAST-YYYY PIC 9(04). DTSCU415 -00053 10 WRK-LAST-Q PIC 9(01). DTSCU415 -00054 DTSCU415 -00055 05 WRK-LAST-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCU415 -00056 05 WRK-LAST-MASS-MAIL-YR PIC S9(05) COMP-3. DTSCU415 -00057 05 WRK-LAST-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCU415 -00058 05 WRK-LAST-LATE-PEN-YR PIC S9(05) COMP-3. DTSCU415 -00059 05 WRK-LAST-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCU415 -00060 05 WRK-LAST-FIRST-DEL-YR PIC S9(05) COMP-3. DTSCU415 -00061 05 WRK-LAST-FINAL-DEL-DATE PIC S9(09) COMP-3. DTSCU415 -00062 05 WRK-LAST-FINAL-DEL-YR PIC S9(05) COMP-3. DTSCU415 -00063 05 WRK-LAST-FINAL-ACTION-DATE PIC S9(09) COMP-3. DTSCU415 -00064 DTSCU415 -00065 05 WRK-FAFD-FOUND-IND PIC X(01). DTSCU415 -00066 88 WRK-FAFD-FOUND-YES-88 VALUE 'Y'. DTSCU415 -00067 88 WRK-FAFD-FOUND-NO-88 VALUE 'N'. DTSCU415 -00068 DTSCU415 -00069 01 L831-COMM-AREA. DTSCU415 -00070 05 L831-CONTROL-BLOCK. DTSCU415 -00071 ++INCLUDE DTSIL831 DTSCU415 -00072 05 FSKL-REC. DTSCU415 -00073 ++INCLUDE DTSIFSKL DTSCU415 -00074 EJECT DTSCU415 -00075 05 FAFD-REC REDEFINES FSKL-REC. DTSCU415 -00076 ++INCLUDE DTSIFAFD DTSCU415 -00077 EJECT DTSCU415 -00078 LINKAGE SECTION. DTSCU415 -00079 SKIP3 DTSCU415 -00080 01 DFHCOMMAREA. DTSCU415 -00081 ++INCLUDE DTSIL415 DTSCU415 -00082 EJECT DTSCU415 -00083 PROCEDURE DIVISION. DTSCU415 -00084 SKIP2 DTSCU415 -00085 DTSCU400-MAINLINE. DTSCU415 -00086 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSCU415 -00087 DTSCU415 -00088 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU415 -00089 DTSCU415 -00090 DTSCU400-MAINLINE-EXIT. DTSCU415 -00091 EXEC CICS DTSCU415 -00092 RETURN DTSCU415 -00093 END-EXEC. DTSCU415 -00094 DTSCU415 -00095 EJECT DTSCU415 -00096 I0000-INITIALIZE. DTSCU415 -00097 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSCU415 -00098 DTSCU415 -00099 PERFORM I2000-INIT-RETURN THRU I2000-EXIT. DTSCU415 -00100 DTSCU415 -00101 I0000-EXIT. DTSCU415 -00102 EXIT. DTSCU415 -00103 I1000-EDIT-INPUT. DTSCU415 -00104 IF L415-MODE-INPUT-YEAR-88 DTSCU415 -00105 IF L415-YR NOT NUMERIC DTSCU415 -00106 PERFORM S899-ABEND THRU S899-EXIT DTSCU415 -00107 ELSE DTSCU415 -00108 MOVE L415-YR TO WRK-YR DTSCU415 -00109 ELSE DTSCU415 -00110 MOVE ZERO TO WRK-YR. DTSCU415 -00111 DTSCU415 -00112 I1000-EXIT. DTSCU415 -00113 EXIT. DTSCU415 -00114 DTSCU415 -00115 I2000-INIT-RETURN. DTSCU415 -00116 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE DTSCU415 -00117 L415-UC30H-MASS-MAIL-DATE DTSCU415 -00118 L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415 -00119 L415-UC30H-MASS-MAIL-END-YRQ DTSCU415 -00120 L415-UC30H-LATE-PEN-DATE DTSCU415 -00121 L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415 -00122 L415-UC30H-LATE-PEN-END-YRQ DTSCU415 -00123 L415-UC30H-FIRST-DEL-DATE DTSCU415 -00124 L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415 -00125 L415-UC30H-FIRST-DEL-END-YRQ DTSCU415 -00126 L415-UC30H-FINAL-DEL-DATE DTSCU415 -00127 L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415 -00128 L415-UC30H-FINAL-DEL-END-YRQ DTSCU415 -00129 L415-UC30H-FINAL-ACTION-DATE DTSCU415 -00130 WRK-LAST-MASS-MAIL-DATE DTSCU415 -00131 WRK-LAST-MASS-MAIL-YR DTSCU415 -00132 WRK-LAST-LATE-PEN-DATE DTSCU415 -00133 WRK-LAST-LATE-PEN-YR DTSCU415 -00134 WRK-LAST-FIRST-DEL-DATE DTSCU415 -00135 WRK-LAST-FIRST-DEL-YR DTSCU415 -00136 WRK-LAST-FINAL-DEL-DATE DTSCU415 -00137 WRK-LAST-FINAL-DEL-YR DTSCU415 -00138 WRK-LAST-FINAL-ACTION-DATE. DTSCU415 -00139 DTSCU415 +000365 77 PAN-VALET PICTURE X(24) VALUE '002DTSCU415 04/09/13'. DTSCU415 +00037 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU415 01/29/03'. DTSCU415 +00038 SKIP3 DTSCU415 +00039 01 WRK-AREA. DTSCU415 +00040 05 WRK-ABEND-CODE PIC X(04) VALUE 'U415'. DTSCU415 +00041 DTSCU415 +00042 05 WRK-YR PIC S9(05) COMP-3. DTSCU415 +00043 05 WRK-FIRST-HSEHLD-YR PIC S9(05) COMP-3 DTSCU415 +00044 VALUE +2002. DTSCU415 +00045 DTSCU415 +00046 05 WRK-YRQ-AREA PIC 9(05). DTSCU415 +00047 05 FILLER REDEFINES WRK-YRQ-AREA. DTSCU415 +00048 10 WRK-YRQ-CCYY PIC 9(04). DTSCU415 +00049 10 WRK-YRQ-Q PIC 9(01). DTSCU415 +00050 DTSCU415 +00051 05 WRK-LAST-YRQ PIC 9(05). DTSCU415 +00052 05 FILLER REDEFINES WRK-LAST-YRQ. DTSCU415 +00053 10 WRK-LAST-YYYY PIC 9(04). DTSCU415 +00054 10 WRK-LAST-Q PIC 9(01). DTSCU415 +00055 DTSCU415 +00056 05 WRK-LAST-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCU415 +00057 05 WRK-LAST-MASS-MAIL-YR PIC S9(05) COMP-3. DTSCU415 +00058 05 WRK-LAST-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCU415 +00059 05 WRK-LAST-LATE-PEN-YR PIC S9(05) COMP-3. DTSCU415 +00060 05 WRK-LAST-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCU415 +00061 05 WRK-LAST-FIRST-DEL-YR PIC S9(05) COMP-3. DTSCU415 +00062 05 WRK-LAST-ESTIMATED-DATE PIC S9(09) COMP-3. CL**2 +00063 05 WRK-LAST-FINAL-DEL-YR PIC S9(05) COMP-3. DTSCU415 +00064 05 WRK-LAST-FINAL-ACTION-DATE PIC S9(09) COMP-3. DTSCU415 +00065 DTSCU415 +00066 05 WRK-FAFD-FOUND-IND PIC X(01). DTSCU415 +00067 88 WRK-FAFD-FOUND-YES-88 VALUE 'Y'. DTSCU415 +00068 88 WRK-FAFD-FOUND-NO-88 VALUE 'N'. DTSCU415 +00069 DTSCU415 +00070 01 L831-COMM-AREA. DTSCU415 +00071 05 L831-CONTROL-BLOCK. DTSCU415 +00072 ++INCLUDE DTSIL831 DTSCU415 +00073 05 FSKL-REC. DTSCU415 +00074 ++INCLUDE DTSIFSKL DTSCU415 +00075 EJECT DTSCU415 +00076 05 FAFD-REC REDEFINES FSKL-REC. DTSCU415 +00077 ++INCLUDE DTSIFAFD DTSCU415 +00078 EJECT DTSCU415 +00079 LINKAGE SECTION. DTSCU415 +00080 SKIP3 DTSCU415 +00081 01 DFHCOMMAREA. DTSCU415 +00082 ++INCLUDE DTSIL415 DTSCU415 +00083 EJECT DTSCU415 +00084 PROCEDURE DIVISION. DTSCU415 +00085 SKIP2 DTSCU415 +00086 DTSCU400-MAINLINE. DTSCU415 +00087 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSCU415 +00088 DTSCU415 +00089 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU415 +00090 DTSCU415 +00091 DTSCU400-MAINLINE-EXIT. DTSCU415 +00092 EXEC CICS DTSCU415 +00093 RETURN DTSCU415 +00094 END-EXEC. DTSCU415 +00095 DTSCU415 +00096 EJECT DTSCU415 +00097 I0000-INITIALIZE. DTSCU415 +00098 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSCU415 +00099 DTSCU415 +00100 PERFORM I2000-INIT-RETURN THRU I2000-EXIT. DTSCU415 +00101 DTSCU415 +00102 I0000-EXIT. DTSCU415 +00103 EXIT. DTSCU415 +00104 I1000-EDIT-INPUT. DTSCU415 +00105 IF L415-MODE-INPUT-YEAR-88 DTSCU415 +00106 IF L415-YR NOT NUMERIC DTSCU415 +00107 PERFORM S899-ABEND THRU S899-EXIT DTSCU415 +00108 ELSE DTSCU415 +00109 MOVE L415-YR TO WRK-YR DTSCU415 +00110 ELSE DTSCU415 +00111 MOVE ZERO TO WRK-YR. DTSCU415 +00112 DTSCU415 +00113 I1000-EXIT. DTSCU415 +00114 EXIT. DTSCU415 +00115 DTSCU415 +00116 I2000-INIT-RETURN. DTSCU415 +00117 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE DTSCU415 +00118 L415-UC30H-MASS-MAIL-DATE DTSCU415 +00119 L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415 +00120 L415-UC30H-MASS-MAIL-END-YRQ DTSCU415 +00121 L415-UC30H-LATE-PEN-DATE DTSCU415 +00122 L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415 +00123 L415-UC30H-LATE-PEN-END-YRQ DTSCU415 +00124 L415-UC30H-FIRST-DEL-DATE DTSCU415 +00125 L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415 +00126 L415-UC30H-FIRST-DEL-END-YRQ DTSCU415 +00127 L415-UC30H-ESTIMATED-DATE CL**2 +00128 L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415 +00129 L415-UC30H-FINAL-DEL-END-YRQ DTSCU415 +00130 L415-UC30H-FINAL-ACTION-DATE DTSCU415 +00131 WRK-LAST-MASS-MAIL-DATE DTSCU415 +00132 WRK-LAST-MASS-MAIL-YR DTSCU415 +00133 WRK-LAST-LATE-PEN-DATE DTSCU415 +00134 WRK-LAST-LATE-PEN-YR DTSCU415 +00135 WRK-LAST-FIRST-DEL-DATE DTSCU415 +00136 WRK-LAST-FIRST-DEL-YR DTSCU415 +00137 WRK-LAST-ESTIMATED-DATE CL**2 +00138 WRK-LAST-FINAL-DEL-YR DTSCU415 +00139 WRK-LAST-FINAL-ACTION-DATE. DTSCU415 00140 DTSCU415 -00141 I2000-EXIT. DTSCU415 -00142 EXIT. DTSCU415 -00143 DTSCU415 -00144 P0000-PROCESS. DTSCU415 -00145 SET L415-NOT-FOUND-88 TO TRUE. DTSCU415 -00146 DTSCU415 -00147 IF L415-MODE-INPUT-YEAR-88 DTSCU415 -00148 PERFORM P1000-INPUT-YEAR THRU P1000-EXIT DTSCU415 -00149 IF L415-OK-88 DTSCU415 -00150 PERFORM P1100-RETURN-VALUES THRU P1100-EXIT DTSCU415 -00151 END-IF DTSCU415 -00152 ELSE DTSCU415 -00153 PERFORM P2000-MOST-RECENT THRU P2000-EXIT DTSCU415 -00154 PERFORM P2200-RETURN-VALUES THRU P2200-EXIT. DTSCU415 -00155 DTSCU415 -00156 P0000-EXIT. DTSCU415 -00157 EXIT. DTSCU415 -00158 DTSCU415 -00159 P1000-INPUT-YEAR. DTSCU415 -00160 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415 -00161 MOVE WRK-YR TO FAFD-YR. DTSCU415 -00162 SET FAFD-AFD-88 TO TRUE. DTSCU415 -00163 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415 -00164 PERFORM S831-READ THRU S831-EXIT. DTSCU415 -00165 IF L831-NO-REC-88 DTSCU415 -00166 NEXT SENTENCE DTSCU415 -00167 ELSE DTSCU415 -00168 MOVE FSKL-REC TO FAFD-REC DTSCU415 -00169 SET L415-OK-88 TO TRUE. DTSCU415 -00170 DTSCU415 -00171 P1000-EXIT. DTSCU415 -00172 EXIT. DTSCU415 -00173 DTSCU415 -00174 P1100-RETURN-VALUES. DTSCU415 -00175 MOVE FAFD-UC30H-RPT-DUE-DATE DTSCU415 -00176 TO L415-UC30H-RPT-DUE-DATE. DTSCU415 -00177 DTSCU415 -00178 MOVE FAFD-UC30H-MASS-MAIL-DATE DTSCU415 -00179 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415 -00180 MOVE FAFD-YR TO WRK-LAST-YYYY. DTSCU415 -00181 MOVE 1 TO WRK-LAST-Q. DTSCU415 -00182 MOVE WRK-LAST-YRQ DTSCU415 -00183 TO L415-UC30H-MASS-MAIL-STRT-YRQ. DTSCU415 -00184 MOVE 4 TO WRK-LAST-Q. DTSCU415 -00185 MOVE WRK-LAST-YRQ DTSCU415 -00186 TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415 -00187 DTSCU415 -00188 MOVE FAFD-LATE-PEN-ASSESSED-DATE DTSCU415 -00189 TO L415-UC30H-LATE-PEN-DATE. DTSCU415 -00190 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415 -00191 MOVE 1 TO WRK-LAST-Q. DTSCU415 -00192 MOVE WRK-LAST-YRQ DTSCU415 -00193 TO L415-UC30H-LATE-PEN-STRT-YRQ. DTSCU415 -00194 MOVE 4 TO WRK-LAST-Q. DTSCU415 -00195 MOVE WRK-LAST-YRQ DTSCU415 -00196 TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415 -00197 DTSCU415 -00198 MOVE FAFD-UC30H-FIRST-DEL-DATE DTSCU415 -00199 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415 -00200 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415 -00201 MOVE 1 TO WRK-LAST-Q. DTSCU415 -00202 MOVE WRK-LAST-YRQ DTSCU415 -00203 TO L415-UC30H-FIRST-DEL-STRT-YRQ. DTSCU415 -00204 MOVE 4 TO WRK-LAST-Q. DTSCU415 -00205 MOVE WRK-LAST-YRQ DTSCU415 -00206 TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415 -00207 DTSCU415 -00208 MOVE FAFD-UC30H-FINAL-DEL-DATE DTSCU415 -00209 TO L415-UC30H-FINAL-DEL-DATE. DTSCU415 -00210 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415 -00211 MOVE 1 TO WRK-LAST-Q. DTSCU415 -00212 MOVE WRK-LAST-YRQ DTSCU415 -00213 TO L415-UC30H-FINAL-DEL-STRT-YRQ. DTSCU415 -00214 MOVE 4 TO WRK-LAST-Q. DTSCU415 -00215 MOVE WRK-LAST-YRQ DTSCU415 -00216 TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415 -00217 DTSCU415 -00218 MOVE FAFD-UC30H-FINAL-ACTION-DATE DTSCU415 -00219 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415 -00220 DTSCU415 -00221 P1100-EXIT. DTSCU415 -00222 EXIT. DTSCU415 -00223 DTSCU415 -00224 P2000-MOST-RECENT. DTSCU415 -00225 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415 -00226 SET FAFD-AFD-88 TO TRUE. DTSCU415 -00227 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415 -00228 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCU415 -00229 IF L831-OK-88 DTSCU415 -00230 SET L415-OK-88 TO TRUE DTSCU415 -00231 PERFORM P2100-SCAN-FAFD THRU P2100-EXIT DTSCU415 -00232 UNTIL L831-NO-REC-88. DTSCU415 -00233 DTSCU415 -00234 P2000-EXIT. DTSCU415 -00235 EXIT. DTSCU415 -00236 DTSCU415 -00237 P2100-SCAN-FAFD. DTSCU415 -00238 MOVE FSKL-REC TO FAFD-REC. DTSCU415 -00239 DTSCU415 -00240 IF FAFD-UC30H-MASS-MAIL-DATE > DTSCU415 -00241 WRK-LAST-MASS-MAIL-DATE DTSCU415 -00242 MOVE FAFD-UC30H-MASS-MAIL-DATE TO DTSCU415 -00243 WRK-LAST-MASS-MAIL-DATE DTSCU415 -00244 MOVE FAFD-YR TO WRK-LAST-MASS-MAIL-YR. DTSCU415 -00245 DTSCU415 -00246 IF FAFD-LATE-PEN-ASSESSED-DATE > DTSCU415 -00247 WRK-LAST-LATE-PEN-DATE DTSCU415 -00248 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO DTSCU415 -00249 WRK-LAST-LATE-PEN-DATE DTSCU415 -00250 MOVE FAFD-YR TO WRK-LAST-LATE-PEN-YR. DTSCU415 -00251 DTSCU415 -00252 IF FAFD-UC30H-FIRST-DEL-DATE > DTSCU415 -00253 WRK-LAST-FIRST-DEL-DATE DTSCU415 -00254 MOVE FAFD-UC30H-FIRST-DEL-DATE TO DTSCU415 -00255 WRK-LAST-FIRST-DEL-DATE DTSCU415 -00256 MOVE FAFD-YR TO WRK-LAST-FIRST-DEL-YR. DTSCU415 -00257 DTSCU415 -00258 IF FAFD-UC30H-FINAL-DEL-DATE > DTSCU415 -00259 WRK-LAST-FINAL-DEL-DATE DTSCU415 -00260 MOVE FAFD-UC30H-FINAL-DEL-DATE TO DTSCU415 -00261 WRK-LAST-FINAL-DEL-DATE DTSCU415 -00262 MOVE FAFD-YR TO WRK-LAST-FINAL-DEL-YR. DTSCU415 -00263 DTSCU415 -00264 IF FAFD-UC30H-FINAL-ACTION-DATE > DTSCU415 -00265 WRK-LAST-FINAL-ACTION-DATE DTSCU415 -00266 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO DTSCU415 -00267 WRK-LAST-FINAL-ACTION-DATE. DTSCU415 -00268 DTSCU415 -00269 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCU415 -00270 DTSCU415 -00271 P2100-EXIT. DTSCU415 -00272 EXIT. DTSCU415 -00273 DTSCU415 -00274 P2200-RETURN-VALUES. DTSCU415 -00275 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE. DTSCU415 -00276 DTSCU415 -00277 MOVE WRK-LAST-MASS-MAIL-DATE DTSCU415 -00278 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415 -00279 IF WRK-LAST-MASS-MAIL-YR > 0 DTSCU415 -00280 MOVE WRK-LAST-MASS-MAIL-YR DTSCU415 -00281 TO WRK-LAST-YYYY DTSCU415 -00282 MOVE 1 TO WRK-LAST-Q DTSCU415 -00283 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415 -00284 MOVE 4 TO WRK-LAST-Q DTSCU415 -00285 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415 -00286 DTSCU415 -00287 MOVE WRK-LAST-LATE-PEN-DATE DTSCU415 -00288 TO L415-UC30H-LATE-PEN-DATE. DTSCU415 -00289 IF WRK-LAST-LATE-PEN-YR > 0 DTSCU415 -00290 MOVE WRK-LAST-LATE-PEN-YR DTSCU415 -00291 TO WRK-LAST-YYYY DTSCU415 -00292 MOVE 1 TO WRK-LAST-Q DTSCU415 -00293 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415 -00294 MOVE 4 TO WRK-LAST-Q DTSCU415 -00295 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415 -00296 DTSCU415 -00297 MOVE WRK-LAST-FIRST-DEL-DATE DTSCU415 -00298 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415 -00299 IF WRK-LAST-FIRST-DEL-YR > 0 DTSCU415 -00300 MOVE WRK-LAST-FIRST-DEL-YR DTSCU415 -00301 TO WRK-LAST-YYYY DTSCU415 -00302 MOVE 1 TO WRK-LAST-Q DTSCU415 -00303 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415 -00304 MOVE 4 TO WRK-LAST-Q DTSCU415 -00305 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415 -00306 DTSCU415 -00307 MOVE WRK-LAST-FINAL-DEL-DATE DTSCU415 -00308 TO L415-UC30H-FINAL-DEL-DATE. DTSCU415 -00309 IF WRK-LAST-FINAL-DEL-YR > 0 DTSCU415 -00310 MOVE WRK-LAST-FINAL-DEL-YR DTSCU415 -00311 TO WRK-LAST-YYYY DTSCU415 -00312 MOVE 1 TO WRK-LAST-Q DTSCU415 -00313 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415 -00314 MOVE 4 TO WRK-LAST-Q DTSCU415 -00315 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415 -00316 DTSCU415 -00317 MOVE WRK-LAST-FINAL-ACTION-DATE DTSCU415 -00318 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415 -00319 DTSCU415 -00320 P2200-EXIT. DTSCU415 -00321 EXIT. DTSCU415 -00322 DTSCU415 -00323 S831-READ. DTSCU415 -00324 SET L831-READ-88 TO TRUE. DTSCU415 -00325 GO TO S831-REF-IO. DTSCU415 -00326 DTSCU415 -00327 S831-START-BROWSE. DTSCU415 -00328 SET L831-START-BROWSE-88 TO TRUE. DTSCU415 -00329 GO TO S831-REF-IO. DTSCU415 -00330 DTSCU415 -00331 S831-READ-NEXT. DTSCU415 -00332 SET L831-READ-NEXT-88 TO TRUE. DTSCU415 -00333 GO TO S831-REF-IO. DTSCU415 -00334 DTSCU415 -00335 S831-REF-IO. DTSCU415 -00336 EXEC CICS LINK DTSCU415 -00337 PROGRAM ('DTSCU831') DTSCU415 -00338 COMMAREA (L831-COMM-AREA) DTSCU415 -00339 END-EXEC. DTSCU415 -00340 SKIP1 DTSCU415 -00341 S831-EXIT. DTSCU415 -00342 EXIT. DTSCU415 -00343 DTSCU415 -00344 S899-ABEND. DTSCU415 -00345 EXEC CICS ABEND DTSCU415 -00346 ABCODE(WRK-ABEND-CODE) DTSCU415 -00347 END-EXEC. DTSCU415 -00348 DTSCU415 -00349 S899-EXIT. DTSCU415 -00350 EXIT. DTSCU415 +00141 DTSCU415 +00142 I2000-EXIT. DTSCU415 +00143 EXIT. DTSCU415 +00144 DTSCU415 +00145 P0000-PROCESS. DTSCU415 +00146 SET L415-NOT-FOUND-88 TO TRUE. DTSCU415 +00147 DTSCU415 +00148 IF L415-MODE-INPUT-YEAR-88 DTSCU415 +00149 PERFORM P1000-INPUT-YEAR THRU P1000-EXIT DTSCU415 +00150 IF L415-OK-88 DTSCU415 +00151 PERFORM P1100-RETURN-VALUES THRU P1100-EXIT DTSCU415 +00152 END-IF DTSCU415 +00153 ELSE DTSCU415 +00154 PERFORM P2000-MOST-RECENT THRU P2000-EXIT DTSCU415 +00155 PERFORM P2200-RETURN-VALUES THRU P2200-EXIT. DTSCU415 +00156 DTSCU415 +00157 P0000-EXIT. DTSCU415 +00158 EXIT. DTSCU415 +00159 DTSCU415 +00160 P1000-INPUT-YEAR. DTSCU415 +00161 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415 +00162 MOVE WRK-YR TO FAFD-YR. DTSCU415 +00163 SET FAFD-AFD-88 TO TRUE. DTSCU415 +00164 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415 +00165 PERFORM S831-READ THRU S831-EXIT. DTSCU415 +00166 IF L831-NO-REC-88 DTSCU415 +00167 NEXT SENTENCE DTSCU415 +00168 ELSE DTSCU415 +00169 MOVE FSKL-REC TO FAFD-REC DTSCU415 +00170 SET L415-OK-88 TO TRUE. DTSCU415 +00171 DTSCU415 +00172 P1000-EXIT. DTSCU415 +00173 EXIT. DTSCU415 +00174 DTSCU415 +00175 P1100-RETURN-VALUES. DTSCU415 +00176 MOVE FAFD-UC30H-RPT-DUE-DATE DTSCU415 +00177 TO L415-UC30H-RPT-DUE-DATE. DTSCU415 +00178 DTSCU415 +00179 MOVE FAFD-UC30H-MASS-MAIL-DATE DTSCU415 +00180 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415 +00181 MOVE FAFD-YR TO WRK-LAST-YYYY. DTSCU415 +00182 MOVE 1 TO WRK-LAST-Q. DTSCU415 +00183 MOVE WRK-LAST-YRQ DTSCU415 +00184 TO L415-UC30H-MASS-MAIL-STRT-YRQ. DTSCU415 +00185 MOVE 4 TO WRK-LAST-Q. DTSCU415 +00186 MOVE WRK-LAST-YRQ DTSCU415 +00187 TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415 +00188 DTSCU415 +00189 MOVE FAFD-LATE-PEN-ASSESSED-DATE DTSCU415 +00190 TO L415-UC30H-LATE-PEN-DATE. DTSCU415 +00191 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415 +00192 MOVE 1 TO WRK-LAST-Q. DTSCU415 +00193 MOVE WRK-LAST-YRQ DTSCU415 +00194 TO L415-UC30H-LATE-PEN-STRT-YRQ. DTSCU415 +00195 MOVE 4 TO WRK-LAST-Q. DTSCU415 +00196 MOVE WRK-LAST-YRQ DTSCU415 +00197 TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415 +00198 DTSCU415 +00199 MOVE FAFD-UC30H-FIRST-DEL-DATE DTSCU415 +00200 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415 +00201 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415 +00202 MOVE 1 TO WRK-LAST-Q. DTSCU415 +00203 MOVE WRK-LAST-YRQ DTSCU415 +00204 TO L415-UC30H-FIRST-DEL-STRT-YRQ. DTSCU415 +00205 MOVE 4 TO WRK-LAST-Q. DTSCU415 +00206 MOVE WRK-LAST-YRQ DTSCU415 +00207 TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415 +00208 DTSCU415 +00209 MOVE FAFD-UC30H-ESTIMATED-DATE CL**2 +00210 TO L415-UC30H-ESTIMATED-DATE. CL**2 +00211 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415 +00212 MOVE 1 TO WRK-LAST-Q. DTSCU415 +00213 MOVE WRK-LAST-YRQ DTSCU415 +00214 TO L415-UC30H-FINAL-DEL-STRT-YRQ. DTSCU415 +00215 MOVE 4 TO WRK-LAST-Q. DTSCU415 +00216 MOVE WRK-LAST-YRQ DTSCU415 +00217 TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415 +00218 DTSCU415 +00219 MOVE FAFD-UC30H-FINAL-ACTION-DATE DTSCU415 +00220 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415 +00221 DTSCU415 +00222 P1100-EXIT. DTSCU415 +00223 EXIT. DTSCU415 +00224 DTSCU415 +00225 P2000-MOST-RECENT. DTSCU415 +00226 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415 +00227 SET FAFD-AFD-88 TO TRUE. DTSCU415 +00228 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415 +00229 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCU415 +00230 IF L831-OK-88 DTSCU415 +00231 SET L415-OK-88 TO TRUE DTSCU415 +00232 PERFORM P2100-SCAN-FAFD THRU P2100-EXIT DTSCU415 +00233 UNTIL L831-NO-REC-88. DTSCU415 +00234 DTSCU415 +00235 P2000-EXIT. DTSCU415 +00236 EXIT. DTSCU415 +00237 DTSCU415 +00238 P2100-SCAN-FAFD. DTSCU415 +00239 MOVE FSKL-REC TO FAFD-REC. DTSCU415 +00240 DTSCU415 +00241 IF FAFD-UC30H-MASS-MAIL-DATE > DTSCU415 +00242 WRK-LAST-MASS-MAIL-DATE DTSCU415 +00243 MOVE FAFD-UC30H-MASS-MAIL-DATE TO DTSCU415 +00244 WRK-LAST-MASS-MAIL-DATE DTSCU415 +00245 MOVE FAFD-YR TO WRK-LAST-MASS-MAIL-YR. DTSCU415 +00246 DTSCU415 +00247 IF FAFD-LATE-PEN-ASSESSED-DATE > DTSCU415 +00248 WRK-LAST-LATE-PEN-DATE DTSCU415 +00249 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO DTSCU415 +00250 WRK-LAST-LATE-PEN-DATE DTSCU415 +00251 MOVE FAFD-YR TO WRK-LAST-LATE-PEN-YR. DTSCU415 +00252 DTSCU415 +00253 IF FAFD-UC30H-FIRST-DEL-DATE > DTSCU415 +00254 WRK-LAST-FIRST-DEL-DATE DTSCU415 +00255 MOVE FAFD-UC30H-FIRST-DEL-DATE TO DTSCU415 +00256 WRK-LAST-FIRST-DEL-DATE DTSCU415 +00257 MOVE FAFD-YR TO WRK-LAST-FIRST-DEL-YR. DTSCU415 +00258 DTSCU415 +00259 IF FAFD-UC30H-ESTIMATED-DATE > CL**2 +00260 WRK-LAST-ESTIMATED-DATE CL**2 +00261 MOVE FAFD-UC30H-ESTIMATED-DATE TO CL**2 +00262 WRK-LAST-ESTIMATED-DATE CL**2 +00263 MOVE FAFD-YR TO WRK-LAST-FINAL-DEL-YR. DTSCU415 +00264 DTSCU415 +00265 IF FAFD-UC30H-FINAL-ACTION-DATE > DTSCU415 +00266 WRK-LAST-FINAL-ACTION-DATE DTSCU415 +00267 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO DTSCU415 +00268 WRK-LAST-FINAL-ACTION-DATE. DTSCU415 +00269 DTSCU415 +00270 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCU415 +00271 DTSCU415 +00272 P2100-EXIT. DTSCU415 +00273 EXIT. DTSCU415 +00274 DTSCU415 +00275 P2200-RETURN-VALUES. DTSCU415 +00276 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE. DTSCU415 +00277 DTSCU415 +00278 MOVE WRK-LAST-MASS-MAIL-DATE DTSCU415 +00279 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415 +00280 IF WRK-LAST-MASS-MAIL-YR > 0 DTSCU415 +00281 MOVE WRK-LAST-MASS-MAIL-YR DTSCU415 +00282 TO WRK-LAST-YYYY DTSCU415 +00283 MOVE 1 TO WRK-LAST-Q DTSCU415 +00284 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415 +00285 MOVE 4 TO WRK-LAST-Q DTSCU415 +00286 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415 +00287 DTSCU415 +00288 MOVE WRK-LAST-LATE-PEN-DATE DTSCU415 +00289 TO L415-UC30H-LATE-PEN-DATE. DTSCU415 +00290 IF WRK-LAST-LATE-PEN-YR > 0 DTSCU415 +00291 MOVE WRK-LAST-LATE-PEN-YR DTSCU415 +00292 TO WRK-LAST-YYYY DTSCU415 +00293 MOVE 1 TO WRK-LAST-Q DTSCU415 +00294 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415 +00295 MOVE 4 TO WRK-LAST-Q DTSCU415 +00296 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415 +00297 DTSCU415 +00298 MOVE WRK-LAST-FIRST-DEL-DATE DTSCU415 +00299 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415 +00300 IF WRK-LAST-FIRST-DEL-YR > 0 DTSCU415 +00301 MOVE WRK-LAST-FIRST-DEL-YR DTSCU415 +00302 TO WRK-LAST-YYYY DTSCU415 +00303 MOVE 1 TO WRK-LAST-Q DTSCU415 +00304 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415 +00305 MOVE 4 TO WRK-LAST-Q DTSCU415 +00306 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415 +00307 DTSCU415 +00308 MOVE WRK-LAST-ESTIMATED-DATE CL**2 +00309 TO L415-UC30H-ESTIMATED-DATE. CL**2 +00310 IF WRK-LAST-FINAL-DEL-YR > 0 DTSCU415 +00311 MOVE WRK-LAST-FINAL-DEL-YR DTSCU415 +00312 TO WRK-LAST-YYYY DTSCU415 +00313 MOVE 1 TO WRK-LAST-Q DTSCU415 +00314 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415 +00315 MOVE 4 TO WRK-LAST-Q DTSCU415 +00316 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415 +00317 DTSCU415 +00318 MOVE WRK-LAST-FINAL-ACTION-DATE DTSCU415 +00319 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415 +00320 DTSCU415 +00321 P2200-EXIT. DTSCU415 +00322 EXIT. DTSCU415 +00323 DTSCU415 +00324 S831-READ. DTSCU415 +00325 SET L831-READ-88 TO TRUE. DTSCU415 +00326 GO TO S831-REF-IO. DTSCU415 +00327 DTSCU415 +00328 S831-START-BROWSE. DTSCU415 +00329 SET L831-START-BROWSE-88 TO TRUE. DTSCU415 +00330 GO TO S831-REF-IO. DTSCU415 +00331 DTSCU415 +00332 S831-READ-NEXT. DTSCU415 +00333 SET L831-READ-NEXT-88 TO TRUE. DTSCU415 +00334 GO TO S831-REF-IO. DTSCU415 +00335 DTSCU415 +00336 S831-REF-IO. DTSCU415 +00337 EXEC CICS LINK DTSCU415 +00338 PROGRAM ('DTSCU831') DTSCU415 +00339 COMMAREA (L831-COMM-AREA) DTSCU415 +00340 END-EXEC. DTSCU415 +00341 SKIP1 DTSCU415 +00342 S831-EXIT. DTSCU415 +00343 EXIT. DTSCU415 +00344 DTSCU415 +00345 S899-ABEND. DTSCU415 +00346 EXEC CICS ABEND DTSCU415 +00347 ABCODE(WRK-ABEND-CODE) DTSCU415 +00348 END-EXEC. DTSCU415 +00349 DTSCU415 +00350 S899-EXIT. DTSCU415 +00351 EXIT. DTSCU415 diff --git a/CICS/DTSIS76.cob b/CICS/DTSIS76.cob deleted file mode 100644 index 3fe84d0..0000000 --- a/CICS/DTSIS76.cob +++ /dev/null @@ -1,264 +0,0 @@ -00001 ***** 11/14/05 -00002 * DTSSIS76 MISCELLANEOUS BATCH PRINT REQUESTS DTSIS76 -00003 * SEND/RECEIVE AREA LV011 -00004 ***** DTSIS76 -00005 10 FILLER PIC X(12). DTSIS76 -00006 DTSIS76 -00007 10 MAP-SCR-TYPE-AREA. DTSIS76 -00008 15 MAP-SCR-TYPE-L PIC S9(04) COMP. DTSIS76 -00009 15 MAP-SCR-TYPE-A PIC X(01). DTSIS76 -00010 15 MAP-SCR-TYPE PIC X(02). DTSIS76 -00011 DTSIS76 -00012 10 MAP-CICS-REGION-NAME-AREA. DTSIS76 -00013 15 MAP-CICS-REGION-NAME-L PIC S9(04) COMP. DTSIS76 -00014 15 MAP-CICS-REGION-NAME-A PIC X(01). DTSIS76 -00015 15 MAP-CICS-REGION-NAME PIC X(08). DTSIS76 -00016 DTSIS76 -00017 10 MAP-SYS-DATE-AREA. DTSIS76 -00018 15 MAP-SYS-DATE-L PIC S9(04) COMP. DTSIS76 -00019 15 MAP-SYS-DATE-A PIC X(01). DTSIS76 -00020 15 MAP-SYS-DATE PIC X(08). DTSIS76 -00021 DTSIS76 -00022 10 MAP-SYS-TIME-AREA. DTSIS76 -00023 15 MAP-SYS-TIME-L PIC S9(04) COMP. DTSIS76 -00024 15 MAP-SYS-TIME-A PIC X(01). DTSIS76 -00025 15 MAP-SYS-TIME PIC X(08). DTSIS76 -00026 DTSIS76 -00027 10 MAP-EMP-NO-AREA. DTSIS76 -00028 15 F760312. DTSIS76 -00029 20 MAP-EMP-NO-1-L PIC S9(04) COMP. DTSIS76 -00030 20 MAP-EMP-NO-1-A PIC X(01). DTSIS76 -00031 20 MAP-EMP-NO-1 PIC X(03). DTSIS76 -00032 15 F760316. DTSIS76 -00033 20 MAP-EMP-NO-2-L PIC S9(04) COMP. DTSIS76 -00034 20 MAP-EMP-NO-2-A PIC X(01). DTSIS76 -00035 20 MAP-EMP-NO-2 PIC X(03). DTSIS76 -00036 DTSIS76 -00037 10 F760323. DTSIS76 -00038 15 MAP-PRIMARY-NAME-L PIC S9(04) COMP. DTSIS76 -00039 15 MAP-PRIMARY-NAME-A PIC X(01). DTSIS76 -00040 15 MAP-PRIMARY-NAME PIC X(40). DTSIS76 -00041 DTSIS76 -00042 10 MAP-MAILING-LABELS-AREA. DTSIS76 -00043 15 MAP-MAILING-LABELS-L PIC S9(04) COMP. DTSIS76 -00044 15 MAP-MAILING-LABELS-A PIC X(01). DTSIS76 -00045 15 MAP-MAILING-LABELS PIC X(02). DTSIS76 -00046 15 MAP-MAILING-LABELS-N REDEFINES DTSIS76 -00047 MAP-MAILING-LABELS PIC ZZ. DTSIS76 -00048 DTSIS76 -00049 10 MAP-FROM-YRQ-AREA. DTSIS76 -00050 15 MAP-FROM-YRQ-YR-L PIC S9(04) COMP. DTSIS76 -00051 15 MAP-FROM-YRQ-YR-A PIC X(01). DTSIS76 -00052 15 MAP-FROM-YRQ-YR PIC X(02). DTSIS76 -00053 DTSIS76 -00054 15 MAP-FROM-YRQ-Q-L PIC S9(04) COMP. DTSIS76 -00055 15 MAP-FROM-YRQ-Q-A PIC X(01). DTSIS76 -00056 15 MAP-FROM-YRQ-Q PIC X(01). DTSIS76 -00057 DTSIS76 -00058 10 MAP-TO-YRQ-AREA. DTSIS76 -00059 15 MAP-TO-YRQ-YR-L PIC S9(04) COMP. DTSIS76 -00060 15 MAP-TO-YRQ-YR-A PIC X(01). DTSIS76 -00061 15 MAP-TO-YRQ-YR PIC X(02). DTSIS76 -00062 DTSIS76 -00063 15 MAP-TO-YRQ-Q-L PIC S9(04) COMP. DTSIS76 -00064 15 MAP-TO-YRQ-Q-A PIC X(01). DTSIS76 -00065 15 MAP-TO-YRQ-Q PIC X(01). DTSIS76 -00066 DTSIS76 -00067 10 MAP-FORCE-PRINT-AREA. DTSIS76 -00068 15 MAP-FORCE-PRINT-L PIC S9(04) COMP. DTSIS76 -00069 15 MAP-FORCE-PRINT-A PIC X(01). DTSIS76 -00070 15 MAP-FORCE-PRINT PIC X(01). DTSIS76 -00071 88 MAP-FORCE-PRINT-NO VALUE 'N'. DTSIS76 -00072 88 MAP-FORCE-PRINT-YES VALUE 'Y'. DTSIS76 -00073 88 MAP-FORCE-PRINT-VALID VALUE 'Y' 'N'. DTSIS76 -00074 DTSIS76 -00075 10 MAP-WAIVE-EXT-DATE-AREA. DTSIS76 -00076 15 MAP-WAIVE-EXT-MO-AREA. DTSIS76 -00077 20 MAP-WAIVE-EXT-MO-L PIC S9(04) COMP. DTSIS76 -00078 20 MAP-WAIVE-EXT-MO-A PIC X(01). DTSIS76 -00079 20 MAP-WAIVE-EXT-MO PIC X(02). DTSIS76 -00080 15 MAP-WAIVE-EXT-DA-AREA. DTSIS76 -00081 20 MAP-WAIVE-EXT-DA-L PIC S9(04) COMP. DTSIS76 -00082 20 MAP-WAIVE-EXT-DA-A PIC X(01). DTSIS76 -00083 20 MAP-WAIVE-EXT-DA PIC X(02). DTSIS76 -00084 15 MAP-WAIVE-EXT-YR-AREA. DTSIS76 -00085 20 MAP-WAIVE-EXT-YR-L PIC S9(04) COMP. DTSIS76 -00086 20 MAP-WAIVE-EXT-YR-A PIC X(01). DTSIS76 -00087 20 MAP-WAIVE-EXT-YR PIC X(02). DTSIS76 -00088 DTSIS76 -00089 *****10 MAP-ONLINE-FROM-YRQ-AREA. DTSIS76 -00090 *********15 MAP-ONLINE-FROM-YRQ-YR-L PIC S9(04) COMP. DTSIS76 -00091 *********15 MAP-ONLINE-FROM-YRQ-YR-A PIC X(01). DTSIS76 -00092 *********15 MAP-ONLINE-FROM-YRQ-YR PIC X(02). DTSIS76 -00093 DTSIS76 -00094 *********15 MAP-ONLINE-FROM-YRQ-Q-L PIC S9(04) COMP. DTSIS76 -00095 *********15 MAP-ONLINE-FROM-YRQ-Q-A PIC X(01). DTSIS76 -00096 *********15 MAP-ONLINE-FROM-YRQ-Q PIC X(01). DTSIS76 -00097 DTSIS76 -00098 *****10 MAP-ONLINE-TO-YRQ-AREA. DTSIS76 -00099 *********15 MAP-ONLINE-TO-YRQ-YR-L PIC S9(04) COMP. DTSIS76 -00100 *********15 MAP-ONLINE-TO-YRQ-YR-A PIC X(01). DTSIS76 -00101 *********15 MAP-ONLINE-TO-YRQ-YR PIC X(02). DTSIS76 -00102 DTSIS76 -00103 *********15 MAP-ONLINE-TO-YRQ-Q-L PIC S9(04) COMP. DTSIS76 -00104 *********15 MAP-ONLINE-TO-YRQ-Q-A PIC X(01). DTSIS76 -00105 *********15 MAP-ONLINE-TO-YRQ-Q PIC X(01). DTSIS76 -00106 DTSIS76 -00107 *****10 MAP-ONLINE-FORCE-PRINT-AREA. DTSIS76 -00108 *********15 MAP-ONLINE-FORCE-PRINT-L PIC S9(04) COMP. DTSIS76 -00109 *********15 MAP-ONLINE-FORCE-PRINT-A PIC X(01). DTSIS76 -00110 *********15 MAP-ONLINE-FORCE-PRINT PIC X(01). DTSIS76 -00111 *************88 MAP-ONLINE-FORCE-PRINT-NO VALUE 'N'. DTSIS76 -00112 *************88 MAP-ONLINE-FORCE-PRINT-YES VALUE 'Y'. DTSIS76 -00113 *************88 MAP-ONLINE-FORCE-PRINT-VALID VALUE 'Y' 'N'. DTSIS76 -00114 DTSIS76 -00115 *****10 MAP-ONLINE-PRINTER-ID-AREA. DTSIS76 -00116 *********15 MAP-ONLINE-PRINTER-ID-L PIC S9(04) COMP. DTSIS76 -00117 *********15 MAP-ONLINE-PRINTER-ID-A PIC X(01). DTSIS76 -00118 *********15 MAP-ONLINE-PRINTER-ID PIC X(04). DTSIS76 -00119 DTSIS76 -00120 10 F761133. DTSIS76 -00121 15 MAP-NOTICE-OF-SUBJECT-L PIC S9(04) COMP. DTSIS76 -00122 15 MAP-NOTICE-OF-SUBJECT-A PIC X(01). DTSIS76 -00123 15 MAP-NOTICE-OF-SUBJECT PIC X(01). DTSIS76 -00124 88 MAP-NOTICE-OF-SUBJECT-NO VALUE 'N'. DTSIS76 -00125 88 MAP-NOTICE-OF-SUBJECT-YES VALUE 'Y'. DTSIS76 -00126 88 MAP-NOTICE-OF-SUBJECT-VALID VALUE 'Y' 'N'. DTSIS76 -00127 DTSIS76 -00128 10 F761333. DTSIS76 -00129 15 MAP-REQUEST-FOR-FEIN-L PIC S9(04) COMP. DTSIS76 -00130 15 MAP-REQUEST-FOR-FEIN-A PIC X(01). DTSIS76 -00131 15 MAP-REQUEST-FOR-FEIN PIC X(01). DTSIS76 -00132 88 MAP-REQUEST-FOR-FEIN-YES VALUE 'Y'. DTSIS76 -00133 88 MAP-REQUEST-FOR-FEIN-NO VALUE 'N'. DTSIS76 -00134 88 MAP-REQUEST-FOR-FEIN-VALID VALUE 'Y' 'N'. DTSIS76 -00135 DTSIS76 -00136 10 MAP-ADDR-TYPE-AREA. DTSIS76 -00137 15 MAP-ADDR-TYPE-L PIC S9(04) COMP. DTSIS76 -00138 15 MAP-ADDR-TYPE-A PIC X(01). DTSIS76 -00139 15 MAP-ADDR-TYPE PIC X(01). DTSIS76 -00140 88 MAP-ADDR-TAX-88 VALUE 'T'. DTSIS76 -00141 88 MAP-ADDR-TAX-ALT-88 VALUE 'A'. DTSIS76 -00142 88 MAP-ADDR-PHY-88 VALUE 'P'. DTSIS76 -00143 88 MAP-ADDR-OPO-88 VALUE 'O'. DTSIS76 -00144 88 MAP-ADDR-TAD-88 VALUE 'T' 'P'. DTSIS76 -00145 88 MAP-ADDR-TAA-OPO-88 VALUE 'A' 'O'. DTSIS76 -00146 88 MAP-ADDR-VALID-88 VALUE 'T' 'A' 'P' 'O'. DTSIS76 -00147 DTSIS76 -00148 10 MAP-ADDR-ID-NO-AREA. DTSIS76 -00149 15 MAP-ADDR-ID-NO-L PIC S9(04) COMP. DTSIS76 -00150 15 MAP-ADDR-ID-NO-A PIC X(01). DTSIS76 -00151 15 MAP-ADDR-ID-NO PIC X(03). DTSIS76 -00152 15 MAP-ADDR-ID-NO-N REDEFINES MAP-ADDR-ID-NO DTSIS76 -00153 PIC ZZZ. DTSIS76 -00154 DTSIS76 -00155 10 F761733. DTSIS76 -00156 15 MAP-AR-AUDIT-TRAIL-L PIC S9(04) COMP. DTSIS76 -00157 15 MAP-AR-AUDIT-TRAIL-A PIC X(01). DTSIS76 -00158 15 MAP-AR-AUDIT-TRAIL PIC X(01). DTSIS76 -00159 88 MAP-AR-AUDIT-TRAIL-NO VALUE 'N'. DTSIS76 -00160 88 MAP-AR-AUDIT-TRAIL-YES VALUE 'Y'. DTSIS76 -00161 88 MAP-AR-AUDIT-TRAIL-VALID VALUE 'Y' 'N'. DTSIS76 -00162 DTSIS76 -00163 10 MAP-STMT-FROM-YRQ-AREA. DTSIS76 -00164 15 MAP-STMT-FROM-YRQ-YR-L PIC S9(04) COMP. DTSIS76 -00165 15 MAP-STMT-FROM-YRQ-YR-A PIC X(01). DTSIS76 -00166 15 MAP-STMT-FROM-YRQ-YR PIC X(02). DTSIS76 -00167 DTSIS76 -00168 15 MAP-STMT-FROM-YRQ-Q-L PIC S9(04) COMP. DTSIS76 -00169 15 MAP-STMT-FROM-YRQ-Q-A PIC X(01). DTSIS76 -00170 15 MAP-STMT-FROM-YRQ-Q PIC X(01). DTSIS76 -00171 DTSIS76 -00172 10 MAP-STMT-TO-YRQ-AREA. DTSIS76 -00173 15 MAP-STMT-TO-YRQ-YR-L PIC S9(04) COMP. DTSIS76 -00174 15 MAP-STMT-TO-YRQ-YR-A PIC X(01). DTSIS76 -00175 15 MAP-STMT-TO-YRQ-YR PIC X(02). DTSIS76 -00176 DTSIS76 -00177 15 MAP-STMT-TO-YRQ-Q-L PIC S9(04) COMP. DTSIS76 -00178 15 MAP-STMT-TO-YRQ-Q-A PIC X(01). DTSIS76 -00179 15 MAP-STMT-TO-YRQ-Q PIC X(01). DTSIS76 -00180 DTSIS76 -00181 10 F762133. DTSIS76 -00182 15 MAP-RESPONSIBLE-OP-ID-L PIC S9(04) COMP. DTSIS76 -00183 15 MAP-RESPONSIBLE-OP-ID-A PIC X(01). DTSIS76 -00184 15 MAP-RESPONSIBLE-OP-ID PIC X(08). DTSIS76 -00185 DTSIS76 -00186 10 F762141. DTSIS76 -00187 15 MAP-RESPONSIBLE-OP-ID-DSCR-L PIC S9(04) COMP. DTSIS76 -00188 15 MAP-RESPONSIBLE-OP-ID-DSCR-A PIC X(01). DTSIS76 -00189 15 MAP-RESPONSIBLE-OP-ID-DSCR PIC X(32). DTSIS76 -00190 DTSIS76 -00191 10 MAP-SSN-AREA. DTSIS76 -00192 15 MAP-SSN-1-AREA. DTSIS76 -00193 20 MAP-SSN-1-L PIC S9(04) COMP. DTSIS76 -00194 20 MAP-SSN-1-A PIC X(01). DTSIS76 -00195 20 MAP-SSN-1 PIC X(03). DTSIS76 -00196 15 MAP-SSN-2-AREA. DTSIS76 -00197 20 MAP-SSN-2-L PIC S9(04) COMP. DTSIS76 -00198 20 MAP-SSN-2-A PIC X(01). DTSIS76 -00199 20 MAP-SSN-2 PIC X(02). DTSIS76 -00200 15 MAP-SSN-3-AREA. DTSIS76 -00201 20 MAP-SSN-3-L PIC S9(04) COMP. DTSIS76 -00202 20 MAP-SSN-3-A PIC X(01). DTSIS76 -00203 20 MAP-SSN-3 PIC X(04). DTSIS76 -00204 DTSIS76 -00205 10 MAP-WR-YRQ1-AREA. DTSIS76 -00206 15 MAP-WR-YRQ1-YR-L PIC S9(04) COMP. DTSIS76 -00207 15 MAP-WR-YRQ1-YR-A PIC X(01). DTSIS76 -00208 15 MAP-WR-YRQ1-YR PIC X(02). DTSIS76 -00209 DTSIS76 -00210 15 MAP-WR-YRQ1-Q-L PIC S9(04) COMP. DTSIS76 -00211 15 MAP-WR-YRQ1-Q-A PIC X(01). DTSIS76 -00212 15 MAP-WR-YRQ1-Q PIC X(01). DTSIS76 -00213 DTSIS76 -00214 10 MAP-WR-YRQ2-AREA. DTSIS76 -00215 15 MAP-WR-YRQ2-YR-L PIC S9(04) COMP. DTSIS76 -00216 15 MAP-WR-YRQ2-YR-A PIC X(01). DTSIS76 -00217 15 MAP-WR-YRQ2-YR PIC X(02). DTSIS76 -00218 DTSIS76 -00219 15 MAP-WR-YRQ2-Q-L PIC S9(04) COMP. DTSIS76 -00220 15 MAP-WR-YRQ2-Q-A PIC X(01). DTSIS76 -00221 15 MAP-WR-YRQ2-Q PIC X(01). DTSIS76 -00222 DTSIS76 -00223 10 MAP-WR-YRQ3-AREA. DTSIS76 -00224 15 MAP-WR-YRQ3-YR-L PIC S9(04) COMP. DTSIS76 -00225 15 MAP-WR-YRQ3-YR-A PIC X(01). DTSIS76 -00226 15 MAP-WR-YRQ3-YR PIC X(02). DTSIS76 -00227 DTSIS76 -00228 15 MAP-WR-YRQ3-Q-L PIC S9(04) COMP. DTSIS76 -00229 15 MAP-WR-YRQ3-Q-A PIC X(01). DTSIS76 -00230 15 MAP-WR-YRQ3-Q PIC X(01). DTSIS76 -00231 DTSIS76 -00232 10 MAP-WR-YRQ4-AREA. DTSIS76 -00233 15 MAP-WR-YRQ4-YR-L PIC S9(04) COMP. DTSIS76 -00234 15 MAP-WR-YRQ4-YR-A PIC X(01). DTSIS76 -00235 15 MAP-WR-YRQ4-YR PIC X(02). DTSIS76 -00236 DTSIS76 -00237 15 MAP-WR-YRQ4-Q-L PIC S9(04) COMP. DTSIS76 -00238 15 MAP-WR-YRQ4-Q-A PIC X(01). DTSIS76 -00239 15 MAP-WR-YRQ4-Q PIC X(01). DTSIS76 -00240 DTSIS76 -00241 10 F762233. DTSIS76 -00242 15 MAP-CLAIMANT-NAME-L PIC S9(04) COMP. DTSIS76 -00243 15 MAP-CLAIMANT-NAME-A PIC X(01). DTSIS76 -00244 15 MAP-CLAIMANT-NAME PIC X(32). DTSIS76 -00245 DTSIS76 -00246 10 F762318. DTSIS76 -00247 15 MAP-KEY-ADD-L PIC S9(04) COMP. DTSIS76 -00248 15 MAP-KEY-ADD-A PIC X(01). DTSIS76 -00249 15 MAP-KEY-ADD PIC X(06). DTSIS76 -00250 DTSIS76 -00251 10 MAP-MSG-AREA. DTSIS76 -00252 15 MAP-MSG-ID-AREA. DTSIS76 -00253 20 MAP-MSG-ID-L PIC S9(04) COMP. DTSIS76 -00254 20 MAP-MSG-ID-A PIC X(01). DTSIS76 -00255 20 MAP-MSG-ID PIC X(08). DTSIS76 -00256 15 MAP-MSG-TEXT-AREA. DTSIS76 -00257 20 MAP-MSG-TEXT-L PIC S9(04) COMP. DTSIS76 -00258 20 MAP-MSG-TEXT-A PIC X(01). DTSIS76 -00259 20 MAP-MSG-TEXT PIC X(58). DTSIS76 -00260 DTSIS76 -00261 10 MAP-GOTO-AREA. DTSIS76 -00262 15 MAP-GOTO-L PIC S9(04) COMP. DTSIS76 -00263 15 MAP-GOTO-A PIC X(01). DTSIS76 -00264 15 MAP-GOTO PIC X(02). DTSIS76 diff --git a/CICS/UCTRAN41.cob b/CICS/UCTRAN41.cob index 03dbdb2..182b2e6 100644 --- a/CICS/UCTRAN41.cob +++ b/CICS/UCTRAN41.cob @@ -37,9 +37,10 @@ END-IF PERFORM APPLY-SETTING END-IF - - EXEC CICS RETURN END-EXEC. - + + + EXEC CICS RETURN END-EXEC. + GOBACK. FLIP-UCTRAN. EXEC CICS INQUIRE TERMINAL(EIBTRMID) UCTRANST(UCTRANST) END-EXEC