giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
8c4bd2e7af8635830ba81b302bc66ab72e840b23
DUTAS/CICS/DTSCS45.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

3373 lines
263 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink