DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
700
Batch/DTSBD145.cob
Normal file
700
Batch/DTSBD145.cob
Normal file
@ -0,0 +1,700 @@
|
||||
00001 IDENTIFICATION DIVISION. 12/11/13
|
||||
00002 PROGRAM-ID. DTSBD145. DTSBD145
|
||||
00003 AUTHOR. NGC. LV001
|
||||
00004 DATE-WRITTEN. JULY 2013. DTSBD145
|
||||
00005 DATE-COMPILED. DTSBD145
|
||||
00006 SKIP3 DTSBD145
|
||||
00007 ***** DTSBD145
|
||||
00008 * DTSBD145
|
||||
00009 * FUNCTION: PRE-UPDTE ACCOUNTING TRANSACTION COLLECTION DTSBD145
|
||||
00010 * FILE SCAN. DTSBD145
|
||||
00011 * DTSBD145
|
||||
00012 * MODIFICATION LOG: DTSBD145
|
||||
00013 * DTSBD145
|
||||
00014 * 07/08/2013 INITIAL DEVELOPMENT. DTSBD145
|
||||
00015 * WORK ORDER: TICKET 1915 PROGRAMMER: GD DTSBD145
|
||||
00016 * DTSBD145
|
||||
00017 * DTSBD145
|
||||
00018 * DESCRIPTION: DTSBD145
|
||||
00019 * DTSBD145
|
||||
00020 * DTSBD145
|
||||
00021 ***** DTSBD145
|
||||
00022 SKIP3 DTSBD145
|
||||
00023 ENVIRONMENT DIVISION. DTSBD145
|
||||
00024 INPUT-OUTPUT SECTION. DTSBD145
|
||||
00025 FILE-CONTROL. DTSBD145
|
||||
00026 SELECT NOT-LIABLE-FILE ASSIGN TO DTSF145 DTSBD145
|
||||
00027 FILE STATUS IS F145-STATUS. DTSBD145
|
||||
00028 DTSBD145
|
||||
00029 DATA DIVISION. DTSBD145
|
||||
00030 SKIP3 DTSBD145
|
||||
00031 FILE SECTION. DTSBD145
|
||||
00032 DTSBD145
|
||||
00033 FD NOT-LIABLE-FILE DTSBD145
|
||||
00034 RECORDING MODE IS F DTSBD145
|
||||
00035 LABEL RECORDS ARE STANDARD DTSBD145
|
||||
00036 BLOCK CONTAINS 0 CHARACTERS. DTSBD145
|
||||
00037 SKIP1 DTSBD145
|
||||
00038 01 NOT-LIABLE-REC PIC X(64). DTSBD145
|
||||
00039 DTSBD145
|
||||
00040 WORKING-STORAGE SECTION. DTSBD145
|
||||
000405 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD145 12/11/13'. DTSBD145
|
||||
00041 77 PAN-VALET PICTURE X(24) VALUE '041DTSBD145 10/10/13'. DTSBD145
|
||||
00042 77 PAN-VALET PICTURE X(24) VALUE '016DTSBD150 03/04/11'. DTSBD145
|
||||
00043 SKIP3 DTSBD145
|
||||
00044 01 WRK-AREA. DTSBD145
|
||||
00045 05 W-ABEND-CD PIC S9(04) COMP VALUE +145.DTSBD145
|
||||
00046 DTSBD145
|
||||
00047 05 W-MODULE-ID PIC X(08) VALUE 'DTSBD145'.DTSBD145
|
||||
00048 DTSBD145
|
||||
00049 05 F145-STATUS PIC X(02). DTSBD145
|
||||
00050 88 F145-STATUS-OK-88 VALUE '00'. DTSBD145
|
||||
00051 DTSBD145
|
||||
00052 05 W-BATCH-NO PIC S9(05) COMP-3 DTSBD145
|
||||
00053 VALUE +0. DTSBD145
|
||||
00054 DTSBD145
|
||||
00055 05 W-ERROR-IND PIC X(01). DTSBD145
|
||||
00056 88 W-ERROR-YES-88 VALUE 'Y'. DTSBD145
|
||||
00057 88 W-ERROR-NO-88 VALUE 'N'. DTSBD145
|
||||
00058 DTSBD145
|
||||
00059 05 W-START-FOUND-IND PIC X(01). DTSBD145
|
||||
00060 88 W-START-FOUND-YES-88 VALUE 'Y'. DTSBD145
|
||||
00061 88 W-START-FOUND-NO-88 VALUE 'N'. DTSBD145
|
||||
00062 DTSBD145
|
||||
00063 05 W-REWRITE-IND PIC X(01). DTSBD145
|
||||
00064 88 W-REWRITE-YES-88 VALUE 'Y'. DTSBD145
|
||||
00065 88 W-REWRITE-NO-88 VALUE 'N'. DTSBD145
|
||||
00066 DTSBD145
|
||||
00067 05 WRK-MNTE-MSG-LINE1. DTSBD145
|
||||
00068 10 FILLER PIC X(53) VALUE DTSBD145
|
||||
00069 'REPORT TRANSACTION WAS DELETED DUE TO ZERO WAGES OR '. DTSBD145
|
||||
00070 05 WRK-MNTE-MSG-LINE2. DTSBD145
|
||||
00071 10 FILLER PIC X(41) VALUE DTSBD145
|
||||
00072 'EMPLOYER WAS FOUND NOT LIABLE. '. DTSBD145
|
||||
00073 05 WRK-MNTE-MSG-LINE3. DTSBD145
|
||||
00074 10 FILLER PIC X(46) VALUE DTSBD145
|
||||
00075 ' '. DTSBD145
|
||||
00076 DTSBD145
|
||||
00077 05 W-HOLD-HDR-REC PIC X(128). DTSBD145
|
||||
00078 05 FILLER REDEFINES W-HOLD-HDR-REC. DTSBD145
|
||||
00079 10 W-HOLD-BATCH-NO PIC S9(05) COMP-3. DTSBD145
|
||||
00080 10 FILLER PIC X(125). DTSBD145
|
||||
00081 DTSBD145
|
||||
00082 05 W-NL-REC. DTSBD145
|
||||
00083 10 W-NL-BATCH PIC 9(05). DTSBD145
|
||||
00084 10 FILLER PIC X(01) VALUE ';'. DTSBD145
|
||||
00085 10 W-NL-ITEM PIC 9(03). DTSBD145
|
||||
00086 10 FILLER PIC X(01) VALUE ';'. DTSBD145
|
||||
00087 10 W-NL-EMP PIC 9(06). DTSBD145
|
||||
00088 10 FILLER PIC X(01) VALUE ';'. DTSBD145
|
||||
00089 10 W-NL-QTR PIC X(06). DTSBD145
|
||||
00090 10 FILLER PIC X(01) VALUE ';'. DTSBD145
|
||||
00091 10 W-NL-TYPE PIC X(40). DTSBD145
|
||||
00092 DTSBD145
|
||||
00093 05 WRK-T003-CNT PIC S9(05) COMP-3 DTSBD145
|
||||
00094 VALUE +0. DTSBD145
|
||||
00095 05 W-TRAN-DELETE-CNT PIC S9(05) COMP-3 DTSBD145
|
||||
00096 VALUE +0. DTSBD145
|
||||
00097 05 W-HDR-UPDATE-CNT PIC S9(05) COMP-3 DTSBD145
|
||||
00098 VALUE +0. DTSBD145
|
||||
00099 DTSBD145
|
||||
00100 01 TSKL-REC. DTSBD145
|
||||
00101 ++INCLUDE DTSITSKL DTSBD145
|
||||
00102 DTSBD145
|
||||
00103 01 T003-REC. DTSBD145
|
||||
00104 ++INCLUDE DTSIT003 DTSBD145
|
||||
00105 DTSBD145
|
||||
00106 01 MNTE-REC. DTSBD145
|
||||
00107 ++INCLUDE DTSIMNTE DTSBD145
|
||||
00108 DTSBD145
|
||||
00109 01 L927-LINK-AREA. DTSBD145
|
||||
00110 ++INCLUDE DTSIL927 DTSBD145
|
||||
00111 DTSBD145
|
||||
00112 01 L001-LINK-AREA. DTSBD145
|
||||
00113 ++INCLUDE DTSIL001 DTSBD145
|
||||
00114 DTSBD145
|
||||
00115 01 L003-LINK-AREA. DTSBD145
|
||||
00116 ++INCLUDE DTSIL003 DTSBD145
|
||||
00117 DTSBD145
|
||||
00118 01 L004-LINK-AREA. DTSBD145
|
||||
00119 ++INCLUDE DTSIL004 DTSBD145
|
||||
00120 DTSBD145
|
||||
00121 01 L005-LINK-AREA. DTSBD145
|
||||
00122 ++INCLUDE DTSIL005 DTSBD145
|
||||
00123 DTSBD145
|
||||
00124 01 L516-LINK-AREA. DTSBD145
|
||||
00125 ++INCLUDE DTSIL516 DTSBD145
|
||||
00126 DTSBD145
|
||||
00127 01 L910-LINK-AREA. DTSBD145
|
||||
00128 ++INCLUDE DTSIL910 DTSBD145
|
||||
00129 DTSBD145
|
||||
00130 01 MSKL-REC. DTSBD145
|
||||
00131 ++INCLUDE DTSIMSKL DTSBD145
|
||||
00132 DTSBD145
|
||||
00133 01 MPRF-REC. DTSBD145
|
||||
00134 ++INCLUDE DTSIMPRF DTSBD145
|
||||
00135 DTSBD145
|
||||
00136 01 MSOL-REC. DTSBD145
|
||||
00137 ++INCLUDE DTSIMSOL DTSBD145
|
||||
00138 DTSBD145
|
||||
00139 01 L923-LINK-AREA. DTSBD145
|
||||
00140 ++INCLUDE DTSIL923 DTSBD145
|
||||
00141 SKIP3 DTSBD145
|
||||
00142 01 ASKL-REC. DTSBD145
|
||||
00143 ++INCLUDE DTSIASKL DTSBD145
|
||||
00144 SKIP3 DTSBD145
|
||||
00145 01 AHDR-REC. DTSBD145
|
||||
00146 ++INCLUDE DTSIAHDR DTSBD145
|
||||
00147 SKIP3 DTSBD145
|
||||
00148 01 ARPT-REC. DTSBD145
|
||||
00149 ++INCLUDE DTSIARPT DTSBD145
|
||||
00150 SKIP3 DTSBD145
|
||||
00151 01 AATX-REC. DTSBD145
|
||||
00152 ++INCLUDE DTSIAATX DTSBD145
|
||||
00153 SKIP3 DTSBD145
|
||||
00154 01 APAY-REC. DTSBD145
|
||||
00155 ++INCLUDE DTSIAPAY DTSBD145
|
||||
00156 SKIP3 DTSBD145
|
||||
00157 01 AADJ-REC. DTSBD145
|
||||
00158 ++INCLUDE DTSIAADJ DTSBD145
|
||||
00159 DTSBD145
|
||||
00160 01 L931-LINK-AREA. DTSBD145
|
||||
00161 ++INCLUDE DTSIL931 DTSBD145
|
||||
00162 DTSBD145
|
||||
00163 01 FSKL-REC. DTSBD145
|
||||
00164 ++INCLUDE DTSIFSKL DTSBD145
|
||||
00165 DTSBD145
|
||||
00166 01 R907-REC. DTSBD145
|
||||
00167 ++INCLUDE DTSIR907 DTSBD145
|
||||
00168 DTSBD145
|
||||
00169 PROCEDURE DIVISION. DTSBD145
|
||||
00170 DTSBD145
|
||||
00171 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD145
|
||||
00172 DTSBD145
|
||||
00173 IF W-ERROR-NO-88 DTSBD145
|
||||
00174 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD145
|
||||
00175 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBD145
|
||||
00176 END-IF. DTSBD145
|
||||
00177 DTSBD145
|
||||
00178 GOBACK. DTSBD145
|
||||
00179 DTSBD145
|
||||
00180 I0000-INITIATE. DTSBD145
|
||||
00181 SET W-ERROR-NO-88 TO TRUE. DTSBD145
|
||||
00182 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBD145
|
||||
00183 DTSBD145
|
||||
00184 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD145
|
||||
00185 DTSBD145
|
||||
00186 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSBD145
|
||||
00187 MOVE '003' TO T003-REC-TYPE. DTSBD145
|
||||
00188 MOVE 'SYSTEM' TO T003-ORIGIN. DTSBD145
|
||||
00189 MOVE L005-DATE TO T003-SYS-DATE. DTSBD145
|
||||
00190 MOVE L005-TIME TO T003-SYS-TIME. DTSBD145
|
||||
00191 SET T003-ADD-MNTE-88 TO TRUE. DTSBD145
|
||||
00192 DTSBD145
|
||||
00193 DTSBD145
|
||||
00194 PERFORM I3000-START-BATCH THRU I3000-EXIT. DTSBD145
|
||||
00195 DTSBD145
|
||||
00196 I0000-EXIT. DTSBD145
|
||||
00197 EXIT. DTSBD145
|
||||
00198 DTSBD145
|
||||
00199 I2000-OPEN-FILES. DTSBD145
|
||||
00200 OPEN OUTPUT NOT-LIABLE-FILE. DTSBD145
|
||||
00201 IF NOT F145-STATUS-OK-88 DTSBD145
|
||||
00202 DISPLAY 'CANNOT OPEN NOT LIABLE FILE ' DTSBD145
|
||||
00203 F145-STATUS DTSBD145
|
||||
00204 SET W-ERROR-YES-88 TO TRUE DTSBD145
|
||||
00205 GO TO I2000-EXIT DTSBD145
|
||||
00206 END-IF. DTSBD145
|
||||
00207 DTSBD145
|
||||
00208 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD145
|
||||
00209 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. DTSBD145
|
||||
00210 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. DTSBD145
|
||||
00211 *& PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBD145
|
||||
00212 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD145
|
||||
00213 DTSBD145
|
||||
00214 I2000-EXIT. DTSBD145
|
||||
00215 EXIT. DTSBD145
|
||||
00216 DTSBD145
|
||||
00217 ************************************************************** DTSBD145
|
||||
00218 * SCAN THE ATC FILE UNTIL FINDING THE FIRST BATCH ESTABLISHED DTSBD145
|
||||
00219 * AFTER W-START-DATE. DTSBD145
|
||||
00220 ************************************************************** DTSBD145
|
||||
00221 I3000-START-BATCH. DTSBD145
|
||||
00222 SET W-START-FOUND-NO-88 TO TRUE. DTSBD145
|
||||
00223 DTSBD145
|
||||
00224 MOVE +0 TO AHDR-BATCH-NO DTSBD145
|
||||
00225 AHDR-ITEM-NO. DTSBD145
|
||||
00226 DTSBD145
|
||||
00227 MOVE AHDR-KEY-AREA TO ASKL-KEY-AREA. DTSBD145
|
||||
00228 DTSBD145
|
||||
00229 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBD145
|
||||
00230 DTSBD145
|
||||
00231 PERFORM UNTIL L923-NO-REC-88 OR W-START-FOUND-YES-88 DTSBD145
|
||||
00232 MOVE ASKL-REC TO AHDR-REC DTSBD145
|
||||
00233 IF ASKL-HDR-88 DTSBD145
|
||||
00234 IF AHDR-ESTB-DATE NOT NUMERIC DTSBD145
|
||||
00235 DISPLAY 'NON-NUM ESTB ' AHDR-BATCH-NO DTSBD145
|
||||
00236 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBD145
|
||||
00237 ELSE DTSBD145
|
||||
00238 IF AHDR-ESTB-SYSTEM-88 DTSBD145
|
||||
00239 OR AHDR-ESTB-DATE < 20130501 DTSBD145
|
||||
00240 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBD145
|
||||
00241 ELSE DTSBD145
|
||||
00242 SET W-START-FOUND-YES-88 TO TRUE DTSBD145
|
||||
00243 END-IF DTSBD145
|
||||
00244 END-IF DTSBD145
|
||||
00245 ELSE DTSBD145
|
||||
00246 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBD145
|
||||
00247 END-IF DTSBD145
|
||||
00248 END-PERFORM. DTSBD145
|
||||
00249 DTSBD145
|
||||
00250 I3000-EXIT. DTSBD145
|
||||
00251 EXIT. DTSBD145
|
||||
00252 DTSBD145
|
||||
00253 P0000-PROCESS. DTSBD145
|
||||
00254 MOVE +0 TO W-HOLD-BATCH-NO. DTSBD145
|
||||
00255 DTSBD145
|
||||
00256 PERFORM UNTIL L923-NO-REC-88 OR W-ERROR-YES-88 DTSBD145
|
||||
00257 IF ASKL-HDR-88 DTSBD145
|
||||
00258 PERFORM P1000-PROCESS-HDR THRU P1000-EXIT DTSBD145
|
||||
00259 ELSE DTSBD145
|
||||
00260 MOVE ASKL-REC TO ARPT-REC DTSBD145
|
||||
00261 PERFORM P2000-CHECK-TRAN THRU P2000-EXIT DTSBD145
|
||||
00262 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBD145
|
||||
00263 END-IF DTSBD145
|
||||
00264 END-PERFORM. DTSBD145
|
||||
00265 DTSBD145
|
||||
00266 IF W-REWRITE-YES-88 DTSBD145
|
||||
00267 DISPLAY 'UPDATE LAST HEADER ' DTSBD145
|
||||
00268 PERFORM P1100-UPD-OLD-HEADER THRU P1100-EXIT DTSBD145
|
||||
00269 END-IF. DTSBD145
|
||||
00270 DTSBD145
|
||||
00271 P0000-EXIT. DTSBD145
|
||||
00272 EXIT. DTSBD145
|
||||
00273 DTSBD145
|
||||
00274 P1000-PROCESS-HDR. DTSBD145
|
||||
00275 **************** DTSBD145
|
||||
00276 * SAVE THE NEW HEADER RECORD JUST READ DTSBD145
|
||||
00277 **************** DTSBD145
|
||||
00278 DISPLAY 'P1000 ' ASKL-BATCH-NO ' ' ASKL-ITEM-NO. DTSBD145
|
||||
00279 IF W-HOLD-BATCH-NO = 0 DTSBD145
|
||||
00280 MOVE ASKL-REC TO AHDR-REC DTSBD145
|
||||
00281 W-HOLD-HDR-REC DTSBD145
|
||||
00282 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBD145
|
||||
00283 GO TO P1000-EXIT DTSBD145
|
||||
00284 ELSE DTSBD145
|
||||
00285 MOVE ASKL-REC TO W-HOLD-HDR-REC DTSBD145
|
||||
00286 END-IF. DTSBD145
|
||||
00287 DTSBD145
|
||||
00288 **************** DTSBD145
|
||||
00289 * UPDATE THE HEADER FOR THE BATCH JUST PROCESSED DTSBD145
|
||||
00290 **************** DTSBD145
|
||||
00291 IF W-REWRITE-YES-88 DTSBD145
|
||||
00292 PERFORM P1100-UPD-OLD-HEADER THRU P1100-EXIT DTSBD145
|
||||
00293 END-IF. DTSBD145
|
||||
00294 DTSBD145
|
||||
00295 **************** DTSBD145
|
||||
00296 * RE-READ THE NEW HEADER RECORD, SAVE IT, AND GET THE FIRST DTSBD145
|
||||
00297 * TRANSACTION IN THE NEW BATCH. DTSBD145
|
||||
00298 **************** DTSBD145
|
||||
00299 DTSBD145
|
||||
00300 PERFORM P1200-START-NEXT-BATCH THRU P1200-EXIT. DTSBD145
|
||||
00301 DTSBD145
|
||||
00302 P1000-EXIT. DTSBD145
|
||||
00303 EXIT. DTSBD145
|
||||
00304 DTSBD145
|
||||
00305 P1100-UPD-OLD-HEADER. DTSBD145
|
||||
00306 MOVE AHDR-KEY-AREA TO ASKL-KEY-AREA. DTSBD145
|
||||
00307 PERFORM S923-READ THRU S923-EXIT. DTSBD145
|
||||
00308 DTSBD145
|
||||
00309 IF L923-NO-REC-88 DTSBD145
|
||||
00310 SET W-ERROR-YES-88 TO TRUE DTSBD145
|
||||
00311 DISPLAY 'CANNOT READ OLD HEADER ' W-HOLD-BATCH-NO DTSBD145
|
||||
00312 ' ' ASKL-BATCH-NO DTSBD145
|
||||
00313 GO TO P1100-EXIT DTSBD145
|
||||
00314 ELSE DTSBD145
|
||||
00315 ADD +1 TO W-HDR-UPDATE-CNT DTSBD145
|
||||
00316 DISPLAY 'CTL UPD ' AHDR-CONTROL-TRAN-CNT DTSBD145
|
||||
00317 MOVE AHDR-REC TO ASKL-REC DTSBD145
|
||||
00318 PERFORM S923-REWRITE THRU S923-EXIT DTSBD145
|
||||
00319 DISPLAY 'REWRITE ' AHDR-BATCH-NO DTSBD145
|
||||
00320 END-IF. DTSBD145
|
||||
00321 DTSBD145
|
||||
00322 P1100-EXIT. DTSBD145
|
||||
00323 EXIT. DTSBD145
|
||||
00324 DTSBD145
|
||||
00325 P1200-START-NEXT-BATCH. DTSBD145
|
||||
00326 ******************* DTSBD145
|
||||
00327 * RE-READ THE NEW HEADER RECORD, THEN DO A START-BROWSE DTSBD145
|
||||
00328 * TO GET THE FIRST TRANSACTION IN THE NEW BATCH. DTSBD145
|
||||
00329 ******************* DTSBD145
|
||||
00330 MOVE W-HOLD-HDR-REC TO ASKL-REC. DTSBD145
|
||||
00331 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBD145
|
||||
00332 *** IF ASKL-BATCH-NO NOT = W-HOLD-BATCH-NO DTSBD145
|
||||
00333 IF L923-NO-REC-88 DTSBD145
|
||||
00334 SET W-ERROR-YES-88 TO TRUE DTSBD145
|
||||
00335 DISPLAY 'CANNOT READ OLD HEADER ' W-HOLD-BATCH-NO DTSBD145
|
||||
00336 ' ' ASKL-BATCH-NO DTSBD145
|
||||
00337 GO TO P1200-EXIT DTSBD145
|
||||
00338 ELSE DTSBD145
|
||||
00339 MOVE ASKL-REC TO AHDR-REC DTSBD145
|
||||
00340 SET W-REWRITE-NO-88 TO TRUE DTSBD145
|
||||
00341 PERFORM S923-READ-NEXT THRU S923-EXIT DTSBD145
|
||||
00342 END-IF. DTSBD145
|
||||
00343 DTSBD145
|
||||
00344 P1200-EXIT. DTSBD145
|
||||
00345 EXIT. DTSBD145
|
||||
00346 DTSBD145
|
||||
00347 P2000-CHECK-TRAN. DTSBD145
|
||||
00348 DISPLAY ' P2000 ' ARPT-EMP-NO. DTSBD145
|
||||
00349 IF ASKL-RPT-88 DTSBD145
|
||||
00350 MOVE ASKL-REC TO ARPT-REC DTSBD145
|
||||
00351 IF ARPT-ORIG-88 DTSBD145
|
||||
00352 AND ARPT-TOT-WAGE = ZERO DTSBD145
|
||||
00353 AND ARPT-NOT-PROCESSED-88 DTSBD145
|
||||
00354 PERFORM P2100-FIND-MPRF THRU P2100-EXIT DTSBD145
|
||||
00355 IF L910-OK-88 DTSBD145
|
||||
00356 PERFORM P2200-LIABILITY THRU P2200-EXIT DTSBD145
|
||||
00357 END-IF DTSBD145
|
||||
00358 END-IF DTSBD145
|
||||
00359 END-IF. DTSBD145
|
||||
00360 DTSBD145
|
||||
00361 P2000-EXIT. DTSBD145
|
||||
00362 EXIT. DTSBD145
|
||||
00363 DTSBD145
|
||||
00364 P2100-FIND-MPRF. DTSBD145
|
||||
00365 DISPLAY ' P2100 ' ARPT-EMP-NO. DTSBD145
|
||||
00366 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD145
|
||||
00367 MOVE ARPT-EMP-NO TO MPRF-EMP-NO. DTSBD145
|
||||
00368 SET MPRF-PRF-88 TO TRUE. DTSBD145
|
||||
00369 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD145
|
||||
00370 PERFORM S910-READ THRU S910-EXIT. DTSBD145
|
||||
00371 IF L910-OK-88 DTSBD145
|
||||
00372 MOVE MSKL-REC TO MPRF-REC DTSBD145
|
||||
00373 ELSE DTSBD145
|
||||
00374 DISPLAY 'CANNOT FIND MPRF ' ARPT-EMP-NO DTSBD145
|
||||
00375 * SET W-ERROR-YES-88 TO TRUE DTSBD145
|
||||
00376 SET W-REWRITE-NO-88 TO TRUE DTSBD145
|
||||
00377 GO TO P2100-EXIT DTSBD145
|
||||
00378 END-IF. DTSBD145
|
||||
00379 DTSBD145
|
||||
00380 P2100-EXIT. DTSBD145
|
||||
00381 EXIT. DTSBD145
|
||||
00382 DTSBD145
|
||||
00383 P2200-LIABILITY. DTSBD145
|
||||
00384 DISPLAY ' P2200 ' ARPT-EMP-NO. DTSBD145
|
||||
00385 IF ARPT-YRQ > ZERO DTSBD145
|
||||
00386 MOVE ARPT-YRQ TO L516-YRQ DTSBD145
|
||||
00387 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSBD145
|
||||
00388 IF L516-NOT-LIABLE-88 DTSBD145
|
||||
00389 PERFORM P2210-NOT-LIABLE THRU P2210-EXIT DTSBD145
|
||||
00390 ELSE DTSBD145
|
||||
00391 PERFORM P2220-FIRST-LIAB-QTR THRU P2220-EXIT DTSBD145
|
||||
00392 END-IF DTSBD145
|
||||
00393 ELSE DTSBD145
|
||||
00394 DISPLAY 'NO QUARTER ' ARPT-BATCH-NO DTSBD145
|
||||
00395 ' ' ARPT-ITEM-NO ' ' ARPT-EMP-NO DTSBD145
|
||||
00396 GO TO P2200-EXIT DTSBD145
|
||||
00397 END-IF. DTSBD145
|
||||
00398 DTSBD145
|
||||
00399 P2200-EXIT. DTSBD145
|
||||
00400 EXIT. DTSBD145
|
||||
00401 DTSBD145
|
||||
00402 P2210-NOT-LIABLE. DTSBD145
|
||||
00403 DISPLAY ' P2210 ' ARPT-EMP-NO. DTSBD145
|
||||
00404 PERFORM P2300-UPD-HDR THRU P2300-EXIT. DTSBD145
|
||||
00405 DTSBD145
|
||||
00406 MOVE 'NOT LIABLE' TO W-NL-TYPE. DTSBD145
|
||||
00407 PERFORM P2400-WRITE-F145 THRU P2400-EXIT. DTSBD145
|
||||
00408 PERFORM S923-DELETE THRU S923-EXIT. DTSBD145
|
||||
00409 PERFORM P2500-NOTEPAD THRU P2500-EXIT. DTSBD145
|
||||
00410 ADD +1 TO W-TRAN-DELETE-CNT. DTSBD145
|
||||
00411 DTSBD145
|
||||
00412 DISPLAY 'NOT LIABLE ' MPRF-EMP-NO ' ' ARPT-YRQ DTSBD145
|
||||
00413 ' ' ARPT-BATCH-NO ' ' ARPT-ITEM-NO. DTSBD145
|
||||
00414 DTSBD145
|
||||
00415 P2210-EXIT. DTSBD145
|
||||
00416 EXIT. DTSBD145
|
||||
00417 DTSBD145
|
||||
00418 P2220-FIRST-LIAB-QTR. DTSBD145
|
||||
00419 DISPLAY ' P2220 ' ARPT-EMP-NO. DTSBD145
|
||||
00420 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBD145
|
||||
00421 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBD145
|
||||
00422 SET MSOL-SOL-88 TO TRUE. DTSBD145
|
||||
00423 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBD145
|
||||
00424 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD145
|
||||
00425 DTSBD145
|
||||
00426 PERFORM UNTIL L910-NO-REC-88 DTSBD145
|
||||
00427 MOVE MSKL-REC TO MSOL-REC DTSBD145
|
||||
00428 IF ARPT-YRQ = MSOL-FIRST-LIAB-YRQ DTSBD145
|
||||
00429 PERFORM P2300-UPD-HDR THRU P2300-EXIT DTSBD145
|
||||
00430 MOVE 'FIRST LIAB QTR ZERO WAGE' DTSBD145
|
||||
00431 TO W-NL-TYPE DTSBD145
|
||||
00432 PERFORM P2400-WRITE-F145 THRU P2400-EXIT DTSBD145
|
||||
00433 PERFORM S923-DELETE THRU S923-EXIT DTSBD145
|
||||
00434 PERFORM P2500-NOTEPAD THRU P2500-EXIT DTSBD145
|
||||
00435 ADD +1 TO W-TRAN-DELETE-CNT DTSBD145
|
||||
00436 DISPLAY 'FIRST LIAB QTR ZERO WAGE ' MPRF-EMP-NO DTSBD145
|
||||
00437 ' ' ARPT-YRQ ' ' ARPT-BATCH-NO DTSBD145
|
||||
00438 ' ' ARPT-ITEM-NO DTSBD145
|
||||
00439 SET L910-NO-REC-88 TO TRUE DTSBD145
|
||||
00440 ELSE DTSBD145
|
||||
00441 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD145
|
||||
00442 END-IF DTSBD145
|
||||
00443 DTSBD145
|
||||
00444 END-PERFORM. DTSBD145
|
||||
00445 DTSBD145
|
||||
00446 P2220-EXIT. DTSBD145
|
||||
00447 EXIT. DTSBD145
|
||||
00448 DTSBD145
|
||||
00449 P2300-UPD-HDR. DTSBD145
|
||||
00450 SET W-REWRITE-YES-88 TO TRUE. DTSBD145
|
||||
00451 DISPLAY 'CTL CNT ' AHDR-CONTROL-TRAN-CNT. DTSBD145
|
||||
00452 SUBTRACT +1 FROM AHDR-CONTROL-TRAN-CNT DTSBD145
|
||||
00453 AHDR-ATC-FILE-TRAN-CNT. DTSBD145
|
||||
00454 DTSBD145
|
||||
00455 P2300-EXIT. DTSBD145
|
||||
00456 EXIT. DTSBD145
|
||||
00457 DTSBD145
|
||||
00458 P2400-WRITE-F145. DTSBD145
|
||||
00459 MOVE ARPT-BATCH-NO TO W-NL-BATCH. DTSBD145
|
||||
00460 MOVE ARPT-ITEM-NO TO W-NL-ITEM. DTSBD145
|
||||
00461 MOVE ARPT-EMP-NO TO W-NL-EMP. DTSBD145
|
||||
00462 MOVE ARPT-YRQ TO L004-QTR-5-9. DTSBD145
|
||||
00463 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD145
|
||||
00464 MOVE L004-SLASH-5-QTR TO W-NL-QTR. DTSBD145
|
||||
00465 DTSBD145
|
||||
00466 WRITE NOT-LIABLE-REC FROM W-NL-REC. DTSBD145
|
||||
00467 DTSBD145
|
||||
00468 P2400-EXIT. DTSBD145
|
||||
00469 EXIT. DTSBD145
|
||||
00470 DTSBD145
|
||||
00471 P2500-NOTEPAD. DTSBD145
|
||||
00472 DISPLAY ' P2500 ' ARPT-EMP-NO. DTSBD145
|
||||
00473 MOVE LOW-VALUES TO MNTE-KEY-AREA. DTSBD145
|
||||
00474 MOVE MPRF-EMP-NO TO MNTE-EMP-NO. DTSBD145
|
||||
00475 SET MNTE-NTE-88 TO TRUE. DTSBD145
|
||||
00476 MOVE +0 TO MNTE-PURGE-DATE. DTSBD145
|
||||
00477 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBD145
|
||||
00478 DTSBD145
|
||||
00479 MOVE L005-DATE TO MNTE-ESTB-DATE DTSBD145
|
||||
00480 MNTE-CHNG-DATE. DTSBD145
|
||||
00481 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBD145
|
||||
00482 MNTE-DATA-ESTB-ABSTIME DTSBD145
|
||||
00483 MNTE-CHNG-ABSTIME. DTSBD145
|
||||
00484 MOVE 'SYSTEM' TO MNTE-ESTB-OP-ID DTSBD145
|
||||
00485 MNTE-CHNG-OP-ID. DTSBD145
|
||||
00486 MOVE 'REPORT TRANSACTION DELETED ZERO WAGES' DTSBD145
|
||||
00487 TO MNTE-SUBJECT. DTSBD145
|
||||
00488 DTSBD145
|
||||
00489 MOVE +3 TO MNTE-TEXT-CNT. DTSBD145
|
||||
00490 DTSBD145
|
||||
00491 MOVE WRK-MNTE-MSG-LINE1 TO MNTE-TEXT (1). DTSBD145
|
||||
00492 MOVE WRK-MNTE-MSG-LINE2 TO MNTE-TEXT (2). DTSBD145
|
||||
00493 MOVE WRK-MNTE-MSG-LINE3 TO MNTE-TEXT (3). DTSBD145
|
||||
00494 PERFORM P2510-WRITE-T003 THRU P2510-EXIT. DTSBD145
|
||||
00495 DTSBD145
|
||||
00496 P2500-EXIT. DTSBD145
|
||||
00497 EXIT. DTSBD145
|
||||
00498 P2510-WRITE-T003. DTSBD145
|
||||
00499 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBD145
|
||||
00500 MOVE MNTE-REC TO T003-MNTE-REC. DTSBD145
|
||||
00501 DTSBD145
|
||||
00502 MOVE T003-REC TO TSKL-REC. DTSBD145
|
||||
00503 PERFORM S927-WRITE THRU S927-EXIT. DTSBD145
|
||||
00504 ADD +1 TO WRK-T003-CNT. DTSBD145
|
||||
00505 DTSBD145
|
||||
00506 P2510-EXIT. DTSBD145
|
||||
00507 EXIT. DTSBD145
|
||||
00508 DTSBD145
|
||||
00509 DTSBD145
|
||||
00510 DTSBD145
|
||||
00511 T0000-TERMINATE. DTSBD145
|
||||
00512 DISPLAY ' '. DTSBD145
|
||||
00513 DTSBD145
|
||||
00514 DISPLAY '*** DTSBD145 TERMINATION STATISTICS ***'. DTSBD145
|
||||
00515 DISPLAY SPACE. DTSBD145
|
||||
00516 DISPLAY ' TRANSACTIONS DELETED: ' W-TRAN-DELETE-CNT. DTSBD145
|
||||
00517 DISPLAY ' HEADERS UPDATED : ' W-HDR-UPDATE-CNT. DTSBD145
|
||||
00518 DISPLAY ' NO OF NOTEPAD REC ADDED : ' WRK-T003-CNT. DTSBD145
|
||||
00519 DTSBD145
|
||||
00520 CLOSE NOT-LIABLE-FILE. DTSBD145
|
||||
00521 DTSBD145
|
||||
00522 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD145
|
||||
00523 PERFORM S923-CLOSE THRU S923-EXIT. DTSBD145
|
||||
00524 PERFORM S927-CLOSE THRU S927-EXIT. DTSBD145
|
||||
00525 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD145
|
||||
00526 DTSBD145
|
||||
00527 T0000-EXIT. DTSBD145
|
||||
00528 EXIT. DTSBD145
|
||||
00529 DTSBD145
|
||||
00530 S001-FROM-FED-8. DTSBD145
|
||||
00531 SET L001-FROM-FED-8 TO TRUE. DTSBD145
|
||||
00532 GO TO S001-DATE. DTSBD145
|
||||
00533 DTSBD145
|
||||
00534 S001-FROM-CAL-8. DTSBD145
|
||||
00535 SET L001-FROM-CAL-8 TO TRUE. DTSBD145
|
||||
00536 GO TO S001-DATE. DTSBD145
|
||||
00537 DTSBD145
|
||||
00538 S001-FROM-ABS-DAY. DTSBD145
|
||||
00539 SET L001-FROM-ABS-DAY TO TRUE. DTSBD145
|
||||
00540 GO TO S001-DATE. DTSBD145
|
||||
00541 DTSBD145
|
||||
00542 S001-DATE. DTSBD145
|
||||
00543 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD145
|
||||
00544 S001-EXIT. DTSBD145
|
||||
00545 EXIT. DTSBD145
|
||||
00546 DTSBD145
|
||||
00547 S003-AGENCY-DAY. DTSBD145
|
||||
00548 SET L003-AGENCY-DAY TO TRUE. DTSBD145
|
||||
00549 GO TO S003-WORK-DAY. DTSBD145
|
||||
00550 DTSBD145
|
||||
00551 S003-WORK-DAY. DTSBD145
|
||||
00552 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBD145
|
||||
00553 S003-EXIT. DTSBD145
|
||||
00554 EXIT. DTSBD145
|
||||
00555 DTSBD145
|
||||
00556 S004-FROM-5. DTSBD145
|
||||
00557 SET L004-FROM-5 TO TRUE. DTSBD145
|
||||
00558 GO TO S004-YRQ. DTSBD145
|
||||
00559 DTSBD145
|
||||
00560 S004-FROM-DATE. DTSBD145
|
||||
00561 SET L004-FROM-DATE TO TRUE. DTSBD145
|
||||
00562 GO TO S004-YRQ. DTSBD145
|
||||
00563 DTSBD145
|
||||
00564 S004-FROM-ABS. DTSBD145
|
||||
00565 SET L004-FROM-ABS TO TRUE. DTSBD145
|
||||
00566 GO TO S004-YRQ. DTSBD145
|
||||
00567 DTSBD145
|
||||
00568 S004-YRQ. DTSBD145
|
||||
00569 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD145
|
||||
00570 DTSBD145
|
||||
00571 S004-EXIT. DTSBD145
|
||||
00572 EXIT. DTSBD145
|
||||
00573 DTSBD145
|
||||
00574 S005-FROM-SYS. DTSBD145
|
||||
00575 SET L005-FROM-SYS TO TRUE. DTSBD145
|
||||
00576 GO TO S005-ABSTIME. DTSBD145
|
||||
00577 DTSBD145
|
||||
00578 S005-ABSTIME. DTSBD145
|
||||
00579 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD145
|
||||
00580 S005-EXIT. DTSBD145
|
||||
00581 EXIT. DTSBD145
|
||||
00582 DTSBD145
|
||||
00583 S516-LIABILITY-INFO. DTSBD145
|
||||
00584 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD145
|
||||
00585 MPRF-REC. DTSBD145
|
||||
00586 S516-EXIT. DTSBD145
|
||||
00587 EXIT. DTSBD145
|
||||
00588 DTSBD145
|
||||
00589 S910-OPEN-READ. DTSBD145
|
||||
00590 SET L910-OPEN-READ-88 TO TRUE. DTSBD145
|
||||
00591 GO TO S910-MSTR-IO. DTSBD145
|
||||
00592 DTSBD145
|
||||
00593 S910-READ. DTSBD145
|
||||
00594 SET L910-READ-88 TO TRUE. DTSBD145
|
||||
00595 GO TO S910-MSTR-IO. DTSBD145
|
||||
00596 DTSBD145
|
||||
00597 S910-START-BROWSE. DTSBD145
|
||||
00598 SET L910-START-BROWSE-88 TO TRUE. DTSBD145
|
||||
00599 GO TO S910-MSTR-IO. DTSBD145
|
||||
00600 DTSBD145
|
||||
00601 S910-READ-NEXT. DTSBD145
|
||||
00602 SET L910-READ-NEXT-88 TO TRUE. DTSBD145
|
||||
00603 GO TO S910-MSTR-IO. DTSBD145
|
||||
00604 DTSBD145
|
||||
00605 S910-CLOSE. DTSBD145
|
||||
00606 SET L910-CLOSE-88 TO TRUE. DTSBD145
|
||||
00607 GO TO S910-MSTR-IO. DTSBD145
|
||||
00608 DTSBD145
|
||||
00609 S910-MSTR-IO. DTSBD145
|
||||
00610 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD145
|
||||
00611 MSKL-REC. DTSBD145
|
||||
00612 S910-EXIT. DTSBD145
|
||||
00613 EXIT. DTSBD145
|
||||
00614 DTSBD145
|
||||
00615 S923-OPEN-UPDATE. DTSBD145
|
||||
00616 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBD145
|
||||
00617 GO TO S923-ATC-IO. DTSBD145
|
||||
00618 DTSBD145
|
||||
00619 S923-OPEN-READ. DTSBD145
|
||||
00620 SET L923-OPEN-READ-88 TO TRUE. DTSBD145
|
||||
00621 GO TO S923-ATC-IO. DTSBD145
|
||||
00622 DTSBD145
|
||||
00623 S923-READ. DTSBD145
|
||||
00624 SET L923-READ-88 TO TRUE. DTSBD145
|
||||
00625 GO TO S923-ATC-IO. DTSBD145
|
||||
00626 DTSBD145
|
||||
00627 S923-START-BROWSE. DTSBD145
|
||||
00628 SET L923-START-BROWSE-88 TO TRUE. DTSBD145
|
||||
00629 GO TO S923-ATC-IO. DTSBD145
|
||||
00630 DTSBD145
|
||||
00631 S923-READ-NEXT. DTSBD145
|
||||
00632 SET L923-READ-NEXT-88 TO TRUE. DTSBD145
|
||||
00633 GO TO S923-ATC-IO. DTSBD145
|
||||
00634 DTSBD145
|
||||
00635 *S923-WRITE. DTSBD145
|
||||
00636 *****SET L923-WRITE-88 TO TRUE. DTSBD145
|
||||
00637 *****GO TO S923-ATC-IO. DTSBD145
|
||||
00638 DTSBD145
|
||||
00639 S923-REWRITE. DTSBD145
|
||||
00640 SET L923-REWRITE-88 TO TRUE. DTSBD145
|
||||
00641 GO TO S923-ATC-IO. DTSBD145
|
||||
00642 DTSBD145
|
||||
00643 S923-DELETE. DTSBD145
|
||||
00644 SET L923-DELETE-88 TO TRUE. DTSBD145
|
||||
00645 GO TO S923-ATC-IO. DTSBD145
|
||||
00646 DTSBD145
|
||||
00647 S923-CLOSE. DTSBD145
|
||||
00648 SET L923-CLOSE-88 TO TRUE. DTSBD145
|
||||
00649 GO TO S923-ATC-IO. DTSBD145
|
||||
00650 DTSBD145
|
||||
00651 S923-ATC-IO. DTSBD145
|
||||
00652 CALL 'DTSBU923' USING L923-LINK-AREA DTSBD145
|
||||
00653 ASKL-REC. DTSBD145
|
||||
00654 S923-EXIT. DTSBD145
|
||||
00655 EXIT. DTSBD145
|
||||
00656 DTSBD145
|
||||
00657 S927-OPEN-UPDATE. DTSBD145
|
||||
00658 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD145
|
||||
00659 GO TO S927-BTC-O. DTSBD145
|
||||
00660 DTSBD145
|
||||
00661 S927-WRITE. DTSBD145
|
||||
00662 SET L927-WRITE-88 TO TRUE. DTSBD145
|
||||
00663 GO TO S927-BTC-O. DTSBD145
|
||||
00664 DTSBD145
|
||||
00665 S927-CLOSE. DTSBD145
|
||||
00666 SET L927-CLOSE-88 TO TRUE. DTSBD145
|
||||
00667 GO TO S927-BTC-O. DTSBD145
|
||||
00668 DTSBD145
|
||||
00669 S927-BTC-O. DTSBD145
|
||||
00670 CALL 'DTSBU927' USING L927-LINK-AREA DTSBD145
|
||||
00671 TSKL-REC. DTSBD145
|
||||
00672 S927-EXIT. DTSBD145
|
||||
00673 EXIT. DTSBD145
|
||||
00674 SKIP3 DTSBD145
|
||||
00675 S931-OPEN-READ. DTSBD145
|
||||
00676 SET L931-OPEN-READ-88 TO TRUE. DTSBD145
|
||||
00677 GO TO S931-REF-IO. DTSBD145
|
||||
00678 DTSBD145
|
||||
00679 S931-CLOSE. DTSBD145
|
||||
00680 SET L931-CLOSE-88 TO TRUE. DTSBD145
|
||||
00681 GO TO S931-REF-IO. DTSBD145
|
||||
00682 DTSBD145
|
||||
00683 S931-REF-IO. DTSBD145
|
||||
00684 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD145
|
||||
00685 FSKL-REC. DTSBD145
|
||||
00686 S931-EXIT. DTSBD145
|
||||
00687 EXIT. DTSBD145
|
||||
00688 DTSBD145
|
||||
00689 *S947-WRITE-R907. DTSBD145
|
||||
00690 * CALL 'DTSBU947' USING R907-REC. DTSBD145
|
||||
00691 * GO TO S947-EXIT. DTSBD145
|
||||
00692 * DTSBD145
|
||||
00693 *S947-EXIT. DTSBD145
|
||||
00694 * EXIT. DTSBD145
|
||||
00695 DTSBD145
|
||||
00696 S999-ABEND. DTSBD145
|
||||
00697 CALL 'DTSBU999' USING W-ABEND-CD. DTSBD145
|
||||
00698 S999-EXIT. DTSBD145
|
||||
00699 EXIT. DTSBD145
|
||||
Reference in New Issue
Block a user