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