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