All Z' modified PROD server code merge 09/10/2025
This commit is contained in:
@ -35,6 +35,10 @@
|
||||
00035 * 02/23/2009 MODIFIED SELECTION TO INCLUDE DC GOV WAGES DESBD310
|
||||
00036 * REFERENCE: PROGRAMMER: GD DESBD310
|
||||
00037 * DESBD310
|
||||
00034 * DESBD310
|
||||
00035 * 10/04/2025 MODIFIED SELECTION TO use 18 byte wwgh DESBD310
|
||||
00036 * copybook : PROGRAMMER: zl1 DESBD310
|
||||
00037 * DESBD310
|
||||
00038 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD310
|
||||
00039 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD310
|
||||
00040 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD310
|
||||
|
||||
519
Batch/DESBD470.cob
Normal file
519
Batch/DESBD470.cob
Normal file
@ -0,0 +1,519 @@
|
||||
00001 IDENTIFICATION DIVISION. 01/24/24
|
||||
00002 PROGRAM-ID. DESBD470. DESBD470
|
||||
00003 AUTHOR. NGC. LV131
|
||||
00004 DATE-WRITTEN. DECEMBER 2012. CL113
|
||||
00005 DATE-COMPILED. DESBD470
|
||||
00006 SKIP3 DESBD470
|
||||
00007 ***** DESBD470
|
||||
00008 * DESBD470
|
||||
00009 * ZUNCTION: DELETE WAGES TO WGH FILE FOR TESTING. CL129
|
||||
00010 * FOR TAX WAGES SINCE UIBS 01/21/24 ZL1 CL117
|
||||
00011 * DESBD470
|
||||
00012 * DESBD470
|
||||
00013 * MODIFICATION LOG: DESBD470
|
||||
00014 * DESBD470
|
||||
00015 * 12/06/2012 INITIAL DEVELOPMENT. CL113
|
||||
00016 * WORK ORDER: PROGRAMMER: GD DESBD470
|
||||
00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD470
|
||||
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD470
|
||||
00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD470
|
||||
00020 * DESBD470
|
||||
00021 * DESBD470
|
||||
00022 * DESCRIPTION: DESBD470
|
||||
00023 * DESBD470
|
||||
00024 * CL*89
|
||||
00025 * CL*89
|
||||
00026 * CL*89
|
||||
00027 * CL*89
|
||||
00028 * DESBD470
|
||||
00029 * CL*89
|
||||
00030 * CL*89
|
||||
00031 * CL*89
|
||||
00032 * CL*89
|
||||
00033 * DESBD470
|
||||
00034 * GENERAL SPECIFICATIONS: DESBD470
|
||||
00035 * DESBD470
|
||||
00036 * ALL COMMANDS ARE VALID. DESBD470
|
||||
00037 * DESBD470
|
||||
00038 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DESBD470
|
||||
00039 * MODULE. DESBD470
|
||||
00040 * DESBD470
|
||||
00041 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DESBD470
|
||||
00042 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DESBD470
|
||||
00043 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DESBD470
|
||||
00044 * DESBD470
|
||||
00045 * DESBD470
|
||||
00046 * DESBD470
|
||||
00047 * COMMAND SPECIFIC SPECIFICATIONS: DESBD470
|
||||
00048 * DESBD470
|
||||
00049 * OPEN-READ DESBD470
|
||||
00050 * OPEN INPUT. DESBD470
|
||||
00051 * DESBD470
|
||||
00052 * OPEN-UPDATE DESBD470
|
||||
00053 * OPEN I-O. DESBD470
|
||||
00054 * DESBD470
|
||||
00055 * CLOSE DESBD470
|
||||
00056 * DESBD470
|
||||
00057 * READ DESBD470
|
||||
00058 * DESBD470
|
||||
00059 * START BROWSE DESBD470
|
||||
00060 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DESBD470
|
||||
00061 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DESBD470
|
||||
00062 * A RECORD. DESBD470
|
||||
00063 * DESBD470
|
||||
00064 * READ NEXT DESBD470
|
||||
00065 * DESBD470
|
||||
00066 * WRITE DESBD470
|
||||
00067 * DESBD470
|
||||
00068 * REWRITE DESBD470
|
||||
00069 * DESBD470
|
||||
00070 * DELETE DESBD470
|
||||
00071 * DESBD470
|
||||
00072 * DESBD470
|
||||
00073 ***** DESBD470
|
||||
00074 CL114
|
||||
00075 ENVIRONMENT DIVISION. CL114
|
||||
00076 CL114
|
||||
00077 INPUT-OUTPUT SECTION. CL114
|
||||
00078 DESBD470
|
||||
00079 FILE-CONTROL. CL114
|
||||
00080 SELECT WAGE-TRANS-FILE ASSIGN TO DTSFWTRN CL114
|
||||
00081 FILE STATUS IS WAGE-TRANS-STATUS. CL114
|
||||
00082 CL114
|
||||
00083 * SELECT TAXWGH-FILE ASSIGN TO DTSXWGH CL129
|
||||
00084 * FILE STATUS IS DOWNLOAD-STATUS. CL129
|
||||
00085 DESBD470
|
||||
00086 DATA DIVISION. DESBD470
|
||||
00087 CL114
|
||||
00088 FILE SECTION. CL114
|
||||
00089 CL114
|
||||
00090 FD WAGE-TRANS-FILE CL114
|
||||
00091 RECORDING MODE IS F CL114
|
||||
00092 BLOCK CONTAINS 0 RECORDS. CL114
|
||||
00093 CL114
|
||||
00094 01 WAGE-TRANS-REC PIC X(80). CL131
|
||||
00095 CL114
|
||||
00096 *FD TAXWGH-FILE CL129
|
||||
00097 * RECORDING MODE IS F CL129
|
||||
00098 * BLOCK CONTAINS 0 RECORDS. CL129
|
||||
00099 CL117
|
||||
00100 *01 TAXWGH-REC PIC X(18). CL129
|
||||
00101 DESBD470
|
||||
00102 WORKING-STORAGE SECTION. DESBD470
|
||||
001025 77 PAN-VALET PICTURE X(24) VALUE '131DESBD470 01/24/24'. DESBD470
|
||||
00103 SKIP3 DESBD470
|
||||
00104 01 WRK-AREA. DESBD470
|
||||
00105 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +480. CL114
|
||||
00106 DESBD470
|
||||
00107 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU480'. CL114
|
||||
00108 DESBD470
|
||||
00109 05 W-CURR-EMP-NO PIC S9(06) COMP-3 VALUE +0. DESBD470
|
||||
00110 05 W-CURR-YRQ PIC S9(05) COMP-3 CL*62
|
||||
00111 VALUE +20121. CL*62
|
||||
00112 05 W-CURR-BATCH PIC S9(05) COMP-3 VALUE +0. CL*53
|
||||
00113 05 W-CURR-ITEM PIC S9(03) COMP-3 VALUE +0. CL*81
|
||||
00114 05 W-MQTR-TOT-WAGE PIC S9(11)V99 COMP-3 CL*58
|
||||
00115 VALUE +0. CL*58
|
||||
00116 05 W-WTC-BATCH-NO PIC S9(05) COMP-3 CL*90
|
||||
00117 VALUE +90001. CL*95
|
||||
00118 05 W-WTC-ITEM-NO PIC S9(03) COMP-3 CL*90
|
||||
00119 VALUE +003. CL*98
|
||||
00120 05 W-WTC-SEQ-NO PIC S9(03) COMP-3 CL*92
|
||||
00121 VALUE +001. CL*92
|
||||
00122 05 W-MAX-BATCH PIC S9(05) COMP-3 VALUE +0. CL*52
|
||||
00123 05 W-MIN-BATCH PIC S9(05) COMP-3 CL*52
|
||||
00124 VALUE +99999. CL*52
|
||||
00125 05 WRK-W2-CNT PIC S9(07) COMP-3 VALUE +0. DESBD470
|
||||
00126 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DESBD470
|
||||
00127 05 WRK-WWGH-CNT PIC S9(07) COMP-3 VALUE +0. DESBD470
|
||||
00128 05 WRK-DELETE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD470
|
||||
00129 05 W-BYPASSED-CNT PIC S9(07) COMP-3 VALUE +0. DESBD470
|
||||
00130 05 W-BACKLOG PIC S9(07) COMP-3 VALUE +0. CL**9
|
||||
00131 05 AMT-DISP1 PIC ----------9.99. CL*60
|
||||
00132 05 AMT-DISP2 PIC ----------9.99. CL*60
|
||||
00133 05 AMT-DISP3 PIC ----------9.99. CL*60
|
||||
00134 05 AMT-DISP4 PIC ----------9.99. CL*57
|
||||
00135 DESBD470
|
||||
00136 05 WRK-NET-WAGE PIC S9(11)V99 COMP-3 DESBD470
|
||||
00137 VALUE +0. DESBD470
|
||||
00138 05 W-WGH-WAGE PIC S9(11)V99 COMP-3 CL*70
|
||||
00139 VALUE +0. CL*70
|
||||
00140 05 W-WORKER-CNT PIC S9(07) COMP-3 VALUE +0. CL*63
|
||||
00141 05 W-DIFFERENCE PIC S9(11)V99 COMP-3 CL*63
|
||||
00142 VALUE +0. CL*63
|
||||
00143 DESBD470
|
||||
00144 05 W2-REC-READ PIC 9(9) VALUE 0. CL124
|
||||
00145 05 W4-REC-READ PIC 9(9) VALUE 0. CL124
|
||||
00146 05 W4-REC-FOUND PIC 9(9) VALUE 0. CL124
|
||||
00147 05 W4-REC-ADDED PIC 9(9) VALUE 0. CL124
|
||||
00148 05 W2-REC-DELETED PIC 9(9) VALUE 0. CL124
|
||||
00149 05 W2-REC-FOUND PIC 9(9) VALUE 0. CL124
|
||||
00150 CL123
|
||||
00151 05 W-RESP-OPID PIC X(08). CL*78
|
||||
00152 05 WRK-ERROR-IND PIC X(01). DESBD470
|
||||
00153 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD470
|
||||
00154 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD470
|
||||
00155 DESBD470
|
||||
00156 05 W-EMP-EXISTS-IND PIC X(01). CL*67
|
||||
00157 88 W-EMP-EXISTS-YES-88 VALUE 'Y'. CL*67
|
||||
00158 88 W-EMP-EXISTS-NO-88 VALUE 'N'. CL*67
|
||||
00159 05 W-DELINQUENT-IND PIC X(01). CL*67
|
||||
00160 88 W-DELINQUENT-YES-88 VALUE 'Y'. CL*67
|
||||
00161 88 W-DELINQUENT-NO-88 VALUE 'N'. CL*67
|
||||
00162 05 WAGE-TRANS-STATUS PIC X(02). DESBD470
|
||||
00163 88 WAGE-TRANS-FILE-OK-88 VALUE '00'. DESBD470
|
||||
00164 88 WAGE-TRANS-FILE-NO-REC-88 VALUE '10' '23'. DESBD470
|
||||
00165 88 WAGE-TRANS-FILE-VERIFY-88 VALUE '97'. DESBD470
|
||||
00166 DESBD470
|
||||
00167 05 DOWNLOAD-STATUS PIC X(02). DESBD470
|
||||
00168 88 DOWNLOAD-FILE-OK-88 VALUE '00'. DESBD470
|
||||
00169 DESBD470
|
||||
00170 05 WRK-YRQ PIC 9(05). DESBD470
|
||||
00171 05 FILLER REDEFINES WRK-YRQ. DESBD470
|
||||
00172 10 WRK-YRQ-YEAR PIC 9(04). DESBD470
|
||||
00173 10 WRK-YRQ-QTR PIC 9(01). DESBD470
|
||||
00174 DESBD470
|
||||
00175 05 WRK-YRQ-X. DESBD470
|
||||
00176 10 WRK-YRQ-YEAR-X PIC 9(04). DESBD470
|
||||
00177 10 FILLER PIC X(01) VALUE '/'. DESBD470
|
||||
00178 10 WRK-YRQ-QTR-X PIC 9(01). DESBD470
|
||||
00179 DESBD470
|
||||
00180 01 L004-COMM-AREA. CL*35
|
||||
00181 ++INCLUDE DTSIL004 CL*35
|
||||
00182 CL*35
|
||||
00183 01 L424-LINK-AREA. CL100
|
||||
00184 ++INCLUDE DTSIL424 CL100
|
||||
00185 CL100
|
||||
00186 01 L516-LINK-AREA. CL*48
|
||||
00187 ++INCLUDE DTSIL516 CL*48
|
||||
00188 CL*48
|
||||
00189 01 L910-LINK-AREA. CL*47
|
||||
00190 ++INCLUDE DTSIL910 CL*47
|
||||
00191 CL*47
|
||||
00192 01 X147-REC. CL129
|
||||
00193 ++INCLUDE DTSIX147 CL129
|
||||
00194 CL129
|
||||
00195 01 MSKL-REC. CL*47
|
||||
00196 ++INCLUDE DTSIMSKL CL*47
|
||||
00197 CL*47
|
||||
00198 01 MPRF-REC. CL*47
|
||||
00199 ++INCLUDE DTSIMPRF CL*47
|
||||
00200 CL*47
|
||||
00201 01 MQTR-REC. CL*47
|
||||
00202 ++INCLUDE DTSIMQTR CL*47
|
||||
00203 CL*47
|
||||
00204 01 L931-LINK-AREA. CL*50
|
||||
00205 ++INCLUDE DTSIL931 CL*50
|
||||
00206 CL*50
|
||||
00207 01 FSKL-REC. CL*50
|
||||
00208 ++INCLUDE DTSIFSKL CL*50
|
||||
00209 CL*50
|
||||
00210 01 L981-LINK-AREA. CL*69
|
||||
00211 ++INCLUDE DTSIL981 CL*69
|
||||
00212 CL*69
|
||||
00213 01 WWGH-REC. CL*69
|
||||
00214 ++INCLUDE DTSIWWGH CL*69
|
||||
00215 CL*69
|
||||
00216 01 L983-LINK-AREA. DESBD470
|
||||
00217 ++INCLUDE DTSIL983 DESBD470
|
||||
00218 DESBD470
|
||||
00219 01 WSKL-REC. DESBD470
|
||||
00220 ++INCLUDE DTSIWSKL DESBD470
|
||||
00221 DESBD470
|
||||
00222 01 W001-REC. DESBD470
|
||||
00223 ++INCLUDE DTSIW001 DESBD470
|
||||
00224 DESBD470
|
||||
00225 01 L982-LINK-AREA. DESBD470
|
||||
00226 ++INCLUDE DTSIL982 DESBD470
|
||||
00227 DESBD470
|
||||
00228 01 WNAM-REC. DESBD470
|
||||
00229 ++INCLUDE DTSIWNAM DESBD470
|
||||
00230 CL114
|
||||
00231 01 WAGE-TRANS-AREA. CL131
|
||||
00232 05 ESP-TRANSACTION-AREA PIC X(80). CL131
|
||||
00233 ++INCLUDE EWGTRNW2 CL131
|
||||
00234 CL114
|
||||
00235 PROCEDURE DIVISION. DESBD470
|
||||
00236 DESBD470
|
||||
00237 PERFORM I0000-INIT THRU I0000-EXIT. CL*96
|
||||
00238 IF WRK-ERROR-NO-88 DESBD470
|
||||
00239 PERFORM P0000-PROCESS THRU P0000-EXIT CL114
|
||||
00240 PERFORM T0000-TERM THRU T0000-EXIT DESBD470
|
||||
00241 END-IF. DESBD470
|
||||
00242 DESBD470
|
||||
00243 GOBACK. DESBD470
|
||||
00244 EJECT DESBD470
|
||||
00245 I0000-INIT. DESBD470
|
||||
00246 SET WRK-ERROR-NO-88 TO TRUE. DESBD470
|
||||
00247 DESBD470
|
||||
00248 OPEN INPUT WAGE-TRANS-FILE. CL115
|
||||
00249 IF WAGE-TRANS-FILE-OK-88 CL114
|
||||
00250 OR WAGE-TRANS-FILE-VERIFY-88 CL114
|
||||
00251 NEXT SENTENCE CL114
|
||||
00252 ELSE CL114
|
||||
00253 PERFORM S999-ABEND THRU S999-EXIT CL114
|
||||
00254 END-IF. CL114
|
||||
00255 CL114
|
||||
00256 CL117
|
||||
00257 * OPEN OUTPUT TAXWGH-FILE. CL129
|
||||
00258 * IF WAGE-TRANS-FILE-OK-88 CL129
|
||||
00259 * OR WAGE-TRANS-FILE-VERIFY-88 CL129
|
||||
00260 * NEXT SENTENCE CL129
|
||||
00261 * ELSE CL129
|
||||
00262 * PERFORM S999-ABEND THRU S999-EXIT CL129
|
||||
00263 * END-IF. CL129
|
||||
00264 CL117
|
||||
00265 PERFORM S981A-OPEN-UPDATE THRU S981A-EXIT. CL*89
|
||||
00266 PERFORM S983-OPEN-UPDATE THRU S983-EXIT. CL*89
|
||||
00267 PERFORM S931-OPEN-READ THRU S931-EXIT. CL102
|
||||
00268 CL*35
|
||||
00269 I0000-EXIT. DESBD470
|
||||
00270 EXIT. DESBD470
|
||||
00271 CL*35
|
||||
00272 P0000-PROCESS. CL114
|
||||
00273 READ WAGE-TRANS-FILE INTO ESP-TRANSACTION-AREA CL131
|
||||
00274 CL114
|
||||
00275 PERFORM UNTIL WAGE-TRANS-FILE-NO-REC-88 CL114
|
||||
00276 PERFORM P2000-WGH THRU P2000-EXIT CL115
|
||||
00277 READ WAGE-TRANS-FILE INTO ESP-TRANSACTION-AREA CL131
|
||||
00278 CL114
|
||||
00279 END-PERFORM. CL114
|
||||
00280 CL114
|
||||
00281 P0000-EXIT. CL114
|
||||
00282 EXIT. CL114
|
||||
00283 CL114
|
||||
00284 CL*60
|
||||
00285 P2000-WGH. CL*92
|
||||
00286 IF W2-TRAN-ID = 'W2' CL131
|
||||
00287 ADD 1 TO W2-REC-READ CL131
|
||||
00288 ELSE CL131
|
||||
00289 DISPLAY 'RECORD NOT W2 ' W2-TRAN-ID CL131
|
||||
00290 GO TO P2000-EXIT. CL131
|
||||
00291 CL123
|
||||
00292 MOVE LOW-VALUE TO WWGH-REC. CL*73
|
||||
00293 MOVE W2-ACCOUNT-NUMBER TO WWGH-EMP-NO. CL131
|
||||
00294 MOVE W2-QTR TO WWGH-YRQ CL131
|
||||
00295 MOVE W2-SSN TO WWGH-SSN. CL131
|
||||
00296 * MOVE X147-EARNINGS TO WWGH-EARNINGS. CL130
|
||||
00297 PERFORM S981C-READ THRU S981C-EXIT. CL117
|
||||
00298 IF L981-OK-88 CL117
|
||||
00299 DISPLAY 'WGH REC FOUND ' WWGH-EMP-NO ' ' WWGH-YRQ CL129
|
||||
00300 ' ' WWGH-SSN ' ' WWGH-EARNINGS CL129
|
||||
00301 ELSE CL117
|
||||
00302 DISPLAY 'WGH REC NOT FOUND ' W2-ACCOUNT-NUMBER CL131
|
||||
00303 ' ' W2-SSN ' ' W2-QTR CL131
|
||||
00304 GO TO P2000-EXIT. CL129
|
||||
00305 CL117
|
||||
00306 ADD 1 TO W2-REC-FOUND CL123
|
||||
00307 PERFORM S981E-DELETE THRU S981E-EXIT CL117
|
||||
00308 IF NOT L981-OK-88 CL117
|
||||
00309 DISPLAY 'DELET FAILED ' W2-ACCOUNT-NUMBER CL131
|
||||
00310 ' ' W2-SSN ' ' W2-QTR CL131
|
||||
00311 ELSE CL121
|
||||
00312 ADD 1 TO W2-REC-DELETED CL123
|
||||
00313 DISPLAY 'WAGES DELETED' WWGH-EMP-NO ' ' WWGH-YRQ CL129
|
||||
00314 ' ' WWGH-SSN. CL129
|
||||
00315 GO TO P2000-EXIT. CL117
|
||||
00316 CL117
|
||||
00317 P2000-CONTINUE. CL117
|
||||
00318 * IF W4-TRAN-ID = 'W2' CL129
|
||||
00319 * GO TO P2000-EXIT. CL129
|
||||
00320 CL127
|
||||
00321 * MOVE LOW-VALUE TO WWGH-REC. CL129
|
||||
00322 * MOVE W4-ACCOUNT TO WWGH-EMP-NO. CL129
|
||||
00323 * MOVE W4-QUARTER TO WWGH-YRQ CL129
|
||||
00324 * MOVE W4-SSN TO WWGH-SSN. CL129
|
||||
00325 * MOVE W4-QUARTER-EARNINGS TO WWGH-EARNINGS. CL129
|
||||
00326 CL117
|
||||
00327 * WRITE TAXWGH-REC FROM WWGH-REC. CL129
|
||||
00328 * ADD 1 TO W4-REC-ADDED. CL129
|
||||
00329 * PERFORM S981B-WRITE THRU S981B-EXIT. CL128
|
||||
00330 * IF NOT L981-OK-88 CL128
|
||||
00331 * DISPLAY 'WRITE FAILED ' W4-ACCOUNT ' ' W4-QUARTER CL128
|
||||
00332 * ' ' W4-SSN. CL128
|
||||
00333 CL*73
|
||||
00334 P2000-EXIT. CL*92
|
||||
00335 EXIT. CL*73
|
||||
00336 CL*69
|
||||
00337 T0000-TERM. DESBD470
|
||||
00338 PERFORM S981D-CLOSE THRU S981D-EXIT. CL*73
|
||||
00339 PERFORM S983-CLOSE THRU S983-EXIT. CL*69
|
||||
00340 PERFORM S931-CLOSE THRU S931-EXIT. CL102
|
||||
00341 DESBD470
|
||||
00342 * CLOSE WAGE-TRANS-FILE TAXWGH-FILE. CL130
|
||||
00343 CLOSE WAGE-TRANS-FILE. CL130
|
||||
00344 DESBD470
|
||||
00345 DISPLAY '******************************************' DESBD470
|
||||
00346 DISPLAY '** DTSBZ479 TERMINATION STATISTICS **'. CL*91
|
||||
00347 CL123
|
||||
00348 DISPLAY 'TOTAL W4 TRANS REC READ = ' W4-REC-READ. CL123
|
||||
00349 DISPLAY 'TOTAL W4 TRANS REC FOUND = ' W4-REC-FOUND. CL123
|
||||
00350 DISPLAY 'TOTAL W4 TRANS REC ADDED = ' W4-REC-ADDED. CL123
|
||||
00351 DISPLAY 'TOTAL W2 TRANS REC READ = ' W2-REC-READ. CL123
|
||||
00352 DISPLAY 'TOTAL W2 TRANS REC FOUND = ' W2-REC-FOUND. CL123
|
||||
00353 DISPLAY 'TOTAL W2 TRANS REC DELETED = ' W2-REC-DELETED. CL125
|
||||
00354 DISPLAY ' '. CL123
|
||||
00355 T0000-EXIT. DESBD470
|
||||
00356 EXIT. DESBD470
|
||||
00357 DESBD470
|
||||
00358 S004-EDIT-QTR. CL*35
|
||||
00359 CALL 'DTSBU004' USING L004-COMM-AREA. CL*35
|
||||
00360 CL*35
|
||||
00361 S004-EXIT. CL*35
|
||||
00362 EXIT. CL*35
|
||||
00363 CL*35
|
||||
00364 S516-LIABILITY-INFO. CL*48
|
||||
00365 CALL 'DTSBU516' USING L516-LINK-AREA CL*48
|
||||
00366 MPRF-REC. CL*48
|
||||
00367 S516-EXIT. CL*48
|
||||
00368 EXIT. CL*48
|
||||
00369 CL*48
|
||||
00370 S910-OPEN-READ. CL*47
|
||||
00371 SET L910-OPEN-READ-88 TO TRUE. CL*47
|
||||
00372 GO TO S910-MSTR-IO. CL*47
|
||||
00373 CL*47
|
||||
00374 S910-READ. CL*47
|
||||
00375 SET L910-READ-88 TO TRUE. CL*47
|
||||
00376 GO TO S910-MSTR-IO. CL*47
|
||||
00377 CL*47
|
||||
00378 S910-START-BROWSE. CL*47
|
||||
00379 SET L910-START-BROWSE-88 TO TRUE. CL*49
|
||||
00380 GO TO S910-MSTR-IO. CL*47
|
||||
00381 CL*47
|
||||
00382 S910-READ-NEXT. CL*47
|
||||
00383 SET L910-READ-NEXT-88 TO TRUE. CL*47
|
||||
00384 GO TO S910-MSTR-IO. CL*47
|
||||
00385 CL*47
|
||||
00386 S910-CLOSE. CL*47
|
||||
00387 SET L910-CLOSE-88 TO TRUE. CL*47
|
||||
00388 GO TO S910-MSTR-IO. CL*47
|
||||
00389 CL*47
|
||||
00390 S910-MSTR-IO. CL*47
|
||||
00391 CALL 'DTSBU910' USING L910-LINK-AREA CL*47
|
||||
00392 MSKL-REC. CL*47
|
||||
00393 S910-EXIT. CL*47
|
||||
00394 EXIT. CL*47
|
||||
00395 CL*47
|
||||
00396 S931-OPEN-READ. CL*50
|
||||
00397 SET L931-OPEN-READ-88 TO TRUE. CL*50
|
||||
00398 GO TO S931-REF-IO. CL*50
|
||||
00399 CL*50
|
||||
00400 S931-CLOSE. CL*50
|
||||
00401 SET L931-CLOSE-88 TO TRUE. CL*50
|
||||
00402 GO TO S931-REF-IO. CL*50
|
||||
00403 CL*50
|
||||
00404 S931-REF-IO. CL*50
|
||||
00405 CALL 'DTSBU931' USING L931-LINK-AREA CL*50
|
||||
00406 FSKL-REC. CL*50
|
||||
00407 S931-EXIT. CL*50
|
||||
00408 EXIT. CL*50
|
||||
00409 CL*50
|
||||
00410 S981A-OPEN-UPDATE. CL*89
|
||||
00411 SET L981-OPEN-UPDATE-88 TO TRUE. CL*89
|
||||
00412 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*69
|
||||
00413 CL*69
|
||||
00414 S981A-EXIT. CL*69
|
||||
00415 EXIT. CL*69
|
||||
00416 CL*69
|
||||
00417 S981B-WRITE. CL*91
|
||||
00418 SET L981-WRITE-88 TO TRUE. CL*91
|
||||
00419 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*69
|
||||
00420 CL*69
|
||||
00421 S981B-EXIT. CL*69
|
||||
00422 EXIT. CL*69
|
||||
00423 S981C-READ. CL117
|
||||
00424 SET L981-READ-88 TO TRUE. CL117
|
||||
00425 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL117
|
||||
00426 CL117
|
||||
00427 S981C-EXIT. CL117
|
||||
00428 EXIT. CL117
|
||||
00429 S981E-DELETE. CL118
|
||||
00430 SET L981-DELETE-88 TO TRUE. CL117
|
||||
00431 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL117
|
||||
00432 CL117
|
||||
00433 S981E-EXIT. CL117
|
||||
00434 EXIT. CL117
|
||||
00435 CL*69
|
||||
00436 S981D-CLOSE. CL*69
|
||||
00437 SET L981-CLOSE-88 TO TRUE. CL*69
|
||||
00438 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. CL*69
|
||||
00439 CL*69
|
||||
00440 S981D-EXIT. CL*69
|
||||
00441 EXIT. CL*69
|
||||
00442 CL*69
|
||||
00443 S981Z-WWGH-IO. CL*69
|
||||
00444 CALL 'DTSBU981' USING L981-LINK-AREA CL*69
|
||||
00445 WWGH-REC. CL*69
|
||||
00446 S981Z-EXIT. CL*69
|
||||
00447 EXIT. CL*69
|
||||
00448 CL*69
|
||||
00449 S983-OPEN-UPDATE. DESBD470
|
||||
00450 SET L983-OPEN-UPDATE-88 TO TRUE. DESBD470
|
||||
00451 GO TO S983-WAGE-I. DESBD470
|
||||
00452 DESBD470
|
||||
00453 S983-WRITE. CL*90
|
||||
00454 SET L983-WRITE-88 TO TRUE. CL*90
|
||||
00455 GO TO S983-WAGE-I. DESBD470
|
||||
00456 DESBD470
|
||||
00457 S983-DELETE. DESBD470
|
||||
00458 SET L983-DELETE-88 TO TRUE. DESBD470
|
||||
00459 GO TO S983-WAGE-I. DESBD470
|
||||
00460 DESBD470
|
||||
00461 S983-CLOSE. DESBD470
|
||||
00462 SET L983-CLOSE-88 TO TRUE. DESBD470
|
||||
00463 GO TO S983-WAGE-I. DESBD470
|
||||
00464 DESBD470
|
||||
00465 S983-WAGE-I. DESBD470
|
||||
00466 CALL 'DTSBU983' USING L983-LINK-AREA DESBD470
|
||||
00467 WSKL-REC. DESBD470
|
||||
00468 S983-EXIT. DESBD470
|
||||
00469 EXIT. DESBD470
|
||||
00470 DESBD470
|
||||
00471 S982A-START-BROWSE. DESBD470
|
||||
00472 SET L982-START-BROWSE-88 TO TRUE. DESBD470
|
||||
00473 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD470
|
||||
00474 DESBD470
|
||||
00475 S982A-EXIT. DESBD470
|
||||
00476 EXIT. DESBD470
|
||||
00477 DESBD470
|
||||
00478 S982B-READ-NEXT. DESBD470
|
||||
00479 SET L982-READ-NEXT-88 TO TRUE. DESBD470
|
||||
00480 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD470
|
||||
00481 DESBD470
|
||||
00482 S982B-EXIT. DESBD470
|
||||
00483 EXIT. DESBD470
|
||||
00484 DESBD470
|
||||
00485 S982C-OPEN-READ. DESBD470
|
||||
00486 SET L982-OPEN-READ-88 TO TRUE. DESBD470
|
||||
00487 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD470
|
||||
00488 DESBD470
|
||||
00489 S982C-EXIT. DESBD470
|
||||
00490 EXIT. DESBD470
|
||||
00491 DESBD470
|
||||
00492 S982D-CLOSE. DESBD470
|
||||
00493 SET L982-CLOSE-88 TO TRUE. DESBD470
|
||||
00494 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD470
|
||||
00495 DESBD470
|
||||
00496 S982D-EXIT. DESBD470
|
||||
00497 EXIT. DESBD470
|
||||
00498 DESBD470
|
||||
00499 S982Z-WNAM-IO. DESBD470
|
||||
00500 CALL 'DTSBU982' USING L982-LINK-AREA DESBD470
|
||||
00501 WNAM-REC. DESBD470
|
||||
00502 S982Z-EXIT. DESBD470
|
||||
00503 EXIT. DESBD470
|
||||
00504 DESBD470
|
||||
00505 DESBD470
|
||||
00506 S999-ABEND. DESBD470
|
||||
00507 DISPLAY '*** I/O MODULE ABENDING'. DESBD470
|
||||
00508 DESBD470
|
||||
00509 DISPLAY '*** CMND-CD = ' L983-CMND-CD. DESBD470
|
||||
00510 DESBD470
|
||||
00511 DISPLAY '*** FILE-STATUS = ' WAGE-TRANS-STATUS. DESBD470
|
||||
00512 DESBD470
|
||||
00513 DISPLAY '*** CALLING MODULE = ' L983-MOD-NAME. DESBD470
|
||||
00514 DESBD470
|
||||
00515 DESBD470
|
||||
00516 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD470
|
||||
00517 S999-EXIT. DESBD470
|
||||
00518 EXIT. DESBD470
|
||||
@ -1,5 +1,5 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/02/24
|
||||
00002 PROGRAM-ID. DESBD471. DESBD474
|
||||
00002 PROGRAM-ID. DESBD474. DESBD474
|
||||
00003 AUTHOR. NGC. LV018
|
||||
00004 DATE-WRITTEN. DECEMBER 2012. DESBD474
|
||||
00005 DATE-COMPILED. DESBD474
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/10/24
|
||||
00002 PROGRAM-ID. DESBD471. DESBD475
|
||||
00002 PROGRAM-ID. DESBD475. DESBD475
|
||||
00003 AUTHOR. NGC. LV005
|
||||
00004 DATE-WRITTEN. DECEMBER 2012. DESBD475
|
||||
00005 DATE-COMPILED. DESBD475
|
||||
|
||||
135
Batch/DOESU946.cob
Normal file
135
Batch/DOESU946.cob
Normal file
@ -0,0 +1,135 @@
|
||||
00001 IDENTIFICATION DIVISION. 02/26/01
|
||||
00002 PROGRAM-ID. DOESU946. DOESU946
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002
|
||||
00004 DATE-WRITTEN. DECEMBER 1991. DOESU946
|
||||
00005 DATE-COMPILED. DOESU946
|
||||
00006 DOESU946
|
||||
00007 ***** DOESU946
|
||||
00008 * DOESU946
|
||||
00009 * FUNCTION: VARIABLE LENGTH RECORD (FILE 1) OUTPUT. DOESU946
|
||||
00010 * DOESU946
|
||||
00011 * DOESU946
|
||||
00012 * MODIFICATION LOG: DOESU946
|
||||
00013 * DOESU946
|
||||
00014 * 12/18/91 INITIAL DEVELOPMENT. DOESU946
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DOESU946
|
||||
00016 * DOESU946
|
||||
00017 * 09/30/1998 REVIEWED AND MODIFIED FOR DC. DOESU946
|
||||
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DOESU946
|
||||
00019 * DOESU946
|
||||
00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DOESU946
|
||||
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DOESU946
|
||||
00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DOESU946
|
||||
00023 * DOESU946
|
||||
00024 * DOESU946
|
||||
00025 * DESCRIPTION: DOESU946
|
||||
00026 * DOESU946
|
||||
00027 * DTSBU946 WRITES REPORT RECORDS TO DTSFVRO1. DOESU946
|
||||
00028 * DOESU946
|
||||
00029 * DOESU946
|
||||
00030 ***** DOESU946
|
||||
00031 DOESU946
|
||||
00032 ENVIRONMENT DIVISION. DOESU946
|
||||
00033 DOESU946
|
||||
00034 INPUT-OUTPUT SECTION. DOESU946
|
||||
00035 DOESU946
|
||||
00036 FILE-CONTROL. DOESU946
|
||||
00037 SELECT VAR-FILE ASSIGN TO DOESVRO1 CL**2
|
||||
00038 FILE STATUS IS FILE-STATUS. DOESU946
|
||||
00039 DOESU946
|
||||
00040 DATA DIVISION. DOESU946
|
||||
00041 DOESU946
|
||||
00042 FILE SECTION. DOESU946
|
||||
00043 DOESU946
|
||||
00044 FD VAR-FILE DOESU946
|
||||
00045 RECORDING MODE IS V DOESU946
|
||||
00046 BLOCK CONTAINS 0 RECORDS. DOESU946
|
||||
00047 DOESU946
|
||||
00048 01 FILE-REC. DOESU946
|
||||
00049 ++INCLUDE DTSIRVAR DOESU946
|
||||
00050 EJECT DOESU946
|
||||
00051 WORKING-STORAGE SECTION. DOESU946
|
||||
000515 77 PAN-VALET PICTURE X(24) VALUE '002DOESU946 02/26/01'. DOESU946
|
||||
00052 DOESU946
|
||||
00053 01 WRK-AREA. DOESU946
|
||||
00054 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +946.DOESU946
|
||||
00055 DOESU946
|
||||
00056 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DOESU946
|
||||
00057 DOESU946
|
||||
00058 05 VAR-CHAR-CNT PIC S9(04) COMP. DOESU946
|
||||
00059 DOESU946
|
||||
00060 05 WRK-REC-CNT PIC S9(07) COMP-3. DOESU946
|
||||
00061 DOESU946
|
||||
00062 05 FILE-STATUS PIC X(02). DOESU946
|
||||
00063 88 FILE-OK-88 VALUE '00'. DOESU946
|
||||
00064 EJECT DOESU946
|
||||
00065 01 RLEN-LENGTH-LITERALS. DOESU946
|
||||
00066 ++INCLUDE DTSIRLEN DOESU946
|
||||
00067 EJECT DOESU946
|
||||
00068 LINKAGE SECTION. DOESU946
|
||||
00069 DOESU946
|
||||
00070 01 LINK-REC. DOESU946
|
||||
00071 ++INCLUDE DTSIRVAR DOESU946
|
||||
00072 EJECT DOESU946
|
||||
00073 PROCEDURE DIVISION USING LINK-REC. DOESU946
|
||||
00074 DOESU946
|
||||
00075 IF FIRST-TIME-IND = 'Y' DOESU946
|
||||
00076 PERFORM P1000-OPEN THRU P1000-EXIT DOESU946
|
||||
00077 MOVE +0 TO WRK-REC-CNT DOESU946
|
||||
00078 MOVE 'N' TO FIRST-TIME-IND. DOESU946
|
||||
00079 DOESU946
|
||||
00080 IF RVAR-LENGTH OF LINK-REC = -1 DOESU946
|
||||
00081 DISPLAY '*** ' DOESU946
|
||||
00082 WRK-REC-CNT DOESU946
|
||||
00083 ' DTSFVRO1 RECORDS WRITTEN' DOESU946
|
||||
00084 PERFORM P2000-CLOSE THRU P2000-EXIT DOESU946
|
||||
00085 ELSE DOESU946
|
||||
00086 IF RVAR-LENGTH OF LINK-REC < RLEN-MIN-LENGTH DOESU946
|
||||
00087 OR RVAR-LENGTH OF LINK-REC > RLEN-MAX-LENGTH DOESU946
|
||||
00088 DISPLAY 'RECORD LENGTH: ' RVAR-LENGTH OF LINK-REC DOESU946
|
||||
00089 PERFORM S999-ABEND THRU S999-EXIT DOESU946
|
||||
00090 ELSE DOESU946
|
||||
00091 COMPUTE VAR-CHAR-CNT = RVAR-LENGTH OF LINK-REC - 2 DOESU946
|
||||
00092 MOVE LINK-REC TO FILE-REC DOESU946
|
||||
00093 PERFORM P3000-WRITE THRU P3000-EXIT DOESU946
|
||||
00094 ADD +1 TO WRK-REC-CNT. DOESU946
|
||||
00095 DOESU946
|
||||
00096 GOBACK. DOESU946
|
||||
00097 EJECT DOESU946
|
||||
00098 P1000-OPEN. DOESU946
|
||||
00099 OPEN OUTPUT VAR-FILE. DOESU946
|
||||
00100 DOESU946
|
||||
00101 IF NOT FILE-OK-88 DOESU946
|
||||
00102 DISPLAY 'CANT OPEN VARIABLE LENGTH FILE' DOESU946
|
||||
00103 PERFORM S999-ABEND THRU S999-EXIT. DOESU946
|
||||
00104 P1000-EXIT. DOESU946
|
||||
00105 EXIT. DOESU946
|
||||
00106 DOESU946
|
||||
00107 DOESU946
|
||||
00108 DOESU946
|
||||
00109 P2000-CLOSE. DOESU946
|
||||
00110 CLOSE VAR-FILE. DOESU946
|
||||
00111 IF NOT FILE-OK-88 DOESU946
|
||||
00112 DISPLAY 'CANT CLOSE VARIABLE LENGTH FILE' DOESU946
|
||||
00113 PERFORM S999-ABEND THRU S999-EXIT. DOESU946
|
||||
00114 P2000-EXIT. DOESU946
|
||||
00115 EXIT. DOESU946
|
||||
00116 DOESU946
|
||||
00117 DOESU946
|
||||
00118 DOESU946
|
||||
00119 P3000-WRITE. DOESU946
|
||||
00120 WRITE FILE-REC. DOESU946
|
||||
00121 DOESU946
|
||||
00122 IF NOT FILE-OK-88 DOESU946
|
||||
00123 DISPLAY 'CANT WRITE VARIABLE LENGTH FILE' DOESU946
|
||||
00124 PERFORM S999-ABEND THRU S999-EXIT. DOESU946
|
||||
00125 P3000-EXIT. DOESU946
|
||||
00126 EXIT. DOESU946
|
||||
00127 EJECT DOESU946
|
||||
00128 S999-ABEND. DOESU946
|
||||
00129 DISPLAY '*** I/O MODULE ABENDING'. DOESU946
|
||||
00130 DISPLAY '*** FILE-STATUS = ' FILE-STATUS. DOESU946
|
||||
00131 DOESU946
|
||||
00132 CALL 'DTSBU999' USING WRK-ABEND-CD. DOESU946
|
||||
00133 S999-EXIT. DOESU946
|
||||
00134 EXIT. DOESU946
|
||||
@ -583,8 +583,10 @@
|
||||
00582 GO TO S910-MSTR-IO. DTSBD120
|
||||
00583 DTSBD120
|
||||
00584 S910-MSTR-IO. DTSBD120
|
||||
RCCODE DISPLAY 'START-Time:' CURRENT-DATE.
|
||||
00585 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD120
|
||||
00586 MSKL-REC. DTSBD120
|
||||
RCCODE DISPLAY 'END-Time:' CURRENT-DATE.
|
||||
00587 S910-EXIT. EXIT. DTSBD120
|
||||
00588 SKIP3 DTSBD120
|
||||
00589 S921-OPEN-READ. DTSBD120
|
||||
|
||||
@ -419,7 +419,7 @@
|
||||
00418 P0100-EXIT. DTSBU910
|
||||
00419 EXIT. DTSBU910
|
||||
00420 EJECT DTSBU910
|
||||
00421 P1100-READ. DTSBU910
|
||||
00421 P1100-READ. DTSBU910
|
||||
00422 IF FILE-SUB = +1 DTSBU910
|
||||
00423 MOVE MSKL-KEY-AREA OF LINK-REC DTSBU910
|
||||
00424 TO MSKL-KEY-AREA OF MSTA-SKL-REC DTSBU910
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/27/25
|
||||
00001 IDENTIFICATION DIVISION. 04/03/15
|
||||
00002 PROGRAM-ID. DTSBX418. DTSBX418
|
||||
00003 AUTHOR. NGC. LV052
|
||||
00003 AUTHOR. NGC. LV051
|
||||
00004 DATE-WRITTEN. APRIL 2005. DTSBX418
|
||||
00005 DATE-COMPILED. DTSBX418
|
||||
00006 SKIP3 DTSBX418
|
||||
@ -142,7 +142,7 @@
|
||||
00142 05 SORT-DATA PIC X(512). DTSBX418
|
||||
00143 DTSBX418
|
||||
00144 WORKING-STORAGE SECTION. DTSBX418
|
||||
001445 77 PAN-VALET PICTURE X(24) VALUE '052DTSBX418 08/27/25'. DTSBX418
|
||||
001445 77 PAN-VALET PICTURE X(24) VALUE '051DTSBX418 04/03/15'. DTSBX418
|
||||
00145 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX418 10/07/14'. CL*49
|
||||
00146 77 PAN-VALET PICTURE X(24) VALUE '154DTSBX418 10/07/14'. CL*49
|
||||
00147 SKIP3 DTSBX418
|
||||
@ -566,8 +566,8 @@
|
||||
00565 MOVE W-CURR-RUN-DATE TO LX42-CURR-RUN-DATE. DTSBX418
|
||||
00566 MOVE L005-DATE TO LX42-SYS-DATE. DTSBX418
|
||||
00567 MOVE L005-TIME TO LX42-SYS-TIME. DTSBX418
|
||||
00568 * MOVE ZERO TO LX42-BATCH-NO CL*52
|
||||
00569 MOVE ZERO TO LX42-PSEUDO-BATCH-NO CL*52
|
||||
00568 * MOVE ZERO TO LX42-BATCH-NO DTSBX418
|
||||
00568 MOVE ZERO TO LX42-PSEUDO-BATCH-NO DTSBX418
|
||||
00570 LX42-LAST-DETERM-EMP DTSBX418
|
||||
00571 LX42-RPT-CNT DTSBX418
|
||||
00572 LX42-RPT-REMIT-AMT DTSBX418
|
||||
|
||||
268
Batch/DTSBX802.cob
Normal file
268
Batch/DTSBX802.cob
Normal file
@ -0,0 +1,268 @@
|
||||
00001 IDENTIFICATION DIVISION. 10/07/25
|
||||
00002 PROGRAM-ID. DTSBX802. DTSBX802
|
||||
00003 AUTHOR. NGC. LV011
|
||||
00004 DATE-WRITTEN. OCTOBER 2006. DTSBX802
|
||||
00005 DATE-COMPILED. DTSBX802
|
||||
00006 SKIP3 DTSBX802
|
||||
00007 ***** DTSBX802
|
||||
00008 * DTSBX802
|
||||
00009 * FUNCTION: CREATE FILE OF RELATIONSHIP RECORDS DTSBX802
|
||||
00010 * IN EFFECTIVE DATE, PREDECESSOR, SUCCESSOR DTSBX802
|
||||
00011 * ORDER. USED FOR TRANSFERRING EXPERIENCE. DTSBX802
|
||||
00012 * DTSBX802
|
||||
00013 * >>> THIS PROGRAM CAN RUN IN TWO MODES, BASED ON A PARM. DTSBX802
|
||||
00014 * >>> PARM = 0: SELECT ONLY EXPERIENCE RATING RELATIONSHIPS. DTSBX802
|
||||
00015 * >>> PARM = 1: SELECT ALL RELATIONSHIPS. DTSBX802
|
||||
00016 * >>> THE 'SELECT ALL' SETTING IS USED IN PROCESSING ICESA DTSBX802
|
||||
00017 * >>> REPORTS (DTSBD551). DTSBX802
|
||||
00018 * DTSBX802
|
||||
00019 * 07/11/2019 MODIFIED TO NOT EXCLUDE EMPLOYER FROM THE SUC TAB CL**9
|
||||
00020 * PROGRAM DTSZX800 NEED TO RUN BEFORE THIS PROGRAM CL**9
|
||||
00021 * REBUILT THE PRED/SUCC REL TABLE. CL**9
|
||||
00022 * REFERENCE: PROGRAMMER: ZL1 CL**9
|
||||
00023 * CL**9
|
||||
00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9
|
||||
00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9
|
||||
00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: CL**9
|
||||
00027 * CL**9
|
||||
00028 ***** DTSBX802
|
||||
00029 SKIP3 DTSBX802
|
||||
00030 ENVIRONMENT DIVISION. DTSBX802
|
||||
00031 SKIP2 DTSBX802
|
||||
00032 INPUT-OUTPUT SECTION. DTSBX802
|
||||
00033 DTSBX802
|
||||
00034 FILE-CONTROL. DTSBX802
|
||||
00035 * SELECT SORT-FILE ASSIGN TO SORTFILE. CL*10
|
||||
00036 DTSBX802
|
||||
00037 SELECT ESP-FILE ASSIGN TO DTSFIESP DTSBX802
|
||||
00038 FILE STATUS IS ESP-STATUS. DTSBX802
|
||||
00039 DTSBX802
|
||||
00040 DATA DIVISION. DTSBX802
|
||||
00041 DTSBX802
|
||||
00042 FILE SECTION. DTSBX802
|
||||
00043 DTSBX802
|
||||
00044 *SD SORT-FILE. CL*10
|
||||
00045 DTSBX802
|
||||
00046 *01 SORT-REC. CL*10
|
||||
00047 * 05 SORT-KEY PIC X(16). CL*10
|
||||
00048 DTSBX802
|
||||
00049 FD ESP-FILE DTSBX802
|
||||
00050 RECORDING MODE IS F DTSBX802
|
||||
00051 BLOCK CONTAINS 0 RECORDS DTSBX802
|
||||
00052 LABEL RECORDS ARE OMITTED. DTSBX802
|
||||
00053 DTSBX802
|
||||
00054 01 ESP-FILE-REC PIC X(16). DTSBX802
|
||||
00055 DTSBX802
|
||||
00056 DTSBX802
|
||||
00057 WORKING-STORAGE SECTION. DTSBX802
|
||||
000575 77 PAN-VALET PICTURE X(24) VALUE '011DTSBX802 10/07/25'. DTSBX802
|
||||
00058 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX800 01/16/08'. DTSBX802
|
||||
00059 SKIP3 DTSBX802
|
||||
00060 01 WRK-AREA. DTSBX802
|
||||
00061 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +340. DTSBX802
|
||||
00062 DTSBX802
|
||||
00063 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBZ340'.DTSBX802
|
||||
00064 DTSBX802
|
||||
00065 05 WRK-SRT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX802
|
||||
00066 05 WRK-ESP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX802
|
||||
00067 DTSBX802
|
||||
00068 05 WRK-ERROR-IND PIC X(01). DTSBX802
|
||||
00069 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX802
|
||||
00070 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX802
|
||||
00071 DTSBX802
|
||||
00072 05 ESP-STATUS PIC X(02). DTSBX802
|
||||
00073 88 ESP-STATUS-OK-88 VALUE '00'. DTSBX802
|
||||
00074 DTSBX802
|
||||
00075 05 SORT-STATUS PIC X(02) VALUE '00'. DTSBX802
|
||||
00076 88 SORT-OK-88 VALUE '00'. DTSBX802
|
||||
00077 88 SORT-EOF-88 VALUE '10'. DTSBX802
|
||||
00078 DTSBX802
|
||||
00079 05 WRK-TRACE-IND PIC X(01). DTSBX802
|
||||
00080 DTSBX802
|
||||
00081 05 PCT-DISP PIC 9.9999. DTSBX802
|
||||
00082 DTSBX802
|
||||
00083 05 WRK-ESP-REC. DTSBX802
|
||||
00084 10 WRK-ESP-EFF-DT PIC S9(09) COMP-3. DTSBX802
|
||||
00085 10 WRK-ESP-PRED PIC S9(07) COMP-3. DTSBX802
|
||||
00086 10 WRK-ESP-SUC PIC S9(07) COMP-3. DTSBX802
|
||||
00087 10 WRK-ESP-PCT PIC S9V9(04) COMP-3. DTSBX802
|
||||
00088 DTSBX802
|
||||
00089 01 L921-LINK-AREA. DTSBX802
|
||||
00090 ++INCLUDE DTSIL921 DTSBX802
|
||||
00091 DTSBX802
|
||||
00092 01 ISKL-REC. DTSBX802
|
||||
00093 ++INCLUDE DTSIISKL DTSBX802
|
||||
00094 DTSBX802
|
||||
00095 01 IPES-REC. DTSBX802
|
||||
00096 ++INCLUDE DTSIIPES DTSBX802
|
||||
00097 DTSBX802
|
||||
00098 LINKAGE SECTION. DTSBX802
|
||||
00099 DTSBX802
|
||||
00100 01 PARM-AREA. DTSBX802
|
||||
00101 05 PARM-LENGTH PIC S9(04) COMP. DTSBX802
|
||||
00102 DTSBX802
|
||||
00103 *********************************************************** DTSBX802
|
||||
00104 * PARM = 0: SELECT ONLY 'EXPERIENCE RATING' RELATIONSHIPS. DTSBX802
|
||||
00105 * PARM = 1: SELECT ALL RELATIONSHIPS. DTSBX802
|
||||
00106 *********************************************************** DTSBX802
|
||||
00107 05 PARM-DATA. DTSBX802
|
||||
00108 10 PARM-EMP-NO PIC X(01). DTSBX802
|
||||
00109 88 PARM-RATING-ONLY-88 VALUE '0'. DTSBX802
|
||||
00110 88 PARM-SELECT-ALL-88 VALUE '1'. DTSBX802
|
||||
00111 DTSBX802
|
||||
00112 PROCEDURE DIVISION USING PARM-AREA. DTSBX802
|
||||
00113 DTSBX802
|
||||
00114 DTSBX800-MAIN. DTSBX802
|
||||
00115 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX802
|
||||
00116 IF WRK-ERROR-YES-88 DTSBX802
|
||||
00117 GO TO DTSBX800-MAIN-EXIT. DTSBX802
|
||||
00118 DTSBX802
|
||||
00119 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX802
|
||||
00120 DTSBX802
|
||||
00121 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX802
|
||||
00122 DTSBX802
|
||||
00123 DTSBX800-MAIN-EXIT. DTSBX802
|
||||
00124 GOBACK. DTSBX802
|
||||
00125 EJECT DTSBX802
|
||||
00126 I0000-INITIATE. DTSBX802
|
||||
00127 DTSBX802
|
||||
00128 SET WRK-ERROR-NO-88 TO TRUE. DTSBX802
|
||||
00129 DTSBX802
|
||||
00130 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX802
|
||||
00131 IF WRK-ERROR-YES-88 DTSBX802
|
||||
00132 GO TO I0000-EXIT. DTSBX802
|
||||
00133 DTSBX802
|
||||
00134 I0000-EXIT. DTSBX802
|
||||
00135 EXIT. DTSBX802
|
||||
00136 I1000-OPEN-FILES. DTSBX802
|
||||
00137 MOVE WRK-TRACE-IND TO L921-TRACE-IND. DTSBX802
|
||||
00138 DTSBX802
|
||||
00139 MOVE WRK-MOD-NAME TO L921-MOD-NAME. DTSBX802
|
||||
00140 DTSBX802
|
||||
00141 OPEN OUTPUT ESP-FILE. DTSBX802
|
||||
00142 IF NOT ESP-STATUS-OK-88 DTSBX802
|
||||
00143 DISPLAY 'CANNOT OPEN ESP OUTPUT FILE ' ESP-STATUS DTSBX802
|
||||
00144 SET WRK-ERROR-YES-88 TO TRUE DTSBX802
|
||||
00145 GO TO I1000-EXIT DTSBX802
|
||||
00146 END-IF. DTSBX802
|
||||
00147 PERFORM S921A-OPEN-READ THRU S921A-EXIT. DTSBX802
|
||||
00148 DTSBX802
|
||||
00149 I1000-EXIT. DTSBX802
|
||||
00150 EXIT. DTSBX802
|
||||
00151 DTSBX802
|
||||
00152 EJECT DTSBX802
|
||||
00153 P0000-PROCESS. DTSBX802
|
||||
00154 PERFORM P1000-GET-IPES THRU P1000-EXIT. CL*10
|
||||
00155 DTSBX802
|
||||
00156 P0000-EXIT. DTSBX802
|
||||
00157 EXIT. DTSBX802
|
||||
00158 DTSBX802
|
||||
00159 P1000-GET-IPES. DTSBX802
|
||||
00160 MOVE LOW-VALUES TO IPES-KEY-AREA. DTSBX802
|
||||
00161 SET IPES-PES-88 TO TRUE. DTSBX802
|
||||
00162 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. DTSBX802
|
||||
00163 PERFORM S921B-START-BROWSE THRU S921B-EXIT. DTSBX802
|
||||
00164 DTSBX802
|
||||
00165 PERFORM UNTIL L921-NO-REC-88 DTSBX802
|
||||
00166 MOVE ISKL-REC TO IPES-REC DTSBX802
|
||||
00167 DISPLAY 'TRANSFER EXP RATING ' IPES-SUC-EMP-NO CL**7
|
||||
00168 ' TRANSFER CODE ' IPES-EXP-TRNSF-CD CL**7
|
||||
00169 CL**7
|
||||
00170 IF PARM-RATING-ONLY-88 DTSBX802
|
||||
00171 IF IPES-EXP-TRNSF-YES-88 DTSBX802
|
||||
00172 PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT DTSBX802
|
||||
00173 ADD +1 TO WRK-SRT-CNT DTSBX802
|
||||
00174 END-IF DTSBX802
|
||||
00175 ELSE DTSBX802
|
||||
00176 PERFORM P1100-WRITE-SORT-REC THRU P1100-EXIT DTSBX802
|
||||
00177 ADD +1 TO WRK-SRT-CNT DTSBX802
|
||||
00178 END-IF DTSBX802
|
||||
00179 PERFORM S921D-READ-NEXT THRU S921D-EXIT DTSBX802
|
||||
00180 END-PERFORM. DTSBX802
|
||||
00181 DTSBX802
|
||||
00182 P1000-EXIT. DTSBX802
|
||||
00183 EXIT. DTSBX802
|
||||
00184 DTSBX802
|
||||
00185 P1100-WRITE-SORT-REC. DTSBX802
|
||||
00186 * IF IPES-SUC-EMP-NO = 582326 OR 813262 OR 862472 CL**8
|
||||
00187 * OR 753582 CL**8
|
||||
00188 * DISPLAY 'PASS ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED CL**8
|
||||
00189 * ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT CL**8
|
||||
00190 * GO TO P1100-EXIT. CL**8
|
||||
00191 CL**3
|
||||
00192 MOVE IPES-EFF-DATE TO WRK-ESP-EFF-DT. DTSBX802
|
||||
00193 MOVE IPES-PRED-EMP-NO TO WRK-ESP-PRED. DTSBX802
|
||||
00194 MOVE IPES-SUC-EMP-NO TO WRK-ESP-SUC. DTSBX802
|
||||
00195 MOVE IPES-PERCENT-TRNSFRD TO WRK-ESP-PCT. DTSBX802
|
||||
00196 DTSBX802
|
||||
00197 DISPLAY 'IN ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED CL**2
|
||||
00198 ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT. CL**7
|
||||
00199 DTSBX802
|
||||
00200 P1100-WRITE-ESP. CL*10
|
||||
00201 DTSBX802
|
||||
00202 ** DISPLAY 'OUT ' WRK-ESP-EFF-DT ' ' WRK-ESP-PRED DTSBX802
|
||||
00203 ** ' ' WRK-ESP-SUC ' ' WRK-ESP-PCT. DTSBX802
|
||||
00204 WRITE ESP-FILE-REC FROM WRK-ESP-REC. CL*10
|
||||
00205 IF NOT ESP-STATUS-OK-88 DTSBX802
|
||||
00206 DISPLAY 'CANNOT WRITE ESP REC ' ESP-STATUS DTSBX802
|
||||
00207 GO TO P1100-EXIT CL*11
|
||||
00208 ELSE DTSBX802
|
||||
00209 ADD +1 TO WRK-ESP-CNT DTSBX802
|
||||
00210 END-IF. DTSBX802
|
||||
00211 DTSBX802
|
||||
00212 P1100-EXIT. CL*10
|
||||
00213 EXIT. DTSBX802
|
||||
00214 DTSBX802
|
||||
00215 T0000-TERMINATE. DTSBX802
|
||||
00216 DTSBX802
|
||||
00217 DISPLAY ' '. DTSBX802
|
||||
00218 DTSBX802
|
||||
00219 DISPLAY '*** DTSBX800 TERMINATION STATISTICS ***'. DTSBX802
|
||||
00220 DTSBX802
|
||||
00221 DISPLAY ' '. DTSBX802
|
||||
00222 DTSBX802
|
||||
00223 DISPLAY 'IPES AIX RECORDS READ : ' DTSBX802
|
||||
00224 WRK-SRT-CNT. DTSBX802
|
||||
00225 DTSBX802
|
||||
00226 DISPLAY 'NUMBER OF ESP RECORDS WRITTEN : ' DTSBX802
|
||||
00227 WRK-ESP-CNT. DTSBX802
|
||||
00228 DTSBX802
|
||||
00229 PERFORM S921C-CLOSE THRU S921C-EXIT. DTSBX802
|
||||
00230 DTSBX802
|
||||
00231 T0000-EXIT. DTSBX802
|
||||
00232 EXIT. DTSBX802
|
||||
00233 EJECT DTSBX802
|
||||
00234 S921A-OPEN-READ. DTSBX802
|
||||
00235 SET L921-OPEN-READ-88 TO TRUE. DTSBX802
|
||||
00236 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX802
|
||||
00237 ISKL-REC. DTSBX802
|
||||
00238 S921A-EXIT. DTSBX802
|
||||
00239 EXIT. DTSBX802
|
||||
00240 DTSBX802
|
||||
00241 S921B-START-BROWSE. DTSBX802
|
||||
00242 SET L921-START-BROWSE-88 TO TRUE. DTSBX802
|
||||
00243 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX802
|
||||
00244 ISKL-REC. DTSBX802
|
||||
00245 S921B-EXIT. DTSBX802
|
||||
00246 EXIT. DTSBX802
|
||||
00247 DTSBX802
|
||||
00248 S921C-CLOSE. DTSBX802
|
||||
00249 SET L921-CLOSE-88 TO TRUE. DTSBX802
|
||||
00250 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX802
|
||||
00251 ISKL-REC. DTSBX802
|
||||
00252 S921C-EXIT. DTSBX802
|
||||
00253 EXIT. DTSBX802
|
||||
00254 DTSBX802
|
||||
00255 S921D-READ-NEXT. DTSBX802
|
||||
00256 SET L921-READ-NEXT-88 TO TRUE. DTSBX802
|
||||
00257 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX802
|
||||
00258 ISKL-REC. DTSBX802
|
||||
00259 S921D-EXIT. DTSBX802
|
||||
00260 EXIT. DTSBX802
|
||||
00261 DTSBX802
|
||||
00262 DTSBX802
|
||||
00263 S999-ABEND. DTSBX802
|
||||
00264 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX802
|
||||
00265 S999-EXIT. DTSBX802
|
||||
00266 EXIT. DTSBX802
|
||||
00267 DTSBX802
|
||||
Reference in New Issue
Block a user