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