00001 IDENTIFICATION DIVISION. 05/19/08 00002 PROGRAM-ID. DTSCS48. DTSCS48 00003 AUTHOR. NGC. LV007 00004 DATE-WRITTEN. APRIL 2004. DTSCS48 00005 DATE-COMPILED. DTSCS48 00006 SKIP3 DTSCS48 00007 ***** DTSCS48 00008 * DTSCS48 00009 * FUNCTION: COMPROMISE SETTLEMENT INQUIRY/UPDATE DTSCS48 00010 * SCREEN PROCESSOR. DTSCS48 00011 * DTSCS48 00012 * DTSCS48 00013 * MODIFICATION LOG: DTSCS48 00014 * DTSCS48 00015 * 04/23/2004 INITIAL DEVELOPMENT. DTSCS48 00016 * REFERENCE: COMPROMISE PROGRAMMER: DTSCS48 00017 * DTSCS48 00018 * DTSCS48 00019 * 04/25/2007 MODIFIED CODE TO EXCLUDE SUR-TAX FROM INTEREST DTSCS48 00020 * CALC. DTSCS48 00021 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS48 00022 * DTSCS48 00023 * DTSCS48 00024 * 02/12/2008 MODIFIED CODE TO INCLUDE SUR-TAX IN INTEREST DTSCS48 00025 * CALC. DTSCS48 00026 * REFERENCE: SUR TAX PROGRAMMER: ZL1 DTSCS48 00027 * DTSCS48 00028 * DTSCS48 00029 * DESCRIPTION: DTSCS48 00030 * DTSCS48 00031 * CLEAR: DTSCS48 00032 * DTSCS48 00033 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS48 00034 * DTSCS48 00035 * DTSCS48 00036 * JUMP: DTSCS48 00037 * DTSCS48 00038 * F19 QUARTER INQUIRY (31). DTSCS48 00039 * F20 COLLECTIONS INQUIRY (41). DTSCS48 00040 * DTSCS48 00041 * DTSCS48 00042 * INQUIRY: DTSCS48 00043 * DTSCS48 00044 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS48 00045 * DTSCS48 00046 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR48-HOLD-AREA EMP-NO DTSCS48 00047 * DISPLAY RECORD INDICATED BY DTSCS48 00048 * LCCM-SCR48-HOLD-AREA DTSCS48 00049 * ELSE DTSCS48 00050 * DISPLAY LAST PAGE OF DATA ASSOCIATED DTSCS48 00051 * WITH LCCM-EMP-NO. DTSCS48 00052 * DTSCS48 00053 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS48 00054 * DTSCS48 00055 * DISPLAY SEQUENCE: ASCENDING ON MCMP-ESTB-ABSTIME. DTSCS48 00056 * DTSCS48 00057 * PAGE INITIALLY DISPLAYED: LAST. DTSCS48 00058 * DTSCS48 00059 * DTSCS48 00060 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS48 00061 * DTSCS48 00062 * STORE INFORMATION REPRESENTING PAGE DTSCS48 00063 * CURRENTLY DISPLAYED IN LCCM-SCR48-HOLD-AREA. DTSCS48 00064 * DTSCS48 00065 * DTSCS48 00066 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS48 00067 * DTSCS48 00068 * MAINTAIN LCCM-COMP-DATE. DTSCS48 00069 * DTSCS48 00070 * DTSCS48 00071 * UPDATE: DTSCS48 00072 * DTSCS48 00073 * ADD DTSCS48 00074 * MOD DTSCS48 00075 * DEL DTSCS48 00076 * DTSCS48 00077 * DTSCS48 00078 * RECORDS READ: DTSCS48 00079 * DTSCS48 00080 * MASTER: DTSCS48 00081 * DTSCS48 00082 * MPRF DTSCS48 00083 * MCMP DTSCS48 00084 * MQTR DTSCS48 00085 * DTSCS48 00086 * DTSCS48 00087 * ALTERNATE INDEX: DTSCS48 00088 * DTSCS48 00089 * NONE. DTSCS48 00090 * DTSCS48 00091 * DTSCS48 00092 * REFERENCE: DTSCS48 00093 * DTSCS48 00094 * NONE. DTSCS48 00095 * DTSCS48 00096 * DTSCS48 00097 * ACCOUNTING TRANSACTION COLLECTION: DTSCS48 00098 * DTSCS48 00099 * NONE. DTSCS48 00100 * DTSCS48 00101 * DTSCS48 00102 * RECORDS UPDATED: DTSCS48 00103 * DTSCS48 00104 * MASTER: DTSCS48 00105 * DTSCS48 00106 * MCMP (WRITE, REWRITE, DELETE) DTSCS48 00107 * DTSCS48 00108 * MEVL (WRITE) DTSCS48 00109 * IF A CMP IS ADDED OR DELETED, THEN WRITE A MEVL RECORD DTSCS48 00110 * COMMEMORATING THE EVENT. DTSCS48 00111 * IF A CMP IS 'WITHDRAWN', THEN WRITE A DTSCS48 00112 * MEVL RECORD COMMEMORATING THE EVENT. DTSCS48 00113 * DTSCS48 00114 * DTSCS48 00115 * REFERENCE: DTSCS48 00116 * DTSCS48 00117 * NONE. DTSCS48 00118 * DTSCS48 00119 * DTSCS48 00120 * ACCOUNTING TRANSACTION COLLECTION: DTSCS48 00121 * DTSCS48 00122 * NONE. DTSCS48 00123 * DTSCS48 00124 * DTSCS48 00125 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS48 00126 * DTSCS48 00127 * NONE. DTSCS48 00128 * DTSCS48 00129 * DTSCS48 00130 * TEMPORARY STORAGE USAGE: DTSCS48 00131 * DTSCS48 00132 * NONE DTSCS48 00133 * DTSCS48 00134 * DTSCS48 00135 * MODULES LINKED TO: DTSCS48 00136 * DTSCS48 00137 * DTSCU001 DATE EDIT/CONVERSION. DTSCS48 00138 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS48 00139 * DTSCU011 AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS48 00140 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS48 00141 * DTSCU029 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS48 00142 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS48 00143 * DTSCU034 COLLECTIONS CODES EDIT/DESCRIPTION. DTSCS48 00144 * DTSCU071 NAME EDIT/CONVERSION. DTSCS48 00145 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS48 00146 * DTSCU101 INTEREST AND PENALTY CHARGE/ABATEMENT DTSCS48 00147 * COMPUTATION. DTSCS48 00148 * DTSCU111 ADDRESS LOOKUP. DTSCS48 00149 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS48 00150 * DTSCU221 EMPLOYER LOCK/UNLOCK. DTSCS48 00151 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS48 00152 ***** DTSCS48 00153 DTSCS48 00154 ENVIRONMENT DIVISION. DTSCS48 00155 DTSCS48 00156 DATA DIVISION. DTSCS48 00157 DTSCS48 00158 WORKING-STORAGE SECTION. DTSCS48 001585 77 PAN-VALET PICTURE X(24) VALUE '007DTSCS48 05/19/08'. DTSCS48 00159 DTSCS48 00160 01 WRK-AREA. DTSCS48 00161 05 WRK-ABEND-CD PIC X(04) VALUE 'S48 '. DTSCS48 00162 DTSCS48 00163 05 WRK-SCR-ID. DTSCS48 00164 10 WRK-SCR-ID-N PIC 9(02) VALUE 48. DTSCS48 00165 DTSCS48 00166 05 WRK-F03-SCR-ID PIC X(02) VALUE '40'. DTSCS48 00167 DTSCS48 00168 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS48 00169 VALUE +999999999. DTSCS48 00170 DTSCS48 00171 05 SCR-ACCESS-IND PIC X(01). DTSCS48 00172 88 SCR-ACCESS-INQ VALUE '1'. DTSCS48 00173 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS48 00174 DTSCS48 00175 05 CURSOR-SET-IND PIC X(01). DTSCS48 00176 88 CURSOR-SET-YES VALUE 'Y'. DTSCS48 00177 88 CURSOR-SET-NO VALUE 'N'. DTSCS48 00178 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS48 00179 DTSCS48 00180 05 REQ-IND PIC X(01). DTSCS48 00181 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS48 00182 88 REQ-ERROR VALUE 'O'. DTSCS48 00183 88 REQ-JUMP VALUE 'J'. DTSCS48 00184 88 REQ-UPDATE VALUE 'U'. DTSCS48 00185 88 REQ-INQUIRE VALUE 'I'. DTSCS48 00186 88 REQ-CLEAR VALUE 'C'. DTSCS48 00187 88 REQ-EDIT VALUE 'E'. DTSCS48 00188 DTSCS48 00189 05 RESP-IND PIC X(01). DTSCS48 00190 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS48 00191 88 RESP-SEND-MAP VALUE 'M'. DTSCS48 00192 88 RESP-JUMP VALUE 'J'. DTSCS48 00193 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS48 00194 DTSCS48 00195 05 WRK-MSG-AREA PIC X(64). DTSCS48 00196 DTSCS48 00197 05 WRK-ATB-AN PIC X(01). DTSCS48 00198 DTSCS48 00199 05 WRK-ATB-NUM PIC X(01). DTSCS48 00200 DTSCS48 00201 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS48 00202 DTSCS48 00203 05 WRK-AMT-DUE PIC S9(09)V9(02) COMP-3. DTSCS48 00204 05 WRK-TAX-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00205 05 WRK-PEN-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00206 05 WRK-INT-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00207 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00208 05 WRK-YRQ-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00209 05 WRK-YRQ-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00210 05 WRK-YRQ-TAX-BAL-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00211 05 WRK-YRQ-WRITTEN-OFF-AMT PIC S9(09)V9(02) COMP-3. DTSCS48 00212 05 WRK-STATUS-CD PIC X(01). DTSCS48 00213 DTSCS48 00214 05 WRK-SUB PIC S9(04) COMP. DTSCS48 00215 05 WRK-ANN-SUB PIC S9(04) COMP. DTSCS48 00216 05 MAP-CNT PIC S9(04) COMP. DTSCS48 00217 DTSCS48 00218 05 WRK-SUB2 PIC S9(04) COMP. DTSCS48 00219 DTSCS48 00220 DTSCS48 00221 05 WRK-YRQ PIC 9(05). DTSCS48 00222 05 FILLER REDEFINES WRK-YRQ. DTSCS48 00223 10 WRK-YRQ-YR PIC 9(04). DTSCS48 00224 10 WRK-YRQ-Q PIC 9(01). DTSCS48 00225 DTSCS48 00226 DTSCS48 00227 DTSCS48 00228 05 WRK-TBL-SUB PIC S9(04) COMP. DTSCS48 00229 DTSCS48 00230 05 WRK-SUB-MINUS-ONE PIC S9(04) COMP. DTSCS48 00231 DTSCS48 00232 05 WRK-NO-ENTRY-CTR PIC S9(04) COMP. DTSCS48 00233 DTSCS48 00234 05 WRK-MPRF-IND PIC X(01). DTSCS48 00235 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS48 00236 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS48 00237 DTSCS48 00238 05 WRK-MCMP-IND PIC X(01). DTSCS48 00239 88 WRK-MCMP-YES-88 VALUE 'Y'. DTSCS48 00240 88 WRK-MCMP-NO-88 VALUE 'N'. DTSCS48 00241 DTSCS48 00242 05 WRK-TBL OCCURS 40 TIMES. DTSCS48 00243 10 WRK-TBL-QTR PIC S9(05) COMP-3. DTSCS48 00244 10 WRK-TBL-BALANCE PIC S9(09)V99 COMP-3. DTSCS48 00245 DTSCS48 00246 DTSCS48 00247 05 WRK-DISPLAY PIC 9(11). DTSCS48 00248 DTSCS48 00249 05 FILLER REDEFINES WRK-DISPLAY. DTSCS48 00250 10 FILLER PIC X(05). DTSCS48 00251 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS48 00252 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS48 00253 DTSCS48 00254 05 FILLER REDEFINES WRK-DISPLAY. DTSCS48 00255 10 FILLER PIC X(05). DTSCS48 00256 10 WRK-DISPLAY-YR PIC X(02). DTSCS48 00257 10 WRK-DISPLAY-MO PIC X(02). DTSCS48 00258 10 WRK-DISPLAY-DA PIC X(02). DTSCS48 00259 DTSCS48 00260 05 FILLER REDEFINES WRK-DISPLAY. DTSCS48 00261 10 FILLER PIC X(08). DTSCS48 00262 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS48 00263 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS48 00264 DTSCS48 00265 DTSCS48 00266 05 INQUIRY-CONTROL-AREA. DTSCS48 00267 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS48 00268 10 WS-REC-NUM PIC S9(08) COMP. DTSCS48 00269 DTSCS48 00270 10 LAST-REC-KEY-AREA PIC X(16). DTSCS48 00271 10 SCR-REC-KEY-AREA PIC X(16). DTSCS48 00272 DTSCS48 00273 10 WS-REC-FOUND-IND PIC X(01). DTSCS48 00274 DTSCS48 00275 DTSCS48 00276 05 EVL-TEXT. DTSCS48 00277 10 FILLER PIC X(26) VALUE DTSCS48 00278 'COMPROMISE SETTLEMENT '. DTSCS48 00279 10 EVL-STATUS-CD-DSCR PIC X(12). DTSCS48 00280 EJECT DTSCS48 00281 01 MSG-LITERALS. DTSCS48 00282 DTSCS48 00283 05 MSG-E481-AREA. DTSCS48 00284 10 FILLER PIC X(04) VALUE 'E481'. DTSCS48 00285 10 FILLER PIC X(30) DTSCS48 00286 VALUE 'YRQ MUST BE IN ASCENDING SEQUE'. DTSCS48 00287 10 FILLER PIC X(30) DTSCS48 00288 VALUE 'NCE '. DTSCS48 00289 DTSCS48 00290 05 MSG-E482-AREA. DTSCS48 00291 10 FILLER PIC X(04) VALUE 'E482'. DTSCS48 00292 10 FILLER PIC X(30) DTSCS48 00293 VALUE 'NO UI TAX DUE '. DTSCS48 00294 10 FILLER PIC X(30) DTSCS48 00295 VALUE ' '. DTSCS48 00296 DTSCS48 00297 05 MSG-E483-AREA. DTSCS48 00298 10 FILLER PIC X(04) VALUE 'E483'. DTSCS48 00299 10 FILLER PIC X(30) DTSCS48 00300 VALUE 'STATUS MAY ONLY BE CHANGED TO '. DTSCS48 00301 10 FILLER PIC X(30) DTSCS48 00302 VALUE 'WITHDRAWN '. DTSCS48 00303 DTSCS48 00304 05 MSG-E484-AREA. DTSCS48 00305 10 FILLER PIC X(04) VALUE 'E484'. DTSCS48 00306 10 FILLER PIC X(30) DTSCS48 00307 VALUE 'AT LEAST ONE QUARTER MUST BE E'. DTSCS48 00308 10 FILLER PIC X(30) DTSCS48 00309 VALUE 'NTERED '. DTSCS48 00310 DTSCS48 00311 DTSCS48 00312 05 MSG-E486-AREA. DTSCS48 00313 10 FILLER PIC X(04) VALUE 'E486'. DTSCS48 00314 10 FILLER PIC X(30) DTSCS48 00315 VALUE 'STATUS MAY NOT BE CHANGED ONCE'. DTSCS48 00316 10 FILLER PIC X(30) DTSCS48 00317 VALUE ' WITHDRAWN '. DTSCS48 00318 DTSCS48 00319 05 MSG-E487-AREA. DTSCS48 00320 10 FILLER PIC X(04) VALUE 'E487'. DTSCS48 00321 10 FILLER PIC X(30) DTSCS48 00322 VALUE 'PENDING COMPROMISE SETTLEMENT '. DTSCS48 00323 10 FILLER PIC X(30) DTSCS48 00324 VALUE 'ALREADY ON FILE '. DTSCS48 00325 DTSCS48 00326 EJECT DTSCS48 00327 01 L001-COMM-AREA. DTSCS48 00328 ++INCLUDE DTSIL001 DTSCS48 00329 EJECT DTSCS48 00330 01 L011-COMM-AREA. DTSCS48 00331 ++INCLUDE DTSIL011 DTSCS48 00332 EJECT DTSCS48 00333 01 L013-COMM-AREA. DTSCS48 00334 ++INCLUDE DTSIL013 DTSCS48 00335 EJECT DTSCS48 00336 01 L015-COMM-AREA. DTSCS48 00337 ++INCLUDE DTSIL015 DTSCS48 00338 EJECT DTSCS48 00339 01 L018-COMM-AREA. DTSCS48 00340 ++INCLUDE DTSIL018 DTSCS48 00341 EJECT DTSCS48 00342 01 L029-COMM-AREA. DTSCS48 00343 ++INCLUDE DTSIL029 DTSCS48 00344 EJECT DTSCS48 00345 01 L034-COMM-AREA. DTSCS48 00346 ++INCLUDE DTSIL034 DTSCS48 00347 EJECT DTSCS48 00348 01 L071-COMM-AREA. DTSCS48 00349 ++INCLUDE DTSIL071 DTSCS48 00350 EJECT DTSCS48 00351 01 L082-COMM-AREA. DTSCS48 00352 ++INCLUDE DTSIL082 DTSCS48 00353 EJECT DTSCS48 00354 01 L101-COMM-AREA. DTSCS48 00355 ++INCLUDE DTSIL101 DTSCS48 00356 EJECT DTSCS48 00357 01 L111-COMM-AREA. DTSCS48 00358 ++INCLUDE DTSIL111 DTSCS48 00359 EJECT DTSCS48 00360 01 L112-COMM-AREA. DTSCS48 00361 ++INCLUDE DTSIL112 DTSCS48 00362 EJECT DTSCS48 00363 01 L109-COMM-AREA. DTSCS48 00364 ++INCLUDE DTSIL109 DTSCS48 00365 EJECT DTSCS48 00366 01 L221-COMM-AREA. DTSCS48 00367 ++INCLUDE DTSIL221 DTSCS48 00368 EJECT DTSCS48 00369 01 L805-COMM-AREA. DTSCS48 00370 ++INCLUDE DTSIL805 DTSCS48 00371 EJECT DTSCS48 00372 01 L810-COMM-AREA. DTSCS48 00373 05 L810-CONTROL-BLOCK. DTSCS48 00374 ++INCLUDE DTSIL810 DTSCS48 00375 EJECT DTSCS48 00376 05 MSKL-REC. DTSCS48 00377 ++INCLUDE DTSIMSKL DTSCS48 00378 EJECT DTSCS48 00379 01 MPRF-REC. DTSCS48 00380 ++INCLUDE DTSIMPRF DTSCS48 00381 EJECT DTSCS48 00382 01 MCMP-REC. DTSCS48 00383 ++INCLUDE DTSIMCMP DTSCS48 00384 EJECT DTSCS48 00385 01 MQTR-REC. DTSCS48 00386 ++INCLUDE DTSIMQTR DTSCS48 00387 EJECT DTSCS48 00388 01 MTCK-REC. DTSCS48 00389 ++INCLUDE DTSIMTCK DTSCS48 00390 EJECT DTSCS48 00391 01 MEVL-REC. DTSCS48 00392 ++INCLUDE DTSIMEVL DTSCS48 00393 EJECT DTSCS48 00394 01 L825-COMM-AREA. DTSCS48 00395 05 L825-CONTROL-BLOCK. DTSCS48 00396 ++INCLUDE DTSIL825 DTSCS48 00397 DTSCS48 00398 05 RSKL-REC. DTSCS48 00399 ++INCLUDE DTSIRSK1 DTSCS48 00400 SKIP3 DTSCS48 00401 01 T011-REC. DTSCS48 00402 ++INCLUDE DTSIT011 DTSCS48 00403 EJECT DTSCS48 00404 01 L851-COMM-AREA. DTSCS48 00405 ++INCLUDE DTSIL851 DTSCS48 00406 DTSCS48 00407 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS48 00408 ++INCLUDE DTSIS48 DTSCS48 00409 EJECT DTSCS48 00410 01 CATB-LITERALS. DTSCS48 00411 ++INCLUDE DTSICATB DTSCS48 00412 DTSCS48 00413 01 CFKD-LITERALS. DTSCS48 00414 ++INCLUDE DTSICFKD DTSCS48 00415 DTSCS48 00416 01 CECD-LITERALS. DTSCS48 00417 ++INCLUDE DTSICECD DTSCS48 00418 DTSCS48 00419 01 CPCD-LITERALS. DTSCS48 00420 ++INCLUDE DTSICPCD DTSCS48 00421 EJECT DTSCS48 00422 DTSCS48 00423 01 MMAX-LITERALS. DTSCS48 00424 ++INCLUDE DTSIMMAX DTSCS48 00425 EJECT DTSCS48 00426 LINKAGE SECTION. DTSCS48 00427 DTSCS48 00428 01 DFHCOMMAREA. DTSCS48 00429 ++INCLUDE DTSILCCM DTSCS48 00430 SKIP3 DTSCS48 00431 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS48 00432 20 LCCM-SCR-HOLD-PROG-NAME PIC X(07). DTSCS48 00433 20 LCCM-SCR-HOLD-KEY PIC X(16). DTSCS48 00434 20 LCCM-SCR-HOLD-STATUS-CD PIC X(01). DTSCS48 00435 EJECT DTSCS48 00436 ***************************************************************** DTSCS48 00437 * DTSCS48 00438 ***************************************************************** DTSCS48 00439 DTSCS48 00440 PROCEDURE DIVISION. DTSCS48 00441 DTSCS48 00442 MOVE +0 TO WRK-EMP-NO. DTSCS48 00443 DTSCS48 00444 SET WRK-MPRF-NO-88 TO TRUE. DTSCS48 00445 DTSCS48 00446 SET WRK-MCMP-NO-88 TO TRUE. DTSCS48 00447 DTSCS48 00448 MOVE LOW-VALUES TO MAP-AREA. DTSCS48 00449 DTSCS48 00450 SET CURSOR-SET-NO TO TRUE. DTSCS48 00451 DTSCS48 00452 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS48 00453 TO SCR-ACCESS-IND. DTSCS48 00454 DTSCS48 00455 IF SCR-ACCESS-UPDATE DTSCS48 00456 IF LCCM-OP-IS-FLD-DESK-88 DTSCS48 00457 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS48 00458 NEXT SENTENCE DTSCS48 00459 ELSE DTSCS48 00460 SET SCR-ACCESS-INQ TO TRUE DTSCS48 00461 END-IF. DTSCS48 00462 DTSCS48 00463 MOVE SPACE TO REQ-IND. DTSCS48 00464 DTSCS48 00465 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS48 00466 DTSCS48 00467 *----------------------------------------------------- DTSCS48 00468 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS48 00469 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS48 00470 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS48 00471 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS48 00472 * DTSCS48 00473 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS48 00474 * PROCESSED. DTSCS48 00475 * DTSCS48 00476 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS48 00477 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS48 00478 * WORK STATION OPERATOR. DTSCS48 00479 *----------------------------------------------------- DTSCS48 00480 DTSCS48 00481 MOVE SPACE TO RESP-IND. DTSCS48 00482 DTSCS48 00483 IF REQ-ERROR DTSCS48 00484 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS48 00485 ELSE DTSCS48 00486 IF REQ-JUMP DTSCS48 00487 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS48 00488 ELSE DTSCS48 00489 IF REQ-CLEAR DTSCS48 00490 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS48 00491 ELSE DTSCS48 00492 IF REQ-CURSOR-TO-GOTO DTSCS48 00493 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS48 00494 ELSE DTSCS48 00495 IF REQ-INQUIRE DTSCS48 00496 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS48 00497 ELSE DTSCS48 00498 IF REQ-EDIT DTSCS48 00499 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS48 00500 ELSE DTSCS48 00501 IF REQ-UPDATE DTSCS48 00502 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS48 00503 ELSE DTSCS48 00504 GO TO S899-ABEND. DTSCS48 00505 DTSCS48 00506 *----------------------------------------------------- DTSCS48 00507 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS48 00508 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS48 00509 *----------------------------------------------------- DTSCS48 00510 DTSCS48 00511 IF RESP-SEND-MAP DTSCS48 00512 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS48 00513 SET LCCM-END-TASK-88 TO TRUE DTSCS48 00514 ELSE DTSCS48 00515 IF RESP-SEND-MSGONLY DTSCS48 00516 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS48 00517 SET LCCM-END-TASK-88 TO TRUE DTSCS48 00518 ELSE DTSCS48 00519 IF RESP-JUMP DTSCS48 00520 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48 00521 ELSE DTSCS48 00522 IF RESP-CURSOR-TO-GOTO DTSCS48 00523 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS48 00524 SET LCCM-END-TASK-88 TO TRUE DTSCS48 00525 ELSE DTSCS48 00526 GO TO S899-ABEND. DTSCS48 00527 DTSCS48 00528 MAINLINE-EXIT. DTSCS48 00529 DTSCS48 00530 EXEC CICS DTSCS48 00531 RETURN DTSCS48 00532 END-EXEC. DTSCS48 00533 DTSCS48 00534 * GOBACK. DTSCS48 00535 EJECT DTSCS48 00536 /**************************************************************** DTSCS48 00537 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION DTSCS48 00538 ***************************************************************** DTSCS48 00539 P1000-ANALYZE-REQUEST. DTSCS48 00540 DTSCS48 00541 *----------------------------------------------------- DTSCS48 00542 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS48 00543 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS48 00544 * REPLACED WITH ENTER) DTSCS48 00545 *----------------------------------------------------- DTSCS48 00546 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS48 00547 SET LCCM-ENTER-88 TO TRUE DTSCS48 00548 IF LCCM-EMP-NO > ZERO DTSCS48 00549 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS48 00550 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS48 00551 END-IF DTSCS48 00552 SET REQ-INQUIRE TO TRUE DTSCS48 00553 GO TO P1000-EXIT. DTSCS48 00554 DTSCS48 00555 *----------------------------------------------------- DTSCS48 00556 * MAP IS RECEIVED DTSCS48 00557 *----------------------------------------------------- DTSCS48 00558 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS48 00559 DTSCS48 00560 *----------------------------------------------------- DTSCS48 00561 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS48 00562 * WORK STATION DTSCS48 00563 *----------------------------------------------------- DTSCS48 00564 IF LCCM-CLEAR-88 DTSCS48 00565 SET REQ-CLEAR TO TRUE DTSCS48 00566 GO TO P1000-EXIT. DTSCS48 00567 DTSCS48 00568 *----------------------------------------------------- DTSCS48 00569 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS48 00570 *----------------------------------------------------- DTSCS48 00571 IF LCCM-SCR-UPDATE-LOCKED DTSCS48 00572 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS48 00573 GO TO P1000-EXIT. DTSCS48 00574 DTSCS48 00575 *----------------------------------------------------- DTSCS48 00576 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS48 00577 *----------------------------------------------------- DTSCS48 00578 IF LCCM-PA2-88 DTSCS48 00579 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS48 00580 GO TO P1000-EXIT. DTSCS48 00581 DTSCS48 00582 *----------------------------------------------------- DTSCS48 00583 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS48 00584 *----------------------------------------------------- DTSCS48 00585 IF LCCM-PA-88 DTSCS48 00586 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS48 00587 SET REQ-ERROR TO TRUE DTSCS48 00588 GO TO P1000-EXIT. DTSCS48 00589 DTSCS48 00590 *----------------------------------------------------- DTSCS48 00591 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS48 00592 * THEN CLEAR SCREEN. DTSCS48 00593 *----------------------------------------------------- DTSCS48 00594 IF LCCM-F12-88 DTSCS48 00595 MOVE LOW-VALUES TO MAP-AREA DTSCS48 00596 SET REQ-CLEAR TO TRUE DTSCS48 00597 GO TO P1000-EXIT. DTSCS48 00598 DTSCS48 00599 *----------------------------------------------------- DTSCS48 00600 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS48 00601 *----------------------------------------------------- DTSCS48 00602 IF LCCM-F03-88 DTSCS48 00603 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS48 00604 SET REQ-JUMP TO TRUE DTSCS48 00605 GO TO P1000-EXIT. DTSCS48 00606 DTSCS48 00607 *----------------------------------------------------- DTSCS48 00608 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS48 00609 *----------------------------------------------------- DTSCS48 00610 IF LCCM-F04-88 DTSCS48 00611 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS48 00612 SET REQ-JUMP TO TRUE DTSCS48 00613 GO TO P1000-EXIT. DTSCS48 00614 DTSCS48 00615 *--------------------------------------------------------- DTSCS48 00616 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS48 00617 * CORRESPONDENCE SCREEN. DTSCS48 00618 *--------------------------------------------------------- DTSCS48 00619 DTSCS48 00620 IF LCCM-F14-88 DTSCS48 00621 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS48 00622 SET REQ-JUMP TO TRUE DTSCS48 00623 GO TO P1000-EXIT. DTSCS48 00624 DTSCS48 00625 *----------------------------------------------------- DTSCS48 00626 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS48 00627 * REQUESTED SCREEN TYPE DTSCS48 00628 *----------------------------------------------------- DTSCS48 00629 * DTSCS48 00630 * IF LCCM-F19-88 DTSCS48 00631 * MOVE '31' TO LCCM-REQ-SCR-ID DTSCS48 00632 * SET REQ-JUMP TO TRUE DTSCS48 00633 * GO TO P1000-EXIT. DTSCS48 00634 * DTSCS48 00635 * IF LCCM-F20-88 DTSCS48 00636 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS48 00637 * SET REQ-JUMP TO TRUE DTSCS48 00638 * GO TO P1000-EXIT. DTSCS48 00639 * DTSCS48 00640 *----------------------------------------------------- DTSCS48 00641 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS48 00642 * REQUESTED SCREEN TYPE DTSCS48 00643 *----------------------------------------------------- DTSCS48 00644 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS48 00645 NEXT SENTENCE DTSCS48 00646 ELSE DTSCS48 00647 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS48 00648 SET REQ-JUMP TO TRUE DTSCS48 00649 GO TO P1000-EXIT. DTSCS48 00650 DTSCS48 00651 *----------------------------------------------------- DTSCS48 00652 * IF REQUEST TO UPDATE THE DATA (ADD,MOD) DTSCS48 00653 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS48 00654 *----------------------------------------------------- DTSCS48 00655 IF LCCM-F09-88 DTSCS48 00656 OR LCCM-F10-88 DTSCS48 00657 IF SCR-ACCESS-UPDATE DTSCS48 00658 SET REQ-EDIT TO TRUE DTSCS48 00659 GO TO P1000-EXIT DTSCS48 00660 ELSE DTSCS48 00661 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS48 00662 SET REQ-ERROR TO TRUE DTSCS48 00663 GO TO P1000-EXIT. DTSCS48 00664 DTSCS48 00665 *----------------------------------------------------- DTSCS48 00666 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS48 00667 * OR F8), INDICATE INQUIRY REQUEST DTSCS48 00668 *----------------------------------------------------- DTSCS48 00669 IF LCCM-INQUIRY-88 DTSCS48 00670 SET REQ-INQUIRE TO TRUE DTSCS48 00671 GO TO P1000-EXIT. DTSCS48 00672 DTSCS48 00673 *----------------------------------------------------- DTSCS48 00674 * ANY OTHER KEY IS INVALID DTSCS48 00675 *----------------------------------------------------- DTSCS48 00676 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS48 00677 SET REQ-ERROR TO TRUE. DTSCS48 00678 P1000-EXIT. DTSCS48 00679 EXIT. DTSCS48 00680 DTSCS48 00681 ***************************************************************** DTSCS48 00682 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH DTSCS48 00683 ***************************************************************** DTSCS48 00684 DTSCS48 00685 P1100-UPDATE-LOCKED. DTSCS48 00686 *----------------------------------------------------- DTSCS48 00687 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS48 00688 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS48 00689 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS48 00690 *----------------------------------------------------- DTSCS48 00691 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS48 00692 SET REQ-UPDATE TO TRUE DTSCS48 00693 ELSE DTSCS48 00694 SET REQ-ERROR TO TRUE DTSCS48 00695 IF LCCM-SCR-ADD-LOCKED DTSCS48 00696 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS48 00697 ELSE DTSCS48 00698 IF LCCM-SCR-MOD-LOCKED DTSCS48 00699 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS48 00700 ELSE DTSCS48 00701 GO TO S899-ABEND. DTSCS48 00702 P1100-EXIT. DTSCS48 00703 EXIT. DTSCS48 00704 /**************************************************************** DTSCS48 00705 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. DTSCS48 00706 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. DTSCS48 00707 ***************************************************************** DTSCS48 00708 DTSCS48 00709 P2000-REQUEST-ERROR. DTSCS48 00710 IF LCCM-MSG DTSCS48 00711 SET RESP-SEND-MSGONLY TO TRUE DTSCS48 00712 ELSE DTSCS48 00713 GO TO S899-ABEND. DTSCS48 00714 P2000-EXIT. DTSCS48 00715 EXIT. DTSCS48 00716 /**************************************************************** DTSCS48 00717 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED DTSCS48 00718 ***************************************************************** DTSCS48 00719 DTSCS48 00720 P3000-REQUEST-JUMP. DTSCS48 00721 *----------------------------------------------------- DTSCS48 00722 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS48 00723 * BY USER DTSCS48 00724 *----------------------------------------------------- DTSCS48 00725 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS48 00726 DTSCS48 00727 *----------------------------------------------------- DTSCS48 00728 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS48 00729 *----------------------------------------------------- DTSCS48 00730 IF LCCM-MSG DTSCS48 00731 SET RESP-SEND-MSGONLY TO TRUE DTSCS48 00732 SET CURSOR-SET-GOTO TO TRUE DTSCS48 00733 GO TO P3000-EXIT. DTSCS48 00734 SKIP3 DTSCS48 00735 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS48 00736 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS48 00737 IF L018-VALID DTSCS48 00738 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS48 00739 DTSCS48 00740 *----------------------------------------------------- DTSCS48 00741 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS48 00742 *----------------------------------------------------- DTSCS48 00743 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS48 00744 LCCM-SCR-HOLD-AREA. DTSCS48 00745 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS48 00746 SET RESP-JUMP TO TRUE. DTSCS48 00747 P3000-EXIT. DTSCS48 00748 EXIT. DTSCS48 00749 /**************************************************************** DTSCS48 00750 * CLEAR KEY WAS PRESSED DTSCS48 00751 ***************************************************************** DTSCS48 00752 DTSCS48 00753 P4000-REQUEST-CLEAR. DTSCS48 00754 DTSCS48 00755 *----------------------------------------------------- DTSCS48 00756 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS48 00757 * FIELDS FROM EARLIER REQUESTS DTSCS48 00758 *----------------------------------------------------- DTSCS48 00759 IF LCCM-EMP-NO > ZERO DTSCS48 00760 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS48 00761 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS48 00762 DTSCS48 00763 MOVE ZERO TO LCCM-EMP-NO. DTSCS48 00764 DTSCS48 00765 DTSCS48 00766 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS48 00767 DTSCS48 00768 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48 00769 DTSCS48 00770 SET LCCM-SCR-CLEAR TO TRUE. DTSCS48 00771 DTSCS48 00772 IF SCR-ACCESS-UPDATE DTSCS48 00773 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS48 00774 ELSE DTSCS48 00775 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS48 00776 DTSCS48 00777 SET RESP-SEND-MAP TO TRUE. DTSCS48 00778 P4000-EXIT. DTSCS48 00779 EXIT. DTSCS48 00780 /**************************************************************** DTSCS48 00781 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED DTSCS48 00782 ***************************************************************** DTSCS48 00783 DTSCS48 00784 P5000-CURSOR-TO-GOTO. DTSCS48 00785 SET CURSOR-SET-GOTO TO TRUE. DTSCS48 00786 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS48 00787 P5000-EXIT. DTSCS48 00788 EXIT. DTSCS48 00789 /**************************************************************** DTSCS48 00790 * INQUIRY WAS REQUESTED DTSCS48 00791 ***************************************************************** DTSCS48 00792 DTSCS48 00793 P6000-REQUEST-INQUIRE. DTSCS48 00794 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS48 00795 MOVE LOW-VALUES TO MAP-AREA. DTSCS48 00796 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS48 00797 DTSCS48 00798 SET LCCM-SCR-CLEAR TO TRUE. DTSCS48 00799 DTSCS48 00800 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48 00801 DTSCS48 00802 IF LCCM-SCR-HOLD-PROG-NAME = 'DTSCS48' DTSCS48 00803 MOVE LCCM-SCR-HOLD-KEY TO SCR-REC-KEY-AREA DTSCS48 00804 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS48 00805 ELSE DTSCS48 00806 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS48 00807 END-IF. DTSCS48 00808 DTSCS48 00809 SET RESP-SEND-MAP TO TRUE. DTSCS48 00810 DTSCS48 00811 IF SCR-ACCESS-UPDATE DTSCS48 00812 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS48 00813 ELSE DTSCS48 00814 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS48 00815 DTSCS48 00816 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 00817 IF LCCM-MSG DTSCS48 00818 GO TO P6000-EXIT. DTSCS48 00819 DTSCS48 00820 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS48 00821 DTSCS48 00822 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48 00823 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48 00824 SET MSKL-CMP-88 TO TRUE. DTSCS48 00825 PERFORM S810-COUNT THRU S810-EXIT. DTSCS48 00826 DTSCS48 00827 IF L810-RECORD-CNT = +0 DTSCS48 00828 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 00829 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 00830 GO TO P6000-EXIT. DTSCS48 00831 DTSCS48 00832 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCS48 00833 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS48 00834 DTSCS48 00835 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS48 00836 IF LCCM-MSG DTSCS48 00837 GO TO P6000-EXIT. DTSCS48 00838 DTSCS48 00839 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS48 00840 DTSCS48 00841 MOVE 'DTSCS48' TO LCCM-SCR-HOLD-PROG-NAME. DTSCS48 00842 MOVE MCMP-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS48 00843 DTSCS48 00844 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS48 00845 DTSCS48 00846 IF SCR-ACCESS-UPDATE DTSCS48 00847 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48 00848 P6000-EXIT. DTSCS48 00849 EXIT. DTSCS48 00850 EJECT DTSCS48 00851 DTSCS48 00852 P6100-LOCATE-REC. DTSCS48 00853 *------------------------------------------------------------ DTSCS48 00854 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS48 00855 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS48 00856 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS48 00857 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS48 00858 * RECORD WITH THE GREATEST MCMP-ESTB-DATE DTSCS48 00859 *------------------------------------------------------------ DTSCS48 00860 DTSCS48 00861 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS48 00862 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS48 00863 GO TO P6100-EXIT. DTSCS48 00864 DTSCS48 00865 MOVE SCR-REC-KEY-AREA TO MCMP-KEY-AREA. DTSCS48 00866 DTSCS48 00867 IF WRK-EMP-NO = MCMP-EMP-NO DTSCS48 00868 NEXT SENTENCE DTSCS48 00869 ELSE DTSCS48 00870 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS48 00871 GO TO P6100-EXIT. DTSCS48 00872 DTSCS48 00873 IF LCCM-F05-88 DTSCS48 00874 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS48 00875 GO TO P6100-EXIT. DTSCS48 00876 DTSCS48 00877 IF LCCM-F06-88 DTSCS48 00878 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS48 00879 GO TO P6100-EXIT. DTSCS48 00880 DTSCS48 00881 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48 00882 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48 00883 SET MSKL-CMP-88 TO TRUE. DTSCS48 00884 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48 00885 IF L810-NO-REC-88 DTSCS48 00886 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 00887 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 00888 GO TO P6100-EXIT. DTSCS48 00889 DTSCS48 00890 MOVE +0 TO WS-REC-NUM. DTSCS48 00891 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS48 00892 PERFORM P6190-BROWSE-MCMP THRU P6190-EXIT DTSCS48 00893 UNTIL (L810-NO-REC-88) DTSCS48 00894 OR DTSCS48 00895 (WS-REC-FOUND-IND = 'Y'). DTSCS48 00896 DTSCS48 00897 IF L810-NO-REC-88 DTSCS48 00898 PERFORM P6101-DEFAULT-PAGE THRU P6101-EXIT DTSCS48 00899 GO TO P6100-EXIT. DTSCS48 00900 DTSCS48 00901 IF LCCM-ENTER-88 DTSCS48 00902 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48 00903 GO TO P6100-EXIT. DTSCS48 00904 DTSCS48 00905 IF LCCM-F07-88 DTSCS48 00906 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS48 00907 GO TO P6100-EXIT. DTSCS48 00908 DTSCS48 00909 IF LCCM-F08-88 DTSCS48 00910 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS48 00911 GO TO P6100-EXIT. DTSCS48 00912 DTSCS48 00913 GO TO S899-ABEND. DTSCS48 00914 P6100-EXIT. DTSCS48 00915 EXIT. DTSCS48 00916 DTSCS48 00917 P6101-DEFAULT-PAGE. DTSCS48 00918 PERFORM P6140-LAST-REC THRU P6140-EXIT. DTSCS48 00919 P6101-EXIT. DTSCS48 00920 EXIT. DTSCS48 00921 DTSCS48 00922 P6110-FIRST-REC. DTSCS48 00923 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48 00924 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48 00925 SET MSKL-CMP-88 TO TRUE. DTSCS48 00926 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48 00927 IF L810-NO-REC-88 DTSCS48 00928 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 00929 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 00930 GO TO P6110-EXIT. DTSCS48 00931 DTSCS48 00932 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48 00933 DTSCS48 00934 MOVE MSKL-REC TO MCMP-REC. DTSCS48 00935 DTSCS48 00936 MOVE +1 TO WS-REC-NUM. DTSCS48 00937 P6110-EXIT. DTSCS48 00938 EXIT. DTSCS48 00939 DTSCS48 00940 P6120-PREV-REC. DTSCS48 00941 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS48 00942 IF L810-NO-REC-88 DTSCS48 00943 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 00944 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 00945 GO TO P6120-EXIT. DTSCS48 00946 DTSCS48 00947 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCS48 00948 IF L810-NO-REC-88 DTSCS48 00949 GO TO P6120-EXIT. DTSCS48 00950 DTSCS48 00951 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48 00952 DTSCS48 00953 SUBTRACT 1 FROM WS-REC-NUM. DTSCS48 00954 DTSCS48 00955 MOVE MSKL-REC TO MCMP-REC. DTSCS48 00956 P6120-EXIT. DTSCS48 00957 EXIT. DTSCS48 00958 DTSCS48 00959 P6130-NEXT-REC. DTSCS48 00960 IF MCMP-KEY-AREA > SCR-REC-KEY-AREA DTSCS48 00961 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48 00962 GO TO P6130-EXIT. DTSCS48 00963 DTSCS48 00964 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS48 00965 DTSCS48 00966 IF L810-NO-REC-88 DTSCS48 00967 GO TO P6130-EXIT. DTSCS48 00968 DTSCS48 00969 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48 00970 DTSCS48 00971 ADD +1 TO WS-REC-NUM. DTSCS48 00972 DTSCS48 00973 MOVE MSKL-REC TO MCMP-REC. DTSCS48 00974 P6130-EXIT. DTSCS48 00975 EXIT. DTSCS48 00976 DTSCS48 00977 P6140-LAST-REC. DTSCS48 00978 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCS48 00979 PERFORM S810-READ THRU S810-EXIT. DTSCS48 00980 IF L810-NO-REC-88 DTSCS48 00981 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 00982 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 00983 GO TO P6140-EXIT. DTSCS48 00984 DTSCS48 00985 MOVE MSKL-REC TO MCMP-REC. DTSCS48 00986 DTSCS48 00987 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS48 00988 P6140-EXIT. DTSCS48 00989 EXIT. DTSCS48 00990 DTSCS48 00991 P6190-BROWSE-MCMP. DTSCS48 00992 MOVE MSKL-REC TO MCMP-REC. DTSCS48 00993 ADD +1 TO WS-REC-NUM. DTSCS48 00994 IF MCMP-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS48 00995 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS48 00996 ELSE DTSCS48 00997 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS48 00998 P6190-EXIT. DTSCS48 00999 EXIT. DTSCS48 01000 /**************************************************************** DTSCS48 01001 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS DTSCS48 01002 ***************************************************************** DTSCS48 01003 DTSCS48 01004 P6900-CONSTRUCT-SCREEN. DTSCS48 01005 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT. DTSCS48 01006 PERFORM P6910-FROM-MCMP THRU P6910-EXIT. DTSCS48 01007 DTSCS48 01008 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS48 01009 P6900-EXIT. DTSCS48 01010 EXIT. DTSCS48 01011 DTSCS48 01012 P6910-FROM-MCMP. DTSCS48 01013 MOVE MCMP-STATUS-CD TO MAP-STATUS-CD DTSCS48 01014 LCCM-SCR-HOLD-STATUS-CD. DTSCS48 01015 DTSCS48 01016 MOVE MCMP-SETTLEMENT-DATE TO WRK-DISPLAY. DTSCS48 01017 MOVE WRK-DISPLAY-MO TO MAP-SETTLEMENT-MO. DTSCS48 01018 MOVE WRK-DISPLAY-DA TO MAP-SETTLEMENT-DA. DTSCS48 01019 MOVE WRK-DISPLAY-YR TO MAP-SETTLEMENT-YR. DTSCS48 01020 DTSCS48 01021 MOVE MCMP-INT-COMP-DATE TO WRK-DISPLAY. DTSCS48 01022 MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO. DTSCS48 01023 MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA. DTSCS48 01024 MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR. DTSCS48 01025 DTSCS48 01026 MOVE MCMP-AUTHORIZE-OP-ID TO MAP-AUTHORIZE-OP-ID. DTSCS48 01027 DTSCS48 01028 MOVE MCMP-MAILING-LINE-1 TO MAP-MAILING-LINE-1. DTSCS48 01029 MOVE MCMP-MAILING-LINE-2 TO MAP-MAILING-LINE-2. DTSCS48 01030 MOVE MCMP-MAILING-LINE-3 TO MAP-MAILING-LINE-3. DTSCS48 01031 MOVE MCMP-MAILING-LINE-4 TO MAP-MAILING-LINE-4. DTSCS48 01032 MOVE MCMP-MAILING-LINE-5 TO MAP-MAILING-LINE-5. DTSCS48 01033 DTSCS48 01034 MOVE +0 TO MAP-CNT. DTSCS48 01035 MOVE +0 TO WRK-AMT-DUE. DTSCS48 01036 MOVE 99999 TO WRK-YRQ. DTSCS48 01037 DTSCS48 01038 PERFORM P6911-COVERED-YRQ THRU P6911-EXIT DTSCS48 01039 VARYING WRK-SUB FROM 1 BY 1 DTSCS48 01040 UNTIL WRK-SUB > MCMP-COV-CNT. DTSCS48 01041 DTSCS48 01042 MOVE MCMP-TAX-WAIVED-AMT TO MAP-TAX-WAIVED-AMT-Z. DTSCS48 01043 MOVE MCMP-PEN-WAIVED-AMT TO MAP-PEN-WAIVED-AMT-Z. DTSCS48 01044 MOVE MCMP-INT-WAIVED-AMT TO MAP-INT-WAIVED-AMT-Z. DTSCS48 01045 MOVE MCMP-TOT-BALANCE-AMT TO MAP-TOT-BALANCE-AMT-Z. DTSCS48 01046 DTSCS48 01047 P6910-EXIT. DTSCS48 01048 EXIT. DTSCS48 01049 DTSCS48 01050 P6911-COVERED-YRQ. DTSCS48 01051 DTSCS48 01052 MOVE ZEROS TO WRK-YRQ. DTSCS48 01053 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS48 01054 MOVE MCMP-EMP-NO TO MQTR-EMP-NO. DTSCS48 01055 SET MQTR-QTR-88 TO TRUE. DTSCS48 01056 MOVE MCMP-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS48 01057 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS48 01058 DTSCS48 01059 PERFORM S810-READ THRU S810-EXIT. DTSCS48 01060 DTSCS48 01061 IF L810-NO-REC-88 DTSCS48 01062 GO TO P6911-EXIT. DTSCS48 01063 DTSCS48 01064 MOVE MSKL-REC TO MQTR-REC. DTSCS48 01065 DTSCS48 01066 * IF MQTR-ANNUAL-YES-88 DTSCS48 01067 * MOVE MQTR-YRQ TO WRK-YRQ. DTSCS48 01068 * DTSCS48 01069 * IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YR DTSCS48 01070 * ADD 1 TO MAP-CNT DTSCS48 01071 * MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48 01072 * WRK-YRQ-WRITTEN-OFF-AMT. DTSCS48 01073 DTSCS48 01074 ADD 1 TO MAP-CNT. DTSCS48 01075 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48 01076 WRK-YRQ-WAIVED-AMT DTSCS48 01077 WRK-YRQ-WRITTEN-OFF-AMT DTSCS48 01078 L101-PAID-CHNG DTSCS48 01079 L101-INT-CHARGE-CHNG DTSCS48 01080 L101-INT-WAIVE-CHNG. DTSCS48 01081 DTSCS48 01082 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS48 01083 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS48 01084 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48 01085 TO WRK-YRQ-BALANCE-AMT DTSCS48 01086 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS48 01087 TO WRK-YRQ-WRITTEN-OFF-AMT DTSCS48 01088 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48 01089 TO WRK-YRQ-WAIVED-AMT DTSCS48 01090 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS48 01091 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48 01092 TO L101-PAID-CHNG DTSCS48 01093 END-IF DTSCS48 01094 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS48 01095 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS48 01096 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48 01097 TO L101-PAID-CHNG DTSCS48 01098 END-IF DTSCS48 01099 END-PERFORM. DTSCS48 01100 DTSCS48 01101 PERFORM S4010-INTEREST THRU S4010-EXIT. DTSCS48 01102 DTSCS48 01103 ADD L101-INT-CHARGE-CHNG TO WRK-YRQ-BALANCE-AMT. DTSCS48 01104 DTSCS48 01105 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-YRQ-BALANCE-AMT. DTSCS48 01106 DTSCS48 01107 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS48 01108 MOVE ' WRITE OFF' TO MAP-WAIVED-AMT (MAP-CNT) DTSCS48 01109 ELSE DTSCS48 01110 * IF MQTR-ANNUAL-YES-88 DTSCS48 01111 * ADD WRK-YRQ-BALANCE-AMT TO WRK-AMT-DUE DTSCS48 01112 * MOVE WRK-AMT-DUE TO MAP-AMT-DUE-Z (MAP-CNT) DTSCS48 01113 * ELSE DTSCS48 01114 MOVE WRK-YRQ-WAIVED-AMT TO MAP-WAIVED-AMT-Z (MAP-CNT) DTSCS48 01115 MOVE WRK-YRQ-BALANCE-AMT TO MAP-BALANCE-AMT-Z (MAP-CNT)DTSCS48 01116 END-IF. DTSCS48 01117 DTSCS48 01118 DTSCS48 01119 IF MCMP-COVERED-YRQ (WRK-SUB) = LCCM-PICKUP-YRQ DTSCS48 01120 MOVE 'PU' TO MAP-COVERED-YRQ-YR (MAP-CNT) DTSCS48 01121 MOVE ' ' TO MAP-COVERED-YRQ-Q (MAP-CNT) DTSCS48 01122 ELSE DTSCS48 01123 MOVE MCMP-COVERED-YRQ(WRK-SUB) TO WRK-DISPLAY DTSCS48 01124 * IF MQTR-ANNUAL-YES-88 DTSCS48 01125 * MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YR DTSCS48 01126 * MOVE ZERO TO WRK-CURR-ANN-Q DTSCS48 01127 * MOVE WRK-CURR-ANN-YY TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS48 01128 * MOVE '*' TO MAP-COVERED-YRQ-Q(MAP-CNT) DTSCS48 01129 * ELSE DTSCS48 01130 MOVE WRK-DISPLAY-YRQ-YR TO MAP-COVERED-YRQ-YR(MAP-CNT) DTSCS48 01131 MOVE WRK-DISPLAY-YRQ-Q TO MAP-COVERED-YRQ-Q(MAP-CNT). DTSCS48 01132 DTSCS48 01133 P6911-EXIT. DTSCS48 01134 EXIT. DTSCS48 01135 DTSCS48 01136 P6990-PAGE-NUMBER. DTSCS48 01137 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS48 01138 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS48 01139 DTSCS48 01140 IF WS-REC-NUM = +1 DTSCS48 01141 IF LAST-REC-NUM = +1 DTSCS48 01142 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS48 01143 ELSE DTSCS48 01144 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS48 01145 ELSE DTSCS48 01146 IF WS-REC-NUM = LAST-REC-NUM DTSCS48 01147 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS48 01148 P6990-EXIT. DTSCS48 01149 EXIT. DTSCS48 01150 /**************************************************************** DTSCS48 01151 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. DTSCS48 01152 ***************************************************************** DTSCS48 01153 DTSCS48 01154 P7000-REQUEST-EDIT. DTSCS48 01155 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48 01156 DTSCS48 01157 IF LCCM-F09-88 DTSCS48 01158 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS48 01159 ELSE DTSCS48 01160 IF LCCM-F10-88 DTSCS48 01161 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS48 01162 * ELSE DTSCS48 01163 * IF LCCM-F23-88 DTSCS48 01164 * PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS48 01165 ELSE DTSCS48 01166 GO TO S899-ABEND. DTSCS48 01167 DTSCS48 01168 *------------------------------------------------------ DTSCS48 01169 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS48 01170 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS48 01171 * REMAIN IN 'INQUIRE' STATUS. DTSCS48 01172 *------------------------------------------------------ DTSCS48 01173 DTSCS48 01174 IF LCCM-MSG DTSCS48 01175 NEXT SENTENCE DTSCS48 01176 ELSE DTSCS48 01177 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS48 01178 IF LCCM-F09-88 DTSCS48 01179 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS48 01180 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS48 01181 ELSE DTSCS48 01182 IF LCCM-F10-88 DTSCS48 01183 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS48 01184 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCS48 01185 * ELSE DTSCS48 01186 * IF LCCM-F23-88 DTSCS48 01187 * SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS48 01188 * MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS48 01189 DTSCS48 01190 SET RESP-SEND-MAP TO TRUE. DTSCS48 01191 P7000-EXIT. DTSCS48 01192 EXIT. DTSCS48 01193 /**************************************************************** DTSCS48 01194 * ADD FUNCTION WAS REQUESTED DTSCS48 01195 ***************************************************************** DTSCS48 01196 DTSCS48 01197 P7100-EDIT-ADD. DTSCS48 01198 *----------------------------------------------------- DTSCS48 01199 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS48 01200 *----------------------------------------------------- DTSCS48 01201 IF NOT LCCM-SCR-CLEAR DTSCS48 01202 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS48 01203 GO TO P7100-EXIT. DTSCS48 01204 DTSCS48 01205 *----------------------------------------------------- DTSCS48 01206 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE ADD DTSCS48 01207 *----------------------------------------------------- DTSCS48 01208 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 01209 IF LCCM-MSG DTSCS48 01210 GO TO P7100-EXIT. DTSCS48 01211 DTSCS48 01212 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS48 01213 P7100-EXIT. DTSCS48 01214 EXIT. DTSCS48 01215 /**************************************************************** DTSCS48 01216 * MODIFICATION FUNCTION WAS REQUESTED DTSCS48 01217 ***************************************************************** DTSCS48 01218 DTSCS48 01219 P7200-EDIT-MOD. DTSCS48 01220 *----------------------------------------------------- DTSCS48 01221 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS48 01222 * INQUIRED DTSCS48 01223 *----------------------------------------------------- DTSCS48 01224 IF NOT LCCM-SCR-INQUIRE DTSCS48 01225 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS48 01226 GO TO P7200-EXIT. DTSCS48 01227 DTSCS48 01228 *----------------------------------------------------- DTSCS48 01229 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS48 01230 *----------------------------------------------------- DTSCS48 01231 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 01232 IF LCCM-MSG DTSCS48 01233 GO TO P7200-EXIT. DTSCS48 01234 DTSCS48 01235 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS48 01236 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS48 01237 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 01238 GO TO P7200-EXIT. DTSCS48 01239 DTSCS48 01240 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS48 01241 DTSCS48 01242 P7200-EXIT. DTSCS48 01243 EXIT. DTSCS48 01244 /**************************************************************** DTSCS48 01245 * DELETE FUNCTION WAS REQUESTED DTSCS48 01246 ***************************************************************** DTSCS48 01247 DTSCS48 01248 *P7300-EDIT-DEL. DTSCS48 01249 *----------------------------------------------------- DTSCS48 01250 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS48 01251 * INQUIRED DTSCS48 01252 *----------------------------------------------------- DTSCS48 01253 * IF NOT LCCM-SCR-INQUIRE DTSCS48 01254 * MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS48 01255 * GO TO P7300-EXIT. DTSCS48 01256 * DTSCS48 01257 *----------------------------------------------------- DTSCS48 01258 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE DELETE DTSCS48 01259 *----------------------------------------------------- DTSCS48 01260 * PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 01261 * IF LCCM-MSG DTSCS48 01262 * GO TO P7300-EXIT. DTSCS48 01263 * DTSCS48 01264 * IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS48 01265 * MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS48 01266 * PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS48 01267 * DTSCS48 01268 *P7300-EXIT. DTSCS48 01269 * EXIT. DTSCS48 01270 /**************************************************************** DTSCS48 01271 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED DTSCS48 01272 ***************************************************************** DTSCS48 01273 DTSCS48 01274 P8000-REQUEST-UPDATE. DTSCS48 01275 DTSCS48 01276 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48 01277 DTSCS48 01278 IF LCCM-SCR-ADD-LOCKED DTSCS48 01279 PERFORM P8100-ADD THRU P8100-EXIT DTSCS48 01280 ELSE DTSCS48 01281 IF LCCM-SCR-MOD-LOCKED DTSCS48 01282 PERFORM P8200-MOD THRU P8200-EXIT DTSCS48 01283 * ELSE DTSCS48 01284 * IF LCCM-SCR-DEL-LOCKED DTSCS48 01285 * PERFORM P8300-DEL THRU P8300-EXIT DTSCS48 01286 ELSE DTSCS48 01287 GO TO S899-ABEND. DTSCS48 01288 DTSCS48 01289 SET RESP-SEND-MAP TO TRUE. DTSCS48 01290 P8000-EXIT. DTSCS48 01291 EXIT. DTSCS48 01292 /**************************************************************** DTSCS48 01293 * DTSCS48 01294 ***************************************************************** DTSCS48 01295 DTSCS48 01296 P8100-ADD. DTSCS48 01297 SET LCCM-SCR-CLEAR TO TRUE. DTSCS48 01298 DTSCS48 01299 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48 01300 DTSCS48 01301 IF LCCM-F12-88 DTSCS48 01302 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS48 01303 GO TO P8100-EXIT. DTSCS48 01304 DTSCS48 01305 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 01306 DTSCS48 01307 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS48 01308 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS48 01309 IF LCCM-MSG DTSCS48 01310 GO TO P8100-EXIT. DTSCS48 01311 DTSCS48 01312 PERFORM P8110-CONSTRUCT-MCMP THRU P8110-EXIT. DTSCS48 01313 DTSCS48 01314 * IF MPRF-NO-MCMP-88 DTSCS48 01315 * PERFORM P8120-UPDATE-MPRF THRU P8120-EXIT. DTSCS48 01316 DTSCS48 01317 * IF MAP-STATUS-CD = 'P' DTSCS48 01318 * PERFORM P8130-CREATE-MTCK THRU P8130-EXIT. DTSCS48 01319 DTSCS48 01320 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS48 01321 DTSCS48 01322 MOVE 'DTSCS48' TO LCCM-SCR-HOLD-PROG-NAME. DTSCS48 01323 MOVE MCMP-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS48 01324 DTSCS48 01325 SET LCCM-ENTER-88 TO TRUE. DTSCS48 01326 DTSCS48 01327 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS48 01328 DTSCS48 01329 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS48 01330 DTSCS48 01331 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48 01332 P8100-EXIT. DTSCS48 01333 EXIT. DTSCS48 01334 DTSCS48 01335 P8110-CONSTRUCT-MCMP. DTSCS48 01336 MOVE LOW-VALUES TO MCMP-REC. DTSCS48 01337 DTSCS48 01338 MOVE WRK-EMP-NO TO MCMP-EMP-NO. DTSCS48 01339 SET MCMP-CMP-88 TO TRUE. DTSCS48 01340 MOVE LCCM-TASK-START-ABSTIME TO MCMP-ESTB-ABSTIME. DTSCS48 01341 DTSCS48 01342 MOVE ZERO TO MCMP-PURGE-DATE. DTSCS48 01343 DTSCS48 01344 SET MCMP-NOT-CONVERTED-88 TO TRUE. DTSCS48 01345 MOVE LCCM-CURR-RUN-DATE TO MCMP-ESTB-DATE. DTSCS48 01346 MOVE LCCM-CURR-RUN-DATE TO MCMP-CHNG-DATE. DTSCS48 01347 DTSCS48 01348 SET MCMP-STATUS-PENDING-88 TO TRUE. DTSCS48 01349 DTSCS48 01350 MOVE MAP-MAILING-LINE-1 TO MCMP-MAILING-LINE-1. DTSCS48 01351 MOVE MAP-MAILING-LINE-2 TO MCMP-MAILING-LINE-2. DTSCS48 01352 MOVE MAP-MAILING-LINE-3 TO MCMP-MAILING-LINE-3. DTSCS48 01353 MOVE MAP-MAILING-LINE-4 TO MCMP-MAILING-LINE-4. DTSCS48 01354 MOVE MAP-MAILING-LINE-5 TO MCMP-MAILING-LINE-5. DTSCS48 01355 DTSCS48 01356 MOVE MAP-SETTLEMENT-DATE-AREA TO L015-S-DATE-AREA. DTSCS48 01357 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48 01358 MOVE L015-DATE TO MCMP-SETTLEMENT-DATE. DTSCS48 01359 DTSCS48 01360 MOVE MAP-INT-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS48 01361 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48 01362 MOVE L015-DATE TO MCMP-INT-COMP-DATE. DTSCS48 01363 DTSCS48 01364 MOVE MAP-AUTHORIZE-OP-ID TO MCMP-AUTHORIZE-OP-ID. DTSCS48 01365 DTSCS48 01366 MOVE +0.00 TO L011-MIN-AMT. DTSCS48 01367 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48 01368 MOVE MAP-TAX-WAIVED-AMT-AREA TO L011-S-AMT-AREA. DTSCS48 01369 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48 01370 MOVE L011-AMT TO MCMP-TAX-WAIVED-AMT. DTSCS48 01371 DTSCS48 01372 MOVE +0.00 TO L011-MIN-AMT. DTSCS48 01373 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48 01374 MOVE MAP-PEN-WAIVED-AMT-AREA TO L011-S-AMT-AREA. DTSCS48 01375 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48 01376 MOVE L011-AMT TO MCMP-PEN-WAIVED-AMT. DTSCS48 01377 DTSCS48 01378 MOVE +0.00 TO L011-MIN-AMT. DTSCS48 01379 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48 01380 MOVE MAP-INT-WAIVED-AMT-AREA TO L011-S-AMT-AREA. DTSCS48 01381 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48 01382 MOVE L011-AMT TO MCMP-INT-WAIVED-AMT. DTSCS48 01383 DTSCS48 01384 MOVE +0.00 TO L011-MIN-AMT. DTSCS48 01385 MOVE +9999999.99 TO L011-MAX-AMT. DTSCS48 01386 MOVE MAP-TOT-BALANCE-AMT-AREA TO L011-S-AMT-AREA. DTSCS48 01387 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS48 01388 MOVE L011-AMT TO MCMP-TOT-BALANCE-AMT. DTSCS48 01389 DTSCS48 01390 MOVE +0 TO MCMP-COV-CNT. DTSCS48 01391 DTSCS48 01392 PERFORM P8111-COVERED-YRQ-LOOP THRU P8111-EXIT DTSCS48 01393 VARYING WRK-SUB FROM 1 BY 1 DTSCS48 01394 UNTIL WRK-SUB > MMAX-CMP-COV-MAX. DTSCS48 01395 DTSCS48 01396 MOVE MCMP-REC TO MSKL-REC. DTSCS48 01397 PERFORM S810-WRITE THRU S810-EXIT. DTSCS48 01398 DTSCS48 01399 PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS48 01400 DTSCS48 01401 PERFORM P8112-ADD-T011 THRU P8112-EXIT. DTSCS48 01402 DTSCS48 01403 P8110-EXIT. EXIT. DTSCS48 01404 DTSCS48 01405 P8111-COVERED-YRQ-LOOP. DTSCS48 01406 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS48 01407 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS48 01408 DTSCS48 01409 IF L029-VALID DTSCS48 01410 ADD +1 TO MCMP-COV-CNT DTSCS48 01411 MOVE L029-YRQ TO MCMP-COVERED-YRQ (MCMP-COV-CNT). DTSCS48 01412 P8111-EXIT. DTSCS48 01413 EXIT. DTSCS48 01414 SKIP3 DTSCS48 01415 P8112-ADD-T011. DTSCS48 01416 MOVE MCMP-EMP-NO TO T011-EMP-NO. DTSCS48 01417 MOVE LCCM-OP-ID TO T011-OP-ID. DTSCS48 01418 MOVE WRK-SCR-ID TO T011-SCR-ID. DTSCS48 01419 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE. DTSCS48 01420 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME. DTSCS48 01421 MOVE LOW-VALUES TO T011-DATA-AREA. DTSCS48 01422 MOVE ZEROS TO T011-START-YRQ DTSCS48 01423 T011-END-YRQ DTSCS48 01424 T011-BATCH-NO DTSCS48 01425 T011-ITEM-NO. DTSCS48 01426 SET T011-CMP-PKG TO TRUE. DTSCS48 01427 MOVE LCCM-OP-ID TO T011-RESP-OP-ID. DTSCS48 01428 MOVE MCMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME. DTSCS48 01429 MOVE LENGTH OF T011-REC TO T011-LENGTH. DTSCS48 01430 MOVE T011-REC TO RSKL-REC. DTSCS48 01431 PERFORM S825-WRITE THRU S825-EXIT. DTSCS48 01432 P8112-EXIT. DTSCS48 01433 EXIT. DTSCS48 01434 SKIP3 DTSCS48 01435 *P8120-UPDATE-MPRF. DTSCS48 01436 * PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS48 01437 * DTSCS48 01438 * SET MPRF-MCMP-EXISTS-88 TO TRUE. DTSCS48 01439 * MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS48 01440 * MOVE MPRF-REC TO MSKL-REC. DTSCS48 01441 * PERFORM S810-REWRITE THRU S810-EXIT. DTSCS48 01442 *P8120-EXIT. DTSCS48 01443 * EXIT. DTSCS48 01444 DTSCS48 01445 *P8130-CREATE-MTCK. DTSCS48 01446 * MOVE LOW-VALUE TO MTCK-REC. DTSCS48 01447 * MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSCS48 01448 * SET MTCK-TCK-88 TO TRUE. DTSCS48 01449 * MOVE LCCM-SCR-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS48 01450 * DTSCS48 01451 * MOVE +0 TO MTCK-PURGE-DATE. DTSCS48 01452 * DTSCS48 01453 * INITIALIZE MTCK-DATA-AREA. DTSCS48 01454 * SET MTCK-TYPE-CMP-PEND-88 TO TRUE. DTSCS48 01455 * DTSCS48 01456 * MOVE LCCM-NEXT-RUN-DATE TO MTCK-TRIGGER-DATE. DTSCS48 01457 * DTSCS48 01458 * SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSCS48 01459 * SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSCS48 01460 * MOVE MCMP-ESTB-ABSTIME TO MTCK-CMP-ESTB-ABSTIME. DTSCS48 01461 * SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSCS48 01462 * MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSCS48 01463 * MTCK-CHNG-DATE. DTSCS48 01464 * MOVE +0 TO MTCK-TEXT-CNT. DTSCS48 01465 * DTSCS48 01466 * MOVE MTCK-REC TO MSKL-REC. DTSCS48 01467 * PERFORM S810-WRITE THRU S810-EXIT. DTSCS48 01468 *P8130-EXIT. DTSCS48 01469 * EXIT. DTSCS48 01470 /**************************************************************** DTSCS48 01471 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS DTSCS48 01472 ***************************************************************** DTSCS48 01473 DTSCS48 01474 P8200-MOD. DTSCS48 01475 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS48 01476 DTSCS48 01477 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48 01478 DTSCS48 01479 IF LCCM-F12-88 DTSCS48 01480 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS48 01481 GO TO P8200-EXIT. DTSCS48 01482 DTSCS48 01483 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 01484 DTSCS48 01485 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS48 01486 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS48 01487 IF LCCM-MSG DTSCS48 01488 GO TO P8200-EXIT. DTSCS48 01489 DTSCS48 01490 PERFORM P8210-CONSTRUCT-MCMP THRU P8210-EXIT. DTSCS48 01491 DTSCS48 01492 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS48 01493 DTSCS48 01494 MOVE 'DTSCS48' TO LCCM-SCR-HOLD-PROG-NAME. DTSCS48 01495 MOVE MCMP-KEY-AREA TO LCCM-SCR-HOLD-KEY. DTSCS48 01496 DTSCS48 01497 SET LCCM-ENTER-88 TO TRUE. DTSCS48 01498 DTSCS48 01499 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS48 01500 DTSCS48 01501 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS48 01502 DTSCS48 01503 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48 01504 P8200-EXIT. DTSCS48 01505 EXIT. DTSCS48 01506 EJECT DTSCS48 01507 P8210-CONSTRUCT-MCMP. DTSCS48 01508 IF LCCM-SCR-HOLD-PROG-NAME = 'DTSCS48' DTSCS48 01509 MOVE LCCM-SCR-HOLD-KEY TO MSKL-KEY-AREA DTSCS48 01510 PERFORM S810-READ THRU S810-EXIT DTSCS48 01511 IF L810-NO-REC-88 DTSCS48 01512 PERFORM S899-ABEND THRU S899-EXIT DTSCS48 01513 ELSE DTSCS48 01514 MOVE MSKL-REC TO MCMP-REC DTSCS48 01515 END-IF DTSCS48 01516 ELSE DTSCS48 01517 PERFORM S899-ABEND THRU S899-EXIT DTSCS48 01518 END-IF. DTSCS48 01519 DTSCS48 01520 MOVE MCMP-STATUS-CD TO WRK-STATUS-CD. DTSCS48 01521 DTSCS48 01522 MOVE MAP-STATUS-CD TO MCMP-STATUS-CD. DTSCS48 01523 DTSCS48 01524 IF (WRK-STATUS-CD = 'F' OR 'P') DTSCS48 01525 AND DTSCS48 01526 (MCMP-STATUS-WITHDRAWN-88) DTSCS48 01527 PERFORM P8212-ADD-T011 THRU P8212-EXIT DTSCS48 01528 PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS48 01529 DTSCS48 01530 MOVE MCMP-REC TO MSKL-REC. DTSCS48 01531 DTSCS48 01532 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS48 01533 P8210-EXIT. EXIT. DTSCS48 01534 DTSCS48 01535 P8212-ADD-T011. DTSCS48 01536 MOVE MCMP-EMP-NO TO T011-EMP-NO. DTSCS48 01537 MOVE LCCM-OP-ID TO T011-OP-ID. DTSCS48 01538 MOVE WRK-SCR-ID TO T011-SCR-ID. DTSCS48 01539 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE. DTSCS48 01540 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME. DTSCS48 01541 MOVE LOW-VALUES TO T011-DATA-AREA. DTSCS48 01542 SET T011-CMP-WD TO TRUE. DTSCS48 01543 MOVE LCCM-OP-ID TO T011-RESP-OP-ID. DTSCS48 01544 MOVE MCMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME. DTSCS48 01545 MOVE LENGTH OF T011-REC TO T011-LENGTH. DTSCS48 01546 MOVE T011-REC TO RSKL-REC. DTSCS48 01547 PERFORM S825-WRITE THRU S825-EXIT. DTSCS48 01548 P8212-EXIT. EXIT. DTSCS48 01549 DTSCS48 01550 /**************************************************************** DTSCS48 01551 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS DTSCS48 01552 ***************************************************************** DTSCS48 01553 DTSCS48 01554 *P8300-DEL. DTSCS48 01555 * SET LCCM-SCR-INQUIRE TO TRUE. DTSCS48 01556 * DTSCS48 01557 * IF LCCM-F12-88 DTSCS48 01558 * MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS48 01559 * GO TO P8300-EXIT. DTSCS48 01560 * DTSCS48 01561 * PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS48 01562 * DTSCS48 01563 * MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS48 01564 * PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS48 01565 * IF LCCM-MSG DTSCS48 01566 * GO TO P8300-EXIT. DTSCS48 01567 * DTSCS48 01568 * MOVE LCCM-SCR48-HOLD-AREA TO MSKL-KEY-AREA. DTSCS48 01569 * PERFORM S810-READ THRU S810-EXIT. DTSCS48 01570 * IF L810-NO-REC-88 DTSCS48 01571 * GO TO S899-ABEND. DTSCS48 01572 * DTSCS48 01573 * PERFORM S810-DELETE THRU S810-EXIT. DTSCS48 01574 * DTSCS48 01575 * MOVE LOW-VALUE TO MCMP-STATUS-CD. DTSCS48 01576 * PERFORM P8820-CREATE-MEVL THRU P8820-EXIT. DTSCS48 01577 * DTSCS48 01578 * MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS48 01579 * MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48 01580 * SET MSKL-CMP-88 TO TRUE. DTSCS48 01581 * PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48 01582 * IF L810-NO-REC-88 DTSCS48 01583 * PERFORM S1110-READ-MPRF THRU S1110-EXIT DTSCS48 01584 * SET MPRF-NO-MCMP-88 TO TRUE DTSCS48 01585 * MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS48 01586 * MOVE MPRF-REC TO MSKL-REC DTSCS48 01587 * PERFORM S810-REWRITE THRU S810-EXIT DTSCS48 01588 * ELSE DTSCS48 01589 * PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS48 01590 * DTSCS48 01591 * PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS48 01592 * DTSCS48 01593 * SET LCCM-SCR-CLEAR TO TRUE. DTSCS48 01594 * MOVE LOW-VALUE TO MAP-AREA. DTSCS48 01595 * PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS48 01596 * DTSCS48 01597 * MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS48 01598 * MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS48 01599 * MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS48 01600 * DTSCS48 01601 * MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS48 01602 * DTSCS48 01603 * MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS48 01604 *P8300-EXIT. DTSCS48 01605 * EXIT. DTSCS48 01606 EJECT DTSCS48 01607 P8810-LOCK-EMPLOYER. DTSCS48 01608 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS48 01609 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS48 01610 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS48 01611 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS48 01612 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS48 01613 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS48 01614 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS48 01615 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS48 01616 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS48 01617 DTSCS48 01618 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS48 01619 P8810-EXIT. DTSCS48 01620 EXIT. DTSCS48 01621 DTSCS48 01622 DTSCS48 01623 P8820-CREATE-MEVL. DTSCS48 01624 MOVE LOW-VALUES TO MEVL-REC. DTSCS48 01625 DTSCS48 01626 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS48 01627 SET MEVL-EVL-88 TO TRUE. DTSCS48 01628 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS48 01629 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS48 01630 DTSCS48 01631 IF MCMP-STATUS-PENDING-88 DTSCS48 01632 MOVE 'PENDING.' TO EVL-STATUS-CD-DSCR DTSCS48 01633 ELSE DTSCS48 01634 IF MCMP-STATUS-WITHDRAWN-88 DTSCS48 01635 MOVE 'WITHDRAWN.' TO EVL-STATUS-CD-DSCR DTSCS48 01636 ELSE DTSCS48 01637 IF MCMP-STATUS-FINAL-88 DTSCS48 01638 MOVE 'FINAL.' TO EVL-STATUS-CD-DSCR DTSCS48 01639 ELSE DTSCS48 01640 GO TO P8820-EXIT. DTSCS48 01641 DTSCS48 01642 MOVE EVL-TEXT TO MEVL-TEXT. DTSCS48 01643 DTSCS48 01644 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS48 01645 DTSCS48 01646 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS48 01647 DTSCS48 01648 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS48 01649 MEVL-CHNG-DATE. DTSCS48 01650 DTSCS48 01651 MOVE MEVL-REC TO MSKL-REC. DTSCS48 01652 PERFORM S810-WRITE THRU S810-EXIT. DTSCS48 01653 P8820-EXIT. DTSCS48 01654 EXIT. DTSCS48 01655 /**************************************************************** DTSCS48 01656 * LINKS TO UTILITY MODULES DTSCS48 01657 ***************************************************************** DTSCS48 01658 DTSCS48 01659 S001-FROM-FED-8. DTSCS48 01660 SET L001-FROM-FED-8 TO TRUE. DTSCS48 01661 GO TO S001-DATE. DTSCS48 01662 DTSCS48 01663 S001-FROM-ABS-DATE. DTSCS48 01664 SET L001-FROM-ABS-DAY TO TRUE. DTSCS48 01665 GO TO S001-DATE. DTSCS48 01666 DTSCS48 01667 S001-DATE. DTSCS48 01668 EXEC CICS LINK DTSCS48 01669 PROGRAM('DTSCU001') DTSCS48 01670 COMMAREA(L001-COMM-AREA) DTSCS48 01671 END-EXEC. DTSCS48 01672 S001-EXIT. DTSCS48 01673 EXIT. DTSCS48 01674 DTSCS48 01675 S011-AMT-FROM-SCREEN. DTSCS48 01676 EXEC CICS LINK DTSCS48 01677 PROGRAM ('DTSCU011') DTSCS48 01678 COMMAREA (L011-COMM-AREA) DTSCS48 01679 END-EXEC. DTSCS48 01680 S011-EXIT. DTSCS48 01681 EXIT. DTSCS48 01682 DTSCS48 01683 S015-DATE-FROM-SCREEN. DTSCS48 01684 EXEC CICS LINK DTSCS48 01685 PROGRAM ('DTSCU015') DTSCS48 01686 COMMAREA (L015-COMM-AREA) DTSCS48 01687 END-EXEC. DTSCS48 01688 S015-EXIT. DTSCS48 01689 EXIT. DTSCS48 01690 DTSCS48 01691 S013-COUNT-FROM-SCREEN. DTSCS48 01692 EXEC CICS LINK DTSCS48 01693 PROGRAM('DTSCU013') DTSCS48 01694 COMMAREA(L013-COMM-AREA) DTSCS48 01695 END-EXEC. DTSCS48 01696 S013-EXIT. DTSCS48 01697 EXIT. DTSCS48 01698 DTSCS48 01699 S018-EMP-NO-FROM-SCREEN. DTSCS48 01700 EXEC CICS LINK DTSCS48 01701 PROGRAM('DTSCU018') DTSCS48 01702 COMMAREA(L018-COMM-AREA) DTSCS48 01703 END-EXEC. DTSCS48 01704 S018-EXIT. DTSCS48 01705 EXIT. DTSCS48 01706 DTSCS48 01707 DTSCS48 01708 S029-YRQ-FROM-SCREEN. DTSCS48 01709 EXEC CICS LINK DTSCS48 01710 PROGRAM('DTSCU029') DTSCS48 01711 COMMAREA(L029-COMM-AREA) DTSCS48 01712 END-EXEC. DTSCS48 01713 S029-EXIT. DTSCS48 01714 EXIT. DTSCS48 01715 DTSCS48 01716 DTSCS48 01717 S034-MCMP-STATUS-CD. DTSCS48 01718 SET L034-MCMP-STATUS-CD TO TRUE. DTSCS48 01719 GO TO S034-LINK. DTSCS48 01720 DTSCS48 01721 S034-LINK. DTSCS48 01722 EXEC CICS LINK DTSCS48 01723 PROGRAM ('DTSCU034') DTSCS48 01724 COMMAREA (L034-COMM-AREA) DTSCS48 01725 END-EXEC. DTSCS48 01726 S034-EXIT. DTSCS48 01727 EXIT. DTSCS48 01728 DTSCS48 01729 S071-CONVERT-NAME. DTSCS48 01730 SET L071-FROM-LAST-NAME-FIRST TO TRUE. DTSCS48 01731 EXEC CICS LINK DTSCS48 01732 PROGRAM ('DTSCU071') DTSCS48 01733 COMMAREA (L071-COMM-AREA) DTSCS48 01734 END-EXEC. DTSCS48 01735 S071-EXIT. DTSCS48 01736 EXIT. DTSCS48 01737 DTSCS48 01738 S082-OP-ID-EDIT. DTSCS48 01739 EXEC CICS LINK DTSCS48 01740 PROGRAM('DTSCU082') DTSCS48 01741 COMMAREA(L082-COMM-AREA) DTSCS48 01742 END-EXEC. DTSCS48 01743 DTSCS48 01744 IF L082-FILE-CLOSED DTSCS48 01745 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS48 01746 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48 01747 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48 01748 GO TO MAINLINE-EXIT. DTSCS48 01749 S082-EXIT. DTSCS48 01750 EXIT. DTSCS48 01751 DTSCS48 01752 S101-PER-MONTH-YES. DTSCS48 01753 SET L101-PER-MONTH-YES-88 TO TRUE. DTSCS48 01754 GO TO S101-INT-COMP. DTSCS48 01755 DTSCS48 01756 S101-INT-COMP. DTSCS48 01757 EXEC CICS LINK DTSCS48 01758 PROGRAM ('DTSCU101') DTSCS48 01759 COMMAREA (L101-COMM-AREA) DTSCS48 01760 END-EXEC. DTSCS48 01761 S101-EXIT. DTSCS48 01762 EXIT. DTSCS48 01763 S109-SUR-TAX-QTR. DTSCS48 01764 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS48 01765 EXEC CICS LINK DTSCS48 01766 PROGRAM ('DTSCU109') DTSCS48 01767 COMMAREA (L109-COMM-AREA) DTSCS48 01768 END-EXEC. DTSCS48 01769 S109-EXIT. DTSCS48 01770 EXIT. DTSCS48 01771 DTSCS48 01772 S111-ADDR-LOOKUP. DTSCS48 01773 EXEC CICS LINK DTSCS48 01774 PROGRAM('DTSCU111') DTSCS48 01775 COMMAREA(L111-COMM-AREA) DTSCS48 01776 END-EXEC. DTSCS48 01777 DTSCS48 01778 IF L111-FILE-CLOSED-88 DTSCS48 01779 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS48 01780 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48 01781 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48 01782 GO TO MAINLINE-EXIT. DTSCS48 01783 S111-EXIT. DTSCS48 01784 EXIT. DTSCS48 01785 DTSCS48 01786 S112-ADDR-FORMAT. DTSCS48 01787 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS48 01788 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS48 01789 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS48 01790 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS48 01791 DTSCS48 01792 EXEC CICS LINK DTSCS48 01793 PROGRAM('DTSCU112') DTSCS48 01794 COMMAREA(L112-COMM-AREA) DTSCS48 01795 END-EXEC. DTSCS48 01796 S112-EXIT. DTSCS48 01797 EXIT. DTSCS48 01798 DTSCS48 01799 S221-EMP-LOCK. DTSCS48 01800 SET L221-START-UPDATE TO TRUE. DTSCS48 01801 GO TO S221-EMP-LOCK-UNLOCK. DTSCS48 01802 DTSCS48 01803 S221-EMP-UNLOCK. DTSCS48 01804 SET L221-END-UPDATE TO TRUE. DTSCS48 01805 GO TO S221-EMP-LOCK-UNLOCK. DTSCS48 01806 DTSCS48 01807 S221-EMP-LOCK-UNLOCK. DTSCS48 01808 EXEC CICS LINK DTSCS48 01809 PROGRAM('DTSCU221') DTSCS48 01810 COMMAREA(L221-COMM-AREA) DTSCS48 01811 END-EXEC. DTSCS48 01812 DTSCS48 01813 IF L221-FILE-CLOSED DTSCS48 01814 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS48 01815 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48 01816 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48 01817 GO TO MAINLINE-EXIT. DTSCS48 01818 DTSCS48 01819 IF L221-NOT-OK DTSCS48 01820 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS48 01821 S221-EXIT. DTSCS48 01822 EXIT. DTSCS48 01823 DTSCS48 01824 DTSCS48 01825 S803-REQ-SCR-ID-EDIT. DTSCS48 01826 EXEC CICS LINK DTSCS48 01827 PROGRAM ('DTSCU803') DTSCS48 01828 COMMAREA (DFHCOMMAREA) DTSCS48 01829 END-EXEC. DTSCS48 01830 S803-EXIT. DTSCS48 01831 EXIT. DTSCS48 01832 DTSCS48 01833 S804-INVALID-KEY. DTSCS48 01834 EXEC CICS LINK DTSCS48 01835 PROGRAM ('DTSCU804') DTSCS48 01836 COMMAREA (DFHCOMMAREA) DTSCS48 01837 END-EXEC. DTSCS48 01838 S804-EXIT. DTSCS48 01839 EXIT. DTSCS48 01840 DTSCS48 01841 S805-MSG-AREA. DTSCS48 01842 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS48 01843 DTSCS48 01844 EXEC CICS LINK DTSCS48 01845 PROGRAM ('DTSCU805') DTSCS48 01846 COMMAREA (L805-COMM-AREA) DTSCS48 01847 END-EXEC. DTSCS48 01848 DTSCS48 01849 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS48 01850 S805-EXIT. DTSCS48 01851 EXIT. DTSCS48 01852 EJECT DTSCS48 01853 S810-READ. DTSCS48 01854 SET L810-READ-88 TO TRUE. DTSCS48 01855 GO TO S810-IO. DTSCS48 01856 DTSCS48 01857 S810-START-BROWSE. DTSCS48 01858 SET L810-START-BROWSE-88 TO TRUE. DTSCS48 01859 GO TO S810-IO. DTSCS48 01860 DTSCS48 01861 S810-READ-NEXT. DTSCS48 01862 SET L810-READ-NEXT-88 TO TRUE. DTSCS48 01863 GO TO S810-IO. DTSCS48 01864 DTSCS48 01865 S810-READ-PREV. DTSCS48 01866 SET L810-READ-PREV-88 TO TRUE. DTSCS48 01867 GO TO S810-IO. DTSCS48 01868 DTSCS48 01869 S810-END-BROWSE. DTSCS48 01870 SET L810-END-BROWSE-88 TO TRUE. DTSCS48 01871 GO TO S810-IO. DTSCS48 01872 DTSCS48 01873 S810-COUNT. DTSCS48 01874 SET L810-COUNT-88 TO TRUE. DTSCS48 01875 GO TO S810-IO. DTSCS48 01876 DTSCS48 01877 S810-REWRITE. DTSCS48 01878 SET L810-REWRITE-88 TO TRUE. DTSCS48 01879 GO TO S810-IO. DTSCS48 01880 DTSCS48 01881 S810-WRITE. DTSCS48 01882 SET L810-WRITE-88 TO TRUE. DTSCS48 01883 GO TO S810-IO. DTSCS48 01884 DTSCS48 01885 S810-DELETE. DTSCS48 01886 SET L810-DELETE-88 TO TRUE. DTSCS48 01887 GO TO S810-IO. DTSCS48 01888 DTSCS48 01889 S810-IO. DTSCS48 01890 DTSCS48 01891 EXEC CICS LINK DTSCS48 01892 PROGRAM ('DTSCU810') DTSCS48 01893 COMMAREA (L810-COMM-AREA) DTSCS48 01894 END-EXEC. DTSCS48 01895 DTSCS48 01896 IF L810-FILE-CLOSED-88 DTSCS48 01897 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS48 01898 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48 01899 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48 01900 GO TO MAINLINE-EXIT. DTSCS48 01901 S810-EXIT. DTSCS48 01902 EXIT. DTSCS48 01903 SKIP3 DTSCS48 01904 S825-WRITE. DTSCS48 01905 SET L825-WRITE-88 TO TRUE. DTSCS48 01906 GO TO S825-O. DTSCS48 01907 DTSCS48 01908 S825-O. DTSCS48 01909 EXEC CICS DTSCS48 01910 LINK DTSCS48 01911 PROGRAM ('DTSCU825') DTSCS48 01912 COMMAREA (L825-COMM-AREA) DTSCS48 01913 END-EXEC. DTSCS48 01914 DTSCS48 01915 IF L825-FILE-CLOSED-88 DTSCS48 01916 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS48 01917 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS48 01918 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS48 01919 GO TO MAINLINE-EXIT. DTSCS48 01920 S825-EXIT. DTSCS48 01921 EXIT. DTSCS48 01922 SKIP3 DTSCS48 01923 S851-SCREEN-PROCESSING. DTSCS48 01924 EXEC CICS LINK DTSCS48 01925 PROGRAM ('DTSCU851') DTSCS48 01926 COMMAREA (L851-COMM-AREA) DTSCS48 01927 END-EXEC. DTSCS48 01928 S851-EXIT. DTSCS48 01929 EXIT. DTSCS48 01930 DTSCS48 01931 S899-ABEND. DTSCS48 01932 EXEC CICS ABEND DTSCS48 01933 ABCODE(WRK-ABEND-CD) DTSCS48 01934 END-EXEC. DTSCS48 01935 S899-EXIT. DTSCS48 01936 EXIT. DTSCS48 01937 /**************************************************************** DTSCS48 01938 * EDIT THE INFORMATION ON THE SCREEN. DTSCS48 01939 ***************************************************************** DTSCS48 01940 DTSCS48 01941 S1000-SCREEN-EDITS. DTSCS48 01942 DTSCS48 01943 IF LCCM-F09-88 DTSCS48 01944 PERFORM S1130-CHK-MCMP THRU S1130-EXIT DTSCS48 01945 IF LCCM-MSG DTSCS48 01946 GO TO S1000-EXIT DTSCS48 01947 ELSE DTSCS48 01948 PERFORM S1200-STATUS-CD THRU S1200-EXIT DTSCS48 01949 PERFORM S1300-SETTLEMENT-DATE THRU S1300-EXIT DTSCS48 01950 PERFORM S1400-MAIL-ADDRESS THRU S1400-EXIT DTSCS48 01951 PERFORM S1500-COMP-DATE THRU S1500-EXIT DTSCS48 01952 PERFORM S2400-AUTHORIZE-OP-ID THRU S2400-EXIT DTSCS48 01953 PERFORM S2900-COVERED-YRQ THRU S2900-EXIT DTSCS48 01954 END-IF DTSCS48 01955 ELSE DTSCS48 01956 PERFORM S1120-READ-MCMP THRU S1120-EXIT DTSCS48 01957 IF WRK-MCMP-YES-88 DTSCS48 01958 PERFORM S1200-STATUS-CD THRU S1200-EXIT DTSCS48 01959 PERFORM S2400-AUTHORIZE-OP-ID DTSCS48 01960 THRU S2400-EXIT DTSCS48 01961 PERFORM S2500-INT-COMP-DATE THRU S2500-EXIT DTSCS48 01962 END-IF DTSCS48 01963 END-IF. DTSCS48 01964 DTSCS48 01965 IF LCCM-MSG DTSCS48 01966 GO TO S1000-EXIT. DTSCS48 01967 DTSCS48 01968 S1000-EXIT. EXIT. DTSCS48 01969 EJECT DTSCS48 01970 DTSCS48 01971 S1100-EDIT-KEY. DTSCS48 01972 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS48 01973 S1100-EXIT. EXIT. DTSCS48 01974 /**************************************************************** DTSCS48 01975 * DTSCS48 01976 ***************************************************************** DTSCS48 01977 S1101-EMP-NO. DTSCS48 01978 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS48 01979 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS48 01980 DTSCS48 01981 IF L018-NO-ENTRY DTSCS48 01982 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48 01983 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 01984 GO TO S1101-EXIT. DTSCS48 01985 DTSCS48 01986 IF L018-NOT-VALID DTSCS48 01987 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 01988 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 01989 GO TO S1101-EXIT. DTSCS48 01990 DTSCS48 01991 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS48 01992 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS48 01993 S1101-EXIT. EXIT. DTSCS48 01994 DTSCS48 01995 S1110-READ-MPRF. DTSCS48 01996 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS48 01997 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS48 01998 SET MPRF-PRF-88 TO TRUE. DTSCS48 01999 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS48 02000 PERFORM S810-READ THRU S810-EXIT. DTSCS48 02001 IF L810-NO-REC-88 DTSCS48 02002 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS48 02003 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 02004 ELSE DTSCS48 02005 MOVE MSKL-REC TO MPRF-REC DTSCS48 02006 SET WRK-MPRF-YES-88 TO TRUE. DTSCS48 02007 S1110-EXIT. DTSCS48 02008 EXIT. DTSCS48 02009 DTSCS48 02010 S1120-READ-MCMP. DTSCS48 02011 MOVE LCCM-SCR-HOLD-KEY TO MSKL-KEY-AREA. DTSCS48 02012 DTSCS48 02013 PERFORM S810-READ THRU S810-EXIT. DTSCS48 02014 DTSCS48 02015 IF L810-NO-REC-88 DTSCS48 02016 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 02017 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 02018 ELSE DTSCS48 02019 MOVE MSKL-REC TO MCMP-REC DTSCS48 02020 SET WRK-MCMP-YES-88 TO TRUE. DTSCS48 02021 S1120-EXIT. DTSCS48 02022 EXIT. DTSCS48 02023 DTSCS48 02024 S1130-CHK-MCMP. DTSCS48 02025 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS48 02026 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS48 02027 SET MSKL-CMP-88 TO TRUE. DTSCS48 02028 DTSCS48 02029 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS48 02030 DTSCS48 02031 IF L810-NO-REC-88 DTSCS48 02032 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48 02033 ELSE DTSCS48 02034 PERFORM DTSCS48 02035 UNTIL L810-NO-REC-88 DTSCS48 02036 OR WRK-MCMP-YES-88 DTSCS48 02037 MOVE MSKL-REC TO MCMP-REC DTSCS48 02038 IF MCMP-STATUS-PENDING-88 DTSCS48 02039 SET WRK-MCMP-YES-88 TO TRUE DTSCS48 02040 ELSE DTSCS48 02041 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS48 02042 END-IF DTSCS48 02043 END-PERFORM DTSCS48 02044 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS48 02045 IF WRK-MCMP-YES-88 DTSCS48 02046 MOVE MSG-E487-AREA TO WRK-MSG-AREA DTSCS48 02047 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS48 02048 END-IF DTSCS48 02049 END-IF. DTSCS48 02050 DTSCS48 02051 S1130-EXIT. DTSCS48 02052 EXIT. DTSCS48 02053 DTSCS48 02054 S1199-ERROR. DTSCS48 02055 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS48 02056 MAP-EMP-NO-2-A. DTSCS48 02057 IF LCCM-NO-MSG DTSCS48 02058 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02059 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS48 02060 SET CURSOR-SET-YES TO TRUE. DTSCS48 02061 S1199-EXIT. EXIT. DTSCS48 02062 DTSCS48 02063 /**************************************************************** DTSCS48 02064 * DTSCS48 02065 ***************************************************************** DTSCS48 02066 S1200-STATUS-CD. DTSCS48 02067 IF LCCM-F09-88 DTSCS48 02068 SET MCMP-STATUS-PENDING-88 TO TRUE DTSCS48 02069 MOVE MCMP-STATUS-CD TO MAP-STATUS-CD DTSCS48 02070 GO TO S1200-EXIT DTSCS48 02071 ELSE DTSCS48 02072 MOVE MAP-STATUS-CD TO L034-CD DTSCS48 02073 PERFORM S034-MCMP-STATUS-CD THRU S034-EXIT DTSCS48 02074 IF NOT L034-VALID DTSCS48 02075 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02076 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS48 02077 GO TO S1200-EXIT DTSCS48 02078 ELSE DTSCS48 02079 PERFORM S1220-MOD THRU S1220-EXIT DTSCS48 02080 END-IF DTSCS48 02081 END-IF. DTSCS48 02082 DTSCS48 02083 S1200-EXIT. EXIT. DTSCS48 02084 DTSCS48 02085 S1201-ERROR. DTSCS48 02086 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATUS-CD-A. DTSCS48 02087 IF LCCM-NO-MSG DTSCS48 02088 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02089 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS48 02090 SET CURSOR-SET-YES TO TRUE. DTSCS48 02091 S1201-EXIT. EXIT. DTSCS48 02092 DTSCS48 02093 DTSCS48 02094 S1220-MOD. DTSCS48 02095 IF MAP-STATUS-CD = MCMP-STATUS-CD DTSCS48 02096 GO TO S1220-EXIT. DTSCS48 02097 DTSCS48 02098 IF MCMP-STATUS-CD = 'P' OR 'F' DTSCS48 02099 IF MAP-STATUS-CD = 'W' DTSCS48 02100 GO TO S1220-EXIT DTSCS48 02101 ELSE DTSCS48 02102 MOVE MSG-E483-AREA TO WRK-MSG-AREA DTSCS48 02103 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS48 02104 GO TO S1220-EXIT DTSCS48 02105 END-IF DTSCS48 02106 END-IF. DTSCS48 02107 DTSCS48 02108 IF MAP-STATUS-CD = 'W' DTSCS48 02109 MOVE MSG-E486-AREA TO WRK-MSG-AREA DTSCS48 02110 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS48 02111 GO TO S1220-EXIT. DTSCS48 02112 DTSCS48 02113 S1220-EXIT. DTSCS48 02114 EXIT. DTSCS48 02115 DTSCS48 02116 /**************************************************************** DTSCS48 02117 * DTSCS48 02118 ***************************************************************** DTSCS48 02119 S1300-SETTLEMENT-DATE. DTSCS48 02120 MOVE MAP-SETTLEMENT-DATE-AREA TO L015-S-DATE-AREA. DTSCS48 02121 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48 02122 DTSCS48 02123 IF L015-NO-ENTRY DTSCS48 02124 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS48 02125 MOVE WRK-DISPLAY-MO TO MAP-SETTLEMENT-MO DTSCS48 02126 MOVE WRK-DISPLAY-DA TO MAP-SETTLEMENT-DA DTSCS48 02127 MOVE WRK-DISPLAY-YR TO MAP-SETTLEMENT-YR DTSCS48 02128 ELSE DTSCS48 02129 IF L015-NOT-VALID DTSCS48 02130 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02131 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS48 02132 S1300-EXIT. DTSCS48 02133 EXIT. DTSCS48 02134 DTSCS48 02135 S1301-ERROR. DTSCS48 02136 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS48 02137 TO MAP-SETTLEMENT-MO-A DTSCS48 02138 MAP-SETTLEMENT-DA-A DTSCS48 02139 MAP-SETTLEMENT-YR-A. DTSCS48 02140 IF LCCM-NO-MSG DTSCS48 02141 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02142 MOVE CATB-CURSOR TO MAP-SETTLEMENT-MO-L DTSCS48 02143 SET CURSOR-SET-YES TO TRUE. DTSCS48 02144 S1301-EXIT. EXIT. DTSCS48 02145 DTSCS48 02146 /**************************************************************** DTSCS48 02147 * DTSCS48 02148 ***************************************************************** DTSCS48 02149 S1400-MAIL-ADDRESS. DTSCS48 02150 PERFORM S1410-ADDR-TYPE THRU S1410-EXIT. DTSCS48 02151 DTSCS48 02152 PERFORM S1420-MAIL-ID-NO THRU S1420-EXIT. DTSCS48 02153 S1400-EXIT. DTSCS48 02154 EXIT. DTSCS48 02155 /**************************************************************** DTSCS48 02156 * DTSCS48 02157 ***************************************************************** DTSCS48 02158 S1410-ADDR-TYPE. DTSCS48 02159 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS48 02160 SET MAP-ADDR-TAX-88 TO TRUE DTSCS48 02161 ELSE DTSCS48 02162 IF MAP-ADDR-VALID-88 DTSCS48 02163 NEXT SENTENCE DTSCS48 02164 ELSE DTSCS48 02165 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02166 PERFORM S1411-ERROR THRU S1411-EXIT. DTSCS48 02167 S1410-EXIT. EXIT. DTSCS48 02168 DTSCS48 02169 S1411-ERROR. DTSCS48 02170 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A. DTSCS48 02171 IF LCCM-NO-MSG DTSCS48 02172 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02173 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS48 02174 SET CURSOR-SET-YES TO TRUE. DTSCS48 02175 S1411-EXIT. EXIT. DTSCS48 02176 /**************************************************************** DTSCS48 02177 * DTSCS48 02178 ***************************************************************** DTSCS48 02179 S1420-MAIL-ID-NO. DTSCS48 02180 INSPECT MAP-ADDR-ID-NO DTSCS48 02181 CONVERTING LOW-VALUES TO SPACES. DTSCS48 02182 DTSCS48 02183 IF MAP-ADDR-TAD-88 DTSCS48 02184 PERFORM S1430-ADDR-TAD THRU S1430-EXIT DTSCS48 02185 GO TO S1420-EXIT. DTSCS48 02186 DTSCS48 02187 IF MAP-ADDR-ID-NO = SPACES DTSCS48 02188 IF MAP-ADDR-NONE-88 DTSCS48 02189 PERFORM S1440-REQUIRE-ADDRESS THRU S1440-EXIT DTSCS48 02190 GO TO S1420-EXIT DTSCS48 02191 ELSE DTSCS48 02192 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48 02193 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02194 GO TO S1420-EXIT. DTSCS48 02195 DTSCS48 02196 IF MAP-ADDR-NONE-88 DTSCS48 02197 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS48 02198 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02199 GO TO S1420-EXIT. DTSCS48 02200 DTSCS48 02201 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS48 02202 MOVE +1 TO L013-MIN-CNT DTSCS48 02203 MOVE +999 TO L013-MAX-CNT. DTSCS48 02204 DTSCS48 02205 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS48 02206 DTSCS48 02207 IF L013-VALID DTSCS48 02208 MOVE L013-CNT TO MAP-ADDR-ID-NO-Z DTSCS48 02209 IF MAP-ADDR-TAA-OPO-88 DTSCS48 02210 PERFORM S1450-ADDR-TAA-OPO THRU S1450-EXIT DTSCS48 02211 ELSE DTSCS48 02212 NEXT SENTENCE DTSCS48 02213 ELSE DTSCS48 02214 IF L013-NO-ENTRY DTSCS48 02215 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48 02216 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02217 ELSE DTSCS48 02218 IF L013-INVALID-NEGATIVE DTSCS48 02219 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS48 02220 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02221 ELSE DTSCS48 02222 IF L013-EXCEEDS-MIN-MAX DTSCS48 02223 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS48 02224 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02225 ELSE DTSCS48 02226 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02227 PERFORM S1421-ERROR THRU S1421-EXIT. DTSCS48 02228 S1420-EXIT. EXIT. DTSCS48 02229 DTSCS48 02230 S1421-ERROR. DTSCS48 02231 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A DTSCS48 02232 IF LCCM-NO-MSG DTSCS48 02233 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02234 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS48 02235 SET CURSOR-SET-YES TO TRUE. DTSCS48 02236 S1421-EXIT. EXIT. DTSCS48 02237 DTSCS48 02238 S1430-ADDR-TAD. DTSCS48 02239 IF MAP-ADDR-ID-NO NOT = SPACES DTSCS48 02240 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS48 02241 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02242 GO TO S1430-EXIT. DTSCS48 02243 DTSCS48 02244 DTSCS48 02245 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS48 02246 IF MAP-ADDR-TAX-88 DTSCS48 02247 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS48 02248 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS48 02249 ELSE DTSCS48 02250 IF MAP-ADDR-PHY-88 DTSCS48 02251 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS48 02252 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS48 02253 ELSE DTSCS48 02254 GO TO S899-ABEND. DTSCS48 02255 DTSCS48 02256 DTSCS48 02257 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS48 02258 DTSCS48 02259 IF L111-ADDR-NOT-FOUND-88 DTSCS48 02260 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS48 02261 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02262 GO TO S1430-EXIT. DTSCS48 02263 DTSCS48 02264 PERFORM S1460-FORMAT THRU S1460-EXIT. DTSCS48 02265 DTSCS48 02266 S1430-EXIT. DTSCS48 02267 EXIT. DTSCS48 02268 S1440-REQUIRE-ADDRESS. DTSCS48 02269 INSPECT MAP-MAILING-LINE-1 DTSCS48 02270 CONVERTING LOW-VALUES TO SPACES. DTSCS48 02271 INSPECT MAP-MAILING-LINE-2 DTSCS48 02272 CONVERTING LOW-VALUES TO SPACES. DTSCS48 02273 INSPECT MAP-MAILING-LINE-3 DTSCS48 02274 CONVERTING LOW-VALUES TO SPACES. DTSCS48 02275 INSPECT MAP-MAILING-LINE-4 DTSCS48 02276 CONVERTING LOW-VALUES TO SPACES. DTSCS48 02277 INSPECT MAP-MAILING-LINE-5 DTSCS48 02278 CONVERTING LOW-VALUES TO SPACES. DTSCS48 02279 DTSCS48 02280 IF (MAP-MAILING-LINE-1 = SPACES) DTSCS48 02281 AND DTSCS48 02282 (MAP-MAILING-LINE-2 = SPACES) DTSCS48 02283 AND DTSCS48 02284 (MAP-MAILING-LINE-3 = SPACES) DTSCS48 02285 AND DTSCS48 02286 (MAP-MAILING-LINE-4 = SPACES) DTSCS48 02287 AND DTSCS48 02288 (MAP-MAILING-LINE-5 = SPACES) DTSCS48 02289 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS48 02290 PERFORM S1441-ERROR THRU S1441-EXIT. DTSCS48 02291 S1440-EXIT. DTSCS48 02292 EXIT. DTSCS48 02293 DTSCS48 02294 S1441-ERROR. DTSCS48 02295 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS48 02296 TO MAP-MAILING-LINE-1-A. DTSCS48 02297 IF LCCM-NO-MSG DTSCS48 02298 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02299 MOVE CATB-CURSOR TO MAP-MAILING-LINE-1-L DTSCS48 02300 SET CURSOR-SET-YES TO TRUE. DTSCS48 02301 S1441-EXIT. EXIT. DTSCS48 02302 DTSCS48 02303 /**************************************************************** DTSCS48 02304 * DTSCS48 02305 ***************************************************************** DTSCS48 02306 S1450-ADDR-TAA-OPO. DTSCS48 02307 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS48 02308 IF MAP-ADDR-TAX-ALT-88 DTSCS48 02309 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS48 02310 ELSE DTSCS48 02311 IF MAP-ADDR-OPO-88 DTSCS48 02312 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS48 02313 ELSE DTSCS48 02314 GO TO S899-ABEND. DTSCS48 02315 DTSCS48 02316 IF L013-CNT = 0 DTSCS48 02317 MOVE 1 TO L111-ID-NO DTSCS48 02318 ELSE DTSCS48 02319 MOVE L013-CNT TO L111-ID-NO. DTSCS48 02320 DTSCS48 02321 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS48 02322 DTSCS48 02323 IF L111-ADDR-NOT-FOUND-88 DTSCS48 02324 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS48 02325 PERFORM S1421-ERROR THRU S1421-EXIT DTSCS48 02326 GO TO S1450-EXIT. DTSCS48 02327 DTSCS48 02328 PERFORM S1460-FORMAT THRU S1460-EXIT. DTSCS48 02329 DTSCS48 02330 S1450-EXIT. DTSCS48 02331 EXIT. DTSCS48 02332 /**************************************************************** DTSCS48 02333 * DTSCS48 02334 ***************************************************************** DTSCS48 02335 S1460-FORMAT. DTSCS48 02336 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS48 02337 DTSCS48 02338 MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1. DTSCS48 02339 MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2. DTSCS48 02340 MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3. DTSCS48 02341 MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4. DTSCS48 02342 MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5. DTSCS48 02343 S1460-EXIT. EXIT. DTSCS48 02344 DTSCS48 02345 S1500-COMP-DATE. DTSCS48 02346 IF MAP-STATUS-PENDING-88 DTSCS48 02347 NEXT SENTENCE DTSCS48 02348 ELSE DTSCS48 02349 GO TO S1500-EXIT DTSCS48 02350 END-IF. DTSCS48 02351 DTSCS48 02352 MOVE MAP-INT-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS48 02353 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS48 02354 DTSCS48 02355 IF L015-NO-ENTRY DTSCS48 02356 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS48 02357 MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO DTSCS48 02358 MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA DTSCS48 02359 MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR DTSCS48 02360 ELSE DTSCS48 02361 IF L015-NOT-VALID DTSCS48 02362 IF MAP-INT-COMP-MO = '99' DTSCS48 02363 AND MAP-INT-COMP-DA = '99' DTSCS48 02364 AND MAP-INT-COMP-YR = '99' DTSCS48 02365 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS48 02366 ELSE DTSCS48 02367 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02368 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS48 02369 END-IF DTSCS48 02370 ELSE DTSCS48 02371 MOVE L015-DATE TO LCCM-COMP-DATE DTSCS48 02372 END-IF DTSCS48 02373 END-IF. DTSCS48 02374 DTSCS48 02375 S1500-EXIT. DTSCS48 02376 EXIT. DTSCS48 02377 DTSCS48 02378 S1501-ERROR. DTSCS48 02379 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS48 02380 TO MAP-INT-COMP-MO-A DTSCS48 02381 MAP-INT-COMP-DA-A DTSCS48 02382 MAP-INT-COMP-YR-A. DTSCS48 02383 IF LCCM-NO-MSG DTSCS48 02384 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02385 MOVE CATB-CURSOR TO MAP-INT-COMP-MO-L DTSCS48 02386 SET CURSOR-SET-YES TO TRUE. DTSCS48 02387 S1501-EXIT. DTSCS48 02388 EXIT. DTSCS48 02389 DTSCS48 02390 /**************************************************************** DTSCS48 02391 * DTSCS48 02392 ***************************************************************** DTSCS48 02393 S2400-AUTHORIZE-OP-ID. DTSCS48 02394 IF MAP-AUTHORIZE-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS48 02395 MOVE LCCM-RESP-OP-ID TO MAP-AUTHORIZE-OP-ID. DTSCS48 02396 DTSCS48 02397 IF MAP-AUTHORIZE-OP-ID = LCCM-OP-ID DTSCS48 02398 NEXT SENTENCE DTSCS48 02399 ELSE DTSCS48 02400 MOVE MAP-AUTHORIZE-OP-ID TO L082-OP-ID DTSCS48 02401 PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS48 02402 IF (L082-NOT-VALID-OP) OR (L082-INTERNAL-88) DTSCS48 02403 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02404 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS48 02405 GO TO S2400-EXIT. DTSCS48 02406 DTSCS48 02407 S2400-EXIT. EXIT. DTSCS48 02408 DTSCS48 02409 S2401-ERROR. DTSCS48 02410 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AUTHORIZE-OP-ID-A. DTSCS48 02411 IF LCCM-NO-MSG DTSCS48 02412 SET CURSOR-SET-YES TO TRUE DTSCS48 02413 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02414 MOVE CATB-CURSOR TO MAP-AUTHORIZE-OP-ID-L. DTSCS48 02415 S2401-EXIT. EXIT. DTSCS48 02416 DTSCS48 02417 S2500-INT-COMP-DATE. DTSCS48 02418 MOVE MCMP-INT-COMP-DATE TO WRK-DISPLAY DTSCS48 02419 LCCM-COMP-DATE. DTSCS48 02420 MOVE WRK-DISPLAY-MO TO MAP-INT-COMP-MO. DTSCS48 02421 MOVE WRK-DISPLAY-DA TO MAP-INT-COMP-DA. DTSCS48 02422 MOVE WRK-DISPLAY-YR TO MAP-INT-COMP-YR. DTSCS48 02423 DTSCS48 02424 S2500-EXIT. DTSCS48 02425 EXIT. DTSCS48 02426 DTSCS48 02427 /**************************************************************** DTSCS48 02428 * DTSCS48 02429 ***************************************************************** DTSCS48 02430 S2900-COVERED-YRQ. DTSCS48 02431 DTSCS48 02432 MOVE +0 TO WRK-TAX-WAIVED-AMT DTSCS48 02433 WRK-PEN-WAIVED-AMT DTSCS48 02434 WRK-INT-WAIVED-AMT. DTSCS48 02435 DTSCS48 02436 MOVE +0 TO WRK-NO-ENTRY-CTR. DTSCS48 02437 DTSCS48 02438 PERFORM S2910-YRQ-LOOP THRU S2910-EXIT DTSCS48 02439 VARYING WRK-SUB FROM 1 BY 1 DTSCS48 02440 UNTIL WRK-SUB > MMAX-CMP-COV-MAX. DTSCS48 02441 DTSCS48 02442 IF WRK-NO-ENTRY-CTR NOT < MMAX-CMP-COV-MAX DTSCS48 02443 MOVE MSG-E484-AREA TO WRK-MSG-AREA DTSCS48 02444 MOVE +1 TO WRK-SUB DTSCS48 02445 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48 02446 GO TO S2900-EXIT. DTSCS48 02447 DTSCS48 02448 IF LCCM-MSG DTSCS48 02449 MOVE LOW-VALUES TO MAP-TAX-WAIVED-AMT DTSCS48 02450 MAP-PEN-WAIVED-AMT DTSCS48 02451 MAP-INT-WAIVED-AMT DTSCS48 02452 GO TO S2900-EXIT DTSCS48 02453 ELSE DTSCS48 02454 MOVE WRK-TAX-WAIVED-AMT TO MAP-TAX-WAIVED-AMT-Z DTSCS48 02455 MOVE WRK-PEN-WAIVED-AMT TO MAP-PEN-WAIVED-AMT-Z DTSCS48 02456 MOVE WRK-INT-WAIVED-AMT TO MAP-INT-WAIVED-AMT-Z DTSCS48 02457 END-IF. DTSCS48 02458 DTSCS48 02459 S2900-EXIT. DTSCS48 02460 EXIT. DTSCS48 02461 EJECT DTSCS48 02462 * CHECK TO SEE WHAT WAS ENTERED ON THE SCREEN DTSCS48 02463 S2910-YRQ-LOOP. DTSCS48 02464 MOVE LOW-VALUE TO MAP-WAIVED-AMT (WRK-SUB) DTSCS48 02465 MAP-BALANCE-AMT (WRK-SUB). DTSCS48 02466 DTSCS48 02467 MOVE +0 TO MCMP-COVERED-YRQ (WRK-SUB). DTSCS48 02468 DTSCS48 02469 MOVE MAP-COVERED-YRQ-AREA (WRK-SUB) TO L029-S-YRQ-AREA. DTSCS48 02470 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS48 02471 IF L029-NOT-VALID DTSCS48 02472 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS48 02473 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48 02474 ELSE DTSCS48 02475 IF L029-NO-ENTRY DTSCS48 02476 PERFORM S2920-NO-ENTRY THRU S2920-EXIT DTSCS48 02477 ELSE DTSCS48 02478 PERFORM S2930-YRQ-ENTERED THRU S2930-EXIT. DTSCS48 02479 S2910-EXIT. DTSCS48 02480 EXIT. DTSCS48 02481 DTSCS48 02482 S2920-NO-ENTRY. DTSCS48 02483 ADD +1 TO WRK-NO-ENTRY-CTR. DTSCS48 02484 S2920-EXIT. DTSCS48 02485 EXIT. DTSCS48 02486 DTSCS48 02487 S2930-YRQ-ENTERED. DTSCS48 02488 MOVE L029-YRQ TO MCMP-COVERED-YRQ (WRK-SUB). DTSCS48 02489 * QTRS MUST BE ASCENDING SEQ DTSCS48 02490 IF WRK-SUB > +1 DTSCS48 02491 COMPUTE WRK-SUB-MINUS-ONE = WRK-SUB - 1 DTSCS48 02492 IF (MCMP-COVERED-YRQ (WRK-SUB-MINUS-ONE) = +0) DTSCS48 02493 OR DTSCS48 02494 (MCMP-COVERED-YRQ (WRK-SUB) DTSCS48 02495 NOT > MCMP-COVERED-YRQ (WRK-SUB-MINUS-ONE)) DTSCS48 02496 MOVE MSG-E481-AREA TO WRK-MSG-AREA DTSCS48 02497 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48 02498 GO TO S2930-EXIT. DTSCS48 02499 DTSCS48 02500 DTSCS48 02501 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS48 02502 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSCS48 02503 SET MQTR-QTR-88 TO TRUE. DTSCS48 02504 MOVE MCMP-COVERED-YRQ (WRK-SUB) TO MQTR-YRQ. DTSCS48 02505 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS48 02506 DTSCS48 02507 PERFORM S810-READ THRU S810-EXIT. DTSCS48 02508 DTSCS48 02509 IF L810-NO-REC-88 DTSCS48 02510 IF MAP-STATUS-CD = 'F' OR 'P' DTSCS48 02511 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS48 02512 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48 02513 GO TO S2930-EXIT DTSCS48 02514 ELSE DTSCS48 02515 GO TO S2930-EXIT. DTSCS48 02516 DTSCS48 02517 MOVE MSKL-REC TO MQTR-REC. DTSCS48 02518 DTSCS48 02519 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48 02520 WRK-YRQ-TAX-BAL-AMT DTSCS48 02521 WRK-YRQ-WAIVED-AMT DTSCS48 02522 WRK-YRQ-WRITTEN-OFF-AMT. DTSCS48 02523 DTSCS48 02524 PERFORM S4000-AMOUNTS THRU S4000-EXIT. DTSCS48 02525 DTSCS48 02526 IF (WRK-YRQ-TAX-BAL-AMT = +0) DTSCS48 02527 AND DTSCS48 02528 (MAP-STATUS-CD = 'F' OR 'P') DTSCS48 02529 MOVE MSG-E482-AREA TO WRK-MSG-AREA DTSCS48 02530 PERFORM S2999-ERROR THRU S2999-EXIT DTSCS48 02531 GO TO S2930-EXIT. DTSCS48 02532 DTSCS48 02533 IF WRK-YRQ-WRITTEN-OFF-AMT NOT = +0 DTSCS48 02534 MOVE ' WRITE OFF' TO MAP-WAIVED-AMT (WRK-SUB) DTSCS48 02535 ELSE DTSCS48 02536 MOVE WRK-YRQ-WAIVED-AMT TO MAP-WAIVED-AMT-Z (WRK-SUB) DTSCS48 02537 MOVE WRK-YRQ-BALANCE-AMT TO MAP-BALANCE-AMT-Z (WRK-SUB). DTSCS48 02538 DTSCS48 02539 DTSCS48 02540 S2930-EXIT. DTSCS48 02541 EXIT. DTSCS48 02542 DTSCS48 02543 S2999-ERROR. DTSCS48 02544 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS48 02545 TO MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS48 02546 MAP-COVERED-YRQ-Q-A(WRK-SUB) DTSCS48 02547 IF LCCM-NO-MSG DTSCS48 02548 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS48 02549 MOVE CATB-CURSOR TO MAP-COVERED-YRQ-YR-L(WRK-SUB) DTSCS48 02550 SET CURSOR-SET-YES TO TRUE. DTSCS48 02551 S2999-EXIT. DTSCS48 02552 EXIT. DTSCS48 02553 /**************************************************************** DTSCS48 02554 * DTSCS48 02555 ***************************************************************** DTSCS48 02556 S4000-AMOUNTS. DTSCS48 02557 MOVE +0 TO WRK-YRQ-BALANCE-AMT DTSCS48 02558 WRK-YRQ-TAX-BAL-AMT DTSCS48 02559 WRK-YRQ-WAIVED-AMT DTSCS48 02560 WRK-YRQ-WRITTEN-OFF-AMT DTSCS48 02561 L101-PAID-CHNG DTSCS48 02562 L101-INT-CHARGE-CHNG DTSCS48 02563 L101-INT-WAIVE-CHNG. DTSCS48 02564 DTSCS48 02565 PERFORM VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS48 02566 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS48 02567 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48 02568 TO WRK-YRQ-BALANCE-AMT DTSCS48 02569 ADD MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSCS48 02570 TO WRK-YRQ-WRITTEN-OFF-AMT DTSCS48 02571 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48 02572 TO WRK-YRQ-WAIVED-AMT DTSCS48 02573 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS48 02574 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS48 02575 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48 02576 TO WRK-YRQ-TAX-BAL-AMT DTSCS48 02577 L101-PAID-CHNG DTSCS48 02578 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48 02579 TO WRK-TAX-WAIVED-AMT DTSCS48 02580 ELSE DTSCS48 02581 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS48 02582 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS48 02583 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS48 02584 TO WRK-YRQ-TAX-BAL-AMT DTSCS48 02585 L101-PAID-CHNG DTSCS48 02586 ELSE DTSCS48 02587 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSCS48 02588 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48 02589 TO WRK-PEN-WAIVED-AMT DTSCS48 02590 ELSE DTSCS48 02591 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS48 02592 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSCS48 02593 TO WRK-INT-WAIVED-AMT DTSCS48 02594 END-IF DTSCS48 02595 END-IF DTSCS48 02596 END-IF DTSCS48 02597 END-IF DTSCS48 02598 END-PERFORM. DTSCS48 02599 DTSCS48 02600 PERFORM S4010-INTEREST THRU S4010-EXIT. DTSCS48 02601 DTSCS48 02602 ADD L101-INT-CHARGE-CHNG TO WRK-YRQ-BALANCE-AMT. DTSCS48 02603 DTSCS48 02604 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-YRQ-BALANCE-AMT. DTSCS48 02605 DTSCS48 02606 S4000-EXIT. DTSCS48 02607 EXIT. DTSCS48 02608 DTSCS48 02609 S4010-INTEREST. DTSCS48 02610 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS48 02611 GO TO S4010-EXIT DTSCS48 02612 END-IF. DTSCS48 02613 DTSCS48 02614 IF L101-PAID-CHNG > +0 DTSCS48 02615 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE DTSCS48 02616 SET L101-WAIVE-INT-NO-88 TO TRUE DTSCS48 02617 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE DTSCS48 02618 MOVE MQTR-INT-AREA TO L101-INT-AREA DTSCS48 02619 DTSCS48 02620 PERFORM S101-PER-MONTH-YES THRU S101-EXIT DTSCS48 02621 ELSE DTSCS48 02622 MOVE ZERO TO L101-INT-CHARGE-CHNG DTSCS48 02623 L101-INT-WAIVE-CHNG DTSCS48 02624 END-IF. DTSCS48 02625 DTSCS48 02626 S4010-EXIT. DTSCS48 02627 EXIT. DTSCS48 02628 /**************************************************************** DTSCS48 02629 * LOCK SCREEN FOR UPDATE CONFIRMATION DTSCS48 02630 ***************************************************************** DTSCS48 02631 S5100-SET-LOCK-ATTRB. DTSCS48 02632 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS48 02633 WRK-ATB-NUM. DTSCS48 02634 DTSCS48 02635 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS48 02636 DTSCS48 02637 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS48 02638 MAP-EMP-NO-2-A DTSCS48 02639 MAP-GOTO-A. DTSCS48 02640 S5100-EXIT. DTSCS48 02641 EXIT. DTSCS48 02642 DTSCS48 02643 ***************************************************************** DTSCS48 02644 * SET ATTIBUTE BYTES FOR UPDATE ACCESS DTSCS48 02645 ***************************************************************** DTSCS48 02646 S5200-SET-UPDATE-ATTRB. DTSCS48 02647 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS48 02648 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS48 02649 DTSCS48 02650 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS48 02651 DTSCS48 02652 DTSCS48 02653 S5200-EXIT. DTSCS48 02654 EXIT. DTSCS48 02655 DTSCS48 02656 ***************************************************************** DTSCS48 02657 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS DTSCS48 02658 ***************************************************************** DTSCS48 02659 S5300-SET-INQ-ATTRB. DTSCS48 02660 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS48 02661 WRK-ATB-NUM. DTSCS48 02662 DTSCS48 02663 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS48 02664 S5300-EXIT. DTSCS48 02665 EXIT. DTSCS48 02666 DTSCS48 02667 S5900-SET-ATTRB. DTSCS48 02668 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS48 02669 MAP-EMP-NO-2-A. DTSCS48 02670 DTSCS48 02671 IF LCCM-SCR-CLEAR DTSCS48 02672 MOVE CATB-ASKIP-BRT-MDTON DTSCS48 02673 TO MAP-STATUS-CD-A DTSCS48 02674 MOVE WRK-ATB-AN DTSCS48 02675 TO MAP-ADDR-TYPE-A DTSCS48 02676 MAP-MAILING-LINE-1-A DTSCS48 02677 MAP-MAILING-LINE-2-A DTSCS48 02678 MAP-MAILING-LINE-3-A DTSCS48 02679 MAP-MAILING-LINE-4-A DTSCS48 02680 MAP-MAILING-LINE-5-A DTSCS48 02681 MAP-AUTHORIZE-OP-ID-A DTSCS48 02682 MOVE WRK-ATB-NUM DTSCS48 02683 TO MAP-ADDR-ID-NO-A DTSCS48 02684 MAP-SETTLEMENT-DA-A DTSCS48 02685 MAP-SETTLEMENT-MO-A DTSCS48 02686 MAP-SETTLEMENT-YR-A DTSCS48 02687 MAP-INT-COMP-DA-A DTSCS48 02688 MAP-INT-COMP-MO-A DTSCS48 02689 MAP-INT-COMP-YR-A DTSCS48 02690 DTSCS48 02691 PERFORM VARYING WRK-SUB FROM 1 BY 1 DTSCS48 02692 UNTIL WRK-SUB > MMAX-CMP-COV-MAX DTSCS48 02693 MOVE WRK-ATB-AN DTSCS48 02694 TO MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS48 02695 MAP-COVERED-YRQ-YR-A (WRK-SUB) DTSCS48 02696 MOVE CATB-ASKIP-BRT-MDTON DTSCS48 02697 TO MAP-WAIVED-AMT-A (WRK-SUB) DTSCS48 02698 MAP-BALANCE-AMT-A (WRK-SUB) DTSCS48 02699 END-PERFORM DTSCS48 02700 ELSE DTSCS48 02701 MOVE WRK-ATB-AN DTSCS48 02702 TO MAP-STATUS-CD-A DTSCS48 02703 MOVE CATB-ASKIP-BRT-MDTON DTSCS48 02704 TO MAP-ADDR-ID-NO-A DTSCS48 02705 MAP-SETTLEMENT-DA-A DTSCS48 02706 MAP-SETTLEMENT-MO-A DTSCS48 02707 MAP-SETTLEMENT-YR-A DTSCS48 02708 MAP-INT-COMP-DA-A DTSCS48 02709 MAP-INT-COMP-MO-A DTSCS48 02710 MAP-INT-COMP-YR-A DTSCS48 02711 MAP-ADDR-TYPE-A DTSCS48 02712 MAP-MAILING-LINE-1-A DTSCS48 02713 MAP-MAILING-LINE-2-A DTSCS48 02714 MAP-MAILING-LINE-3-A DTSCS48 02715 MAP-MAILING-LINE-4-A DTSCS48 02716 MAP-MAILING-LINE-5-A DTSCS48 02717 MAP-AUTHORIZE-OP-ID-A DTSCS48 02718 DTSCS48 02719 PERFORM VARYING WRK-SUB FROM 1 BY 1 DTSCS48 02720 UNTIL WRK-SUB > MMAX-CMP-COV-MAX DTSCS48 02721 MOVE CATB-ASKIP-BRT-MDTON DTSCS48 02722 TO MAP-COVERED-YRQ-Q-A (WRK-SUB) DTSCS48 02723 MAP-COVERED-YRQ-YR-A(WRK-SUB) DTSCS48 02724 MAP-WAIVED-AMT-A(WRK-SUB) DTSCS48 02725 MAP-BALANCE-AMT-A(WRK-SUB) DTSCS48 02726 END-PERFORM DTSCS48 02727 END-IF. DTSCS48 02728 DTSCS48 02729 DTSCS48 02730 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A DTSCS48 02731 MAP-TAX-WAIVED-AMT-A DTSCS48 02732 MAP-PEN-WAIVED-AMT-A DTSCS48 02733 MAP-INT-WAIVED-AMT-A DTSCS48 02734 MAP-TOT-BALANCE-AMT-A DTSCS48 02735 MAP-CURR-PAGE-A DTSCS48 02736 MAP-LAST-PAGE-A. DTSCS48 02737 DTSCS48 02738 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS48 02739 S5900-EXIT. DTSCS48 02740 EXIT. DTSCS48 02741 EJECT DTSCS48 02742 /**************************************************************** DTSCS48 02743 * MAP ROUTINES DTSCS48 02744 ***************************************************************** DTSCS48 02745 S9100-RECEIVE. DTSCS48 02746 SET L851-RECEIVE-88 TO TRUE. DTSCS48 02747 DTSCS48 02748 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS48 02749 DTSCS48 02750 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS48 02751 DTSCS48 02752 MOVE L851-AID TO LCCM-AID. DTSCS48 02753 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS48 02754 S9100-EXIT. DTSCS48 02755 EXIT. DTSCS48 02756 DTSCS48 02757 S9200-SEND-DATAONLY. DTSCS48 02758 MOVE LOW-VALUES TO MAP-AREA. DTSCS48 02759 DTSCS48 02760 IF LCCM-NO-MSG DTSCS48 02761 NEXT SENTENCE DTSCS48 02762 ELSE DTSCS48 02763 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS48 02764 DTSCS48 02765 IF CURSOR-SET-GOTO DTSCS48 02766 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS48 02767 ELSE DTSCS48 02768 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS48 02769 DTSCS48 02770 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS48 02771 DTSCS48 02772 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS48 02773 DTSCS48 02774 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS48 02775 S9200-EXIT. DTSCS48 02776 EXIT. DTSCS48 02777 DTSCS48 02778 S9300-SEND-MAP. DTSCS48 02779 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS48 02780 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS48 02781 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS48 02782 DTSCS48 02783 IF SCR-ACCESS-UPDATE DTSCS48 02784 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS48 02785 ELSE DTSCS48 02786 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS48 02787 DTSCS48 02788 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS48 02789 DTSCS48 02790 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS48 02791 DTSCS48 02792 IF CURSOR-SET-NO DTSCS48 02793 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS48 02794 DTSCS48 02795 SET L851-SEND-88 TO TRUE. DTSCS48 02796 DTSCS48 02797 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS48 02798 DTSCS48 02799 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS48 02800 S9300-EXIT. DTSCS48 02801 EXIT. DTSCS48 02802 DTSCS48 02803 S9310-UPDATE-FKEYS. DTSCS48 02804 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS48 02805 DTSCS48 02806 DTSCS48 02807 IF LCCM-SCR-CLEAR DTSCS48 02808 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS48 02809 ELSE DTSCS48 02810 IF LCCM-SCR-INQUIRE DTSCS48 02811 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS48 02812 ELSE DTSCS48 02813 IF LCCM-SCR-UPDATE-LOCKED DTSCS48 02814 MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS48 02815 MAP-KEY-LAST DTSCS48 02816 MAP-KEY-BACK DTSCS48 02817 MAP-KEY-FWRD. DTSCS48 02818 S9310-EXIT. DTSCS48 02819 EXIT. DTSCS48 02820 DTSCS48 02821 S9320-INQUIRY-FKEYS. DTSCS48 02822 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS48 02823 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS48 02824 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS48 02825 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS48 02826 DTSCS48 02827 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS48 02828 MAP-KEY-MOD DTSCS48 02829 MAP-KEY-DEL. DTSCS48 02830 DTSCS48 02831 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS48 02832 S9320-EXIT. DTSCS48 02833 EXIT. DTSCS48 02834 DTSCS48 02835 *S9321-JUMP-KEYS. DTSCS48 02836 * MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS48 02837 * MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS48 02838 *S9321-EXIT. DTSCS48 02839 * EXIT. DTSCS48 02840 * DTSCS48 02841 S9330-DSCR-FIELDS. DTSCS48 02842 IF WRK-MPRF-YES-88 DTSCS48 02843 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS48 02844 END-IF. DTSCS48 02845 DTSCS48 02846 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS48 02847 MOVE LOW-VALUES TO MAP-STATUS-CD-DSCR DTSCS48 02848 ELSE DTSCS48 02849 MOVE MAP-STATUS-CD TO L034-CD DTSCS48 02850 PERFORM S034-MCMP-STATUS-CD THRU S034-EXIT DTSCS48 02851 MOVE L034-SHORT-DSCR TO MAP-STATUS-CD-DSCR. DTSCS48 02852 DTSCS48 02853 * IF MAP-AUTHORIZE-OP-ID = LCCM-OP-ID DTSCS48 02854 * MOVE LCCM-OP-NAME TO MAP-AUTHORIZE-OP-ID-DSCR DTSCS48 02855 * ELSE DTSCS48 02856 * IF MAP-AUTHORIZE-OP-ID = L082-NAME DTSCS48 02857 * MOVE L082-NAME TO MAP-AUTHORIZE-OP-ID-DSCR DTSCS48 02858 * ELSE DTSCS48 02859 * MOVE MAP-AUTHORIZE-OP-ID TO L082-OP-ID DTSCS48 02860 * PERFORM S082-OP-ID-EDIT THRU S082-EXIT DTSCS48 02861 * MOVE L082-NAME TO MAP-AUTHORIZE-OP-ID-DSCR. DTSCS48 02862 DTSCS48 02863 S9330-EXIT. EXIT. DTSCS48 02864 DTSCS48 02865 S9900-PREPARE-SEND. DTSCS48 02866 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS48 02867 LCCM-SCR-ID. DTSCS48 02868 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS48 02869 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS48 02870 S9900-EXIT. DTSCS48 02871 EXIT. DTSCS48