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