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