368 lines
29 KiB
COBOL
368 lines
29 KiB
COBOL
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
|