00001  IDENTIFICATION DIVISION.                                         12/08/21
00002  PROGRAM-ID.             DTSCU031.                                DTSCU031
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV047
00004  DATE-WRITTEN.           SEPTEMBER 1998.                          DTSCU031
00005  DATE-COMPILED.                                                   DTSCU031
00006      SKIP3                                                        DTSCU031
00007 *****                                                             DTSCU031
00008 *                                                                 DTSCU031
00009 *    FUNCTION:  EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION.     DTSCU031
00010 *                                                                 DTSCU031
00011 *                                                                 DTSCU031
00012 *    MODIFICATION LOG:                                            DTSCU031
00013 *                                                                 DTSCU031
00014 *    09/02/1998  INITIAL DEVELOPMENT. MODIFIED FROM MACCU031.     DTSCU031
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00016 *                                                                 DTSCU031
00017 *    06/29/2004  RECOMPILED FOR ELIG CODE 17 - DOMESTIC VIOLENCE. DTSCU031
00018 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00019 *                                                                 DTSCU031
00020 *    03/08/2005  RECOMPILED FOR ELIG CODE 18 - EDUCATIONAL        DTSCU031
00021 *                STEPLADDER PROGRAM.                              DTSCU031
00022 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00023 *                                                                 DTSCU031
00024 *    06/01/2005  RECOMPILED FOR WEB REGISTRATION MERA STATUS      DTSCU031
00025 *                CODES (14 THROUGH 19).                           DTSCU031
00026 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00027 *                                                                 DTSCU031
00028 *    09/14/2005  RECOMPILED FOR ADDITIONAL ORG-TYPE:              DTSCU031
00029 *                S-CORPORATION.                                   DTSCU031
00030 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00031 *                                                                 DTSCU031
00032 *    07/15/2008  RECOMPILED FOR 2008 EB PROGRAM                   DTSCU031
00033 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00034 *                                                                 DTSCU031
00035 *    02/26/2009  RECOMPILED FOR 2008 FAC PROGRAM                  DTSCU031
00036 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00037 *                                                                 DTSCU031
00038 *    07/14/2009  RECOMPILED FOR ADDITIONAL BENEFITS AND           DTSCU031
00039 *                DEPENDENT ALLOWANCE                              DTSCU031
00040 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00041 *                                                                 DTSCU031
00042 *    07/30/2009  RECOMPILED FOR TRAINING EXTENSION BENEFITS       DTSCU031
00043 *                PROGRAM                                          DTSCU031
00044 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00045 *                                                                 DTSCU031
00046 *    11/17/2009  RECOMPILED FOR EUC 2008 TIERS 3 AND 4            DTSCU031
00047 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00048 *                                                                 DTSCU031
00049 *    05/09/2012  RECOMPILED: OCCURS COUNTER FOR LIABLE CODE IN    DTSCU031
00050 *                DTSIC031 WAS INCORRECT.                          DTSCU031
00051 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU031
00052 *                                                                 DTSCU031
00053 *    04/29/2013  RECOMPILED: MREL SUTA DUMPING CODES ON SCREEN    DTSCU031
00054 *                19 ADDED.                                        DTSCU031
00055 *                WORK ORDER: TICKET 1780          PROGRAMMER: GD  DTSCU031
00056 *                                                                 DTSCU031
00057 *    03/25/2015  RECOMPILED: ADDED NEW ELIG CODES FOR DUA AND     DTSCU031
00058 *                GPS                                              DTSCU031
00059 *                WORK ORDER: TICKET ONPOINT       PROGRAMMER: ZL1 DTSCU031
00060 *                                                                 DTSCU031
00061 *    09/15/2015  RECOMPILED: ADDED NEW ORG CODES UNA FIT AND      DTSCU031
00062 *                OTH                                              DTSCU031
00063 *                WORK ORDER: TICKET ESSP          PROGRAMMER: ZL1 DTSCU031
00064 *                                                                 DTSCU031
00065 *    04/07/2020  RECOMPILED: ADDED NEWELIG CODES FPUC AND FRUR    DTSCU031
00066 *                WORK ORDER: PANDEMIC             PROGRAMMER: ZL1 DTSCU031
00067 *                                                                 DTSCU031
00068 *    06/08/2020  RECOMPILED: ADDED NEWELIG CODE  REUR             DTSCU031
00069 *                WORK ORDER: PANDEMIC             PROGRAMMER: ZL1 DTSCU031
00070 *                                                                 DTSCU031
00071 *    09/02/2020  RECOMPILED: ADDED NEWELIG CODE  LWA              DTSCU031
00072 *                WORK ORDER: PANDEMIC             PROGRAMMER: ZL1 DTSCU031
00073 *                                                                 DTSCU031
00074 *    02/16/2021  RECOMPILED: ADDED NEWELIG CODE  MEUC             DTSCU031
00075 *                WORK ORDER: PANDEMIC             PROGRAMMER: ZL1 DTSCU031
00076 *                                                                 DTSCU031
00077 *    12/06/2021  RECOMPILED: ADDED NEWELIG CODE  DUC              DTSCU031
00078 *                WORK ORDER: PANDEMIC             PROGRAMMER: ZL1 DTSCU031
00079 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU031
00080 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU031
00081 *                WORK ORDER:                      PROGRAMMER: XXX DTSCU031
00082 *                                                                 DTSCU031
00083 *                                                                 DTSCU031
00084 *    DESCRIPTION:                                                 DTSCU031
00085 *                                                                 DTSCU031
00086 *    DTSCU031 EDITS EMPLOYER REGISTRATION CODES AND INDICATORS.   DTSCU031
00087 *                                                                 DTSCU031
00088 *    DTSCU031 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION     DTSCU031
00089 *    OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE        DTSCU031
00090 *    VALUE.                                                       DTSCU031
00091 *                                                                 DTSCU031
00092 *    IF L031-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN     DTSCU031
00093 *    ABEND CODE OF 'U031'.                                        DTSCU031
00094 *                                                                 DTSCU031
00095 *    GO TO DEPENDING ON L031-OPTION TO GET TO THE PARAGRAPH       DTSCU031
00096 *    THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED      DTSCU031
00097 *    BY L031-OPTION.  USE A SEARCH STATEMENT TO DETERMINE THE     DTSCU031
00098 *    VALIDITY OF L031-CD-*.                                       DTSCU031
00099 *                                                                 DTSCU031
00100 *    IF L031-CD-* IS A VALID VALUE                                DTSCU031
00101 *        MOVE '1' TO L031-RESULT-IND                              DTSCU031
00102 *        MOVE THE APPROPRIATE C031-*-SHORT-DSCR                   DTSCU031
00103 *          TO L031-SHORT-DSCR                                     DTSCU031
00104 *        MOVE THE APPROPRIATE C031-*-LONG-DSCR                    DTSCU031
00105 *          TO L031-LONG-DSCR                                      DTSCU031
00106 *    ELSE                                                         DTSCU031
00107 *        MOVE '2' TO L031-RESULT-IND                              DTSCU031
00108 *        MOVE 'NOT VALID' TO L031-SHORT-DSCR                      DTSCU031
00109 *                            L031-LONG-DSCR.                      DTSCU031
00110 *                                                                 DTSCU031
00111 *                                                                 DTSCU031
00112 *****                                                             DTSCU031
00113      SKIP3                                                        DTSCU031
00114  ENVIRONMENT DIVISION.                                            DTSCU031
00115      SKIP3                                                        DTSCU031
00116  DATA DIVISION.                                                   DTSCU031
00117      SKIP3                                                        DTSCU031
00118  WORKING-STORAGE SECTION.                                         DTSCU031
001185 77  PAN-VALET PICTURE X(24) VALUE '047DTSCU031  12/08/21'.       DTSCU031
00119  77  PAN-VALET PICTURE X(24) VALUE '002DTSCU031  12/07/21'.       DTSCU031
00120  77  PAN-VALET PICTURE X(24) VALUE '045DTSCU031  02/16/21'.       DTSCU031
00121  77  PAN-VALET PICTURE X(24) VALUE '002DTSCU031  02/16/21'.       DTSCU031
00122  77  PAN-VALET PICTURE X(24) VALUE '043DTSCU031  12/07/20'.       DTSCU031
00123  77  PAN-VALET PICTURE X(24) VALUE '002DTSCU031  09/02/20'.       DTSCU031
00124  77  PAN-VALET PICTURE X(24) VALUE '041DTSCU031  05/08/20'.       DTSCU031
00125  77  PAN-VALET PICTURE X(24) VALUE '002DTSCU031  05/08/20'.       DTSCU031
00126  77  PAN-VALET PICTURE X(24) VALUE '039DTSCU031  04/27/20'.       DTSCU031
00127  77  PAN-VALET PICTURE X(24) VALUE '003DTSCU031  04/07/20'.       DTSCU031
00128  77  PAN-VALET PICTURE X(24) VALUE '037DTSCU031  03/25/15'.       DTSCU031
00129  77  PAN-VALET PICTURE X(24) VALUE '002DTSCU031  03/25/15'.       DTSCU031
00130  77  PAN-VALET PICTURE X(24) VALUE '035DTSCU031  10/01/14'.       DTSCU031
00131  77  PAN-VALET PICTURE X(24) VALUE '002DTSCU031  04/29/13'.       DTSCU031
00132  77  PAN-VALET PICTURE X(24) VALUE '033DTSCU031  05/09/12'.       DTSCU031
00133      SKIP3                                                        DTSCU031
00134  01  WRK-AREA.                                                    DTSCU031
00135      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U031'.    DTSCU031
00136      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU031
00137      EJECT                                                        DTSCU031
00138  01  C031-LITERALS.                                               DTSCU031
00139  ++INCLUDE DTSIC031                                               DTSCU031
00140      EJECT                                                        DTSCU031
00141  LINKAGE SECTION.                                                 DTSCU031
00142      SKIP3                                                        DTSCU031
00143  01  DFHCOMMAREA.                                                 DTSCU031
00144  ++INCLUDE DTSIL031                                               DTSCU031
00145      EJECT                                                        DTSCU031
00146  PROCEDURE DIVISION.                                              DTSCU031
00147      SKIP2                                                        DTSCU031
00148      MOVE '2' TO L031-RESULT-IND.                                 DTSCU031
00149      MOVE 'NOT VALID' TO L031-SHORT-DSCR                          DTSCU031
00150                          L031-LONG-DSCR.                          DTSCU031
00151      PERFORM P1000-PROCESS THRU P1000-EXIT.                       DTSCU031
00152      SKIP2                                                        DTSCU031
00153      EXEC CICS                                                    DTSCU031
00154          RETURN                                                   DTSCU031
00155      END-EXEC.                                                    DTSCU031
00156      SKIP2                                                        DTSCU031
00157      GOBACK.                                                      DTSCU031
00158      EJECT                                                        DTSCU031
00159  P1000-PROCESS.                                                   DTSCU031
00160      GO TO P1000-01-MPRF-EMP-CLASS                                DTSCU031
00161            P1000-02-MPRF-EMP-STATUS                               DTSCU031
00162            P1000-03-MPRF-ELIGIBLE-CD                              DTSCU031
00163            P1000-04-MPRF-ORG-TYPE                                 DTSCU031
00164            P1000-05-FISCAL-AGENT-CD                               DTSCU031
00165            S899-ABEND                                             DTSCU031
00166            S899-ABEND                                             DTSCU031
00167            S899-ABEND                                             DTSCU031
00168            S899-ABEND                                             DTSCU031
00169            P1000-10-MERA-SOURCE-CD                                DTSCU031
00170            P1000-11-MERA-STATUS-CD                                DTSCU031
00171            P1000-12-MERA-LETTER-1-CD                              DTSCU031
00172            S899-ABEND                                             DTSCU031
00173            S899-ABEND                                             DTSCU031
00174            S899-ABEND                                             DTSCU031
00175            S899-ABEND                                             DTSCU031
00176            P1000-17-MREL-RELATION-CD                              DTSCU031
00177            P1000-18-MREL-SUTA-DUMPING-CD                          DTSCU031
00178            S899-ABEND                                             DTSCU031
00179            S899-ABEND                                             DTSCU031
00180            S899-ABEND                                             DTSCU031
00181            P1000-22-MSOL-LIAB-CD                                  DTSCU031
00182            P1000-23-MSOL-INACT-CD                                 DTSCU031
00183          DEPENDING ON L031-OPTION.                                DTSCU031
00184      SKIP1                                                        DTSCU031
00185      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU031
00186      SKIP3                                                        DTSCU031
00187  P1000-01-MPRF-EMP-CLASS.                                         DTSCU031
00188      SET C031-01-IDX TO 1.                                        DTSCU031
00189      SEARCH C031-01-ENTRY                                         DTSCU031
00190         VARYING                                                   DTSCU031
00191           C031-01-IDX                                             DTSCU031
00192          WHEN L031-CD-1 = C031-01-CD (C031-01-IDX)                DTSCU031
00193              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00194              MOVE C031-01-SHORT-DSCR (C031-01-IDX)                DTSCU031
00195                TO L031-SHORT-DSCR                                 DTSCU031
00196              MOVE C031-01-LONG-DSCR (C031-01-IDX)                 DTSCU031
00197                TO L031-LONG-DSCR.                                 DTSCU031
00198      SKIP1                                                        DTSCU031
00199      GO TO P1000-EXIT.                                            DTSCU031
00200      SKIP3                                                        DTSCU031
00201  P1000-02-MPRF-EMP-STATUS.                                        DTSCU031
00202      SET C031-02-IDX TO 1.                                        DTSCU031
00203      SEARCH C031-02-ENTRY                                         DTSCU031
00204         VARYING                                                   DTSCU031
00205           C031-02-IDX                                             DTSCU031
00206          WHEN L031-CD-1 = C031-02-CD (C031-02-IDX)                DTSCU031
00207              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00208              MOVE C031-02-SHORT-DSCR (C031-02-IDX)                DTSCU031
00209                TO L031-SHORT-DSCR                                 DTSCU031
00210              MOVE C031-02-LONG-DSCR (C031-02-IDX)                 DTSCU031
00211                TO L031-LONG-DSCR.                                 DTSCU031
00212      SKIP1                                                        DTSCU031
00213      GO TO P1000-EXIT.                                            DTSCU031
00214      SKIP3                                                        DTSCU031
00215  P1000-03-MPRF-ELIGIBLE-CD.                                       DTSCU031
00216      SET C031-03-IDX TO 1.                                        DTSCU031
00217      SEARCH C031-03-ENTRY                                         DTSCU031
00218         VARYING                                                   DTSCU031
00219           C031-03-IDX                                             DTSCU031
00220          WHEN L031-CD-3 = C031-03-CD (C031-03-IDX)                DTSCU031
00221              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00222              MOVE C031-03-SHORT-DSCR (C031-03-IDX)                DTSCU031
00223                TO L031-SHORT-DSCR                                 DTSCU031
00224              MOVE C031-03-LONG-DSCR (C031-03-IDX)                 DTSCU031
00225                TO L031-LONG-DSCR.                                 DTSCU031
00226      SKIP1                                                        DTSCU031
00227      GO TO P1000-EXIT.                                            DTSCU031
00228      SKIP3                                                        DTSCU031
00229  P1000-04-MPRF-ORG-TYPE.                                          DTSCU031
00230      SET C031-04-IDX TO 1.                                        DTSCU031
00231      SEARCH C031-04-ENTRY                                         DTSCU031
00232         VARYING                                                   DTSCU031
00233           C031-04-IDX                                             DTSCU031
00234          WHEN L031-CD-3 = C031-04-CD (C031-04-IDX)                DTSCU031
00235              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00236              MOVE C031-04-SHORT-DSCR (C031-04-IDX)                DTSCU031
00237                TO L031-SHORT-DSCR                                 DTSCU031
00238              MOVE C031-04-LONG-DSCR (C031-04-IDX)                 DTSCU031
00239                TO L031-LONG-DSCR.                                 DTSCU031
00240      SKIP1                                                        DTSCU031
00241      GO TO P1000-EXIT.                                            DTSCU031
00242      SKIP3                                                        DTSCU031
00243  P1000-05-FISCAL-AGENT-CD.                                        DTSCU031
00244      SET C031-05-IDX TO 1.                                        DTSCU031
00245      SEARCH C031-05-ENTRY                                         DTSCU031
00246         VARYING                                                   DTSCU031
00247           C031-05-IDX                                             DTSCU031
00248          WHEN L031-CD-3 = C031-05-CD (C031-05-IDX)                DTSCU031
00249              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00250              MOVE C031-05-SHORT-DSCR (C031-05-IDX)                DTSCU031
00251                TO L031-SHORT-DSCR                                 DTSCU031
00252              MOVE C031-05-LONG-DSCR (C031-05-IDX)                 DTSCU031
00253                TO L031-LONG-DSCR.                                 DTSCU031
00254      SKIP1                                                        DTSCU031
00255      GO TO P1000-EXIT.                                            DTSCU031
00256      SKIP3                                                        DTSCU031
00257  P1000-10-MERA-SOURCE-CD.                                         DTSCU031
00258      SET C031-10-IDX TO 1.                                        DTSCU031
00259      SEARCH C031-10-ENTRY                                         DTSCU031
00260         VARYING                                                   DTSCU031
00261           C031-10-IDX                                             DTSCU031
00262          WHEN L031-CD-2 = C031-10-CD (C031-10-IDX)                DTSCU031
00263              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00264              MOVE C031-10-SHORT-DSCR (C031-10-IDX)                DTSCU031
00265                TO L031-SHORT-DSCR                                 DTSCU031
00266              MOVE C031-10-LONG-DSCR (C031-10-IDX)                 DTSCU031
00267                TO L031-LONG-DSCR.                                 DTSCU031
00268      SKIP1                                                        DTSCU031
00269      GO TO P1000-EXIT.                                            DTSCU031
00270      SKIP3                                                        DTSCU031
00271  P1000-11-MERA-STATUS-CD.                                         DTSCU031
00272      SET C031-11-IDX TO 1.                                        DTSCU031
00273      SEARCH C031-11-ENTRY                                         DTSCU031
00274         VARYING                                                   DTSCU031
00275           C031-11-IDX                                             DTSCU031
00276          WHEN L031-CD-2 = C031-11-CD (C031-11-IDX)                DTSCU031
00277              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00278              MOVE C031-11-SHORT-DSCR (C031-11-IDX)                DTSCU031
00279                TO L031-SHORT-DSCR                                 DTSCU031
00280              MOVE C031-11-LONG-DSCR (C031-11-IDX)                 DTSCU031
00281                TO L031-LONG-DSCR.                                 DTSCU031
00282      SKIP1                                                        DTSCU031
00283      GO TO P1000-EXIT.                                            DTSCU031
00284      SKIP3                                                        DTSCU031
00285  P1000-12-MERA-LETTER-1-CD.                                       DTSCU031
00286      SET C031-12-IDX TO 1.                                        DTSCU031
00287      SEARCH C031-12-ENTRY                                         DTSCU031
00288         VARYING                                                   DTSCU031
00289           C031-12-IDX                                             DTSCU031
00290          WHEN L031-CD-2 = C031-12-CD (C031-12-IDX)                DTSCU031
00291              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00292              MOVE C031-12-SHORT-DSCR (C031-12-IDX)                DTSCU031
00293                TO L031-SHORT-DSCR                                 DTSCU031
00294              MOVE C031-12-LONG-DSCR (C031-12-IDX)                 DTSCU031
00295                TO L031-LONG-DSCR.                                 DTSCU031
00296      SKIP1                                                        DTSCU031
00297      GO TO P1000-EXIT.                                            DTSCU031
00298      SKIP3                                                        DTSCU031
00299  P1000-17-MREL-RELATION-CD.                                       DTSCU031
00300      SET C031-17-IDX TO 1.                                        DTSCU031
00301      SEARCH C031-17-ENTRY                                         DTSCU031
00302         VARYING                                                   DTSCU031
00303           C031-17-IDX                                             DTSCU031
00304          WHEN L031-CD-2 = C031-17-CD (C031-17-IDX)                DTSCU031
00305              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00306              MOVE C031-17-SHORT-DSCR (C031-17-IDX)                DTSCU031
00307                TO L031-SHORT-DSCR                                 DTSCU031
00308              MOVE C031-17-LONG-DSCR (C031-17-IDX)                 DTSCU031
00309                TO L031-LONG-DSCR.                                 DTSCU031
00310      SKIP1                                                        DTSCU031
00311      GO TO P1000-EXIT.                                            DTSCU031
00312      SKIP3                                                        DTSCU031
00313  P1000-18-MREL-SUTA-DUMPING-CD.                                   DTSCU031
00314      SET C031-18-IDX TO 1.                                        DTSCU031
00315      SEARCH C031-18-ENTRY                                         DTSCU031
00316         VARYING                                                   DTSCU031
00317           C031-18-IDX                                             DTSCU031
00318          WHEN L031-CD-1 = C031-18-CD (C031-18-IDX)                DTSCU031
00319              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00320              MOVE C031-18-SHORT-DSCR (C031-18-IDX)                DTSCU031
00321                TO L031-SHORT-DSCR                                 DTSCU031
00322              MOVE C031-18-LONG-DSCR (C031-18-IDX)                 DTSCU031
00323                TO L031-LONG-DSCR.                                 DTSCU031
00324      SKIP1                                                        DTSCU031
00325      GO TO P1000-EXIT.                                            DTSCU031
00326      SKIP3                                                        DTSCU031
00327  P1000-22-MSOL-LIAB-CD.                                           DTSCU031
00328      SET C031-22-IDX TO 1.                                        DTSCU031
00329      SEARCH C031-22-ENTRY                                         DTSCU031
00330         VARYING                                                   DTSCU031
00331           C031-22-IDX                                             DTSCU031
00332          WHEN L031-CD-2 = C031-22-CD (C031-22-IDX)                DTSCU031
00333              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00334              MOVE C031-22-SHORT-DSCR (C031-22-IDX)                DTSCU031
00335                TO L031-SHORT-DSCR                                 DTSCU031
00336              MOVE C031-22-LONG-DSCR (C031-22-IDX)                 DTSCU031
00337                TO L031-LONG-DSCR.                                 DTSCU031
00338      SKIP1                                                        DTSCU031
00339      GO TO P1000-EXIT.                                            DTSCU031
00340      SKIP3                                                        DTSCU031
00341  P1000-23-MSOL-INACT-CD.                                          DTSCU031
00342      SET C031-23-IDX TO 1.                                        DTSCU031
00343      SEARCH C031-23-ENTRY                                         DTSCU031
00344         VARYING                                                   DTSCU031
00345           C031-23-IDX                                             DTSCU031
00346          WHEN L031-CD-2 = C031-23-CD (C031-23-IDX)                DTSCU031
00347              MOVE '1' TO L031-RESULT-IND                          DTSCU031
00348              MOVE C031-23-SHORT-DSCR (C031-23-IDX)                DTSCU031
00349                TO L031-SHORT-DSCR                                 DTSCU031
00350              MOVE C031-23-LONG-DSCR (C031-23-IDX)                 DTSCU031
00351                TO L031-LONG-DSCR.                                 DTSCU031
00352      SKIP1                                                        DTSCU031
00353      GO TO P1000-EXIT.                                            DTSCU031
00354      SKIP3                                                        DTSCU031
00355  P1000-EXIT.                                                      DTSCU031
00356      EXIT.                                                        DTSCU031
00357      EJECT                                                        DTSCU031
00358  S899-ABEND.                                                      DTSCU031
00359      SKIP1                                                        DTSCU031
00360      EXEC CICS                                                    DTSCU031
00361          ABEND                                                    DTSCU031
00362              ABCODE (WRK-ABEND-CODE)                              DTSCU031
00363      END-EXEC.                                                    DTSCU031
00364      SKIP1                                                        DTSCU031
00365  S899-EXIT.                                                       DTSCU031
00366      EXIT.                                                        DTSCU031
