New programms added, GOback check added by Arturo in program USTRAN41.cob, DTSCU351.cob is not compiled yet, its copy book are missing.

This commit is contained in:
faizana
2025-08-23 14:15:17 -04:00
parent cbd5346313
commit deaa6ecb6a
8 changed files with 10309 additions and 9493 deletions

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

1059
CICS/DTSCU351.cob Normal file

File diff suppressed because it is too large Load Diff

View File

@ -1,6 +1,6 @@
00001 IDENTIFICATION DIVISION. 01/29/03
00001 IDENTIFICATION DIVISION. 04/09/13
00002 PROGRAM-ID. DTSCU415. DTSCU415
00003 AUTHOR. TRW. LV003
00003 AUTHOR. TRW. LV002
00004 DATE-WRITTEN. OCTOBER 20001. DTSCU415
00005 DATE-COMPILED. DTSCU415
00006 DTSCU415
@ -34,318 +34,319 @@
00034 DATA DIVISION. DTSCU415
00035 SKIP3 DTSCU415
00036 WORKING-STORAGE SECTION. DTSCU415
000365 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU415 01/29/03'. DTSCU415
00037 SKIP3 DTSCU415
00038 01 WRK-AREA. DTSCU415
00039 05 WRK-ABEND-CODE PIC X(04) VALUE 'U415'. DTSCU415
00040 DTSCU415
00041 05 WRK-YR PIC S9(05) COMP-3. DTSCU415
00042 05 WRK-FIRST-HSEHLD-YR PIC S9(05) COMP-3 DTSCU415
00043 VALUE +2002. DTSCU415
00044 DTSCU415
00045 05 WRK-YRQ-AREA PIC 9(05). DTSCU415
00046 05 FILLER REDEFINES WRK-YRQ-AREA. DTSCU415
00047 10 WRK-YRQ-CCYY PIC 9(04). DTSCU415
00048 10 WRK-YRQ-Q PIC 9(01). DTSCU415
00049 DTSCU415
00050 05 WRK-LAST-YRQ PIC 9(05). DTSCU415
00051 05 FILLER REDEFINES WRK-LAST-YRQ. DTSCU415
00052 10 WRK-LAST-YYYY PIC 9(04). DTSCU415
00053 10 WRK-LAST-Q PIC 9(01). DTSCU415
00054 DTSCU415
00055 05 WRK-LAST-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCU415
00056 05 WRK-LAST-MASS-MAIL-YR PIC S9(05) COMP-3. DTSCU415
00057 05 WRK-LAST-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCU415
00058 05 WRK-LAST-LATE-PEN-YR PIC S9(05) COMP-3. DTSCU415
00059 05 WRK-LAST-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCU415
00060 05 WRK-LAST-FIRST-DEL-YR PIC S9(05) COMP-3. DTSCU415
00061 05 WRK-LAST-FINAL-DEL-DATE PIC S9(09) COMP-3. DTSCU415
00062 05 WRK-LAST-FINAL-DEL-YR PIC S9(05) COMP-3. DTSCU415
00063 05 WRK-LAST-FINAL-ACTION-DATE PIC S9(09) COMP-3. DTSCU415
00064 DTSCU415
00065 05 WRK-FAFD-FOUND-IND PIC X(01). DTSCU415
00066 88 WRK-FAFD-FOUND-YES-88 VALUE 'Y'. DTSCU415
00067 88 WRK-FAFD-FOUND-NO-88 VALUE 'N'. DTSCU415
00068 DTSCU415
00069 01 L831-COMM-AREA. DTSCU415
00070 05 L831-CONTROL-BLOCK. DTSCU415
00071 ++INCLUDE DTSIL831 DTSCU415
00072 05 FSKL-REC. DTSCU415
00073 ++INCLUDE DTSIFSKL DTSCU415
00074 EJECT DTSCU415
00075 05 FAFD-REC REDEFINES FSKL-REC. DTSCU415
00076 ++INCLUDE DTSIFAFD DTSCU415
00077 EJECT DTSCU415
00078 LINKAGE SECTION. DTSCU415
00079 SKIP3 DTSCU415
00080 01 DFHCOMMAREA. DTSCU415
00081 ++INCLUDE DTSIL415 DTSCU415
00082 EJECT DTSCU415
00083 PROCEDURE DIVISION. DTSCU415
00084 SKIP2 DTSCU415
00085 DTSCU400-MAINLINE. DTSCU415
00086 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSCU415
00087 DTSCU415
00088 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU415
00089 DTSCU415
00090 DTSCU400-MAINLINE-EXIT. DTSCU415
00091 EXEC CICS DTSCU415
00092 RETURN DTSCU415
00093 END-EXEC. DTSCU415
00094 DTSCU415
00095 EJECT DTSCU415
00096 I0000-INITIALIZE. DTSCU415
00097 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSCU415
00098 DTSCU415
00099 PERFORM I2000-INIT-RETURN THRU I2000-EXIT. DTSCU415
00100 DTSCU415
00101 I0000-EXIT. DTSCU415
00102 EXIT. DTSCU415
00103 I1000-EDIT-INPUT. DTSCU415
00104 IF L415-MODE-INPUT-YEAR-88 DTSCU415
00105 IF L415-YR NOT NUMERIC DTSCU415
00106 PERFORM S899-ABEND THRU S899-EXIT DTSCU415
00107 ELSE DTSCU415
00108 MOVE L415-YR TO WRK-YR DTSCU415
00109 ELSE DTSCU415
00110 MOVE ZERO TO WRK-YR. DTSCU415
00111 DTSCU415
00112 I1000-EXIT. DTSCU415
00113 EXIT. DTSCU415
00114 DTSCU415
00115 I2000-INIT-RETURN. DTSCU415
00116 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE DTSCU415
00117 L415-UC30H-MASS-MAIL-DATE DTSCU415
00118 L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415
00119 L415-UC30H-MASS-MAIL-END-YRQ DTSCU415
00120 L415-UC30H-LATE-PEN-DATE DTSCU415
00121 L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415
00122 L415-UC30H-LATE-PEN-END-YRQ DTSCU415
00123 L415-UC30H-FIRST-DEL-DATE DTSCU415
00124 L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415
00125 L415-UC30H-FIRST-DEL-END-YRQ DTSCU415
00126 L415-UC30H-FINAL-DEL-DATE DTSCU415
00127 L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415
00128 L415-UC30H-FINAL-DEL-END-YRQ DTSCU415
00129 L415-UC30H-FINAL-ACTION-DATE DTSCU415
00130 WRK-LAST-MASS-MAIL-DATE DTSCU415
00131 WRK-LAST-MASS-MAIL-YR DTSCU415
00132 WRK-LAST-LATE-PEN-DATE DTSCU415
00133 WRK-LAST-LATE-PEN-YR DTSCU415
00134 WRK-LAST-FIRST-DEL-DATE DTSCU415
00135 WRK-LAST-FIRST-DEL-YR DTSCU415
00136 WRK-LAST-FINAL-DEL-DATE DTSCU415
00137 WRK-LAST-FINAL-DEL-YR DTSCU415
00138 WRK-LAST-FINAL-ACTION-DATE. DTSCU415
00139 DTSCU415
000365 77 PAN-VALET PICTURE X(24) VALUE '002DTSCU415 04/09/13'. DTSCU415
00037 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU415 01/29/03'. DTSCU415
00038 SKIP3 DTSCU415
00039 01 WRK-AREA. DTSCU415
00040 05 WRK-ABEND-CODE PIC X(04) VALUE 'U415'. DTSCU415
00041 DTSCU415
00042 05 WRK-YR PIC S9(05) COMP-3. DTSCU415
00043 05 WRK-FIRST-HSEHLD-YR PIC S9(05) COMP-3 DTSCU415
00044 VALUE +2002. DTSCU415
00045 DTSCU415
00046 05 WRK-YRQ-AREA PIC 9(05). DTSCU415
00047 05 FILLER REDEFINES WRK-YRQ-AREA. DTSCU415
00048 10 WRK-YRQ-CCYY PIC 9(04). DTSCU415
00049 10 WRK-YRQ-Q PIC 9(01). DTSCU415
00050 DTSCU415
00051 05 WRK-LAST-YRQ PIC 9(05). DTSCU415
00052 05 FILLER REDEFINES WRK-LAST-YRQ. DTSCU415
00053 10 WRK-LAST-YYYY PIC 9(04). DTSCU415
00054 10 WRK-LAST-Q PIC 9(01). DTSCU415
00055 DTSCU415
00056 05 WRK-LAST-MASS-MAIL-DATE PIC S9(09) COMP-3. DTSCU415
00057 05 WRK-LAST-MASS-MAIL-YR PIC S9(05) COMP-3. DTSCU415
00058 05 WRK-LAST-LATE-PEN-DATE PIC S9(09) COMP-3. DTSCU415
00059 05 WRK-LAST-LATE-PEN-YR PIC S9(05) COMP-3. DTSCU415
00060 05 WRK-LAST-FIRST-DEL-DATE PIC S9(09) COMP-3. DTSCU415
00061 05 WRK-LAST-FIRST-DEL-YR PIC S9(05) COMP-3. DTSCU415
00062 05 WRK-LAST-ESTIMATED-DATE PIC S9(09) COMP-3. CL**2
00063 05 WRK-LAST-FINAL-DEL-YR PIC S9(05) COMP-3. DTSCU415
00064 05 WRK-LAST-FINAL-ACTION-DATE PIC S9(09) COMP-3. DTSCU415
00065 DTSCU415
00066 05 WRK-FAFD-FOUND-IND PIC X(01). DTSCU415
00067 88 WRK-FAFD-FOUND-YES-88 VALUE 'Y'. DTSCU415
00068 88 WRK-FAFD-FOUND-NO-88 VALUE 'N'. DTSCU415
00069 DTSCU415
00070 01 L831-COMM-AREA. DTSCU415
00071 05 L831-CONTROL-BLOCK. DTSCU415
00072 ++INCLUDE DTSIL831 DTSCU415
00073 05 FSKL-REC. DTSCU415
00074 ++INCLUDE DTSIFSKL DTSCU415
00075 EJECT DTSCU415
00076 05 FAFD-REC REDEFINES FSKL-REC. DTSCU415
00077 ++INCLUDE DTSIFAFD DTSCU415
00078 EJECT DTSCU415
00079 LINKAGE SECTION. DTSCU415
00080 SKIP3 DTSCU415
00081 01 DFHCOMMAREA. DTSCU415
00082 ++INCLUDE DTSIL415 DTSCU415
00083 EJECT DTSCU415
00084 PROCEDURE DIVISION. DTSCU415
00085 SKIP2 DTSCU415
00086 DTSCU400-MAINLINE. DTSCU415
00087 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSCU415
00088 DTSCU415
00089 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU415
00090 DTSCU415
00091 DTSCU400-MAINLINE-EXIT. DTSCU415
00092 EXEC CICS DTSCU415
00093 RETURN DTSCU415
00094 END-EXEC. DTSCU415
00095 DTSCU415
00096 EJECT DTSCU415
00097 I0000-INITIALIZE. DTSCU415
00098 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSCU415
00099 DTSCU415
00100 PERFORM I2000-INIT-RETURN THRU I2000-EXIT. DTSCU415
00101 DTSCU415
00102 I0000-EXIT. DTSCU415
00103 EXIT. DTSCU415
00104 I1000-EDIT-INPUT. DTSCU415
00105 IF L415-MODE-INPUT-YEAR-88 DTSCU415
00106 IF L415-YR NOT NUMERIC DTSCU415
00107 PERFORM S899-ABEND THRU S899-EXIT DTSCU415
00108 ELSE DTSCU415
00109 MOVE L415-YR TO WRK-YR DTSCU415
00110 ELSE DTSCU415
00111 MOVE ZERO TO WRK-YR. DTSCU415
00112 DTSCU415
00113 I1000-EXIT. DTSCU415
00114 EXIT. DTSCU415
00115 DTSCU415
00116 I2000-INIT-RETURN. DTSCU415
00117 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE DTSCU415
00118 L415-UC30H-MASS-MAIL-DATE DTSCU415
00119 L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415
00120 L415-UC30H-MASS-MAIL-END-YRQ DTSCU415
00121 L415-UC30H-LATE-PEN-DATE DTSCU415
00122 L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415
00123 L415-UC30H-LATE-PEN-END-YRQ DTSCU415
00124 L415-UC30H-FIRST-DEL-DATE DTSCU415
00125 L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415
00126 L415-UC30H-FIRST-DEL-END-YRQ DTSCU415
00127 L415-UC30H-ESTIMATED-DATE CL**2
00128 L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415
00129 L415-UC30H-FINAL-DEL-END-YRQ DTSCU415
00130 L415-UC30H-FINAL-ACTION-DATE DTSCU415
00131 WRK-LAST-MASS-MAIL-DATE DTSCU415
00132 WRK-LAST-MASS-MAIL-YR DTSCU415
00133 WRK-LAST-LATE-PEN-DATE DTSCU415
00134 WRK-LAST-LATE-PEN-YR DTSCU415
00135 WRK-LAST-FIRST-DEL-DATE DTSCU415
00136 WRK-LAST-FIRST-DEL-YR DTSCU415
00137 WRK-LAST-ESTIMATED-DATE CL**2
00138 WRK-LAST-FINAL-DEL-YR DTSCU415
00139 WRK-LAST-FINAL-ACTION-DATE. DTSCU415
00140 DTSCU415
00141 I2000-EXIT. DTSCU415
00142 EXIT. DTSCU415
00143 DTSCU415
00144 P0000-PROCESS. DTSCU415
00145 SET L415-NOT-FOUND-88 TO TRUE. DTSCU415
00146 DTSCU415
00147 IF L415-MODE-INPUT-YEAR-88 DTSCU415
00148 PERFORM P1000-INPUT-YEAR THRU P1000-EXIT DTSCU415
00149 IF L415-OK-88 DTSCU415
00150 PERFORM P1100-RETURN-VALUES THRU P1100-EXIT DTSCU415
00151 END-IF DTSCU415
00152 ELSE DTSCU415
00153 PERFORM P2000-MOST-RECENT THRU P2000-EXIT DTSCU415
00154 PERFORM P2200-RETURN-VALUES THRU P2200-EXIT. DTSCU415
00155 DTSCU415
00156 P0000-EXIT. DTSCU415
00157 EXIT. DTSCU415
00158 DTSCU415
00159 P1000-INPUT-YEAR. DTSCU415
00160 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415
00161 MOVE WRK-YR TO FAFD-YR. DTSCU415
00162 SET FAFD-AFD-88 TO TRUE. DTSCU415
00163 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415
00164 PERFORM S831-READ THRU S831-EXIT. DTSCU415
00165 IF L831-NO-REC-88 DTSCU415
00166 NEXT SENTENCE DTSCU415
00167 ELSE DTSCU415
00168 MOVE FSKL-REC TO FAFD-REC DTSCU415
00169 SET L415-OK-88 TO TRUE. DTSCU415
00170 DTSCU415
00171 P1000-EXIT. DTSCU415
00172 EXIT. DTSCU415
00173 DTSCU415
00174 P1100-RETURN-VALUES. DTSCU415
00175 MOVE FAFD-UC30H-RPT-DUE-DATE DTSCU415
00176 TO L415-UC30H-RPT-DUE-DATE. DTSCU415
00177 DTSCU415
00178 MOVE FAFD-UC30H-MASS-MAIL-DATE DTSCU415
00179 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415
00180 MOVE FAFD-YR TO WRK-LAST-YYYY. DTSCU415
00181 MOVE 1 TO WRK-LAST-Q. DTSCU415
00182 MOVE WRK-LAST-YRQ DTSCU415
00183 TO L415-UC30H-MASS-MAIL-STRT-YRQ. DTSCU415
00184 MOVE 4 TO WRK-LAST-Q. DTSCU415
00185 MOVE WRK-LAST-YRQ DTSCU415
00186 TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415
00187 DTSCU415
00188 MOVE FAFD-LATE-PEN-ASSESSED-DATE DTSCU415
00189 TO L415-UC30H-LATE-PEN-DATE. DTSCU415
00190 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415
00191 MOVE 1 TO WRK-LAST-Q. DTSCU415
00192 MOVE WRK-LAST-YRQ DTSCU415
00193 TO L415-UC30H-LATE-PEN-STRT-YRQ. DTSCU415
00194 MOVE 4 TO WRK-LAST-Q. DTSCU415
00195 MOVE WRK-LAST-YRQ DTSCU415
00196 TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415
00197 DTSCU415
00198 MOVE FAFD-UC30H-FIRST-DEL-DATE DTSCU415
00199 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415
00200 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415
00201 MOVE 1 TO WRK-LAST-Q. DTSCU415
00202 MOVE WRK-LAST-YRQ DTSCU415
00203 TO L415-UC30H-FIRST-DEL-STRT-YRQ. DTSCU415
00204 MOVE 4 TO WRK-LAST-Q. DTSCU415
00205 MOVE WRK-LAST-YRQ DTSCU415
00206 TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415
00207 DTSCU415
00208 MOVE FAFD-UC30H-FINAL-DEL-DATE DTSCU415
00209 TO L415-UC30H-FINAL-DEL-DATE. DTSCU415
00210 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415
00211 MOVE 1 TO WRK-LAST-Q. DTSCU415
00212 MOVE WRK-LAST-YRQ DTSCU415
00213 TO L415-UC30H-FINAL-DEL-STRT-YRQ. DTSCU415
00214 MOVE 4 TO WRK-LAST-Q. DTSCU415
00215 MOVE WRK-LAST-YRQ DTSCU415
00216 TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415
00217 DTSCU415
00218 MOVE FAFD-UC30H-FINAL-ACTION-DATE DTSCU415
00219 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415
00220 DTSCU415
00221 P1100-EXIT. DTSCU415
00222 EXIT. DTSCU415
00223 DTSCU415
00224 P2000-MOST-RECENT. DTSCU415
00225 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415
00226 SET FAFD-AFD-88 TO TRUE. DTSCU415
00227 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415
00228 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCU415
00229 IF L831-OK-88 DTSCU415
00230 SET L415-OK-88 TO TRUE DTSCU415
00231 PERFORM P2100-SCAN-FAFD THRU P2100-EXIT DTSCU415
00232 UNTIL L831-NO-REC-88. DTSCU415
00233 DTSCU415
00234 P2000-EXIT. DTSCU415
00235 EXIT. DTSCU415
00236 DTSCU415
00237 P2100-SCAN-FAFD. DTSCU415
00238 MOVE FSKL-REC TO FAFD-REC. DTSCU415
00239 DTSCU415
00240 IF FAFD-UC30H-MASS-MAIL-DATE > DTSCU415
00241 WRK-LAST-MASS-MAIL-DATE DTSCU415
00242 MOVE FAFD-UC30H-MASS-MAIL-DATE TO DTSCU415
00243 WRK-LAST-MASS-MAIL-DATE DTSCU415
00244 MOVE FAFD-YR TO WRK-LAST-MASS-MAIL-YR. DTSCU415
00245 DTSCU415
00246 IF FAFD-LATE-PEN-ASSESSED-DATE > DTSCU415
00247 WRK-LAST-LATE-PEN-DATE DTSCU415
00248 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO DTSCU415
00249 WRK-LAST-LATE-PEN-DATE DTSCU415
00250 MOVE FAFD-YR TO WRK-LAST-LATE-PEN-YR. DTSCU415
00251 DTSCU415
00252 IF FAFD-UC30H-FIRST-DEL-DATE > DTSCU415
00253 WRK-LAST-FIRST-DEL-DATE DTSCU415
00254 MOVE FAFD-UC30H-FIRST-DEL-DATE TO DTSCU415
00255 WRK-LAST-FIRST-DEL-DATE DTSCU415
00256 MOVE FAFD-YR TO WRK-LAST-FIRST-DEL-YR. DTSCU415
00257 DTSCU415
00258 IF FAFD-UC30H-FINAL-DEL-DATE > DTSCU415
00259 WRK-LAST-FINAL-DEL-DATE DTSCU415
00260 MOVE FAFD-UC30H-FINAL-DEL-DATE TO DTSCU415
00261 WRK-LAST-FINAL-DEL-DATE DTSCU415
00262 MOVE FAFD-YR TO WRK-LAST-FINAL-DEL-YR. DTSCU415
00263 DTSCU415
00264 IF FAFD-UC30H-FINAL-ACTION-DATE > DTSCU415
00265 WRK-LAST-FINAL-ACTION-DATE DTSCU415
00266 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO DTSCU415
00267 WRK-LAST-FINAL-ACTION-DATE. DTSCU415
00268 DTSCU415
00269 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCU415
00270 DTSCU415
00271 P2100-EXIT. DTSCU415
00272 EXIT. DTSCU415
00273 DTSCU415
00274 P2200-RETURN-VALUES. DTSCU415
00275 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE. DTSCU415
00276 DTSCU415
00277 MOVE WRK-LAST-MASS-MAIL-DATE DTSCU415
00278 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415
00279 IF WRK-LAST-MASS-MAIL-YR > 0 DTSCU415
00280 MOVE WRK-LAST-MASS-MAIL-YR DTSCU415
00281 TO WRK-LAST-YYYY DTSCU415
00282 MOVE 1 TO WRK-LAST-Q DTSCU415
00283 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415
00284 MOVE 4 TO WRK-LAST-Q DTSCU415
00285 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415
00286 DTSCU415
00287 MOVE WRK-LAST-LATE-PEN-DATE DTSCU415
00288 TO L415-UC30H-LATE-PEN-DATE. DTSCU415
00289 IF WRK-LAST-LATE-PEN-YR > 0 DTSCU415
00290 MOVE WRK-LAST-LATE-PEN-YR DTSCU415
00291 TO WRK-LAST-YYYY DTSCU415
00292 MOVE 1 TO WRK-LAST-Q DTSCU415
00293 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415
00294 MOVE 4 TO WRK-LAST-Q DTSCU415
00295 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415
00296 DTSCU415
00297 MOVE WRK-LAST-FIRST-DEL-DATE DTSCU415
00298 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415
00299 IF WRK-LAST-FIRST-DEL-YR > 0 DTSCU415
00300 MOVE WRK-LAST-FIRST-DEL-YR DTSCU415
00301 TO WRK-LAST-YYYY DTSCU415
00302 MOVE 1 TO WRK-LAST-Q DTSCU415
00303 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415
00304 MOVE 4 TO WRK-LAST-Q DTSCU415
00305 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415
00306 DTSCU415
00307 MOVE WRK-LAST-FINAL-DEL-DATE DTSCU415
00308 TO L415-UC30H-FINAL-DEL-DATE. DTSCU415
00309 IF WRK-LAST-FINAL-DEL-YR > 0 DTSCU415
00310 MOVE WRK-LAST-FINAL-DEL-YR DTSCU415
00311 TO WRK-LAST-YYYY DTSCU415
00312 MOVE 1 TO WRK-LAST-Q DTSCU415
00313 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415
00314 MOVE 4 TO WRK-LAST-Q DTSCU415
00315 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415
00316 DTSCU415
00317 MOVE WRK-LAST-FINAL-ACTION-DATE DTSCU415
00318 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415
00319 DTSCU415
00320 P2200-EXIT. DTSCU415
00321 EXIT. DTSCU415
00322 DTSCU415
00323 S831-READ. DTSCU415
00324 SET L831-READ-88 TO TRUE. DTSCU415
00325 GO TO S831-REF-IO. DTSCU415
00326 DTSCU415
00327 S831-START-BROWSE. DTSCU415
00328 SET L831-START-BROWSE-88 TO TRUE. DTSCU415
00329 GO TO S831-REF-IO. DTSCU415
00330 DTSCU415
00331 S831-READ-NEXT. DTSCU415
00332 SET L831-READ-NEXT-88 TO TRUE. DTSCU415
00333 GO TO S831-REF-IO. DTSCU415
00334 DTSCU415
00335 S831-REF-IO. DTSCU415
00336 EXEC CICS LINK DTSCU415
00337 PROGRAM ('DTSCU831') DTSCU415
00338 COMMAREA (L831-COMM-AREA) DTSCU415
00339 END-EXEC. DTSCU415
00340 SKIP1 DTSCU415
00341 S831-EXIT. DTSCU415
00342 EXIT. DTSCU415
00343 DTSCU415
00344 S899-ABEND. DTSCU415
00345 EXEC CICS ABEND DTSCU415
00346 ABCODE(WRK-ABEND-CODE) DTSCU415
00347 END-EXEC. DTSCU415
00348 DTSCU415
00349 S899-EXIT. DTSCU415
00350 EXIT. DTSCU415
00141 DTSCU415
00142 I2000-EXIT. DTSCU415
00143 EXIT. DTSCU415
00144 DTSCU415
00145 P0000-PROCESS. DTSCU415
00146 SET L415-NOT-FOUND-88 TO TRUE. DTSCU415
00147 DTSCU415
00148 IF L415-MODE-INPUT-YEAR-88 DTSCU415
00149 PERFORM P1000-INPUT-YEAR THRU P1000-EXIT DTSCU415
00150 IF L415-OK-88 DTSCU415
00151 PERFORM P1100-RETURN-VALUES THRU P1100-EXIT DTSCU415
00152 END-IF DTSCU415
00153 ELSE DTSCU415
00154 PERFORM P2000-MOST-RECENT THRU P2000-EXIT DTSCU415
00155 PERFORM P2200-RETURN-VALUES THRU P2200-EXIT. DTSCU415
00156 DTSCU415
00157 P0000-EXIT. DTSCU415
00158 EXIT. DTSCU415
00159 DTSCU415
00160 P1000-INPUT-YEAR. DTSCU415
00161 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415
00162 MOVE WRK-YR TO FAFD-YR. DTSCU415
00163 SET FAFD-AFD-88 TO TRUE. DTSCU415
00164 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415
00165 PERFORM S831-READ THRU S831-EXIT. DTSCU415
00166 IF L831-NO-REC-88 DTSCU415
00167 NEXT SENTENCE DTSCU415
00168 ELSE DTSCU415
00169 MOVE FSKL-REC TO FAFD-REC DTSCU415
00170 SET L415-OK-88 TO TRUE. DTSCU415
00171 DTSCU415
00172 P1000-EXIT. DTSCU415
00173 EXIT. DTSCU415
00174 DTSCU415
00175 P1100-RETURN-VALUES. DTSCU415
00176 MOVE FAFD-UC30H-RPT-DUE-DATE DTSCU415
00177 TO L415-UC30H-RPT-DUE-DATE. DTSCU415
00178 DTSCU415
00179 MOVE FAFD-UC30H-MASS-MAIL-DATE DTSCU415
00180 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415
00181 MOVE FAFD-YR TO WRK-LAST-YYYY. DTSCU415
00182 MOVE 1 TO WRK-LAST-Q. DTSCU415
00183 MOVE WRK-LAST-YRQ DTSCU415
00184 TO L415-UC30H-MASS-MAIL-STRT-YRQ. DTSCU415
00185 MOVE 4 TO WRK-LAST-Q. DTSCU415
00186 MOVE WRK-LAST-YRQ DTSCU415
00187 TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415
00188 DTSCU415
00189 MOVE FAFD-LATE-PEN-ASSESSED-DATE DTSCU415
00190 TO L415-UC30H-LATE-PEN-DATE. DTSCU415
00191 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415
00192 MOVE 1 TO WRK-LAST-Q. DTSCU415
00193 MOVE WRK-LAST-YRQ DTSCU415
00194 TO L415-UC30H-LATE-PEN-STRT-YRQ. DTSCU415
00195 MOVE 4 TO WRK-LAST-Q. DTSCU415
00196 MOVE WRK-LAST-YRQ DTSCU415
00197 TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415
00198 DTSCU415
00199 MOVE FAFD-UC30H-FIRST-DEL-DATE DTSCU415
00200 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415
00201 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415
00202 MOVE 1 TO WRK-LAST-Q. DTSCU415
00203 MOVE WRK-LAST-YRQ DTSCU415
00204 TO L415-UC30H-FIRST-DEL-STRT-YRQ. DTSCU415
00205 MOVE 4 TO WRK-LAST-Q. DTSCU415
00206 MOVE WRK-LAST-YRQ DTSCU415
00207 TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415
00208 DTSCU415
00209 MOVE FAFD-UC30H-ESTIMATED-DATE CL**2
00210 TO L415-UC30H-ESTIMATED-DATE. CL**2
00211 MOVE FAFD-YR TO WRK-LAST-YYYY DTSCU415
00212 MOVE 1 TO WRK-LAST-Q. DTSCU415
00213 MOVE WRK-LAST-YRQ DTSCU415
00214 TO L415-UC30H-FINAL-DEL-STRT-YRQ. DTSCU415
00215 MOVE 4 TO WRK-LAST-Q. DTSCU415
00216 MOVE WRK-LAST-YRQ DTSCU415
00217 TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415
00218 DTSCU415
00219 MOVE FAFD-UC30H-FINAL-ACTION-DATE DTSCU415
00220 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415
00221 DTSCU415
00222 P1100-EXIT. DTSCU415
00223 EXIT. DTSCU415
00224 DTSCU415
00225 P2000-MOST-RECENT. DTSCU415
00226 MOVE LOW-VALUES TO FAFD-KEY-AREA. DTSCU415
00227 SET FAFD-AFD-88 TO TRUE. DTSCU415
00228 MOVE FAFD-KEY-AREA TO FSKL-KEY-AREA. DTSCU415
00229 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCU415
00230 IF L831-OK-88 DTSCU415
00231 SET L415-OK-88 TO TRUE DTSCU415
00232 PERFORM P2100-SCAN-FAFD THRU P2100-EXIT DTSCU415
00233 UNTIL L831-NO-REC-88. DTSCU415
00234 DTSCU415
00235 P2000-EXIT. DTSCU415
00236 EXIT. DTSCU415
00237 DTSCU415
00238 P2100-SCAN-FAFD. DTSCU415
00239 MOVE FSKL-REC TO FAFD-REC. DTSCU415
00240 DTSCU415
00241 IF FAFD-UC30H-MASS-MAIL-DATE > DTSCU415
00242 WRK-LAST-MASS-MAIL-DATE DTSCU415
00243 MOVE FAFD-UC30H-MASS-MAIL-DATE TO DTSCU415
00244 WRK-LAST-MASS-MAIL-DATE DTSCU415
00245 MOVE FAFD-YR TO WRK-LAST-MASS-MAIL-YR. DTSCU415
00246 DTSCU415
00247 IF FAFD-LATE-PEN-ASSESSED-DATE > DTSCU415
00248 WRK-LAST-LATE-PEN-DATE DTSCU415
00249 MOVE FAFD-LATE-PEN-ASSESSED-DATE TO DTSCU415
00250 WRK-LAST-LATE-PEN-DATE DTSCU415
00251 MOVE FAFD-YR TO WRK-LAST-LATE-PEN-YR. DTSCU415
00252 DTSCU415
00253 IF FAFD-UC30H-FIRST-DEL-DATE > DTSCU415
00254 WRK-LAST-FIRST-DEL-DATE DTSCU415
00255 MOVE FAFD-UC30H-FIRST-DEL-DATE TO DTSCU415
00256 WRK-LAST-FIRST-DEL-DATE DTSCU415
00257 MOVE FAFD-YR TO WRK-LAST-FIRST-DEL-YR. DTSCU415
00258 DTSCU415
00259 IF FAFD-UC30H-ESTIMATED-DATE > CL**2
00260 WRK-LAST-ESTIMATED-DATE CL**2
00261 MOVE FAFD-UC30H-ESTIMATED-DATE TO CL**2
00262 WRK-LAST-ESTIMATED-DATE CL**2
00263 MOVE FAFD-YR TO WRK-LAST-FINAL-DEL-YR. DTSCU415
00264 DTSCU415
00265 IF FAFD-UC30H-FINAL-ACTION-DATE > DTSCU415
00266 WRK-LAST-FINAL-ACTION-DATE DTSCU415
00267 MOVE FAFD-UC30H-FINAL-ACTION-DATE TO DTSCU415
00268 WRK-LAST-FINAL-ACTION-DATE. DTSCU415
00269 DTSCU415
00270 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCU415
00271 DTSCU415
00272 P2100-EXIT. DTSCU415
00273 EXIT. DTSCU415
00274 DTSCU415
00275 P2200-RETURN-VALUES. DTSCU415
00276 MOVE ZERO TO L415-UC30H-RPT-DUE-DATE. DTSCU415
00277 DTSCU415
00278 MOVE WRK-LAST-MASS-MAIL-DATE DTSCU415
00279 TO L415-UC30H-MASS-MAIL-DATE. DTSCU415
00280 IF WRK-LAST-MASS-MAIL-YR > 0 DTSCU415
00281 MOVE WRK-LAST-MASS-MAIL-YR DTSCU415
00282 TO WRK-LAST-YYYY DTSCU415
00283 MOVE 1 TO WRK-LAST-Q DTSCU415
00284 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-STRT-YRQ DTSCU415
00285 MOVE 4 TO WRK-LAST-Q DTSCU415
00286 MOVE WRK-LAST-YRQ TO L415-UC30H-MASS-MAIL-END-YRQ. DTSCU415
00287 DTSCU415
00288 MOVE WRK-LAST-LATE-PEN-DATE DTSCU415
00289 TO L415-UC30H-LATE-PEN-DATE. DTSCU415
00290 IF WRK-LAST-LATE-PEN-YR > 0 DTSCU415
00291 MOVE WRK-LAST-LATE-PEN-YR DTSCU415
00292 TO WRK-LAST-YYYY DTSCU415
00293 MOVE 1 TO WRK-LAST-Q DTSCU415
00294 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-STRT-YRQ DTSCU415
00295 MOVE 4 TO WRK-LAST-Q DTSCU415
00296 MOVE WRK-LAST-YRQ TO L415-UC30H-LATE-PEN-END-YRQ. DTSCU415
00297 DTSCU415
00298 MOVE WRK-LAST-FIRST-DEL-DATE DTSCU415
00299 TO L415-UC30H-FIRST-DEL-DATE. DTSCU415
00300 IF WRK-LAST-FIRST-DEL-YR > 0 DTSCU415
00301 MOVE WRK-LAST-FIRST-DEL-YR DTSCU415
00302 TO WRK-LAST-YYYY DTSCU415
00303 MOVE 1 TO WRK-LAST-Q DTSCU415
00304 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-STRT-YRQ DTSCU415
00305 MOVE 4 TO WRK-LAST-Q DTSCU415
00306 MOVE WRK-LAST-YRQ TO L415-UC30H-FIRST-DEL-END-YRQ. DTSCU415
00307 DTSCU415
00308 MOVE WRK-LAST-ESTIMATED-DATE CL**2
00309 TO L415-UC30H-ESTIMATED-DATE. CL**2
00310 IF WRK-LAST-FINAL-DEL-YR > 0 DTSCU415
00311 MOVE WRK-LAST-FINAL-DEL-YR DTSCU415
00312 TO WRK-LAST-YYYY DTSCU415
00313 MOVE 1 TO WRK-LAST-Q DTSCU415
00314 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-STRT-YRQ DTSCU415
00315 MOVE 4 TO WRK-LAST-Q DTSCU415
00316 MOVE WRK-LAST-YRQ TO L415-UC30H-FINAL-DEL-END-YRQ. DTSCU415
00317 DTSCU415
00318 MOVE WRK-LAST-FINAL-ACTION-DATE DTSCU415
00319 TO L415-UC30H-FINAL-ACTION-DATE. DTSCU415
00320 DTSCU415
00321 P2200-EXIT. DTSCU415
00322 EXIT. DTSCU415
00323 DTSCU415
00324 S831-READ. DTSCU415
00325 SET L831-READ-88 TO TRUE. DTSCU415
00326 GO TO S831-REF-IO. DTSCU415
00327 DTSCU415
00328 S831-START-BROWSE. DTSCU415
00329 SET L831-START-BROWSE-88 TO TRUE. DTSCU415
00330 GO TO S831-REF-IO. DTSCU415
00331 DTSCU415
00332 S831-READ-NEXT. DTSCU415
00333 SET L831-READ-NEXT-88 TO TRUE. DTSCU415
00334 GO TO S831-REF-IO. DTSCU415
00335 DTSCU415
00336 S831-REF-IO. DTSCU415
00337 EXEC CICS LINK DTSCU415
00338 PROGRAM ('DTSCU831') DTSCU415
00339 COMMAREA (L831-COMM-AREA) DTSCU415
00340 END-EXEC. DTSCU415
00341 SKIP1 DTSCU415
00342 S831-EXIT. DTSCU415
00343 EXIT. DTSCU415
00344 DTSCU415
00345 S899-ABEND. DTSCU415
00346 EXEC CICS ABEND DTSCU415
00347 ABCODE(WRK-ABEND-CODE) DTSCU415
00348 END-EXEC. DTSCU415
00349 DTSCU415
00350 S899-EXIT. DTSCU415
00351 EXIT. DTSCU415

View File

@ -1,264 +0,0 @@
00001 ***** 11/14/05
00002 * DTSSIS76 MISCELLANEOUS BATCH PRINT REQUESTS DTSIS76
00003 * SEND/RECEIVE AREA LV011
00004 ***** DTSIS76
00005 10 FILLER PIC X(12). DTSIS76
00006 DTSIS76
00007 10 MAP-SCR-TYPE-AREA. DTSIS76
00008 15 MAP-SCR-TYPE-L PIC S9(04) COMP. DTSIS76
00009 15 MAP-SCR-TYPE-A PIC X(01). DTSIS76
00010 15 MAP-SCR-TYPE PIC X(02). DTSIS76
00011 DTSIS76
00012 10 MAP-CICS-REGION-NAME-AREA. DTSIS76
00013 15 MAP-CICS-REGION-NAME-L PIC S9(04) COMP. DTSIS76
00014 15 MAP-CICS-REGION-NAME-A PIC X(01). DTSIS76
00015 15 MAP-CICS-REGION-NAME PIC X(08). DTSIS76
00016 DTSIS76
00017 10 MAP-SYS-DATE-AREA. DTSIS76
00018 15 MAP-SYS-DATE-L PIC S9(04) COMP. DTSIS76
00019 15 MAP-SYS-DATE-A PIC X(01). DTSIS76
00020 15 MAP-SYS-DATE PIC X(08). DTSIS76
00021 DTSIS76
00022 10 MAP-SYS-TIME-AREA. DTSIS76
00023 15 MAP-SYS-TIME-L PIC S9(04) COMP. DTSIS76
00024 15 MAP-SYS-TIME-A PIC X(01). DTSIS76
00025 15 MAP-SYS-TIME PIC X(08). DTSIS76
00026 DTSIS76
00027 10 MAP-EMP-NO-AREA. DTSIS76
00028 15 F760312. DTSIS76
00029 20 MAP-EMP-NO-1-L PIC S9(04) COMP. DTSIS76
00030 20 MAP-EMP-NO-1-A PIC X(01). DTSIS76
00031 20 MAP-EMP-NO-1 PIC X(03). DTSIS76
00032 15 F760316. DTSIS76
00033 20 MAP-EMP-NO-2-L PIC S9(04) COMP. DTSIS76
00034 20 MAP-EMP-NO-2-A PIC X(01). DTSIS76
00035 20 MAP-EMP-NO-2 PIC X(03). DTSIS76
00036 DTSIS76
00037 10 F760323. DTSIS76
00038 15 MAP-PRIMARY-NAME-L PIC S9(04) COMP. DTSIS76
00039 15 MAP-PRIMARY-NAME-A PIC X(01). DTSIS76
00040 15 MAP-PRIMARY-NAME PIC X(40). DTSIS76
00041 DTSIS76
00042 10 MAP-MAILING-LABELS-AREA. DTSIS76
00043 15 MAP-MAILING-LABELS-L PIC S9(04) COMP. DTSIS76
00044 15 MAP-MAILING-LABELS-A PIC X(01). DTSIS76
00045 15 MAP-MAILING-LABELS PIC X(02). DTSIS76
00046 15 MAP-MAILING-LABELS-N REDEFINES DTSIS76
00047 MAP-MAILING-LABELS PIC ZZ. DTSIS76
00048 DTSIS76
00049 10 MAP-FROM-YRQ-AREA. DTSIS76
00050 15 MAP-FROM-YRQ-YR-L PIC S9(04) COMP. DTSIS76
00051 15 MAP-FROM-YRQ-YR-A PIC X(01). DTSIS76
00052 15 MAP-FROM-YRQ-YR PIC X(02). DTSIS76
00053 DTSIS76
00054 15 MAP-FROM-YRQ-Q-L PIC S9(04) COMP. DTSIS76
00055 15 MAP-FROM-YRQ-Q-A PIC X(01). DTSIS76
00056 15 MAP-FROM-YRQ-Q PIC X(01). DTSIS76
00057 DTSIS76
00058 10 MAP-TO-YRQ-AREA. DTSIS76
00059 15 MAP-TO-YRQ-YR-L PIC S9(04) COMP. DTSIS76
00060 15 MAP-TO-YRQ-YR-A PIC X(01). DTSIS76
00061 15 MAP-TO-YRQ-YR PIC X(02). DTSIS76
00062 DTSIS76
00063 15 MAP-TO-YRQ-Q-L PIC S9(04) COMP. DTSIS76
00064 15 MAP-TO-YRQ-Q-A PIC X(01). DTSIS76
00065 15 MAP-TO-YRQ-Q PIC X(01). DTSIS76
00066 DTSIS76
00067 10 MAP-FORCE-PRINT-AREA. DTSIS76
00068 15 MAP-FORCE-PRINT-L PIC S9(04) COMP. DTSIS76
00069 15 MAP-FORCE-PRINT-A PIC X(01). DTSIS76
00070 15 MAP-FORCE-PRINT PIC X(01). DTSIS76
00071 88 MAP-FORCE-PRINT-NO VALUE 'N'. DTSIS76
00072 88 MAP-FORCE-PRINT-YES VALUE 'Y'. DTSIS76
00073 88 MAP-FORCE-PRINT-VALID VALUE 'Y' 'N'. DTSIS76
00074 DTSIS76
00075 10 MAP-WAIVE-EXT-DATE-AREA. DTSIS76
00076 15 MAP-WAIVE-EXT-MO-AREA. DTSIS76
00077 20 MAP-WAIVE-EXT-MO-L PIC S9(04) COMP. DTSIS76
00078 20 MAP-WAIVE-EXT-MO-A PIC X(01). DTSIS76
00079 20 MAP-WAIVE-EXT-MO PIC X(02). DTSIS76
00080 15 MAP-WAIVE-EXT-DA-AREA. DTSIS76
00081 20 MAP-WAIVE-EXT-DA-L PIC S9(04) COMP. DTSIS76
00082 20 MAP-WAIVE-EXT-DA-A PIC X(01). DTSIS76
00083 20 MAP-WAIVE-EXT-DA PIC X(02). DTSIS76
00084 15 MAP-WAIVE-EXT-YR-AREA. DTSIS76
00085 20 MAP-WAIVE-EXT-YR-L PIC S9(04) COMP. DTSIS76
00086 20 MAP-WAIVE-EXT-YR-A PIC X(01). DTSIS76
00087 20 MAP-WAIVE-EXT-YR PIC X(02). DTSIS76
00088 DTSIS76
00089 *****10 MAP-ONLINE-FROM-YRQ-AREA. DTSIS76
00090 *********15 MAP-ONLINE-FROM-YRQ-YR-L PIC S9(04) COMP. DTSIS76
00091 *********15 MAP-ONLINE-FROM-YRQ-YR-A PIC X(01). DTSIS76
00092 *********15 MAP-ONLINE-FROM-YRQ-YR PIC X(02). DTSIS76
00093 DTSIS76
00094 *********15 MAP-ONLINE-FROM-YRQ-Q-L PIC S9(04) COMP. DTSIS76
00095 *********15 MAP-ONLINE-FROM-YRQ-Q-A PIC X(01). DTSIS76
00096 *********15 MAP-ONLINE-FROM-YRQ-Q PIC X(01). DTSIS76
00097 DTSIS76
00098 *****10 MAP-ONLINE-TO-YRQ-AREA. DTSIS76
00099 *********15 MAP-ONLINE-TO-YRQ-YR-L PIC S9(04) COMP. DTSIS76
00100 *********15 MAP-ONLINE-TO-YRQ-YR-A PIC X(01). DTSIS76
00101 *********15 MAP-ONLINE-TO-YRQ-YR PIC X(02). DTSIS76
00102 DTSIS76
00103 *********15 MAP-ONLINE-TO-YRQ-Q-L PIC S9(04) COMP. DTSIS76
00104 *********15 MAP-ONLINE-TO-YRQ-Q-A PIC X(01). DTSIS76
00105 *********15 MAP-ONLINE-TO-YRQ-Q PIC X(01). DTSIS76
00106 DTSIS76
00107 *****10 MAP-ONLINE-FORCE-PRINT-AREA. DTSIS76
00108 *********15 MAP-ONLINE-FORCE-PRINT-L PIC S9(04) COMP. DTSIS76
00109 *********15 MAP-ONLINE-FORCE-PRINT-A PIC X(01). DTSIS76
00110 *********15 MAP-ONLINE-FORCE-PRINT PIC X(01). DTSIS76
00111 *************88 MAP-ONLINE-FORCE-PRINT-NO VALUE 'N'. DTSIS76
00112 *************88 MAP-ONLINE-FORCE-PRINT-YES VALUE 'Y'. DTSIS76
00113 *************88 MAP-ONLINE-FORCE-PRINT-VALID VALUE 'Y' 'N'. DTSIS76
00114 DTSIS76
00115 *****10 MAP-ONLINE-PRINTER-ID-AREA. DTSIS76
00116 *********15 MAP-ONLINE-PRINTER-ID-L PIC S9(04) COMP. DTSIS76
00117 *********15 MAP-ONLINE-PRINTER-ID-A PIC X(01). DTSIS76
00118 *********15 MAP-ONLINE-PRINTER-ID PIC X(04). DTSIS76
00119 DTSIS76
00120 10 F761133. DTSIS76
00121 15 MAP-NOTICE-OF-SUBJECT-L PIC S9(04) COMP. DTSIS76
00122 15 MAP-NOTICE-OF-SUBJECT-A PIC X(01). DTSIS76
00123 15 MAP-NOTICE-OF-SUBJECT PIC X(01). DTSIS76
00124 88 MAP-NOTICE-OF-SUBJECT-NO VALUE 'N'. DTSIS76
00125 88 MAP-NOTICE-OF-SUBJECT-YES VALUE 'Y'. DTSIS76
00126 88 MAP-NOTICE-OF-SUBJECT-VALID VALUE 'Y' 'N'. DTSIS76
00127 DTSIS76
00128 10 F761333. DTSIS76
00129 15 MAP-REQUEST-FOR-FEIN-L PIC S9(04) COMP. DTSIS76
00130 15 MAP-REQUEST-FOR-FEIN-A PIC X(01). DTSIS76
00131 15 MAP-REQUEST-FOR-FEIN PIC X(01). DTSIS76
00132 88 MAP-REQUEST-FOR-FEIN-YES VALUE 'Y'. DTSIS76
00133 88 MAP-REQUEST-FOR-FEIN-NO VALUE 'N'. DTSIS76
00134 88 MAP-REQUEST-FOR-FEIN-VALID VALUE 'Y' 'N'. DTSIS76
00135 DTSIS76
00136 10 MAP-ADDR-TYPE-AREA. DTSIS76
00137 15 MAP-ADDR-TYPE-L PIC S9(04) COMP. DTSIS76
00138 15 MAP-ADDR-TYPE-A PIC X(01). DTSIS76
00139 15 MAP-ADDR-TYPE PIC X(01). DTSIS76
00140 88 MAP-ADDR-TAX-88 VALUE 'T'. DTSIS76
00141 88 MAP-ADDR-TAX-ALT-88 VALUE 'A'. DTSIS76
00142 88 MAP-ADDR-PHY-88 VALUE 'P'. DTSIS76
00143 88 MAP-ADDR-OPO-88 VALUE 'O'. DTSIS76
00144 88 MAP-ADDR-TAD-88 VALUE 'T' 'P'. DTSIS76
00145 88 MAP-ADDR-TAA-OPO-88 VALUE 'A' 'O'. DTSIS76
00146 88 MAP-ADDR-VALID-88 VALUE 'T' 'A' 'P' 'O'. DTSIS76
00147 DTSIS76
00148 10 MAP-ADDR-ID-NO-AREA. DTSIS76
00149 15 MAP-ADDR-ID-NO-L PIC S9(04) COMP. DTSIS76
00150 15 MAP-ADDR-ID-NO-A PIC X(01). DTSIS76
00151 15 MAP-ADDR-ID-NO PIC X(03). DTSIS76
00152 15 MAP-ADDR-ID-NO-N REDEFINES MAP-ADDR-ID-NO DTSIS76
00153 PIC ZZZ. DTSIS76
00154 DTSIS76
00155 10 F761733. DTSIS76
00156 15 MAP-AR-AUDIT-TRAIL-L PIC S9(04) COMP. DTSIS76
00157 15 MAP-AR-AUDIT-TRAIL-A PIC X(01). DTSIS76
00158 15 MAP-AR-AUDIT-TRAIL PIC X(01). DTSIS76
00159 88 MAP-AR-AUDIT-TRAIL-NO VALUE 'N'. DTSIS76
00160 88 MAP-AR-AUDIT-TRAIL-YES VALUE 'Y'. DTSIS76
00161 88 MAP-AR-AUDIT-TRAIL-VALID VALUE 'Y' 'N'. DTSIS76
00162 DTSIS76
00163 10 MAP-STMT-FROM-YRQ-AREA. DTSIS76
00164 15 MAP-STMT-FROM-YRQ-YR-L PIC S9(04) COMP. DTSIS76
00165 15 MAP-STMT-FROM-YRQ-YR-A PIC X(01). DTSIS76
00166 15 MAP-STMT-FROM-YRQ-YR PIC X(02). DTSIS76
00167 DTSIS76
00168 15 MAP-STMT-FROM-YRQ-Q-L PIC S9(04) COMP. DTSIS76
00169 15 MAP-STMT-FROM-YRQ-Q-A PIC X(01). DTSIS76
00170 15 MAP-STMT-FROM-YRQ-Q PIC X(01). DTSIS76
00171 DTSIS76
00172 10 MAP-STMT-TO-YRQ-AREA. DTSIS76
00173 15 MAP-STMT-TO-YRQ-YR-L PIC S9(04) COMP. DTSIS76
00174 15 MAP-STMT-TO-YRQ-YR-A PIC X(01). DTSIS76
00175 15 MAP-STMT-TO-YRQ-YR PIC X(02). DTSIS76
00176 DTSIS76
00177 15 MAP-STMT-TO-YRQ-Q-L PIC S9(04) COMP. DTSIS76
00178 15 MAP-STMT-TO-YRQ-Q-A PIC X(01). DTSIS76
00179 15 MAP-STMT-TO-YRQ-Q PIC X(01). DTSIS76
00180 DTSIS76
00181 10 F762133. DTSIS76
00182 15 MAP-RESPONSIBLE-OP-ID-L PIC S9(04) COMP. DTSIS76
00183 15 MAP-RESPONSIBLE-OP-ID-A PIC X(01). DTSIS76
00184 15 MAP-RESPONSIBLE-OP-ID PIC X(08). DTSIS76
00185 DTSIS76
00186 10 F762141. DTSIS76
00187 15 MAP-RESPONSIBLE-OP-ID-DSCR-L PIC S9(04) COMP. DTSIS76
00188 15 MAP-RESPONSIBLE-OP-ID-DSCR-A PIC X(01). DTSIS76
00189 15 MAP-RESPONSIBLE-OP-ID-DSCR PIC X(32). DTSIS76
00190 DTSIS76
00191 10 MAP-SSN-AREA. DTSIS76
00192 15 MAP-SSN-1-AREA. DTSIS76
00193 20 MAP-SSN-1-L PIC S9(04) COMP. DTSIS76
00194 20 MAP-SSN-1-A PIC X(01). DTSIS76
00195 20 MAP-SSN-1 PIC X(03). DTSIS76
00196 15 MAP-SSN-2-AREA. DTSIS76
00197 20 MAP-SSN-2-L PIC S9(04) COMP. DTSIS76
00198 20 MAP-SSN-2-A PIC X(01). DTSIS76
00199 20 MAP-SSN-2 PIC X(02). DTSIS76
00200 15 MAP-SSN-3-AREA. DTSIS76
00201 20 MAP-SSN-3-L PIC S9(04) COMP. DTSIS76
00202 20 MAP-SSN-3-A PIC X(01). DTSIS76
00203 20 MAP-SSN-3 PIC X(04). DTSIS76
00204 DTSIS76
00205 10 MAP-WR-YRQ1-AREA. DTSIS76
00206 15 MAP-WR-YRQ1-YR-L PIC S9(04) COMP. DTSIS76
00207 15 MAP-WR-YRQ1-YR-A PIC X(01). DTSIS76
00208 15 MAP-WR-YRQ1-YR PIC X(02). DTSIS76
00209 DTSIS76
00210 15 MAP-WR-YRQ1-Q-L PIC S9(04) COMP. DTSIS76
00211 15 MAP-WR-YRQ1-Q-A PIC X(01). DTSIS76
00212 15 MAP-WR-YRQ1-Q PIC X(01). DTSIS76
00213 DTSIS76
00214 10 MAP-WR-YRQ2-AREA. DTSIS76
00215 15 MAP-WR-YRQ2-YR-L PIC S9(04) COMP. DTSIS76
00216 15 MAP-WR-YRQ2-YR-A PIC X(01). DTSIS76
00217 15 MAP-WR-YRQ2-YR PIC X(02). DTSIS76
00218 DTSIS76
00219 15 MAP-WR-YRQ2-Q-L PIC S9(04) COMP. DTSIS76
00220 15 MAP-WR-YRQ2-Q-A PIC X(01). DTSIS76
00221 15 MAP-WR-YRQ2-Q PIC X(01). DTSIS76
00222 DTSIS76
00223 10 MAP-WR-YRQ3-AREA. DTSIS76
00224 15 MAP-WR-YRQ3-YR-L PIC S9(04) COMP. DTSIS76
00225 15 MAP-WR-YRQ3-YR-A PIC X(01). DTSIS76
00226 15 MAP-WR-YRQ3-YR PIC X(02). DTSIS76
00227 DTSIS76
00228 15 MAP-WR-YRQ3-Q-L PIC S9(04) COMP. DTSIS76
00229 15 MAP-WR-YRQ3-Q-A PIC X(01). DTSIS76
00230 15 MAP-WR-YRQ3-Q PIC X(01). DTSIS76
00231 DTSIS76
00232 10 MAP-WR-YRQ4-AREA. DTSIS76
00233 15 MAP-WR-YRQ4-YR-L PIC S9(04) COMP. DTSIS76
00234 15 MAP-WR-YRQ4-YR-A PIC X(01). DTSIS76
00235 15 MAP-WR-YRQ4-YR PIC X(02). DTSIS76
00236 DTSIS76
00237 15 MAP-WR-YRQ4-Q-L PIC S9(04) COMP. DTSIS76
00238 15 MAP-WR-YRQ4-Q-A PIC X(01). DTSIS76
00239 15 MAP-WR-YRQ4-Q PIC X(01). DTSIS76
00240 DTSIS76
00241 10 F762233. DTSIS76
00242 15 MAP-CLAIMANT-NAME-L PIC S9(04) COMP. DTSIS76
00243 15 MAP-CLAIMANT-NAME-A PIC X(01). DTSIS76
00244 15 MAP-CLAIMANT-NAME PIC X(32). DTSIS76
00245 DTSIS76
00246 10 F762318. DTSIS76
00247 15 MAP-KEY-ADD-L PIC S9(04) COMP. DTSIS76
00248 15 MAP-KEY-ADD-A PIC X(01). DTSIS76
00249 15 MAP-KEY-ADD PIC X(06). DTSIS76
00250 DTSIS76
00251 10 MAP-MSG-AREA. DTSIS76
00252 15 MAP-MSG-ID-AREA. DTSIS76
00253 20 MAP-MSG-ID-L PIC S9(04) COMP. DTSIS76
00254 20 MAP-MSG-ID-A PIC X(01). DTSIS76
00255 20 MAP-MSG-ID PIC X(08). DTSIS76
00256 15 MAP-MSG-TEXT-AREA. DTSIS76
00257 20 MAP-MSG-TEXT-L PIC S9(04) COMP. DTSIS76
00258 20 MAP-MSG-TEXT-A PIC X(01). DTSIS76
00259 20 MAP-MSG-TEXT PIC X(58). DTSIS76
00260 DTSIS76
00261 10 MAP-GOTO-AREA. DTSIS76
00262 15 MAP-GOTO-L PIC S9(04) COMP. DTSIS76
00263 15 MAP-GOTO-A PIC X(01). DTSIS76
00264 15 MAP-GOTO PIC X(02). DTSIS76

View File

@ -37,9 +37,10 @@
END-IF
PERFORM APPLY-SETTING
END-IF
EXEC CICS RETURN END-EXEC.
EXEC CICS RETURN END-EXEC.
GOBACK.
FLIP-UCTRAN.
EXEC CICS INQUIRE TERMINAL(EIBTRMID) UCTRANST(UCTRANST)
END-EXEC