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
