DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
541
Batch/DTSBD381.cob
Normal file
541
Batch/DTSBD381.cob
Normal file
@ -0,0 +1,541 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/02/09
|
||||
00002 PROGRAM-ID. DTSBD381. DTSBD381
|
||||
00003 AUTHOR. NORTHROP GRUMMAN. LV003
|
||||
00004 DATE-WRITTEN. JUNE 2005. DTSBD381
|
||||
00005 DATE-COMPILED. DTSBD381
|
||||
00006 DTSBD381
|
||||
00007 ***** DTSBD381
|
||||
00008 * DTSBD381
|
||||
00009 * FUNCTION: ADD MSOL, MERD RECORDS FOR WEB LIABILITY DTSBD381
|
||||
00010 * DETERMINATIONS. INPUT DATA FROM T002 TRANSACTION. DTSBD381
|
||||
00011 * DTSBD381
|
||||
00012 * MODIFICATION LOG: DTSBD381
|
||||
00013 * DTSBD381
|
||||
00014 * 06/01/2005 INITIAL DEVELOPMENT. DTSBD381
|
||||
00015 * WORK ORDER: PROGRAMMER: GD DTSBD381
|
||||
00016 * DTSBD381
|
||||
00017 * 09/25/2009 MODIFIED S330 TO SET L331-OP-ID FROM T002-OP-ID DTSBD381
|
||||
00018 * TO DISTINGUISH MODIFICATIONS FROM THE WEB FROM DTSBD381
|
||||
00019 * THOSE MADE BY STAFF. DTSBD381
|
||||
00020 * WORK ORDER: PROGRAMMER: GD DTSBD381
|
||||
00021 * DTSBD381
|
||||
00022 * MM/DD/CCYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD381
|
||||
00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD381
|
||||
00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD381
|
||||
00025 * DTSBD381
|
||||
00026 * DTSBD381
|
||||
00027 * DESCRIPTION: DTSBD381
|
||||
00028 * DTSBD381
|
||||
00029 * DTSBD381
|
||||
00030 * DTSBD381
|
||||
00031 * MASTER FILE RECORDS READ: DTSBD381
|
||||
00032 * DTSBD381
|
||||
00033 * NONE DTSBD381
|
||||
00034 * DTSBD381
|
||||
00035 * DTSBD381
|
||||
00036 * MASTER FILE RECORDS UPDATED: DTSBD381
|
||||
00037 * DTSBD381
|
||||
00038 * MSOL AND MERD DTSBD381
|
||||
00039 * DTSBD381
|
||||
00040 * DTSBD381
|
||||
00041 * REPORT RECORDS WRITTEN: DTSBD381
|
||||
00042 * DTSBD381
|
||||
00043 * NONE DTSBD381
|
||||
00044 * DTSBD381
|
||||
00045 * DTSBD381
|
||||
00046 * MODULES CALLED: DTSBD381
|
||||
00047 * DTSBD381
|
||||
00048 * DTSBU331 FORMAT AND WRITE MLOG RECORD OCCURRENCE. DTSBD381
|
||||
00049 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD381
|
||||
00050 * DTSBU927 BTC FILE OUTPUT. DTSBD381
|
||||
00051 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. DTSBD381
|
||||
00052 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD381
|
||||
00053 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. DTSBD381
|
||||
00054 * DTSBD381
|
||||
00055 ***** DTSBD381
|
||||
00056 SKIP3 DTSBD381
|
||||
00057 ENVIRONMENT DIVISION. DTSBD381
|
||||
00058 SKIP3 DTSBD381
|
||||
00059 DATA DIVISION. DTSBD381
|
||||
00060 EJECT DTSBD381
|
||||
00061 WORKING-STORAGE SECTION. DTSBD381
|
||||
000615 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD381 10/02/09'. DTSBD381
|
||||
00062 SKIP3 DTSBD381
|
||||
00063 01 WRK-AREA. DTSBD381
|
||||
00064 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +381.DTSBD381
|
||||
00065 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD381'.DTSBD381
|
||||
00066 05 WRK-ABEND-MSG PIC X(60). DTSBD381
|
||||
00067 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD381
|
||||
00068 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD381
|
||||
00069 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBD381
|
||||
00070 DTSBD381
|
||||
00071 05 WRK-LIAB-DATE PIC S9(09) COMP-3 VALUE 0. DTSBD381
|
||||
00072 05 WRK-INACT-DATE PIC S9(09) COMP-3 VALUE 0. DTSBD381
|
||||
00073 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3 VALUE 0. DTSBD381
|
||||
00074 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE 0. DTSBD381
|
||||
00075 05 WRK-ALL-NINES-QTR PIC S9(05) COMP-3 DTSBD381
|
||||
00076 VALUE +99999. DTSBD381
|
||||
00077 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBD381
|
||||
00078 VALUE +999999999. DTSBD381
|
||||
00079 DTSBD381
|
||||
00080 05 WRK-MSOL-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD381
|
||||
00081 05 WRK-MERD-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD381
|
||||
00082 05 WRK-R907-REC-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD381
|
||||
00083 DTSBD381
|
||||
00084 05 DISP-DATE PIC X(10) VALUE SPACES. DTSBD381
|
||||
00085 05 DISP-TIME PIC X(08) VALUE SPACES. DTSBD381
|
||||
00086 05 DISP-ABSTIME PIC X(16) VALUE SPACES. DTSBD381
|
||||
00087 DTSBD381
|
||||
00088 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. DTSBD381
|
||||
00089 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. DTSBD381
|
||||
00090 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. DTSBD381
|
||||
00091 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBD381
|
||||
00092 DTSBD381
|
||||
00093 05 WRK-MSG-TEXT. DTSBD381
|
||||
00094 10 WRK-MSG-LINE PIC X(50). DTSBD381
|
||||
00095 DTSBD381
|
||||
00096 01 MSG-TABLE. DTSBD381
|
||||
00097 05 MSG1-ADDRESS-MISSING. DTSBD381
|
||||
00098 10 MSG1-ID PIC X(11) VALUE 'DTSBD383909'. DTSBD381
|
||||
00099 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'NAME & ADDR CHG'. DTSBD381
|
||||
00100 10 MSG1-LONG-TEXT. DTSBD381
|
||||
00101 15 FILLER PIC X(30) DTSBD381
|
||||
00102 VALUE 'TRANSACTION FAILED - EXPECTED '. DTSBD381
|
||||
00103 15 FILLER PIC X(30) DTSBD381
|
||||
00104 VALUE 'NAME OR ADDRESS NOT FOUND '. DTSBD381
|
||||
00105 EJECT DTSBD381
|
||||
00106 01 Y104-REC. DTSBD381
|
||||
00107 ++INCLUDE DTSIY104 DTSBD381
|
||||
00108 EJECT DTSBD381
|
||||
00109 01 L001-LINK-AREA. DTSBD381
|
||||
00110 ++INCLUDE DTSIL001 DTSBD381
|
||||
00111 EJECT DTSBD381
|
||||
00112 01 L004-LINK-AREA. DTSBD381
|
||||
00113 ++INCLUDE DTSIL004 DTSBD381
|
||||
00114 EJECT DTSBD381
|
||||
00115 01 L331-LINK-AREA. DTSBD381
|
||||
00116 ++INCLUDE DTSIL331 DTSBD381
|
||||
00117 EJECT DTSBD381
|
||||
00118 01 L910-LINK-AREA. DTSBD381
|
||||
00119 ++INCLUDE DTSIL910 DTSBD381
|
||||
00120 EJECT DTSBD381
|
||||
00121 01 MSKL-REC. DTSBD381
|
||||
00122 ++INCLUDE DTSIMSKL DTSBD381
|
||||
00123 EJECT DTSBD381
|
||||
00124 01 MSOL-REC. DTSBD381
|
||||
00125 ++INCLUDE DTSIMSOL DTSBD381
|
||||
00126 01 MERD-REC. DTSBD381
|
||||
00127 ++INCLUDE DTSIMERD DTSBD381
|
||||
00128 EJECT DTSBD381
|
||||
00129 01 RSKL-REC. DTSBD381
|
||||
00130 ++INCLUDE DTSIRSK1 DTSBD381
|
||||
00131 EJECT DTSBD381
|
||||
00132 01 R128-REC. DTSBD381
|
||||
00133 ++INCLUDE DTSIR128 DTSBD381
|
||||
00134 EJECT DTSBD381
|
||||
00135 01 R907-REC. DTSBD381
|
||||
00136 ++INCLUDE DTSIR907 DTSBD381
|
||||
00137 EJECT DTSBD381
|
||||
00138 DTSBD381
|
||||
00139 LINKAGE SECTION. DTSBD381
|
||||
00140 SKIP3 DTSBD381
|
||||
00141 01 LBCM-LINK-AREA. DTSBD381
|
||||
00142 ++INCLUDE DTSILBCM DTSBD381
|
||||
00143 EJECT DTSBD381
|
||||
00144 01 MPRF-REC. DTSBD381
|
||||
00145 ++INCLUDE DTSIMPRF DTSBD381
|
||||
00146 EJECT DTSBD381
|
||||
00147 01 T002-REC. DTSBD381
|
||||
00148 ++INCLUDE DTSIT002 DTSBD381
|
||||
00149 EJECT DTSBD381
|
||||
00150 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD381
|
||||
00151 MPRF-REC DTSBD381
|
||||
00152 T002-REC. DTSBD381
|
||||
00153 DTSBD381
|
||||
00154 IF FIRST-TIME-IND = 'Y' DTSBD381
|
||||
00155 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD381
|
||||
00156 MOVE 'N' TO FIRST-TIME-IND DTSBD381
|
||||
00157 END-IF. DTSBD381
|
||||
00158 DTSBD381
|
||||
00159 IF MPRF-EMP-NO NOT = WRK-EMP-NO DTSBD381
|
||||
00160 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD381
|
||||
00161 MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBD381
|
||||
00162 END-IF. DTSBD381
|
||||
00163 DTSBD381
|
||||
00164 GOBACK. DTSBD381
|
||||
00165 DTSBD381
|
||||
00166 I0000-INITIATE. DTSBD381
|
||||
00167 DTSBD381
|
||||
00168 MOVE +0 TO WRK-EMP-NO. DTSBD381
|
||||
00169 MOVE LENGTH OF R128-REC TO R128-LENGTH. DTSBD381
|
||||
00170 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD381
|
||||
00171 DTSBD381
|
||||
00172 I0000-EXIT. DTSBD381
|
||||
00173 EXIT. DTSBD381
|
||||
00174 DTSBD381
|
||||
00175 P0000-PROCESS. DTSBD381
|
||||
00176 IF T002-DETERM-88 DTSBD381
|
||||
00177 MOVE T002-DATA-AREA TO Y104-REC DTSBD381
|
||||
00178 DISPLAY 'BD381 ' T002-EMP-NO DTSBD381
|
||||
00179 ' ' Y104-STAFF-REVIEW-IND DTSBD381
|
||||
00180 IF Y104-STAFF-REVIEW-YES-88 DTSBD381
|
||||
00181 OR Y104-LIAB-CD = SPACES DTSBD381
|
||||
00182 OR MPRF-ELIGIBLE-NOT-SUBJECT-88 DTSBD381
|
||||
00183 PERFORM P3000-WRITE-R128 THRU P3000-EXIT DTSBD381
|
||||
00184 ELSE DTSBD381
|
||||
00185 PERFORM P1000-ADD-MSOL THRU P1000-EXIT DTSBD381
|
||||
00186 PERFORM P2000-ADD-MERD THRU P2000-EXIT DTSBD381
|
||||
00187 PERFORM P3000-WRITE-R128 THRU P3000-EXIT DTSBD381
|
||||
00188 END-IF DTSBD381
|
||||
00189 ELSE DTSBD381
|
||||
00190 GO TO P0000-EXIT DTSBD381
|
||||
00191 END-IF. DTSBD381
|
||||
00192 DTSBD381
|
||||
00193 P0000-EXIT. DTSBD381
|
||||
00194 EXIT. DTSBD381
|
||||
00195 DTSBD381
|
||||
00196 P1000-ADD-MSOL. DTSBD381
|
||||
00197 PERFORM S330-INIT-MLOG THRU S330-EXIT. DTSBD381
|
||||
00198 DTSBD381
|
||||
00199 PERFORM P1100-LIAB-DATES THRU P1100-EXIT. DTSBD381
|
||||
00200 DTSBD381
|
||||
00201 MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9. DTSBD381
|
||||
00202 MOVE L001-FED-8-DATE-X TO L331-REC-OCC-ID. DTSBD381
|
||||
00203 MOVE SPACE TO L331-FROM-VALUE. DTSBD381
|
||||
00204 DTSBD381
|
||||
00205 MOVE LOW-VALUES TO MSOL-REC. DTSBD381
|
||||
00206 MOVE T002-EMP-NO TO MSOL-EMP-NO. DTSBD381
|
||||
00207 SET MSOL-SOL-88 TO TRUE. DTSBD381
|
||||
00208 MOVE WRK-LIAB-DATE TO MSOL-LIAB-DATE. DTSBD381
|
||||
00209 MOVE +0 TO MSOL-PURGE-DATE. DTSBD381
|
||||
00210 DTSBD381
|
||||
00211 DTSBD381
|
||||
00212 MOVE WRK-FIRST-LIAB-YRQ TO MSOL-FIRST-LIAB-YRQ. DTSBD381
|
||||
00213 MOVE 'MSOL-FIRST-LIAB-YRQ' TO L331-FIELD-NAME. DTSBD381
|
||||
00214 MOVE WRK-FIRST-LIAB-YRQ TO L004-QTR-5-9. DTSBD381
|
||||
00215 SET L004-FROM-5 TO TRUE. DTSBD381
|
||||
00216 PERFORM S004-YRQ THRU S004-EXIT. DTSBD381
|
||||
00217 MOVE L004-SLASH-QTR TO L331-TO-VALUE. DTSBD381
|
||||
00218 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD381
|
||||
00219 DTSBD381
|
||||
00220 MOVE WRK-LIAB-DATE TO MSOL-LIAB-ESTB-DATE. DTSBD381
|
||||
00221 MOVE 'MSOL-LIAB-ESTB-DATE' TO L331-FIELD-NAME. DTSBD381
|
||||
00222 MOVE MSOL-LIAB-ESTB-DATE TO L001-FED-8-DATE-9. DTSBD381
|
||||
00223 SET L001-FROM-FED-8 TO TRUE. DTSBD381
|
||||
00224 PERFORM S001-DATE THRU S001-EXIT. DTSBD381
|
||||
00225 MOVE L001-SLASH-DATE TO L331-TO-VALUE. DTSBD381
|
||||
00226 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD381
|
||||
00227 DTSBD381
|
||||
00228 MOVE +0 TO MSOL-LIAB-MAIL-DATE. DTSBD381
|
||||
00229 MOVE Y104-LIAB-CD TO MSOL-LIAB-CD. DTSBD381
|
||||
00230 MOVE 'MSOL-LIAB-CD' TO L331-FIELD-NAME. DTSBD381
|
||||
00231 MOVE MSOL-LIAB-CD TO L331-TO-VALUE. DTSBD381
|
||||
00232 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD381
|
||||
00233 DTSBD381
|
||||
00234 IF Y104-ACQUIRE-IND = 'N' DTSBD381
|
||||
00235 AND Y104-MERGE-SPLIT-IND = 'N' DTSBD381
|
||||
00236 AND Y104-REORG-IND = 'N' DTSBD381
|
||||
00237 MOVE 'Y' TO MSOL-NEW-EMPLOYER-IND DTSBD381
|
||||
00238 ELSE DTSBD381
|
||||
00239 MOVE 'N' TO MSOL-NEW-EMPLOYER-IND DTSBD381
|
||||
00240 END-IF. DTSBD381
|
||||
00241 MOVE 'MSOL-NEW-EMPLOYER-IND' TO L331-FIELD-NAME. DTSBD381
|
||||
00242 MOVE MSOL-NEW-EMPLOYER-IND TO L331-TO-VALUE. DTSBD381
|
||||
00243 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSBD381
|
||||
00244 DTSBD381
|
||||
00245 MOVE WRK-INACT-DATE TO MSOL-INACT-DATE. DTSBD381
|
||||
00246 IF WRK-INACT-DATE = WRK-ALL-NINES-DATE DTSBD381
|
||||
00247 NEXT SENTENCE DTSBD381
|
||||
00248 ELSE DTSBD381
|
||||
00249 MOVE 'MSOL-INACT-DATE' TO L331-FIELD-NAME DTSBD381
|
||||
00250 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 DTSBD381
|
||||
00251 SET L001-FROM-FED-8 TO TRUE DTSBD381
|
||||
00252 PERFORM S001-DATE THRU S001-EXIT DTSBD381
|
||||
00253 MOVE L001-SLASH-DATE TO L331-TO-VALUE DTSBD381
|
||||
00254 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD381
|
||||
00255 END-IF. DTSBD381
|
||||
00256 DTSBD381
|
||||
00257 IF WRK-INACT-DATE = WRK-ALL-NINES-DATE DTSBD381
|
||||
00258 MOVE +0 TO MSOL-INACT-ENTER-DATE DTSBD381
|
||||
00259 ELSE DTSBD381
|
||||
00260 MOVE LBCM-CURR-RUN-DATE TO MSOL-INACT-ENTER-DATE DTSBD381
|
||||
00261 END-IF. DTSBD381
|
||||
00262 DTSBD381
|
||||
00263 MOVE +0 TO MSOL-INACT-REVERSE-DATE. DTSBD381
|
||||
00264 DTSBD381
|
||||
00265 MOVE WRK-LAST-LIAB-YRQ TO MSOL-LAST-LIAB-YRQ. DTSBD381
|
||||
00266 DTSBD381
|
||||
00267 IF WRK-LAST-LIAB-YRQ = +0 OR WRK-ALL-NINES-QTR DTSBD381
|
||||
00268 NEXT SENTENCE DTSBD381
|
||||
00269 ELSE DTSBD381
|
||||
00270 MOVE 'MSOL-LAST-LIAB-YRQ' TO L331-FIELD-NAME DTSBD381
|
||||
00271 MOVE WRK-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSBD381
|
||||
00272 SET L004-FROM-5 TO TRUE DTSBD381
|
||||
00273 PERFORM S004-YRQ THRU S004-EXIT DTSBD381
|
||||
00274 MOVE L004-SLASH-QTR TO L331-TO-VALUE DTSBD381
|
||||
00275 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD381
|
||||
00276 END-IF. DTSBD381
|
||||
00277 DTSBD381
|
||||
00278 IF WRK-INACT-DATE = WRK-ALL-NINES-DATE DTSBD381
|
||||
00279 SET MSOL-INACT-ACTIVE-88 TO TRUE DTSBD381
|
||||
00280 ELSE DTSBD381
|
||||
00281 SET MSOL-INACT-OUT-OF-BUS-88 TO TRUE DTSBD381
|
||||
00282 MOVE 'MSOL-INACT-CD' TO L331-FIELD-NAME DTSBD381
|
||||
00283 MOVE MSOL-INACT-CD TO L331-TO-VALUE DTSBD381
|
||||
00284 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSBD381
|
||||
00285 END-IF. DTSBD381
|
||||
00286 DTSBD381
|
||||
00287 DTSBD381
|
||||
00288 SET MSOL-NOT-CONVERTED-88 TO TRUE. DTSBD381
|
||||
00289 DTSBD381
|
||||
00290 MOVE LBCM-CURR-RUN-DATE TO MSOL-ESTB-DATE DTSBD381
|
||||
00291 MSOL-CHNG-DATE. DTSBD381
|
||||
00292 DTSBD381
|
||||
00293 MOVE MSOL-REC TO MSKL-REC. DTSBD381
|
||||
00294 DTSBD381
|
||||
00295 PERFORM S910-WRITE THRU S910-EXIT. DTSBD381
|
||||
00296 DTSBD381
|
||||
00297 P1000-EXIT. DTSBD381
|
||||
00298 EXIT. DTSBD381
|
||||
00299 DTSBD381
|
||||
00300 P1100-LIAB-DATES. DTSBD381
|
||||
00301 MOVE Y104-FIRST-WAGE-DT TO L004-DATE DTSBD381
|
||||
00302 WRK-LIAB-DATE. DTSBD381
|
||||
00303 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBD381
|
||||
00304 IF NOT L004-VALID-QTR DTSBD381
|
||||
00305 DISPLAY 'P1100: INVALID FIRST WAGE DATE ' DTSBD381
|
||||
00306 T002-EMP-NO ' ' Y104-FIRST-WAGE-DT DTSBD381
|
||||
00307 MOVE 'INVALID FIRST WAGE DATE' TO WRK-ABEND-MSG DTSBD381
|
||||
00308 PERFORM S999-ABEND THRU S999-EXIT DTSBD381
|
||||
00309 ELSE DTSBD381
|
||||
00310 MOVE L004-QTR-5-9 TO WRK-FIRST-LIAB-YRQ DTSBD381
|
||||
00311 END-IF. DTSBD381
|
||||
00312 DTSBD381
|
||||
00313 MOVE WRK-ALL-NINES-QTR TO WRK-LAST-LIAB-YRQ. DTSBD381
|
||||
00314 MOVE WRK-ALL-NINES-DATE TO WRK-INACT-DATE. DTSBD381
|
||||
00315 DTSBD381
|
||||
00316 *** IF Y104-LAST-WAGE-DT = ZERO DTSBD381
|
||||
00317 * MOVE WRK-ALL-NINES-QTR TO WRK-LAST-LIAB-YRQ DTSBD381
|
||||
00318 * MOVE WRK-ALL-NINES-DATE TO WRK-INACT-DATE DTSBD381
|
||||
00319 * ELSE DTSBD381
|
||||
00320 * MOVE Y104-LAST-WAGE-DT TO L004-DATE DTSBD381
|
||||
00321 * WRK-INACT-DATE DTSBD381
|
||||
00322 * PERFORM S004-FROM-DATE THRU S004-EXIT DTSBD381
|
||||
00323 * IF NOT L004-VALID-QTR DTSBD381
|
||||
00324 * DISPLAY 'P1100: INVALID FIRST WAGE DATE ' DTSBD381
|
||||
00325 * T002-EMP-NO ' ' Y104-FIRST-WAGE-DT DTSBD381
|
||||
00326 * MOVE 'INVALID FIRST WAGE DATE' TO WRK-ABEND-MSG DTSBD381
|
||||
00327 * PERFORM S999-ABEND THRU S999-EXIT DTSBD381
|
||||
00328 * ELSE DTSBD381
|
||||
00329 * MOVE L004-QTR-5-9 TO WRK-LAST-LIAB-YRQ DTSBD381
|
||||
00330 * END-IF DTSBD381
|
||||
00331 *** END-IF. DTSBD381
|
||||
00332 DTSBD381
|
||||
00333 *& DTSBD381
|
||||
00334 DISPLAY 'BD381 P1100 LIAB DATE ' WRK-LIAB-DATE DTSBD381
|
||||
00335 ' FIRST QTR ' WRK-FIRST-LIAB-YRQ DTSBD381
|
||||
00336 ' LAST QTR ' WRK-LAST-LIAB-YRQ DTSBD381
|
||||
00337 ' INACT ' WRK-INACT-DATE. DTSBD381
|
||||
00338 *& DTSBD381
|
||||
00339 P1100-EXIT. DTSBD381
|
||||
00340 EXIT. DTSBD381
|
||||
00341 DTSBD381
|
||||
00342 P2000-ADD-MERD. DTSBD381
|
||||
00343 MOVE LOW-VALUES TO MERD-REC. DTSBD381
|
||||
00344 DTSBD381
|
||||
00345 MOVE T002-EMP-NO TO MERD-EMP-NO. DTSBD381
|
||||
00346 DTSBD381
|
||||
00347 SET MERD-ERD-88 TO TRUE. DTSBD381
|
||||
00348 DTSBD381
|
||||
00349 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD381
|
||||
00350 MOVE LBCM-ABSTIME TO MERD-ESTB-ABSTIME. DTSBD381
|
||||
00351 DTSBD381
|
||||
00352 MOVE +0 TO MERD-PURGE-DATE. DTSBD381
|
||||
00353 DTSBD381
|
||||
00354 IF MSOL-NEW-EMP-88 DTSBD381
|
||||
00355 SET MERD-DETER-NEW-88 TO TRUE DTSBD381
|
||||
00356 ELSE DTSBD381
|
||||
00357 SET MERD-DETER-SUC-88 TO TRUE DTSBD381
|
||||
00358 END-IF. DTSBD381
|
||||
00359 DTSBD381
|
||||
00360 MOVE MSOL-LIAB-ESTB-DATE TO MERD-EFFECTIVE-DATE. DTSBD381
|
||||
00361 DTSBD381
|
||||
00362 MOVE SPACES TO MERD-SCREEN-ID. DTSBD381
|
||||
00363 DTSBD381
|
||||
00364 EVALUATE TRUE DTSBD381
|
||||
00365 WHEN Y104-SOURCE-WEB-88 DTSBD381
|
||||
00366 MOVE 'WEB REG ' TO MERD-OP-ID DTSBD381
|
||||
00367 DTSBD381
|
||||
00368 WHEN Y104-SOURCE-UC30-SYS-88 DTSBD381
|
||||
00369 MOVE 'UC30 SYS' TO MERD-OP-ID DTSBD381
|
||||
00370 DTSBD381
|
||||
00371 WHEN Y104-SOURCE-FISC-AGNT-88 DTSBD381
|
||||
00372 MOVE 'FISC AGT' TO MERD-OP-ID DTSBD381
|
||||
00373 DTSBD381
|
||||
00374 WHEN OTHER DTSBD381
|
||||
00375 MOVE 'BATCH ' TO MERD-OP-ID DTSBD381
|
||||
00376 DTSBD381
|
||||
00377 END-EVALUATE. DTSBD381
|
||||
00378 DTSBD381
|
||||
00379 SET MERD-NOT-CONVERTED-88 TO TRUE. DTSBD381
|
||||
00380 DTSBD381
|
||||
00381 MOVE LBCM-CURR-RUN-DATE TO MERD-ESTB-DATE. DTSBD381
|
||||
00382 DTSBD381
|
||||
00383 MOVE MERD-REC TO MSKL-REC. DTSBD381
|
||||
00384 DTSBD381
|
||||
00385 PERFORM S910-WRITE THRU S910-EXIT. DTSBD381
|
||||
00386 DTSBD381
|
||||
00387 IF MSOL-INACT-ACTIVE-88 DTSBD381
|
||||
00388 NEXT SENTENCE DTSBD381
|
||||
00389 ELSE DTSBD381
|
||||
00390 ADD +1 TO MERD-ESTB-ABSTIME DTSBD381
|
||||
00391 SET MERD-DETER-INACT-88 TO TRUE DTSBD381
|
||||
00392 MOVE MSOL-INACT-DATE TO MERD-EFFECTIVE-DATE DTSBD381
|
||||
00393 MOVE MERD-REC TO MSKL-REC DTSBD381
|
||||
00394 PERFORM S910-WRITE THRU S910-EXIT DTSBD381
|
||||
00395 END-IF. DTSBD381
|
||||
00396 DTSBD381
|
||||
00397 P2000-EXIT. DTSBD381
|
||||
00398 EXIT. DTSBD381
|
||||
00399 DTSBD381
|
||||
00400 P3000-WRITE-R128. DTSBD381
|
||||
00401 MOVE '128' TO R128-REC-TYPE. DTSBD381
|
||||
00402 MOVE T002-EMP-NO TO R128-EMP-NO. DTSBD381
|
||||
00403 IF Y104-STAFF-REVIEW-YES-88 DTSBD381
|
||||
00404 OR Y104-LIAB-CD = SPACES DTSBD381
|
||||
00405 SET R128-PENDING-DETERM-88 TO TRUE DTSBD381
|
||||
00406 ELSE DTSBD381
|
||||
00407 SET R128-LIAB-ENTERED-NEW-88 TO TRUE DTSBD381
|
||||
00408 END-IF. DTSBD381
|
||||
00409 DTSBD381
|
||||
00410 MOVE Y104-SOURCE-CD TO R128-SOURCE. DTSBD381
|
||||
00411 IF Y104-TRADE-NAME NOT = SPACES DTSBD381
|
||||
00412 MOVE Y104-TRADE-NAME TO R128-LIAB-PRIMARY-NAME DTSBD381
|
||||
00413 ELSE DTSBD381
|
||||
00414 MOVE Y104-ENTITY-NAME TO R128-LIAB-PRIMARY-NAME DTSBD381
|
||||
00415 END-IF. DTSBD381
|
||||
00416 DTSBD381
|
||||
00417 MOVE LBCM-CURR-RUN-DATE TO R128-ESTB-DATE. DTSBD381
|
||||
00418 DTSBD381
|
||||
00419 MOVE R128-REC TO RSKL-REC. DTSBD381
|
||||
00420 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD381
|
||||
00421 DTSBD381
|
||||
00422 P3000-EXIT. DTSBD381
|
||||
00423 EXIT. DTSBD381
|
||||
00424 DTSBD381
|
||||
00425 S001-FROM-FED-8. DTSBD381
|
||||
00426 SET L001-FROM-FED-8 TO TRUE. DTSBD381
|
||||
00427 GO TO S001-DATE. DTSBD381
|
||||
00428 DTSBD381
|
||||
00429 S001-FROM-CAL-8. DTSBD381
|
||||
00430 SET L001-FROM-CAL-8 TO TRUE. DTSBD381
|
||||
00431 GO TO S001-DATE. DTSBD381
|
||||
00432 DTSBD381
|
||||
00433 S001-FROM-ABS-DAY. DTSBD381
|
||||
00434 SET L001-FROM-ABS-DAY TO TRUE. DTSBD381
|
||||
00435 GO TO S001-DATE. DTSBD381
|
||||
00436 DTSBD381
|
||||
00437 S001-DATE. DTSBD381
|
||||
00438 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD381
|
||||
00439 S001-EXIT. DTSBD381
|
||||
00440 EXIT. DTSBD381
|
||||
00441 DTSBD381
|
||||
00442 S004-FROM-5. DTSBD381
|
||||
00443 SET L004-FROM-5 TO TRUE. DTSBD381
|
||||
00444 GO TO S004-YRQ. DTSBD381
|
||||
00445 DTSBD381
|
||||
00446 S004-FROM-DATE. DTSBD381
|
||||
00447 SET L004-FROM-DATE TO TRUE. DTSBD381
|
||||
00448 GO TO S004-YRQ. DTSBD381
|
||||
00449 DTSBD381
|
||||
00450 S004-FROM-ABS. DTSBD381
|
||||
00451 SET L004-FROM-ABS TO TRUE. DTSBD381
|
||||
00452 GO TO S004-YRQ. DTSBD381
|
||||
00453 DTSBD381
|
||||
00454 S004-YRQ. DTSBD381
|
||||
00455 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD381
|
||||
00456 DTSBD381
|
||||
00457 S004-EXIT. DTSBD381
|
||||
00458 EXIT. DTSBD381
|
||||
00459 DTSBD381
|
||||
00460 S330-INIT-MLOG. DTSBD381
|
||||
00461 MOVE T002-EMP-NO TO L331-EMP-NO. DTSBD381
|
||||
00462 MOVE LBCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSBD381
|
||||
00463 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD381
|
||||
00464 MOVE LBCM-EMP-ABSTIME TO L331-UPDATE-ABSTIME. DTSBD381
|
||||
00465 MOVE T002-OP-ID TO L331-OP-ID. DTSBD381
|
||||
00466 DTSBD381
|
||||
00467 S330-EXIT. DTSBD381
|
||||
00468 EXIT. DTSBD381
|
||||
00469 DTSBD381
|
||||
00470 S331-WRITE-MLOG. DTSBD381
|
||||
00471 CALL 'DTSBU331' USING L331-LINK-AREA. DTSBD381
|
||||
00472 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD381
|
||||
00473 DTSBD381
|
||||
00474 S331-EXIT. DTSBD381
|
||||
00475 EXIT. DTSBD381
|
||||
00476 DTSBD381
|
||||
00477 S910-OPEN-READ. DTSBD381
|
||||
00478 SET L910-OPEN-READ-88 TO TRUE. DTSBD381
|
||||
00479 GO TO S910-MSTR-IO. DTSBD381
|
||||
00480 DTSBD381
|
||||
00481 S910-OPEN-UPDATE. DTSBD381
|
||||
00482 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD381
|
||||
00483 GO TO S910-MSTR-IO. DTSBD381
|
||||
00484 DTSBD381
|
||||
00485 S910-OPEN-UPDATE-NO-AIX. DTSBD381
|
||||
00486 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBD381
|
||||
00487 GO TO S910-MSTR-IO. DTSBD381
|
||||
00488 DTSBD381
|
||||
00489 S910-READ. DTSBD381
|
||||
00490 SET L910-READ-88 TO TRUE. DTSBD381
|
||||
00491 GO TO S910-MSTR-IO. DTSBD381
|
||||
00492 DTSBD381
|
||||
00493 S910-START-BROWSE. DTSBD381
|
||||
00494 SET L910-START-BROWSE-88 TO TRUE. DTSBD381
|
||||
00495 GO TO S910-MSTR-IO. DTSBD381
|
||||
00496 DTSBD381
|
||||
00497 S910-READ-NEXT. DTSBD381
|
||||
00498 SET L910-READ-NEXT-88 TO TRUE. DTSBD381
|
||||
00499 GO TO S910-MSTR-IO. DTSBD381
|
||||
00500 DTSBD381
|
||||
00501 S910-COUNT. DTSBD381
|
||||
00502 SET L910-COUNT-88 TO TRUE. DTSBD381
|
||||
00503 GO TO S910-MSTR-IO. DTSBD381
|
||||
00504 DTSBD381
|
||||
00505 S910-WRITE. DTSBD381
|
||||
00506 SET L910-WRITE-88 TO TRUE. DTSBD381
|
||||
00507 GO TO S910-MSTR-IO. DTSBD381
|
||||
00508 DTSBD381
|
||||
00509 S910-REWRITE. DTSBD381
|
||||
00510 SET L910-REWRITE-88 TO TRUE. DTSBD381
|
||||
00511 GO TO S910-MSTR-IO. DTSBD381
|
||||
00512 DTSBD381
|
||||
00513 S910-DELETE. DTSBD381
|
||||
00514 SET L910-DELETE-88 TO TRUE. DTSBD381
|
||||
00515 GO TO S910-MSTR-IO. DTSBD381
|
||||
00516 DTSBD381
|
||||
00517 S910-CLOSE. DTSBD381
|
||||
00518 SET L910-CLOSE-88 TO TRUE. DTSBD381
|
||||
00519 GO TO S910-MSTR-IO. DTSBD381
|
||||
00520 DTSBD381
|
||||
00521 S910-MSTR-IO. DTSBD381
|
||||
00522 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD381
|
||||
00523 MSKL-REC. DTSBD381
|
||||
00524 S910-EXIT. DTSBD381
|
||||
00525 EXIT. DTSBD381
|
||||
00526 DTSBD381
|
||||
00527 S946-RPT-O. DTSBD381
|
||||
00528 CALL 'DTSBU946' USING RSKL-REC. DTSBD381
|
||||
00529 S946-EXIT. DTSBD381
|
||||
00530 EXIT. DTSBD381
|
||||
00531 DTSBD381
|
||||
00532 DTSBD381
|
||||
00533 S999-ABEND. DTSBD381
|
||||
00534 DISPLAY '*** DTSBD381 ABENDING : ' DTSBD381
|
||||
00535 WRK-ABEND-MSG. DTSBD381
|
||||
00536 DTSBD381
|
||||
00537 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD381
|
||||
00538 S999-EXIT. DTSBD381
|
||||
00539 EXIT. DTSBD381
|
||||
00540 DTSBD381
|
||||
Reference in New Issue
Block a user