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