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