2877 lines
225 KiB
COBOL
2877 lines
225 KiB
COBOL
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
|