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