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