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