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