740 lines
58 KiB
COBOL
740 lines
58 KiB
COBOL
00001 IDENTIFICATION DIVISION. 02/13/02
|
|
00002 PROGRAM-ID. DTSCU400. DTSCU400
|
|
00003 AUTHOR. TRW. LV005
|
|
00004 DATE-WRITTEN. OCTOBER 20001. DTSCU400
|
|
00005 DATE-COMPILED. DTSCU400
|
|
00006 DTSCU4KIP3 DTSCU400
|
|
00007 ***** DTSCU400
|
|
00008 * DTSCU400
|
|
00009 * FUNCTION: FILING SCHEDULE MAINTENANCE MODULE DTSCU400
|
|
00010 * DTSCU400
|
|
00011 * DTSCU400
|
|
00012 * MODIFICATION LOG: DTSCU400
|
|
00013 * DTSCU400
|
|
00014 * 10/15/2001 INITIAL DEVELOPMENT. DTSCU400
|
|
00015 * WORK ORDER: PROGRAMMER: GD DTSCU400
|
|
00016 * DTSCU400
|
|
00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU400
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU400
|
|
00019 * WORK ORDER: PROGRAMMER: XXX DTSCU400
|
|
00020 ***** DTSCU400
|
|
00021 * DTSCU400
|
|
00022 * DESCRIPTION: DTSCU400
|
|
00023 * DTSCU400
|
|
00024 * DTSCU400 PERFORMS COMMON FUNCTIONS NEEDED TO ADD AND UPDATE DTSCU400
|
|
00025 * MFSC RECORDS. DTSCU400
|
|
00026 * DTSCU400
|
|
00027 * DTSCU400
|
|
00028 ***** DTSCU400
|
|
00029 SKIP3 DTSCU400
|
|
00030 ENVIRONMENT DIVISION. DTSCU400
|
|
00031 SKIP3 DTSCU400
|
|
00032 DATA DIVISION. DTSCU400
|
|
00033 SKIP3 DTSCU400
|
|
00034 WORKING-STORAGE SECTION. DTSCU400
|
|
000345 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU400 02/13/02'. DTSCU400
|
|
00035 SKIP3 DTSCU400
|
|
00036 01 WRK-AREA. DTSCU400
|
|
00037 05 WRK-ABEND-CODE PIC X(04) VALUE 'U400'. DTSCU400
|
|
00038 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU400
|
|
00039 DTSCU400
|
|
00040 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSCU400
|
|
00041 VALUE +0. DTSCU400
|
|
00042 05 WRK-ABS-QTR PIC S9(04) COMP. DTSCU400
|
|
00043 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSCU400
|
|
00044 05 WRK-PRIOR-START-YRQ PIC S9(05) COMP-3. DTSCU400
|
|
00045 05 WRK-PRIOR-MFSC-KEY PIC X(16). DTSCU400
|
|
00046 05 WRK-NEXT-START-YRQ PIC S9(05) COMP-3. DTSCU400
|
|
00047 DTSCU400
|
|
00048 05 WRK-PENDING-MFSC-KEY PIC X(16). DTSCU400
|
|
00049 DTSCU400
|
|
00050 05 WRK-OPEN-CNT PIC S9(04) COMP DTSCU400
|
|
00051 VALUE +0. DTSCU400
|
|
00052 05 WRK-ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCU400
|
|
00053 VALUE +99999. DTSCU400
|
|
00054 DTSCU400
|
|
00055 05 WRK-RETURN-AREA. DTSCU400
|
|
00056 10 WRK-PRIOR-STATE-IND PIC X(01). DTSCU400
|
|
00057 88 WRK-PENDING-MFSC-88 VALUE '1'. DTSCU400
|
|
00058 88 WRK-ORIG-DETERM-88 VALUE '2'. DTSCU400
|
|
00059 88 WRK-REDETERM-88 VALUE '3'. DTSCU400
|
|
00060 10 WRK-NOTICE-SENT-IND PIC X(01). DTSCU400
|
|
00061 88 WRK-NOTICE-SENT-YES-88 VALUE 'Y'. DTSCU400
|
|
00062 88 WRK-NOTICE-SENT-NO-88 VALUE 'N'. DTSCU400
|
|
00063 DTSCU400
|
|
00064 05 WRK-T001-RPT-TYPE PIC X(02). DTSCU400
|
|
00065 88 WRK-POT-HOUSEHOLD-88 VALUE '01'. DTSCU400
|
|
00066 88 WRK-ADMIN-REACT-88 VALUE '21'. DTSCU400
|
|
00067 DTSCU400
|
|
00068 05 WRK-R907-MSG-TABLE. DTSCU400
|
|
00069 10 WRK-R907-MSG1. DTSCU400
|
|
00070 15 WRK-R907-MSG1-ID PIC X(11) DTSCU400
|
|
00071 VALUE 'DTSCU400401'. DTSCU400
|
|
00072 15 WRK-R907-MSG1-SHORT-TEXT PIC X(20) DTSCU400
|
|
00073 VALUE 'MFSC ALREADY EXISTS'. DTSCU400
|
|
00074 15 WRK-R907-MSG1-LONG-TEXT. DTSCU400
|
|
00075 20 FILLER PIC X(30) DTSCU400
|
|
00076 VALUE 'MFSC ALREADY EXISTS - USING EX'. DTSCU400
|
|
00077 20 FILLER PIC X(30) DTSCU400
|
|
00078 VALUE 'ISTING RECORD '. DTSCU400
|
|
00079 10 WRK-R907-MSG2. DTSCU400
|
|
00080 15 WRK-R907-MSG2-ID PIC X(11) DTSCU400
|
|
00081 VALUE 'DTSCU400402'. DTSCU400
|
|
00082 15 WRK-R907-MSG2-SHORT-TEXT PIC X(20) DTSCU400
|
|
00083 VALUE 'MFSC ALREADY EXISTS'. DTSCU400
|
|
00084 15 WRK-R907-MSG2-LONG-TEXT. DTSCU400
|
|
00085 20 FILLER PIC X(30) DTSCU400
|
|
00086 VALUE 'MFSC EXISTS - REPLACING FILING'. DTSCU400
|
|
00087 20 FILLER PIC X(30) DTSCU400
|
|
00088 VALUE ' SCHEDULE '. DTSCU400
|
|
00089 10 WRK-R907-MSG3. DTSCU400
|
|
00090 15 WRK-R907-MSG3-ID PIC X(11) DTSCU400
|
|
00091 VALUE 'DTSCU400403'. DTSCU400
|
|
00092 15 WRK-R907-MSG3-SHORT-TEXT PIC X(20) DTSCU400
|
|
00093 VALUE 'MFSC FILE ERROR '. DTSCU400
|
|
00094 15 WRK-R907-MSG3-LONG-TEXT. DTSCU400
|
|
00095 20 FILLER PIC X(30) DTSCU400
|
|
00096 VALUE 'PRIOR MFSC NOT FOUND - NO RECO'. DTSCU400
|
|
00097 20 FILLER PIC X(30) DTSCU400
|
|
00098 VALUE 'RD ADDED '. DTSCU400
|
|
00099 DTSCU400
|
|
00100 01 L810-COMM-AREA. DTSCU400
|
|
00101 05 L810-CONTROL-BLOCK. DTSCU400
|
|
00102 ++INCLUDE DTSIL810 DTSCU400
|
|
00103 05 MSKL-REC. DTSCU400
|
|
00104 ++INCLUDE DTSIMSKL DTSCU400
|
|
00105 EJECT DTSCU400
|
|
00106 01 MFSC-REC. DTSCU400
|
|
00107 ++INCLUDE DTSIMFSC DTSCU400
|
|
00108 EJECT DTSCU400
|
|
00109 01 L004-COMM-AREA. DTSCU400
|
|
00110 ++INCLUDE DTSIL004 DTSCU400
|
|
00111 EJECT DTSCU400
|
|
00112 01 L005-COMM-AREA. DTSCU400
|
|
00113 ++INCLUDE DTSIL005 DTSCU400
|
|
00114 EJECT DTSCU400
|
|
00115 01 L825-COMM-AREA. DTSCU400
|
|
00116 05 L825-CONTROL-BLOCK. DTSCU400
|
|
00117 ++INCLUDE DTSIL825 DTSCU400
|
|
00118 05 RSKL-REC. DTSCU400
|
|
00119 ++INCLUDE DTSIRSK1 DTSCU400
|
|
00120 EJECT DTSCU400
|
|
00121 01 T001-REC. DTSCU400
|
|
00122 ++INCLUDE DTSIT001 DTSCU400
|
|
00123 EJECT DTSCU400
|
|
00124 01 R907-REC. DTSCU400
|
|
00125 ++INCLUDE DTSIR907 DTSCU400
|
|
00126 EJECT DTSCU400
|
|
00127 LINKAGE SECTION. DTSCU400
|
|
00128 SKIP3 DTSCU400
|
|
00129 01 DFHCOMMAREA. DTSCU400
|
|
00130 ++INCLUDE DTSIL400 DTSCU400
|
|
00131 EJECT DTSCU400
|
|
00132 01 MPRF-REC. DTSCU400
|
|
00133 ++INCLUDE DTSIMPRF DTSCU400
|
|
00134 EJECT DTSCU400
|
|
00135 PROCEDURE DIVISION. DTSCU400
|
|
00136 SKIP2 DTSCU400
|
|
00137 DTSCU400-MAINLINE. DTSCU400
|
|
00138 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSCU400
|
|
00139 DTSCU400
|
|
00140 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU400
|
|
00141 DTSCU400
|
|
00142 DTSCU400-MAINLINE-EXIT. DTSCU400
|
|
00143 EXEC CICS DTSCU400
|
|
00144 RETURN DTSCU400
|
|
00145 END-EXEC. DTSCU400
|
|
00146 DTSCU400
|
|
00147 EJECT DTSCU400
|
|
00148 I0000-INITIALIZE. DTSCU400
|
|
00149 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSCU400
|
|
00150 PERFORM I2000-INIT-RETURN THRU I2000-EXIT. DTSCU400
|
|
00151 PERFORM I3000-INIT-WS THRU I3000-EXIT. DTSCU400
|
|
00152 DTSCU400
|
|
00153 I0000-EXIT. DTSCU400
|
|
00154 EXIT. DTSCU400
|
|
00155 I1000-EDIT-INPUT. DTSCU400
|
|
00156 IF L400-EMP-NO NOT NUMERIC DTSCU400
|
|
00157 PERFORM S899-ABEND THRU S899-EXIT DTSCU400
|
|
00158 ELSE DTSCU400
|
|
00159 MOVE L400-EMP-NO TO WRK-EMP-NO. DTSCU400
|
|
00160 DTSCU400
|
|
00161 IF L400-ADD-PENDING-1A-88 DTSCU400
|
|
00162 OR L400-LIAB-DETERM-88 DTSCU400
|
|
00163 PERFORM I1100-ADD-UPD THRU I1100-EXIT. DTSCU400
|
|
00164 DTSCU400
|
|
00165 I1000-EXIT. DTSCU400
|
|
00166 EXIT. DTSCU400
|
|
00167 DTSCU400
|
|
00168 I1100-ADD-UPD. DTSCU400
|
|
00169 IF L400-FIRST-LIAB-YRQ NOT NUMERIC DTSCU400
|
|
00170 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400
|
|
00171 DTSCU400
|
|
00172 IF L400-CURR-RUN-DATE NOT > ZERO DTSCU400
|
|
00173 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400
|
|
00174 DTSCU400
|
|
00175 I1100-EXIT. DTSCU400
|
|
00176 EXIT. DTSCU400
|
|
00177 DTSCU400
|
|
00178 I2000-INIT-RETURN. DTSCU400
|
|
00179 MOVE SPACES TO L400-PRIOR-STATE-IND. DTSCU400
|
|
00180 DTSCU400
|
|
00181 I2000-EXIT. DTSCU400
|
|
00182 EXIT. DTSCU400
|
|
00183 DTSCU400
|
|
00184 I3000-INIT-WS. DTSCU400
|
|
00185 SET L005-FROM-SYS TO TRUE. DTSCU400
|
|
00186 PERFORM S005-ABSTIME THRU S005-EXIT. DTSCU400
|
|
00187 DTSCU400
|
|
00188 MOVE ZERO TO WRK-ABS-QTR DTSCU400
|
|
00189 WRK-START-YRQ DTSCU400
|
|
00190 WRK-PRIOR-START-YRQ DTSCU400
|
|
00191 WRK-OPEN-CNT. DTSCU400
|
|
00192 MOVE LOW-VALUES TO WRK-PENDING-MFSC-KEY DTSCU400
|
|
00193 WRK-PRIOR-MFSC-KEY. DTSCU400
|
|
00194 DTSCU400
|
|
00195 MOVE WRK-ALL-NINES-YRQ TO WRK-NEXT-START-YRQ. DTSCU400
|
|
00196 MOVE SPACES TO WRK-PRIOR-STATE-IND DTSCU400
|
|
00197 WRK-T001-RPT-TYPE. DTSCU400
|
|
00198 SET WRK-NOTICE-SENT-NO-88 TO TRUE. DTSCU400
|
|
00199 DTSCU400
|
|
00200 I3000-EXIT. DTSCU400
|
|
00201 EXIT. DTSCU400
|
|
00202 DTSCU400
|
|
00203 P0000-PROCESS. DTSCU400
|
|
00204 IF L400-FIND-PRIOR-88 DTSCU400
|
|
00205 OR L400-NOT-LIAB-DETERM-88 DTSCU400
|
|
00206 NEXT SENTENCE DTSCU400
|
|
00207 ELSE DTSCU400
|
|
00208 PERFORM S1000-START-YRQ THRU S1000-EXIT. DTSCU400
|
|
00209 DTSCU400
|
|
00210 PERFORM P1000-FIND-PRIOR THRU P1000-EXIT. DTSCU400
|
|
00211 DTSCU400
|
|
00212 IF L400-FIND-PRIOR-88 DTSCU400
|
|
00213 GO TO P0000-EXIT. DTSCU400
|
|
00214 DTSCU400
|
|
00215 IF L400-ADD-PENDING-1A-88 DTSCU400
|
|
00216 OR L400-DETERM-PENDING-88 DTSCU400
|
|
00217 PERFORM P2000-ADD-MFSC-T001 THRU P2000-EXIT DTSCU400
|
|
00218 ELSE DTSCU400
|
|
00219 IF L400-LIAB-DETERM-88 DTSCU400
|
|
00220 PERFORM P0100-LIAB-DETERM THRU P0100-EXIT DTSCU400
|
|
00221 ELSE DTSCU400
|
|
00222 IF L400-NOT-LIAB-DETERM-88 DTSCU400
|
|
00223 PERFORM P3000-UPDATE-MFSC THRU P3000-EXIT DTSCU400
|
|
00224 ELSE DTSCU400
|
|
00225 IF L400-ORG-TYPE-CHANGE-88 DTSCU400
|
|
00226 PERFORM P5000-ORG-TYPE-CHNG THRU P5000-EXIT. DTSCU400
|
|
00227 DTSCU400
|
|
00228 P0000-EXIT. DTSCU400
|
|
00229 EXIT. DTSCU400
|
|
00230 DTSCU400
|
|
00231 P0100-LIAB-DETERM. DTSCU400
|
|
00232 IF WRK-ORIG-DETERM-88 DTSCU400
|
|
00233 PERFORM P2000-ADD-MFSC-T001 THRU P2000-EXIT DTSCU400
|
|
00234 ELSE DTSCU400
|
|
00235 IF WRK-PENDING-MFSC-88 DTSCU400
|
|
00236 PERFORM P3000-UPDATE-MFSC THRU P3000-EXIT DTSCU400
|
|
00237 *& ELSE DTSCU400
|
|
00238 *& PERFORM P4000-REACTIVATE THRU P4000-EXIT DTSCU400
|
|
00239 END-IF DTSCU400
|
|
00240 END-IF. DTSCU400
|
|
00241 DTSCU400
|
|
00242 P0100-EXIT. DTSCU400
|
|
00243 EXIT. DTSCU400
|
|
00244 DTSCU400
|
|
00245 P1000-FIND-PRIOR. DTSCU400
|
|
00246 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCU400
|
|
00247 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCU400
|
|
00248 SET MFSC-FSC-88 TO TRUE. DTSCU400
|
|
00249 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCU400
|
|
00250 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCU400
|
|
00251 IF L810-NO-REC-88 DTSCU400
|
|
00252 SET WRK-ORIG-DETERM-88 TO TRUE DTSCU400
|
|
00253 ELSE DTSCU400
|
|
00254 MOVE ZERO TO WRK-OPEN-CNT DTSCU400
|
|
00255 PERFORM P1100-SCAN-MFSC THRU P1100-EXIT DTSCU400
|
|
00256 UNTIL L810-NO-REC-88 DTSCU400
|
|
00257 OR WRK-PENDING-MFSC-88. DTSCU400
|
|
00258 DTSCU400
|
|
00259 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCU400
|
|
00260 DTSCU400
|
|
00261 IF WRK-PENDING-MFSC-88 DTSCU400
|
|
00262 OR WRK-ORIG-DETERM-88 DTSCU400
|
|
00263 NEXT SENTENCE DTSCU400
|
|
00264 ELSE DTSCU400
|
|
00265 IF WRK-OPEN-CNT = ZERO DTSCU400
|
|
00266 SET WRK-ORIG-DETERM-88 TO TRUE DTSCU400
|
|
00267 ELSE DTSCU400
|
|
00268 SET WRK-REDETERM-88 TO TRUE DTSCU400
|
|
00269 END-IF DTSCU400
|
|
00270 END-IF. DTSCU400
|
|
00271 DTSCU400
|
|
00272 MOVE WRK-PRIOR-STATE-IND TO L400-PRIOR-STATE-IND. DTSCU400
|
|
00273 MOVE WRK-NOTICE-SENT-IND TO L400-NOTICE-SENT-IND. DTSCU400
|
|
00274 DTSCU400
|
|
00275 P1000-EXIT. DTSCU400
|
|
00276 EXIT. DTSCU400
|
|
00277 DTSCU400
|
|
00278 P1100-SCAN-MFSC. DTSCU400
|
|
00279 MOVE MSKL-REC TO MFSC-REC. DTSCU400
|
|
00280 DTSCU400
|
|
00281 IF MFSC-STATUS-PENDING-88 DTSCU400
|
|
00282 PERFORM P1110-PENDING THRU P1110-EXIT DTSCU400
|
|
00283 GO TO P1100-EXIT DTSCU400
|
|
00284 ELSE DTSCU400
|
|
00285 IF MFSC-STATUS-OPEN-88 DTSCU400
|
|
00286 ADD +1 TO WRK-OPEN-CNT DTSCU400
|
|
00287 IF MFSC-START-YRQ <= WRK-START-YRQ DTSCU400
|
|
00288 IF MFSC-START-YRQ > WRK-PRIOR-START-YRQ DTSCU400
|
|
00289 MOVE MFSC-START-YRQ TO WRK-PRIOR-START-YRQ DTSCU400
|
|
00290 MOVE MFSC-KEY-AREA TO WRK-PRIOR-MFSC-KEY DTSCU400
|
|
00291 END-IF DTSCU400
|
|
00292 ELSE DTSCU400
|
|
00293 IF MFSC-START-YRQ < WRK-NEXT-START-YRQ DTSCU400
|
|
00294 MOVE MFSC-START-YRQ TO WRK-NEXT-START-YRQ DTSCU400
|
|
00295 END-IF DTSCU400
|
|
00296 END-IF DTSCU400
|
|
00297 END-IF DTSCU400
|
|
00298 END-IF. DTSCU400
|
|
00299 DTSCU400
|
|
00300 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCU400
|
|
00301 DTSCU400
|
|
00302 P1100-EXIT. DTSCU400
|
|
00303 EXIT. DTSCU400
|
|
00304 DTSCU400
|
|
00305 P1110-PENDING. DTSCU400
|
|
00306 MOVE MSKL-KEY-AREA TO WRK-PENDING-MFSC-KEY. DTSCU400
|
|
00307 DTSCU400
|
|
00308 IF MFSC-INITIAL-MAIL-DATE > ZERO DTSCU400
|
|
00309 SET WRK-NOTICE-SENT-YES-88 TO TRUE DTSCU400
|
|
00310 END-IF. DTSCU400
|
|
00311 DTSCU400
|
|
00312 IF MFSC-STATUS-PENDING-88 DTSCU400
|
|
00313 SET WRK-PENDING-MFSC-88 TO TRUE. DTSCU400
|
|
00314 DTSCU400
|
|
00315 P1110-EXIT. DTSCU400
|
|
00316 EXIT. DTSCU400
|
|
00317 DTSCU400
|
|
00318 ************************************************************** DTSCU400
|
|
00319 * THIS PARAGRAPH EXECUTES IN THREE SITUATIONS: DTSCU400
|
|
00320 * 1. WHEN DTSCU400 IS CALLED FROM SCREEN 1A TO ADD A DTSCU400
|
|
00321 * PENDING MFSC AND T001 REPORT TRANSACTION. DTSCU400
|
|
00322 * 2. WHEN DTSCU400 IS CALLED FROM SCREEN 1A TO ADD A DTSCU400
|
|
00323 * T001 REPORT TRANSACTION ONLY. DTSCU400
|
|
00324 * 3. WHEN DTSCU400 IS CALLED FROM SCREEN 1C AND THIS DTSCU400
|
|
00325 * IS AN ORIGINAL DETERMINATION. DTSCU400
|
|
00326 * DTSCU400
|
|
00327 * IF THIS IS AN ORIGINAL DETERMINATION, ONLY ADD AN DTSCU400
|
|
00328 * MFSC IF THE ORGANIZATION TYPE IS 'HOUSEHOLD.' DTSCU400
|
|
00329 * DTSCU400
|
|
00330 * WHEN CALLED FROM SCREEN 1A, IF THERE IS ALREADY A PENDING DTSCU400
|
|
00331 * MFSC ON FILE AND THE INITIAL NOTICE DATE = ZERO, THIS IS DTSCU400
|
|
00332 * A REQUEST TO PRINT THE NOTICES ONLY. DTSCU400
|
|
00333 * DTSCU400
|
|
00334 * ADD A PENDING MFSC UNLESS THE EMPLOYER HAS BEEN DTSCU400
|
|
00335 * DETERMINED LIABLE AND INACTIVATED AT THE SAME TIME. DTSCU400
|
|
00336 * IN THIS CASE, ADD A QUARTERLY MFSC AND DO NOT PRINT DTSCU400
|
|
00337 * ANY NOTICES. DTSCU400
|
|
00338 ************************************************************** DTSCU400
|
|
00339 P2000-ADD-MFSC-T001. DTSCU400
|
|
00340 IF L400-ADD-PENDING-1A-88 DTSCU400
|
|
00341 OR L400-DETERM-PENDING-88 DTSCU400
|
|
00342 IF WRK-ORIG-DETERM-88 DTSCU400
|
|
00343 PERFORM P2100-BUILD-MFSC THRU P2100-EXIT DTSCU400
|
|
00344 ELSE DTSCU400
|
|
00345 IF WRK-PENDING-MFSC-88 DTSCU400
|
|
00346 AND WRK-NOTICE-SENT-NO-88 DTSCU400
|
|
00347 PERFORM P2200-NOTICE-ONLY THRU P2200-EXIT DTSCU400
|
|
00348 END-IF DTSCU400
|
|
00349 END-IF DTSCU400
|
|
00350 ELSE DTSCU400
|
|
00351 IF L400-ORG-HOUSEHOLD-88 DTSCU400
|
|
00352 PERFORM P2100-BUILD-MFSC THRU P2100-EXIT. DTSCU400
|
|
00353 DTSCU400
|
|
00354 P2000-EXIT. DTSCU400
|
|
00355 EXIT. DTSCU400
|
|
00356 DTSCU400
|
|
00357 P2100-BUILD-MFSC. DTSCU400
|
|
00358 DTSCU400
|
|
00359 PERFORM S2000-INIT-MFSC THRU S2000-EXIT. DTSCU400
|
|
00360 DTSCU400
|
|
00361 IF L400-ADD-PENDING-1A-88 DTSCU400
|
|
00362 OR L400-DETERM-PENDING-88 DTSCU400
|
|
00363 SET MFSC-STATUS-PENDING-88 DTSCU400
|
|
00364 TO TRUE DTSCU400
|
|
00365 MOVE SPACES TO MFSC-FILING-SCHEDULE-CD DTSCU400
|
|
00366 ELSE DTSCU400
|
|
00367 SET MFSC-STATUS-OPEN-88 TO TRUE DTSCU400
|
|
00368 MOVE L400-FILING-SCHED TO MFSC-FILING-SCHEDULE-CD. DTSCU400
|
|
00369 DTSCU400
|
|
00370 IF MFSC-STATUS-OPEN-88 DTSCU400
|
|
00371 AND WRK-PRIOR-MFSC-KEY NOT = LOW-VALUES DTSCU400
|
|
00372 PERFORM P2110-CHK-DUPLICATE THRU P2110-EXIT DTSCU400
|
|
00373 ELSE DTSCU400
|
|
00374 MOVE MFSC-REC TO MSKL-REC DTSCU400
|
|
00375 PERFORM S810-WRITE THRU S810-EXIT. DTSCU400
|
|
00376 DTSCU400
|
|
00377 IF L400-ADD-PENDING-1A-88 DTSCU400
|
|
00378 OR L400-DETERM-PENDING-88 DTSCU400
|
|
00379 SET WRK-POT-HOUSEHOLD-88 TO TRUE DTSCU400
|
|
00380 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCU400
|
|
00381 DTSCU400
|
|
00382 P2100-EXIT. DTSCU400
|
|
00383 EXIT. DTSCU400
|
|
00384 DTSCU400
|
|
00385 ************************************************************* DTSCU400
|
|
00386 * IF THERE IS AN MFSC RECORD ALREADY ON FILE WITH THE SAME DTSCU400
|
|
00387 * START YRQ: DTSCU400
|
|
00388 * IF THE FILING SCHEDULES ARE THE SAME, LEAVE THE DTSCU400
|
|
00389 * EXISTING MFSC UNCHANGED AND WRITE AN R907 RECORD. DTSCU400
|
|
00390 * IF THE FILING SCHEDULES ARE DIFFERENT, CHANGE THE DTSCU400
|
|
00391 * FILING SCHEDULE ON THE EXISTING MFSC, REWRITE IT AND DTSCU400
|
|
00392 * WRITE AN R907 RECORD. DTSCU400
|
|
00393 * IF THERE IS NO PREVIOUS MFSC, ADD THE NEW RECORD. DTSCU400
|
|
00394 ************************************************************* DTSCU400
|
|
00395 P2110-CHK-DUPLICATE. DTSCU400
|
|
00396 MOVE WRK-PRIOR-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400
|
|
00397 PERFORM S810-READ THRU S810-EXIT DTSCU400
|
|
00398 IF L810-OK-88 DTSCU400
|
|
00399 MOVE MSKL-REC TO MFSC-REC DTSCU400
|
|
00400 IF MFSC-FILING-SCHEDULE-CD = L400-FILING-SCHED DTSCU400
|
|
00401 PERFORM P2111-ERR-MSG1 THRU P2111-EXIT DTSCU400
|
|
00402 ELSE DTSCU400
|
|
00403 MOVE L400-FILING-SCHED TO MFSC-FILING-SCHEDULE-CD DTSCU400
|
|
00404 PERFORM S810-REWRITE THRU S810-EXIT DTSCU400
|
|
00405 PERFORM P2112-ERR-MSG2 THRU P2112-EXIT DTSCU400
|
|
00406 END-IF DTSCU400
|
|
00407 ELSE DTSCU400
|
|
00408 MOVE MFSC-REC TO MSKL-REC DTSCU400
|
|
00409 PERFORM S810-WRITE THRU S810-EXIT DTSCU400
|
|
00410 END-IF. DTSCU400
|
|
00411 DTSCU400
|
|
00412 P2110-EXIT. DTSCU400
|
|
00413 EXIT. DTSCU400
|
|
00414 DTSCU400
|
|
00415 P2111-ERR-MSG1. DTSCU400
|
|
00416 MOVE '401' TO R907-MSG-ID. DTSCU400
|
|
00417 MOVE WRK-R907-MSG1-LONG-TEXT TO R907-MSG-TEXT. DTSCU400
|
|
00418 PERFORM S825-WRITE-R907 THRU S825-EXIT. DTSCU400
|
|
00419 DTSCU400
|
|
00420 P2111-EXIT. DTSCU400
|
|
00421 EXIT. DTSCU400
|
|
00422 DTSCU400
|
|
00423 P2112-ERR-MSG2. DTSCU400
|
|
00424 MOVE '402' TO R907-MSG-ID. DTSCU400
|
|
00425 MOVE WRK-R907-MSG2-LONG-TEXT TO R907-MSG-TEXT. DTSCU400
|
|
00426 PERFORM S825-WRITE-R907 THRU S825-EXIT. DTSCU400
|
|
00427 DTSCU400
|
|
00428 P2112-EXIT. DTSCU400
|
|
00429 EXIT. DTSCU400
|
|
00430 DTSCU400
|
|
00431 P2200-NOTICE-ONLY. DTSCU400
|
|
00432 MOVE ZERO TO WRK-START-YRQ. DTSCU400
|
|
00433 SET WRK-POT-HOUSEHOLD-88 TO TRUE DTSCU400
|
|
00434 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCU400
|
|
00435 DTSCU400
|
|
00436 P2200-EXIT. DTSCU400
|
|
00437 EXIT. DTSCU400
|
|
00438 DTSCU400
|
|
00439 DTSCU400
|
|
00440 ************************************************************* DTSCU400
|
|
00441 * THIS PARAGRAPH UPDATES AN MFSC CREATED FROM SCREEN 1A DTSCU400
|
|
00442 * ONCE THE LIABILITY DATE IS KNOWN. SINCE THE KEY CHANGES DTSCU400
|
|
00443 * WHEN MFSC-ABS-QTR IS UPDATED, THE RECORD MUST FIRST BE DTSCU400
|
|
00444 * DELETED. THE ORIGINAL DATA REMAINS IN WORKING-STORAGE IN DTSCU400
|
|
00445 * THE MFSC-REC AREA. THE PARAGRAPH UPDATES THIS DATA AND DTSCU400
|
|
00446 * WRITES THE NEW RECORD. DTSCU400
|
|
00447 ************************************************************* DTSCU400
|
|
00448 P3000-UPDATE-MFSC. DTSCU400
|
|
00449 IF WRK-PENDING-MFSC-88 DTSCU400
|
|
00450 NEXT SENTENCE DTSCU400
|
|
00451 ELSE DTSCU400
|
|
00452 GO TO P3000-EXIT. DTSCU400
|
|
00453 DTSCU400
|
|
00454 IF NOT L400-ORG-HOUSEHOLD-88 DTSCU400
|
|
00455 OR L400-NOT-LIAB-DETERM-88 DTSCU400
|
|
00456 PERFORM P3100-WITHDRAW THRU P3100-EXIT DTSCU400
|
|
00457 ELSE DTSCU400
|
|
00458 PERFORM P3200-UPDATE THRU P3200-EXIT. DTSCU400
|
|
00459 DTSCU400
|
|
00460 P3000-EXIT. DTSCU400
|
|
00461 EXIT. DTSCU400
|
|
00462 DTSCU400
|
|
00463 P3100-WITHDRAW. DTSCU400
|
|
00464 MOVE WRK-PENDING-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400
|
|
00465 PERFORM S810-READ THRU S810-EXIT. DTSCU400
|
|
00466 MOVE MSKL-REC TO MFSC-REC. DTSCU400
|
|
00467 DTSCU400
|
|
00468 SET MFSC-STATUS-WITHDRAWN-88 TO TRUE. DTSCU400
|
|
00469 MOVE L400-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCU400
|
|
00470 SET MFSC-CHNG-SYSTEM-88 TO TRUE. DTSCU400
|
|
00471 DTSCU400
|
|
00472 MOVE MFSC-REC TO MSKL-REC. DTSCU400
|
|
00473 PERFORM S810-REWRITE THRU S810-EXIT. DTSCU400
|
|
00474 DTSCU400
|
|
00475 P3100-EXIT. DTSCU400
|
|
00476 EXIT. DTSCU400
|
|
00477 DTSCU400
|
|
00478 P3200-UPDATE. DTSCU400
|
|
00479 MOVE WRK-PENDING-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400
|
|
00480 PERFORM S810-READ THRU S810-EXIT. DTSCU400
|
|
00481 MOVE MSKL-REC TO MFSC-REC. DTSCU400
|
|
00482 DTSCU400
|
|
00483 PERFORM S810-DELETE THRU S810-EXIT. DTSCU400
|
|
00484 DTSCU400
|
|
00485 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCU400
|
|
00486 MOVE WRK-START-YRQ TO MFSC-START-YRQ. DTSCU400
|
|
00487 DTSCU400
|
|
00488 SET MFSC-STATUS-OPEN-88 TO TRUE. DTSCU400
|
|
00489 MOVE L400-FILING-SCHED TO MFSC-FILING-SCHEDULE-CD. DTSCU400
|
|
00490 DTSCU400
|
|
00491 MOVE L400-OP-ID TO MFSC-CHNG-OP-ID. DTSCU400
|
|
00492 MOVE L400-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCU400
|
|
00493 DTSCU400
|
|
00494 MOVE MFSC-REC TO MSKL-REC. DTSCU400
|
|
00495 PERFORM S810-WRITE THRU S810-EXIT. DTSCU400
|
|
00496 DTSCU400
|
|
00497 P3200-EXIT. DTSCU400
|
|
00498 EXIT. DTSCU400
|
|
00499 DTSCU400
|
|
00500 *P4000-REACTIVATE. DTSCU400
|
|
00501 * IF L400-DELINQUENT-YES-88 DTSCU400
|
|
00502 * IF MFSC-FILING-SCHED-ANN-88 DTSCU400
|
|
00503 * PERFORM P4100-TERMINATE-CURR-MFSC THRU P4100-EXIT DTSCU400
|
|
00504 * PERFORM P4200-ADD-QTRLY THRU P4200-EXIT DTSCU400
|
|
00505 * SET WRK-ADMIN-REACT-88 TO TRUE DTSCU400
|
|
00506 * PERFORM S825-WRITE-T001 THRU S825-EXIT DTSCU400
|
|
00507 * END-IF DTSCU400
|
|
00508 * END-IF. DTSCU400
|
|
00509 * DTSCU400
|
|
00510 *P4000-EXIT. DTSCU400
|
|
00511 * EXIT. DTSCU400
|
|
00512 * DTSCU400
|
|
00513 *P4100-TERMINATE-CURR-MFSC. DTSCU400
|
|
00514 * MOVE WRK-PRIOR-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400
|
|
00515 * PERFORM S810-READ THRU S810-EXIT. DTSCU400
|
|
00516 * MOVE MSKL-REC TO MFSC-REC. DTSCU400
|
|
00517 * DTSCU400
|
|
00518 * MOVE WRK-ABS-QTR TO L004-ABS-QTR. DTSCU400
|
|
00519 * SUBTRACT +1 FROM L004-ABS-QTR. DTSCU400
|
|
00520 * PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCU400
|
|
00521 * MOVE L004-QTR-5-9 TO MFSC-END-YRQ. DTSCU400
|
|
00522 * DTSCU400
|
|
00523 * MOVE L400-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCU400
|
|
00524 * SET MFSC-CHNG-SYSTEM-88 TO TRUE. DTSCU400
|
|
00525 * MOVE MFSC-REC TO MSKL-REC. DTSCU400
|
|
00526 * DTSCU400
|
|
00527 * PERFORM S810-REWRITE THRU S810-EXIT. DTSCU400
|
|
00528 * DTSCU400
|
|
00529 *P4100-EXIT. DTSCU400
|
|
00530 * EXIT. DTSCU400
|
|
00531 * DTSCU400
|
|
00532 *P4200-ADD-QTRLY. DTSCU400
|
|
00533 * PERFORM S2000-INIT-MFSC THRU S2000-EXIT. DTSCU400
|
|
00534 * DTSCU400
|
|
00535 * SET MFSC-STATUS-OPEN-88 TO TRUE. DTSCU400
|
|
00536 * DTSCU400
|
|
00537 * SET MFSC-FILING-SCHED-QTR-88 TO TRUE. DTSCU400
|
|
00538 * DTSCU400
|
|
00539 * SET MFSC-REQ-ADMIN-88 TO TRUE. DTSCU400
|
|
00540 * DTSCU400
|
|
00541 * MOVE MFSC-REC TO MSKL-REC. DTSCU400
|
|
00542 * PERFORM S810-WRITE THRU S810-EXIT. DTSCU400
|
|
00543 * DTSCU400
|
|
00544 *P4200-EXIT. DTSCU400
|
|
00545 * EXIT. DTSCU400
|
|
00546 DTSCU400
|
|
00547 P5000-ORG-TYPE-CHNG. DTSCU400
|
|
00548 PERFORM S2000-INIT-MFSC THRU S2000-EXIT. DTSCU400
|
|
00549 DTSCU400
|
|
00550 SET MFSC-STATUS-OPEN-88 TO TRUE DTSCU400
|
|
00551 SET MFSC-FILING-SCHED-QTR-88 TO TRUE. DTSCU400
|
|
00552 SET MFSC-REQ-ORG-TYPE-88 TO TRUE. DTSCU400
|
|
00553 DTSCU400
|
|
00554 MOVE MFSC-REC TO MSKL-REC. DTSCU400
|
|
00555 PERFORM S810-WRITE THRU S810-EXIT. DTSCU400
|
|
00556 DTSCU400
|
|
00557 SET WRK-POT-HOUSEHOLD-88 TO TRUE. DTSCU400
|
|
00558 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCU400
|
|
00559 DTSCU400
|
|
00560 P5000-EXIT. DTSCU400
|
|
00561 EXIT. DTSCU400
|
|
00562 DTSCU400
|
|
00563 S004-FROM-5. DTSCU400
|
|
00564 SET L004-FROM-5 TO TRUE. DTSCU400
|
|
00565 GO TO S004-LINK. DTSCU400
|
|
00566 DTSCU400
|
|
00567 S004-FROM-ABS. DTSCU400
|
|
00568 SET L004-FROM-ABS TO TRUE. DTSCU400
|
|
00569 GO TO S004-LINK. DTSCU400
|
|
00570 DTSCU400
|
|
00571 S004-LINK. DTSCU400
|
|
00572 EXEC CICS LINK DTSCU400
|
|
00573 PROGRAM('DTSCU004') DTSCU400
|
|
00574 COMMAREA(L004-COMM-AREA) DTSCU400
|
|
00575 END-EXEC. DTSCU400
|
|
00576 S004-EXIT. DTSCU400
|
|
00577 EXIT. DTSCU400
|
|
00578 DTSCU400
|
|
00579 S005-ABSTIME. DTSCU400
|
|
00580 EXEC CICS LINK DTSCU400
|
|
00581 PROGRAM('DTSCU005') DTSCU400
|
|
00582 COMMAREA(L005-COMM-AREA) DTSCU400
|
|
00583 END-EXEC. DTSCU400
|
|
00584 S005-EXIT. DTSCU400
|
|
00585 EXIT. DTSCU400
|
|
00586 DTSCU400
|
|
00587 S810-READ. DTSCU400
|
|
00588 SET L810-READ-88 TO TRUE. DTSCU400
|
|
00589 GO TO S810-IO. DTSCU400
|
|
00590 DTSCU400
|
|
00591 S810-READ-UPDATE. DTSCU400
|
|
00592 SET L810-READ-UPDATE-88 TO TRUE. DTSCU400
|
|
00593 GO TO S810-IO. DTSCU400
|
|
00594 DTSCU400
|
|
00595 S810-START-BROWSE. DTSCU400
|
|
00596 SET L810-START-BROWSE-88 TO TRUE. DTSCU400
|
|
00597 GO TO S810-IO. DTSCU400
|
|
00598 DTSCU400
|
|
00599 S810-READ-NEXT. DTSCU400
|
|
00600 SET L810-READ-NEXT-88 TO TRUE. DTSCU400
|
|
00601 GO TO S810-IO. DTSCU400
|
|
00602 DTSCU400
|
|
00603 S810-READ-PREV. DTSCU400
|
|
00604 SET L810-READ-PREV-88 TO TRUE. DTSCU400
|
|
00605 GO TO S810-IO. DTSCU400
|
|
00606 DTSCU400
|
|
00607 S810-END-BROWSE. DTSCU400
|
|
00608 SET L810-END-BROWSE-88 TO TRUE. DTSCU400
|
|
00609 GO TO S810-IO. DTSCU400
|
|
00610 DTSCU400
|
|
00611 S810-COUNT. DTSCU400
|
|
00612 SET L810-COUNT-88 TO TRUE. DTSCU400
|
|
00613 GO TO S810-IO. DTSCU400
|
|
00614 DTSCU400
|
|
00615 S810-REWRITE. DTSCU400
|
|
00616 SET L810-REWRITE-88 TO TRUE. DTSCU400
|
|
00617 GO TO S810-IO. DTSCU400
|
|
00618 DTSCU400
|
|
00619 S810-REWRITE-UPDATE. DTSCU400
|
|
00620 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCU400
|
|
00621 GO TO S810-IO. DTSCU400
|
|
00622 DTSCU400
|
|
00623 S810-WRITE. DTSCU400
|
|
00624 SET L810-WRITE-88 TO TRUE. DTSCU400
|
|
00625 GO TO S810-IO. DTSCU400
|
|
00626 DTSCU400
|
|
00627 S810-DELETE. DTSCU400
|
|
00628 SET L810-DELETE-88 TO TRUE. DTSCU400
|
|
00629 GO TO S810-IO. DTSCU400
|
|
00630 DTSCU400
|
|
00631 S810-IO. DTSCU400
|
|
00632 EXEC CICS LINK DTSCU400
|
|
00633 PROGRAM ('DTSCU810') DTSCU400
|
|
00634 COMMAREA (L810-COMM-AREA) DTSCU400
|
|
00635 END-EXEC. DTSCU400
|
|
00636 DTSCU400
|
|
00637 S810-EXIT. DTSCU400
|
|
00638 EXIT. DTSCU400
|
|
00639 DTSCU400
|
|
00640 S825-WRITE-T001. DTSCU400
|
|
00641 MOVE '001' TO T001-REC-TYPE. DTSCU400
|
|
00642 MOVE LENGTH OF T001-REC TO T001-LENGTH. DTSCU400
|
|
00643 MOVE WRK-EMP-NO TO T001-EMP-NO. DTSCU400
|
|
00644 MOVE L400-OP-ID TO T001-OP-ID DTSCU400
|
|
00645 T001-RESP-OP-ID. DTSCU400
|
|
00646 MOVE '1A' TO T001-SCR-ID DTSCU400
|
|
00647 MOVE L005-DATE TO T001-SYS-DATE. DTSCU400
|
|
00648 MOVE L005-TIME TO T001-SYS-TIME. DTSCU400
|
|
00649 SET T001-HSEHLD-NOTICES TO TRUE. DTSCU400
|
|
00650 MOVE WRK-T001-RPT-TYPE TO T001-HSEHLD-RPT-TYPE. DTSCU400
|
|
00651 MOVE WRK-START-YRQ TO T001-HH-START-YRQ. DTSCU400
|
|
00652 MOVE SPACES TO T001-INACT-LTR-TYPE DTSCU400
|
|
00653 T001-NOT-LIABLE-LTR-TYPE DTSCU400
|
|
00654 T001-WELCOME-LTR-IND. DTSCU400
|
|
00655 MOVE T001-REC TO RSKL-REC. DTSCU400
|
|
00656 DTSCU400
|
|
00657 SET L825-WRITE-88 TO TRUE. DTSCU400
|
|
00658 GO TO S825-O. DTSCU400
|
|
00659 DTSCU400
|
|
00660 S825-WRITE-R907. DTSCU400
|
|
00661 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSCU400
|
|
00662 MOVE WRK-EMP-NO TO R907-EMP-NO. DTSCU400
|
|
00663 MOVE 'DTSCU400' TO R907-MODULE-NAME. DTSCU400
|
|
00664 MOVE R907-REC TO RSKL-REC. DTSCU400
|
|
00665 DTSCU400
|
|
00666 SET L825-WRITE-88 TO TRUE. DTSCU400
|
|
00667 GO TO S825-O. DTSCU400
|
|
00668 DTSCU400
|
|
00669 S825-O. DTSCU400
|
|
00670 EXEC CICS LINK DTSCU400
|
|
00671 PROGRAM ('DTSCU825') DTSCU400
|
|
00672 COMMAREA (L825-COMM-AREA) DTSCU400
|
|
00673 END-EXEC. DTSCU400
|
|
00674 DTSCU400
|
|
00675 IF L825-FILE-CLOSED-88 DTSCU400
|
|
00676 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400
|
|
00677 DTSCU400
|
|
00678 S825-EXIT. DTSCU400
|
|
00679 EXIT. DTSCU400
|
|
00680 DTSCU400
|
|
00681 S1000-START-YRQ. DTSCU400
|
|
00682 IF L400-ADD-PENDING-1A-88 DTSCU400
|
|
00683 OR L400-DETERM-PENDING-88 DTSCU400
|
|
00684 MOVE ZERO TO WRK-ABS-QTR DTSCU400
|
|
00685 WRK-START-YRQ DTSCU400
|
|
00686 GO TO S1000-EXIT DTSCU400
|
|
00687 END-IF. DTSCU400
|
|
00688 DTSCU400
|
|
00689 MOVE L400-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCU400
|
|
00690 MOVE 1 TO L004-QTR-5-Q DTSCU400
|
|
00691 PERFORM S004-FROM-5 THRU S004-EXIT DTSCU400
|
|
00692 IF L004-VALID-QTR DTSCU400
|
|
00693 MOVE L004-ABS-QTR TO WRK-ABS-QTR DTSCU400
|
|
00694 MOVE L004-QTR-5-9 TO WRK-START-YRQ DTSCU400
|
|
00695 ELSE DTSCU400
|
|
00696 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400
|
|
00697 DTSCU400
|
|
00698 S1000-EXIT. DTSCU400
|
|
00699 EXIT. DTSCU400
|
|
00700 DTSCU400
|
|
00701 S2000-INIT-MFSC. DTSCU400
|
|
00702 MOVE LOW-VALUE TO MFSC-REC. DTSCU400
|
|
00703 DTSCU400
|
|
00704 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCU400
|
|
00705 SET MFSC-FSC-88 TO TRUE. DTSCU400
|
|
00706 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCU400
|
|
00707 MOVE L005-ABSTIME TO MFSC-ABSTIME. DTSCU400
|
|
00708 DTSCU400
|
|
00709 MOVE ZERO TO MFSC-PURGE-DATE DTSCU400
|
|
00710 MFSC-INITIAL-MAIL-DATE DTSCU400
|
|
00711 MFSC-CONFIRM-MAIL-DATE DTSCU400
|
|
00712 MFSC-DENIAL-MAIL-DATE. DTSCU400
|
|
00713 DTSCU400
|
|
00714 MOVE WRK-START-YRQ TO MFSC-START-YRQ. DTSCU400
|
|
00715 MOVE +99999 TO MFSC-END-YRQ. DTSCU400
|
|
00716 SET MFSC-REQ-LIAB-DETERM-88 TO TRUE. DTSCU400
|
|
00717 MOVE SPACES TO MFSC-CHANGE-REASON-CD DTSCU400
|
|
00718 MFSC-INIT-NOTICE-TYPE DTSCU400
|
|
00719 MFSC-CONFIRM-NOTICE-TYPE DTSCU400
|
|
00720 MFSC-DENIAL-NOTICE-TYPE. DTSCU400
|
|
00721 MOVE L400-OP-ID TO MFSC-CHNG-OP-ID. DTSCU400
|
|
00722 MOVE L400-CURR-RUN-DATE TO MFSC-ESTB-DATE DTSCU400
|
|
00723 MFSC-CHNG-DATE. DTSCU400
|
|
00724 MOVE ZERO TO MFSC-NOTE-CNT. DTSCU400
|
|
00725 DTSCU400
|
|
00726 DTSCU400
|
|
00727 S2000-EXIT. DTSCU400
|
|
00728 EXIT. DTSCU400
|
|
00729 DTSCU400
|
|
00730 S899-ABEND. DTSCU400
|
|
00731 SKIP1 DTSCU400
|
|
00732 EXEC CICS DTSCU400
|
|
00733 ABEND DTSCU400
|
|
00734 ABCODE (WRK-ABEND-CODE) DTSCU400
|
|
00735 END-EXEC. DTSCU400
|
|
00736 SKIP1 DTSCU400
|
|
00737 S899-EXIT. DTSCU400
|
|
00738 EXIT. DTSCU400
|