3519 lines
275 KiB
COBOL
3519 lines
275 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/27/10
|
|
00002 PROGRAM-ID. DTSCS52. DTSCS52
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV036
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS52
|
|
00005 DATE-COMPILED. DTSCS52
|
|
00006 SKIP3 DTSCS52
|
|
00007 ***** DTSCS52
|
|
00008 * DTSCS52
|
|
00009 * FUNCTION: RATE CUTOFF INQUIRY/UPDATE SCREEN PROCESSOR. DTSCS52
|
|
00010 * DTSCS52
|
|
00011 * DTSCS52
|
|
00012 * MODIFICATION LOG: DTSCS52
|
|
00013 * DTSCS52
|
|
00014 * 08/01/97 MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE DTSCS52
|
|
00015 * PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11. DTSCS52
|
|
00016 * REFERENCE RFP: TCL 096 PROGRAMMER: FLS DTSCS52
|
|
00017 * DTSCS52
|
|
00018 * 01/23/1999 REVIEWED AND MODIFIED FOR DC. DTSCS52
|
|
00019 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS52
|
|
00020 * DTSCS52
|
|
00021 * 06/16/1999 MODIFY ADD CANCEL LOGIC AND MODIFY CANCEL LOGIC DTSCS52
|
|
00022 * TO REVERSE EFFECT OF PSEUDO UPDATE FROM SCREEN. DTSCS52
|
|
00023 * REFERENCE: TPR 06/16/1999 PROGRAMMER: EHH DTSCS52
|
|
00024 * DTSCS52
|
|
00025 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS52
|
|
00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS52
|
|
00027 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS52
|
|
00028 * DTSCS52
|
|
00029 * DTSCS52
|
|
00030 * DESCRIPTION: DTSCS52
|
|
00031 * DTSCS52
|
|
00032 * DTSCS52
|
|
00033 * CLEAR: DTSCS52
|
|
00034 * DTSCS52
|
|
00035 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS52
|
|
00036 * DTSCS52
|
|
00037 * DTSCS52
|
|
00038 * JUMP: DTSCS52
|
|
00039 * DTSCS52
|
|
00040 * NONE DTSCS52
|
|
00041 * DTSCS52
|
|
00042 * DTSCS52
|
|
00043 * INQUIRY: DTSCS52
|
|
00044 * DTSCS52
|
|
00045 * CONTROL FIELDS: MAP-EMP-NO. DTSCS52
|
|
00046 * DTSCS52
|
|
00047 * JUMP IN: IF LCCM-EMP-NO = LCCM-HOLD-SCR52-AREA EMP-NO DTSCS52
|
|
00048 * DISPLAY RECORD INDICATED BY LCCM-HOLD-SCR52-AREADTSCS52
|
|
00049 * ELSE DTSCS52
|
|
00050 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS52
|
|
00051 * WITH LCCM-EMP-NO. DTSCS52
|
|
00052 * DTSCS52
|
|
00053 * ENTER, F5, F6, F7, F8: STANDARD PAGING. DTSCS52
|
|
00054 * DTSCS52
|
|
00055 * DISPLAY SEQUENCE: ASCENDING ON MRCT-EFF-YRQ. DTSCS52
|
|
00056 * DTSCS52
|
|
00057 * PAGE INITIALLY DISPLAYED: LAST DTSCS52
|
|
00058 * DTSCS52
|
|
00059 * DTSCS52
|
|
00060 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE DTSCS52
|
|
00061 * DTSCS52
|
|
00062 * STORE INFORMATION REPRESENTING PAGE CURRENTLY DTSCS52
|
|
00063 * DISPLAYED IN LCCM-SCR52-HOLD-AREA. DTSCS52
|
|
00064 * DTSCS52
|
|
00065 * DTSCS52
|
|
00066 * UPDATE: DTSCS52
|
|
00067 * DTSCS52
|
|
00068 * ADD DTSCS52
|
|
00069 * MOD DTSCS52
|
|
00070 * DEL DTSCS52
|
|
00071 * DTSCS52
|
|
00072 * CHANGING MAP-EFF-YRQ PRIOR TO MOD OR DEL IS AN ERROR. DTSCS52
|
|
00073 * DTSCS52
|
|
00074 * DTSCS52
|
|
00075 * DTSCS52
|
|
00076 * RECORDS READ: DTSCS52
|
|
00077 * DTSCS52
|
|
00078 * MASTER: DTSCS52
|
|
00079 * DTSCS52
|
|
00080 * MPRF DTSCS52
|
|
00081 * MRCT DTSCS52
|
|
00082 * DTSCS52
|
|
00083 * DTSCS52
|
|
00084 * ALTERNATE INDEX: DTSCS52
|
|
00085 * DTSCS52
|
|
00086 * NONE. DTSCS52
|
|
00087 * DTSCS52
|
|
00088 * DTSCS52
|
|
00089 * REFERENCE: DTSCS52
|
|
00090 * DTSCS52
|
|
00091 * NONE. DTSCS52
|
|
00092 * DTSCS52
|
|
00093 * DTSCS52
|
|
00094 * ACCOUNTING TRANSACTION COLLECTION: DTSCS52
|
|
00095 * DTSCS52
|
|
00096 * NONE. DTSCS52
|
|
00097 * DTSCS52
|
|
00098 * DTSCS52
|
|
00099 * RECORDS UPDATED: DTSCS52
|
|
00100 * DTSCS52
|
|
00101 * MASTER: DTSCS52
|
|
00102 * DTSCS52
|
|
00103 * MRCT (WRITE, DELETE, REWRITE). DTSCS52
|
|
00104 * DTSCS52
|
|
00105 * DTSCS52
|
|
00106 * REFERENCE: DTSCS52
|
|
00107 * DTSCS52
|
|
00108 * NONE. DTSCS52
|
|
00109 * DTSCS52
|
|
00110 * DTSCS52
|
|
00111 * ACCOUNTING TRANSACTION COLLECTION: DTSCS52
|
|
00112 * DTSCS52
|
|
00113 * NONE. DTSCS52
|
|
00114 * DTSCS52
|
|
00115 * DTSCS52
|
|
00116 * ON-LINE ACTIVITY FILE RECODS WRITTEN: DTSCS52
|
|
00117 * DTSCS52
|
|
00118 * NONE. DTSCS52
|
|
00119 * DTSCS52
|
|
00120 * DTSCS52
|
|
00121 * TEMPORARY STORAGE USAGE: DTSCS52
|
|
00122 * DTSCS52
|
|
00123 * NONE DTSCS52
|
|
00124 * DTSCS52
|
|
00125 * DTSCS52
|
|
00126 * MODULES LINKED TO: DTSCS52
|
|
00127 * DTSCS52
|
|
00128 * DTSCU001 DATE EDIT/CONVERSION. DTSCS52
|
|
00129 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS52
|
|
00130 * DTSCU006 RATING YEAR/RATING EXPERIENCE PERIOD START/END. DTSCS52
|
|
00131 * DTSCU011 AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS52
|
|
00132 * DTSCU013 COUNT (INTEGER) FROM SCREEN FORMAT/EDIT. DTSCS52
|
|
00133 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS52
|
|
00134 * DTSCU016 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS52
|
|
00135 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS52
|
|
00136 * DTSCU054 UI RATE DETERMINATION FROM MRCT RECORD. DTSCS52
|
|
00137 * DTSCU055 UI RATE EXPERIENCE PERIOD. DTSCS52
|
|
00138 * DTSCU056 RATE DISPLAY. DTSCS52
|
|
00139 * DTSCU057 RESERVE RATIO DISPLAY. DTSCS52
|
|
00140 * DTSCU221 MPRF-UPDATE DATA ELEMENTS MAINTENANCE. DTSCS52
|
|
00141 * DTSCU331 WRITE MLOG RECORDS. DTSCS52
|
|
00142 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS52
|
|
00143 * DTSCS52
|
|
00144 ***** DTSCS52
|
|
00145 DTSCS52
|
|
00146 ENVIRONMENT DIVISION. DTSCS52
|
|
00147 DTSCS52
|
|
00148 DATA DIVISION. DTSCS52
|
|
00149 DTSCS52
|
|
00150 WORKING-STORAGE SECTION. DTSCS52
|
|
001505 77 PAN-VALET PICTURE X(24) VALUE '036DTSCS52 05/27/10'. DTSCS52
|
|
00151 DTSCS52
|
|
00152 01 WRK-AREA. DTSCS52
|
|
00153 05 WRK-ABEND-CD PIC X(04) VALUE 'S52 '. DTSCS52
|
|
00154 DTSCS52
|
|
00155 05 WRK-SCR-ID. DTSCS52
|
|
00156 10 WRK-SCR-ID-N PIC 9(02) VALUE 52. DTSCS52
|
|
00157 DTSCS52
|
|
00158 05 WRK-F03-SCR-ID PIC X(02) VALUE '50'. DTSCS52
|
|
00159 DTSCS52
|
|
00160 DTSCS52
|
|
00161 05 SCR-ACCESS-IND PIC X(01). DTSCS52
|
|
00162 88 SCR-ACCESS-INQ VALUE '1'. DTSCS52
|
|
00163 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS52
|
|
00164 DTSCS52
|
|
00165 DTSCS52
|
|
00166 05 CURSOR-SET-IND PIC X(01). DTSCS52
|
|
00167 88 CURSOR-SET-YES VALUE 'Y'. DTSCS52
|
|
00168 88 CURSOR-SET-NO VALUE 'N'. DTSCS52
|
|
00169 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS52
|
|
00170 DTSCS52
|
|
00171 DTSCS52
|
|
00172 05 REQ-IND PIC X(01). DTSCS52
|
|
00173 88 REQ-ERROR VALUE 'O'. DTSCS52
|
|
00174 88 REQ-JUMP VALUE 'J'. DTSCS52
|
|
00175 88 REQ-INQUIRE VALUE 'I'. DTSCS52
|
|
00176 88 REQ-CLEAR VALUE 'C'. DTSCS52
|
|
00177 88 REQ-EDIT VALUE 'E'. DTSCS52
|
|
00178 88 REQ-UPDATE VALUE 'U'. DTSCS52
|
|
00179 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS52
|
|
00180 DTSCS52
|
|
00181 DTSCS52
|
|
00182 05 RESP-IND PIC X(01). DTSCS52
|
|
00183 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS52
|
|
00184 88 RESP-SEND-MAP VALUE 'M'. DTSCS52
|
|
00185 88 RESP-JUMP VALUE 'J'. DTSCS52
|
|
00186 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS52
|
|
00187 DTSCS52
|
|
00188 DTSCS52
|
|
00189 05 WRK-MSG-AREA PIC X(64). DTSCS52
|
|
00190 DTSCS52
|
|
00191 DTSCS52
|
|
00192 05 WRK-ATB-AN PIC X(01). DTSCS52
|
|
00193 DTSCS52
|
|
00194 05 WRK-ATB-NUM PIC X(01). DTSCS52
|
|
00195 DTSCS52
|
|
00196 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS52
|
|
00197 DTSCS52
|
|
00198 05 WRK-MPRF-IND PIC X(01). DTSCS52
|
|
00199 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS52
|
|
00200 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS52
|
|
00201 DTSCS52
|
|
00202 05 WRK-MRCT-IND PIC X(01). DTSCS52
|
|
00203 88 WRK-MRCT-YES-88 VALUE 'Y'. DTSCS52
|
|
00204 88 WRK-MRCT-NO-88 VALUE 'N'. DTSCS52
|
|
00205 DTSCS52
|
|
00206 05 WRK-CTR PIC S9(04) COMP. DTSCS52
|
|
00207 DTSCS52
|
|
00208 DTSCS52
|
|
00209 05 WRK-DISPLAY PIC 9(11). DTSCS52
|
|
00210 DTSCS52
|
|
00211 05 FILLER REDEFINES WRK-DISPLAY. DTSCS52
|
|
00212 10 FILLER PIC X(08). DTSCS52
|
|
00213 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS52
|
|
00214 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS52
|
|
00215 DTSCS52
|
|
00216 05 FILLER REDEFINES WRK-DISPLAY. DTSCS52
|
|
00217 10 FILLER PIC X(05). DTSCS52
|
|
00218 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS52
|
|
00219 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS52
|
|
00220 DTSCS52
|
|
00221 05 FILLER REDEFINES WRK-DISPLAY. DTSCS52
|
|
00222 10 FILLER PIC 9(05). DTSCS52
|
|
00223 10 WRK-DISPLAY-YR PIC 9(02). DTSCS52
|
|
00224 10 WRK-DISPLAY-MO PIC 9(02). DTSCS52
|
|
00225 10 WRK-DISPLAY-DA PIC 9(02). DTSCS52
|
|
00226 DTSCS52
|
|
00227 DTSCS52
|
|
00228 DTSCS52
|
|
00229 05 INQUIRY-CONTROL-AREA. DTSCS52
|
|
00230 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS52
|
|
00231 DTSCS52
|
|
00232 10 WS-REC-NUM PIC S9(08) COMP. DTSCS52
|
|
00233 DTSCS52
|
|
00234 10 LAST-REC-KEY-AREA PIC X(16). DTSCS52
|
|
00235 DTSCS52
|
|
00236 10 SCR-REC-KEY-AREA PIC X(16). DTSCS52
|
|
00237 DTSCS52
|
|
00238 10 WS-REC-FOUND-IND PIC X(01). DTSCS52
|
|
00239 DTSCS52
|
|
00240 DTSCS52
|
|
00241 01 WRK-HOLD-AREA PIC X(1984). DTSCS52
|
|
00242 DTSCS52
|
|
00243 01 WRK-NUM-N PIC ------,---,--9.99. DTSCS52
|
|
00244 DTSCS52
|
|
00245 01 WRK-MISS-RPT-CNT-N PIC ZZ9. DTSCS52
|
|
00246 DTSCS52
|
|
00247 01 WRK-CHK-NEGATIVE-AMT PIC S9(11)V9(02) COMP-3. DTSCS52
|
|
00248 DTSCS52
|
|
00249 01 WRK-CHK-TOT-WAGE-AMT PIC S9(11)V9(02) COMP-3. DTSCS52
|
|
00250 DTSCS52
|
|
00251 01 WRK-CHK-TAX-WAGE-AMT PIC S9(11)V9(02) COMP-3. DTSCS52
|
|
00252 DTSCS52
|
|
00253 01 WRK-LABEL-AREA. DTSCS52
|
|
00254 05 FILLER PIC X(14). DTSCS52
|
|
00255 05 WRK-LABEL-LEFT-PAREN PIC X(01). DTSCS52
|
|
00256 05 WRK-LABEL-OCC PIC 9(01). DTSCS52
|
|
00257 05 WRK-LABEL-RIGHT-PAREN PIC X(01). DTSCS52
|
|
00258 DTSCS52
|
|
00259 *01 WRK-OCCURS-AREA. DTSCS52
|
|
00260 *****05 WRK-TBL-TOT OCCURS 4 TIMES PIC S9(11)V99 COMP-3. DTSCS52
|
|
00261 DTSCS52
|
|
00262 *****05 WRK-TBL-OK-IND OCCURS 4 TIMES PIC X. DTSCS52
|
|
00263 *********88 WRK-TBL-OK-88 VALUE 'Y'. DTSCS52
|
|
00264 *********88 WRK-TBL-NOT-OK-88 VALUE 'N'. DTSCS52
|
|
00265 DTSCS52
|
|
00266 01 WRK-LITS. DTSCS52
|
|
00267 05 WRK-MAX-LIT PIC S9(09) COMP-3 DTSCS52
|
|
00268 VALUE +100000000. DTSCS52
|
|
00269 05 WRK-MIN-LIT PIC S9(09) COMP-3 DTSCS52
|
|
00270 VALUE -100000000. DTSCS52
|
|
00271 EJECT DTSCS52
|
|
00272 01 MSG-LITERALS. DTSCS52
|
|
00273 05 MSG-E521-AREA. DTSCS52
|
|
00274 10 FILLER PIC X(04) VALUE 'E521'. DTSCS52
|
|
00275 10 FILLER PIC X(30) DTSCS52
|
|
00276 VALUE 'UPDATE REQUIRES EMPLOYER CLASS'. DTSCS52
|
|
00277 10 FILLER PIC X(30) DTSCS52
|
|
00278 VALUE ' RATED '. DTSCS52
|
|
00279 DTSCS52
|
|
00280 05 MSG-E522-AREA. DTSCS52
|
|
00281 10 FILLER PIC X(04) VALUE 'E522'. DTSCS52
|
|
00282 10 FILLER PIC X(30) DTSCS52
|
|
00283 VALUE 'EXISTING AMOUNT PLUS CHANGE AM'. DTSCS52
|
|
00284 10 FILLER PIC X(30) DTSCS52
|
|
00285 VALUE 'OUNT IS NEGATIVE '. DTSCS52
|
|
00286 DTSCS52
|
|
00287 *****05 MSG-E523-AREA. DTSCS52
|
|
00288 *********10 FILLER PIC X(04) VALUE 'E523'. DTSCS52
|
|
00289 *********10 FILLER PIC X(30) DTSCS52
|
|
00290 ***************VALUE 'NEGATIVE BENEFIT CHARGES TOTAL'. DTSCS52
|
|
00291 *********10 FILLER PIC X(30) DTSCS52
|
|
00292 ***************VALUE ' NOT VALID '. DTSCS52
|
|
00293 EJECT DTSCS52
|
|
00294 01 L001-COMM-AREA. DTSCS52
|
|
00295 ++INCLUDE DTSIL001 DTSCS52
|
|
00296 EJECT DTSCS52
|
|
00297 01 L004-COMM-AREA. DTSCS52
|
|
00298 ++INCLUDE DTSIL004 DTSCS52
|
|
00299 EJECT DTSCS52
|
|
00300 01 L006-COMM-AREA. DTSCS52
|
|
00301 ++INCLUDE DTSIL006 DTSCS52
|
|
00302 EJECT DTSCS52
|
|
00303 01 L011-COMM-AREA. DTSCS52
|
|
00304 ++INCLUDE DTSIL011 DTSCS52
|
|
00305 EJECT DTSCS52
|
|
00306 01 L013-COMM-AREA. DTSCS52
|
|
00307 ++INCLUDE DTSIL013 DTSCS52
|
|
00308 EJECT DTSCS52
|
|
00309 01 L015-COMM-AREA. DTSCS52
|
|
00310 ++INCLUDE DTSIL015 DTSCS52
|
|
00311 EJECT DTSCS52
|
|
00312 01 L016-COMM-AREA. DTSCS52
|
|
00313 ++INCLUDE DTSIL016 DTSCS52
|
|
00314 EJECT DTSCS52
|
|
00315 01 L018-COMM-AREA. DTSCS52
|
|
00316 ++INCLUDE DTSIL018 DTSCS52
|
|
00317 EJECT DTSCS52
|
|
00318 01 L054-COMM-AREA. DTSCS52
|
|
00319 03 FILLER. DTSCS52
|
|
00320 ++INCLUDE DTSIL054 DTSCS52
|
|
00321 SKIP3 DTSCS52
|
|
00322 03 MRCT-REC. DTSCS52
|
|
00323 ++INCLUDE DTSIMRCT DTSCS52
|
|
00324 SKIP3 DTSCS52
|
|
00325 03 MRTE-REC. DTSCS52
|
|
00326 ++INCLUDE DTSIMRTE DTSCS52
|
|
00327 EJECT DTSCS52
|
|
00328 01 L055-COMM-AREA. DTSCS52
|
|
00329 ++INCLUDE DTSIL055 DTSCS52
|
|
00330 EJECT DTSCS52
|
|
00331 01 L056-COMM-AREA. DTSCS52
|
|
00332 ++INCLUDE DTSIL056 DTSCS52
|
|
00333 EJECT DTSCS52
|
|
00334 01 L057-COMM-AREA. DTSCS52
|
|
00335 ++INCLUDE DTSIL057 DTSCS52
|
|
00336 EJECT DTSCS52
|
|
00337 01 L221-COMM-AREA. DTSCS52
|
|
00338 ++INCLUDE DTSIL221 DTSCS52
|
|
00339 EJECT DTSCS52
|
|
00340 01 L331-COMM-AREA. DTSCS52
|
|
00341 ++INCLUDE DTSIL331 DTSCS52
|
|
00342 EJECT DTSCS52
|
|
00343 01 L805-COMM-AREA. DTSCS52
|
|
00344 ++INCLUDE DTSIL805 DTSCS52
|
|
00345 EJECT DTSCS52
|
|
00346 01 L810-COMM-AREA. DTSCS52
|
|
00347 05 L810-CONTROL-BLOCK. DTSCS52
|
|
00348 ++INCLUDE DTSIL810 DTSCS52
|
|
00349 EJECT DTSCS52
|
|
00350 05 MSKL-REC. DTSCS52
|
|
00351 ++INCLUDE DTSIMSKL DTSCS52
|
|
00352 EJECT DTSCS52
|
|
00353 01 MPRF-REC. DTSCS52
|
|
00354 ++INCLUDE DTSIMPRF DTSCS52
|
|
00355 EJECT DTSCS52
|
|
00356 *01 L825-COMM-AREA. DTSCS52
|
|
00357 *****05 L825-CONTROL-BLOCK. DTSCS52
|
|
00358 ***INCLUDE DTSIL825 DTSCS52
|
|
00359 SKIP3 DTSCS52
|
|
00360 *****05 RSKL-REC. DTSCS52
|
|
00361 ***INCLUDE DTSIRSK1 DTSCS52
|
|
00362 EJECT DTSCS52
|
|
00363 01 L851-COMM-AREA. DTSCS52
|
|
00364 ++INCLUDE DTSIL851 DTSCS52
|
|
00365 DTSCS52
|
|
00366 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS52
|
|
00367 ++INCLUDE DTSIS52 DTSCS52
|
|
00368 EJECT DTSCS52
|
|
00369 01 CATB-LITERALS. DTSCS52
|
|
00370 ++INCLUDE DTSICATB DTSCS52
|
|
00371 SKIP3 DTSCS52
|
|
00372 01 CFKD-LITERALS. DTSCS52
|
|
00373 ++INCLUDE DTSICFKD DTSCS52
|
|
00374 SKIP3 DTSCS52
|
|
00375 01 CECD-LITERALS. DTSCS52
|
|
00376 ++INCLUDE DTSICECD DTSCS52
|
|
00377 SKIP3 DTSCS52
|
|
00378 01 CPCD-LITERALS. DTSCS52
|
|
00379 ++INCLUDE DTSICPCD DTSCS52
|
|
00380 EJECT DTSCS52
|
|
00381 LINKAGE SECTION. DTSCS52
|
|
00382 DTSCS52
|
|
00383 01 DFHCOMMAREA. DTSCS52
|
|
00384 ++INCLUDE DTSILCCM DTSCS52
|
|
00385 EJECT DTSCS52
|
|
00386 ******************************************************************DTSCS52
|
|
00387 * *DTSCS52
|
|
00388 ******************************************************************DTSCS52
|
|
00389 PROCEDURE DIVISION. DTSCS52
|
|
00390 DTSCS52
|
|
00391 *****PERFORM DTSCS52
|
|
00392 ******VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
00393 ******UNTIL WRK-CTR > 4 DTSCS52
|
|
00394 *********MOVE 0 TO WRK-TBL-TOT (WRK-CTR) DTSCS52
|
|
00395 *********SET WRK-TBL-OK-88 (WRK-CTR) TO TRUE DTSCS52
|
|
00396 *****END-PERFORM DTSCS52
|
|
00397 DTSCS52
|
|
00398 DTSCS52
|
|
00399 MOVE +0 TO WRK-EMP-NO. DTSCS52
|
|
00400 DTSCS52
|
|
00401 SET WRK-MPRF-NO-88 TO TRUE. DTSCS52
|
|
00402 DTSCS52
|
|
00403 SET WRK-MRCT-NO-88 TO TRUE. DTSCS52
|
|
00404 DTSCS52
|
|
00405 MOVE LOW-VALUES TO MAP-AREA. DTSCS52
|
|
00406 DTSCS52
|
|
00407 SET CURSOR-SET-NO TO TRUE. DTSCS52
|
|
00408 DTSCS52
|
|
00409 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS52
|
|
00410 TO SCR-ACCESS-IND. DTSCS52
|
|
00411 DTSCS52
|
|
00412 DTSCS52
|
|
00413 MOVE SPACE TO REQ-IND. DTSCS52
|
|
00414 DTSCS52
|
|
00415 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS52
|
|
00416 DTSCS52
|
|
00417 DTSCS52
|
|
00418 *----------------------------------------------------- DTSCS52
|
|
00419 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS52
|
|
00420 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS52
|
|
00421 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS52
|
|
00422 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS52
|
|
00423 * DTSCS52
|
|
00424 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS52
|
|
00425 * PROCESSED. DTSCS52
|
|
00426 * DTSCS52
|
|
00427 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS52
|
|
00428 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS52
|
|
00429 * WORK STATION OPERATOR. DTSCS52
|
|
00430 *----------------------------------------------------- DTSCS52
|
|
00431 DTSCS52
|
|
00432 MOVE SPACE TO RESP-IND. DTSCS52
|
|
00433 DTSCS52
|
|
00434 IF REQ-ERROR DTSCS52
|
|
00435 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS52
|
|
00436 ELSE DTSCS52
|
|
00437 IF REQ-JUMP DTSCS52
|
|
00438 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS52
|
|
00439 ELSE DTSCS52
|
|
00440 IF REQ-CLEAR DTSCS52
|
|
00441 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS52
|
|
00442 ELSE DTSCS52
|
|
00443 IF REQ-CURSOR-TO-GOTO DTSCS52
|
|
00444 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS52
|
|
00445 ELSE DTSCS52
|
|
00446 IF REQ-INQUIRE DTSCS52
|
|
00447 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS52
|
|
00448 ELSE DTSCS52
|
|
00449 IF REQ-EDIT DTSCS52
|
|
00450 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS52
|
|
00451 ELSE DTSCS52
|
|
00452 IF REQ-UPDATE DTSCS52
|
|
00453 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS52
|
|
00454 ELSE DTSCS52
|
|
00455 GO TO S899-ABEND. DTSCS52
|
|
00456 DTSCS52
|
|
00457 DTSCS52
|
|
00458 *----------------------------------------------------- DTSCS52
|
|
00459 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS52
|
|
00460 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS52
|
|
00461 *----------------------------------------------------- DTSCS52
|
|
00462 DTSCS52
|
|
00463 IF RESP-SEND-MAP DTSCS52
|
|
00464 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS52
|
|
00465 SET LCCM-END-TASK-88 TO TRUE DTSCS52
|
|
00466 ELSE DTSCS52
|
|
00467 IF RESP-SEND-MSGONLY DTSCS52
|
|
00468 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS52
|
|
00469 SET LCCM-END-TASK-88 TO TRUE DTSCS52
|
|
00470 ELSE DTSCS52
|
|
00471 IF RESP-JUMP DTSCS52
|
|
00472 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS52
|
|
00473 ELSE DTSCS52
|
|
00474 IF RESP-CURSOR-TO-GOTO DTSCS52
|
|
00475 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS52
|
|
00476 SET LCCM-END-TASK-88 TO TRUE DTSCS52
|
|
00477 ELSE DTSCS52
|
|
00478 GO TO S899-ABEND. DTSCS52
|
|
00479 DTSCS52
|
|
00480 DTSCS52
|
|
00481 MAINLINE-EXIT. DTSCS52
|
|
00482 DTSCS52
|
|
00483 EXEC CICS DTSCS52
|
|
00484 RETURN DTSCS52
|
|
00485 END-EXEC. DTSCS52
|
|
00486 DTSCS52
|
|
00487 DTSCS52
|
|
00488 GOBACK. DTSCS52
|
|
00489 EJECT DTSCS52
|
|
00490 /*****************************************************************DTSCS52
|
|
00491 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS52
|
|
00492 ******************************************************************DTSCS52
|
|
00493 DTSCS52
|
|
00494 P1000-ANALYZE-REQUEST. DTSCS52
|
|
00495 DTSCS52
|
|
00496 *----------------------------------------------------- DTSCS52
|
|
00497 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS52
|
|
00498 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS52
|
|
00499 * REPLACED WITH ENTER) DTSCS52
|
|
00500 *----------------------------------------------------- DTSCS52
|
|
00501 DTSCS52
|
|
00502 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS52
|
|
00503 SET LCCM-ENTER-88 TO TRUE DTSCS52
|
|
00504 IF LCCM-EMP-NO > ZERO DTSCS52
|
|
00505 SET REQ-INQUIRE TO TRUE DTSCS52
|
|
00506 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS52
|
|
00507 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS52
|
|
00508 ELSE DTSCS52
|
|
00509 SET REQ-CLEAR TO TRUE DTSCS52
|
|
00510 END-IF DTSCS52
|
|
00511 GO TO P1000-EXIT. DTSCS52
|
|
00512 DTSCS52
|
|
00513 DTSCS52
|
|
00514 *----------------------------------------------------- DTSCS52
|
|
00515 * RECEIVE THE MAP DTSCS52
|
|
00516 *----------------------------------------------------- DTSCS52
|
|
00517 DTSCS52
|
|
00518 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS52
|
|
00519 DTSCS52
|
|
00520 DTSCS52
|
|
00521 *----------------------------------------------------- DTSCS52
|
|
00522 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS52
|
|
00523 * WORK STATION DTSCS52
|
|
00524 *----------------------------------------------------- DTSCS52
|
|
00525 DTSCS52
|
|
00526 IF LCCM-CLEAR-88 DTSCS52
|
|
00527 SET REQ-CLEAR TO TRUE DTSCS52
|
|
00528 GO TO P1000-EXIT. DTSCS52
|
|
00529 DTSCS52
|
|
00530 DTSCS52
|
|
00531 *----------------------------------------------------- DTSCS52
|
|
00532 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS52
|
|
00533 *----------------------------------------------------- DTSCS52
|
|
00534 DTSCS52
|
|
00535 IF LCCM-SCR-UPDATE-LOCKED DTSCS52
|
|
00536 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS52
|
|
00537 GO TO P1000-EXIT. DTSCS52
|
|
00538 DTSCS52
|
|
00539 DTSCS52
|
|
00540 *----------------------------------------------------- DTSCS52
|
|
00541 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS52
|
|
00542 *----------------------------------------------------- DTSCS52
|
|
00543 DTSCS52
|
|
00544 IF LCCM-PA2-88 DTSCS52
|
|
00545 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS52
|
|
00546 GO TO P1000-EXIT. DTSCS52
|
|
00547 DTSCS52
|
|
00548 DTSCS52
|
|
00549 *----------------------------------------------------- DTSCS52
|
|
00550 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS52
|
|
00551 *----------------------------------------------------- DTSCS52
|
|
00552 DTSCS52
|
|
00553 IF LCCM-PA-88 DTSCS52
|
|
00554 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS52
|
|
00555 SET REQ-ERROR TO TRUE DTSCS52
|
|
00556 GO TO P1000-EXIT. DTSCS52
|
|
00557 DTSCS52
|
|
00558 DTSCS52
|
|
00559 *----------------------------------------------------- DTSCS52
|
|
00560 * IN DC F12 (WHEN UPDATE IS NOT IN PROGRESS) IS A DTSCS52
|
|
00561 * REQUEST TO CLEAR THE SCREEN. DTSCS52
|
|
00562 *----------------------------------------------------- DTSCS52
|
|
00563 DTSCS52
|
|
00564 IF LCCM-F12-88 DTSCS52
|
|
00565 MOVE LOW-VALUES TO MAP-AREA DTSCS52
|
|
00566 SET REQ-CLEAR TO TRUE DTSCS52
|
|
00567 GO TO P1000-EXIT. DTSCS52
|
|
00568 DTSCS52
|
|
00569 DTSCS52
|
|
00570 *----------------------------------------------------- DTSCS52
|
|
00571 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS52
|
|
00572 *----------------------------------------------------- DTSCS52
|
|
00573 DTSCS52
|
|
00574 IF LCCM-F03-88 DTSCS52
|
|
00575 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS52
|
|
00576 SET REQ-JUMP TO TRUE DTSCS52
|
|
00577 GO TO P1000-EXIT. DTSCS52
|
|
00578 DTSCS52
|
|
00579 DTSCS52
|
|
00580 *----------------------------------------------------- DTSCS52
|
|
00581 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS52
|
|
00582 *----------------------------------------------------- DTSCS52
|
|
00583 DTSCS52
|
|
00584 IF LCCM-F04-88 DTSCS52
|
|
00585 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS52
|
|
00586 SET REQ-JUMP TO TRUE DTSCS52
|
|
00587 GO TO P1000-EXIT. DTSCS52
|
|
00588 DTSCS52
|
|
00589 DTSCS52
|
|
00590 *----------------------------------------------------- DTSCS52
|
|
00591 * IF JUMP TO CORRESPONDENCE QUEUE INQUIRY/UPDATE KEY DTSCS52
|
|
00592 * PRESSED, THEN JUMP. DTSCS52
|
|
00593 *----------------------------------------------------- DTSCS52
|
|
00594 DTSCS52
|
|
00595 IF LCCM-F14-88 DTSCS52
|
|
00596 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS52
|
|
00597 SET REQ-JUMP TO TRUE DTSCS52
|
|
00598 GO TO P1000-EXIT. DTSCS52
|
|
00599 DTSCS52
|
|
00600 DTSCS52
|
|
00601 *----------------------------------------------------- DTSCS52
|
|
00602 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS52
|
|
00603 * REQUESTED SCREEN TYPE DTSCS52
|
|
00604 *----------------------------------------------------- DTSCS52
|
|
00605 DTSCS52
|
|
00606 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS52
|
|
00607 NEXT SENTENCE DTSCS52
|
|
00608 ELSE DTSCS52
|
|
00609 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS52
|
|
00610 SET REQ-JUMP TO TRUE DTSCS52
|
|
00611 GO TO P1000-EXIT. DTSCS52
|
|
00612 DTSCS52
|
|
00613 DTSCS52
|
|
00614 *----------------------------------------------------- DTSCS52
|
|
00615 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS52
|
|
00616 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS52
|
|
00617 *----------------------------------------------------- DTSCS52
|
|
00618 DTSCS52
|
|
00619 IF LCCM-F09-88 DTSCS52
|
|
00620 OR LCCM-F10-88 DTSCS52
|
|
00621 OR LCCM-F23-88 DTSCS52
|
|
00622 IF SCR-ACCESS-UPDATE DTSCS52
|
|
00623 SET REQ-EDIT TO TRUE DTSCS52
|
|
00624 GO TO P1000-EXIT DTSCS52
|
|
00625 ELSE DTSCS52
|
|
00626 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS52
|
|
00627 SET REQ-ERROR TO TRUE DTSCS52
|
|
00628 GO TO P1000-EXIT. DTSCS52
|
|
00629 DTSCS52
|
|
00630 *----------------------------------------------------- DTSCS52
|
|
00631 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS52
|
|
00632 * OR F8), INDICATE INQUIRY REQUEST DTSCS52
|
|
00633 *----------------------------------------------------- DTSCS52
|
|
00634 DTSCS52
|
|
00635 IF LCCM-INQUIRY-88 DTSCS52
|
|
00636 SET REQ-INQUIRE TO TRUE DTSCS52
|
|
00637 GO TO P1000-EXIT. DTSCS52
|
|
00638 DTSCS52
|
|
00639 DTSCS52
|
|
00640 *----------------------------------------------------- DTSCS52
|
|
00641 * ANY OTHER KEY IS INVALID DTSCS52
|
|
00642 *----------------------------------------------------- DTSCS52
|
|
00643 DTSCS52
|
|
00644 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS52
|
|
00645 DTSCS52
|
|
00646 SET REQ-ERROR TO TRUE. DTSCS52
|
|
00647 P1000-EXIT. DTSCS52
|
|
00648 EXIT. DTSCS52
|
|
00649 SKIP3 DTSCS52
|
|
00650 ******************************************************************DTSCS52
|
|
00651 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS52
|
|
00652 ******************************************************************DTSCS52
|
|
00653 DTSCS52
|
|
00654 P1100-UPDATE-LOCKED. DTSCS52
|
|
00655 DTSCS52
|
|
00656 *----------------------------------------------------- DTSCS52
|
|
00657 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS52
|
|
00658 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS52
|
|
00659 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS52
|
|
00660 *----------------------------------------------------- DTSCS52
|
|
00661 DTSCS52
|
|
00662 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS52
|
|
00663 SET REQ-UPDATE TO TRUE DTSCS52
|
|
00664 ELSE DTSCS52
|
|
00665 SET REQ-ERROR TO TRUE DTSCS52
|
|
00666 IF LCCM-SCR-ADD-LOCKED DTSCS52
|
|
00667 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS52
|
|
00668 ELSE DTSCS52
|
|
00669 IF LCCM-SCR-MOD-LOCKED DTSCS52
|
|
00670 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS52
|
|
00671 ELSE DTSCS52
|
|
00672 IF LCCM-SCR-DEL-LOCKED DTSCS52
|
|
00673 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS52
|
|
00674 ELSE DTSCS52
|
|
00675 GO TO S899-ABEND. DTSCS52
|
|
00676 P1100-EXIT. DTSCS52
|
|
00677 EXIT. DTSCS52
|
|
00678 /*****************************************************************DTSCS52
|
|
00679 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS52
|
|
00680 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS52
|
|
00681 ******************************************************************DTSCS52
|
|
00682 DTSCS52
|
|
00683 P2000-REQUEST-ERROR. DTSCS52
|
|
00684 IF LCCM-MSG DTSCS52
|
|
00685 SET RESP-SEND-MSGONLY TO TRUE DTSCS52
|
|
00686 ELSE DTSCS52
|
|
00687 GO TO S899-ABEND. DTSCS52
|
|
00688 P2000-EXIT. DTSCS52
|
|
00689 EXIT. DTSCS52
|
|
00690 /*****************************************************************DTSCS52
|
|
00691 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS52
|
|
00692 ******************************************************************DTSCS52
|
|
00693 DTSCS52
|
|
00694 P3000-REQUEST-JUMP. DTSCS52
|
|
00695 DTSCS52
|
|
00696 *----------------------------------------------------- DTSCS52
|
|
00697 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS52
|
|
00698 * BY USER DTSCS52
|
|
00699 *----------------------------------------------------- DTSCS52
|
|
00700 DTSCS52
|
|
00701 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS52
|
|
00702 DTSCS52
|
|
00703 DTSCS52
|
|
00704 *----------------------------------------------------- DTSCS52
|
|
00705 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS52
|
|
00706 *----------------------------------------------------- DTSCS52
|
|
00707 DTSCS52
|
|
00708 IF LCCM-MSG DTSCS52
|
|
00709 SET RESP-SEND-MSGONLY TO TRUE DTSCS52
|
|
00710 SET CURSOR-SET-GOTO TO TRUE DTSCS52
|
|
00711 GO TO P3000-EXIT. DTSCS52
|
|
00712 DTSCS52
|
|
00713 DTSCS52
|
|
00714 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS52
|
|
00715 DTSCS52
|
|
00716 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS52
|
|
00717 DTSCS52
|
|
00718 IF L018-VALID DTSCS52
|
|
00719 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS52
|
|
00720 DTSCS52
|
|
00721 DTSCS52
|
|
00722 *----------------------------------------------------- DTSCS52
|
|
00723 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS52
|
|
00724 *----------------------------------------------------- DTSCS52
|
|
00725 DTSCS52
|
|
00726 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS52
|
|
00727 LCCM-SCR-HOLD-AREA. DTSCS52
|
|
00728 DTSCS52
|
|
00729 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS52
|
|
00730 DTSCS52
|
|
00731 SET RESP-JUMP TO TRUE. DTSCS52
|
|
00732 P3000-EXIT. DTSCS52
|
|
00733 EXIT. DTSCS52
|
|
00734 /*****************************************************************DTSCS52
|
|
00735 * CLEAR KEY WAS PRESSED *DTSCS52
|
|
00736 ******************************************************************DTSCS52
|
|
00737 DTSCS52
|
|
00738 P4000-REQUEST-CLEAR. DTSCS52
|
|
00739 DTSCS52
|
|
00740 *----------------------------------------------------- DTSCS52
|
|
00741 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS52
|
|
00742 * FIELDS FROM EARLIER REQUESTS DTSCS52
|
|
00743 *----------------------------------------------------- DTSCS52
|
|
00744 DTSCS52
|
|
00745 IF LCCM-EMP-NO > ZERO DTSCS52
|
|
00746 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS52
|
|
00747 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS52
|
|
00748 DTSCS52
|
|
00749 MOVE ZERO TO LCCM-EMP-NO. DTSCS52
|
|
00750 DTSCS52
|
|
00751 MOVE LOW-VALUES TO LCCM-SCR52-HOLD-AREA. DTSCS52
|
|
00752 DTSCS52
|
|
00753 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS52
|
|
00754 DTSCS52
|
|
00755 SET LCCM-SCR-CLEAR TO TRUE. DTSCS52
|
|
00756 DTSCS52
|
|
00757 SET RESP-SEND-MAP TO TRUE. DTSCS52
|
|
00758 DTSCS52
|
|
00759 IF SCR-ACCESS-UPDATE DTSCS52
|
|
00760 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS52
|
|
00761 ELSE DTSCS52
|
|
00762 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS52
|
|
00763 P4000-EXIT. DTSCS52
|
|
00764 EXIT. DTSCS52
|
|
00765 /*****************************************************************DTSCS52
|
|
00766 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS52
|
|
00767 ******************************************************************DTSCS52
|
|
00768 DTSCS52
|
|
00769 P5000-CURSOR-TO-GOTO. DTSCS52
|
|
00770 SET CURSOR-SET-GOTO TO TRUE. DTSCS52
|
|
00771 DTSCS52
|
|
00772 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS52
|
|
00773 P5000-EXIT. DTSCS52
|
|
00774 EXIT. DTSCS52
|
|
00775 /*****************************************************************DTSCS52
|
|
00776 * INQUIRY WAS REQUESTED *DTSCS52
|
|
00777 ******************************************************************DTSCS52
|
|
00778 DTSCS52
|
|
00779 P6000-REQUEST-INQUIRE. DTSCS52
|
|
00780 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS52
|
|
00781 DTSCS52
|
|
00782 MOVE LOW-VALUES TO MAP-AREA. DTSCS52
|
|
00783 DTSCS52
|
|
00784 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS52
|
|
00785 DTSCS52
|
|
00786 SET LCCM-SCR-CLEAR TO TRUE. DTSCS52
|
|
00787 DTSCS52
|
|
00788 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS52
|
|
00789 DTSCS52
|
|
00790 SET RESP-SEND-MAP TO TRUE. DTSCS52
|
|
00791 DTSCS52
|
|
00792 IF SCR-ACCESS-UPDATE DTSCS52
|
|
00793 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS52
|
|
00794 ELSE DTSCS52
|
|
00795 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS52
|
|
00796 DTSCS52
|
|
00797 MOVE LCCM-SCR52-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS52
|
|
00798 DTSCS52
|
|
00799 MOVE LOW-VALUES TO LCCM-SCR52-HOLD-AREA. DTSCS52
|
|
00800 DTSCS52
|
|
00801 DTSCS52
|
|
00802 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
00803 DTSCS52
|
|
00804 IF LCCM-MSG DTSCS52
|
|
00805 GO TO P6000-EXIT. DTSCS52
|
|
00806 DTSCS52
|
|
00807 DTSCS52
|
|
00808 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS52
|
|
00809 DTSCS52
|
|
00810 IF LCCM-MSG DTSCS52
|
|
00811 GO TO P6000-EXIT. DTSCS52
|
|
00812 DTSCS52
|
|
00813 DTSCS52
|
|
00814 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS52
|
|
00815 DTSCS52
|
|
00816 DTSCS52
|
|
00817 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS52
|
|
00818 DTSCS52
|
|
00819 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS52
|
|
00820 DTSCS52
|
|
00821 SET MSKL-RCT-88 TO TRUE. DTSCS52
|
|
00822 DTSCS52
|
|
00823 PERFORM S810-COUNT THRU S810-EXIT. DTSCS52
|
|
00824 DTSCS52
|
|
00825 IF L810-RECORD-CNT = +0 DTSCS52
|
|
00826 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS52
|
|
00827 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
00828 GO TO P6000-EXIT. DTSCS52
|
|
00829 DTSCS52
|
|
00830 DTSCS52
|
|
00831 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS52
|
|
00832 DTSCS52
|
|
00833 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS52
|
|
00834 DTSCS52
|
|
00835 DTSCS52
|
|
00836 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS52
|
|
00837 DTSCS52
|
|
00838 IF LCCM-MSG DTSCS52
|
|
00839 GO TO P6000-EXIT. DTSCS52
|
|
00840 DTSCS52
|
|
00841 DTSCS52
|
|
00842 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS52
|
|
00843 DTSCS52
|
|
00844 DTSCS52
|
|
00845 MOVE MRCT-KEY-AREA TO LCCM-SCR52-HOLD-AREA. DTSCS52
|
|
00846 DTSCS52
|
|
00847 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS52
|
|
00848 DTSCS52
|
|
00849 IF SCR-ACCESS-UPDATE DTSCS52
|
|
00850 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS52
|
|
00851 P6000-EXIT. DTSCS52
|
|
00852 EXIT. DTSCS52
|
|
00853 EJECT DTSCS52
|
|
00854 P6100-LOCATE-REC. DTSCS52
|
|
00855 DTSCS52
|
|
00856 *------------------------------------------------------------ DTSCS52
|
|
00857 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS52
|
|
00858 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS52
|
|
00859 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS52
|
|
00860 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS52
|
|
00861 * RECORD WITH THE GREATEST MRCT-EFF-YRQ DTSCS52
|
|
00862 * ASSOCIATED WITH WRK-EMP-NO). DTSCS52
|
|
00863 *------------------------------------------------------------ DTSCS52
|
|
00864 DTSCS52
|
|
00865 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS52
|
|
00866 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS52
|
|
00867 GO TO P6100-EXIT. DTSCS52
|
|
00868 DTSCS52
|
|
00869 DTSCS52
|
|
00870 MOVE SCR-REC-KEY-AREA TO MRCT-KEY-AREA. DTSCS52
|
|
00871 DTSCS52
|
|
00872 IF WRK-EMP-NO = MRCT-EMP-NO DTSCS52
|
|
00873 NEXT SENTENCE DTSCS52
|
|
00874 ELSE DTSCS52
|
|
00875 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS52
|
|
00876 GO TO P6100-EXIT. DTSCS52
|
|
00877 DTSCS52
|
|
00878 DTSCS52
|
|
00879 IF LCCM-F05-88 DTSCS52
|
|
00880 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS52
|
|
00881 GO TO P6100-EXIT. DTSCS52
|
|
00882 DTSCS52
|
|
00883 DTSCS52
|
|
00884 IF LCCM-F06-88 DTSCS52
|
|
00885 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS52
|
|
00886 GO TO P6100-EXIT. DTSCS52
|
|
00887 DTSCS52
|
|
00888 DTSCS52
|
|
00889 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS52
|
|
00890 DTSCS52
|
|
00891 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS52
|
|
00892 DTSCS52
|
|
00893 SET MSKL-RCT-88 TO TRUE. DTSCS52
|
|
00894 DTSCS52
|
|
00895 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS52
|
|
00896 DTSCS52
|
|
00897 IF L810-NO-REC-88 DTSCS52
|
|
00898 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS52
|
|
00899 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
00900 GO TO P6100-EXIT. DTSCS52
|
|
00901 DTSCS52
|
|
00902 DTSCS52
|
|
00903 MOVE +0 TO WS-REC-NUM. DTSCS52
|
|
00904 DTSCS52
|
|
00905 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS52
|
|
00906 DTSCS52
|
|
00907 PERFORM P6190-BROWSE-MRCT THRU P6190-EXIT DTSCS52
|
|
00908 UNTIL (L810-NO-REC-88) DTSCS52
|
|
00909 OR DTSCS52
|
|
00910 (WS-REC-FOUND-IND = 'Y'). DTSCS52
|
|
00911 DTSCS52
|
|
00912 DTSCS52
|
|
00913 IF L810-NO-REC-88 DTSCS52
|
|
00914 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS52
|
|
00915 GO TO P6100-EXIT. DTSCS52
|
|
00916 DTSCS52
|
|
00917 DTSCS52
|
|
00918 IF LCCM-ENTER-88 DTSCS52
|
|
00919 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS52
|
|
00920 GO TO P6100-EXIT. DTSCS52
|
|
00921 DTSCS52
|
|
00922 DTSCS52
|
|
00923 IF LCCM-F07-88 DTSCS52
|
|
00924 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS52
|
|
00925 GO TO P6100-EXIT. DTSCS52
|
|
00926 DTSCS52
|
|
00927 DTSCS52
|
|
00928 IF LCCM-F08-88 DTSCS52
|
|
00929 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS52
|
|
00930 GO TO P6100-EXIT. DTSCS52
|
|
00931 DTSCS52
|
|
00932 DTSCS52
|
|
00933 GO TO S899-ABEND. DTSCS52
|
|
00934 P6100-EXIT. DTSCS52
|
|
00935 EXIT. DTSCS52
|
|
00936 SKIP3 DTSCS52
|
|
00937 P6110-FIRST-REC. DTSCS52
|
|
00938 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS52
|
|
00939 DTSCS52
|
|
00940 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS52
|
|
00941 DTSCS52
|
|
00942 SET MSKL-RCT-88 TO TRUE. DTSCS52
|
|
00943 DTSCS52
|
|
00944 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS52
|
|
00945 DTSCS52
|
|
00946 IF L810-NO-REC-88 DTSCS52
|
|
00947 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS52
|
|
00948 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
00949 GO TO P6110-EXIT. DTSCS52
|
|
00950 DTSCS52
|
|
00951 DTSCS52
|
|
00952 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS52
|
|
00953 DTSCS52
|
|
00954 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
00955 DTSCS52
|
|
00956 MOVE +1 TO WS-REC-NUM. DTSCS52
|
|
00957 P6110-EXIT. DTSCS52
|
|
00958 EXIT. DTSCS52
|
|
00959 SKIP3 DTSCS52
|
|
00960 P6120-PREV-REC. DTSCS52
|
|
00961 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS52
|
|
00962 DTSCS52
|
|
00963 IF L810-NO-REC-88 DTSCS52
|
|
00964 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS52
|
|
00965 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
00966 GO TO P6120-EXIT. DTSCS52
|
|
00967 DTSCS52
|
|
00968 DTSCS52
|
|
00969 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS52
|
|
00970 DTSCS52
|
|
00971 IF L810-NO-REC-88 DTSCS52
|
|
00972 GO TO P6120-EXIT. DTSCS52
|
|
00973 DTSCS52
|
|
00974 DTSCS52
|
|
00975 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS52
|
|
00976 DTSCS52
|
|
00977 SUBTRACT 1 FROM WS-REC-NUM. DTSCS52
|
|
00978 DTSCS52
|
|
00979 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
00980 P6120-EXIT. DTSCS52
|
|
00981 EXIT. DTSCS52
|
|
00982 SKIP3 DTSCS52
|
|
00983 P6130-NEXT-REC. DTSCS52
|
|
00984 IF MRCT-KEY-AREA > SCR-REC-KEY-AREA DTSCS52
|
|
00985 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS52
|
|
00986 GO TO P6130-EXIT. DTSCS52
|
|
00987 DTSCS52
|
|
00988 DTSCS52
|
|
00989 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS52
|
|
00990 DTSCS52
|
|
00991 IF L810-NO-REC-88 DTSCS52
|
|
00992 GO TO P6130-EXIT. DTSCS52
|
|
00993 DTSCS52
|
|
00994 DTSCS52
|
|
00995 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS52
|
|
00996 DTSCS52
|
|
00997 ADD +1 TO WS-REC-NUM. DTSCS52
|
|
00998 DTSCS52
|
|
00999 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
01000 P6130-EXIT. DTSCS52
|
|
01001 EXIT. DTSCS52
|
|
01002 SKIP3 DTSCS52
|
|
01003 P6140-LAST-REC. DTSCS52
|
|
01004 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
01005 DTSCS52
|
|
01006 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
01007 DTSCS52
|
|
01008 IF L810-NO-REC-88 DTSCS52
|
|
01009 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS52
|
|
01010 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
01011 GO TO P6140-EXIT. DTSCS52
|
|
01012 DTSCS52
|
|
01013 DTSCS52
|
|
01014 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
01015 DTSCS52
|
|
01016 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS52
|
|
01017 P6140-EXIT. DTSCS52
|
|
01018 EXIT. DTSCS52
|
|
01019 SKIP3 DTSCS52
|
|
01020 P6190-BROWSE-MRCT. DTSCS52
|
|
01021 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
01022 DTSCS52
|
|
01023 ADD +1 TO WS-REC-NUM. DTSCS52
|
|
01024 DTSCS52
|
|
01025 IF MRCT-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS52
|
|
01026 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS52
|
|
01027 ELSE DTSCS52
|
|
01028 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS52
|
|
01029 P6190-EXIT. DTSCS52
|
|
01030 EXIT. DTSCS52
|
|
01031 /*****************************************************************DTSCS52
|
|
01032 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS52
|
|
01033 ******************************************************************DTSCS52
|
|
01034 DTSCS52
|
|
01035 P6900-CONSTRUCT-SCREEN. DTSCS52
|
|
01036 DTSCS52
|
|
01037 *****PERFORM DTSCS52
|
|
01038 ******VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
01039 ******UNTIL WRK-CTR > 4 DTSCS52
|
|
01040 *********MOVE 0 TO WRK-TBL-TOT (WRK-CTR) DTSCS52
|
|
01041 *********SET WRK-TBL-OK-88 (WRK-CTR) TO TRUE DTSCS52
|
|
01042 *****END-PERFORM DTSCS52
|
|
01043 DTSCS52
|
|
01044 PERFORM P6910-FROM-MRTE THRU P6910-EXIT. DTSCS52
|
|
01045 DTSCS52
|
|
01046 PERFORM P6920-FROM-MRCT THRU P6920-EXIT. DTSCS52
|
|
01047 DTSCS52
|
|
01048 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS52
|
|
01049 P6900-EXIT. DTSCS52
|
|
01050 EXIT. DTSCS52
|
|
01051 SKIP3 DTSCS52
|
|
01052 P6910-FROM-MRTE. DTSCS52
|
|
01053 PERFORM P6911-FIND-MRTE THRU P6911-EXIT. DTSCS52
|
|
01054 DTSCS52
|
|
01055 IF L810-OK-88 DTSCS52
|
|
01056 MOVE MRTE-RATE-TYPE-IND TO MAP-RATE-TYPE DTSCS52
|
|
01057 ELSE DTSCS52
|
|
01058 SET MAP-RATE-TYPE-NULL-88 TO TRUE. DTSCS52
|
|
01059 DTSCS52
|
|
01060 IF MAP-RATE-TYPE-ESTIM-88 DTSCS52
|
|
01061 OR MAP-RATE-TYPE-FINAL-88 DTSCS52
|
|
01062 MOVE MRCT-QTR1-ESTIM-TAX-WAGE DTSCS52
|
|
01063 TO MAP-ESTIM-QTR1-WAGE-N. DTSCS52
|
|
01064 DTSCS52
|
|
01065 P6910-EXIT. DTSCS52
|
|
01066 EXIT. DTSCS52
|
|
01067 SKIP3 DTSCS52
|
|
01068 P6911-FIND-MRTE. DTSCS52
|
|
01069 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSCS52
|
|
01070 DTSCS52
|
|
01071 MOVE WRK-EMP-NO TO MRTE-EMP-NO. DTSCS52
|
|
01072 DTSCS52
|
|
01073 SET MRTE-RTE-88 TO TRUE. DTSCS52
|
|
01074 DTSCS52
|
|
01075 MOVE MRCT-EFF-YRQ TO MRTE-EFF-YRQ. DTSCS52
|
|
01076 DTSCS52
|
|
01077 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
01078 DTSCS52
|
|
01079 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
01080 DTSCS52
|
|
01081 IF L810-OK-88 DTSCS52
|
|
01082 MOVE MSKL-REC TO MRTE-REC. DTSCS52
|
|
01083 DTSCS52
|
|
01084 P6911-EXIT. DTSCS52
|
|
01085 EXIT. DTSCS52
|
|
01086 SKIP3 DTSCS52
|
|
01087 P6920-FROM-MRCT. DTSCS52
|
|
01088 MOVE MRCT-EFF-YRQ TO WRK-DISPLAY. DTSCS52
|
|
01089 DTSCS52
|
|
01090 MOVE WRK-DISPLAY-QTR-YR TO MAP-EFF-QTR-YR. DTSCS52
|
|
01091 DTSCS52
|
|
01092 MOVE WRK-DISPLAY-QTR-Q TO MAP-EFF-QTR-Q. DTSCS52
|
|
01093 DTSCS52
|
|
01094 DTSCS52
|
|
01095 MOVE MRCT-EFF-YRQ TO L006-YRQ. DTSCS52
|
|
01096 DTSCS52
|
|
01097 PERFORM S006-RATE-PERIOD THRU S006-EXIT. DTSCS52
|
|
01098 DTSCS52
|
|
01099 DTSCS52
|
|
01100 MOVE L006-RTE-YR-START-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
01101 DTSCS52
|
|
01102 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
01103 DTSCS52
|
|
01104 MOVE L001-SLASH-DATE TO MAP-PERIOD-FROM. DTSCS52
|
|
01105 DTSCS52
|
|
01106 DTSCS52
|
|
01107 MOVE L006-RTE-YR-END-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
01108 DTSCS52
|
|
01109 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
01110 DTSCS52
|
|
01111 MOVE L001-SLASH-DATE TO MAP-PERIOD-TO. DTSCS52
|
|
01112 DTSCS52
|
|
01113 DTSCS52
|
|
01114 MOVE MRCT-EARLIEST-LIAB-DATE TO WRK-DISPLAY. DTSCS52
|
|
01115 DTSCS52
|
|
01116 MOVE WRK-DISPLAY-MO TO MAP-EARLIEST-LIAB-MONTH. DTSCS52
|
|
01117 DTSCS52
|
|
01118 MOVE WRK-DISPLAY-DA TO MAP-EARLIEST-LIAB-DAY. DTSCS52
|
|
01119 DTSCS52
|
|
01120 MOVE WRK-DISPLAY-YR TO MAP-EARLIEST-LIAB-YEAR. DTSCS52
|
|
01121 DTSCS52
|
|
01122 DTSCS52
|
|
01123 MOVE MRCT-ACTIVE-IND TO MAP-ACTIVE-IND. DTSCS52
|
|
01124 DTSCS52
|
|
01125 DTSCS52
|
|
01126 IF MRCT-TRANSFERRED-TO-EMP-NO NOT = ZERO DTSCS52
|
|
01127 MOVE MRCT-TRANSFERRED-TO-EMP-NO TO WRK-DISPLAY DTSCS52
|
|
01128 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-TRNSF-TO-EMP-NO-1 DTSCS52
|
|
01129 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-TRNSF-TO-EMP-NO-2. DTSCS52
|
|
01130 DTSCS52
|
|
01131 DTSCS52
|
|
01132 MOVE MRCT-EFF-YRQ TO L055-EFF-YRQ. DTSCS52
|
|
01133 DTSCS52
|
|
01134 PERFORM S055-EXPERIENCE-PERIODS THRU S055-EXIT. DTSCS52
|
|
01135 DTSCS52
|
|
01136 DTSCS52
|
|
01137 MOVE L055-PRIOR-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
01138 DTSCS52
|
|
01139 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
01140 DTSCS52
|
|
01141 MOVE '(' TO MAP-PRIOR-DATE-LEFT. DTSCS52
|
|
01142 DTSCS52
|
|
01143 MOVE L001-SLASH-DATE TO MAP-PRIOR-DATE. DTSCS52
|
|
01144 DTSCS52
|
|
01145 MOVE ')' TO MAP-PRIOR-DATE-RIGHT. DTSCS52
|
|
01146 DTSCS52
|
|
01147 DTSCS52
|
|
01148 MOVE MRCT-PRIOR-RESERVE-AMT TO MAP-PRIOR-RESERVE-N. DTSCS52
|
|
01149 DTSCS52
|
|
01150 DTSCS52
|
|
01151 MOVE MRCT-UI-TAX-PAID-AMT TO MAP-UI-TAX-PAID-N. DTSCS52
|
|
01152 DTSCS52
|
|
01153 DTSCS52
|
|
01154 MOVE MRCT-TRUST-FUND-INTEREST-AMT TO MAP-TRUST-FUND-INT-N. DTSCS52
|
|
01155 DTSCS52
|
|
01156 DTSCS52
|
|
01157 MOVE MRCT-BENEFITS-CHARGED-AMT TO MAP-UI-BEN-CHRGD-N. DTSCS52
|
|
01158 DTSCS52
|
|
01159 DTSCS52
|
|
01160 PERFORM VARYING WRK-CTR DTSCS52
|
|
01161 FROM 1 BY 1 DTSCS52
|
|
01162 UNTIL WRK-CTR > 3 DTSCS52
|
|
01163 MOVE L055-WAGES-FROM-YRQ (WRK-CTR) TO L004-QTR-5-9 DTSCS52
|
|
01164 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS52
|
|
01165 MOVE L004-SLASH-QTR TO MAP-START-YRQ (WRK-CTR) DTSCS52
|
|
01166 MOVE L055-WAGES-THRU-YRQ (WRK-CTR) TO L004-QTR-5-9 DTSCS52
|
|
01167 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS52
|
|
01168 MOVE L004-SLASH-QTR TO MAP-END-YRQ (WRK-CTR) DTSCS52
|
|
01169 MOVE MRCT-TOT-WAGE (WRK-CTR) DTSCS52
|
|
01170 TO MAP-TOT-WAGE-N (WRK-CTR) DTSCS52
|
|
01171 MOVE MRCT-TAX-WAGE (WRK-CTR) DTSCS52
|
|
01172 TO MAP-TAX-WAGE-N (WRK-CTR) DTSCS52
|
|
01173 END-PERFORM. DTSCS52
|
|
01174 DTSCS52
|
|
01175 DTSCS52
|
|
01176 MOVE L055-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
01177 DTSCS52
|
|
01178 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
01179 DTSCS52
|
|
01180 MOVE '(' TO MAP-CURRENT-DATE-LEFT. DTSCS52
|
|
01181 DTSCS52
|
|
01182 MOVE L001-SLASH-DATE TO MAP-CURRENT-DATE. DTSCS52
|
|
01183 DTSCS52
|
|
01184 MOVE ')' TO MAP-CURRENT-DATE-RIGHT. DTSCS52
|
|
01185 DTSCS52
|
|
01186 DTSCS52
|
|
01187 MOVE MRCT-MISS-RPT-CNT TO MAP-MISS-RPT-CNT-N. DTSCS52
|
|
01188 DTSCS52
|
|
01189 DTSCS52
|
|
01190 MOVE MRCT-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
01191 DTSCS52
|
|
01192 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
01193 DTSCS52
|
|
01194 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS52
|
|
01195 DTSCS52
|
|
01196 DTSCS52
|
|
01197 MOVE MRCT-TOT-UI-TAX-BALANCE-AMT TO MAP-UI-TAX-DUE-N. DTSCS52
|
|
01198 DTSCS52
|
|
01199 DTSCS52
|
|
01200 MOVE MRCT-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
01201 DTSCS52
|
|
01202 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
01203 DTSCS52
|
|
01204 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS52
|
|
01205 DTSCS52
|
|
01206 DTSCS52
|
|
01207 MOVE MRCT-PRED-DUE-IND TO MAP-PRED-DUE-IND. DTSCS52
|
|
01208 DTSCS52
|
|
01209 DTSCS52
|
|
01210 MOVE MRCT-CHNG-OP-ID TO MAP-CHNG-OPID. DTSCS52
|
|
01211 DTSCS52
|
|
01212 DTSCS52
|
|
01213 PERFORM P6921-MISC-INFO THRU P6921-EXIT. DTSCS52
|
|
01214 P6920-EXIT. DTSCS52
|
|
01215 EXIT. DTSCS52
|
|
01216 SKIP3 DTSCS52
|
|
01217 P6921-MISC-INFO. DTSCS52
|
|
01218 SET L054-RATE-LOOKUP-YES-88 TO TRUE. DTSCS52
|
|
01219 DTSCS52
|
|
01220 IF MAP-RATE-TYPE-ESTIM-88 DTSCS52
|
|
01221 OR MAP-RATE-TYPE-FINAL-88 DTSCS52
|
|
01222 SET L054-ESTIMATED-RATE-YES-88 TO TRUE DTSCS52
|
|
01223 ELSE DTSCS52
|
|
01224 SET L054-ESTIMATED-RATE-NO-88 TO TRUE. DTSCS52
|
|
01225 DTSCS52
|
|
01226 PERFORM S054-RATE-DETERMINATION THRU S054-EXIT. DTSCS52
|
|
01227 DTSCS52
|
|
01228 DTSCS52
|
|
01229 MOVE L054-CURRENT-RESERVE-AMT TO MAP-CURRENT-RESERVE-N. DTSCS52
|
|
01230 DTSCS52
|
|
01231 DTSCS52
|
|
01232 MOVE L054-AVG-TAX-WAGE TO MAP-AVG-TAX-WAGE-N. DTSCS52
|
|
01233 DTSCS52
|
|
01234 DTSCS52
|
|
01235 MOVE L054-RATIO TO L057-RATIO. DTSCS52
|
|
01236 DTSCS52
|
|
01237 PERFORM S057-RESERVE-RATIO-DISPLAY THRU S057-EXIT. DTSCS52
|
|
01238 DTSCS52
|
|
01239 MOVE L057-DISP-RATIO TO MAP-RESERVE-RATIO. DTSCS52
|
|
01240 DTSCS52
|
|
01241 DTSCS52
|
|
01242 MOVE SPACES TO MAP-RATE-A. DTSCS52
|
|
01243 DTSCS52
|
|
01244 IF L054-OK-88 DTSCS52
|
|
01245 IF L054-UI-PEN-RATE-YES-88 DTSCS52
|
|
01246 MOVE L054-UI-PEN-RATE TO L056-RATE DTSCS52
|
|
01247 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT DTSCS52
|
|
01248 MOVE '(' TO MAP-RATE-A-LEFT DTSCS52
|
|
01249 MOVE L056-DISP-RATE TO MAP-RATE-A-DISP DTSCS52
|
|
01250 MOVE ')' TO MAP-RATE-A-RIGHT DTSCS52
|
|
01251 END-IF DTSCS52
|
|
01252 MOVE L054-UI-CALC-RATE TO L056-RATE DTSCS52
|
|
01253 PERFORM S056-RATE-DISPLAY-RIGHT THRU S056-EXIT DTSCS52
|
|
01254 MOVE L056-DISP-RATE (3:5) TO MAP-RATE-B DTSCS52
|
|
01255 ELSE DTSCS52
|
|
01256 MOVE ' ?.?' TO MAP-RATE-B. DTSCS52
|
|
01257 DTSCS52
|
|
01258 DTSCS52
|
|
01259 MOVE L054-UI-PEN-RATE-CD TO MAP-PEN-RATE-IND. DTSCS52
|
|
01260 DTSCS52
|
|
01261 DTSCS52
|
|
01262 IF L054-CLASSIFIED-88 DTSCS52
|
|
01263 MOVE 'CLASSIFIED' TO MAP-RATE-CATEGORY-DSCR DTSCS52
|
|
01264 ELSE DTSCS52
|
|
01265 MOVE 'NONCLASSIFIED' TO MAP-RATE-CATEGORY-DSCR. DTSCS52
|
|
01266 P6921-EXIT. DTSCS52
|
|
01267 EXIT. DTSCS52
|
|
01268 SKIP3 DTSCS52
|
|
01269 P6990-PAGE-NUMBER. DTSCS52
|
|
01270 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS52
|
|
01271 DTSCS52
|
|
01272 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS52
|
|
01273 DTSCS52
|
|
01274 IF WS-REC-NUM = +1 DTSCS52
|
|
01275 IF LAST-REC-NUM = +1 DTSCS52
|
|
01276 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS52
|
|
01277 ELSE DTSCS52
|
|
01278 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS52
|
|
01279 ELSE DTSCS52
|
|
01280 IF WS-REC-NUM = LAST-REC-NUM DTSCS52
|
|
01281 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS52
|
|
01282 P6990-EXIT. DTSCS52
|
|
01283 EXIT. DTSCS52
|
|
01284 /*****************************************************************DTSCS52
|
|
01285 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS52
|
|
01286 ******************************************************************DTSCS52
|
|
01287 DTSCS52
|
|
01288 P7000-REQUEST-EDIT. DTSCS52
|
|
01289 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS52
|
|
01290 DTSCS52
|
|
01291 DTSCS52
|
|
01292 IF LCCM-F09-88 DTSCS52
|
|
01293 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS52
|
|
01294 ELSE DTSCS52
|
|
01295 IF LCCM-F10-88 DTSCS52
|
|
01296 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS52
|
|
01297 ELSE DTSCS52
|
|
01298 IF LCCM-F23-88 DTSCS52
|
|
01299 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS52
|
|
01300 ELSE DTSCS52
|
|
01301 GO TO S899-ABEND. DTSCS52
|
|
01302 DTSCS52
|
|
01303 DTSCS52
|
|
01304 *------------------------------------------------------ DTSCS52
|
|
01305 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS52
|
|
01306 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS52
|
|
01307 * REMAIN IN 'INQUIRE' STATUS. DTSCS52
|
|
01308 *------------------------------------------------------ DTSCS52
|
|
01309 DTSCS52
|
|
01310 IF LCCM-MSG DTSCS52
|
|
01311 NEXT SENTENCE DTSCS52
|
|
01312 ELSE DTSCS52
|
|
01313 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS52
|
|
01314 IF LCCM-F09-88 DTSCS52
|
|
01315 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS52
|
|
01316 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS52
|
|
01317 PERFORM P7010-PSUEDO-UPDATE THRU P7010-EXIT DTSCS52
|
|
01318 ELSE DTSCS52
|
|
01319 IF LCCM-F10-88 DTSCS52
|
|
01320 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS52
|
|
01321 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS52
|
|
01322 PERFORM P7010-PSUEDO-UPDATE THRU P7010-EXIT DTSCS52
|
|
01323 ELSE DTSCS52
|
|
01324 IF LCCM-F23-88 DTSCS52
|
|
01325 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS52
|
|
01326 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS52
|
|
01327 DTSCS52
|
|
01328 DTSCS52
|
|
01329 SET RESP-SEND-MAP TO TRUE. DTSCS52
|
|
01330 P7000-EXIT. DTSCS52
|
|
01331 EXIT. DTSCS52
|
|
01332 SKIP3 DTSCS52
|
|
01333 P7010-PSUEDO-UPDATE. DTSCS52
|
|
01334 MOVE MAP-AREA TO WRK-HOLD-AREA. DTSCS52
|
|
01335 DTSCS52
|
|
01336 DTSCS52
|
|
01337 *****PERFORM DTSCS52
|
|
01338 ******VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
01339 ******UNTIL WRK-CTR > 4 DTSCS52
|
|
01340 *********MOVE 0 TO WRK-TBL-TOT (WRK-CTR) DTSCS52
|
|
01341 *********SET WRK-TBL-OK-88 (WRK-CTR) TO TRUE DTSCS52
|
|
01342 *****END-PERFORM. DTSCS52
|
|
01343 DTSCS52
|
|
01344 DTSCS52
|
|
01345 IF LCCM-SCR-ADD-LOCKED DTSCS52
|
|
01346 PERFORM P8110-CONSTRUCT-MRCT THRU P8110-EXIT DTSCS52
|
|
01347 ELSE DTSCS52
|
|
01348 PERFORM P8210-CONSTRUCT-MRCT THRU P8210-EXIT. DTSCS52
|
|
01349 DTSCS52
|
|
01350 DTSCS52
|
|
01351 MOVE WRK-HOLD-AREA TO MAP-AREA. DTSCS52
|
|
01352 DTSCS52
|
|
01353 DTSCS52
|
|
01354 PERFORM P6921-MISC-INFO THRU P6921-EXIT. DTSCS52
|
|
01355 DTSCS52
|
|
01356 DTSCS52
|
|
01357 *****PERFORM S9335-TOTALS THRU S9335-EXIT. DTSCS52
|
|
01358 P7010-EXIT. DTSCS52
|
|
01359 EXIT. DTSCS52
|
|
01360 /*****************************************************************DTSCS52
|
|
01361 * ADD FUNCTION WAS REQUESTED *DTSCS52
|
|
01362 ******************************************************************DTSCS52
|
|
01363 DTSCS52
|
|
01364 P7100-EDIT-ADD. DTSCS52
|
|
01365 DTSCS52
|
|
01366 *----------------------------------------------------- DTSCS52
|
|
01367 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS52
|
|
01368 *----------------------------------------------------- DTSCS52
|
|
01369 DTSCS52
|
|
01370 IF NOT LCCM-SCR-CLEAR DTSCS52
|
|
01371 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS52
|
|
01372 GO TO P7100-EXIT. DTSCS52
|
|
01373 DTSCS52
|
|
01374 DTSCS52
|
|
01375 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
01376 DTSCS52
|
|
01377 IF LCCM-MSG DTSCS52
|
|
01378 GO TO P7100-EXIT. DTSCS52
|
|
01379 DTSCS52
|
|
01380 DTSCS52
|
|
01381 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS52
|
|
01382 P7100-EXIT. DTSCS52
|
|
01383 EXIT. DTSCS52
|
|
01384 /*****************************************************************DTSCS52
|
|
01385 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS52
|
|
01386 ******************************************************************DTSCS52
|
|
01387 DTSCS52
|
|
01388 P7200-EDIT-MOD. DTSCS52
|
|
01389 DTSCS52
|
|
01390 *----------------------------------------------------- DTSCS52
|
|
01391 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS52
|
|
01392 * INQUIRED DTSCS52
|
|
01393 *----------------------------------------------------- DTSCS52
|
|
01394 DTSCS52
|
|
01395 IF NOT LCCM-SCR-INQUIRE DTSCS52
|
|
01396 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS52
|
|
01397 GO TO P7200-EXIT. DTSCS52
|
|
01398 DTSCS52
|
|
01399 DTSCS52
|
|
01400 *----------------------------------------------------- DTSCS52
|
|
01401 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS52
|
|
01402 *----------------------------------------------------- DTSCS52
|
|
01403 DTSCS52
|
|
01404 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
01405 DTSCS52
|
|
01406 IF LCCM-MSG DTSCS52
|
|
01407 GO TO P7200-EXIT. DTSCS52
|
|
01408 DTSCS52
|
|
01409 DTSCS52
|
|
01410 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS52
|
|
01411 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS52
|
|
01412 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
01413 GO TO P7200-EXIT. DTSCS52
|
|
01414 DTSCS52
|
|
01415 DTSCS52
|
|
01416 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS52
|
|
01417 P7200-EXIT. DTSCS52
|
|
01418 EXIT. DTSCS52
|
|
01419 /*****************************************************************DTSCS52
|
|
01420 * DELETE FUNCTION WAS REQUESTED *DTSCS52
|
|
01421 ******************************************************************DTSCS52
|
|
01422 DTSCS52
|
|
01423 P7300-EDIT-DEL. DTSCS52
|
|
01424 DTSCS52
|
|
01425 *----------------------------------------------------- DTSCS52
|
|
01426 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS52
|
|
01427 * INQUIRED DTSCS52
|
|
01428 *----------------------------------------------------- DTSCS52
|
|
01429 DTSCS52
|
|
01430 IF NOT LCCM-SCR-INQUIRE DTSCS52
|
|
01431 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS52
|
|
01432 GO TO P7300-EXIT. DTSCS52
|
|
01433 DTSCS52
|
|
01434 DTSCS52
|
|
01435 *----------------------------------------------------- DTSCS52
|
|
01436 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DEL DTSCS52
|
|
01437 *----------------------------------------------------- DTSCS52
|
|
01438 DTSCS52
|
|
01439 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
01440 DTSCS52
|
|
01441 IF LCCM-MSG DTSCS52
|
|
01442 GO TO P7300-EXIT. DTSCS52
|
|
01443 DTSCS52
|
|
01444 DTSCS52
|
|
01445 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS52
|
|
01446 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS52
|
|
01447 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
01448 GO TO P7300-EXIT. DTSCS52
|
|
01449 P7300-EXIT. DTSCS52
|
|
01450 EXIT. DTSCS52
|
|
01451 /*****************************************************************DTSCS52
|
|
01452 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS52
|
|
01453 ******************************************************************DTSCS52
|
|
01454 DTSCS52
|
|
01455 P8000-REQUEST-UPDATE. DTSCS52
|
|
01456 IF LCCM-SCR-ADD-LOCKED DTSCS52
|
|
01457 PERFORM P8100-ADD THRU P8100-EXIT DTSCS52
|
|
01458 ELSE DTSCS52
|
|
01459 IF LCCM-SCR-MOD-LOCKED DTSCS52
|
|
01460 PERFORM P8200-MOD THRU P8200-EXIT DTSCS52
|
|
01461 ELSE DTSCS52
|
|
01462 IF LCCM-SCR-DEL-LOCKED DTSCS52
|
|
01463 PERFORM P8300-DEL THRU P8300-EXIT DTSCS52
|
|
01464 ELSE DTSCS52
|
|
01465 GO TO S899-ABEND. DTSCS52
|
|
01466 DTSCS52
|
|
01467 DTSCS52
|
|
01468 SET RESP-SEND-MAP TO TRUE. DTSCS52
|
|
01469 P8000-EXIT. DTSCS52
|
|
01470 EXIT. DTSCS52
|
|
01471 /*****************************************************************DTSCS52
|
|
01472 * *DTSCS52
|
|
01473 ******************************************************************DTSCS52
|
|
01474 DTSCS52
|
|
01475 P8100-ADD. DTSCS52
|
|
01476 SET LCCM-SCR-CLEAR TO TRUE. DTSCS52
|
|
01477 DTSCS52
|
|
01478 DTSCS52
|
|
01479 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS52
|
|
01480 DTSCS52
|
|
01481 DTSCS52
|
|
01482 IF LCCM-F12-88 DTSCS52
|
|
01483 PERFORM P8120-REVERSE-PSUEDO-UPDATE THRU P8120-EXIT DTSCS52
|
|
01484 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS52
|
|
01485 GO TO P8100-EXIT. DTSCS52
|
|
01486 DTSCS52
|
|
01487 DTSCS52
|
|
01488 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
01489 DTSCS52
|
|
01490 DTSCS52
|
|
01491 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS52
|
|
01492 DTSCS52
|
|
01493 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS52
|
|
01494 DTSCS52
|
|
01495 IF LCCM-MSG DTSCS52
|
|
01496 GO TO P8100-EXIT. DTSCS52
|
|
01497 DTSCS52
|
|
01498 DTSCS52
|
|
01499 MOVE LOW-VALUES TO MRCT-DATA-AREA. DTSCS52
|
|
01500 DTSCS52
|
|
01501 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS52
|
|
01502 DTSCS52
|
|
01503 PERFORM P8110-CONSTRUCT-MRCT THRU P8110-EXIT. DTSCS52
|
|
01504 DTSCS52
|
|
01505 MOVE MRCT-REC TO MSKL-REC. DTSCS52
|
|
01506 DTSCS52
|
|
01507 PERFORM S810-WRITE THRU S810-EXIT. DTSCS52
|
|
01508 DTSCS52
|
|
01509 DTSCS52
|
|
01510 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS52
|
|
01511 DTSCS52
|
|
01512 DTSCS52
|
|
01513 MOVE MRCT-KEY-AREA TO LCCM-SCR52-HOLD-AREA. DTSCS52
|
|
01514 DTSCS52
|
|
01515 SET LCCM-ENTER-88 TO TRUE. DTSCS52
|
|
01516 DTSCS52
|
|
01517 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS52
|
|
01518 DTSCS52
|
|
01519 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS52
|
|
01520 DTSCS52
|
|
01521 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS52
|
|
01522 P8100-EXIT. DTSCS52
|
|
01523 EXIT. DTSCS52
|
|
01524 SKIP3 DTSCS52
|
|
01525 P8110-CONSTRUCT-MRCT. DTSCS52
|
|
01526 MOVE LOW-VALUES TO MRCT-REC. DTSCS52
|
|
01527 DTSCS52
|
|
01528 DTSCS52
|
|
01529 MOVE WRK-EMP-NO TO MRCT-EMP-NO. DTSCS52
|
|
01530 DTSCS52
|
|
01531 DTSCS52
|
|
01532 SET MRCT-RCT-88 TO TRUE. DTSCS52
|
|
01533 DTSCS52
|
|
01534 DTSCS52
|
|
01535 MOVE MAP-EFF-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS52
|
|
01536 DTSCS52
|
|
01537 PERFORM S016-QTR-FROM-SCREEN THRU S016-EXIT. DTSCS52
|
|
01538 DTSCS52
|
|
01539 MOVE L016-YRQ TO MRCT-EFF-YRQ. DTSCS52
|
|
01540 DTSCS52
|
|
01541 DTSCS52
|
|
01542 MOVE +0 TO MRCT-PURGE-DATE. DTSCS52
|
|
01543 DTSCS52
|
|
01544 DTSCS52
|
|
01545 PERFORM P8900-MLOG-INIT THRU P8900-EXIT. DTSCS52
|
|
01546 DTSCS52
|
|
01547 DTSCS52
|
|
01548 MOVE MAP-ACTIVE-IND TO MRCT-ACTIVE-IND. DTSCS52
|
|
01549 DTSCS52
|
|
01550 PERFORM P8900-MLOG-ACTIVE-IND THRU P8900-EXIT. DTSCS52
|
|
01551 DTSCS52
|
|
01552 DTSCS52
|
|
01553 MOVE MAP-PRIOR-RESERVE-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01554 DTSCS52
|
|
01555 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01556 DTSCS52
|
|
01557 MOVE L011-AMT TO MRCT-PRIOR-RESERVE-AMT. DTSCS52
|
|
01558 DTSCS52
|
|
01559 IF L011-AMT NOT = +0 DTSCS52
|
|
01560 PERFORM P8900-MLOG-PRIOR-RESERVE-AMT THRU P8900-EXIT. DTSCS52
|
|
01561 DTSCS52
|
|
01562 DTSCS52
|
|
01563 MOVE MAP-UI-TAX-PAID-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01564 DTSCS52
|
|
01565 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01566 DTSCS52
|
|
01567 MOVE L011-AMT TO MRCT-UI-TAX-PAID-AMT. DTSCS52
|
|
01568 DTSCS52
|
|
01569 IF L011-AMT NOT = +0 DTSCS52
|
|
01570 PERFORM P8900-MLOG-UI-TAX-PAID-AMT THRU P8900-EXIT. DTSCS52
|
|
01571 DTSCS52
|
|
01572 DTSCS52
|
|
01573 MOVE MAP-TRUST-FUND-INT-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01574 DTSCS52
|
|
01575 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01576 DTSCS52
|
|
01577 MOVE L011-AMT TO MRCT-TRUST-FUND-INTEREST-AMT. DTSCS52
|
|
01578 DTSCS52
|
|
01579 IF L011-AMT NOT = +0 DTSCS52
|
|
01580 PERFORM P8900-MLOG-TRUST-FUND-INT-AMT THRU P8900-EXIT. DTSCS52
|
|
01581 DTSCS52
|
|
01582 DTSCS52
|
|
01583 MOVE MAP-UI-BEN-CHRGD-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01584 DTSCS52
|
|
01585 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01586 DTSCS52
|
|
01587 MOVE L011-AMT TO MRCT-BENEFITS-CHARGED-AMT. DTSCS52
|
|
01588 DTSCS52
|
|
01589 IF L011-AMT NOT = +0 DTSCS52
|
|
01590 PERFORM P8900-MLOG-BENEFITS-CHRGD-AMT THRU P8900-EXIT. DTSCS52
|
|
01591 DTSCS52
|
|
01592 DTSCS52
|
|
01593 PERFORM DTSCS52
|
|
01594 VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
01595 UNTIL WRK-CTR > 3 DTSCS52
|
|
01596 MOVE +0 TO MRCT-TOT-WAGE (WRK-CTR) DTSCS52
|
|
01597 MRCT-TAX-WAGE (WRK-CTR) DTSCS52
|
|
01598 MOVE MAP-TOT-WAGE-CHNG-AREA (WRK-CTR) DTSCS52
|
|
01599 TO L011-S-AMT-AREA DTSCS52
|
|
01600 PERFORM S011-MAX-LIMITS THRU S011-EXIT DTSCS52
|
|
01601 IF L011-AMT NOT = +0 DTSCS52
|
|
01602 ADD L011-AMT TO MRCT-TOT-WAGE (WRK-CTR) DTSCS52
|
|
01603 PERFORM P8900-MLOG-TOT-WAGE THRU P8900-EXIT DTSCS52
|
|
01604 END-IF DTSCS52
|
|
01605 MOVE MAP-TAX-WAGE-CHNG-AREA (WRK-CTR) DTSCS52
|
|
01606 TO L011-S-AMT-AREA DTSCS52
|
|
01607 PERFORM S011-MAX-LIMITS THRU S011-EXIT DTSCS52
|
|
01608 IF L011-AMT NOT = +0 DTSCS52
|
|
01609 ADD L011-AMT TO MRCT-TAX-WAGE (WRK-CTR) DTSCS52
|
|
01610 PERFORM P8900-MLOG-TAX-WAGE THRU P8900-EXIT DTSCS52
|
|
01611 END-IF DTSCS52
|
|
01612 END-PERFORM. DTSCS52
|
|
01613 DTSCS52
|
|
01614 DTSCS52
|
|
01615 MOVE MAP-EARLIEST-LIAB-DATE-AREA TO L015-S-DATE-AREA. DTSCS52
|
|
01616 DTSCS52
|
|
01617 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS52
|
|
01618 DTSCS52
|
|
01619 MOVE L015-DATE TO MRCT-EARLIEST-LIAB-DATE. DTSCS52
|
|
01620 DTSCS52
|
|
01621 PERFORM P8900-MLOG-EARLIEST-LIAB-DATE THRU P8900-EXIT. DTSCS52
|
|
01622 DTSCS52
|
|
01623 DTSCS52
|
|
01624 MOVE MAP-MISS-RPT-CNT-AREA TO L013-S-CNT-AREA. DTSCS52
|
|
01625 DTSCS52
|
|
01626 PERFORM S013-MAX-LIMITS THRU S013-EXIT. DTSCS52
|
|
01627 DTSCS52
|
|
01628 MOVE L013-CNT TO MRCT-MISS-RPT-CNT. DTSCS52
|
|
01629 DTSCS52
|
|
01630 IF L013-CNT NOT = +0 DTSCS52
|
|
01631 PERFORM P8900-MLOG-MISS-RPT-CNT THRU P8900-EXIT. DTSCS52
|
|
01632 DTSCS52
|
|
01633 DTSCS52
|
|
01634 MOVE MAP-UI-TAX-DUE-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01635 DTSCS52
|
|
01636 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01637 DTSCS52
|
|
01638 MOVE L011-AMT TO MRCT-TOT-UI-TAX-BALANCE-AMT. DTSCS52
|
|
01639 DTSCS52
|
|
01640 IF L011-AMT NOT = +0 DTSCS52
|
|
01641 PERFORM P8900-MLOG-TOT-DUE-AMT THRU P8900-EXIT. DTSCS52
|
|
01642 DTSCS52
|
|
01643 DTSCS52
|
|
01644 MOVE MAP-PRED-DUE-IND TO MRCT-PRED-DUE-IND DTSCS52
|
|
01645 DTSCS52
|
|
01646 PERFORM P8900-MLOG-PRED-DUE-IND THRU P8900-EXIT. DTSCS52
|
|
01647 DTSCS52
|
|
01648 DTSCS52
|
|
01649 MOVE MAP-TRNSF-TO-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS52
|
|
01650 DTSCS52
|
|
01651 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS52
|
|
01652 DTSCS52
|
|
01653 MOVE L018-EMP-NO TO MRCT-TRANSFERRED-TO-EMP-NO. DTSCS52
|
|
01654 DTSCS52
|
|
01655 IF L018-EMP-NO NOT = +0 DTSCS52
|
|
01656 PERFORM P8900-MLOG-TRNSFR-TO-EMP-NO THRU P8900-EXIT. DTSCS52
|
|
01657 DTSCS52
|
|
01658 DTSCS52
|
|
01659 MOVE LCCM-OP-ID TO MRCT-CHNG-OP-ID DTSCS52
|
|
01660 DTSCS52
|
|
01661 SET MRCT-NOT-CONVERTED-88 TO TRUE. DTSCS52
|
|
01662 DTSCS52
|
|
01663 MOVE LCCM-CURR-RUN-DATE TO MRCT-ESTB-DATE. DTSCS52
|
|
01664 DTSCS52
|
|
01665 MOVE LCCM-CURR-RUN-DATE TO MRCT-CHNG-DATE. DTSCS52
|
|
01666 P8110-EXIT. DTSCS52
|
|
01667 EXIT. DTSCS52
|
|
01668 EJECT DTSCS52
|
|
01669 P8120-REVERSE-PSUEDO-UPDATE. DTSCS52
|
|
01670 MOVE LOW-VALUES TO MAP-PRIOR-DATE-DISP DTSCS52
|
|
01671 MAP-PRIOR-RESERVE DTSCS52
|
|
01672 MAP-UI-TAX-PAID DTSCS52
|
|
01673 MAP-TRUST-FUND-INT DTSCS52
|
|
01674 MAP-UI-BEN-CHRGD. DTSCS52
|
|
01675 DTSCS52
|
|
01676 PERFORM DTSCS52
|
|
01677 VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
01678 UNTIL WRK-CTR > +3 DTSCS52
|
|
01679 MOVE LOW-VALUES TO MAP-START-YRQ (WRK-CTR) DTSCS52
|
|
01680 MAP-END-YRQ (WRK-CTR) DTSCS52
|
|
01681 MAP-TOT-WAGE (WRK-CTR) DTSCS52
|
|
01682 MAP-TAX-WAGE (WRK-CTR) DTSCS52
|
|
01683 END-PERFORM. DTSCS52
|
|
01684 DTSCS52
|
|
01685 MOVE LOW-VALUES TO MAP-CURRENT-RESERVE DTSCS52
|
|
01686 MAP-CURRENT-DATE-DISP DTSCS52
|
|
01687 MAP-AVG-TAX-WAGE DTSCS52
|
|
01688 MAP-RESERVE-RATIO DTSCS52
|
|
01689 MAP-RATE-A DTSCS52
|
|
01690 MAP-RATE-B DTSCS52
|
|
01691 MAP-PEN-RATE-IND DTSCS52
|
|
01692 MAP-RATE-CATEGORY-DSCR DTSCS52
|
|
01693 MAP-ESTB-DATE DTSCS52
|
|
01694 MAP-CHNG-DATE DTSCS52
|
|
01695 MAP-CHNG-OPID. DTSCS52
|
|
01696 P8120-EXIT. DTSCS52
|
|
01697 EXIT. DTSCS52
|
|
01698 /*****************************************************************DTSCS52
|
|
01699 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS52
|
|
01700 ******************************************************************DTSCS52
|
|
01701 DTSCS52
|
|
01702 P8200-MOD. DTSCS52
|
|
01703 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS52
|
|
01704 DTSCS52
|
|
01705 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS52
|
|
01706 DTSCS52
|
|
01707 IF LCCM-F12-88 DTSCS52
|
|
01708 PERFORM P8220-REVERSE-PSEUDO-UPDATE THRU P8220-EXIT DTSCS52
|
|
01709 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS52
|
|
01710 GO TO P8200-EXIT. DTSCS52
|
|
01711 DTSCS52
|
|
01712 DTSCS52
|
|
01713 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
01714 DTSCS52
|
|
01715 DTSCS52
|
|
01716 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS52
|
|
01717 DTSCS52
|
|
01718 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS52
|
|
01719 DTSCS52
|
|
01720 IF LCCM-MSG DTSCS52
|
|
01721 GO TO P8200-EXIT. DTSCS52
|
|
01722 DTSCS52
|
|
01723 DTSCS52
|
|
01724 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS52
|
|
01725 DTSCS52
|
|
01726 DTSCS52
|
|
01727 PERFORM P8210-CONSTRUCT-MRCT THRU P8210-EXIT. DTSCS52
|
|
01728 DTSCS52
|
|
01729 DTSCS52
|
|
01730 MOVE MRCT-REC TO MSKL-REC. DTSCS52
|
|
01731 DTSCS52
|
|
01732 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS52
|
|
01733 DTSCS52
|
|
01734 DTSCS52
|
|
01735 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS52
|
|
01736 DTSCS52
|
|
01737 DTSCS52
|
|
01738 SET LCCM-ENTER-88 TO TRUE. DTSCS52
|
|
01739 DTSCS52
|
|
01740 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS52
|
|
01741 DTSCS52
|
|
01742 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS52
|
|
01743 DTSCS52
|
|
01744 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS52
|
|
01745 P8200-EXIT. DTSCS52
|
|
01746 EXIT. DTSCS52
|
|
01747 EJECT DTSCS52
|
|
01748 P8210-CONSTRUCT-MRCT. DTSCS52
|
|
01749 MOVE LCCM-SCR52-HOLD-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
01750 DTSCS52
|
|
01751 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
01752 DTSCS52
|
|
01753 IF L810-NO-REC-88 DTSCS52
|
|
01754 GO TO S899-ABEND. DTSCS52
|
|
01755 DTSCS52
|
|
01756 DTSCS52
|
|
01757 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
01758 DTSCS52
|
|
01759 DTSCS52
|
|
01760 PERFORM P8900-MLOG-INIT THRU P8900-EXIT. DTSCS52
|
|
01761 DTSCS52
|
|
01762 DTSCS52
|
|
01763 IF MAP-ACTIVE-IND NOT = MRCT-ACTIVE-IND DTSCS52
|
|
01764 MOVE MRCT-ACTIVE-IND TO L331-FROM-VALUE DTSCS52
|
|
01765 MOVE MAP-ACTIVE-IND TO MRCT-ACTIVE-IND DTSCS52
|
|
01766 PERFORM P8900-MLOG-ACTIVE-IND THRU P8900-EXIT. DTSCS52
|
|
01767 DTSCS52
|
|
01768 DTSCS52
|
|
01769 MOVE MAP-PRIOR-RESERVE-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01770 DTSCS52
|
|
01771 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01772 DTSCS52
|
|
01773 IF L011-AMT NOT = +0 DTSCS52
|
|
01774 MOVE MRCT-PRIOR-RESERVE-AMT TO WRK-NUM-N DTSCS52
|
|
01775 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01776 ADD L011-AMT TO MRCT-PRIOR-RESERVE-AMT DTSCS52
|
|
01777 PERFORM P8900-MLOG-PRIOR-RESERVE-AMT THRU P8900-EXIT. DTSCS52
|
|
01778 DTSCS52
|
|
01779 DTSCS52
|
|
01780 MOVE MAP-UI-TAX-PAID-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01781 DTSCS52
|
|
01782 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01783 DTSCS52
|
|
01784 IF L011-AMT NOT = +0 DTSCS52
|
|
01785 MOVE MRCT-UI-TAX-PAID-AMT TO WRK-NUM-N DTSCS52
|
|
01786 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01787 ADD L011-AMT TO MRCT-UI-TAX-PAID-AMT DTSCS52
|
|
01788 PERFORM P8900-MLOG-UI-TAX-PAID-AMT THRU P8900-EXIT. DTSCS52
|
|
01789 DTSCS52
|
|
01790 DTSCS52
|
|
01791 MOVE MAP-TRUST-FUND-INT-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01792 DTSCS52
|
|
01793 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01794 DTSCS52
|
|
01795 IF L011-AMT NOT = +0 DTSCS52
|
|
01796 MOVE MRCT-TRUST-FUND-INTEREST-AMT TO WRK-NUM-N DTSCS52
|
|
01797 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01798 ADD L011-AMT TO MRCT-TRUST-FUND-INTEREST-AMT DTSCS52
|
|
01799 PERFORM P8900-MLOG-TRUST-FUND-INT-AMT THRU P8900-EXIT. DTSCS52
|
|
01800 DTSCS52
|
|
01801 DTSCS52
|
|
01802 MOVE MAP-UI-BEN-CHRGD-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01803 DTSCS52
|
|
01804 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01805 DTSCS52
|
|
01806 IF L011-AMT NOT = +0 DTSCS52
|
|
01807 MOVE MRCT-BENEFITS-CHARGED-AMT TO WRK-NUM-N DTSCS52
|
|
01808 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01809 ADD L011-AMT TO MRCT-BENEFITS-CHARGED-AMT DTSCS52
|
|
01810 PERFORM P8900-MLOG-BENEFITS-CHRGD-AMT THRU P8900-EXIT. DTSCS52
|
|
01811 DTSCS52
|
|
01812 DTSCS52
|
|
01813 PERFORM DTSCS52
|
|
01814 VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
01815 UNTIL WRK-CTR > 3 DTSCS52
|
|
01816 MOVE MAP-TOT-WAGE-CHNG-AREA (WRK-CTR) DTSCS52
|
|
01817 TO L011-S-AMT-AREA DTSCS52
|
|
01818 PERFORM S011-MAX-LIMITS THRU S011-EXIT DTSCS52
|
|
01819 IF L011-AMT NOT = +0 DTSCS52
|
|
01820 MOVE MRCT-TOT-WAGE (WRK-CTR) TO WRK-NUM-N DTSCS52
|
|
01821 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01822 ADD L011-AMT TO MRCT-TOT-WAGE (WRK-CTR) DTSCS52
|
|
01823 PERFORM P8900-MLOG-TOT-WAGE THRU P8900-EXIT DTSCS52
|
|
01824 END-IF DTSCS52
|
|
01825 MOVE MAP-TAX-WAGE-CHNG-AREA (WRK-CTR) DTSCS52
|
|
01826 TO L011-S-AMT-AREA DTSCS52
|
|
01827 PERFORM S011-MAX-LIMITS THRU S011-EXIT DTSCS52
|
|
01828 IF L011-AMT NOT = +0 DTSCS52
|
|
01829 MOVE MRCT-TAX-WAGE (WRK-CTR) TO WRK-NUM-N DTSCS52
|
|
01830 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01831 ADD L011-AMT TO MRCT-TAX-WAGE (WRK-CTR) DTSCS52
|
|
01832 PERFORM P8900-MLOG-TAX-WAGE THRU P8900-EXIT DTSCS52
|
|
01833 END-IF DTSCS52
|
|
01834 END-PERFORM. DTSCS52
|
|
01835 DTSCS52
|
|
01836 DTSCS52
|
|
01837 MOVE MAP-EARLIEST-LIAB-DATE-AREA TO L015-S-DATE-AREA. DTSCS52
|
|
01838 DTSCS52
|
|
01839 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS52
|
|
01840 DTSCS52
|
|
01841 IF L015-DATE NOT = MRCT-EARLIEST-LIAB-DATE DTSCS52
|
|
01842 MOVE MRCT-EARLIEST-LIAB-DATE TO L001-FED-8-DATE-9 DTSCS52
|
|
01843 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS52
|
|
01844 MOVE L001-SLASH-8-DATE TO L331-FROM-VALUE DTSCS52
|
|
01845 MOVE L015-DATE TO MRCT-EARLIEST-LIAB-DATE DTSCS52
|
|
01846 PERFORM P8900-MLOG-EARLIEST-LIAB-DATE THRU P8900-EXIT. DTSCS52
|
|
01847 DTSCS52
|
|
01848 DTSCS52
|
|
01849 MOVE MAP-MISS-RPT-CNT-AREA TO L013-S-CNT-AREA. DTSCS52
|
|
01850 DTSCS52
|
|
01851 PERFORM S013-MAX-LIMITS THRU S013-EXIT. DTSCS52
|
|
01852 DTSCS52
|
|
01853 IF L013-CNT NOT = MRCT-MISS-RPT-CNT DTSCS52
|
|
01854 MOVE MRCT-MISS-RPT-CNT TO WRK-MISS-RPT-CNT-N DTSCS52
|
|
01855 MOVE WRK-MISS-RPT-CNT-N TO L331-FROM-VALUE DTSCS52
|
|
01856 MOVE L013-CNT TO MRCT-MISS-RPT-CNT DTSCS52
|
|
01857 PERFORM P8900-MLOG-MISS-RPT-CNT THRU P8900-EXIT. DTSCS52
|
|
01858 DTSCS52
|
|
01859 DTSCS52
|
|
01860 MOVE MAP-UI-TAX-DUE-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
01861 DTSCS52
|
|
01862 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
01863 DTSCS52
|
|
01864 IF L011-AMT NOT = MRCT-TOT-UI-TAX-BALANCE-AMT DTSCS52
|
|
01865 MOVE MRCT-TOT-UI-TAX-BALANCE-AMT TO WRK-NUM-N DTSCS52
|
|
01866 MOVE WRK-NUM-N TO L331-FROM-VALUE DTSCS52
|
|
01867 MOVE L011-AMT TO MRCT-TOT-UI-TAX-BALANCE-AMT DTSCS52
|
|
01868 PERFORM P8900-MLOG-TOT-DUE-AMT THRU P8900-EXIT. DTSCS52
|
|
01869 DTSCS52
|
|
01870 DTSCS52
|
|
01871 IF MAP-PRED-DUE-IND NOT = MRCT-PRED-DUE-IND DTSCS52
|
|
01872 MOVE MRCT-PRED-DUE-IND TO L331-FROM-VALUE DTSCS52
|
|
01873 MOVE MAP-PRED-DUE-IND TO MRCT-PRED-DUE-IND DTSCS52
|
|
01874 PERFORM P8900-MLOG-PRED-DUE-IND THRU P8900-EXIT. DTSCS52
|
|
01875 DTSCS52
|
|
01876 DTSCS52
|
|
01877 MOVE MAP-TRNSF-TO-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS52
|
|
01878 DTSCS52
|
|
01879 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS52
|
|
01880 DTSCS52
|
|
01881 IF L018-EMP-NO NOT = MRCT-TRANSFERRED-TO-EMP-NO DTSCS52
|
|
01882 MOVE MRCT-TRANSFERRED-TO-EMP-NO TO WRK-DISPLAY DTSCS52
|
|
01883 MOVE SPACES TO L331-FROM-VALUE DTSCS52
|
|
01884 STRING DTSCS52
|
|
01885 WRK-DISPLAY-EMP-NO-1 DELIMITED BY SIZE DTSCS52
|
|
01886 ' ' DELIMITED BY SIZE DTSCS52
|
|
01887 WRK-DISPLAY-EMP-NO-2 DELIMITED BY SIZE DTSCS52
|
|
01888 INTO DTSCS52
|
|
01889 L331-FROM-VALUE DTSCS52
|
|
01890 END-STRING DTSCS52
|
|
01891 MOVE L018-EMP-NO TO MRCT-TRANSFERRED-TO-EMP-NO DTSCS52
|
|
01892 PERFORM P8900-MLOG-TRNSFR-TO-EMP-NO THRU P8900-EXIT. DTSCS52
|
|
01893 DTSCS52
|
|
01894 DTSCS52
|
|
01895 MOVE LCCM-OP-ID TO MRCT-CHNG-OP-ID DTSCS52
|
|
01896 DTSCS52
|
|
01897 MOVE LCCM-CURR-RUN-DATE TO MRCT-CHNG-DATE. DTSCS52
|
|
01898 P8210-EXIT. DTSCS52
|
|
01899 EXIT. DTSCS52
|
|
01900 EJECT DTSCS52
|
|
01901 P8220-REVERSE-PSEUDO-UPDATE. DTSCS52
|
|
01902 MOVE LCCM-SCR52-HOLD-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
01903 DTSCS52
|
|
01904 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
01905 DTSCS52
|
|
01906 IF L810-NO-REC-88 DTSCS52
|
|
01907 GO TO P8220-EXIT. DTSCS52
|
|
01908 DTSCS52
|
|
01909 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
01910 DTSCS52
|
|
01911 DTSCS52
|
|
01912 PERFORM P6921-MISC-INFO THRU P6921-EXIT. DTSCS52
|
|
01913 P8220-EXIT. DTSCS52
|
|
01914 EXIT. DTSCS52
|
|
01915 /*****************************************************************DTSCS52
|
|
01916 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS52
|
|
01917 ******************************************************************DTSCS52
|
|
01918 DTSCS52
|
|
01919 P8300-DEL. DTSCS52
|
|
01920 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS52
|
|
01921 DTSCS52
|
|
01922 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS52
|
|
01923 DTSCS52
|
|
01924 DTSCS52
|
|
01925 IF LCCM-F12-88 DTSCS52
|
|
01926 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS52
|
|
01927 GO TO P8300-EXIT. DTSCS52
|
|
01928 DTSCS52
|
|
01929 DTSCS52
|
|
01930 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS52
|
|
01931 DTSCS52
|
|
01932 DTSCS52
|
|
01933 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS52
|
|
01934 DTSCS52
|
|
01935 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS52
|
|
01936 DTSCS52
|
|
01937 IF LCCM-MSG DTSCS52
|
|
01938 GO TO P8300-EXIT. DTSCS52
|
|
01939 DTSCS52
|
|
01940 DTSCS52
|
|
01941 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS52
|
|
01942 DTSCS52
|
|
01943 MOVE LCCM-SCR52-HOLD-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
01944 DTSCS52
|
|
01945 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
01946 DTSCS52
|
|
01947 IF L810-NO-REC-88 DTSCS52
|
|
01948 GO TO S899-ABEND. DTSCS52
|
|
01949 DTSCS52
|
|
01950 DTSCS52
|
|
01951 MOVE MSKL-REC TO MRCT-REC. DTSCS52
|
|
01952 DTSCS52
|
|
01953 DTSCS52
|
|
01954 PERFORM S810-DELETE THRU S810-EXIT. DTSCS52
|
|
01955 DTSCS52
|
|
01956 DTSCS52
|
|
01957 PERFORM P8900-MLOG-INIT THRU P8900-EXIT. DTSCS52
|
|
01958 DTSCS52
|
|
01959 MOVE 'MRCT' TO L331-FIELD-NAME. DTSCS52
|
|
01960 DTSCS52
|
|
01961 MOVE 'RECORD DELETED ' TO L331-FROM-VALUE. DTSCS52
|
|
01962 DTSCS52
|
|
01963 MOVE SPACES TO L331-TO-VALUE. DTSCS52
|
|
01964 DTSCS52
|
|
01965 PERFORM P8900-MLOG-WRITE THRU P8900-EXIT. DTSCS52
|
|
01966 DTSCS52
|
|
01967 DTSCS52
|
|
01968 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS52
|
|
01969 DTSCS52
|
|
01970 DTSCS52
|
|
01971 MOVE LOW-VALUES TO MAP-AREA. DTSCS52
|
|
01972 DTSCS52
|
|
01973 DTSCS52
|
|
01974 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS52
|
|
01975 DTSCS52
|
|
01976 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS52
|
|
01977 DTSCS52
|
|
01978 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS52
|
|
01979 DTSCS52
|
|
01980 DTSCS52
|
|
01981 MOVE MRCT-EFF-YRQ TO WRK-DISPLAY. DTSCS52
|
|
01982 DTSCS52
|
|
01983 MOVE WRK-DISPLAY-QTR-YR TO MAP-EFF-QTR-YR. DTSCS52
|
|
01984 DTSCS52
|
|
01985 MOVE WRK-DISPLAY-QTR-Q TO MAP-EFF-QTR-Q. DTSCS52
|
|
01986 DTSCS52
|
|
01987 DTSCS52
|
|
01988 SET LCCM-SCR-CLEAR TO TRUE. DTSCS52
|
|
01989 DTSCS52
|
|
01990 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS52
|
|
01991 DTSCS52
|
|
01992 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS52
|
|
01993 DTSCS52
|
|
01994 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS52
|
|
01995 P8300-EXIT. DTSCS52
|
|
01996 EXIT. DTSCS52
|
|
01997 EJECT DTSCS52
|
|
01998 P8810-LOCK-EMPLOYER. DTSCS52
|
|
01999 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS52
|
|
02000 DTSCS52
|
|
02001 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS52
|
|
02002 DTSCS52
|
|
02003 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS52
|
|
02004 DTSCS52
|
|
02005 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS52
|
|
02006 DTSCS52
|
|
02007 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS52
|
|
02008 DTSCS52
|
|
02009 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS52
|
|
02010 DTSCS52
|
|
02011 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS52
|
|
02012 DTSCS52
|
|
02013 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS52
|
|
02014 DTSCS52
|
|
02015 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS52
|
|
02016 DTSCS52
|
|
02017 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS52
|
|
02018 P8810-EXIT. DTSCS52
|
|
02019 EXIT. DTSCS52
|
|
02020 EJECT DTSCS52
|
|
02021 P8900-MLOG-INIT. DTSCS52
|
|
02022 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS52
|
|
02023 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS52
|
|
02024 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS52
|
|
02025 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS52
|
|
02026 MOVE MRCT-EFF-YRQ TO L004-QTR-5-9. DTSCS52
|
|
02027 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS52
|
|
02028 MOVE L004-SLASH-5-QTR TO L331-REC-OCC-ID. DTSCS52
|
|
02029 MOVE SPACE TO L331-FROM-VALUE. DTSCS52
|
|
02030 GO TO P8900-EXIT. DTSCS52
|
|
02031 DTSCS52
|
|
02032 P8900-MLOG-ACTIVE-IND. DTSCS52
|
|
02033 MOVE 'MRCT-ACTIVE-IND ' TO L331-FIELD-NAME. DTSCS52
|
|
02034 MOVE MAP-ACTIVE-IND TO L331-TO-VALUE. DTSCS52
|
|
02035 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02036 DTSCS52
|
|
02037 P8900-MLOG-PRIOR-RESERVE-AMT. DTSCS52
|
|
02038 MOVE 'MRCT-PRIOR-RESERVE-AMT' TO L331-FIELD-NAME. DTSCS52
|
|
02039 MOVE MRCT-PRIOR-RESERVE-AMT TO WRK-NUM-N. DTSCS52
|
|
02040 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02041 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02042 DTSCS52
|
|
02043 P8900-MLOG-UI-TAX-PAID-AMT. DTSCS52
|
|
02044 MOVE 'MRCT-UI-TAX-PAID-AMT' TO L331-FIELD-NAME. DTSCS52
|
|
02045 MOVE MRCT-UI-TAX-PAID-AMT TO WRK-NUM-N. DTSCS52
|
|
02046 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02047 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02048 DTSCS52
|
|
02049 P8900-MLOG-TRUST-FUND-INT-AMT. DTSCS52
|
|
02050 MOVE 'MRCT-TRUST-FUND-INTEREST-AMT' TO L331-FIELD-NAME. DTSCS52
|
|
02051 MOVE MRCT-TRUST-FUND-INTEREST-AMT TO WRK-NUM-N. DTSCS52
|
|
02052 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02053 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02054 DTSCS52
|
|
02055 P8900-MLOG-BENEFITS-CHRGD-AMT. DTSCS52
|
|
02056 MOVE 'MRCT-BENEFITS-CHARGED-AMT' TO L331-FIELD-NAME. DTSCS52
|
|
02057 MOVE MRCT-BENEFITS-CHARGED-AMT TO WRK-NUM-N. DTSCS52
|
|
02058 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02059 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02060 DTSCS52
|
|
02061 P8900-MLOG-TOT-WAGE. DTSCS52
|
|
02062 MOVE 'MRCT-TOT-WAGE ' TO WRK-LABEL-AREA. DTSCS52
|
|
02063 MOVE '(' TO WRK-LABEL-LEFT-PAREN. DTSCS52
|
|
02064 MOVE WRK-CTR TO WRK-LABEL-OCC. DTSCS52
|
|
02065 MOVE ')' TO WRK-LABEL-RIGHT-PAREN. DTSCS52
|
|
02066 MOVE WRK-LABEL-AREA TO L331-FIELD-NAME. DTSCS52
|
|
02067 MOVE MRCT-TOT-WAGE (WRK-CTR) TO WRK-NUM-N. DTSCS52
|
|
02068 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02069 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02070 DTSCS52
|
|
02071 P8900-MLOG-TAX-WAGE. DTSCS52
|
|
02072 MOVE 'MRCT-TAX-WAGE ' TO WRK-LABEL-AREA. DTSCS52
|
|
02073 MOVE '(' TO WRK-LABEL-LEFT-PAREN. DTSCS52
|
|
02074 MOVE WRK-CTR TO WRK-LABEL-OCC. DTSCS52
|
|
02075 MOVE ')' TO WRK-LABEL-RIGHT-PAREN. DTSCS52
|
|
02076 MOVE WRK-LABEL-AREA TO L331-FIELD-NAME. DTSCS52
|
|
02077 MOVE MRCT-TAX-WAGE(WRK-CTR) TO WRK-NUM-N. DTSCS52
|
|
02078 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02079 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02080 DTSCS52
|
|
02081 P8900-MLOG-EARLIEST-LIAB-DATE. DTSCS52
|
|
02082 MOVE 'MRCT-EARLIEST-LIAB-DATE' TO L331-FIELD-NAME. DTSCS52
|
|
02083 MOVE MRCT-EARLIEST-LIAB-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
02084 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
02085 MOVE L001-SLASH-8-DATE TO L331-TO-VALUE. DTSCS52
|
|
02086 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02087 DTSCS52
|
|
02088 P8900-MLOG-MISS-RPT-CNT. DTSCS52
|
|
02089 MOVE 'MRCT-MISS-RPT-CNT ' TO L331-FIELD-NAME. DTSCS52
|
|
02090 MOVE MRCT-MISS-RPT-CNT TO WRK-MISS-RPT-CNT-N. DTSCS52
|
|
02091 MOVE WRK-MISS-RPT-CNT-N TO L331-TO-VALUE. DTSCS52
|
|
02092 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02093 DTSCS52
|
|
02094 P8900-MLOG-TOT-DUE-AMT. DTSCS52
|
|
02095 MOVE 'MRCT-TOT-UI-TAX-BALANCE-AMT' TO L331-FIELD-NAME. DTSCS52
|
|
02096 MOVE MRCT-TOT-UI-TAX-BALANCE-AMT TO WRK-NUM-N. DTSCS52
|
|
02097 MOVE WRK-NUM-N TO L331-TO-VALUE. DTSCS52
|
|
02098 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02099 DTSCS52
|
|
02100 P8900-MLOG-PRED-DUE-IND. DTSCS52
|
|
02101 MOVE 'MRCT-PRED-DUE-IND ' TO L331-FIELD-NAME. DTSCS52
|
|
02102 MOVE MRCT-PRED-DUE-IND TO L331-TO-VALUE. DTSCS52
|
|
02103 GO TO P8900-MLOG-WRITE. DTSCS52
|
|
02104 DTSCS52
|
|
02105 P8900-MLOG-TRNSFR-TO-EMP-NO. DTSCS52
|
|
02106 MOVE 'MRCT-TRANSFERRED-TO-EMP-NO' TO L331-FIELD-NAME. DTSCS52
|
|
02107 MOVE MRCT-TRANSFERRED-TO-EMP-NO TO WRK-DISPLAY. DTSCS52
|
|
02108 MOVE SPACES TO L331-TO-VALUE. DTSCS52
|
|
02109 STRING DTSCS52
|
|
02110 WRK-DISPLAY-EMP-NO-1 DELIMITED BY SIZE DTSCS52
|
|
02111 ' ' DELIMITED BY SIZE DTSCS52
|
|
02112 WRK-DISPLAY-EMP-NO-2 DELIMITED BY SIZE DTSCS52
|
|
02113 INTO DTSCS52
|
|
02114 L331-TO-VALUE. DTSCS52
|
|
02115 GO TO P8900-EXIT. DTSCS52
|
|
02116 DTSCS52
|
|
02117 P8900-MLOG-WRITE. DTSCS52
|
|
02118 IF LCCM-SCR-UPDATE-LOCKED DTSCS52
|
|
02119 GO TO P8900-EXIT. DTSCS52
|
|
02120 DTSCS52
|
|
02121 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS52
|
|
02122 P8900-EXIT. DTSCS52
|
|
02123 EXIT. DTSCS52
|
|
02124 /*****************************************************************DTSCS52
|
|
02125 * LINKS TO UTILITY MODULES DTSCS52
|
|
02126 ******************************************************************DTSCS52
|
|
02127 DTSCS52
|
|
02128 S001-FROM-FED-8. DTSCS52
|
|
02129 SET L001-FROM-FED-8 TO TRUE. DTSCS52
|
|
02130 GO TO S001-DATE. DTSCS52
|
|
02131 DTSCS52
|
|
02132 S001-FROM-ABS-DATE. DTSCS52
|
|
02133 SET L001-FROM-ABS-DAY TO TRUE. DTSCS52
|
|
02134 GO TO S001-DATE. DTSCS52
|
|
02135 DTSCS52
|
|
02136 S001-DATE. DTSCS52
|
|
02137 EXEC CICS LINK DTSCS52
|
|
02138 PROGRAM('DTSCU001') DTSCS52
|
|
02139 COMMAREA(L001-COMM-AREA) DTSCS52
|
|
02140 END-EXEC. DTSCS52
|
|
02141 S001-EXIT. DTSCS52
|
|
02142 EXIT. DTSCS52
|
|
02143 DTSCS52
|
|
02144 DTSCS52
|
|
02145 DTSCS52
|
|
02146 S004-FROM-5. DTSCS52
|
|
02147 SET L004-FROM-5 TO TRUE. DTSCS52
|
|
02148 GO TO S004-YRQ. DTSCS52
|
|
02149 DTSCS52
|
|
02150 S004-FROM-ABS. DTSCS52
|
|
02151 SET L004-FROM-ABS TO TRUE. DTSCS52
|
|
02152 GO TO S004-YRQ. DTSCS52
|
|
02153 DTSCS52
|
|
02154 S004-FROM-DATE. DTSCS52
|
|
02155 SET L004-FROM-DATE TO TRUE. DTSCS52
|
|
02156 GO TO S004-YRQ. DTSCS52
|
|
02157 DTSCS52
|
|
02158 S004-YRQ. DTSCS52
|
|
02159 EXEC CICS LINK DTSCS52
|
|
02160 PROGRAM('DTSCU004') DTSCS52
|
|
02161 COMMAREA(L004-COMM-AREA) DTSCS52
|
|
02162 END-EXEC. DTSCS52
|
|
02163 S004-EXIT. DTSCS52
|
|
02164 EXIT. DTSCS52
|
|
02165 DTSCS52
|
|
02166 DTSCS52
|
|
02167 DTSCS52
|
|
02168 S006-RATE-PERIOD. DTSCS52
|
|
02169 SET L006-FROM-QTR TO TRUE. DTSCS52
|
|
02170 DTSCS52
|
|
02171 EXEC CICS LINK DTSCS52
|
|
02172 PROGRAM('DTSCU006') DTSCS52
|
|
02173 COMMAREA(L006-COMM-AREA) DTSCS52
|
|
02174 END-EXEC. DTSCS52
|
|
02175 S006-EXIT. DTSCS52
|
|
02176 EXIT. DTSCS52
|
|
02177 DTSCS52
|
|
02178 DTSCS52
|
|
02179 S011-MAX-LIMITS. DTSCS52
|
|
02180 MOVE -99999999999.99 TO L011-MIN-AMT. DTSCS52
|
|
02181 MOVE +99999999999.99 TO L011-MAX-AMT. DTSCS52
|
|
02182 DTSCS52
|
|
02183 S011-AMOUNT-FROM-SCREEN. DTSCS52
|
|
02184 EXEC CICS LINK DTSCS52
|
|
02185 PROGRAM('DTSCU011') DTSCS52
|
|
02186 COMMAREA(L011-COMM-AREA) DTSCS52
|
|
02187 END-EXEC. DTSCS52
|
|
02188 S011-EXIT. DTSCS52
|
|
02189 EXIT. DTSCS52
|
|
02190 DTSCS52
|
|
02191 DTSCS52
|
|
02192 S013-MAX-LIMITS. DTSCS52
|
|
02193 MOVE -999 TO L013-MIN-CNT. DTSCS52
|
|
02194 MOVE +999 TO L013-MAX-CNT. DTSCS52
|
|
02195 DTSCS52
|
|
02196 S013-COUNT-FROM-SCREEN. DTSCS52
|
|
02197 EXEC CICS LINK DTSCS52
|
|
02198 PROGRAM('DTSCU013') DTSCS52
|
|
02199 COMMAREA(L013-COMM-AREA) DTSCS52
|
|
02200 END-EXEC. DTSCS52
|
|
02201 S013-EXIT. DTSCS52
|
|
02202 EXIT. DTSCS52
|
|
02203 DTSCS52
|
|
02204 DTSCS52
|
|
02205 DTSCS52
|
|
02206 S015-DATE-FROM-SCREEN. DTSCS52
|
|
02207 EXEC CICS LINK DTSCS52
|
|
02208 PROGRAM('DTSCU015') DTSCS52
|
|
02209 COMMAREA(L015-COMM-AREA) DTSCS52
|
|
02210 END-EXEC. DTSCS52
|
|
02211 S015-EXIT. DTSCS52
|
|
02212 EXIT. DTSCS52
|
|
02213 DTSCS52
|
|
02214 DTSCS52
|
|
02215 DTSCS52
|
|
02216 S016-QTR-FROM-SCREEN. DTSCS52
|
|
02217 EXEC CICS LINK DTSCS52
|
|
02218 PROGRAM('DTSCU016') DTSCS52
|
|
02219 COMMAREA(L016-COMM-AREA) DTSCS52
|
|
02220 END-EXEC. DTSCS52
|
|
02221 S016-EXIT. DTSCS52
|
|
02222 EXIT. DTSCS52
|
|
02223 DTSCS52
|
|
02224 DTSCS52
|
|
02225 DTSCS52
|
|
02226 S018-EMP-NO-FROM-SCREEN. DTSCS52
|
|
02227 EXEC CICS LINK DTSCS52
|
|
02228 PROGRAM('DTSCU018') DTSCS52
|
|
02229 COMMAREA(L018-COMM-AREA) DTSCS52
|
|
02230 END-EXEC. DTSCS52
|
|
02231 S018-EXIT. DTSCS52
|
|
02232 EXIT. DTSCS52
|
|
02233 DTSCS52
|
|
02234 DTSCS52
|
|
02235 DTSCS52
|
|
02236 S054-RATE-DETERMINATION. DTSCS52
|
|
02237 EXEC CICS LINK DTSCS52
|
|
02238 PROGRAM('DTSCU054') DTSCS52
|
|
02239 COMMAREA(L054-COMM-AREA) DTSCS52
|
|
02240 END-EXEC. DTSCS52
|
|
02241 DTSCS52
|
|
02242 IF L054-FILE-CLOSED-88 DTSCS52
|
|
02243 MOVE L054-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02244 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS52
|
|
02245 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS52
|
|
02246 GO TO MAINLINE-EXIT. DTSCS52
|
|
02247 S054-EXIT. DTSCS52
|
|
02248 EXIT. DTSCS52
|
|
02249 DTSCS52
|
|
02250 DTSCS52
|
|
02251 DTSCS52
|
|
02252 S055-EXPERIENCE-PERIODS. DTSCS52
|
|
02253 SET L055-FROM-EFF-YRQ-88 TO TRUE. DTSCS52
|
|
02254 DTSCS52
|
|
02255 EXEC CICS LINK DTSCS52
|
|
02256 PROGRAM('DTSCU055') DTSCS52
|
|
02257 COMMAREA(L055-COMM-AREA) DTSCS52
|
|
02258 END-EXEC. DTSCS52
|
|
02259 S055-EXIT. DTSCS52
|
|
02260 EXIT. DTSCS52
|
|
02261 DTSCS52
|
|
02262 DTSCS52
|
|
02263 DTSCS52
|
|
02264 S056-RATE-DISPLAY-RIGHT. DTSCS52
|
|
02265 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS52
|
|
02266 GO TO S056-RATE-DISPLAY. DTSCS52
|
|
02267 DTSCS52
|
|
02268 S056-RATE-DISPLAY-LEFT. DTSCS52
|
|
02269 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS52
|
|
02270 GO TO S056-RATE-DISPLAY. DTSCS52
|
|
02271 DTSCS52
|
|
02272 S056-RATE-DISPLAY. DTSCS52
|
|
02273 EXEC CICS LINK DTSCS52
|
|
02274 PROGRAM('DTSCU056') DTSCS52
|
|
02275 COMMAREA(L056-COMM-AREA) DTSCS52
|
|
02276 END-EXEC. DTSCS52
|
|
02277 S056-EXIT. DTSCS52
|
|
02278 EXIT. DTSCS52
|
|
02279 DTSCS52
|
|
02280 DTSCS52
|
|
02281 DTSCS52
|
|
02282 S057-RESERVE-RATIO-DISPLAY. DTSCS52
|
|
02283 EXEC CICS LINK DTSCS52
|
|
02284 PROGRAM('DTSCU057') DTSCS52
|
|
02285 COMMAREA(L057-COMM-AREA) DTSCS52
|
|
02286 END-EXEC. DTSCS52
|
|
02287 S057-EXIT. DTSCS52
|
|
02288 EXIT. DTSCS52
|
|
02289 DTSCS52
|
|
02290 DTSCS52
|
|
02291 DTSCS52
|
|
02292 S221-EMP-LOCK. DTSCS52
|
|
02293 SET L221-START-UPDATE TO TRUE. DTSCS52
|
|
02294 GO TO S221-EMP-LOCK-UNLOCK. DTSCS52
|
|
02295 DTSCS52
|
|
02296 S221-EMP-UNLOCK. DTSCS52
|
|
02297 SET L221-END-UPDATE TO TRUE. DTSCS52
|
|
02298 GO TO S221-EMP-LOCK-UNLOCK. DTSCS52
|
|
02299 DTSCS52
|
|
02300 S221-EMP-LOCK-UNLOCK. DTSCS52
|
|
02301 EXEC CICS LINK DTSCS52
|
|
02302 PROGRAM('DTSCU221') DTSCS52
|
|
02303 COMMAREA(L221-COMM-AREA) DTSCS52
|
|
02304 END-EXEC. DTSCS52
|
|
02305 DTSCS52
|
|
02306 IF L221-FILE-CLOSED DTSCS52
|
|
02307 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02308 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS52
|
|
02309 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS52
|
|
02310 GO TO MAINLINE-EXIT. DTSCS52
|
|
02311 DTSCS52
|
|
02312 IF L221-NOT-OK DTSCS52
|
|
02313 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS52
|
|
02314 S221-EXIT. DTSCS52
|
|
02315 EXIT. DTSCS52
|
|
02316 DTSCS52
|
|
02317 DTSCS52
|
|
02318 DTSCS52
|
|
02319 S331-WRITE-MLOG. DTSCS52
|
|
02320 EXEC CICS LINK DTSCS52
|
|
02321 PROGRAM('DTSCU331') DTSCS52
|
|
02322 COMMAREA(L331-COMM-AREA) DTSCS52
|
|
02323 END-EXEC. DTSCS52
|
|
02324 DTSCS52
|
|
02325 IF L331-FILE-CLOSED DTSCS52
|
|
02326 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02327 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS52
|
|
02328 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS52
|
|
02329 GO TO MAINLINE-EXIT. DTSCS52
|
|
02330 S331-EXIT. DTSCS52
|
|
02331 EXIT. DTSCS52
|
|
02332 DTSCS52
|
|
02333 DTSCS52
|
|
02334 DTSCS52
|
|
02335 S803-REQ-SCR-ID-EDIT. DTSCS52
|
|
02336 EXEC CICS LINK DTSCS52
|
|
02337 PROGRAM ('DTSCU803') DTSCS52
|
|
02338 COMMAREA (DFHCOMMAREA) DTSCS52
|
|
02339 END-EXEC. DTSCS52
|
|
02340 S803-EXIT. DTSCS52
|
|
02341 EXIT. DTSCS52
|
|
02342 DTSCS52
|
|
02343 DTSCS52
|
|
02344 DTSCS52
|
|
02345 S804-INVALID-KEY. DTSCS52
|
|
02346 EXEC CICS LINK DTSCS52
|
|
02347 PROGRAM ('DTSCU804') DTSCS52
|
|
02348 COMMAREA (DFHCOMMAREA) DTSCS52
|
|
02349 END-EXEC. DTSCS52
|
|
02350 S804-EXIT. DTSCS52
|
|
02351 EXIT. DTSCS52
|
|
02352 DTSCS52
|
|
02353 DTSCS52
|
|
02354 DTSCS52
|
|
02355 S805-MSG-AREA. DTSCS52
|
|
02356 MOVE LCCM-MSG-AREA TO L805-MSG-AREA. DTSCS52
|
|
02357 DTSCS52
|
|
02358 EXEC CICS LINK DTSCS52
|
|
02359 PROGRAM ('DTSCU805') DTSCS52
|
|
02360 COMMAREA (L805-COMM-AREA) DTSCS52
|
|
02361 END-EXEC. DTSCS52
|
|
02362 DTSCS52
|
|
02363 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS52
|
|
02364 S805-EXIT. DTSCS52
|
|
02365 EXIT. DTSCS52
|
|
02366 DTSCS52
|
|
02367 DTSCS52
|
|
02368 DTSCS52
|
|
02369 S810-READ. DTSCS52
|
|
02370 SET L810-READ-88 TO TRUE. DTSCS52
|
|
02371 GO TO S810-IO. DTSCS52
|
|
02372 DTSCS52
|
|
02373 S810-START-BROWSE. DTSCS52
|
|
02374 SET L810-START-BROWSE-88 TO TRUE. DTSCS52
|
|
02375 GO TO S810-IO. DTSCS52
|
|
02376 DTSCS52
|
|
02377 S810-READ-NEXT. DTSCS52
|
|
02378 SET L810-READ-NEXT-88 TO TRUE. DTSCS52
|
|
02379 GO TO S810-IO. DTSCS52
|
|
02380 DTSCS52
|
|
02381 S810-READ-PREV. DTSCS52
|
|
02382 SET L810-READ-PREV-88 TO TRUE. DTSCS52
|
|
02383 GO TO S810-IO. DTSCS52
|
|
02384 DTSCS52
|
|
02385 S810-END-BROWSE. DTSCS52
|
|
02386 SET L810-END-BROWSE-88 TO TRUE. DTSCS52
|
|
02387 GO TO S810-IO. DTSCS52
|
|
02388 DTSCS52
|
|
02389 S810-COUNT. DTSCS52
|
|
02390 SET L810-COUNT-88 TO TRUE. DTSCS52
|
|
02391 GO TO S810-IO. DTSCS52
|
|
02392 DTSCS52
|
|
02393 S810-REWRITE. DTSCS52
|
|
02394 SET L810-REWRITE-88 TO TRUE. DTSCS52
|
|
02395 GO TO S810-IO. DTSCS52
|
|
02396 DTSCS52
|
|
02397 S810-WRITE. DTSCS52
|
|
02398 SET L810-WRITE-88 TO TRUE. DTSCS52
|
|
02399 GO TO S810-IO. DTSCS52
|
|
02400 DTSCS52
|
|
02401 S810-DELETE. DTSCS52
|
|
02402 SET L810-DELETE-88 TO TRUE. DTSCS52
|
|
02403 GO TO S810-IO. DTSCS52
|
|
02404 DTSCS52
|
|
02405 S810-IO. DTSCS52
|
|
02406 EXEC CICS LINK DTSCS52
|
|
02407 PROGRAM ('DTSCU810') DTSCS52
|
|
02408 COMMAREA (L810-COMM-AREA) DTSCS52
|
|
02409 END-EXEC. DTSCS52
|
|
02410 DTSCS52
|
|
02411 IF L810-FILE-CLOSED-88 DTSCS52
|
|
02412 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02413 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS52
|
|
02414 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS52
|
|
02415 GO TO MAINLINE-EXIT. DTSCS52
|
|
02416 S810-EXIT. DTSCS52
|
|
02417 EXIT. DTSCS52
|
|
02418 DTSCS52
|
|
02419 DTSCS52
|
|
02420 DTSCS52
|
|
02421 *S825-WRITE. DTSCS52
|
|
02422 *****SET L825-WRITE-88 TO TRUE. DTSCS52
|
|
02423 *****GO TO S825-O. DTSCS52
|
|
02424 DTSCS52
|
|
02425 *S825-O. DTSCS52
|
|
02426 DTSCS52
|
|
02427 *****COMPUTE L825-LENGTH = L825-CB-LENGTH + RSK1-LENGTH. DTSCS52
|
|
02428 DTSCS52
|
|
02429 *****EXEC CICS LINK DTSCS52
|
|
02430 *********PROGRAM ('DTSCU825') DTSCS52
|
|
02431 *********COMMAREA (L825-COMM-AREA) DTSCS52
|
|
02432 *********LENGTH (L825-LENGTH) DTSCS52
|
|
02433 *****END-EXEC. DTSCS52
|
|
02434 DTSCS52
|
|
02435 *****IF L825-FILE-CLOSED-88 DTSCS52
|
|
02436 *********MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02437 *********SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS52
|
|
02438 *********SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS52
|
|
02439 *********GO TO MAINLINE-EXIT. DTSCS52
|
|
02440 *S825-EXIT. DTSCS52
|
|
02441 *****EXIT. DTSCS52
|
|
02442 DTSCS52
|
|
02443 DTSCS52
|
|
02444 DTSCS52
|
|
02445 S851-SCREEN-PROCESSING. DTSCS52
|
|
02446 EXEC CICS LINK DTSCS52
|
|
02447 PROGRAM ('DTSCU851') DTSCS52
|
|
02448 COMMAREA (L851-COMM-AREA) DTSCS52
|
|
02449 END-EXEC. DTSCS52
|
|
02450 S851-EXIT. DTSCS52
|
|
02451 EXIT. DTSCS52
|
|
02452 DTSCS52
|
|
02453 DTSCS52
|
|
02454 DTSCS52
|
|
02455 S899-ABEND. DTSCS52
|
|
02456 EXEC CICS ABEND DTSCS52
|
|
02457 ABCODE(WRK-ABEND-CD) DTSCS52
|
|
02458 END-EXEC. DTSCS52
|
|
02459 S899-EXIT. DTSCS52
|
|
02460 EXIT. DTSCS52
|
|
02461 /*****************************************************************DTSCS52
|
|
02462 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS52
|
|
02463 ******************************************************************DTSCS52
|
|
02464 DTSCS52
|
|
02465 S1000-SCREEN-EDITS. DTSCS52
|
|
02466 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS52
|
|
02467 DTSCS52
|
|
02468 IF LCCM-MSG DTSCS52
|
|
02469 GO TO S1000-EXIT. DTSCS52
|
|
02470 DTSCS52
|
|
02471 DTSCS52
|
|
02472 ***** DTSCS52
|
|
02473 * DTSCS52
|
|
02474 * IF EMP CLASS IS NOT RATED, THEN SOME OF THE RATE DTSCS52
|
|
02475 * UTILITY MODULES BLOW UP. DTSCS52
|
|
02476 * DTSCS52
|
|
02477 * THIS IS AN EASY FIX. DTSCS52
|
|
02478 * DTSCS52
|
|
02479 ***** DTSCS52
|
|
02480 DTSCS52
|
|
02481 IF MPRF-CLASS-RATED-88 DTSCS52
|
|
02482 NEXT SENTENCE DTSCS52
|
|
02483 ELSE DTSCS52
|
|
02484 MOVE MSG-E521-AREA TO WRK-MSG-AREA DTSCS52
|
|
02485 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
02486 GO TO S1000-EXIT. DTSCS52
|
|
02487 DTSCS52
|
|
02488 DTSCS52
|
|
02489 PERFORM S1200-EFF-YRQ THRU S1200-EXIT. DTSCS52
|
|
02490 DTSCS52
|
|
02491 PERFORM S1300-EARLIEST-LIAB-DATE THRU S1300-EXIT. DTSCS52
|
|
02492 DTSCS52
|
|
02493 PERFORM S1400-ACTIVE-IND THRU S1400-EXIT. DTSCS52
|
|
02494 DTSCS52
|
|
02495 PERFORM S1500-TRNSF-TO-EMP-NO THRU S1500-EXIT. DTSCS52
|
|
02496 DTSCS52
|
|
02497 PERFORM S1600-PRIOR-RESERVE-CHNG THRU S1600-EXIT. DTSCS52
|
|
02498 DTSCS52
|
|
02499 PERFORM S1700-UI-TAX-PAID-CHNG THRU S1700-EXIT. DTSCS52
|
|
02500 DTSCS52
|
|
02501 PERFORM S1800-TRUST-FUND-INT-CHNG THRU S1800-EXIT. DTSCS52
|
|
02502 DTSCS52
|
|
02503 PERFORM S1900-UI-BEN-CHRGD-CHNG THRU S1900-EXIT. DTSCS52
|
|
02504 DTSCS52
|
|
02505 PERFORM S2000-WAGE-CHNG THRU S2000-EXIT DTSCS52
|
|
02506 VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
02507 UNTIL WRK-CTR > 3. DTSCS52
|
|
02508 DTSCS52
|
|
02509 PERFORM S2100-MISS-RPT-CNT THRU S2100-EXIT. DTSCS52
|
|
02510 DTSCS52
|
|
02511 PERFORM S2200-UI-TAX-DUE THRU S2200-EXIT. DTSCS52
|
|
02512 DTSCS52
|
|
02513 PERFORM S2300-PRED-DUE-IND THRU S2300-EXIT. DTSCS52
|
|
02514 DTSCS52
|
|
02515 IF LCCM-MSG DTSCS52
|
|
02516 GO TO S1000-EXIT. DTSCS52
|
|
02517 DTSCS52
|
|
02518 DTSCS52
|
|
02519 PERFORM S3100-MISC-EDITS THRU S3100-EXIT. DTSCS52
|
|
02520 S1000-EXIT. DTSCS52
|
|
02521 EXIT. DTSCS52
|
|
02522 EJECT DTSCS52
|
|
02523 S1100-EDIT-KEY. DTSCS52
|
|
02524 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS52
|
|
02525 S1100-EXIT. DTSCS52
|
|
02526 EXIT. DTSCS52
|
|
02527 /*****************************************************************DTSCS52
|
|
02528 * DTSCS52
|
|
02529 ******************************************************************DTSCS52
|
|
02530 DTSCS52
|
|
02531 S1101-EMP-NO. DTSCS52
|
|
02532 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS52
|
|
02533 DTSCS52
|
|
02534 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS52
|
|
02535 DTSCS52
|
|
02536 IF L018-NO-ENTRY DTSCS52
|
|
02537 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
02538 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
02539 GO TO S1101-EXIT. DTSCS52
|
|
02540 DTSCS52
|
|
02541 IF L018-NOT-VALID DTSCS52
|
|
02542 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02543 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
02544 GO TO S1101-EXIT. DTSCS52
|
|
02545 DTSCS52
|
|
02546 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS52
|
|
02547 S1101-EXIT. DTSCS52
|
|
02548 EXIT. DTSCS52
|
|
02549 SKIP3 DTSCS52
|
|
02550 S1110-READ-MPRF. DTSCS52
|
|
02551 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS52
|
|
02552 DTSCS52
|
|
02553 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS52
|
|
02554 DTSCS52
|
|
02555 SET MPRF-PRF-88 TO TRUE. DTSCS52
|
|
02556 DTSCS52
|
|
02557 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
02558 DTSCS52
|
|
02559 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
02560 DTSCS52
|
|
02561 IF L810-NO-REC-88 DTSCS52
|
|
02562 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS52
|
|
02563 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
02564 ELSE DTSCS52
|
|
02565 MOVE MSKL-REC TO MPRF-REC DTSCS52
|
|
02566 SET WRK-MPRF-YES-88 TO TRUE. DTSCS52
|
|
02567 S1110-EXIT. DTSCS52
|
|
02568 EXIT. DTSCS52
|
|
02569 SKIP3 DTSCS52
|
|
02570 S1199-ERROR. DTSCS52
|
|
02571 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS52
|
|
02572 MAP-EMP-NO-2-A. DTSCS52
|
|
02573 DTSCS52
|
|
02574 IF LCCM-NO-MSG DTSCS52
|
|
02575 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02576 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS52
|
|
02577 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02578 S1199-EXIT. DTSCS52
|
|
02579 EXIT. DTSCS52
|
|
02580 /*****************************************************************DTSCS52
|
|
02581 * *DTSCS52
|
|
02582 ******************************************************************DTSCS52
|
|
02583 S1200-EFF-YRQ. DTSCS52
|
|
02584 MOVE MAP-EFF-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS52
|
|
02585 DTSCS52
|
|
02586 PERFORM S016-QTR-FROM-SCREEN THRU S016-EXIT. DTSCS52
|
|
02587 DTSCS52
|
|
02588 IF L016-NO-ENTRY DTSCS52
|
|
02589 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
02590 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS52
|
|
02591 ELSE DTSCS52
|
|
02592 IF L016-NOT-VALID DTSCS52
|
|
02593 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02594 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS52
|
|
02595 ELSE DTSCS52
|
|
02596 MOVE L016-YRQ TO L006-YRQ DTSCS52
|
|
02597 SET L006-FROM-QTR TO TRUE DTSCS52
|
|
02598 PERFORM S006-RATE-PERIOD THRU S006-EXIT DTSCS52
|
|
02599 MOVE L006-RTE-YR-START-DATE TO L001-FED-8-DATE-9 DTSCS52
|
|
02600 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS52
|
|
02601 MOVE L001-SLASH-DATE TO MAP-PERIOD-FROM DTSCS52
|
|
02602 MOVE L006-RTE-YR-END-DATE TO L001-FED-8-DATE-9 DTSCS52
|
|
02603 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS52
|
|
02604 MOVE L001-SLASH-DATE TO MAP-PERIOD-TO DTSCS52
|
|
02605 IF L006-RTE-YR-START-YRQ NOT = L016-YRQ DTSCS52
|
|
02606 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02607 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS52
|
|
02608 ELSE DTSCS52
|
|
02609 PERFORM S1220-EXP-QTRS THRU S1220-EXIT. DTSCS52
|
|
02610 S1200-EXIT. DTSCS52
|
|
02611 EXIT. DTSCS52
|
|
02612 SKIP3 DTSCS52
|
|
02613 S1201-ERROR. DTSCS52
|
|
02614 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EFF-QTR-YR-A DTSCS52
|
|
02615 MAP-EFF-QTR-Q-A. DTSCS52
|
|
02616 DTSCS52
|
|
02617 IF LCCM-NO-MSG DTSCS52
|
|
02618 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS52
|
|
02619 MOVE CATB-CURSOR TO MAP-EFF-QTR-YR-L. DTSCS52
|
|
02620 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02621 S1201-EXIT. DTSCS52
|
|
02622 EXIT. DTSCS52
|
|
02623 SKIP3 DTSCS52
|
|
02624 S1220-EXP-QTRS. DTSCS52
|
|
02625 MOVE L016-YRQ TO L055-EFF-YRQ. DTSCS52
|
|
02626 DTSCS52
|
|
02627 PERFORM S055-EXPERIENCE-PERIODS THRU S055-EXIT. DTSCS52
|
|
02628 DTSCS52
|
|
02629 DTSCS52
|
|
02630 MOVE L055-PRIOR-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
02631 DTSCS52
|
|
02632 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
02633 DTSCS52
|
|
02634 MOVE '(' TO MAP-PRIOR-DATE-LEFT. DTSCS52
|
|
02635 DTSCS52
|
|
02636 MOVE L001-SLASH-DATE TO MAP-PRIOR-DATE. DTSCS52
|
|
02637 DTSCS52
|
|
02638 MOVE ')' TO MAP-PRIOR-DATE-RIGHT. DTSCS52
|
|
02639 DTSCS52
|
|
02640 DTSCS52
|
|
02641 PERFORM S1221-LOOP THRU S1221-EXIT DTSCS52
|
|
02642 VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
02643 UNTIL WRK-CTR > 3. DTSCS52
|
|
02644 DTSCS52
|
|
02645 DTSCS52
|
|
02646 MOVE L055-CURRENT-RESERVE-THRU-DATE TO L001-FED-8-DATE-9. DTSCS52
|
|
02647 DTSCS52
|
|
02648 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS52
|
|
02649 DTSCS52
|
|
02650 MOVE '(' TO MAP-CURRENT-DATE-LEFT. DTSCS52
|
|
02651 DTSCS52
|
|
02652 MOVE L001-SLASH-DATE TO MAP-CURRENT-DATE. DTSCS52
|
|
02653 DTSCS52
|
|
02654 MOVE ')' TO MAP-CURRENT-DATE-RIGHT. DTSCS52
|
|
02655 S1220-EXIT. DTSCS52
|
|
02656 EXIT. DTSCS52
|
|
02657 SKIP3 DTSCS52
|
|
02658 S1221-LOOP. DTSCS52
|
|
02659 MOVE L055-WAGES-FROM-YRQ (WRK-CTR) TO L004-QTR-5-9. DTSCS52
|
|
02660 DTSCS52
|
|
02661 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS52
|
|
02662 DTSCS52
|
|
02663 MOVE L004-SLASH-QTR TO MAP-START-YRQ (WRK-CTR). DTSCS52
|
|
02664 DTSCS52
|
|
02665 DTSCS52
|
|
02666 MOVE L055-WAGES-THRU-YRQ (WRK-CTR) TO L004-QTR-5-9. DTSCS52
|
|
02667 DTSCS52
|
|
02668 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS52
|
|
02669 DTSCS52
|
|
02670 MOVE L004-SLASH-QTR TO MAP-END-YRQ (WRK-CTR). DTSCS52
|
|
02671 S1221-EXIT. DTSCS52
|
|
02672 EXIT. DTSCS52
|
|
02673 /*****************************************************************DTSCS52
|
|
02674 * *DTSCS52
|
|
02675 ******************************************************************DTSCS52
|
|
02676 S1300-EARLIEST-LIAB-DATE. DTSCS52
|
|
02677 MOVE MAP-EARLIEST-LIAB-DATE-AREA TO L015-S-DATE-AREA. DTSCS52
|
|
02678 DTSCS52
|
|
02679 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS52
|
|
02680 DTSCS52
|
|
02681 IF L015-NO-ENTRY DTSCS52
|
|
02682 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
02683 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS52
|
|
02684 ELSE DTSCS52
|
|
02685 IF L015-NOT-VALID DTSCS52
|
|
02686 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02687 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS52
|
|
02688 S1300-EXIT. DTSCS52
|
|
02689 EXIT. DTSCS52
|
|
02690 SKIP3 DTSCS52
|
|
02691 S1301-ERROR. DTSCS52
|
|
02692 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
02693 TO MAP-EARLIEST-LIAB-MONTH-A DTSCS52
|
|
02694 MAP-EARLIEST-LIAB-DAY-A DTSCS52
|
|
02695 MAP-EARLIEST-LIAB-YEAR-A. DTSCS52
|
|
02696 DTSCS52
|
|
02697 IF LCCM-NO-MSG DTSCS52
|
|
02698 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS52
|
|
02699 MOVE CATB-CURSOR TO MAP-EARLIEST-LIAB-MONTH-L DTSCS52
|
|
02700 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02701 S1301-EXIT. DTSCS52
|
|
02702 EXIT. DTSCS52
|
|
02703 SKIP3 DTSCS52
|
|
02704 /*****************************************************************DTSCS52
|
|
02705 * *DTSCS52
|
|
02706 ******************************************************************DTSCS52
|
|
02707 S1400-ACTIVE-IND. DTSCS52
|
|
02708 IF MAP-ACTIVE-IND = LOW-VALUES OR SPACES DTSCS52
|
|
02709 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
02710 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS52
|
|
02711 ELSE DTSCS52
|
|
02712 IF MAP-ACTIVE-IND = 'Y' OR 'N' DTSCS52
|
|
02713 NEXT SENTENCE DTSCS52
|
|
02714 ELSE DTSCS52
|
|
02715 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02716 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS52
|
|
02717 DTSCS52
|
|
02718 S1400-EXIT. DTSCS52
|
|
02719 EXIT. DTSCS52
|
|
02720 SKIP3 DTSCS52
|
|
02721 S1401-ERROR. DTSCS52
|
|
02722 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACTIVE-IND-A. DTSCS52
|
|
02723 DTSCS52
|
|
02724 IF LCCM-NO-MSG DTSCS52
|
|
02725 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02726 MOVE CATB-CURSOR TO MAP-ACTIVE-IND-L DTSCS52
|
|
02727 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02728 S1401-EXIT. DTSCS52
|
|
02729 EXIT. DTSCS52
|
|
02730 /*****************************************************************DTSCS52
|
|
02731 * DTSCS52
|
|
02732 ******************************************************************DTSCS52
|
|
02733 DTSCS52
|
|
02734 S1500-TRNSF-TO-EMP-NO. DTSCS52
|
|
02735 MOVE MAP-TRNSF-TO-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS52
|
|
02736 DTSCS52
|
|
02737 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS52
|
|
02738 DTSCS52
|
|
02739 IF L018-NO-ENTRY DTSCS52
|
|
02740 GO TO S1500-EXIT. DTSCS52
|
|
02741 DTSCS52
|
|
02742 IF L018-NOT-VALID DTSCS52
|
|
02743 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02744 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS52
|
|
02745 GO TO S1500-EXIT. DTSCS52
|
|
02746 DTSCS52
|
|
02747 IF L018-EMP-NO = WRK-EMP-NO DTSCS52
|
|
02748 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS52
|
|
02749 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS52
|
|
02750 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS52
|
|
02751 GO TO S1500-EXIT. DTSCS52
|
|
02752 DTSCS52
|
|
02753 IF LCCM-F09-88 DTSCS52
|
|
02754 PERFORM S1510-TRNSF-TO-EXISTENCE-CHECK THRU S1510-EXIT DTSCS52
|
|
02755 GO TO S1500-EXIT. DTSCS52
|
|
02756 DTSCS52
|
|
02757 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSCS52
|
|
02758 DTSCS52
|
|
02759 MOVE WRK-EMP-NO TO MRCT-EMP-NO. DTSCS52
|
|
02760 DTSCS52
|
|
02761 SET MRCT-RCT-88 TO TRUE. DTSCS52
|
|
02762 DTSCS52
|
|
02763 MOVE L016-YRQ TO MRCT-EFF-YRQ. DTSCS52
|
|
02764 DTSCS52
|
|
02765 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
02766 DTSCS52
|
|
02767 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
02768 DTSCS52
|
|
02769 IF L810-OK-88 DTSCS52
|
|
02770 MOVE MSKL-REC TO MRCT-REC DTSCS52
|
|
02771 IF MRCT-TRANSFERRED-TO-EMP-NO NOT = L018-EMP-NO DTSCS52
|
|
02772 PERFORM S1510-TRNSF-TO-EXISTENCE-CHECK DTSCS52
|
|
02773 THRU S1510-EXIT. DTSCS52
|
|
02774 S1500-EXIT. DTSCS52
|
|
02775 EXIT. DTSCS52
|
|
02776 SKIP3 DTSCS52
|
|
02777 S1501-ERROR. DTSCS52
|
|
02778 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
02779 TO MAP-TRNSF-TO-EMP-NO-1-A DTSCS52
|
|
02780 MAP-TRNSF-TO-EMP-NO-2-A. DTSCS52
|
|
02781 DTSCS52
|
|
02782 IF LCCM-NO-MSG DTSCS52
|
|
02783 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02784 MOVE CATB-CURSOR TO MAP-TRNSF-TO-EMP-NO-1-L DTSCS52
|
|
02785 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02786 S1501-EXIT. DTSCS52
|
|
02787 EXIT. DTSCS52
|
|
02788 SKIP3 DTSCS52
|
|
02789 S1510-TRNSF-TO-EXISTENCE-CHECK. DTSCS52
|
|
02790 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS52
|
|
02791 DTSCS52
|
|
02792 MOVE L018-EMP-NO TO MSKL-EMP-NO. DTSCS52
|
|
02793 DTSCS52
|
|
02794 SET MSKL-PRF-88 TO TRUE. DTSCS52
|
|
02795 DTSCS52
|
|
02796 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
02797 DTSCS52
|
|
02798 IF L810-NO-REC-88 DTSCS52
|
|
02799 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS52
|
|
02800 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS52
|
|
02801 GO TO S1510-EXIT. DTSCS52
|
|
02802 DTSCS52
|
|
02803 MOVE MSKL-REC TO MPRF-REC. DTSCS52
|
|
02804 DTSCS52
|
|
02805 IF NOT MPRF-CLASS-RATED-88 DTSCS52
|
|
02806 MOVE MSG-E521-AREA TO WRK-MSG-AREA DTSCS52
|
|
02807 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS52
|
|
02808 DTSCS52
|
|
02809 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS52
|
|
02810 DTSCS52
|
|
02811 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS52
|
|
02812 DTSCS52
|
|
02813 SET MSKL-PRF-88 TO TRUE. DTSCS52
|
|
02814 DTSCS52
|
|
02815 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
02816 DTSCS52
|
|
02817 IF L810-OK-88 DTSCS52
|
|
02818 MOVE MSKL-REC TO MPRF-REC. DTSCS52
|
|
02819 S1510-EXIT. DTSCS52
|
|
02820 EXIT. DTSCS52
|
|
02821 /*****************************************************************DTSCS52
|
|
02822 * DTSCS52
|
|
02823 ******************************************************************DTSCS52
|
|
02824 DTSCS52
|
|
02825 S1600-PRIOR-RESERVE-CHNG. DTSCS52
|
|
02826 MOVE MAP-PRIOR-RESERVE-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
02827 DTSCS52
|
|
02828 MOVE WRK-MAX-LIT TO L011-MAX-AMT. DTSCS52
|
|
02829 DTSCS52
|
|
02830 MOVE WRK-MIN-LIT TO L011-MIN-AMT. DTSCS52
|
|
02831 DTSCS52
|
|
02832 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
02833 DTSCS52
|
|
02834 IF L011-NO-ENTRY DTSCS52
|
|
02835 NEXT SENTENCE DTSCS52
|
|
02836 ELSE DTSCS52
|
|
02837 IF L011-EXCEEDS-MIN-MAX DTSCS52
|
|
02838 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS52
|
|
02839 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS52
|
|
02840 ELSE DTSCS52
|
|
02841 IF L011-NOT-VALID DTSCS52
|
|
02842 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02843 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS52
|
|
02844 ELSE DTSCS52
|
|
02845 MOVE L011-AMT TO MAP-PRIOR-RESERVE-CHNG-N. DTSCS52
|
|
02846 S1600-EXIT. DTSCS52
|
|
02847 EXIT. DTSCS52
|
|
02848 SKIP3 DTSCS52
|
|
02849 S1601-ERROR. DTSCS52
|
|
02850 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
02851 TO MAP-PRIOR-RESERVE-CHNG-A. DTSCS52
|
|
02852 DTSCS52
|
|
02853 IF LCCM-NO-MSG DTSCS52
|
|
02854 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02855 MOVE CATB-CURSOR DTSCS52
|
|
02856 TO MAP-PRIOR-RESERVE-CHNG-L DTSCS52
|
|
02857 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02858 S1601-EXIT. DTSCS52
|
|
02859 EXIT. DTSCS52
|
|
02860 /*****************************************************************DTSCS52
|
|
02861 * DTSCS52
|
|
02862 ******************************************************************DTSCS52
|
|
02863 DTSCS52
|
|
02864 S1700-UI-TAX-PAID-CHNG. DTSCS52
|
|
02865 MOVE MAP-UI-TAX-PAID-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
02866 DTSCS52
|
|
02867 MOVE WRK-MAX-LIT TO L011-MAX-AMT. DTSCS52
|
|
02868 DTSCS52
|
|
02869 MOVE WRK-MIN-LIT TO L011-MIN-AMT. DTSCS52
|
|
02870 DTSCS52
|
|
02871 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
02872 DTSCS52
|
|
02873 IF L011-NO-ENTRY DTSCS52
|
|
02874 NEXT SENTENCE DTSCS52
|
|
02875 ELSE DTSCS52
|
|
02876 IF L011-EXCEEDS-MIN-MAX DTSCS52
|
|
02877 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS52
|
|
02878 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS52
|
|
02879 ELSE DTSCS52
|
|
02880 IF L011-NOT-VALID DTSCS52
|
|
02881 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02882 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS52
|
|
02883 ELSE DTSCS52
|
|
02884 MOVE L011-AMT TO MAP-UI-TAX-PAID-CHNG-N. DTSCS52
|
|
02885 S1700-EXIT. DTSCS52
|
|
02886 EXIT. DTSCS52
|
|
02887 SKIP3 DTSCS52
|
|
02888 S1701-ERROR. DTSCS52
|
|
02889 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
02890 TO MAP-UI-TAX-PAID-CHNG-A. DTSCS52
|
|
02891 DTSCS52
|
|
02892 IF LCCM-NO-MSG DTSCS52
|
|
02893 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02894 MOVE CATB-CURSOR DTSCS52
|
|
02895 TO MAP-UI-TAX-PAID-CHNG-L DTSCS52
|
|
02896 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02897 S1701-EXIT. DTSCS52
|
|
02898 EXIT. DTSCS52
|
|
02899 /*****************************************************************DTSCS52
|
|
02900 * DTSCS52
|
|
02901 ******************************************************************DTSCS52
|
|
02902 DTSCS52
|
|
02903 S1800-TRUST-FUND-INT-CHNG. DTSCS52
|
|
02904 MOVE MAP-TRUST-FUND-INT-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
02905 DTSCS52
|
|
02906 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
02907 DTSCS52
|
|
02908 MOVE L011-AMT TO WRK-CHK-NEGATIVE-AMT. DTSCS52
|
|
02909 DTSCS52
|
|
02910 DTSCS52
|
|
02911 MOVE MAP-TRUST-FUND-INT-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
02912 DTSCS52
|
|
02913 MOVE WRK-MAX-LIT TO L011-MAX-AMT. DTSCS52
|
|
02914 DTSCS52
|
|
02915 MOVE WRK-MIN-LIT TO L011-MIN-AMT. DTSCS52
|
|
02916 DTSCS52
|
|
02917 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
02918 DTSCS52
|
|
02919 IF L011-NO-ENTRY DTSCS52
|
|
02920 NEXT SENTENCE DTSCS52
|
|
02921 ELSE DTSCS52
|
|
02922 IF L011-EXCEEDS-MIN-MAX DTSCS52
|
|
02923 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS52
|
|
02924 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS52
|
|
02925 ELSE DTSCS52
|
|
02926 IF L011-NOT-VALID DTSCS52
|
|
02927 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02928 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS52
|
|
02929 ELSE DTSCS52
|
|
02930 ADD L011-AMT TO WRK-CHK-NEGATIVE-AMT DTSCS52
|
|
02931 IF WRK-CHK-NEGATIVE-AMT < +0 DTSCS52
|
|
02932 MOVE MSG-E522-AREA TO WRK-MSG-AREA DTSCS52
|
|
02933 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS52
|
|
02934 ELSE DTSCS52
|
|
02935 MOVE L011-AMT TO MAP-TRUST-FUND-INT-CHNG-N. DTSCS52
|
|
02936 S1800-EXIT. DTSCS52
|
|
02937 EXIT. DTSCS52
|
|
02938 SKIP3 DTSCS52
|
|
02939 S1801-ERROR. DTSCS52
|
|
02940 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
02941 TO MAP-TRUST-FUND-INT-CHNG-A. DTSCS52
|
|
02942 DTSCS52
|
|
02943 IF LCCM-NO-MSG DTSCS52
|
|
02944 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02945 MOVE CATB-CURSOR DTSCS52
|
|
02946 TO MAP-TRUST-FUND-INT-CHNG-L DTSCS52
|
|
02947 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02948 S1801-EXIT. DTSCS52
|
|
02949 EXIT. DTSCS52
|
|
02950 /*****************************************************************DTSCS52
|
|
02951 * DTSCS52
|
|
02952 ******************************************************************DTSCS52
|
|
02953 DTSCS52
|
|
02954 S1900-UI-BEN-CHRGD-CHNG. DTSCS52
|
|
02955 MOVE MAP-UI-BEN-CHRGD-CHNG-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
02956 DTSCS52
|
|
02957 MOVE WRK-MAX-LIT TO L011-MAX-AMT. DTSCS52
|
|
02958 DTSCS52
|
|
02959 MOVE WRK-MIN-LIT TO L011-MIN-AMT. DTSCS52
|
|
02960 DTSCS52
|
|
02961 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
02962 DTSCS52
|
|
02963 IF L011-NO-ENTRY DTSCS52
|
|
02964 NEXT SENTENCE DTSCS52
|
|
02965 ELSE DTSCS52
|
|
02966 IF L011-EXCEEDS-MIN-MAX DTSCS52
|
|
02967 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS52
|
|
02968 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS52
|
|
02969 ELSE DTSCS52
|
|
02970 IF L011-NOT-VALID DTSCS52
|
|
02971 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
02972 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS52
|
|
02973 ELSE DTSCS52
|
|
02974 MOVE L011-AMT TO MAP-UI-BEN-CHRGD-CHNG-N. DTSCS52
|
|
02975 S1900-EXIT. DTSCS52
|
|
02976 EXIT. DTSCS52
|
|
02977 SKIP3 DTSCS52
|
|
02978 S1901-ERROR. DTSCS52
|
|
02979 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
02980 TO MAP-UI-BEN-CHRGD-CHNG-A. DTSCS52
|
|
02981 DTSCS52
|
|
02982 IF LCCM-NO-MSG DTSCS52
|
|
02983 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
02984 MOVE CATB-CURSOR DTSCS52
|
|
02985 TO MAP-UI-BEN-CHRGD-CHNG-L DTSCS52
|
|
02986 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
02987 S1901-EXIT. DTSCS52
|
|
02988 EXIT. DTSCS52
|
|
02989 /*****************************************************************DTSCS52
|
|
02990 * DTSCS52
|
|
02991 ******************************************************************DTSCS52
|
|
02992 DTSCS52
|
|
02993 S2000-WAGE-CHNG. DTSCS52
|
|
02994 PERFORM S2010-TOT-WAGE-CHNG THRU S2010-EXIT. DTSCS52
|
|
02995 DTSCS52
|
|
02996 PERFORM S2020-TAX-WAGE-CHNG THRU S2020-EXIT. DTSCS52
|
|
02997 S2000-EXIT. DTSCS52
|
|
02998 EXIT. DTSCS52
|
|
02999 SKIP3 DTSCS52
|
|
03000 S2010-TOT-WAGE-CHNG. DTSCS52
|
|
03001 MOVE MAP-TOT-WAGE-AREA (WRK-CTR) TO L011-S-AMT-AREA. DTSCS52
|
|
03002 DTSCS52
|
|
03003 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
03004 DTSCS52
|
|
03005 MOVE L011-AMT TO WRK-CHK-NEGATIVE-AMT DTSCS52
|
|
03006 WRK-CHK-TOT-WAGE-AMT. DTSCS52
|
|
03007 DTSCS52
|
|
03008 *****IF WRK-TBL-OK-88 (1) DTSCS52
|
|
03009 ********ADD L011-AMT TO WRK-TBL-TOT (1). DTSCS52
|
|
03010 DTSCS52
|
|
03011 DTSCS52
|
|
03012 MOVE MAP-TOT-WAGE-CHNG-AREA (WRK-CTR) TO L011-S-AMT-AREA. DTSCS52
|
|
03013 DTSCS52
|
|
03014 MOVE WRK-MAX-LIT TO L011-MAX-AMT. DTSCS52
|
|
03015 DTSCS52
|
|
03016 MOVE WRK-MIN-LIT TO L011-MIN-AMT. DTSCS52
|
|
03017 DTSCS52
|
|
03018 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
03019 DTSCS52
|
|
03020 IF L011-NO-ENTRY DTSCS52
|
|
03021 NEXT SENTENCE DTSCS52
|
|
03022 ELSE DTSCS52
|
|
03023 IF L011-EXCEEDS-MIN-MAX DTSCS52
|
|
03024 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS52
|
|
03025 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS52
|
|
03026 ELSE DTSCS52
|
|
03027 IF L011-NOT-VALID DTSCS52
|
|
03028 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
03029 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS52
|
|
03030 ELSE DTSCS52
|
|
03031 ADD L011-AMT TO WRK-CHK-NEGATIVE-AMT DTSCS52
|
|
03032 IF WRK-CHK-NEGATIVE-AMT < +0 DTSCS52
|
|
03033 MOVE MSG-E522-AREA TO WRK-MSG-AREA DTSCS52
|
|
03034 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS52
|
|
03035 ELSE DTSCS52
|
|
03036 MOVE L011-AMT TO MAP-TOT-WAGE-CHNG-N (WRK-CTR) DTSCS52
|
|
03037 ADD L011-AMT TO WRK-CHK-TOT-WAGE-AMT. DTSCS52
|
|
03038 ***********IF WRK-TBL-OK-88 (1) DTSCS52
|
|
03039 **************ADD L011-AMT TO WRK-TBL-TOT (1). DTSCS52
|
|
03040 S2010-EXIT. DTSCS52
|
|
03041 EXIT. DTSCS52
|
|
03042 SKIP3 DTSCS52
|
|
03043 S2011-ERROR. DTSCS52
|
|
03044 *****SET WRK-TBL-NOT-OK-88 (1) TO TRUE. DTSCS52
|
|
03045 DTSCS52
|
|
03046 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
03047 TO MAP-TOT-WAGE-CHNG-A (WRK-CTR). DTSCS52
|
|
03048 DTSCS52
|
|
03049 IF LCCM-NO-MSG DTSCS52
|
|
03050 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
03051 MOVE CATB-CURSOR DTSCS52
|
|
03052 TO MAP-TOT-WAGE-CHNG-L (WRK-CTR) DTSCS52
|
|
03053 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
03054 S2011-EXIT. DTSCS52
|
|
03055 EXIT. DTSCS52
|
|
03056 SKIP3 DTSCS52
|
|
03057 S2020-TAX-WAGE-CHNG. DTSCS52
|
|
03058 MOVE MAP-TAX-WAGE-AREA (WRK-CTR) TO L011-S-AMT-AREA. DTSCS52
|
|
03059 DTSCS52
|
|
03060 PERFORM S011-MAX-LIMITS THRU S011-EXIT. DTSCS52
|
|
03061 DTSCS52
|
|
03062 MOVE L011-AMT TO WRK-CHK-NEGATIVE-AMT DTSCS52
|
|
03063 WRK-CHK-TAX-WAGE-AMT. DTSCS52
|
|
03064 DTSCS52
|
|
03065 *****IF WRK-TBL-OK-88 (2) DTSCS52
|
|
03066 ********ADD L011-AMT TO WRK-TBL-TOT (2). DTSCS52
|
|
03067 DTSCS52
|
|
03068 DTSCS52
|
|
03069 MOVE MAP-TAX-WAGE-CHNG-AREA (WRK-CTR) TO L011-S-AMT-AREA. DTSCS52
|
|
03070 DTSCS52
|
|
03071 MOVE WRK-MAX-LIT TO L011-MAX-AMT. DTSCS52
|
|
03072 DTSCS52
|
|
03073 MOVE WRK-MIN-LIT TO L011-MIN-AMT. DTSCS52
|
|
03074 DTSCS52
|
|
03075 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
03076 DTSCS52
|
|
03077 IF L011-NO-ENTRY DTSCS52
|
|
03078 IF (MAP-TOT-WAGE-CHNG-A (WRK-CTR) DTSCS52
|
|
03079 NOT = CATB-UNPROT-NORM-NUM-MDTON) DTSCS52
|
|
03080 AND DTSCS52
|
|
03081 (WRK-CHK-NEGATIVE-AMT > WRK-CHK-TOT-WAGE-AMT) DTSCS52
|
|
03082 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS52
|
|
03083 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS52
|
|
03084 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS52
|
|
03085 ELSE DTSCS52
|
|
03086 NEXT SENTENCE DTSCS52
|
|
03087 ELSE DTSCS52
|
|
03088 IF L011-EXCEEDS-MIN-MAX DTSCS52
|
|
03089 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS52
|
|
03090 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS52
|
|
03091 ELSE DTSCS52
|
|
03092 IF L011-NOT-VALID DTSCS52
|
|
03093 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
03094 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS52
|
|
03095 ELSE DTSCS52
|
|
03096 ADD L011-AMT TO WRK-CHK-NEGATIVE-AMT DTSCS52
|
|
03097 IF WRK-CHK-NEGATIVE-AMT < +0 DTSCS52
|
|
03098 MOVE MSG-E522-AREA TO WRK-MSG-AREA DTSCS52
|
|
03099 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS52
|
|
03100 ELSE DTSCS52
|
|
03101 IF (MAP-TOT-WAGE-CHNG-A (WRK-CTR) DTSCS52
|
|
03102 NOT = CATB-UNPROT-NORM-NUM-MDTON) DTSCS52
|
|
03103 AND DTSCS52
|
|
03104 (WRK-CHK-NEGATIVE-AMT > WRK-CHK-TOT-WAGE-AMT) DTSCS52
|
|
03105 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS52
|
|
03106 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS52
|
|
03107 PERFORM S2021-ERROR THRU S2021-EXIT DTSCS52
|
|
03108 ELSE DTSCS52
|
|
03109 MOVE L011-AMT TO MAP-TAX-WAGE-CHNG-N (WRK-CTR) DTSCS52
|
|
03110 ADD L011-AMT TO WRK-CHK-TAX-WAGE-AMT. DTSCS52
|
|
03111 DTSCS52
|
|
03112 ***********IF WRK-TBL-OK-88(2) DTSCS52
|
|
03113 **************ADD L011-AMT TO WRK-TBL-TOT (2). DTSCS52
|
|
03114 S2020-EXIT. DTSCS52
|
|
03115 EXIT. DTSCS52
|
|
03116 SKIP3 DTSCS52
|
|
03117 S2021-ERROR. DTSCS52
|
|
03118 *****SET WRK-TBL-NOT-OK-88 (2) TO TRUE. DTSCS52
|
|
03119 DTSCS52
|
|
03120 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS52
|
|
03121 TO MAP-TAX-WAGE-CHNG-A (WRK-CTR). DTSCS52
|
|
03122 DTSCS52
|
|
03123 IF LCCM-NO-MSG DTSCS52
|
|
03124 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
03125 MOVE CATB-CURSOR DTSCS52
|
|
03126 TO MAP-TAX-WAGE-CHNG-L (WRK-CTR) DTSCS52
|
|
03127 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
03128 S2021-EXIT. DTSCS52
|
|
03129 EXIT. DTSCS52
|
|
03130 /*****************************************************************DTSCS52
|
|
03131 * *DTSCS52
|
|
03132 ******************************************************************DTSCS52
|
|
03133 S2100-MISS-RPT-CNT. DTSCS52
|
|
03134 MOVE MAP-MISS-RPT-CNT-AREA TO L013-S-CNT-AREA. DTSCS52
|
|
03135 DTSCS52
|
|
03136 MOVE +0 TO L013-MIN-CNT. DTSCS52
|
|
03137 DTSCS52
|
|
03138 MOVE +999 TO L013-MAX-CNT. DTSCS52
|
|
03139 DTSCS52
|
|
03140 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS52
|
|
03141 DTSCS52
|
|
03142 IF L013-NO-ENTRY DTSCS52
|
|
03143 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
03144 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS52
|
|
03145 ELSE DTSCS52
|
|
03146 IF L013-NOT-VALID DTSCS52
|
|
03147 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
03148 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS52
|
|
03149 ELSE DTSCS52
|
|
03150 MOVE L013-CNT TO MAP-MISS-RPT-CNT-N. DTSCS52
|
|
03151 S2100-EXIT. DTSCS52
|
|
03152 EXIT. DTSCS52
|
|
03153 SKIP3 DTSCS52
|
|
03154 S2101-ERROR. DTSCS52
|
|
03155 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MISS-RPT-CNT-A. DTSCS52
|
|
03156 DTSCS52
|
|
03157 IF LCCM-NO-MSG DTSCS52
|
|
03158 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
03159 MOVE CATB-CURSOR TO MAP-MISS-RPT-CNT-L DTSCS52
|
|
03160 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
03161 S2101-EXIT. DTSCS52
|
|
03162 EXIT. DTSCS52
|
|
03163 /*****************************************************************DTSCS52
|
|
03164 * *DTSCS52
|
|
03165 ******************************************************************DTSCS52
|
|
03166 S2200-UI-TAX-DUE. DTSCS52
|
|
03167 MOVE MAP-UI-TAX-DUE-AREA TO L011-S-AMT-AREA. DTSCS52
|
|
03168 DTSCS52
|
|
03169 MOVE +0 TO L011-MIN-AMT. DTSCS52
|
|
03170 DTSCS52
|
|
03171 MOVE +999999999.99 TO L011-MAX-AMT. DTSCS52
|
|
03172 DTSCS52
|
|
03173 PERFORM S011-AMOUNT-FROM-SCREEN THRU S011-EXIT. DTSCS52
|
|
03174 DTSCS52
|
|
03175 IF L011-NO-ENTRY DTSCS52
|
|
03176 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
03177 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS52
|
|
03178 ELSE DTSCS52
|
|
03179 IF L011-NOT-VALID DTSCS52
|
|
03180 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
03181 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS52
|
|
03182 ELSE DTSCS52
|
|
03183 MOVE L011-AMT TO MAP-UI-TAX-DUE-N. DTSCS52
|
|
03184 S2200-EXIT. DTSCS52
|
|
03185 EXIT. DTSCS52
|
|
03186 SKIP3 DTSCS52
|
|
03187 S2201-ERROR. DTSCS52
|
|
03188 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UI-TAX-DUE-A. DTSCS52
|
|
03189 DTSCS52
|
|
03190 IF LCCM-NO-MSG DTSCS52
|
|
03191 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
03192 MOVE CATB-CURSOR TO MAP-UI-TAX-DUE-L DTSCS52
|
|
03193 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
03194 S2201-EXIT. DTSCS52
|
|
03195 EXIT. DTSCS52
|
|
03196 /*****************************************************************DTSCS52
|
|
03197 * *DTSCS52
|
|
03198 ******************************************************************DTSCS52
|
|
03199 S2300-PRED-DUE-IND. DTSCS52
|
|
03200 IF MAP-PRED-DUE-IND = LOW-VALUES OR SPACES DTSCS52
|
|
03201 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS52
|
|
03202 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS52
|
|
03203 ELSE DTSCS52
|
|
03204 IF MAP-PRED-DUE-IND = 'Y' OR 'N' DTSCS52
|
|
03205 NEXT SENTENCE DTSCS52
|
|
03206 ELSE DTSCS52
|
|
03207 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS52
|
|
03208 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS52
|
|
03209 S2300-EXIT. DTSCS52
|
|
03210 EXIT. DTSCS52
|
|
03211 SKIP3 DTSCS52
|
|
03212 S2301-ERROR. DTSCS52
|
|
03213 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRED-DUE-IND-A. DTSCS52
|
|
03214 DTSCS52
|
|
03215 IF LCCM-NO-MSG DTSCS52
|
|
03216 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS52
|
|
03217 MOVE CATB-CURSOR TO MAP-PRED-DUE-IND-L DTSCS52
|
|
03218 SET CURSOR-SET-YES TO TRUE. DTSCS52
|
|
03219 S2301-EXIT. DTSCS52
|
|
03220 EXIT. DTSCS52
|
|
03221 /*****************************************************************DTSCS52
|
|
03222 * *DTSCS52
|
|
03223 ******************************************************************DTSCS52
|
|
03224 S3100-MISC-EDITS. DTSCS52
|
|
03225 *****PERFORM S3110-BEN-CHARGED-TOTAL-EDIT THRU S3110-EXIT. DTSCS52
|
|
03226 DTSCS52
|
|
03227 DTSCS52
|
|
03228 MOVE LOW-VALUES TO MRCT-REC. DTSCS52
|
|
03229 DTSCS52
|
|
03230 MOVE WRK-EMP-NO TO MRCT-EMP-NO. DTSCS52
|
|
03231 DTSCS52
|
|
03232 SET MRCT-RCT-88 TO TRUE. DTSCS52
|
|
03233 DTSCS52
|
|
03234 MOVE L016-YRQ TO MRCT-EFF-YRQ. DTSCS52
|
|
03235 DTSCS52
|
|
03236 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSCS52
|
|
03237 DTSCS52
|
|
03238 PERFORM S810-READ THRU S810-EXIT. DTSCS52
|
|
03239 DTSCS52
|
|
03240 DTSCS52
|
|
03241 IF L810-OK-88 DTSCS52
|
|
03242 AND LCCM-F09-88 DTSCS52
|
|
03243 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS52
|
|
03244 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS52
|
|
03245 GO TO S3100-EXIT. DTSCS52
|
|
03246 DTSCS52
|
|
03247 DTSCS52
|
|
03248 IF L810-NO-REC-88 DTSCS52
|
|
03249 AND LCCM-F10-88 DTSCS52
|
|
03250 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS52
|
|
03251 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS52
|
|
03252 GO TO S3100-EXIT. DTSCS52
|
|
03253 S3100-EXIT. DTSCS52
|
|
03254 EXIT. DTSCS52
|
|
03255 SKIP3 DTSCS52
|
|
03256 *S3110-BEN-CHARGED-TOTAL-EDIT. DTSCS52
|
|
03257 *****IF WRK-TBL-NOT-OK-88 (4) DTSCS52
|
|
03258 *********GO TO S3110-EXIT. DTSCS52
|
|
03259 DTSCS52
|
|
03260 *****IF WRK-TBL-TOT (4) < +0 DTSCS52
|
|
03261 *********MOVE MSG-E523-AREA TO WRK-MSG-AREA DTSCS52
|
|
03262 *********PERFORM S1851-ERROR THRU S1851-EXIT DTSCS52
|
|
03263 *************VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
03264 *************UNTIL WRK-CTR > +4. DTSCS52
|
|
03265 *S3110-EXIT. DTSCS52
|
|
03266 *****EXIT. DTSCS52
|
|
03267 /*****************************************************************DTSCS52
|
|
03268 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS52
|
|
03269 ******************************************************************DTSCS52
|
|
03270 S5100-SET-LOCK-ATTRB. DTSCS52
|
|
03271 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS52
|
|
03272 WRK-ATB-NUM. DTSCS52
|
|
03273 DTSCS52
|
|
03274 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS52
|
|
03275 DTSCS52
|
|
03276 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS52
|
|
03277 MAP-EMP-NO-2-A DTSCS52
|
|
03278 MAP-GOTO-A. DTSCS52
|
|
03279 S5100-EXIT. DTSCS52
|
|
03280 EXIT. DTSCS52
|
|
03281 SKIP3 DTSCS52
|
|
03282 ******************************************************************DTSCS52
|
|
03283 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS52
|
|
03284 ******************************************************************DTSCS52
|
|
03285 DTSCS52
|
|
03286 S5200-SET-UPDATE-ATTRB. DTSCS52
|
|
03287 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS52
|
|
03288 DTSCS52
|
|
03289 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS52
|
|
03290 DTSCS52
|
|
03291 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS52
|
|
03292 DTSCS52
|
|
03293 IF LCCM-SCR-INQUIRE DTSCS52
|
|
03294 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EFF-QTR-YR-A DTSCS52
|
|
03295 MAP-EFF-QTR-Q-A. DTSCS52
|
|
03296 S5200-EXIT. DTSCS52
|
|
03297 EXIT. DTSCS52
|
|
03298 SKIP3 DTSCS52
|
|
03299 ******************************************************************DTSCS52
|
|
03300 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS52
|
|
03301 ******************************************************************DTSCS52
|
|
03302 DTSCS52
|
|
03303 S5300-SET-INQ-ATTRB. DTSCS52
|
|
03304 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS52
|
|
03305 WRK-ATB-NUM. DTSCS52
|
|
03306 DTSCS52
|
|
03307 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS52
|
|
03308 S5300-EXIT. DTSCS52
|
|
03309 EXIT. DTSCS52
|
|
03310 SKIP3 DTSCS52
|
|
03311 S5900-SET-ATTRB. DTSCS52
|
|
03312 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS52
|
|
03313 MAP-EMP-NO-2-A. DTSCS52
|
|
03314 DTSCS52
|
|
03315 MOVE WRK-ATB-AN DTSCS52
|
|
03316 TO MAP-ACTIVE-IND-A DTSCS52
|
|
03317 MAP-PRED-DUE-IND-A DTSCS52
|
|
03318 MAP-RATE-TYPE-A. DTSCS52
|
|
03319 DTSCS52
|
|
03320 MOVE WRK-ATB-NUM DTSCS52
|
|
03321 TO MAP-EFF-QTR-YR-A DTSCS52
|
|
03322 MAP-EFF-QTR-Q-A DTSCS52
|
|
03323 MAP-EARLIEST-LIAB-MONTH-A DTSCS52
|
|
03324 MAP-EARLIEST-LIAB-DAY-A DTSCS52
|
|
03325 MAP-EARLIEST-LIAB-YEAR-A DTSCS52
|
|
03326 MAP-TRNSF-TO-EMP-NO-1-A DTSCS52
|
|
03327 MAP-TRNSF-TO-EMP-NO-2-A DTSCS52
|
|
03328 MAP-PRIOR-RESERVE-CHNG-A DTSCS52
|
|
03329 MAP-UI-TAX-PAID-CHNG-A DTSCS52
|
|
03330 MAP-TRUST-FUND-INT-CHNG-A DTSCS52
|
|
03331 MAP-UI-BEN-CHRGD-CHNG-A DTSCS52
|
|
03332 MAP-MISS-RPT-CNT-A DTSCS52
|
|
03333 MAP-UI-TAX-DUE-A . DTSCS52
|
|
03334 DTSCS52
|
|
03335 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS52
|
|
03336 MAP-CURR-PAGE-A DTSCS52
|
|
03337 MAP-LAST-PAGE-A DTSCS52
|
|
03338 MAP-PERIOD-FROM-A DTSCS52
|
|
03339 MAP-PERIOD-TO-A DTSCS52
|
|
03340 MAP-PRIOR-DATE-A DTSCS52
|
|
03341 MAP-PRIOR-RESERVE-A DTSCS52
|
|
03342 MAP-UI-TAX-PAID-A DTSCS52
|
|
03343 MAP-TRUST-FUND-INT-A DTSCS52
|
|
03344 MAP-UI-BEN-CHRGD-A DTSCS52
|
|
03345 MAP-CURRENT-RESERVE-A DTSCS52
|
|
03346 MAP-CURRENT-DATE-A DTSCS52
|
|
03347 MAP-ESTB-DATE-A DTSCS52
|
|
03348 MAP-AVG-TAX-WAGE-A DTSCS52
|
|
03349 MAP-CHNG-DATE-A DTSCS52
|
|
03350 MAP-RESERVE-RATIO-A DTSCS52
|
|
03351 MAP-CHNG-OPID-A DTSCS52
|
|
03352 MAP-RATE-A-A DTSCS52
|
|
03353 MAP-RATE-B-A DTSCS52
|
|
03354 MAP-PEN-RATE-IND-A DTSCS52
|
|
03355 MAP-RATE-CATEGORY-DSCR-A DTSCS52
|
|
03356 MAP-ESTIM-QTR1-WAGE-A. DTSCS52
|
|
03357 DTSCS52
|
|
03358 PERFORM S5910-LOOP THRU S5910-EXIT DTSCS52
|
|
03359 VARYING WRK-CTR FROM 1 BY 1 DTSCS52
|
|
03360 UNTIL WRK-CTR > 3. DTSCS52
|
|
03361 DTSCS52
|
|
03362 DTSCS52
|
|
03363 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS52
|
|
03364 S5900-EXIT. DTSCS52
|
|
03365 EXIT. DTSCS52
|
|
03366 SKIP3 DTSCS52
|
|
03367 S5910-LOOP. DTSCS52
|
|
03368 MOVE WRK-ATB-NUM DTSCS52
|
|
03369 TO MAP-TOT-WAGE-CHNG-A (WRK-CTR) DTSCS52
|
|
03370 MAP-TAX-WAGE-CHNG-A (WRK-CTR). DTSCS52
|
|
03371 DTSCS52
|
|
03372 MOVE CATB-ASKIP-BRT-MDTON DTSCS52
|
|
03373 TO MAP-START-YRQ-A (WRK-CTR) DTSCS52
|
|
03374 MAP-END-YRQ-A (WRK-CTR) DTSCS52
|
|
03375 MAP-TOT-WAGE-A (WRK-CTR) DTSCS52
|
|
03376 MAP-TAX-WAGE-A (WRK-CTR). DTSCS52
|
|
03377 S5910-EXIT. DTSCS52
|
|
03378 EXIT. DTSCS52
|
|
03379 /*****************************************************************DTSCS52
|
|
03380 * MAP ROUTINES *DTSCS52
|
|
03381 ******************************************************************DTSCS52
|
|
03382 DTSCS52
|
|
03383 S9100-RECEIVE. DTSCS52
|
|
03384 SET L851-RECEIVE-88 TO TRUE. DTSCS52
|
|
03385 DTSCS52
|
|
03386 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS52
|
|
03387 DTSCS52
|
|
03388 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS52
|
|
03389 DTSCS52
|
|
03390 MOVE L851-AID TO LCCM-AID. DTSCS52
|
|
03391 DTSCS52
|
|
03392 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS52
|
|
03393 S9100-EXIT. DTSCS52
|
|
03394 EXIT. DTSCS52
|
|
03395 SKIP3 DTSCS52
|
|
03396 S9200-SEND-DATAONLY. DTSCS52
|
|
03397 MOVE LOW-VALUES TO MAP-AREA. DTSCS52
|
|
03398 DTSCS52
|
|
03399 IF LCCM-NO-MSG DTSCS52
|
|
03400 NEXT SENTENCE DTSCS52
|
|
03401 ELSE DTSCS52
|
|
03402 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS52
|
|
03403 DTSCS52
|
|
03404 IF CURSOR-SET-GOTO DTSCS52
|
|
03405 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS52
|
|
03406 ELSE DTSCS52
|
|
03407 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS52
|
|
03408 DTSCS52
|
|
03409 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS52
|
|
03410 DTSCS52
|
|
03411 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS52
|
|
03412 DTSCS52
|
|
03413 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS52
|
|
03414 S9200-EXIT. DTSCS52
|
|
03415 EXIT. DTSCS52
|
|
03416 SKIP3 DTSCS52
|
|
03417 S9300-SEND-MAP. DTSCS52
|
|
03418 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS52
|
|
03419 DTSCS52
|
|
03420 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS52
|
|
03421 DTSCS52
|
|
03422 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS52
|
|
03423 DTSCS52
|
|
03424 IF SCR-ACCESS-UPDATE DTSCS52
|
|
03425 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS52
|
|
03426 ELSE DTSCS52
|
|
03427 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS52
|
|
03428 DTSCS52
|
|
03429 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS52
|
|
03430 DTSCS52
|
|
03431 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS52
|
|
03432 DTSCS52
|
|
03433 IF CURSOR-SET-NO DTSCS52
|
|
03434 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS52
|
|
03435 DTSCS52
|
|
03436 SET L851-SEND-88 TO TRUE. DTSCS52
|
|
03437 DTSCS52
|
|
03438 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS52
|
|
03439 DTSCS52
|
|
03440 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS52
|
|
03441 S9300-EXIT. DTSCS52
|
|
03442 EXIT. DTSCS52
|
|
03443 SKIP3 DTSCS52
|
|
03444 S9310-UPDATE-FKEYS. DTSCS52
|
|
03445 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS52
|
|
03446 DTSCS52
|
|
03447 IF LCCM-SCR-CLEAR DTSCS52
|
|
03448 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS52
|
|
03449 ELSE DTSCS52
|
|
03450 IF LCCM-SCR-INQUIRE DTSCS52
|
|
03451 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS52
|
|
03452 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS52
|
|
03453 ELSE DTSCS52
|
|
03454 IF LCCM-SCR-UPDATE-LOCKED DTSCS52
|
|
03455 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS52
|
|
03456 MAP-KEY-LAST DTSCS52
|
|
03457 MAP-KEY-BACK DTSCS52
|
|
03458 MAP-KEY-FWRD DTSCS52
|
|
03459 MAP-KEY-ADD DTSCS52
|
|
03460 MAP-KEY-MOD DTSCS52
|
|
03461 MAP-KEY-DEL. DTSCS52
|
|
03462 S9310-EXIT. DTSCS52
|
|
03463 EXIT. DTSCS52
|
|
03464 SKIP3 DTSCS52
|
|
03465 S9320-INQUIRY-FKEYS. DTSCS52
|
|
03466 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS52
|
|
03467 DTSCS52
|
|
03468 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS52
|
|
03469 DTSCS52
|
|
03470 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS52
|
|
03471 DTSCS52
|
|
03472 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS52
|
|
03473 DTSCS52
|
|
03474 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS52
|
|
03475 MAP-KEY-MOD DTSCS52
|
|
03476 MAP-KEY-DEL. DTSCS52
|
|
03477 S9320-EXIT. DTSCS52
|
|
03478 EXIT. DTSCS52
|
|
03479 SKIP3 DTSCS52
|
|
03480 S9330-DSCR-FIELDS. DTSCS52
|
|
03481 IF WRK-MPRF-YES-88 DTSCS52
|
|
03482 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS52
|
|
03483 S9330-EXIT. DTSCS52
|
|
03484 EXIT. DTSCS52
|
|
03485 SKIP3 DTSCS52
|
|
03486 *S9335-TOTALS. DTSCS52
|
|
03487 *****IF WRK-TBL-OK-88(1) DTSCS52
|
|
03488 ********MOVE WRK-TBL-TOT(1) TO MAP-TOTAL-WG-CHNG-N DTSCS52
|
|
03489 *****ELSE DTSCS52
|
|
03490 ********MOVE ' - -ERROR- - ' TO MAP-TOTAL-WG-CHNG. DTSCS52
|
|
03491 DTSCS52
|
|
03492 *****IF WRK-TBL-OK-88(2) DTSCS52
|
|
03493 ********MOVE WRK-TBL-TOT(2) TO MAP-TOTAL-TAX-WG-CHNG-N DTSCS52
|
|
03494 *****ELSE DTSCS52
|
|
03495 ********MOVE ' - -ERROR- - ' TO MAP-TOTAL-TAX-WG-CHNG. DTSCS52
|
|
03496 DTSCS52
|
|
03497 *****IF WRK-TBL-OK-88(3) DTSCS52
|
|
03498 ********MOVE WRK-TBL-TOT(3) TO MAP-TOTAL-UI-PAID-CHNG-N DTSCS52
|
|
03499 *****ELSE DTSCS52
|
|
03500 ********MOVE ' - -ERROR- - ' TO MAP-TOTAL-UI-PAID-CHNG. DTSCS52
|
|
03501 DTSCS52
|
|
03502 *****IF WRK-TBL-OK-88(4) DTSCS52
|
|
03503 ********MOVE WRK-TBL-TOT(4) TO MAP-TOTAL-BEN-CHARGE-CHNG-N DTSCS52
|
|
03504 *****ELSE DTSCS52
|
|
03505 ********MOVE ' - -ERROR- - ' TO MAP-TOTAL-BEN-CHARGE-CHNG. DTSCS52
|
|
03506 *S9335-EXIT. DTSCS52
|
|
03507 *****EXIT. DTSCS52
|
|
03508 SKIP3 DTSCS52
|
|
03509 S9900-PREPARE-SEND. DTSCS52
|
|
03510 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS52
|
|
03511 LCCM-SCR-ID. DTSCS52
|
|
03512 DTSCS52
|
|
03513 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS52
|
|
03514 DTSCS52
|
|
03515 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS52
|
|
03516 S9900-EXIT. DTSCS52
|
|
03517 EXIT. DTSCS52
|