DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
367
CICS/DTSCU031.cob
Normal file
367
CICS/DTSCU031.cob
Normal file
@ -0,0 +1,367 @@
|
||||
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
|
||||
Reference in New Issue
Block a user