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
