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