00001 IDENTIFICATION DIVISION. 03/27/14 00002 PROGRAM-ID. DTSCS51. DTSCS51 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV031 00004 DATE-WRITTEN. MAY 1994. DTSCS51 00005 DATE-COMPILED. DTSCS51 00006 DTSCS51 00007 DTSCS51 00008 ***** DTSCS51 00009 * DTSCS51 00010 * FUNCTION: RATE INQUIRY/UPDATE SCREEN PROCESSOR. DTSCS51 00011 * DTSCS51 00012 * DTSCS51 00013 * MODIFICATION LOG: DTSCS51 00014 * DTSCS51 00015 * 11/25/98 INITIAL DEVELOPMENT. COPIED FROM MACCS51 DTSCS51 00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCS51 00017 * DTSCS51 00018 * 08/01/97 MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE DTSCS51 00019 * PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11. DTSCS51 00020 * REFERENCE RFP: TCL 096 PROGRAMMER: FLS DTSCS51 00021 * DTSCS51 00022 * 07/11/2002 ADDED RATE TYPE FIELD AND PROCESSING TO HANDLE DTSCS51 00023 * ESTIMATED RATES. DTSCS51 00024 * REFERENCE RFP: HOUSEHOLD PROGRAMMER: GD DTSCS51 00025 * DTSCS51 00026 * 11/30/2009 MODIFIED FOR STATUS CHANGE APPROVAL PROCESS. DTSCS51 00027 * REFERENCE RFP: PROGRAMMER: GD DTSCS51 00028 * DTSCS51 00029 * 04/14/2010 MODIFIED S1000: APPROVAL NOT REQUIRED TO DTSCS51 00030 * REPRINT RATE NOTICE, AS LONG AS RATE IS NOT DTSCS51 00031 * CHANGED. DTSCS51 00032 * REFERENCE RFP: PROGRAMMER: GD DTSCS51 00033 * DTSCS51 00034 * 04/26/2013 MODIFIED FOR SUTA DUMPING. THE SCREEN WILL DTSCS51 00035 * CHECK FOR A RELATIONSHIP ENTERED BASED ON DTSCS51 00036 * A SUTA DUMPING INVESTIGATION AND DISPLAY THE DTSCS51 00037 * PREDECESSOR NUMBER AND RELATIONSHIP EFFECTIVE DTSCS51 00038 * DATE. THIS WILL PROVIDE A LINK THAT CAN BE DTSCS51 00039 * USED TO CALCULATE THE CHANGE IN TAX DUE. DTSCS51 00040 * REFERENCE RFP: TICKET 1780 PROGRAMMER: GD DTSCS51 00041 * DTSCS51 00042 * 04/29/2013 ADDED MREL PREDECESSOR AND EFF DATE DTSCS51 00043 * TO IDENTIFY RATE CHANGES RESULTING FROM DTSCS51 00044 * SUTA DUMPING DETECTION. DTSCS51 00045 * REFERENCE RFP: TICKET 1780 PROGRAMMER: GD DTSCS51 00046 * DTSCS51 00047 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS51 00048 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS51 00049 * WORK ORDER: PROGRAMMER: XXX DTSCS51 00050 * DTSCS51 00051 * DTSCS51 00052 * DESCRIPTION: DTSCS51 00053 * DTSCS51 00054 * DTSCS51 00055 * CLEAR: DTSCS51 00056 * DTSCS51 00057 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO) DTSCS51 00058 * DTSCS51 00059 * DTSCS51 00060 * JUMP: DTSCS51 00061 * DTSCS51 00062 * NONE. DTSCS51 00063 * DTSCS51 00064 * DTSCS51 00065 * INQUIRY: DTSCS51 00066 * DTSCS51 00067 * CONTROL FIELDS: MAP-EMP-NO DTSCS51 00068 * DTSCS51 00069 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR51-HOLD-AREA EMP-NO DTSCS51 00070 * DISPLAY RECORD INDICATED BY LCCM-SCR51-HOLD-AREADTSCS51 00071 * ELSE DTSCS51 00072 * DISPLAY LAST PAGE OF DATA ASSOCIATED WITH DTSCS51 00073 * LCCM-EMP-NO. DTSCS51 00074 * DTSCS51 00075 * DTSCS51 00076 * ENTER, F5, F6, F7, F8: STANDARD PAGING. DTSCS51 00077 * DTSCS51 00078 * DISPLAY SEQUENCE: ASCENDING ON MRTE-EFF-YRQ. DTSCS51 00079 * DTSCS51 00080 * PAGE INITIALLY DISPLAYED: LAST. DTSCS51 00081 * DTSCS51 00082 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS51 00083 * DTSCS51 00084 * STORE INFORMATION REPRESENTING PAGE DTSCS51 00085 * CURRENTLY DISPLAYED IN LCCM-SCR51-HOLD-AREA. DTSCS51 00086 * DTSCS51 00087 * DTSCS51 00088 * DTSCS51 00089 * UPDATE: DTSCS51 00090 * DTSCS51 00091 * ADD DTSCS51 00092 * MOD DTSCS51 00093 * DEL DTSCS51 00094 * DTSCS51 00095 * CHANGING MAP-EFF-YRQ PRIOR TO MOD OR DEL IS AN ERROR. DTSCS51 00096 * DTSCS51 00097 * DTSCS51 00098 * RECORDS READ: DTSCS51 00099 * DTSCS51 00100 * MASTER: DTSCS51 00101 * DTSCS51 00102 * MPRF DTSCS51 00103 * MRTE DTSCS51 00104 * MRCT DTSCS51 00105 * DTSCS51 00106 * DTSCS51 00107 * ALTERNATE INDEX: DTSCS51 00108 * DTSCS51 00109 * NONE. DTSCS51 00110 * DTSCS51 00111 * DTSCS51 00112 * REFERENCE: DTSCS51 00113 * DTSCS51 00114 * NONE. DTSCS51 00115 * DTSCS51 00116 * DTSCS51 00117 * ACCOUNTING TRANSACTION COLLECTION: DTSCS51 00118 * DTSCS51 00119 * NONE. DTSCS51 00120 * DTSCS51 00121 * DTSCS51 00122 * RECORDS UPDATED: DTSCS51 00123 * DTSCS51 00124 * MASTER: DTSCS51 00125 * DTSCS51 00126 * MRTE (WRITE, DELETE, REWRITE) DTSCS51 00127 * DTSCS51 00128 * DTSCS51 00129 * REFERENCE: DTSCS51 00130 * DTSCS51 00131 * NONE. DTSCS51 00132 * DTSCS51 00133 * DTSCS51 00134 * ACCOUNTING TRANSACTION COLLECTION: DTSCS51 00135 * DTSCS51 00136 * NONE. DTSCS51 00137 * DTSCS51 00138 * DTSCS51 00139 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS51 00140 * DTSCS51 00141 * IF POST UPDATE (ADD OR MOD) MRTE-RATE-TYPE = 'I' DTSCS51 00142 * MACIT006 WITH T006-TRN-CD = '02' DTSCS51 00143 * (UIRTE-SIC-DIVISION-CHK). DTSCS51 00144 * DTSCS51 00145 * IF MAP-PRINT-RATE-NOTICE = 'Y' DTSCS51 00146 * MACIT006 WITH T006-TRN-CD = '03' (UIRTE-NOTICE). DTSCS51 00147 * DTSCS51 00148 * IF MRTE RECORD IS DELETED DTSCS51 00149 * MACIT006 WITH T006-TRN-CD = '01' (UIRTE-EXIST-CHK). DTSCS51 00150 * DTSCS51 00151 * IF MRTE-RATE MODIFIED DTSCS51 00152 * MACIT031 WITH T031-TRN-CD = '01' (AUTO-PROCESS). DTSCS51 00153 * DTSCS51 00154 * DTSCS51 00155 * TEMPORARY STORAGE USAGE: DTSCS51 00156 * DTSCS51 00157 * NONE. DTSCS51 00158 * DTSCS51 00159 * DTSCS51 00160 * MODULES LINKED TO: DTSCS51 00161 * DTSCS51 00162 * DTSCU001 DATE EDIT/CONVERSION. DTSCS51 00163 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS51 00164 * DTSCU006 RATING YEAR/RATING EXPERIENCE PERIOD START/END. DTSCS51 00165 * DTSCU012 RATE FROM SCREEN FORMAT/EDIT. DTSCS51 00166 * DTSCU016 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS51 00167 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS51 00168 * DTSCU031 RATE EDIT. DTSCS51 00169 * DTSCU035 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS51 00170 * DTSCU052 UI RATE EDIT. DTSCS51 00171 * DTSCU054 UI RATE DETERMINATION FROM MRCT RECORD. DTSCS51 00172 * DTSCU056 RATE DISPLAY. DTSCS51 00173 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS51 00174 * DTSCU331 WRITE RATING MAINTENANCE LIST REPORT RECORD. DTSCS51 00175 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS51 00176 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS51 00177 * DTSCS51 00178 * DTSCS51 00179 * DTSCS51 00180 * NOTES TO JEFF: DTSCS51 00181 * DTSCS51 00182 * . IN ORDER TO TEST THIS MODULE, FCYR AND FUIR RECORDS DTSCS51 00183 * MUST EXIST ON THE REFERENCE FILE. USE SCREEN 81 AND DTSCS51 00184 * SCREEN 82 TO ADD THESE RECORDS TO THE REFERENCE FILE. DTSCS51 00185 * SEE THE SCREEN PRINTS. DTSCS51 00186 * DTSCS51 00187 * . IN ORDER TO TEST THE "PRINT RATE NOTICE? Y" FUNCTION DTSCS51 00188 * MRCT RECORDS MUST EXIST. THUS, YOU MAY WANT TO WRITE DTSCS51 00189 * DTSCS52 PRIOR TO WRITING THIS MODULE. DTSCS51 00190 * DTSCS51 00191 * . IF YOU DO DTSCS51 FIRST, I WOULD USE DTSCS17 AS A BASE, DTSCS51 00192 * FOLDING IN THE EDITS FROM TXC410C. IF YOU DO DTSCS51 00193 * DTSCS52 FIRST, THEN YOU WOULD PROBABLY USE DTSCS52 AS DTSCS51 00194 * A BASE. DTSCS51 00195 * DTSCS51 00196 * . SEE \RPT\RPT501.* FOR THE LIST OF DATA ELEMENTS TO BE DTSCS51 00197 * REPORTED VIA DTSCU331. DTSCS51 00198 * DTSCS51 00199 * . ADD FUNCTION PERMITTED IF AND ONLY IF MPRF-CLASS-REG-88 DTSCS51 00200 * OR MPRF-CLASS-GOV-88. DTSCS51 00201 * DTSCS51 00202 * . SOME SLIGHTLY WARPED LOGIC FOR "UI RATE TYPE" IS NOTED DTSCS51 00203 * IN THE SCREEN DESCRIPTION. DTSCS51 00204 * DTSCS51 00205 * . USE DTSCU006 TO DETERMINE "RATE PERIOD". THE LOGIC DTSCS51 00206 * AROUND DTSCU006 IS SIMILAR TO THE VERMONT LOGIC. DTSCS51 00207 * NOTE THAT L006-EMP-CLASS MUST BE PASSED TO DTSCU006. DTSCS51 00208 * MONTANA HAS A SEPARATE RATING SYSTEM (WITH DIFFERENT DTSCS51 00209 * RATE PERIODS) FROM THE RATING SYSTEM USED FOR "PRIVATE" DTSCS51 00210 * EMPLOYERS. DTSCS51 00211 * DTSCS51 00212 * . PRINTING RATE NOTICE. IN VERMONT, AFTER A RATE UPDATE DTSCS51 00213 * WE AUTOMATICALLY PRINTED A RATE NOTICE. IN MONTANA, WE DTSCS51 00214 * ONLY WRITE THE RATE NOTICE PRINT TRIGGER WHEN THE USER DTSCS51 00215 * EXPLICITLY REQUESTS THE RATE NOTICE BE PRINTED. DTSCS51 00216 * DTSCS51 00217 * . RATE NOTICE DATE. IN VERMONT RATE NOTICE DATE WAS DTSCS51 00218 * DISPLAY ONLY. IN MONTANA, RATE NOTICE DATE MAY BE DTSCS51 00219 * UPDATED FROM THIS SCREEN. DTSCS51 00220 * DTSCS51 00221 * . CALL DTSCU053 TO EDIT THE RATE. SIMILAR TO VERMONT. DTSCS51 00222 * DTSCS51 00223 * . IF "PRINT RATE NOTICE? Y", THEN CALL DTSCU054 TO DTSCS51 00224 * VERIFY "UI RATE TYPE" AND "UI RATE" IS CONSISTENT WITH DTSCS51 00225 * THE CORRESPONDING MRCT RECORD. THIS IS SIMILAR TO DTSCS51 00226 * VERMONT. HOWEVER, IN MONTANA: DTSCS51 00227 * DTSCS51 00228 * . THE MRCT RECORD IS CONCATINATED INTO THE DTSCU054 DTSCS51 00229 * COMM AREA. DTSCS51 00230 * DTSCS51 00231 * . L054-EMP-CLASS MUST BE PASSED TO DTSCU054. DTSCS51 00232 * DTSCS51 00233 * . IN MONTANA WE HAVE THE CONCEPT OF A "PENALTY RATE" DTSCS51 00234 * (A CONCEPT THAT DID NOT EXIST IN VERMONT). ON DTSCS51 00235 * RETURN FROM DTSCU054: DTSCS51 00236 * DTSCS51 00237 * IF L054-OK-88 DTSCS51 00238 * DTSCS51 00239 * IF L054-UI-PEN-RATE-YES-88 DTSCS51 00240 * DTSCS51 00241 * IF (L054-UI-RATE-TYPE = SCREEN "UI RATE TYPE") DTSCS51 00242 * AND DTSCS51 00243 * (L054-UI-PEN-RATE = SCREEN "UI RATE") DTSCS51 00244 * DTSCS51 00245 * SCREEN "UI RATE" IS CONSISTENT WITH MRCT DTSCS51 00246 * DTSCS51 00247 * ELSE DTSCS51 00248 * DTSCS51 00249 * SCREEN "UI RATE" IS NOT CONSISTENT WITH MRCT DTSCS51 00250 * DTSCS51 00251 * ELSE DTSCS51 00252 * DTSCS51 00253 * IF (L054-UI-RATE-TYPE = SCREEN "UI RATE TYPE") DTSCS51 00254 * AND DTSCS51 00255 * (L054-UI-CALC-RATE = SCREEN "UI RATE") DTSCS51 00256 * DTSCS51 00257 * ELSE DTSCS51 00258 * DTSCS51 00259 * SCREEN "UI RATE" IS NOT CONSISTENT WITH MRCT. DTSCS51 00260 * DTSCS51 00261 * DTSCS51 00262 ***** DTSCS51 00263 DTSCS51 00264 ENVIRONMENT DIVISION. DTSCS51 00265 DTSCS51 00266 DATA DIVISION. DTSCS51 00267 DTSCS51 00268 WORKING-STORAGE SECTION. DTSCS51 002685 77 PAN-VALET PICTURE X(24) VALUE '031DTSCS51 03/27/14'. DTSCS51 00269 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS51 03/18/14'. DTSCS51 00270 77 PAN-VALET PICTURE X(24) VALUE '029DTSCS51 06/19/13'. DTSCS51 00271 77 PAN-VALET PICTURE X(24) VALUE '030DTSCS51 05/06/13'. DTSCS51 00272 77 PAN-VALET PICTURE X(24) VALUE '027DTSCS51 04/14/10'. DTSCS51 00273 DTSCS51 00274 01 WRK-AREA. DTSCS51 00275 05 WRK-ABEND-CD PIC X(04) VALUE 'S51 '. DTSCS51 00276 DTSCS51 00277 05 WRK-SCR-ID. DTSCS51 00278 10 WRK-SCR-ID-N PIC 9(02) VALUE 51. DTSCS51 00279 DTSCS51 00280 05 WRK-F03-SCR-ID PIC X(02) VALUE '50'. DTSCS51 00281 05 SCR-ACCESS-IND PIC X(01). DTSCS51 00282 88 SCR-ACCESS-INQ VALUE '1'. DTSCS51 00283 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS51 00284 DTSCS51 00285 05 CURSOR-SET-IND PIC X(01). DTSCS51 00286 88 CURSOR-SET-YES VALUE 'Y'. DTSCS51 00287 88 CURSOR-SET-NO VALUE 'N'. DTSCS51 00288 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS51 00289 DTSCS51 00290 05 REQ-IND PIC X(01). DTSCS51 00291 88 REQ-ERROR VALUE 'O'. DTSCS51 00292 88 REQ-JUMP VALUE 'J'. DTSCS51 00293 88 REQ-INQUIRE VALUE 'I'. DTSCS51 00294 88 REQ-CLEAR VALUE 'C'. DTSCS51 00295 88 REQ-EDIT VALUE 'E'. DTSCS51 00296 88 REQ-UPDATE VALUE 'U'. DTSCS51 00297 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS51 00298 DTSCS51 00299 05 RESP-IND PIC X(01). DTSCS51 00300 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS51 00301 88 RESP-SEND-MAP VALUE 'M'. DTSCS51 00302 88 RESP-JUMP VALUE 'J'. DTSCS51 00303 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS51 00304 DTSCS51 00305 05 WRK-MSG-AREA PIC X(64). DTSCS51 00306 DTSCS51 00307 05 WRK-ATB-AN PIC X(01). DTSCS51 00308 05 WRK-ATB-NUM PIC X(01). DTSCS51 00309 DTSCS51 00310 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS51 00311 DTSCS51 00312 05 WRK-EFF-YRQ PIC S9(05) COMP-3. DTSCS51 00313 DTSCS51 00314 05 WRK-MPRF-IND PIC X(01). DTSCS51 00315 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS51 00316 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS51 00317 DTSCS51 00318 05 WRK-OLD-RATE PIC S9(01)V9(04) COMP-3. DTSCS51 00319 DTSCS51 00320 05 WRK-REL-CHNG-DATE PIC S9(09) COMP-3. DTSCS51 00321 05 WRK-REL-EFF-DATE PIC S9(09) COMP-3. DTSCS51 00322 05 WRK-REL-PRED-NO PIC S9(07) COMP-3. DTSCS51 00323 05 WRK-SUTA-DMP-CHNG-IND PIC X(01). DTSCS51 00324 88 WRK-SUTA-DMP-CHNG-YES-88 VALUE 'Y'. DTSCS51 00325 88 WRK-SUTA-DMP-CHNG-NO-88 VALUE 'N'. DTSCS51 00326 DTSCS51 00327 05 WRK-DISPLAY PIC 9(11). DTSCS51 00328 DTSCS51 00329 05 FILLER REDEFINES WRK-DISPLAY. DTSCS51 00330 10 FILLER PIC X(05). DTSCS51 00331 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS51 00332 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS51 00333 DTSCS51 00334 05 FILLER REDEFINES WRK-DISPLAY. DTSCS51 00335 10 FILLER PIC X(08). DTSCS51 00336 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS51 00337 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS51 00338 DTSCS51 00339 05 FILLER REDEFINES WRK-DISPLAY. DTSCS51 00340 10 FILLER PIC 9(05). DTSCS51 00341 10 WRK-DISPLAY-YR PIC 9(02). DTSCS51 00342 10 WRK-DISPLAY-MO PIC 9(02). DTSCS51 00343 10 WRK-DISPLAY-DA PIC 9(02). DTSCS51 00344 DTSCS51 00345 DTSCS51 00346 05 WRK-RATE-TYPE-AREA. DTSCS51 00347 10 WRK-RATE-YR-SCHED PIC X(01). DTSCS51 00348 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. DTSCS51 00349 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). DTSCS51 00350 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. DTSCS51 00351 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). DTSCS51 00352 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. DTSCS51 00353 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). DTSCS51 00354 88 WRK-ESTIMATE-NEEDED-88 VALUE 'YYY' 'NYY'. DTSCS51 00355 88 WRK-TRANSITION-YEAR-88 VALUE 'YYN' 'NYN'. DTSCS51 00356 88 WRK-INIT-VALUES-88 VALUE 'NNN'. DTSCS51 00357 DTSCS51 00358 05 INQUIRY-CONTROL-AREA. DTSCS51 00359 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS51 00360 10 WS-REC-NUM PIC S9(08) COMP. DTSCS51 00361 DTSCS51 00362 10 LAST-REC-KEY-AREA PIC X(16). DTSCS51 00363 10 SCR-REC-KEY-AREA PIC X(16). DTSCS51 00364 DTSCS51 00365 10 WS-REC-FOUND-IND PIC X(01). DTSCS51 00366 EJECT DTSCS51 00367 01 MSG-LITERALS. DTSCS51 00368 DTSCS51 00369 05 MSG-E511-AREA. DTSCS51 00370 10 FILLER PIC X(04) VALUE 'E511'. DTSCS51 00371 10 FILLER PIC X(30) DTSCS51 00372 VALUE 'RATES ALLOWED FOR RATED EMPLOY'. DTSCS51 00373 10 FILLER PIC X(30) DTSCS51 00374 VALUE 'ERS ONLY '. DTSCS51 00375 DTSCS51 00376 05 MSG-E512-AREA. DTSCS51 00377 10 FILLER PIC X(04) VALUE 'E512'. DTSCS51 00378 10 FILLER PIC X(30) DTSCS51 00379 VALUE 'NO RATE CUTOFF TO SUPPORT RATE'. DTSCS51 00380 10 FILLER PIC X(30) DTSCS51 00381 VALUE 'NOTICE '. DTSCS51 00382 DTSCS51 00383 05 MSG-E513-AREA. DTSCS51 00384 10 FILLER PIC X(04) VALUE 'E513'. DTSCS51 00385 10 FILLER PIC X(30) DTSCS51 00386 VALUE 'UI RATE IS NOT CONSISTENT WITH'. DTSCS51 00387 10 FILLER PIC X(30) DTSCS51 00388 VALUE ' RATING EXPERIENCE '. DTSCS51 00389 DTSCS51 00390 05 MSG-E514-AREA. DTSCS51 00391 10 FILLER PIC X(04) VALUE 'E514'. DTSCS51 00392 10 FILLER PIC X(34) DTSCS51 00393 VALUE 'ESTIMATED RATE WILL BECOME FINAL. '. DTSCS51 00394 10 FILLER PIC X(26) DTSCS51 00395 VALUE 'CONTINUE? '. DTSCS51 00396 DTSCS51 00397 05 MSG-E515-AREA. DTSCS51 00398 10 FILLER PIC X(04) VALUE 'E515'. DTSCS51 00399 10 FILLER PIC X(36) DTSCS51 00400 VALUE 'RATE NOTICE MUST BE PRINTED. CONTINU'. DTSCS51 00401 10 FILLER PIC X(26) DTSCS51 00402 VALUE 'E? '. DTSCS51 00403 DTSCS51 00404 05 MSG-E516-AREA. DTSCS51 00405 10 FILLER PIC X(04) VALUE 'E516'. DTSCS51 00406 10 FILLER PIC X(36) DTSCS51 00407 VALUE 'SUPERVISOR APPROVAL REQUIRED FOR RAT'. DTSCS51 00408 10 FILLER PIC X(26) DTSCS51 00409 VALUE 'E CHANGE. '. DTSCS51 00410 DTSCS51 00411 05 MSG-E517-AREA. DTSCS51 00412 10 FILLER PIC X(04) VALUE 'E517'. DTSCS51 00413 10 FILLER PIC X(36) DTSCS51 00414 VALUE 'SUTA DUMPING RATE CHANGE. CONTINUE? '. DTSCS51 00415 DTSCS51 00416 05 MSG-E518-AREA. DTSCS51 00417 10 FILLER PIC X(04) VALUE 'E518'. DTSCS51 00418 10 FILLER PIC X(36) DTSCS51 00419 VALUE 'SUTA DUMPING PRED ENTERED. RELATION'. DTSCS51 00420 10 FILLER PIC X(26) DTSCS51 00421 VALUE 'SHIP EFF DT REQUIRED. '. DTSCS51 00422 DTSCS51 00423 05 MSG-E519-AREA. DTSCS51 00424 10 FILLER PIC X(04) VALUE 'E519'. DTSCS51 00425 10 FILLER PIC X(36) DTSCS51 00426 VALUE 'SUTA DUMPING RELATIONSHIP EFF DT ENT'. DTSCS51 00427 10 FILLER PIC X(26) DTSCS51 00428 VALUE 'ERED. PRED REQUIRED. '. DTSCS51 00429 DTSCS51 00430 EJECT DTSCS51 00431 01 L001-COMM-AREA. DTSCS51 00432 ++INCLUDE DTSIL001 DTSCS51 00433 EJECT DTSCS51 00434 01 L004-COMM-AREA. DTSCS51 00435 ++INCLUDE DTSIL004 DTSCS51 00436 EJECT DTSCS51 00437 01 L006-COMM-AREA. DTSCS51 00438 ++INCLUDE DTSIL006 DTSCS51 00439 EJECT DTSCS51 00440 01 L012-COMM-AREA. DTSCS51 00441 ++INCLUDE DTSIL012 DTSCS51 00442 EJECT DTSCS51 00443 01 L015-COMM-AREA. DTSCS51 00444 ++INCLUDE DTSIL015 DTSCS51 00445 EJECT DTSCS51 00446 01 L016-COMM-AREA. DTSCS51 00447 ++INCLUDE DTSIL016 DTSCS51 00448 EJECT DTSCS51 00449 01 L018-COMM-AREA. DTSCS51 00450 ++INCLUDE DTSIL018 DTSCS51 00451 EJECT DTSCS51 00452 01 L052-COMM-AREA. DTSCS51 00453 ++INCLUDE DTSIL052 DTSCS51 00454 EJECT DTSCS51 00455 01 L054-COMM-AREA. DTSCS51 00456 ++INCLUDE DTSIL054 DTSCS51 00457 ++INCLUDE DTSIMRCT DTSCS51 00458 EJECT DTSCS51 00459 01 L056-COMM-AREA. DTSCS51 00460 ++INCLUDE DTSIL056 DTSCS51 00461 EJECT DTSCS51 00462 01 L084-COMM-AREA. DTSCS51 00463 ++INCLUDE DTSIL084 DTSCS51 00464 EJECT DTSCS51 00465 01 L221-COMM-AREA. DTSCS51 00466 ++INCLUDE DTSIL221 DTSCS51 00467 EJECT DTSCS51 00468 01 L331-COMM-AREA. DTSCS51 00469 ++INCLUDE DTSIL331 DTSCS51 00470 EJECT DTSCS51 00471 01 L410-COMM-AREA. DTSCS51 00472 ++INCLUDE DTSIL410 DTSCS51 00473 EJECT DTSCS51 00474 01 L805-COMM-AREA. DTSCS51 00475 ++INCLUDE DTSIL805 DTSCS51 00476 EJECT DTSCS51 00477 01 L810-COMM-AREA. DTSCS51 00478 05 L810-CONTROL-BLOCK. DTSCS51 00479 ++INCLUDE DTSIL810 DTSCS51 00480 EJECT DTSCS51 00481 05 MSKL-REC. DTSCS51 00482 ++INCLUDE DTSIMSKL DTSCS51 00483 EJECT DTSCS51 00484 01 MPRF-REC. DTSCS51 00485 ++INCLUDE DTSIMPRF DTSCS51 00486 EJECT DTSCS51 00487 01 MRTE-REC. DTSCS51 00488 ++INCLUDE DTSIMRTE DTSCS51 00489 EJECT DTSCS51 00490 01 MREL-REC. DTSCS51 00491 ++INCLUDE DTSIMREL DTSCS51 00492 EJECT DTSCS51 00493 01 L825-COMM-AREA. DTSCS51 00494 05 L825-CONTROL-BLOCK. DTSCS51 00495 ++INCLUDE DTSIL825 DTSCS51 00496 DTSCS51 00497 05 RSKL-REC. DTSCS51 00498 ++INCLUDE DTSIRSK1 DTSCS51 00499 EJECT DTSCS51 00500 01 T006-REC. DTSCS51 00501 ++INCLUDE DTSIT006 DTSCS51 00502 EJECT DTSCS51 00503 01 T031-REC. DTSCS51 00504 ++INCLUDE DTSIT031 DTSCS51 00505 EJECT DTSCS51 00506 01 L851-COMM-AREA. DTSCS51 00507 ++INCLUDE DTSIL851 DTSCS51 00508 DTSCS51 00509 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS51 00510 ++INCLUDE DTSIS51 DTSCS51 00511 EJECT DTSCS51 00512 01 CATB-LITERALS. DTSCS51 00513 ++INCLUDE DTSICATB DTSCS51 00514 DTSCS51 00515 01 CFKD-LITERALS. DTSCS51 00516 ++INCLUDE DTSICFKD DTSCS51 00517 DTSCS51 00518 01 CECD-LITERALS. DTSCS51 00519 ++INCLUDE DTSICECD DTSCS51 00520 DTSCS51 00521 01 CPCD-LITERALS. DTSCS51 00522 ++INCLUDE DTSICPCD DTSCS51 00523 EJECT DTSCS51 00524 LINKAGE SECTION. DTSCS51 00525 DTSCS51 00526 01 DFHCOMMAREA. DTSCS51 00527 ++INCLUDE DTSILCCM DTSCS51 00528 EJECT DTSCS51 00529 ******************************************************************DTSCS51 00530 * *DTSCS51 00531 ******************************************************************DTSCS51 00532 DTSCS51 00533 PROCEDURE DIVISION. DTSCS51 00534 DTSCS51 00535 MOVE +0 TO WRK-EMP-NO. DTSCS51 00536 SET WRK-MPRF-NO-88 TO TRUE. DTSCS51 00537 DTSCS51 00538 MOVE LOW-VALUES TO MAP-AREA. DTSCS51 00539 DTSCS51 00540 SET CURSOR-SET-NO TO TRUE. DTSCS51 00541 DTSCS51 00542 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS51 00543 TO SCR-ACCESS-IND. DTSCS51 00544 DTSCS51 00545 MOVE SPACE TO REQ-IND. DTSCS51 00546 DTSCS51 00547 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS51 00548 DTSCS51 00549 *----------------------------------------------------- DTSCS51 00550 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS51 00551 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS51 00552 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS51 00553 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS51 00554 * DTSCS51 00555 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS51 00556 * PROCESSED. DTSCS51 00557 * DTSCS51 00558 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS51 00559 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS51 00560 * WORK STATION OPERATOR. DTSCS51 00561 *----------------------------------------------------- DTSCS51 00562 DTSCS51 00563 MOVE SPACE TO RESP-IND. DTSCS51 00564 DTSCS51 00565 IF REQ-ERROR DTSCS51 00566 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS51 00567 ELSE DTSCS51 00568 IF REQ-JUMP DTSCS51 00569 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS51 00570 ELSE DTSCS51 00571 IF REQ-CLEAR DTSCS51 00572 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS51 00573 ELSE DTSCS51 00574 IF REQ-CURSOR-TO-GOTO DTSCS51 00575 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS51 00576 ELSE DTSCS51 00577 IF REQ-INQUIRE DTSCS51 00578 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS51 00579 ELSE DTSCS51 00580 IF REQ-EDIT DTSCS51 00581 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS51 00582 ELSE DTSCS51 00583 IF REQ-UPDATE DTSCS51 00584 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS51 00585 ELSE DTSCS51 00586 GO TO S899-ABEND. DTSCS51 00587 DTSCS51 00588 *----------------------------------------------------- DTSCS51 00589 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS51 00590 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS51 00591 *----------------------------------------------------- DTSCS51 00592 DTSCS51 00593 IF RESP-SEND-MAP DTSCS51 00594 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS51 00595 SET LCCM-END-TASK-88 TO TRUE DTSCS51 00596 ELSE DTSCS51 00597 IF RESP-SEND-MSGONLY DTSCS51 00598 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS51 00599 SET LCCM-END-TASK-88 TO TRUE DTSCS51 00600 ELSE DTSCS51 00601 IF RESP-JUMP DTSCS51 00602 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 00603 ELSE DTSCS51 00604 IF RESP-CURSOR-TO-GOTO DTSCS51 00605 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS51 00606 SET LCCM-END-TASK-88 TO TRUE DTSCS51 00607 ELSE DTSCS51 00608 GO TO S899-ABEND. DTSCS51 00609 DTSCS51 00610 MAINLINE-EXIT. DTSCS51 00611 DTSCS51 00612 EXEC CICS DTSCS51 00613 RETURN DTSCS51 00614 END-EXEC. DTSCS51 00615 DTSCS51 00616 GOBACK. DTSCS51 00617 EJECT DTSCS51 00618 /*****************************************************************DTSCS51 00619 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS51 00620 ******************************************************************DTSCS51 00621 P1000-ANALYZE-REQUEST. DTSCS51 00622 DTSCS51 00623 *----------------------------------------------------- DTSCS51 00624 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS51 00625 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS51 00626 * REPLACED WITH ENTER) DTSCS51 00627 *----------------------------------------------------- DTSCS51 00628 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS51 00629 SET LCCM-ENTER-88 TO TRUE DTSCS51 00630 IF LCCM-EMP-NO > ZERO DTSCS51 00631 SET REQ-INQUIRE TO TRUE DTSCS51 00632 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS51 00633 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS51 00634 ELSE DTSCS51 00635 SET REQ-CLEAR TO TRUE DTSCS51 00636 END-IF DTSCS51 00637 GO TO P1000-EXIT. DTSCS51 00638 DTSCS51 00639 *----------------------------------------------------- DTSCS51 00640 * MAP IS RECEIVED DTSCS51 00641 *----------------------------------------------------- DTSCS51 00642 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS51 00643 DTSCS51 00644 *----------------------------------------------------- DTSCS51 00645 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS51 00646 * WORK STATION DTSCS51 00647 *----------------------------------------------------- DTSCS51 00648 IF LCCM-CLEAR-88 DTSCS51 00649 SET REQ-CLEAR TO TRUE DTSCS51 00650 GO TO P1000-EXIT. DTSCS51 00651 DTSCS51 00652 *----------------------------------------------------- DTSCS51 00653 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS51 00654 *----------------------------------------------------- DTSCS51 00655 IF LCCM-SCR-UPDATE-LOCKED DTSCS51 00656 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS51 00657 GO TO P1000-EXIT. DTSCS51 00658 DTSCS51 00659 *----------------------------------------------------- DTSCS51 00660 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS51 00661 *----------------------------------------------------- DTSCS51 00662 IF LCCM-PA2-88 DTSCS51 00663 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS51 00664 GO TO P1000-EXIT. DTSCS51 00665 DTSCS51 00666 *----------------------------------------------------- DTSCS51 00667 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS51 00668 *----------------------------------------------------- DTSCS51 00669 IF LCCM-PA-88 DTSCS51 00670 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS51 00671 SET REQ-ERROR TO TRUE DTSCS51 00672 GO TO P1000-EXIT. DTSCS51 00673 DTSCS51 00674 *----------------------------------------------------- DTSCS51 00675 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS51 00676 * CLEAR SCREEN DTSCS51 00677 *----------------------------------------------------- DTSCS51 00678 IF LCCM-F12-88 DTSCS51 00679 MOVE LOW-VALUES TO MAP-AREA DTSCS51 00680 SET REQ-CLEAR TO TRUE DTSCS51 00681 GO TO P1000-EXIT. DTSCS51 00682 DTSCS51 00683 *----------------------------------------------------- DTSCS51 00684 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS51 00685 *----------------------------------------------------- DTSCS51 00686 IF LCCM-F03-88 DTSCS51 00687 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS51 00688 SET REQ-JUMP TO TRUE DTSCS51 00689 GO TO P1000-EXIT. DTSCS51 00690 DTSCS51 00691 *----------------------------------------------------- DTSCS51 00692 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS51 00693 *----------------------------------------------------- DTSCS51 00694 IF LCCM-F04-88 DTSCS51 00695 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS51 00696 SET REQ-JUMP TO TRUE DTSCS51 00697 GO TO P1000-EXIT. DTSCS51 00698 DTSCS51 00699 *----------------------------------------------------- DTSCS51 00700 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS51 00701 * CORRESPONDENCE SCREEN DTSCS51 00702 *----------------------------------------------------- DTSCS51 00703 IF LCCM-F14-88 DTSCS51 00704 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS51 00705 SET REQ-JUMP TO TRUE DTSCS51 00706 GO TO P1000-EXIT. DTSCS51 00707 DTSCS51 00708 *----------------------------------------------------- DTSCS51 00709 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS51 00710 * REQUESTED SCREEN TYPE DTSCS51 00711 *----------------------------------------------------- DTSCS51 00712 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS51 00713 NEXT SENTENCE DTSCS51 00714 ELSE DTSCS51 00715 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS51 00716 SET REQ-JUMP TO TRUE DTSCS51 00717 GO TO P1000-EXIT. DTSCS51 00718 DTSCS51 00719 *----------------------------------------------------- DTSCS51 00720 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS51 00721 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS51 00722 *----------------------------------------------------- DTSCS51 00723 IF LCCM-F09-88 DTSCS51 00724 OR LCCM-F10-88 DTSCS51 00725 OR LCCM-F23-88 DTSCS51 00726 IF SCR-ACCESS-UPDATE DTSCS51 00727 SET REQ-EDIT TO TRUE DTSCS51 00728 GO TO P1000-EXIT DTSCS51 00729 ELSE DTSCS51 00730 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS51 00731 SET REQ-ERROR TO TRUE DTSCS51 00732 GO TO P1000-EXIT. DTSCS51 00733 DTSCS51 00734 *----------------------------------------------------- DTSCS51 00735 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS51 00736 * OR F8), INDICATE INQUIRY REQUEST DTSCS51 00737 *----------------------------------------------------- DTSCS51 00738 IF LCCM-INQUIRY-88 DTSCS51 00739 SET REQ-INQUIRE TO TRUE DTSCS51 00740 GO TO P1000-EXIT. DTSCS51 00741 DTSCS51 00742 *----------------------------------------------------- DTSCS51 00743 * ANY OTHER KEY IS INVALID DTSCS51 00744 *----------------------------------------------------- DTSCS51 00745 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS51 00746 SET REQ-ERROR TO TRUE. DTSCS51 00747 P1000-EXIT. DTSCS51 00748 EXIT. DTSCS51 00749 DTSCS51 00750 ******************************************************************DTSCS51 00751 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS51 00752 ******************************************************************DTSCS51 00753 DTSCS51 00754 P1100-UPDATE-LOCKED. DTSCS51 00755 *----------------------------------------------------- DTSCS51 00756 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS51 00757 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS51 00758 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS51 00759 *----------------------------------------------------- DTSCS51 00760 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS51 00761 SET REQ-UPDATE TO TRUE DTSCS51 00762 ELSE DTSCS51 00763 SET REQ-ERROR TO TRUE DTSCS51 00764 IF LCCM-SCR-ADD-LOCKED DTSCS51 00765 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS51 00766 ELSE DTSCS51 00767 IF LCCM-SCR-MOD-LOCKED DTSCS51 00768 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS51 00769 ELSE DTSCS51 00770 IF LCCM-SCR-DEL-LOCKED DTSCS51 00771 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS51 00772 ELSE DTSCS51 00773 GO TO S899-ABEND. DTSCS51 00774 P1100-EXIT. DTSCS51 00775 EXIT. DTSCS51 00776 /*****************************************************************DTSCS51 00777 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS51 00778 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS51 00779 ******************************************************************DTSCS51 00780 DTSCS51 00781 P2000-REQUEST-ERROR. DTSCS51 00782 IF LCCM-MSG DTSCS51 00783 SET RESP-SEND-MSGONLY TO TRUE DTSCS51 00784 ELSE DTSCS51 00785 GO TO S899-ABEND. DTSCS51 00786 P2000-EXIT. DTSCS51 00787 EXIT. DTSCS51 00788 /*****************************************************************DTSCS51 00789 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS51 00790 ******************************************************************DTSCS51 00791 DTSCS51 00792 P3000-REQUEST-JUMP. DTSCS51 00793 *----------------------------------------------------- DTSCS51 00794 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS51 00795 * BY USER DTSCS51 00796 *----------------------------------------------------- DTSCS51 00797 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS51 00798 DTSCS51 00799 *----------------------------------------------------- DTSCS51 00800 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS51 00801 *----------------------------------------------------- DTSCS51 00802 IF LCCM-MSG DTSCS51 00803 SET RESP-SEND-MSGONLY TO TRUE DTSCS51 00804 SET CURSOR-SET-GOTO TO TRUE DTSCS51 00805 GO TO P3000-EXIT. DTSCS51 00806 SKIP3 DTSCS51 00807 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS51 00808 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS51 00809 IF L018-VALID DTSCS51 00810 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS51 00811 DTSCS51 00812 *----------------------------------------------------- DTSCS51 00813 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS51 00814 *----------------------------------------------------- DTSCS51 00815 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS51 00816 LCCM-SCR-HOLD-AREA. DTSCS51 00817 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS51 00818 SET RESP-JUMP TO TRUE. DTSCS51 00819 P3000-EXIT. DTSCS51 00820 EXIT. DTSCS51 00821 /*****************************************************************DTSCS51 00822 * CLEAR KEY WAS PRESSED *DTSCS51 00823 ******************************************************************DTSCS51 00824 DTSCS51 00825 P4000-REQUEST-CLEAR. DTSCS51 00826 DTSCS51 00827 *----------------------------------------------------- DTSCS51 00828 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS51 00829 * FIELDS FROM EARLIER REQUESTS DTSCS51 00830 *----------------------------------------------------- DTSCS51 00831 IF LCCM-EMP-NO > ZERO DTSCS51 00832 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS51 00833 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS51 00834 DTSCS51 00835 MOVE ZERO TO LCCM-EMP-NO. DTSCS51 00836 DTSCS51 00837 MOVE LOW-VALUES TO LCCM-SCR51-HOLD-AREA. DTSCS51 00838 DTSCS51 00839 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS51 00840 DTSCS51 00841 SET LCCM-SCR-CLEAR TO TRUE. DTSCS51 00842 DTSCS51 00843 IF SCR-ACCESS-UPDATE DTSCS51 00844 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS51 00845 ELSE DTSCS51 00846 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS51 00847 DTSCS51 00848 SET RESP-SEND-MAP TO TRUE. DTSCS51 00849 P4000-EXIT. DTSCS51 00850 EXIT. DTSCS51 00851 /*****************************************************************DTSCS51 00852 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS51 00853 ******************************************************************DTSCS51 00854 DTSCS51 00855 P5000-CURSOR-TO-GOTO. DTSCS51 00856 SET CURSOR-SET-GOTO TO TRUE. DTSCS51 00857 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS51 00858 P5000-EXIT. DTSCS51 00859 EXIT. DTSCS51 00860 /*****************************************************************DTSCS51 00861 * INQUIRY WAS REQUESTED *DTSCS51 00862 ******************************************************************DTSCS51 00863 DTSCS51 00864 P6000-REQUEST-INQUIRE. DTSCS51 00865 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS51 00866 MOVE LOW-VALUES TO MAP-AREA. DTSCS51 00867 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS51 00868 DTSCS51 00869 SET LCCM-SCR-CLEAR TO TRUE. DTSCS51 00870 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS51 00871 DTSCS51 00872 SET RESP-SEND-MAP TO TRUE. DTSCS51 00873 DTSCS51 00874 IF SCR-ACCESS-UPDATE DTSCS51 00875 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS51 00876 ELSE DTSCS51 00877 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS51 00878 DTSCS51 00879 MOVE LCCM-SCR51-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS51 00880 MOVE LOW-VALUES TO LCCM-SCR51-HOLD-AREA. DTSCS51 00881 DTSCS51 00882 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 00883 IF LCCM-MSG DTSCS51 00884 GO TO P6000-EXIT. DTSCS51 00885 DTSCS51 00886 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS51 00887 IF LCCM-MSG DTSCS51 00888 GO TO P6000-EXIT. DTSCS51 00889 DTSCS51 00890 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS51 00891 DTSCS51 00892 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS51 00893 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS51 00894 SET MSKL-RTE-88 TO TRUE. DTSCS51 00895 PERFORM S810-COUNT THRU S810-EXIT. DTSCS51 00896 DTSCS51 00897 IF L810-RECORD-CNT = +0 DTSCS51 00898 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS51 00899 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 00900 GO TO P6000-EXIT. DTSCS51 00901 DTSCS51 00902 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS51 00903 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS51 00904 DTSCS51 00905 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS51 00906 IF LCCM-MSG DTSCS51 00907 GO TO P6000-EXIT. DTSCS51 00908 DTSCS51 00909 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS51 00910 DTSCS51 00911 MOVE MRTE-KEY-AREA TO LCCM-SCR51-HOLD-AREA. DTSCS51 00912 DTSCS51 00913 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS51 00914 DTSCS51 00915 DTSCS51 00916 IF SCR-ACCESS-UPDATE DTSCS51 00917 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS51 00918 P6000-EXIT. DTSCS51 00919 EXIT. DTSCS51 00920 EJECT DTSCS51 00921 P6100-LOCATE-REC. DTSCS51 00922 *------------------------------------------------------------ DTSCS51 00923 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS51 00924 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS51 00925 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS51 00926 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS51 00927 * RECORD WITH THE GREATEST MRTE-LIAB-DATE (THE MOST DTSCS51 00928 * RECENT SPAN OF LIABILITY ASSOCIATED WITH WRK-EMP-NO). DTSCS51 00929 *------------------------------------------------------------ DTSCS51 00930 DTSCS51 00931 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS51 00932 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS51 00933 GO TO P6100-EXIT. DTSCS51 00934 DTSCS51 00935 MOVE SCR-REC-KEY-AREA TO MRTE-KEY-AREA. DTSCS51 00936 DTSCS51 00937 IF WRK-EMP-NO = MRTE-EMP-NO DTSCS51 00938 NEXT SENTENCE DTSCS51 00939 ELSE DTSCS51 00940 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS51 00941 GO TO P6100-EXIT. DTSCS51 00942 DTSCS51 00943 IF LCCM-F05-88 DTSCS51 00944 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS51 00945 GO TO P6100-EXIT. DTSCS51 00946 DTSCS51 00947 IF LCCM-F06-88 DTSCS51 00948 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS51 00949 GO TO P6100-EXIT. DTSCS51 00950 DTSCS51 00951 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS51 00952 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS51 00953 SET MSKL-RTE-88 TO TRUE. DTSCS51 00954 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS51 00955 IF L810-NO-REC-88 DTSCS51 00956 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS51 00957 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 00958 GO TO P6100-EXIT. DTSCS51 00959 DTSCS51 00960 MOVE +0 TO WS-REC-NUM. DTSCS51 00961 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS51 00962 PERFORM P6190-BROWSE-MRTE THRU P6190-EXIT DTSCS51 00963 UNTIL (L810-NO-REC-88) DTSCS51 00964 OR DTSCS51 00965 (WS-REC-FOUND-IND = 'Y'). DTSCS51 00966 DTSCS51 00967 IF L810-NO-REC-88 DTSCS51 00968 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS51 00969 GO TO P6100-EXIT. DTSCS51 00970 DTSCS51 00971 IF LCCM-ENTER-88 DTSCS51 00972 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS51 00973 GO TO P6100-EXIT. DTSCS51 00974 DTSCS51 00975 IF LCCM-F07-88 DTSCS51 00976 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS51 00977 GO TO P6100-EXIT. DTSCS51 00978 DTSCS51 00979 IF LCCM-F08-88 DTSCS51 00980 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS51 00981 GO TO P6100-EXIT. DTSCS51 00982 DTSCS51 00983 GO TO S899-ABEND. DTSCS51 00984 P6100-EXIT. DTSCS51 00985 EXIT. DTSCS51 00986 DTSCS51 00987 P6110-FIRST-REC. DTSCS51 00988 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS51 00989 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS51 00990 SET MSKL-RTE-88 TO TRUE. DTSCS51 00991 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS51 00992 IF L810-NO-REC-88 DTSCS51 00993 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS51 00994 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 00995 GO TO P6110-EXIT. DTSCS51 00996 DTSCS51 00997 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS51 00998 DTSCS51 00999 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01000 DTSCS51 01001 MOVE +1 TO WS-REC-NUM. DTSCS51 01002 P6110-EXIT. DTSCS51 01003 EXIT. DTSCS51 01004 DTSCS51 01005 P6120-PREV-REC. DTSCS51 01006 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS51 01007 IF L810-NO-REC-88 DTSCS51 01008 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS51 01009 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 01010 GO TO P6120-EXIT. DTSCS51 01011 DTSCS51 01012 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS51 01013 IF L810-NO-REC-88 DTSCS51 01014 GO TO P6120-EXIT. DTSCS51 01015 DTSCS51 01016 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS51 01017 DTSCS51 01018 SUBTRACT 1 FROM WS-REC-NUM. DTSCS51 01019 DTSCS51 01020 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01021 P6120-EXIT. DTSCS51 01022 EXIT. DTSCS51 01023 DTSCS51 01024 P6130-NEXT-REC. DTSCS51 01025 IF MRTE-KEY-AREA > SCR-REC-KEY-AREA DTSCS51 01026 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS51 01027 GO TO P6130-EXIT. DTSCS51 01028 DTSCS51 01029 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS51 01030 DTSCS51 01031 IF L810-NO-REC-88 DTSCS51 01032 GO TO P6130-EXIT. DTSCS51 01033 DTSCS51 01034 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS51 01035 DTSCS51 01036 ADD +1 TO WS-REC-NUM. DTSCS51 01037 DTSCS51 01038 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01039 P6130-EXIT. DTSCS51 01040 EXIT. DTSCS51 01041 DTSCS51 01042 P6140-LAST-REC. DTSCS51 01043 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS51 01044 PERFORM S810-READ THRU S810-EXIT. DTSCS51 01045 IF L810-NO-REC-88 DTSCS51 01046 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS51 01047 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 01048 GO TO P6140-EXIT. DTSCS51 01049 DTSCS51 01050 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01051 DTSCS51 01052 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS51 01053 P6140-EXIT. DTSCS51 01054 EXIT. DTSCS51 01055 DTSCS51 01056 P6190-BROWSE-MRTE. DTSCS51 01057 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01058 ADD +1 TO WS-REC-NUM. DTSCS51 01059 IF MRTE-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS51 01060 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS51 01061 ELSE DTSCS51 01062 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS51 01063 P6190-EXIT. DTSCS51 01064 EXIT. DTSCS51 01065 /*****************************************************************DTSCS51 01066 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS51 01067 ******************************************************************DTSCS51 01068 DTSCS51 01069 P6900-CONSTRUCT-SCREEN. DTSCS51 01070 PERFORM P6910-FROM-MRTE THRU P6910-EXIT. DTSCS51 01071 DTSCS51 01072 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS51 01073 P6900-EXIT. DTSCS51 01074 EXIT. DTSCS51 01075 DTSCS51 01076 P6910-FROM-MRTE. DTSCS51 01077 MOVE MRTE-EFF-YRQ TO WRK-DISPLAY. DTSCS51 01078 MOVE WRK-DISPLAY-QTR-YR TO MAP-EFF-QTR-YR. DTSCS51 01079 MOVE WRK-DISPLAY-QTR-Q TO MAP-EFF-QTR-Q. DTSCS51 01080 DTSCS51 01081 MOVE MRTE-EFF-YRQ TO L006-YRQ. DTSCS51 01082 PERFORM S006-RATE-PERIOD THRU S006-EXIT. DTSCS51 01083 DTSCS51 01084 MOVE L006-RTE-YR-START-DATE TO L001-FED-8-DATE-9. DTSCS51 01085 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS51 01086 MOVE L001-SLASH-DATE TO MAP-PERIOD-FROM. DTSCS51 01087 DTSCS51 01088 MOVE L006-RTE-YR-END-DATE TO L001-FED-8-DATE-9. DTSCS51 01089 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS51 01090 MOVE L001-SLASH-DATE TO MAP-PERIOD-TO. DTSCS51 01091 DTSCS51 01092 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS51 01093 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT. DTSCS51 01094 MOVE L056-DISP-RATE TO MAP-RATE. DTSCS51 01095 DTSCS51 01096 DTSCS51 01097 IF MRTE-NOTICE-DATE = +0 DTSCS51 01098 NEXT SENTENCE DTSCS51 01099 ELSE DTSCS51 01100 MOVE MRTE-NOTICE-DATE TO WRK-DISPLAY DTSCS51 01101 MOVE WRK-DISPLAY-MO TO MAP-NOTICE-DATE-MO DTSCS51 01102 MOVE WRK-DISPLAY-DA TO MAP-NOTICE-DATE-DA DTSCS51 01103 MOVE WRK-DISPLAY-YR TO MAP-NOTICE-DATE-YR. DTSCS51 01104 DTSCS51 01105 MOVE MRTE-RATE-TYPE-IND TO MAP-RATE-TYPE. DTSCS51 01106 IF MRTE-RATE-TYPE-REG-88 DTSCS51 01107 MOVE 'REGULAR' TO MAP-RATE-TYPE-DESC DTSCS51 01108 ELSE DTSCS51 01109 IF MRTE-RATE-TYPE-ESTIM-88 DTSCS51 01110 MOVE 'ESTIMATED' TO MAP-RATE-TYPE-DESC DTSCS51 01111 ELSE DTSCS51 01112 IF MRTE-RATE-TYPE-TRANS-88 DTSCS51 01113 MOVE 'TRANSITIONAL' TO MAP-RATE-TYPE-DESC DTSCS51 01114 ELSE DTSCS51 01115 IF MRTE-RATE-TYPE-FINAL-88 DTSCS51 01116 MOVE 'FINAL' TO MAP-RATE-TYPE-DESC. DTSCS51 01117 DTSCS51 01118 IF MRTE-MREL-PRED-NO NOT NUMERIC DTSCS51 01119 MOVE +0 TO MRTE-MREL-PRED-NO DTSCS51 01120 END-IF. DTSCS51 01121 IF MRTE-MREL-PRED-NO = +0 DTSCS51 01122 NEXT SENTENCE DTSCS51 01123 ELSE DTSCS51 01124 MOVE MRTE-MREL-PRED-NO TO WRK-DISPLAY DTSCS51 01125 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-NO-1 DTSCS51 01126 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-NO-2 DTSCS51 01127 END-IF. DTSCS51 01128 DTSCS51 01129 IF MRTE-MREL-EFF-DATE NOT NUMERIC DTSCS51 01130 MOVE +0 TO MRTE-MREL-EFF-DATE DTSCS51 01131 END-IF. DTSCS51 01132 IF MRTE-MREL-EFF-DATE = +0 DTSCS51 01133 NEXT SENTENCE DTSCS51 01134 ELSE DTSCS51 01135 MOVE MRTE-MREL-EFF-DATE TO WRK-DISPLAY DTSCS51 01136 MOVE WRK-DISPLAY-MO TO MAP-MREL-EFF-DATE-MO DTSCS51 01137 MOVE WRK-DISPLAY-DA TO MAP-MREL-EFF-DATE-DA DTSCS51 01138 MOVE WRK-DISPLAY-YR TO MAP-MREL-EFF-DATE-YR DTSCS51 01139 END-IF. DTSCS51 01140 DTSCS51 01141 P6910-EXIT. DTSCS51 01142 EXIT. DTSCS51 01143 DTSCS51 01144 P6990-PAGE-NUMBER. DTSCS51 01145 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS51 01146 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS51 01147 DTSCS51 01148 IF WS-REC-NUM = +1 DTSCS51 01149 IF LAST-REC-NUM = +1 DTSCS51 01150 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS51 01151 ELSE DTSCS51 01152 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS51 01153 ELSE DTSCS51 01154 IF WS-REC-NUM = LAST-REC-NUM DTSCS51 01155 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS51 01156 P6990-EXIT. DTSCS51 01157 EXIT. DTSCS51 01158 /*****************************************************************DTSCS51 01159 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS51 01160 ******************************************************************DTSCS51 01161 DTSCS51 01162 P7000-REQUEST-EDIT. DTSCS51 01163 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS51 01164 DTSCS51 01165 IF LCCM-F09-88 DTSCS51 01166 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS51 01167 ELSE DTSCS51 01168 IF LCCM-F10-88 DTSCS51 01169 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS51 01170 ELSE DTSCS51 01171 IF LCCM-F23-88 DTSCS51 01172 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS51 01173 ELSE DTSCS51 01174 GO TO S899-ABEND. DTSCS51 01175 DTSCS51 01176 *------------------------------------------------------ DTSCS51 01177 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS51 01178 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS51 01179 * REMAIN IN 'INQUIRE' STATUS. DTSCS51 01180 *------------------------------------------------------ DTSCS51 01181 DTSCS51 01182 IF LCCM-MSG DTSCS51 01183 NEXT SENTENCE DTSCS51 01184 ELSE DTSCS51 01185 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS51 01186 IF LCCM-F09-88 DTSCS51 01187 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS51 01188 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS51 01189 ELSE DTSCS51 01190 IF LCCM-F10-88 DTSCS51 01191 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS51 01192 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS51 01193 ELSE DTSCS51 01194 IF LCCM-F23-88 DTSCS51 01195 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS51 01196 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS51 01197 DTSCS51 01198 SET RESP-SEND-MAP TO TRUE. DTSCS51 01199 P7000-EXIT. DTSCS51 01200 EXIT. DTSCS51 01201 /*****************************************************************DTSCS51 01202 * ADD FUNCTION WAS REQUESTED *DTSCS51 01203 ******************************************************************DTSCS51 01204 DTSCS51 01205 P7100-EDIT-ADD. DTSCS51 01206 *----------------------------------------------------- DTSCS51 01207 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS51 01208 *----------------------------------------------------- DTSCS51 01209 IF NOT LCCM-SCR-CLEAR DTSCS51 01210 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS51 01211 GO TO P7100-EXIT. DTSCS51 01212 DTSCS51 01213 *----------------------------------------------------- DTSCS51 01214 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS51 01215 *----------------------------------------------------- DTSCS51 01216 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 01217 IF LCCM-MSG DTSCS51 01218 GO TO P7100-EXIT. DTSCS51 01219 DTSCS51 01220 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS51 01221 P7100-EXIT. DTSCS51 01222 EXIT. DTSCS51 01223 /*****************************************************************DTSCS51 01224 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS51 01225 ******************************************************************DTSCS51 01226 DTSCS51 01227 P7200-EDIT-MOD. DTSCS51 01228 *----------------------------------------------------- DTSCS51 01229 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS51 01230 * INQUIRED DTSCS51 01231 *----------------------------------------------------- DTSCS51 01232 IF NOT LCCM-SCR-INQUIRE DTSCS51 01233 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS51 01234 GO TO P7200-EXIT. DTSCS51 01235 DTSCS51 01236 *----------------------------------------------------- DTSCS51 01237 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS51 01238 *----------------------------------------------------- DTSCS51 01239 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 01240 IF LCCM-MSG DTSCS51 01241 GO TO P7200-EXIT. DTSCS51 01242 DTSCS51 01243 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS51 01244 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS51 01245 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 01246 GO TO P7200-EXIT. DTSCS51 01247 DTSCS51 01248 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS51 01249 DTSCS51 01250 P7200-EXIT. DTSCS51 01251 EXIT. DTSCS51 01252 /*****************************************************************DTSCS51 01253 * DELETE FUNCTION WAS REQUESTED *DTSCS51 01254 ******************************************************************DTSCS51 01255 DTSCS51 01256 P7300-EDIT-DEL. DTSCS51 01257 *----------------------------------------------------- DTSCS51 01258 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS51 01259 * INQUIRED DTSCS51 01260 *----------------------------------------------------- DTSCS51 01261 IF NOT LCCM-SCR-INQUIRE DTSCS51 01262 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS51 01263 GO TO P7300-EXIT. DTSCS51 01264 DTSCS51 01265 *----------------------------------------------------- DTSCS51 01266 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS51 01267 *----------------------------------------------------- DTSCS51 01268 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 01269 IF LCCM-MSG DTSCS51 01270 GO TO P7300-EXIT. DTSCS51 01271 DTSCS51 01272 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS51 01273 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS51 01274 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 01275 GO TO P7300-EXIT. DTSCS51 01276 DTSCS51 01277 P7300-EXIT. DTSCS51 01278 EXIT. DTSCS51 01279 /*****************************************************************DTSCS51 01280 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS51 01281 ******************************************************************DTSCS51 01282 DTSCS51 01283 P8000-REQUEST-UPDATE. DTSCS51 01284 IF LCCM-SCR-ADD-LOCKED DTSCS51 01285 PERFORM P8100-ADD THRU P8100-EXIT DTSCS51 01286 ELSE DTSCS51 01287 IF LCCM-SCR-MOD-LOCKED DTSCS51 01288 PERFORM P8200-MOD THRU P8200-EXIT DTSCS51 01289 ELSE DTSCS51 01290 IF LCCM-SCR-DEL-LOCKED DTSCS51 01291 PERFORM P8300-DEL THRU P8300-EXIT DTSCS51 01292 ELSE DTSCS51 01293 GO TO S899-ABEND. DTSCS51 01294 DTSCS51 01295 SET RESP-SEND-MAP TO TRUE. DTSCS51 01296 P8000-EXIT. DTSCS51 01297 EXIT. DTSCS51 01298 /*****************************************************************DTSCS51 01299 * *DTSCS51 01300 ******************************************************************DTSCS51 01301 P8100-ADD. DTSCS51 01302 SET LCCM-SCR-CLEAR TO TRUE. DTSCS51 01303 DTSCS51 01304 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS51 01305 DTSCS51 01306 IF LCCM-F12-88 DTSCS51 01307 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS51 01308 GO TO P8100-EXIT. DTSCS51 01309 DTSCS51 01310 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 01311 DTSCS51 01312 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS51 01313 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS51 01314 IF LCCM-MSG DTSCS51 01315 GO TO P8100-EXIT. DTSCS51 01316 DTSCS51 01317 MOVE LOW-VALUES TO MRTE-DATA-AREA. DTSCS51 01318 DTSCS51 01319 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS51 01320 DTSCS51 01321 PERFORM P8110-CONSTRUCT-MRTE THRU P8110-EXIT. DTSCS51 01322 DTSCS51 01323 MOVE MRTE-REC TO MSKL-REC. DTSCS51 01324 PERFORM S810-WRITE THRU S810-EXIT. DTSCS51 01325 DTSCS51 01326 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS51 01327 DTSCS51 01328 DTSCS51 01329 MOVE MRTE-KEY-AREA TO LCCM-SCR51-HOLD-AREA. DTSCS51 01330 DTSCS51 01331 SET LCCM-ENTER-88 TO TRUE. DTSCS51 01332 DTSCS51 01333 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS51 01334 DTSCS51 01335 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS51 01336 DTSCS51 01337 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS51 01338 P8100-EXIT. DTSCS51 01339 EXIT. DTSCS51 01340 DTSCS51 01341 P8110-CONSTRUCT-MRTE. DTSCS51 01342 MOVE LOW-VALUES TO MRTE-REC. DTSCS51 01343 DTSCS51 01344 MOVE WRK-EMP-NO TO MRTE-EMP-NO. DTSCS51 01345 DTSCS51 01346 SET MRTE-RTE-88 TO TRUE. DTSCS51 01347 DTSCS51 01348 MOVE MAP-EFF-QTR-AREA TO L016-S-YRQ-AREA. DTSCS51 01349 PERFORM S016-QTR-FROM-SCREEN THRU S016-EXIT. DTSCS51 01350 MOVE L016-YRQ TO MRTE-EFF-YRQ. DTSCS51 01351 DTSCS51 01352 MOVE +0 TO MRTE-PURGE-DATE. DTSCS51 01353 DTSCS51 01354 MOVE L016-YRQ TO L006-YRQ DTSCS51 01355 PERFORM S006-RATE-PERIOD THRU S006-EXIT. DTSCS51 01356 MOVE L006-RTE-YR-END-YRQ TO MRTE-END-YRQ. DTSCS51 01357 DTSCS51 01358 *****MOVE MAP-UI-RATE-TYPE TO MRTE-UI-RATE-TYPE. DTSCS51 01359 DTSCS51 01360 MOVE MAP-RATE-AREA TO L012-S-RATE-AREA. DTSCS51 01361 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS51 01362 MOVE L012-RATE TO MRTE-UI-RATE. DTSCS51 01363 DTSCS51 01364 MOVE MAP-NOTICE-DATE-AREA TO L015-S-DATE-AREA. DTSCS51 01365 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS51 01366 MOVE L015-DATE TO MRTE-NOTICE-DATE. DTSCS51 01367 DTSCS51 01368 MOVE MAP-SUTA-DMP-PRED-AREA TO L018-S-EMP-NO-AREA. DTSCS51 01369 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS51 01370 IF L018-NO-ENTRY DTSCS51 01371 MOVE +0 TO MRTE-MREL-PRED-NO DTSCS51 01372 ELSE DTSCS51 01373 MOVE L018-EMP-NO TO MRTE-MREL-PRED-NO DTSCS51 01374 END-IF. DTSCS51 01375 DTSCS51 01376 MOVE MAP-MREL-EFF-DATE-AREA TO L015-S-DATE-AREA. DTSCS51 01377 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS51 01378 MOVE L015-DATE TO MRTE-MREL-EFF-DATE. DTSCS51 01379 DTSCS51 01380 SET MRTE-NOT-CONVERTED-88 TO TRUE. DTSCS51 01381 DTSCS51 01382 MOVE LCCM-CURR-RUN-DATE TO MRTE-ESTB-DATE. DTSCS51 01383 MOVE LCCM-CURR-RUN-DATE TO MRTE-CHNG-DATE. DTSCS51 01384 DTSCS51 01385 *----------------------------------------------------------- DTSCS51 01386 * IF POST UPDATE (ADD OR MOD) MRTE-RATE-TYPE = 'I' DTSCS51 01387 * MACIT006 WITH T006-TRN-CD = '02' DTSCS51 01388 * (UIRTE-SIC-DIVISION-CHK). DTSCS51 01389 * IF MAP-PRINT-RATE-NOTICE = 'Y' DTSCS51 01390 * MACIT006 WITH T006-TRN-CD = '03' (UIRTE-NOTICE). DTSCS51 01391 *----------------------------------------------------------- DTSCS51 01392 *****IF MRTE-UI-RATE-TYPE = 'I' DTSCS51 01393 ********PERFORM P9102-CREATE-T006 THRU P9102-EXIT. DTSCS51 01394 DTSCS51 01395 MOVE 'Y' TO MAP-VERIFY. DTSCS51 01396 MOVE MRTE-EFF-YRQ TO L016-YRQ. DTSCS51 01397 PERFORM S2100-DETERM-RATE-TYPE THRU S2100-EXIT. DTSCS51 01398 DTSCS51 01399 IF WRK-ESTIMATE-NEEDED-88 DTSCS51 01400 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 01401 SET MRTE-RATE-TYPE-FINAL-88 TO TRUE DTSCS51 01402 ELSE DTSCS51 01403 SET MRTE-RATE-TYPE-ESTIM-88 TO TRUE DTSCS51 01404 END-IF DTSCS51 01405 ELSE DTSCS51 01406 IF WRK-TRANSITION-YEAR-88 DTSCS51 01407 SET MRTE-RATE-TYPE-TRANS-88 TO TRUE DTSCS51 01408 ELSE DTSCS51 01409 SET MRTE-RATE-TYPE-REG-88 TO TRUE DTSCS51 01410 END-IF DTSCS51 01411 END-IF. DTSCS51 01412 DTSCS51 01413 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 01414 PERFORM P9103-CREATE-T006 THRU P9103-EXIT. DTSCS51 01415 DTSCS51 01416 PERFORM P9131-CREATE-T031 THRU P9131-EXIT. DTSCS51 01417 DTSCS51 01418 PERFORM P8900-EMP-INIT-MLOG THRU P8900-EXIT. DTSCS51 01419 DTSCS51 01420 PERFORM P8111-REPORT-501 THRU P8111-EXIT. DTSCS51 01421 P8110-EXIT. DTSCS51 01422 EXIT. DTSCS51 01423 P8111-REPORT-501. DTSCS51 01424 MOVE SPACES TO L331-REC-OCC-ID. DTSCS51 01425 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS51 01426 STRING L004-QTR-5-YR DELIMITED BY SIZE DTSCS51 01427 '/' DELIMITED BY SIZE DTSCS51 01428 L004-QTR-5-Q DELIMITED BY SIZE DTSCS51 01429 INTO L331-REC-OCC-ID. DTSCS51 01430 MOVE 'MRTE-UI-RATE ' TO L331-FIELD-NAME. DTSCS51 01431 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS51 01432 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT. DTSCS51 01433 MOVE SPACE TO L331-FROM-VALUE. DTSCS51 01434 MOVE L056-DISP-RATE TO L331-TO-VALUE. DTSCS51 01435 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS51 01436 P8111-EXIT. EXIT. DTSCS51 01437 /*****************************************************************DTSCS51 01438 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS51 01439 ******************************************************************DTSCS51 01440 DTSCS51 01441 P8200-MOD. DTSCS51 01442 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS51 01443 DTSCS51 01444 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS51 01445 DTSCS51 01446 IF LCCM-F12-88 DTSCS51 01447 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS51 01448 GO TO P8200-EXIT. DTSCS51 01449 DTSCS51 01450 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 01451 DTSCS51 01452 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS51 01453 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS51 01454 IF LCCM-MSG DTSCS51 01455 GO TO P8200-EXIT. DTSCS51 01456 DTSCS51 01457 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS51 01458 DTSCS51 01459 PERFORM P8210-CONSTRUCT-MRTE THRU P8210-EXIT. DTSCS51 01460 DTSCS51 01461 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS51 01462 DTSCS51 01463 SET LCCM-ENTER-88 TO TRUE. DTSCS51 01464 DTSCS51 01465 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS51 01466 DTSCS51 01467 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS51 01468 DTSCS51 01469 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS51 01470 P8200-EXIT. DTSCS51 01471 EXIT. DTSCS51 01472 EJECT DTSCS51 01473 P8210-CONSTRUCT-MRTE. DTSCS51 01474 MOVE LCCM-SCR51-HOLD-AREA TO MSKL-KEY-AREA. DTSCS51 01475 PERFORM S810-READ THRU S810-EXIT. DTSCS51 01476 IF L810-NO-REC-88 DTSCS51 01477 GO TO S899-ABEND. DTSCS51 01478 DTSCS51 01479 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01480 DTSCS51 01481 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 01482 IF MRTE-RATE-TYPE-ESTIM-88 DTSCS51 01483 MOVE 'Y' TO MAP-VERIFY DTSCS51 01484 MOVE MRTE-EFF-YRQ TO L016-YRQ DTSCS51 01485 PERFORM S2100-DETERM-RATE-TYPE THRU S2100-EXIT DTSCS51 01486 IF WRK-ESTIMATE-NEEDED-88 DTSCS51 01487 SET MRTE-RATE-TYPE-FINAL-88 TO TRUE DTSCS51 01488 ELSE DTSCS51 01489 SET MRTE-RATE-TYPE-REG-88 TO TRUE DTSCS51 01490 END-IF DTSCS51 01491 ELSE DTSCS51 01492 IF MRTE-RATE-TYPE-TRANS-88 DTSCS51 01493 OR MRTE-RATE-TYPE-FINAL-88 DTSCS51 01494 NEXT SENTENCE DTSCS51 01495 ELSE DTSCS51 01496 SET MRTE-RATE-TYPE-REG-88 TO TRUE DTSCS51 01497 END-IF DTSCS51 01498 END-IF DTSCS51 01499 END-IF. DTSCS51 01500 DTSCS51 01501 MOVE MRTE-UI-RATE TO WRK-OLD-RATE. DTSCS51 01502 DTSCS51 01503 MOVE MAP-RATE-AREA TO L012-S-RATE-AREA. DTSCS51 01504 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS51 01505 MOVE L012-RATE TO MRTE-UI-RATE DTSCS51 01506 DTSCS51 01507 MOVE MAP-NOTICE-DATE-AREA TO L015-S-DATE-AREA. DTSCS51 01508 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS51 01509 MOVE L015-DATE TO MRTE-NOTICE-DATE. DTSCS51 01510 DTSCS51 01511 MOVE MAP-SUTA-DMP-PRED-AREA TO L018-S-EMP-NO-AREA. DTSCS51 01512 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS51 01513 IF L018-NO-ENTRY DTSCS51 01514 MOVE +0 TO MRTE-MREL-PRED-NO DTSCS51 01515 ELSE DTSCS51 01516 MOVE L018-EMP-NO TO MRTE-MREL-PRED-NO DTSCS51 01517 END-IF. DTSCS51 01518 DTSCS51 01519 MOVE MAP-MREL-EFF-DATE-AREA TO L015-S-DATE-AREA. DTSCS51 01520 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS51 01521 MOVE L015-DATE TO MRTE-MREL-EFF-DATE. DTSCS51 01522 DTSCS51 01523 MOVE LCCM-CURR-RUN-DATE TO MRTE-CHNG-DATE. DTSCS51 01524 *----------------------------------------------------------- DTSCS51 01525 * IF POST UPDATE (ADD OR MOD) MRTE-RATE-TYPE = 'I' DTSCS51 01526 * MACIT006 WITH T006-TRN-CD = '02' DTSCS51 01527 * (UIRTE-SIC-DIVISION-CHK). DTSCS51 01528 * IF MAP-PRINT-RATE-NOTICE = 'Y' DTSCS51 01529 * MACIT006 WITH T006-TRN-CD = '03' (UIRTE-NOTICE). DTSCS51 01530 * IF MRTE-RATE MODIFIED DTSCS51 01531 * MACIT031 WITH T031-TRN-CD = '01' (AUTO-PROCESS). DTSCS51 01532 *----------------------------------------------------------- DTSCS51 01533 MOVE MRTE-EFF-YRQ TO L006-YRQ. DTSCS51 01534 PERFORM S006-RATE-PERIOD THRU S006-EXIT. DTSCS51 01535 DTSCS51 01536 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 01537 PERFORM P9103-CREATE-T006 THRU P9103-EXIT. DTSCS51 01538 DTSCS51 01539 IF MRTE-UI-RATE NOT = WRK-OLD-RATE DTSCS51 01540 PERFORM P9131-CREATE-T031 THRU P9131-EXIT. DTSCS51 01541 DTSCS51 01542 PERFORM P8900-EMP-INIT-MLOG THRU P8900-EXIT. DTSCS51 01543 DTSCS51 01544 PERFORM P8211-REPORT-501 THRU P8211-EXIT. DTSCS51 01545 DTSCS51 01546 MOVE MRTE-REC TO MSKL-REC. DTSCS51 01547 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS51 01548 P8210-EXIT. DTSCS51 01549 EXIT. DTSCS51 01550 P8211-REPORT-501. DTSCS51 01551 IF MRTE-UI-RATE NOT = WRK-OLD-RATE DTSCS51 01552 MOVE 'MRTE-UI-RATE ' TO L331-FIELD-NAME DTSCS51 01553 MOVE SPACES TO L331-REC-OCC-ID DTSCS51 01554 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9 DTSCS51 01555 STRING L004-QTR-5-YR DELIMITED BY SIZE DTSCS51 01556 '/' DELIMITED BY SIZE DTSCS51 01557 L004-QTR-5-Q DELIMITED BY SIZE DTSCS51 01558 INTO L331-REC-OCC-ID DTSCS51 01559 MOVE WRK-OLD-RATE TO L056-RATE DTSCS51 01560 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT DTSCS51 01561 MOVE L056-DISP-RATE TO L331-FROM-VALUE DTSCS51 01562 MOVE MRTE-UI-RATE TO L056-RATE DTSCS51 01563 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT DTSCS51 01564 MOVE L056-DISP-RATE TO L331-TO-VALUE DTSCS51 01565 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS51 01566 P8211-EXIT. DTSCS51 01567 EXIT. DTSCS51 01568 DTSCS51 01569 /*****************************************************************DTSCS51 01570 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS51 01571 ******************************************************************DTSCS51 01572 DTSCS51 01573 P8300-DEL. DTSCS51 01574 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS51 01575 DTSCS51 01576 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS51 01577 DTSCS51 01578 IF LCCM-F12-88 DTSCS51 01579 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS51 01580 GO TO P8300-EXIT. DTSCS51 01581 DTSCS51 01582 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS51 01583 DTSCS51 01584 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS51 01585 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS51 01586 IF LCCM-MSG DTSCS51 01587 GO TO P8300-EXIT. DTSCS51 01588 DTSCS51 01589 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS51 01590 DTSCS51 01591 MOVE LCCM-SCR51-HOLD-AREA TO MSKL-KEY-AREA. DTSCS51 01592 PERFORM S810-READ THRU S810-EXIT. DTSCS51 01593 IF L810-NO-REC-88 DTSCS51 01594 GO TO S899-ABEND. DTSCS51 01595 DTSCS51 01596 MOVE MSKL-REC TO MRTE-REC. DTSCS51 01597 *----------------------------------------------------------- DTSCS51 01598 * IF MRTE RECORD IS DELETED DTSCS51 01599 * MACIT006 WITH T006-TRN-CD = '01' (UIRTE-EXIST-CHK). DTSCS51 01600 *----------------------------------------------------------- DTSCS51 01601 MOVE MRTE-EFF-YRQ TO L006-YRQ. DTSCS51 01602 PERFORM S006-RATE-PERIOD THRU S006-EXIT. DTSCS51 01603 DTSCS51 01604 PERFORM P9101-CREATE-T006 THRU P9101-EXIT. DTSCS51 01605 PERFORM P8900-EMP-INIT-MLOG THRU P8900-EXIT. DTSCS51 01606 PERFORM P8311-REPORT-501 THRU P8311-EXIT. DTSCS51 01607 DTSCS51 01608 PERFORM S810-DELETE THRU S810-EXIT. DTSCS51 01609 DTSCS51 01610 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS51 01611 DTSCS51 01612 MOVE LOW-VALUES TO MAP-AREA. DTSCS51 01613 DTSCS51 01614 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS51 01615 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS51 01616 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS51 01617 DTSCS51 01618 MOVE MRTE-EFF-YRQ TO WRK-DISPLAY. DTSCS51 01619 MOVE WRK-DISPLAY-QTR-YR TO MAP-EFF-QTR-YR. DTSCS51 01620 MOVE WRK-DISPLAY-QTR-Q TO MAP-EFF-QTR-Q. DTSCS51 01621 DTSCS51 01622 SET LCCM-SCR-CLEAR TO TRUE. DTSCS51 01623 DTSCS51 01624 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS51 01625 DTSCS51 01626 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS51 01627 DTSCS51 01628 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS51 01629 P8300-EXIT. DTSCS51 01630 EXIT. DTSCS51 01631 EJECT DTSCS51 01632 DTSCS51 01633 P8311-REPORT-501. DTSCS51 01634 MOVE 'MRTE-UI-RATE ' TO L331-FIELD-NAME. DTSCS51 01635 MOVE SPACES TO L331-REC-OCC-ID. DTSCS51 01636 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSCS51 01637 STRING L004-QTR-5-YR DELIMITED BY SIZE DTSCS51 01638 '/' DELIMITED BY SIZE DTSCS51 01639 L004-QTR-5-Q DELIMITED BY SIZE DTSCS51 01640 INTO L331-REC-OCC-ID. DTSCS51 01641 MOVE MRTE-UI-RATE TO L056-RATE. DTSCS51 01642 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT. DTSCS51 01643 MOVE L056-DISP-RATE TO L331-FROM-VALUE. DTSCS51 01644 MOVE SPACES TO L331-TO-VALUE. DTSCS51 01645 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS51 01646 DTSCS51 01647 P8311-EXIT. EXIT. DTSCS51 01648 DTSCS51 01649 P8810-LOCK-EMPLOYER. DTSCS51 01650 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS51 01651 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS51 01652 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS51 01653 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS51 01654 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS51 01655 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS51 01656 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS51 01657 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS51 01658 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS51 01659 DTSCS51 01660 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS51 01661 P8810-EXIT. DTSCS51 01662 EXIT. DTSCS51 01663 EJECT DTSCS51 01664 DTSCS51 01665 /*****************************************************************DTSCS51 01666 * *DTSCS51 01667 ******************************************************************DTSCS51 01668 DTSCS51 01669 P8900-EMP-INIT-MLOG. DTSCS51 01670 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS51 01671 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS51 01672 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS51 01673 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS51 01674 P8900-EXIT. EXIT. DTSCS51 01675 DTSCS51 01676 P9101-CREATE-T006. DTSCS51 01677 PERFORM P9111-INIT-T006 THRU P9111-EXIT DTSCS51 01678 SET T006-UIRTE-EXIST-CHK TO TRUE. DTSCS51 01679 MOVE LENGTH OF T006-REC TO T006-LENGTH. DTSCS51 01680 MOVE T006-REC TO RSKL-REC. DTSCS51 01681 PERFORM S825-WRITE THRU S825-EXIT. DTSCS51 01682 P9101-EXIT. DTSCS51 01683 EXIT. DTSCS51 01684 DTSCS51 01685 *P9102-CREATE-T006. DTSCS51 01686 *****PERFORM P9111-INIT-T006 THRU P9111-EXIT DTSCS51 01687 *****SET T006-UIRTE-SIC-DIVISION-CHK TO TRUE DTSCS51 01688 *****MOVE T006-REC TO RSKL-REC DTSCS51 01689 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS51 01690 *P9102-EXIT. DTSCS51 01691 *****EXIT. DTSCS51 01692 DTSCS51 01693 P9103-CREATE-T006. DTSCS51 01694 PERFORM P9111-INIT-T006 THRU P9111-EXIT. DTSCS51 01695 SET T006-UIRTE-NOTICE TO TRUE. DTSCS51 01696 MOVE LENGTH OF T006-REC TO T006-LENGTH. DTSCS51 01697 MOVE T006-REC TO RSKL-REC. DTSCS51 01698 PERFORM S825-WRITE THRU S825-EXIT. DTSCS51 01699 P9103-EXIT. DTSCS51 01700 EXIT. DTSCS51 01701 DTSCS51 01702 P9111-INIT-T006. DTSCS51 01703 MOVE WRK-EMP-NO TO T006-EMP-NO. DTSCS51 01704 MOVE LCCM-OP-ID TO T006-OP-ID. DTSCS51 01705 MOVE WRK-SCR-ID TO T006-SCR-ID. DTSCS51 01706 MOVE LCCM-TASK-START-DATE TO T006-SYS-DATE. DTSCS51 01707 MOVE LCCM-TASK-START-TIME TO T006-SYS-TIME. DTSCS51 01708 MOVE LCCM-OP-ID TO T006-RESP-OP-ID. DTSCS51 01709 MOVE L006-RTE-YR-START-YRQ TO T006-START-YRQ. DTSCS51 01710 MOVE L006-RTE-YR-END-YRQ TO T006-END-YRQ. DTSCS51 01711 P9111-EXIT. DTSCS51 01712 EXIT. DTSCS51 01713 DTSCS51 01714 P9131-CREATE-T031. DTSCS51 01715 MOVE WRK-EMP-NO TO T031-EMP-NO DTSCS51 01716 MOVE LCCM-OP-ID TO T031-OP-ID. DTSCS51 01717 MOVE WRK-SCR-ID TO T031-SCR-ID. DTSCS51 01718 MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE. DTSCS51 01719 MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME. DTSCS51 01720 SET T031-AUTO-PROCESS TO TRUE DTSCS51 01721 MOVE L006-RTE-YR-START-YRQ TO T031-START-YRQ. DTSCS51 01722 MOVE L006-RTE-YR-END-YRQ TO T031-END-YRQ. DTSCS51 01723 MOVE ZEROS TO DTSCS51 01724 T031-WAIVER-START-YRQ DTSCS51 01725 T031-WAIVER-END-YRQ DTSCS51 01726 T031-WAIVER-EXT-DATE. DTSCS51 01727 SET T031-TRANSFER-NO-88 TO TRUE. DTSCS51 01728 MOVE +0 TO T031-TRANSFER-TO-EMP-NO. DTSCS51 01729 MOVE LENGTH OF T031-REC TO T031-LENGTH. DTSCS51 01730 MOVE T031-REC TO RSKL-REC. DTSCS51 01731 PERFORM S825-WRITE THRU S825-EXIT. DTSCS51 01732 P9131-EXIT. DTSCS51 01733 EXIT. DTSCS51 01734 /*****************************************************************DTSCS51 01735 * LINKS TO UTILITY MODULES DTSCS51 01736 ******************************************************************DTSCS51 01737 DTSCS51 01738 S001-FROM-FED-8. DTSCS51 01739 SET L001-FROM-FED-8 TO TRUE. DTSCS51 01740 GO TO S001-DATE. DTSCS51 01741 DTSCS51 01742 S001-FROM-ABS-DATE. DTSCS51 01743 SET L001-FROM-ABS-DAY TO TRUE. DTSCS51 01744 GO TO S001-DATE. DTSCS51 01745 DTSCS51 01746 S001-DATE. DTSCS51 01747 EXEC CICS LINK DTSCS51 01748 PROGRAM('DTSCU001') DTSCS51 01749 COMMAREA(L001-COMM-AREA) DTSCS51 01750 END-EXEC. DTSCS51 01751 S001-EXIT. DTSCS51 01752 EXIT. DTSCS51 01753 DTSCS51 01754 S004-FROM-5. DTSCS51 01755 SET L004-FROM-5 TO TRUE. DTSCS51 01756 GO TO S004-YRQ. DTSCS51 01757 DTSCS51 01758 S004-FROM-ABS. DTSCS51 01759 SET L004-FROM-ABS TO TRUE. DTSCS51 01760 GO TO S004-YRQ. DTSCS51 01761 DTSCS51 01762 S004-FROM-DATE. DTSCS51 01763 SET L004-FROM-DATE TO TRUE. DTSCS51 01764 GO TO S004-YRQ. DTSCS51 01765 DTSCS51 01766 S004-YRQ. DTSCS51 01767 EXEC CICS LINK DTSCS51 01768 PROGRAM('DTSCU004') DTSCS51 01769 COMMAREA(L004-COMM-AREA) DTSCS51 01770 END-EXEC. DTSCS51 01771 S004-EXIT. DTSCS51 01772 EXIT. DTSCS51 01773 DTSCS51 01774 S006-RATE-PERIOD. DTSCS51 01775 SET L006-FROM-QTR TO TRUE. DTSCS51 01776 EXEC CICS LINK DTSCS51 01777 PROGRAM('DTSCU006') DTSCS51 01778 COMMAREA(L006-COMM-AREA) DTSCS51 01779 END-EXEC. DTSCS51 01780 S006-EXIT. DTSCS51 01781 EXIT. DTSCS51 01782 DTSCS51 01783 S012-RATE-FROM-SCREEN. DTSCS51 01784 EXEC CICS LINK DTSCS51 01785 PROGRAM('DTSCU012') DTSCS51 01786 COMMAREA(L012-COMM-AREA) DTSCS51 01787 END-EXEC. DTSCS51 01788 S012-EXIT. DTSCS51 01789 EXIT. DTSCS51 01790 DTSCS51 01791 S015-DATE-FROM-SCREEN. DTSCS51 01792 EXEC CICS LINK DTSCS51 01793 PROGRAM('DTSCU015') DTSCS51 01794 COMMAREA(L015-COMM-AREA) DTSCS51 01795 END-EXEC. DTSCS51 01796 S015-EXIT. DTSCS51 01797 EXIT. DTSCS51 01798 DTSCS51 01799 S016-QTR-FROM-SCREEN. DTSCS51 01800 EXEC CICS LINK DTSCS51 01801 PROGRAM('DTSCU016') DTSCS51 01802 COMMAREA(L016-COMM-AREA) DTSCS51 01803 END-EXEC. DTSCS51 01804 S016-EXIT. DTSCS51 01805 EXIT. DTSCS51 01806 DTSCS51 01807 S018-EMP-NO-FROM-SCREEN. DTSCS51 01808 EXEC CICS LINK DTSCS51 01809 PROGRAM('DTSCU018') DTSCS51 01810 COMMAREA(L018-COMM-AREA) DTSCS51 01811 END-EXEC. DTSCS51 01812 S018-EXIT. DTSCS51 01813 EXIT. DTSCS51 01814 DTSCS51 01815 *S031-REG-CODES. DTSCS51 01816 *****EXEC CICS LINK DTSCS51 01817 *********PROGRAM('DTSCU031') DTSCS51 01818 *********COMMAREA(L031-COMM-AREA) DTSCS51 01819 *****END-EXEC. DTSCS51 01820 *S031-EXIT. DTSCS51 01821 *****EXIT. DTSCS51 01822 DTSCS51 01823 *S035-RATE-CODES. DTSCS51 01824 *****EXEC CICS LINK DTSCS51 01825 *********PROGRAM('DTSCU035') DTSCS51 01826 *********COMMAREA(L035-COMM-AREA) DTSCS51 01827 *****END-EXEC. DTSCS51 01828 *S035-EXIT. DTSCS51 01829 *****EXIT. DTSCS51 01830 DTSCS51 01831 S052-RATE-EDIT. DTSCS51 01832 EXEC CICS LINK DTSCS51 01833 PROGRAM('DTSCU052') DTSCS51 01834 COMMAREA(L052-COMM-AREA) DTSCS51 01835 END-EXEC. DTSCS51 01836 DTSCS51 01837 IF L052-FILE-CLOSED DTSCS51 01838 MOVE L052-MSG-AREA TO LCCM-MSG-AREA DTSCS51 01839 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 01840 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 01841 GO TO MAINLINE-EXIT. DTSCS51 01842 S052-EXIT. DTSCS51 01843 EXIT. DTSCS51 01844 DTSCS51 01845 S054-RATE-DETERMINATION. DTSCS51 01846 EXEC CICS LINK DTSCS51 01847 PROGRAM('DTSCU054') DTSCS51 01848 COMMAREA(L054-COMM-AREA) DTSCS51 01849 END-EXEC. DTSCS51 01850 DTSCS51 01851 IF L054-FILE-CLOSED-88 DTSCS51 01852 MOVE L054-MSG-AREA TO LCCM-MSG-AREA DTSCS51 01853 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 01854 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 01855 GO TO MAINLINE-EXIT. DTSCS51 01856 S054-EXIT. DTSCS51 01857 EXIT. DTSCS51 01858 DTSCS51 01859 *S056-RATE-DISPLAY-RIGHT. DTSCS51 01860 *****SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS51 01861 *****GO TO S056-RATE-DISPLAY. DTSCS51 01862 DTSCS51 01863 S056-RATE-DISPLAY-LEFT. DTSCS51 01864 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS51 01865 GO TO S056-RATE-DISPLAY. DTSCS51 01866 DTSCS51 01867 S056-RATE-DISPLAY. DTSCS51 01868 EXEC CICS LINK DTSCS51 01869 PROGRAM('DTSCU056') DTSCS51 01870 COMMAREA(L056-COMM-AREA) DTSCS51 01871 END-EXEC. DTSCS51 01872 S056-EXIT. DTSCS51 01873 EXIT. DTSCS51 01874 DTSCS51 01875 S084-APPROVAL. DTSCS51 01876 EXEC CICS LINK DTSCS51 01877 PROGRAM('DTSCU084') DTSCS51 01878 COMMAREA(L084-COMM-AREA) DTSCS51 01879 END-EXEC. DTSCS51 01880 DTSCS51 01881 IF L084-FILE-CLOSED-88 DTSCS51 01882 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 01883 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 01884 GO TO MAINLINE-EXIT. DTSCS51 01885 S084-EXIT. DTSCS51 01886 EXIT. DTSCS51 01887 DTSCS51 01888 S221-EMP-LOCK. DTSCS51 01889 SET L221-START-UPDATE TO TRUE. DTSCS51 01890 GO TO S221-EMP-LOCK-UNLOCK. DTSCS51 01891 DTSCS51 01892 S221-EMP-UNLOCK. DTSCS51 01893 SET L221-END-UPDATE TO TRUE. DTSCS51 01894 GO TO S221-EMP-LOCK-UNLOCK. DTSCS51 01895 DTSCS51 01896 S221-EMP-LOCK-UNLOCK. DTSCS51 01897 EXEC CICS LINK DTSCS51 01898 PROGRAM('DTSCU221') DTSCS51 01899 COMMAREA(L221-COMM-AREA) DTSCS51 01900 END-EXEC. DTSCS51 01901 DTSCS51 01902 IF L221-FILE-CLOSED DTSCS51 01903 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS51 01904 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 01905 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 01906 GO TO MAINLINE-EXIT. DTSCS51 01907 DTSCS51 01908 IF L221-NOT-OK DTSCS51 01909 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS51 01910 S221-EXIT. DTSCS51 01911 EXIT. DTSCS51 01912 DTSCS51 01913 S331-EMP-WRITE-MLOG. DTSCS51 01914 DTSCS51 01915 EXEC CICS LINK DTSCS51 01916 PROGRAM('DTSCU331') DTSCS51 01917 COMMAREA(L331-COMM-AREA) DTSCS51 01918 END-EXEC. DTSCS51 01919 DTSCS51 01920 IF L331-FILE-CLOSED DTSCS51 01921 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS51 01922 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 01923 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 01924 GO TO MAINLINE-EXIT. DTSCS51 01925 S331-EXIT. DTSCS51 01926 EXIT. DTSCS51 01927 DTSCS51 01928 S410-FILING-SCHEDULE. DTSCS51 01929 EXEC CICS LINK DTSCS51 01930 PROGRAM('DTSCU410') DTSCS51 01931 COMMAREA(L410-COMM-AREA) DTSCS51 01932 END-EXEC. DTSCS51 01933 S410-EXIT. DTSCS51 01934 EXIT. DTSCS51 01935 DTSCS51 01936 S803-REQ-SCR-ID-EDIT. DTSCS51 01937 EXEC CICS LINK DTSCS51 01938 PROGRAM ('DTSCU803') DTSCS51 01939 COMMAREA (DFHCOMMAREA) DTSCS51 01940 END-EXEC. DTSCS51 01941 S803-EXIT. DTSCS51 01942 EXIT. DTSCS51 01943 DTSCS51 01944 S804-INVALID-KEY. DTSCS51 01945 EXEC CICS LINK DTSCS51 01946 PROGRAM ('DTSCU804') DTSCS51 01947 COMMAREA (DFHCOMMAREA) DTSCS51 01948 END-EXEC. DTSCS51 01949 S804-EXIT. DTSCS51 01950 EXIT. DTSCS51 01951 DTSCS51 01952 S805-MSG-AREA. DTSCS51 01953 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS51 01954 DTSCS51 01955 EXEC CICS LINK DTSCS51 01956 PROGRAM ('DTSCU805') DTSCS51 01957 COMMAREA (L805-COMM-AREA) DTSCS51 01958 END-EXEC. DTSCS51 01959 DTSCS51 01960 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS51 01961 S805-EXIT. DTSCS51 01962 EXIT. DTSCS51 01963 EJECT DTSCS51 01964 S810-READ. DTSCS51 01965 SET L810-READ-88 TO TRUE. DTSCS51 01966 GO TO S810-IO. DTSCS51 01967 DTSCS51 01968 S810-START-BROWSE. DTSCS51 01969 SET L810-START-BROWSE-88 TO TRUE. DTSCS51 01970 GO TO S810-IO. DTSCS51 01971 DTSCS51 01972 S810-READ-NEXT. DTSCS51 01973 SET L810-READ-NEXT-88 TO TRUE. DTSCS51 01974 GO TO S810-IO. DTSCS51 01975 DTSCS51 01976 S810-READ-PREV. DTSCS51 01977 SET L810-READ-PREV-88 TO TRUE. DTSCS51 01978 GO TO S810-IO. DTSCS51 01979 DTSCS51 01980 S810-END-BROWSE. DTSCS51 01981 SET L810-END-BROWSE-88 TO TRUE. DTSCS51 01982 GO TO S810-IO. DTSCS51 01983 DTSCS51 01984 S810-COUNT. DTSCS51 01985 SET L810-COUNT-88 TO TRUE. DTSCS51 01986 GO TO S810-IO. DTSCS51 01987 DTSCS51 01988 S810-REWRITE. DTSCS51 01989 SET L810-REWRITE-88 TO TRUE. DTSCS51 01990 GO TO S810-IO. DTSCS51 01991 DTSCS51 01992 S810-WRITE. DTSCS51 01993 SET L810-WRITE-88 TO TRUE. DTSCS51 01994 GO TO S810-IO. DTSCS51 01995 DTSCS51 01996 S810-DELETE. DTSCS51 01997 SET L810-DELETE-88 TO TRUE. DTSCS51 01998 GO TO S810-IO. DTSCS51 01999 DTSCS51 02000 S810-IO. DTSCS51 02001 DTSCS51 02002 EXEC CICS LINK DTSCS51 02003 PROGRAM ('DTSCU810') DTSCS51 02004 COMMAREA (L810-COMM-AREA) DTSCS51 02005 END-EXEC. DTSCS51 02006 DTSCS51 02007 IF L810-FILE-CLOSED-88 DTSCS51 02008 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02009 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 02010 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 02011 GO TO MAINLINE-EXIT. DTSCS51 02012 S810-EXIT. DTSCS51 02013 EXIT. DTSCS51 02014 EJECT DTSCS51 02015 S825-WRITE. DTSCS51 02016 SET L825-WRITE-88 TO TRUE. DTSCS51 02017 GO TO S825-O. DTSCS51 02018 DTSCS51 02019 S825-O. DTSCS51 02020 DTSCS51 02021 DTSCS51 02022 EXEC CICS LINK DTSCS51 02023 PROGRAM ('DTSCU825') DTSCS51 02024 COMMAREA (L825-COMM-AREA) DTSCS51 02025 END-EXEC. DTSCS51 02026 DTSCS51 02027 IF L825-FILE-CLOSED-88 DTSCS51 02028 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02029 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS51 02030 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS51 02031 GO TO MAINLINE-EXIT. DTSCS51 02032 S825-EXIT. DTSCS51 02033 EXIT. DTSCS51 02034 EJECT DTSCS51 02035 S851-SCREEN-PROCESSING. DTSCS51 02036 EXEC CICS LINK DTSCS51 02037 PROGRAM ('DTSCU851') DTSCS51 02038 COMMAREA (L851-COMM-AREA) DTSCS51 02039 END-EXEC. DTSCS51 02040 S851-EXIT. DTSCS51 02041 EXIT. DTSCS51 02042 DTSCS51 02043 S899-ABEND. DTSCS51 02044 EXEC CICS ABEND DTSCS51 02045 ABCODE(WRK-ABEND-CD) DTSCS51 02046 END-EXEC. DTSCS51 02047 S899-EXIT. DTSCS51 02048 EXIT. DTSCS51 02049 /*****************************************************************DTSCS51 02050 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS51 02051 ******************************************************************DTSCS51 02052 DTSCS51 02053 S1000-SCREEN-EDITS. DTSCS51 02054 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS51 02055 IF LCCM-MSG DTSCS51 02056 GO TO S1000-EXIT. DTSCS51 02057 DTSCS51 02058 ***** DTSCS51 02059 * DTSCS51 02060 * IF EMP CLASS IS NOT REGULAR OR GOVERNMENT, DTSCS51 02061 * THEN SOME OF THE RATE UTILITY MODULES BLOW UP. DTSCS51 02062 * DTSCS51 02063 * THIS WAS AN EASY FIX. DTSCS51 02064 * DTSCS51 02065 ***** DTSCS51 02066 DTSCS51 02067 IF MPRF-CLASS-RATED-88 DTSCS51 02068 NEXT SENTENCE DTSCS51 02069 ELSE DTSCS51 02070 MOVE MSG-E511-AREA TO WRK-MSG-AREA DTSCS51 02071 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 02072 GO TO S1000-EXIT. DTSCS51 02073 DTSCS51 02074 PERFORM S1200-EFF-YRQ THRU S1200-EXIT. DTSCS51 02075 PERFORM S1300-UI-RATE THRU S1300-EXIT. DTSCS51 02076 PERFORM S1500-PRINT-RATE-NOTICE THRU S1500-EXIT. DTSCS51 02077 PERFORM S1600-RATE-NOTICE-DATE THRU S1600-EXIT. DTSCS51 02078 PERFORM S1700-VERIFY THRU S1700-EXIT. DTSCS51 02079 PERFORM S1800-SUTA-DMP-PRED THRU S1800-EXIT. DTSCS51 02080 PERFORM S1900-SUTA-DMP-EFF-DT THRU S1900-EXIT. DTSCS51 02081 DTSCS51 02082 IF LCCM-MSG DTSCS51 02083 GO TO S1000-EXIT. DTSCS51 02084 DTSCS51 02085 PERFORM S2000-MISC-EDITS THRU S2000-EXIT. DTSCS51 02086 DTSCS51 02087 IF LCCM-MSG DTSCS51 02088 GO TO S1000-EXIT. DTSCS51 02089 DTSCS51 02090 ** APPROVAL NOT REQUIRED TO RE-PRINT RATE NOTICE ** DTSCS51 02091 IF LCCM-F10-88 DTSCS51 02092 AND MAP-PRINT-RATE-NOTICE-YES DTSCS51 02093 AND L012-RATE = MRTE-UI-RATE DTSCS51 02094 NEXT SENTENCE DTSCS51 02095 ELSE DTSCS51 02096 PERFORM S3000-APPROVAL THRU S3000-EXIT DTSCS51 02097 END-IF. DTSCS51 02098 DTSCS51 02099 S1000-EXIT. EXIT. DTSCS51 02100 EJECT DTSCS51 02101 S1100-EDIT-KEY. DTSCS51 02102 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS51 02103 S1100-EXIT. EXIT. DTSCS51 02104 /*****************************************************************DTSCS51 02105 * DTSCS51 02106 ******************************************************************DTSCS51 02107 S1101-EMP-NO. DTSCS51 02108 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS51 02109 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS51 02110 DTSCS51 02111 IF L018-NO-ENTRY DTSCS51 02112 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS51 02113 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 02114 GO TO S1101-EXIT. DTSCS51 02115 DTSCS51 02116 IF L018-NOT-VALID DTSCS51 02117 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02118 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 02119 GO TO S1101-EXIT. DTSCS51 02120 DTSCS51 02121 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS51 02122 S1101-EXIT. EXIT. DTSCS51 02123 DTSCS51 02124 S1110-READ-MPRF. DTSCS51 02125 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS51 02126 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS51 02127 SET MPRF-PRF-88 TO TRUE. DTSCS51 02128 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS51 02129 PERFORM S810-READ THRU S810-EXIT. DTSCS51 02130 IF L810-NO-REC-88 DTSCS51 02131 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS51 02132 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 02133 ELSE DTSCS51 02134 MOVE MSKL-REC TO MPRF-REC DTSCS51 02135 SET WRK-MPRF-YES-88 TO TRUE. DTSCS51 02136 S1110-EXIT. DTSCS51 02137 EXIT. DTSCS51 02138 DTSCS51 02139 DTSCS51 02140 S1199-ERROR. DTSCS51 02141 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS51 02142 MAP-EMP-NO-2-A. DTSCS51 02143 IF LCCM-NO-MSG DTSCS51 02144 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02145 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS51 02146 SET CURSOR-SET-YES TO TRUE. DTSCS51 02147 S1199-EXIT. EXIT. DTSCS51 02148 DTSCS51 02149 /*****************************************************************DTSCS51 02150 * DTSCS51 02151 ******************************************************************DTSCS51 02152 S1200-EFF-YRQ. DTSCS51 02153 MOVE +0 TO WRK-EFF-YRQ. DTSCS51 02154 DTSCS51 02155 MOVE MAP-EFF-QTR-AREA TO L016-S-YRQ-AREA. DTSCS51 02156 PERFORM S016-QTR-FROM-SCREEN THRU S016-EXIT. DTSCS51 02157 DTSCS51 02158 IF L016-NO-ENTRY DTSCS51 02159 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS51 02160 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS51 02161 ELSE DTSCS51 02162 IF L016-NOT-VALID DTSCS51 02163 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02164 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS51 02165 ELSE DTSCS51 02166 MOVE L016-YRQ TO L006-YRQ DTSCS51 02167 SET L006-FROM-QTR TO TRUE DTSCS51 02168 PERFORM S006-RATE-PERIOD THRU S006-EXIT DTSCS51 02169 MOVE L006-RTE-YR-START-DATE TO L001-FED-8-DATE-9 DTSCS51 02170 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS51 02171 MOVE L001-SLASH-DATE TO MAP-PERIOD-FROM DTSCS51 02172 MOVE L006-RTE-YR-END-DATE TO L001-FED-8-DATE-9 DTSCS51 02173 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS51 02174 MOVE L001-SLASH-DATE TO MAP-PERIOD-TO DTSCS51 02175 IF L006-RTE-YR-START-YRQ NOT = L016-YRQ DTSCS51 02176 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS51 02177 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS51 02178 ELSE DTSCS51 02179 MOVE L016-YRQ TO WRK-EFF-YRQ. DTSCS51 02180 S1200-EXIT. DTSCS51 02181 EXIT. DTSCS51 02182 S1201-ERROR. DTSCS51 02183 IF LCCM-F10-88 DTSCS51 02184 MOVE CATB-ASKIP-NORM-MDTON TO MAP-EFF-QTR-YR-A DTSCS51 02185 MAP-EFF-QTR-Q-A DTSCS51 02186 ELSE DTSCS51 02187 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS51 02188 TO MAP-EFF-QTR-YR-A DTSCS51 02189 MAP-EFF-QTR-Q-A. DTSCS51 02190 IF LCCM-NO-MSG DTSCS51 02191 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02192 MOVE CATB-CURSOR TO MAP-EFF-QTR-YR-L DTSCS51 02193 SET CURSOR-SET-YES TO TRUE. DTSCS51 02194 S1201-EXIT. EXIT. DTSCS51 02195 /*****************************************************************DTSCS51 02196 * *DTSCS51 02197 ******************************************************************DTSCS51 02198 S1300-UI-RATE. DTSCS51 02199 DTSCS51 02200 MOVE MAP-RATE-AREA TO L012-S-RATE-AREA. DTSCS51 02201 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS51 02202 IF L012-NO-ENTRY DTSCS51 02203 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS51 02204 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS51 02205 ELSE DTSCS51 02206 IF L012-NOT-VALID DTSCS51 02207 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02208 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS51 02209 ELSE DTSCS51 02210 MOVE L012-RATE TO L056-RATE DTSCS51 02211 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT DTSCS51 02212 MOVE L056-DISP-RATE TO MAP-RATE. DTSCS51 02213 S1300-EXIT. DTSCS51 02214 EXIT. DTSCS51 02215 S1301-ERROR. DTSCS51 02216 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS51 02217 TO MAP-RATE-A. DTSCS51 02218 IF LCCM-NO-MSG DTSCS51 02219 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02220 MOVE CATB-CURSOR TO MAP-RATE-L DTSCS51 02221 SET CURSOR-SET-YES TO TRUE. DTSCS51 02222 S1301-EXIT. EXIT. DTSCS51 02223 DTSCS51 02224 /*****************************************************************DTSCS51 02225 * *DTSCS51 02226 ******************************************************************DTSCS51 02227 S1500-PRINT-RATE-NOTICE. DTSCS51 02228 IF MAP-PRINT-RATE-NOTICE = LOW-VALUES OR SPACES DTSCS51 02229 MOVE 'N' TO MAP-PRINT-RATE-NOTICE DTSCS51 02230 ELSE DTSCS51 02231 IF MAP-PRINT-RATE-NOTICE-VALID DTSCS51 02232 CONTINUE DTSCS51 02233 ELSE DTSCS51 02234 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02235 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS51 02236 DTSCS51 02237 S1500-EXIT. EXIT. DTSCS51 02238 DTSCS51 02239 S1501-ERROR. DTSCS51 02240 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS51 02241 TO MAP-PRINT-RATE-NOTICE-A DTSCS51 02242 IF LCCM-NO-MSG DTSCS51 02243 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02244 MOVE CATB-CURSOR TO MAP-PRINT-RATE-NOTICE-L DTSCS51 02245 SET CURSOR-SET-YES TO TRUE. DTSCS51 02246 S1501-EXIT. EXIT. DTSCS51 02247 DTSCS51 02248 /*****************************************************************DTSCS51 02249 * *DTSCS51 02250 ******************************************************************DTSCS51 02251 S1600-RATE-NOTICE-DATE. DTSCS51 02252 MOVE MAP-NOTICE-DATE-AREA TO L015-S-DATE-AREA. DTSCS51 02253 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS51 02254 DTSCS51 02255 IF L015-NO-ENTRY DTSCS51 02256 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 02257 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS51 02258 MOVE WRK-DISPLAY-YR TO MAP-NOTICE-DATE-YR DTSCS51 02259 MOVE WRK-DISPLAY-MO TO MAP-NOTICE-DATE-MO DTSCS51 02260 MOVE WRK-DISPLAY-DA TO MAP-NOTICE-DATE-DA DTSCS51 02261 MOVE LCCM-CURR-RUN-DATE TO L015-DATE DTSCS51 02262 ELSE DTSCS51 02263 GO TO S1600-EXIT DTSCS51 02264 ELSE DTSCS51 02265 IF L015-NOT-VALID DTSCS51 02266 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02267 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS51 02268 GO TO S1600-EXIT. DTSCS51 02269 DTSCS51 02270 ***** DTSCS51 02271 * DTSCS51 02272 * FOLLOWING EDIT ADDED PER DANITA ON 03/03/95. DTSCS51 02273 * DTSCS51 02274 ***** DTSCS51 02275 DTSCS51 02276 *& EDIT BYPASSED FOR TESTING DTSCS51 02277 GO TO S1600-EXIT. DTSCS51 02278 *& DTSCS51 02279 IF WRK-EFF-YRQ = +0 DTSCS51 02280 GO TO S1600-EXIT. DTSCS51 02281 DTSCS51 02282 MOVE WRK-EFF-YRQ TO L004-QTR-5-9. DTSCS51 02283 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS51 02284 IF L004-INVALID-QTR DTSCS51 02285 GO TO S1600-EXIT. DTSCS51 02286 DTSCS51 02287 MOVE L004-QTR-START-DATE TO L001-FED-8-DATE-9. DTSCS51 02288 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS51 02289 SUBTRACT 60 FROM L001-JUL-ABS-DAY. DTSCS51 02290 PERFORM S001-FROM-ABS-DATE THRU S001-EXIT. DTSCS51 02291 DTSCS51 02292 IF L015-DATE < L001-FED-8-DATE-9 DTSCS51 02293 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02294 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS51 02295 S1600-EXIT. EXIT. DTSCS51 02296 DTSCS51 02297 S1601-ERROR. DTSCS51 02298 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-NOTICE-DATE-MO-A DTSCS51 02299 MAP-NOTICE-DATE-DA-A DTSCS51 02300 MAP-NOTICE-DATE-YR-A. DTSCS51 02301 IF LCCM-NO-MSG DTSCS51 02302 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02303 MOVE CATB-CURSOR TO MAP-NOTICE-DATE-MO-L DTSCS51 02304 SET CURSOR-SET-YES TO TRUE. DTSCS51 02305 S1601-EXIT. EXIT. DTSCS51 02306 /*****************************************************************DTSCS51 02307 * *DTSCS51 02308 ******************************************************************DTSCS51 02309 S1700-VERIFY. DTSCS51 02310 IF MAP-VERIFY = LOW-VALUES OR SPACES DTSCS51 02311 GO TO S1700-EXIT DTSCS51 02312 ELSE DTSCS51 02313 IF MAP-VERIFY = 'Y' OR 'N' DTSCS51 02314 GO TO S1700-EXIT DTSCS51 02315 ELSE DTSCS51 02316 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02317 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS51 02318 DTSCS51 02319 S1700-EXIT. EXIT. DTSCS51 02320 DTSCS51 02321 S1701-ERROR. DTSCS51 02322 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VERIFY-A DTSCS51 02323 IF LCCM-NO-MSG DTSCS51 02324 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02325 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS51 02326 SET CURSOR-SET-YES TO TRUE. DTSCS51 02327 S1701-EXIT. EXIT. DTSCS51 02328 DTSCS51 02329 S1800-SUTA-DMP-PRED. DTSCS51 02330 MOVE MAP-SUTA-DMP-PRED-AREA TO L018-S-EMP-NO-AREA. DTSCS51 02331 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS51 02332 DTSCS51 02333 IF L018-NO-ENTRY DTSCS51 02334 NEXT SENTENCE DTSCS51 02335 ELSE DTSCS51 02336 IF L018-NOT-VALID DTSCS51 02337 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02338 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS51 02339 GO TO S1800-EXIT DTSCS51 02340 END-IF DTSCS51 02341 END-IF. DTSCS51 02342 DTSCS51 02343 *** MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS51 02344 S1800-EXIT. EXIT. DTSCS51 02345 DTSCS51 02346 S1801-ERROR. DTSCS51 02347 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PRED-NO-1-A DTSCS51 02348 MAP-PRED-NO-2-A. DTSCS51 02349 IF LCCM-NO-MSG DTSCS51 02350 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02351 MOVE CATB-CURSOR TO MAP-PRED-NO-1-L DTSCS51 02352 SET CURSOR-SET-YES TO TRUE DTSCS51 02353 END-IF. DTSCS51 02354 DTSCS51 02355 S1801-EXIT. EXIT. DTSCS51 02356 DTSCS51 02357 S1900-SUTA-DMP-EFF-DT. DTSCS51 02358 MOVE MAP-MREL-EFF-DATE-AREA TO L015-S-DATE-AREA. DTSCS51 02359 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS51 02360 DTSCS51 02361 IF L015-NO-ENTRY DTSCS51 02362 IF L018-NO-ENTRY DTSCS51 02363 GO TO S1900-EXIT DTSCS51 02364 ELSE DTSCS51 02365 MOVE MSG-E518-AREA TO WRK-MSG-AREA DTSCS51 02366 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS51 02367 END-IF DTSCS51 02368 ELSE DTSCS51 02369 IF L015-NOT-VALID DTSCS51 02370 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS51 02371 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS51 02372 ELSE DTSCS51 02373 IF L018-NO-ENTRY DTSCS51 02374 MOVE MSG-E519-AREA TO WRK-MSG-AREA DTSCS51 02375 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS51 02376 END-IF DTSCS51 02377 END-IF DTSCS51 02378 END-IF. DTSCS51 02379 DTSCS51 02380 S1900-EXIT. EXIT. DTSCS51 02381 DTSCS51 02382 S1901-ERROR. DTSCS51 02383 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MREL-EFF-DATE-MO-A DTSCS51 02384 MAP-MREL-EFF-DATE-DA-A DTSCS51 02385 MAP-MREL-EFF-DATE-YR-A. DTSCS51 02386 IF LCCM-NO-MSG DTSCS51 02387 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS51 02388 MOVE CATB-CURSOR TO MAP-MREL-EFF-DATE-MO-L DTSCS51 02389 SET CURSOR-SET-YES TO TRUE DTSCS51 02390 END-IF. DTSCS51 02391 DTSCS51 02392 S1901-EXIT. EXIT. DTSCS51 02393 DTSCS51 02394 /*****************************************************************DTSCS51 02395 * *DTSCS51 02396 ******************************************************************DTSCS51 02397 S2000-MISC-EDITS. DTSCS51 02398 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS51 02399 NEXT SENTENCE DTSCS51 02400 ELSE DTSCS51 02401 MOVE EMSG-EMP-WRITTEN-OFF TO WRK-MSG-AREA DTSCS51 02402 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS51 02403 GO TO S2000-EXIT. DTSCS51 02404 DTSCS51 02405 MOVE L016-YRQ TO L052-EFF-YRQ. DTSCS51 02406 MOVE L012-RATE TO L052-UI-RATE. DTSCS51 02407 PERFORM S052-RATE-EDIT THRU S052-EXIT. DTSCS51 02408 IF L052-NOT-VALID DTSCS51 02409 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS51 02410 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS51 02411 GO TO S2000-EXIT. DTSCS51 02412 DTSCS51 02413 MOVE LOW-VALUES TO MRTE-REC. DTSCS51 02414 MOVE WRK-EMP-NO TO MRTE-EMP-NO. DTSCS51 02415 SET MRTE-RTE-88 TO TRUE. DTSCS51 02416 MOVE L016-YRQ TO MRTE-EFF-YRQ. DTSCS51 02417 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSCS51 02418 PERFORM S810-READ THRU S810-EXIT. DTSCS51 02419 DTSCS51 02420 IF L810-OK-88 DTSCS51 02421 MOVE MSKL-REC TO MRTE-REC DTSCS51 02422 IF LCCM-F09-88 DTSCS51 02423 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS51 02424 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS51 02425 GO TO S2000-EXIT DTSCS51 02426 END-IF DTSCS51 02427 END-IF. DTSCS51 02428 DTSCS51 02429 IF L810-NO-REC-88 DTSCS51 02430 AND LCCM-F10-88 DTSCS51 02431 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS51 02432 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS51 02433 GO TO S2000-EXIT. DTSCS51 02434 DTSCS51 02435 PERFORM S2100-DETERM-RATE-TYPE THRU S2100-EXIT. DTSCS51 02436 IF WRK-ESTIMATE-NEEDED-88 DTSCS51 02437 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 02438 IF MAP-VERIFY = 'Y' DTSCS51 02439 GO TO S2000-EXIT DTSCS51 02440 ELSE DTSCS51 02441 MOVE MSG-E514-AREA TO WRK-MSG-AREA DTSCS51 02442 PERFORM S2010-VERIFY-MSG THRU S2010-EXIT DTSCS51 02443 GO TO S2000-EXIT DTSCS51 02444 END-IF DTSCS51 02445 ELSE DTSCS51 02446 IF MAP-VERIFY = 'Y' DTSCS51 02447 GO TO S2000-EXIT DTSCS51 02448 ELSE DTSCS51 02449 MOVE MSG-E515-AREA TO WRK-MSG-AREA DTSCS51 02450 PERFORM S2010-VERIFY-MSG THRU S2010-EXIT DTSCS51 02451 GO TO S2000-EXIT DTSCS51 02452 END-IF DTSCS51 02453 END-IF DTSCS51 02454 END-IF. DTSCS51 02455 DTSCS51 02456 IF MAP-PRINT-RATE-NOTICE-YES DTSCS51 02457 MOVE LOW-VALUES TO MRCT-KEY-AREA DTSCS51 02458 MOVE WRK-EMP-NO TO MRCT-EMP-NO DTSCS51 02459 SET MRCT-RCT-88 TO TRUE DTSCS51 02460 MOVE L016-YRQ TO MRCT-EFF-YRQ DTSCS51 02461 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA DTSCS51 02462 PERFORM S810-READ THRU S810-EXIT DTSCS51 02463 IF L810-OK-88 DTSCS51 02464 MOVE MSKL-DATA-AREA TO MRCT-DATA-AREA DTSCS51 02465 PERFORM S2200-CHK-CONSISTENCY THRU S2200-EXIT DTSCS51 02466 IF LCCM-MSG DTSCS51 02467 GO TO S2000-EXIT DTSCS51 02468 END-IF DTSCS51 02469 ELSE DTSCS51 02470 MOVE MSG-E512-AREA TO WRK-MSG-AREA DTSCS51 02471 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS51 02472 GO TO S2000-EXIT. DTSCS51 02473 DTSCS51 02474 PERFORM S2300-SUTA-DMP THRU S2300-EXIT. DTSCS51 02475 DTSCS51 02476 S2000-EXIT. EXIT. DTSCS51 02477 DTSCS51 02478 S2001-ERROR. DTSCS51 02479 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS51 02480 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS51 02481 S2001-EXIT. EXIT. DTSCS51 02482 DTSCS51 02483 S2010-VERIFY-MSG. DTSCS51 02484 MOVE CATB-ASKIP-BRT-MDTON TO MAP-VERIFY-TEXT-A. DTSCS51 02485 MOVE 'VERIFY?' TO MAP-VERIFY-TEXT. DTSCS51 02486 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-VERIFY-A. DTSCS51 02487 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS51 02488 DTSCS51 02489 S2010-EXIT. EXIT. DTSCS51 02490 DTSCS51 02491 S2100-DETERM-RATE-TYPE. DTSCS51 02492 SET WRK-INIT-VALUES-88 TO TRUE. DTSCS51 02493 DTSCS51 02494 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS51 02495 NEXT SENTENCE DTSCS51 02496 ELSE DTSCS51 02497 GO TO S2100-EXIT. DTSCS51 02498 DTSCS51 02499 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSCS51 02500 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSCS51 02501 MOVE L016-YRQ TO L410-YRQ. DTSCS51 02502 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT. DTSCS51 02503 IF L410-ANN-SCHED-88 DTSCS51 02504 SET WRK-RATE-YR-ANN-88 TO TRUE. DTSCS51 02505 DTSCS51 02506 MOVE L016-YRQ TO L004-QTR-5-9. DTSCS51 02507 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCS51 02508 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS51 02509 DTSCS51 02510 MOVE L004-QTR-5-9 TO L410-YRQ. DTSCS51 02511 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT. DTSCS51 02512 IF L410-ANN-SCHED-88 DTSCS51 02513 SET WRK-RATE-YR-MINUS1-ANN-88 TO TRUE. DTSCS51 02514 DTSCS51 02515 SUBTRACT 1 FROM L004-QTR-5-YR. DTSCS51 02516 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS51 02517 MOVE L004-QTR-5-9 TO L410-YRQ . DTSCS51 02518 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT. DTSCS51 02519 IF L410-ANN-SCHED-88 DTSCS51 02520 SET WRK-RATE-YR-MINUS2-ANN-88 TO TRUE. DTSCS51 02521 DTSCS51 02522 S2100-EXIT. EXIT. DTSCS51 02523 DTSCS51 02524 S2200-CHK-CONSISTENCY. DTSCS51 02525 SET L054-RATE-LOOKUP-YES-88 TO TRUE. DTSCS51 02526 IF WRK-ESTIMATE-NEEDED-88 DTSCS51 02527 SET L054-ESTIMATED-RATE-YES-88 TO TRUE DTSCS51 02528 ELSE DTSCS51 02529 SET L054-ESTIMATED-RATE-NO-88 TO TRUE. DTSCS51 02530 DTSCS51 02531 PERFORM S054-RATE-DETERMINATION THRU S054-EXIT DTSCS51 02532 IF L054-OK-88 DTSCS51 02533 IF L054-UI-PEN-RATE-YES-88 DTSCS51 02534 IF (L054-UI-PEN-RATE = L012-RATE) DTSCS51 02535 CONTINUE DTSCS51 02536 *------------ SCREEN "UI RATE" IS CONSISTENT WITH MRCT DTSCS51 02537 ELSE DTSCS51 02538 MOVE MSG-E513-AREA TO WRK-MSG-AREA DTSCS51 02539 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS51 02540 *------------ SCREEN "UI RATE" IS NOT CONSISTENT WITH MRCT DTSCS51 02541 ELSE DTSCS51 02542 IF (L054-UI-CALC-RATE = L012-RATE) DTSCS51 02543 CONTINUE DTSCS51 02544 *------------ SCREEN "UI RATE" IS CONSISTENT WITH MRCT DTSCS51 02545 ELSE DTSCS51 02546 MOVE MSG-E513-AREA TO WRK-MSG-AREA DTSCS51 02547 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS51 02548 *------------ SCREEN "UI RATE" IS NOT CONSISTENT WITH MRCT DTSCS51 02549 ELSE DTSCS51 02550 MOVE MSG-E513-AREA TO WRK-MSG-AREA DTSCS51 02551 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS51 02552 S2200-EXIT. EXIT. DTSCS51 02553 DTSCS51 02554 S2300-SUTA-DMP. DTSCS51 02555 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS51 02556 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS51 02557 MOVE +0 TO WRK-REL-CHNG-DATE DTSCS51 02558 WRK-REL-PRED-NO DTSCS51 02559 WRK-REL-EFF-DATE. DTSCS51 02560 DTSCS51 02561 ******************* DTSCS51 02562 * IF THE USER HAS ENTERED 'Y' IN THE VERIFY FIELD AND DTSCS51 02563 * CLEARED THE PREDECESSOR AND EFF DATE FIELD, ACCEPT DTSCS51 02564 * THE UPDATE: THIS IS NOT A SUTA DUMPING RELATED DTSCS51 02565 * RATE CHANGE. DTSCS51 02566 ******************* DTSCS51 02567 IF MAP-VERIFY = 'Y' DTSCS51 02568 MOVE MAP-SUTA-DMP-PRED-AREA TO L018-S-EMP-NO-AREA DTSCS51 02569 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT DTSCS51 02570 IF L018-NO-ENTRY DTSCS51 02571 GO TO S2300-EXIT DTSCS51 02572 END-IF DTSCS51 02573 END-IF. DTSCS51 02574 DTSCS51 02575 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSCS51 02576 MOVE MPRF-EMP-NO TO MREL-EMP-NO. DTSCS51 02577 SET MREL-REL-88 TO TRUE. DTSCS51 02578 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSCS51 02579 DTSCS51 02580 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS51 02581 PERFORM UNTIL L810-NO-REC-88 DTSCS51 02582 MOVE MSKL-REC TO MREL-REC DTSCS51 02583 PERFORM S2310-CHK-MREL THRU S2310-EXIT DTSCS51 02584 MOVE MREL-REC TO MSKL-REC DTSCS51 02585 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS51 02586 END-PERFORM. DTSCS51 02587 DTSCS51 02588 IF WRK-REL-CHNG-DATE > +0 DTSCS51 02589 SET WRK-SUTA-DMP-CHNG-YES-88 TO TRUE DTSCS51 02590 MOVE LOW-VALUES TO MRTE-REC DTSCS51 02591 MOVE WRK-EMP-NO TO MRTE-EMP-NO DTSCS51 02592 SET MRTE-RTE-88 TO TRUE DTSCS51 02593 MOVE WRK-EFF-YRQ TO MRTE-EFF-YRQ DTSCS51 02594 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA DTSCS51 02595 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS51 02596 PERFORM UNTIL L810-NO-REC-88 DTSCS51 02597 MOVE MSKL-REC TO MRTE-REC DTSCS51 02598 PERFORM S2320-CHK-MRTE THRU S2320-EXIT DTSCS51 02599 MOVE MRTE-REC TO MSKL-REC DTSCS51 02600 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS51 02601 END-PERFORM DTSCS51 02602 END-IF. DTSCS51 02603 DTSCS51 02604 IF WRK-SUTA-DMP-CHNG-YES-88 DTSCS51 02605 MOVE WRK-REL-PRED-NO TO WRK-DISPLAY DTSCS51 02606 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-NO-1 DTSCS51 02607 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-NO-2 DTSCS51 02608 MOVE WRK-REL-EFF-DATE TO WRK-DISPLAY DTSCS51 02609 MOVE WRK-DISPLAY-MO TO MAP-MREL-EFF-DATE-MO DTSCS51 02610 MOVE WRK-DISPLAY-DA TO MAP-MREL-EFF-DATE-DA DTSCS51 02611 MOVE WRK-DISPLAY-YR TO MAP-MREL-EFF-DATE-YR DTSCS51 02612 IF MAP-VERIFY = 'Y' DTSCS51 02613 GO TO S2300-EXIT DTSCS51 02614 ELSE DTSCS51 02615 PERFORM S2330-VERIFY THRU S2330-EXIT DTSCS51 02616 END-IF DTSCS51 02617 END-IF. DTSCS51 02618 DTSCS51 02619 S2300-EXIT. EXIT. DTSCS51 02620 DTSCS51 02621 S2310-CHK-MREL. DTSCS51 02622 IF (MREL-XFER-MANDATORY-88 DTSCS51 02623 OR MREL-XFER-PROHIBITED-88) DTSCS51 02624 IF (MREL-ESTB-DATE >= L004-QTR-START-DATE DTSCS51 02625 AND <= L004-QTR-END-DATE) DTSCS51 02626 MOVE MREL-ESTB-DATE TO WRK-REL-CHNG-DATE DTSCS51 02627 MOVE MREL-EFF-DATE TO WRK-REL-EFF-DATE DTSCS51 02628 MOVE MREL-PRED-EMP-NO TO WRK-REL-PRED-NO DTSCS51 02629 ELSE DTSCS51 02630 IF (MREL-CHNG-DATE >= L004-QTR-START-DATE DTSCS51 02631 AND <= L004-QTR-END-DATE) DTSCS51 02632 MOVE MREL-CHNG-DATE TO WRK-REL-CHNG-DATE DTSCS51 02633 MOVE MREL-EFF-DATE TO WRK-REL-EFF-DATE DTSCS51 02634 MOVE MREL-PRED-EMP-NO TO WRK-REL-PRED-NO DTSCS51 02635 END-IF DTSCS51 02636 END-IF. DTSCS51 02637 DTSCS51 02638 S2310-EXIT. EXIT. DTSCS51 02639 DTSCS51 02640 S2320-CHK-MRTE. DTSCS51 02641 IF MRTE-MREL-PRED-NO NOT NUMERIC DTSCS51 02642 MOVE +0 TO MRTE-MREL-PRED-NO DTSCS51 02643 END-IF. DTSCS51 02644 IF MRTE-MREL-EFF-DATE NOT NUMERIC DTSCS51 02645 MOVE +0 TO MRTE-MREL-EFF-DATE DTSCS51 02646 END-IF. DTSCS51 02647 IF MRTE-MREL-PRED-NO = WRK-REL-PRED-NO DTSCS51 02648 AND MRTE-MREL-EFF-DATE = WRK-REL-EFF-DATE DTSCS51 02649 SET WRK-SUTA-DMP-CHNG-NO-88 TO TRUE DTSCS51 02650 END-IF. DTSCS51 02651 DTSCS51 02652 S2320-EXIT. EXIT. DTSCS51 02653 DTSCS51 02654 S2330-VERIFY. DTSCS51 02655 MOVE MSG-E517-AREA TO WRK-MSG-AREA. DTSCS51 02656 MOVE CATB-ASKIP-BRT-MDTON TO MAP-VERIFY-TEXT-A. DTSCS51 02657 MOVE 'VERIFY?' TO MAP-VERIFY-TEXT. DTSCS51 02658 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-VERIFY-A DTSCS51 02659 MAP-PRED-NO-1-A DTSCS51 02660 MAP-PRED-NO-2-A DTSCS51 02661 MAP-MREL-EFF-DATE-MO-A DTSCS51 02662 MAP-MREL-EFF-DATE-DA-A DTSCS51 02663 MAP-MREL-EFF-DATE-YR-A. DTSCS51 02664 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS51 02665 DTSCS51 02666 S2330-EXIT. EXIT. DTSCS51 02667 DTSCS51 02668 /*****************************************************************DTSCS51 02669 * CALL DTSCU084 TO CHECK FOR RATE CHANGE APPROVAL *DTSCS51 02670 ******************************************************************DTSCS51 02671 S3000-APPROVAL. DTSCS51 02672 MOVE WRK-EMP-NO TO L084-EMP-NO. DTSCS51 02673 SET L084-RATE-CHANGE-88 TO TRUE. DTSCS51 02674 MOVE LCCM-CURR-RUN-DATE TO L084-CURR-RUN-DATE. DTSCS51 02675 DTSCS51 02676 PERFORM S084-APPROVAL THRU S084-EXIT. DTSCS51 02677 DTSCS51 02678 IF L012-RATE NOT = 0.027 DTSCS51 02679 ** AND L012-RATE NOT = MRTE-UI-RATE DTSCS51 02680 IF NOT L084-VALID-APPROVAL-88 DTSCS51 02681 MOVE MSG-E516-AREA TO WRK-MSG-AREA DTSCS51 02682 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS51 02683 END-IF DTSCS51 02684 END-IF. DTSCS51 02685 DTSCS51 02686 S3000-EXIT. EXIT. DTSCS51 02687 DTSCS51 02688 /*****************************************************************DTSCS51 02689 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS51 02690 ******************************************************************DTSCS51 02691 S5100-SET-LOCK-ATTRB. DTSCS51 02692 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS51 02693 WRK-ATB-NUM. DTSCS51 02694 DTSCS51 02695 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS51 02696 DTSCS51 02697 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS51 02698 MAP-EMP-NO-2-A DTSCS51 02699 MAP-GOTO-A. DTSCS51 02700 DTSCS51 02701 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-TEXT-A DTSCS51 02702 MAP-VERIFY-A. DTSCS51 02703 S5100-EXIT. DTSCS51 02704 EXIT. DTSCS51 02705 DTSCS51 02706 ******************************************************************DTSCS51 02707 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS51 02708 ******************************************************************DTSCS51 02709 S5200-SET-UPDATE-ATTRB. DTSCS51 02710 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS51 02711 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS51 02712 DTSCS51 02713 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS51 02714 DTSCS51 02715 IF LCCM-SCR-INQUIRE DTSCS51 02716 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EFF-QTR-YR-A DTSCS51 02717 MAP-EFF-QTR-Q-A. DTSCS51 02718 S5200-EXIT. DTSCS51 02719 EXIT. DTSCS51 02720 DTSCS51 02721 ******************************************************************DTSCS51 02722 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS51 02723 ******************************************************************DTSCS51 02724 S5300-SET-INQ-ATTRB. DTSCS51 02725 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS51 02726 WRK-ATB-NUM. DTSCS51 02727 DTSCS51 02728 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS51 02729 S5300-EXIT. DTSCS51 02730 EXIT. DTSCS51 02731 DTSCS51 02732 S5900-SET-ATTRB. DTSCS51 02733 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS51 02734 MAP-EMP-NO-2-A. DTSCS51 02735 DTSCS51 02736 MOVE WRK-ATB-AN TO DTSCS51 02737 MAP-PRINT-RATE-NOTICE-A. DTSCS51 02738 DTSCS51 02739 MOVE WRK-ATB-NUM TO DTSCS51 02740 MAP-EFF-QTR-YR-A DTSCS51 02741 MAP-EFF-QTR-Q-A DTSCS51 02742 MAP-RATE-A DTSCS51 02743 MAP-NOTICE-DATE-MO-A DTSCS51 02744 MAP-NOTICE-DATE-DA-A DTSCS51 02745 MAP-NOTICE-DATE-YR-A DTSCS51 02746 MAP-PRED-NO-1-A DTSCS51 02747 MAP-PRED-NO-2-A DTSCS51 02748 MAP-MREL-EFF-DATE-MO-A DTSCS51 02749 MAP-MREL-EFF-DATE-DA-A DTSCS51 02750 MAP-MREL-EFF-DATE-YR-A. DTSCS51 02751 DTSCS51 02752 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS51 02753 MAP-CURR-PAGE-A DTSCS51 02754 MAP-LAST-PAGE-A DTSCS51 02755 MAP-PERIOD-FROM-A DTSCS51 02756 MAP-PERIOD-TO-A DTSCS51 02757 MAP-RATE-TYPE-DESC-A DTSCS51 02758 MAP-RATE-TYPE-A. DTSCS51 02759 DTSCS51 02760 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS51 02761 S5900-EXIT. DTSCS51 02762 EXIT. DTSCS51 02763 EJECT DTSCS51 02764 /*****************************************************************DTSCS51 02765 * MAP ROUTINES *DTSCS51 02766 ******************************************************************DTSCS51 02767 S9100-RECEIVE. DTSCS51 02768 SET L851-RECEIVE-88 TO TRUE. DTSCS51 02769 DTSCS51 02770 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS51 02771 DTSCS51 02772 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS51 02773 DTSCS51 02774 MOVE L851-AID TO LCCM-AID. DTSCS51 02775 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS51 02776 S9100-EXIT. DTSCS51 02777 EXIT. DTSCS51 02778 DTSCS51 02779 S9200-SEND-DATAONLY. DTSCS51 02780 MOVE LOW-VALUES TO MAP-AREA. DTSCS51 02781 DTSCS51 02782 IF LCCM-NO-MSG DTSCS51 02783 NEXT SENTENCE DTSCS51 02784 ELSE DTSCS51 02785 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS51 02786 DTSCS51 02787 IF CURSOR-SET-GOTO DTSCS51 02788 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS51 02789 ELSE DTSCS51 02790 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS51 02791 DTSCS51 02792 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS51 02793 DTSCS51 02794 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS51 02795 DTSCS51 02796 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS51 02797 S9200-EXIT. DTSCS51 02798 EXIT. DTSCS51 02799 DTSCS51 02800 S9300-SEND-MAP. DTSCS51 02801 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS51 02802 MOVE SPACES TO MAP-SYS-TIME. DTSCS51 02803 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS51 02804 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS51 02805 DTSCS51 02806 IF SCR-ACCESS-UPDATE DTSCS51 02807 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS51 02808 ELSE DTSCS51 02809 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS51 02810 DTSCS51 02811 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS51 02812 DTSCS51 02813 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS51 02814 DTSCS51 02815 IF CURSOR-SET-NO DTSCS51 02816 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS51 02817 DTSCS51 02818 SET L851-SEND-88 TO TRUE. DTSCS51 02819 DTSCS51 02820 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS51 02821 DTSCS51 02822 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS51 02823 S9300-EXIT. DTSCS51 02824 EXIT. DTSCS51 02825 DTSCS51 02826 S9310-UPDATE-FKEYS. DTSCS51 02827 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS51 02828 DTSCS51 02829 DTSCS51 02830 IF LCCM-SCR-CLEAR DTSCS51 02831 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS51 02832 ELSE DTSCS51 02833 IF LCCM-SCR-INQUIRE DTSCS51 02834 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS51 02835 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS51 02836 ELSE DTSCS51 02837 IF LCCM-SCR-UPDATE-LOCKED DTSCS51 02838 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS51 02839 MAP-KEY-LAST DTSCS51 02840 MAP-KEY-BACK DTSCS51 02841 MAP-KEY-FWRD. DTSCS51 02842 S9310-EXIT. DTSCS51 02843 EXIT. DTSCS51 02844 DTSCS51 02845 S9320-INQUIRY-FKEYS. DTSCS51 02846 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS51 02847 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS51 02848 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS51 02849 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS51 02850 DTSCS51 02851 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS51 02852 MAP-KEY-MOD DTSCS51 02853 MAP-KEY-ADD. DTSCS51 02854 DTSCS51 02855 PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS51 02856 S9320-EXIT. DTSCS51 02857 EXIT. DTSCS51 02858 DTSCS51 02859 S9321-JUMP-KEYS. DTSCS51 02860 S9321-EXIT. DTSCS51 02861 EXIT. DTSCS51 02862 * DTSCS51 02863 S9330-DSCR-FIELDS. DTSCS51 02864 IF WRK-MPRF-YES-88 DTSCS51 02865 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS51 02866 DTSCS51 02867 S9330-EXIT. EXIT. DTSCS51 02868 DTSCS51 02869 S9900-PREPARE-SEND. DTSCS51 02870 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS51 02871 LCCM-SCR-ID. DTSCS51 02872 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS51 02873 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS51 02874 S9900-EXIT. DTSCS51 02875 EXIT. DTSCS51