00001  IDENTIFICATION DIVISION.                                         05/05/25
00002  PROGRAM-ID.             DTSCS7D.                                 DTSCS7D
00003  AUTHOR.                 NORTHROP GRUMMEN.                           LV003
00004  DATE-WRITTEN.           JANUARY 2003.                            DTSCS7D
00005  DATE-COMPILED.                                                   DTSCS7D
00006                                                                   DTSCS7D
00007 *****                                                             DTSCS7D
00008 *                                                                 DTSCS7D
00009 *    FUNCTION:  EMPLOYER WAGE REQUEST SCREEN PROCESSOR.           DTSCS7D
00010 *                                                                 DTSCS7D
00011 *                                                                 DTSCS7D
00012 *    MODIFICATION LOG:                                            DTSCS7D
00013 *                                                                 DTSCS7D
00014 *    01/02/03  INITIAL DEVELOPMENT.      COPIED FROM DTSCS76.     DTSCS7D
00015 *                                        PROGRAMMER: SCM          DTSCS7D
00016 *                                                                 DTSCS7D
00017 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS7D
00018 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS7D
00019 *              REFERENCE RFP: #***              PROGRAMMER: XXX   DTSCS7D
00020 *                                                                 DTSCS7D
00021 *                                                                 DTSCS7D
00022 *  DESCRIPTION:                                                   DTSCS7D
00023 *                                                                 DTSCS7D
00024 *                                                                 DTSCS7D
00025 *    CLEAR:                                                       DTSCS7D
00026 *                                                                 DTSCS7D
00027 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS7D
00028 *                                                                 DTSCS7D
00029 *                                                                 DTSCS7D
00030 *    JUMP:                                                        DTSCS7D
00031 *                                                                 DTSCS7D
00032 *      NONE.                                                      DTSCS7D
00033 *                                                                 DTSCS7D
00034 *                                                                 DTSCS7D
00035 *    INQUIRY:                                                     DTSCS7D
00036 *                                                                 DTSCS7D
00037 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS7D
00038 *                                                                 DTSCS7D
00039 *      JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS7D
00040 *                                                                 DTSCS7D
00041 *      ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO.   DTSCS7D
00042 *                                                                 DTSCS7D
00043 *      STANDARD LCCM-EMP-NO.                                      DTSCS7D
00044 *                                                                 DTSCS7D
00045 *                                                                 DTSCS7D
00046 *    UPDATE:                                                      DTSCS7D
00047 *                                                                 DTSCS7D
00048 *      ADD                                                        DTSCS7D
00049 *                                                                 DTSCS7D
00050 *        DOES NOT UPDATE THE MASTER FILE.  WRITES DTSIR751        DTSCS7D
00051 *        RECORD TO THE ON-LINE ACTIVITY FILE.  OPTIONALLY         DTSCS7D
00052 *        WRITES A DTSIR901 LABEL RECORD TO OLA FILE.              DTSCS7D
00053 *                                                                 DTSCS7D
00054 *    RECORDS READ:                                                DTSCS7D
00055 *                                                                 DTSCS7D
00056 *      MASTER:                                                    DTSCS7D
00057 *                                                                 DTSCS7D
00058 *        MPRF                                                     DTSCS7D
00059 *        MSOL                                                     DTSCS7D
00060 *        MRTE                                                     DTSCS7D
00061 *        MRPT                                                     DTSCS7D
00062 *                                                                 DTSCS7D
00063 *      ALTERNATE INDEX:                                           DTSCS7D
00064 *                                                                 DTSCS7D
00065 *        NONE.                                                    DTSCS7D
00066 *                                                                 DTSCS7D
00067 *      REFERENCE:                                                 DTSCS7D
00068 *                                                                 DTSCS7D
00069 *        NONE.                                                    DTSCS7D
00070 *                                                                 DTSCS7D
00071 *                                                                 DTSCS7D
00072 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS7D
00073 *                                                                 DTSCS7D
00074 *        NONE.                                                    DTSCS7D
00075 *                                                                 DTSCS7D
00076 *                                                                 DTSCS7D
00077 *    RECORDS UPDATED:                                             DTSCS7D
00078 *                                                                 DTSCS7D
00079 *      MASTER:                                                    DTSCS7D
00080 *                                                                 DTSCS7D
00081 *        NONE.                                                    DTSCS7D
00082 *                                                                 DTSCS7D
00083 *                                                                 DTSCS7D
00084 *      REFERENCE:                                                 DTSCS7D
00085 *                                                                 DTSCS7D
00086 *        NONE.                                                    DTSCS7D
00087 *                                                                 DTSCS7D
00088 *                                                                 DTSCS7D
00089 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS7D
00090 *                                                                 DTSCS7D
00091 *        NONE.                                                    DTSCS7D
00092 *                                                                 DTSCS7D
00093 *                                                                 DTSCS7D
00094 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS7D
00095 *                                                                 DTSCS7D
00096 *      WRITE A DTSIR751 RECORD.                                   DTSCS7D
00097 *                                                                 DTSCS7D
00098 *    TEMPORARY STORAGE USAGE:                                     DTSCS7D
00099 *                                                                 DTSCS7D
00100 *      NONE.                                                      DTSCS7D
00101 *                                                                 DTSCS7D
00102 *                                                                 DTSCS7D
00103 *    MODULES LINKED TO:                                           DTSCS7D
00104 *                                                                 DTSCS7D
00105 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS7D
00106 *      DTSCU016  QUARTER/YEAR FROM SCREEN FORMAT/EDIT.            DTSCS7D
00107 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS7D
00108 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS7D
00109 *      DTSCU111  ADDRESS LOOKUP.                                  DTSCS7D
00110 *      DTSCU112  FORMAT ADDRESS FOR MAILING.                      DTSCS7D
00111 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS7D
00112 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT.                    DTSCS7D
00113 *                                                                 DTSCS7D
00114 *****                                                             DTSCS7D
00115                                                                   DTSCS7D
00116  ENVIRONMENT DIVISION.                                            DTSCS7D
00117                                                                   DTSCS7D
00118  DATA DIVISION.                                                   DTSCS7D
00119                                                                   DTSCS7D
00120  WORKING-STORAGE SECTION.                                         DTSCS7D
001205 77  PAN-VALET PICTURE X(24) VALUE '003DTSCS7D   05/05/25'.       DTSCS7D
00121  77  PAN-VALET PICTURE X(24) VALUE '008DTSCS7D   05/05/25'.       DTSCS7D
00122                                                                   DTSCS7D
00123  01  SW-AREA.                                                     DTSCS7D
00124      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S7D '.    DTSCS7D
00125                                                                   DTSCS7D
00126      05  WRK-SCR-ID.                                              DTSCS7D
00127          10  WRK-SCR-ID-A            PIC  X(02)  VALUE '7D'.      DTSCS7D
00128                                                                   DTSCS7D
00129      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '70'.      DTSCS7D
00130                                                                   DTSCS7D
00131      05  WRK-FINL-IND-OK             PIC  X(01).                  DTSCS7D
00132                                                                   DTSCS7D
00133      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS7D
00134          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS7D
00135          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS7D
00136                                                                   DTSCS7D
00137      05  CURSOR-SET-IND              PIC X(01).                   DTSCS7D
00138          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS7D
00139          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS7D
00140          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS7D
00141                                                                   DTSCS7D
00142      05  REQ-IND                     PIC X(01).                   DTSCS7D
00143          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS7D
00144          88  REQ-ERROR                       VALUE 'O'.           DTSCS7D
00145          88  REQ-JUMP                        VALUE 'J'.           DTSCS7D
00146          88  REQ-UPDATE                      VALUE 'U'.           DTSCS7D
00147          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS7D
00148          88  REQ-CLEAR                       VALUE 'C'.           DTSCS7D
00149          88  REQ-EDIT                        VALUE 'E'.           DTSCS7D
00150                                                                   DTSCS7D
00151      05  RESP-IND                    PIC X(01).                   DTSCS7D
00152          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS7D
00153          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS7D
00154          88  RESP-JUMP                       VALUE 'J'.           DTSCS7D
00155          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS7D
00156                                                                   DTSCS7D
00157      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS7D
00158                                                                   DTSCS7D
00159      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS7D
00160                                                                   DTSCS7D
00161      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS7D
00162                                                                   DTSCS7D
00163      05  WRK-NO-DEFAULT              PIC  X(01).                  DTSCS7D
00164                                                                   DTSCS7D
00165      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS7D
00166                                                                   DTSCS7D
00167      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS7D
00168          88  WRK-MPRF-NONE-88               VALUE ' '.            DTSCS7D
00169          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS7D
00170          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS7D
00171                                                                   DTSCS7D
00172      05  WRK-MAILING-ADDRESS-AREA.                                DTSCS7D
00173          10  WRK-MAILING-ADDRESS.                                 DTSCS7D
00174              15  FILLER   OCCURS 5       PIC  X(40).              DTSCS7D
00175          10  WRK-ZIP                     PIC  X(10).              DTSCS7D
00176          10  WRK-ADVANCED-BARCODE        PIC  X(14).              DTSCS7D
00177                                                                   DTSCS7D
00178      05  WRK-TELEPHONE-AREA.                                      DTSCS7D
00179          10  FILLER                      PIC X(01) VALUE '('.     DTSCS7D
00180          10  WRK-VOICE-AREA-CD           PIC X(03).               DTSCS7D
00181          10  FILLER                      PIC X(02) VALUE ')'.     DTSCS7D
00182          10  WRK-VOICE-PREFIX            PIC X(03).               DTSCS7D
00183          10  FILLER                      PIC X(01) VALUE '-'.     DTSCS7D
00184          10  WRK-VOICE-SUFFIX            PIC X(04).               DTSCS7D
00185                                                                   DTSCS7D
00186      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS7D
00187                                                                   DTSCS7D
00188      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS7D
00189          10  FILLER                  PIC X(05).                   DTSCS7D
00190          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS7D
00191          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS7D
00192                                                                   DTSCS7D
00193      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS7D
00194          10  FILLER                  PIC X(05).                   DTSCS7D
00195          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS7D
00196          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS7D
00197          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS7D
00198                                                                   DTSCS7D
00199      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS7D
00200          10  FILLER                 PIC X(06).                    DTSCS7D
00201          10  WRK-DISPLAY-YRQ        PIC X(05).                    DTSCS7D
00202          10  FILLER REDEFINES WRK-DISPLAY-YRQ.                    DTSCS7D
00203              15  FILLER PIC XX.                                   DTSCS7D
00204              15  WRK-DISPLAY-YRQ-Y  PIC 99.                       DTSCS7D
00205              15  WRK-DISPLAY-YRQ-Q  PIC 9.                        DTSCS7D
00206                                                                   DTSCS7D
00207      EJECT                                                        DTSCS7D
00208  01  MSG-LITERALS.                                                DTSCS7D
00209      05  MSG-E7D1-AREA.                                           DTSCS7D
00210          10  FILLER                  PIC  X(04)  VALUE 'E7D1'.    DTSCS7D
00211          10  FILLER                  PIC  X(30)                   DTSCS7D
00212                VALUE 'SSN MUST BE ENTERED           '.            DTSCS7D
00213          10  FILLER                  PIC  X(30)                   DTSCS7D
00214                VALUE '                              '.            DTSCS7D
00215                                                                   DTSCS7D
00216      05  MSG-E7D2-AREA.                                           DTSCS7D
00217          10  FILLER                  PIC  X(04)  VALUE 'E7D2'.    DTSCS7D
00218          10  FILLER                  PIC  X(30)                   DTSCS7D
00219                VALUE 'SSN NOT IN CLAIMANT FILE; RE-E'.            DTSCS7D
00220          10  FILLER                  PIC  X(30)                   DTSCS7D
00221                VALUE 'NTER.                         '.            DTSCS7D
00222                                                                   DTSCS7D
00223      05  MSG-E7D3-AREA.                                           DTSCS7D
00224          10  FILLER                  PIC  X(04)  VALUE 'E7D3'.    DTSCS7D
00225          10  FILLER                  PIC  X(52)  VALUE            DTSCS7D
00226          'EITHER EMPLOYER NUMBER OR NAME & ADDRESS IS REQUIRED'.  DTSCS7D
00227                                                                   DTSCS7D
00228      05  MSG-E7D4-AREA.                                           DTSCS7D
00229          10  FILLER                  PIC  X(04)  VALUE 'E7D4'.    DTSCS7D
00230          10  FILLER                  PIC  X(47)  VALUE            DTSCS7D
00231              'ENTER EITHER EMPLOYER NUMBER OR NAME & ADDRESS,'.   DTSCS7D
00232          10  FILLER                  PIC  X(08)                   DTSCS7D
00233                VALUE 'NOT BOTH'.                                  DTSCS7D
00234                                                                   DTSCS7D
00235      05  MSG-E7D5-AREA.                                           DTSCS7D
00236          10  FILLER                  PIC  X(04)  VALUE 'E7D5'.    DTSCS7D
00237          10  FILLER                  PIC  X(47)  VALUE            DTSCS7D
00238              'INCOMPLETE/INVALID ADDRESS ENTERED FOR EMPLOYER'.   DTSCS7D
00239                                                                   DTSCS7D
00240      05  MSG-E7D6-AREA.                                           DTSCS7D
00241          10  FILLER                  PIC  X(04)  VALUE 'E7D6'.    DTSCS7D
00242          10  FILLER                  PIC  X(33)  VALUE            DTSCS7D
00243              'INVALID ENTRY.  MUST BE (Y, N, L)'.                 DTSCS7D
00244                                                                   DTSCS7D
00245      05  MSG-E7D7-AREA.                                           DTSCS7D
00246          10  FILLER                  PIC  X(04)  VALUE 'E7D7'.    DTSCS7D
00247          10  FILLER                  PIC  X(40)  VALUE            DTSCS7D
00248              'EMPLOYER ADDRESS COULD NOT BE CONFIRMED'.           DTSCS7D
00249                                                                   DTSCS7D
00250      05  MSG-E7D8-AREA.                                           DTSCS7D
00251          10  FILLER                  PIC  X(04)  VALUE 'E7D8'.    DTSCS7D
00252          10  FILLER                  PIC  X(32)  VALUE            DTSCS7D
00253              'EMPLOYER DOES NOT EXIST IN DUTAS'.                  DTSCS7D
00254                                                                   DTSCS7D
00255      05  MSG-E7D9-AREA.                                           DTSCS7D
00256          10  FILLER                  PIC  X(04)  VALUE 'E7D9'.    DTSCS7D
00257          10  FILLER                  PIC  X(37)  VALUE            DTSCS7D
00258              'DO NOT ENTER EMPLOYER OR QTR(S) WHEN'.              DTSCS7D
00259          10  FILLER                  PIC  X(14)                   DTSCS7D
00260                VALUE 'MAIL LABEL = L'.                            DTSCS7D
00261                                                                   DTSCS7D
00262      05  MSG-E7D10-AREA.                                          DTSCS7D
00263          10  FILLER                  PIC  X(05)  VALUE 'E7D10'.   DTSCS7D
00264          10  FILLER                  PIC  X(51)  VALUE            DTSCS7D
00265          'EITHER EMPLOYER NUMBER OR EMPLOYER NAME IS REQUIRED'.   DTSCS7D
00266                                                                   DTSCS7D
00267 *01  ESP072D-COMM-AREA.                                              CL**3
00268 *++INCLUDE ESPLINKC                                                  CL**3
00269 *    EJECT                                                           CL**3
00270  01  L001-COMM-AREA.                                              DTSCS7D
00271  ++INCLUDE DTSIL001                                               DTSCS7D
00272      EJECT                                                        DTSCS7D
00273  01  L004-COMM-AREA.                                              DTSCS7D
00274  ++INCLUDE DTSIL004                                               DTSCS7D
00275      EJECT                                                        DTSCS7D
00276  01  L006-COMM-AREA.                                              DTSCS7D
00277  ++INCLUDE DTSIL006                                               DTSCS7D
00278      EJECT                                                        DTSCS7D
00279  01  L013-COMM-AREA.                                              DTSCS7D
00280  ++INCLUDE DTSIL013                                               DTSCS7D
00281      EJECT                                                        DTSCS7D
00282  01  L015-COMM-AREA.                                              DTSCS7D
00283  ++INCLUDE DTSIL015                                               DTSCS7D
00284      EJECT                                                        DTSCS7D
00285  01  L016-COMM-AREA.                                              DTSCS7D
00286  ++INCLUDE DTSIL016                                               DTSCS7D
00287      EJECT                                                        DTSCS7D
00288  01  L018-COMM-AREA.                                              DTSCS7D
00289  ++INCLUDE DTSIL018                                               DTSCS7D
00290      EJECT                                                        DTSCS7D
00291  01  L020-COMM-AREA.                                              DTSCS7D
00292  ++INCLUDE DTSIL020                                               DTSCS7D
00293      EJECT                                                        DTSCS7D
00294  01  L072-COMM-AREA.                                              DTSCS7D
00295  ++INCLUDE DTSIL072                                               DTSCS7D
00296      EJECT                                                        DTSCS7D
00297  01  L081-COMM-AREA.                                              DTSCS7D
00298  ++INCLUDE DTSIL081                                               DTSCS7D
00299      EJECT                                                        DTSCS7D
00300  01  L082-COMM-AREA.                                              DTSCS7D
00301  ++INCLUDE DTSIL082                                               DTSCS7D
00302      EJECT                                                        DTSCS7D
00303  01  L112-COMM-AREA.                                              DTSCS7D
00304  ++INCLUDE DTSIL112                                               DTSCS7D
00305      EJECT                                                        DTSCS7D
00306  01  L381-COMM-AREA.                                              DTSCS7D
00307  ++INCLUDE DTSIL381                                               DTSCS7D
00308      EJECT                                                        DTSCS7D
00309  01  L410-COMM-AREA.                                              DTSCS7D
00310  ++INCLUDE DTSIL410                                               DTSCS7D
00311      EJECT                                                        DTSCS7D
00312  01  L805-COMM-AREA.                                              DTSCS7D
00313  ++INCLUDE DTSIL805                                               DTSCS7D
00314      EJECT                                                        DTSCS7D
00315  01  L810-COMM-AREA.                                              DTSCS7D
00316      05  L810-CONTROL-BLOCK.                                      DTSCS7D
00317  ++INCLUDE DTSIL810                                               DTSCS7D
00318      EJECT                                                        DTSCS7D
00319      05  MSKL-REC.                                                DTSCS7D
00320  ++INCLUDE DTSIMSKL                                               DTSCS7D
00321      EJECT                                                        DTSCS7D
00322  01  MPRF-REC.                                                    DTSCS7D
00323  ++INCLUDE DTSIMPRF                                               DTSCS7D
00324      EJECT                                                        DTSCS7D
00325  01  MTAD-REC.                                                    DTSCS7D
00326  ++INCLUDE DTSIMTAD                                               DTSCS7D
00327      EJECT                                                        DTSCS7D
00328  01  L851-COMM-AREA.                                              DTSCS7D
00329  ++INCLUDE DTSIL851                                               DTSCS7D
00330      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS7D
00331      EJECT                                                        DTSCS7D
00332  ++INCLUDE DTSIS7D                                                DTSCS7D
00333      EJECT                                                        DTSCS7D
00334  01  L825-COMM-AREA.                                              DTSCS7D
00335      05  L825-CONTROL-BLOCK.                                      DTSCS7D
00336  ++INCLUDE DTSIL825                                               DTSCS7D
00337      EJECT                                                        DTSCS7D
00338      05  RSKL-REC.                                                DTSCS7D
00339  ++INCLUDE DTSIRSK1                                               DTSCS7D
00340      EJECT                                                        DTSCS7D
00341  01  R751-REC.                                                    DTSCS7D
00342  ++INCLUDE DTSIR751                                               DTSCS7D
00343      EJECT                                                        DTSCS7D
00344  01  R901-REC.                                                    DTSCS7D
00345  ++INCLUDE DTSIR901                                               DTSCS7D
00346      EJECT                                                        DTSCS7D
00347  01  CATB-LITERALS.                                               DTSCS7D
00348  ++INCLUDE DTSICATB                                               DTSCS7D
00349                                                                   DTSCS7D
00350  01  CFKD-LITERALS.                                               DTSCS7D
00351  ++INCLUDE DTSICFKD                                               DTSCS7D
00352                                                                   DTSCS7D
00353  01  CECD-LITERALS.                                               DTSCS7D
00354  ++INCLUDE DTSICECD                                               DTSCS7D
00355                                                                   DTSCS7D
00356  01  CPCD-LITERALS.                                               DTSCS7D
00357  ++INCLUDE DTSICPCD                                               DTSCS7D
00358                                                                   DTSCS7D
00359  LINKAGE SECTION.                                                 DTSCS7D
00360                                                                   DTSCS7D
00361  01  DFHCOMMAREA.                                                 DTSCS7D
00362  ++INCLUDE DTSILCCM                                               DTSCS7D
00363      EJECT                                                        DTSCS7D
00364  PROCEDURE DIVISION.                                              DTSCS7D
00365                                                                   DTSCS7D
00366      MOVE +0 TO WRK-EMP-NO.                                       DTSCS7D
00367                                                                   DTSCS7D
00368      SET WRK-MPRF-NONE-88 TO TRUE.                                DTSCS7D
00369                                                                   DTSCS7D
00370      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS7D
00371                                                                   DTSCS7D
00372      SET CURSOR-SET-NO TO TRUE.                                   DTSCS7D
00373                                                                   DTSCS7D
00374      PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT                  DTSCS7D
00375         VARYING LCCM-NONUM-IDX FROM +1 BY +1                      DTSCS7D
00376         UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT.                DTSCS7D
00377                                                                   DTSCS7D
00378      MOVE SPACE TO REQ-IND.                                       DTSCS7D
00379                                                                   DTSCS7D
00380      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS7D
00381                                                                   DTSCS7D
00382 *-----------------------------------------------------            DTSCS7D
00383 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS7D
00384 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS7D
00385 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS7D
00386 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS7D
00387 *                                                                 DTSCS7D
00388 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS7D
00389 *    PROCESSED.                                                   DTSCS7D
00390 *                                                                 DTSCS7D
00391 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS7D
00392 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS7D
00393 *    WORK STATION OPERATOR.                                       DTSCS7D
00394 *-----------------------------------------------------            DTSCS7D
00395                                                                   DTSCS7D
00396      MOVE SPACE TO RESP-IND.                                      DTSCS7D
00397                                                                   DTSCS7D
00398      IF REQ-ERROR                                                 DTSCS7D
00399         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS7D
00400      ELSE                                                         DTSCS7D
00401      IF REQ-JUMP                                                  DTSCS7D
00402         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS7D
00403      ELSE                                                         DTSCS7D
00404      IF REQ-CLEAR                                                 DTSCS7D
00405         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS7D
00406      ELSE                                                         DTSCS7D
00407      IF REQ-CURSOR-TO-GOTO                                        DTSCS7D
00408         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS7D
00409      ELSE                                                         DTSCS7D
00410      IF REQ-INQUIRE                                               DTSCS7D
00411         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS7D
00412      ELSE                                                         DTSCS7D
00413      IF REQ-EDIT                                                  DTSCS7D
00414         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS7D
00415      ELSE                                                         DTSCS7D
00416      IF REQ-UPDATE                                                DTSCS7D
00417         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS7D
00418      ELSE                                                         DTSCS7D
00419         GO TO S899-ABEND.                                         DTSCS7D
00420                                                                   DTSCS7D
00421 *-----------------------------------------------------            DTSCS7D
00422 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS7D
00423 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS7D
00424 *-----------------------------------------------------            DTSCS7D
00425                                                                   DTSCS7D
00426      IF RESP-SEND-MAP                                             DTSCS7D
00427          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS7D
00428          SET LCCM-END-TASK-88 TO TRUE                             DTSCS7D
00429      ELSE                                                         DTSCS7D
00430      IF RESP-SEND-MSGONLY                                         DTSCS7D
00431          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS7D
00432          SET LCCM-END-TASK-88 TO TRUE                             DTSCS7D
00433      ELSE                                                         DTSCS7D
00434      IF RESP-JUMP                                                 DTSCS7D
00435          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS7D
00436      ELSE                                                         DTSCS7D
00437      IF RESP-CURSOR-TO-GOTO                                       DTSCS7D
00438          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS7D
00439          SET LCCM-END-TASK-88 TO TRUE                             DTSCS7D
00440      ELSE                                                         DTSCS7D
00441          GO TO S899-ABEND.                                        DTSCS7D
00442                                                                   DTSCS7D
00443  MAINLINE-EXIT.                                                   DTSCS7D
00444                                                                   DTSCS7D
00445      EXEC CICS                                                    DTSCS7D
00446          RETURN                                                   DTSCS7D
00447      END-EXEC.                                                    DTSCS7D
00448                                                                   DTSCS7D
00449      GOBACK.                                                      DTSCS7D
00450      EJECT                                                        DTSCS7D
00451  P0100-ACCESS-SEARCH.                                             DTSCS7D
00452      IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID-A         DTSCS7D
00453          MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX)          DTSCS7D
00454              TO SCR-ACCESS-IND.                                   DTSCS7D
00455  P0100-EXIT.                                                      DTSCS7D
00456      EXIT.                                                        DTSCS7D
00457                                                                   DTSCS7D
00458 ******************************************************************DTSCS7D
00459 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS7D
00460 ******************************************************************DTSCS7D
00461                                                                   DTSCS7D
00462  P1000-ANALYZE-REQUEST.                                           DTSCS7D
00463                                                                   DTSCS7D
00464 *-----------------------------------------------------            DTSCS7D
00465 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS7D
00466 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS7D
00467 *     REPLACED WITH ENTER)                                        DTSCS7D
00468 *-----------------------------------------------------            DTSCS7D
00469                                                                   DTSCS7D
00470      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS7D
00471         SET LCCM-ENTER-88 TO TRUE                                 DTSCS7D
00472         SET REQ-INQUIRE TO TRUE                                   DTSCS7D
00473         IF LCCM-EMP-NO > ZERO                                     DTSCS7D
00474             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS7D
00475             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS7D
00476         END-IF                                                    DTSCS7D
00477         GO TO P1000-EXIT.                                         DTSCS7D
00478                                                                   DTSCS7D
00479 *-----------------------------------------------------            DTSCS7D
00480 *    RECEIVE THE MAP                                              DTSCS7D
00481 *-----------------------------------------------------            DTSCS7D
00482                                                                   DTSCS7D
00483      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS7D
00484                                                                   DTSCS7D
00485 *-----------------------------------------------------            DTSCS7D
00486 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS7D
00487 *    WORK STATION                                                 DTSCS7D
00488 *-----------------------------------------------------            DTSCS7D
00489                                                                   DTSCS7D
00490      IF LCCM-CLEAR-88                                             DTSCS7D
00491         SET REQ-CLEAR TO TRUE                                     DTSCS7D
00492         GO TO P1000-EXIT.                                         DTSCS7D
00493                                                                   DTSCS7D
00494 *-----------------------------------------------------            DTSCS7D
00495 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS7D
00496 *-----------------------------------------------------            DTSCS7D
00497                                                                   DTSCS7D
00498      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS7D
00499         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS7D
00500         GO TO P1000-EXIT.                                         DTSCS7D
00501                                                                   DTSCS7D
00502 *-----------------------------------------------------            DTSCS7D
00503 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS7D
00504 *-----------------------------------------------------            DTSCS7D
00505                                                                   DTSCS7D
00506      IF LCCM-PA2-88                                               DTSCS7D
00507          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS7D
00508          GO TO P1000-EXIT.                                        DTSCS7D
00509                                                                   DTSCS7D
00510 *-----------------------------------------------------            DTSCS7D
00511 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS7D
00512 *-----------------------------------------------------            DTSCS7D
00513                                                                   DTSCS7D
00514      IF LCCM-PA-88                                                DTSCS7D
00515        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS7D
00516        SET REQ-ERROR TO TRUE                                      DTSCS7D
00517        GO TO P1000-EXIT.                                          DTSCS7D
00518                                                                   DTSCS7D
00519 *-----------------------------------------------------            DTSCS7D
00520 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS             DTSCS7D
00521 *    CLEAR SCREEN                                                 DTSCS7D
00522 *-----------------------------------------------------            DTSCS7D
00523                                                                   DTSCS7D
00524      IF LCCM-F12-88                                               DTSCS7D
00525         MOVE LOW-VALUES TO MAP-AREA                               DTSCS7D
00526         SET REQ-CLEAR TO TRUE                                     DTSCS7D
00527         GO TO P1000-EXIT.                                         DTSCS7D
00528                                                                   DTSCS7D
00529 *-----------------------------------------------------            DTSCS7D
00530 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS7D
00531 *-----------------------------------------------------            DTSCS7D
00532                                                                   DTSCS7D
00533      IF LCCM-F03-88                                               DTSCS7D
00534         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS7D
00535         SET REQ-JUMP TO TRUE                                      DTSCS7D
00536         GO TO P1000-EXIT.                                         DTSCS7D
00537                                                                   DTSCS7D
00538 *-----------------------------------------------------            DTSCS7D
00539 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS7D
00540 *-----------------------------------------------------            DTSCS7D
00541                                                                   DTSCS7D
00542      IF LCCM-F04-88                                               DTSCS7D
00543         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS7D
00544         SET REQ-JUMP TO TRUE                                      DTSCS7D
00545         GO TO P1000-EXIT.                                         DTSCS7D
00546                                                                   DTSCS7D
00547 *-----------------------------------------------------            DTSCS7D
00548 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS7D
00549 *    CORRESPONDENCE SCREEN                                        DTSCS7D
00550 *-----------------------------------------------------            DTSCS7D
00551                                                                   DTSCS7D
00552      IF LCCM-F14-88                                               DTSCS7D
00553         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS7D
00554         SET REQ-JUMP TO TRUE                                      DTSCS7D
00555         GO TO P1000-EXIT.                                         DTSCS7D
00556                                                                   DTSCS7D
00557 *-----------------------------------------------------            DTSCS7D
00558 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS7D
00559 *    REQUESTED SCREEN TYPE                                        DTSCS7D
00560 *-----------------------------------------------------            DTSCS7D
00561                                                                   DTSCS7D
00562      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS7D
00563         NEXT SENTENCE                                             DTSCS7D
00564      ELSE                                                         DTSCS7D
00565        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS7D
00566        SET REQ-JUMP TO TRUE                                       DTSCS7D
00567        GO TO P1000-EXIT.                                          DTSCS7D
00568                                                                   DTSCS7D
00569 *-----------------------------------------------------            DTSCS7D
00570 *    IF REQUEST TO UPDATE THE DATA (ADD)                          DTSCS7D
00571 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS7D
00572 *-----------------------------------------------------            DTSCS7D
00573                                                                   DTSCS7D
00574      IF LCCM-F09-88                                               DTSCS7D
00575         IF SCR-ACCESS-UPDATE                                      DTSCS7D
00576            SET REQ-EDIT TO TRUE                                   DTSCS7D
00577            GO TO P1000-EXIT                                       DTSCS7D
00578         ELSE                                                      DTSCS7D
00579            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS7D
00580            SET REQ-ERROR TO TRUE                                  DTSCS7D
00581            GO TO P1000-EXIT.                                      DTSCS7D
00582                                                                   DTSCS7D
00583 *-----------------------------------------------------            DTSCS7D
00584 *     IF INQUIRY KEY IS PRESSED (ENTER), INDICATE                 DTSCS7D
00585 *     INQUIRY REQUESTED.                                          DTSCS7D
00586 *-----------------------------------------------------            DTSCS7D
00587                                                                   DTSCS7D
00588      IF LCCM-ENTER-88                                             DTSCS7D
00589          SET REQ-INQUIRE TO TRUE                                  DTSCS7D
00590          GO TO P1000-EXIT.                                        DTSCS7D
00591                                                                   DTSCS7D
00592 *-----------------------------------------------------            DTSCS7D
00593 *     ANY OTHER KEY IS INVALID                                    DTSCS7D
00594 *-----------------------------------------------------            DTSCS7D
00595                                                                   DTSCS7D
00596      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS7D
00597                                                                   DTSCS7D
00598      SET REQ-ERROR TO TRUE.                                       DTSCS7D
00599  P1000-EXIT.                                                      DTSCS7D
00600      EXIT.                                                        DTSCS7D
00601                                                                   DTSCS7D
00602 ******************************************************************DTSCS7D
00603 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS7D
00604 ******************************************************************DTSCS7D
00605                                                                   DTSCS7D
00606  P1100-UPDATE-LOCKED.                                             DTSCS7D
00607                                                                   DTSCS7D
00608 *-----------------------------------------------------            DTSCS7D
00609 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS7D
00610 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F9             DTSCS7D
00611 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS7D
00612 *-----------------------------------------------------            DTSCS7D
00613                                                                   DTSCS7D
00614      IF LCCM-ENTER-88 OR LCCM-F12-88 OR LCCM-F09-88               DTSCS7D
00615         SET REQ-UPDATE TO TRUE                                    DTSCS7D
00616         IF LCCM-F09-88                                            DTSCS7D
00617            SET LCCM-ENTER-88 TO TRUE                              DTSCS7D
00618         END-IF                                                    DTSCS7D
00619      ELSE                                                         DTSCS7D
00620         SET REQ-ERROR TO TRUE                                     DTSCS7D
00621         IF LCCM-SCR-ADD-LOCKED                                    DTSCS7D
00622            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS7D
00623         ELSE                                                      DTSCS7D
00624            GO TO S899-ABEND.                                      DTSCS7D
00625  P1100-EXIT.                                                      DTSCS7D
00626      EXIT.                                                        DTSCS7D
00627 ******************************************************************DTSCS7D
00628 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS7D
00629 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS7D
00630 ******************************************************************DTSCS7D
00631                                                                   DTSCS7D
00632  P2000-REQUEST-ERROR.                                             DTSCS7D
00633      IF LCCM-MSG                                                  DTSCS7D
00634         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS7D
00635      ELSE                                                         DTSCS7D
00636         GO TO S899-ABEND.                                         DTSCS7D
00637  P2000-EXIT.                                                      DTSCS7D
00638      EXIT.                                                        DTSCS7D
00639 ******************************************************************DTSCS7D
00640 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS7D
00641 ******************************************************************DTSCS7D
00642                                                                   DTSCS7D
00643  P3000-REQUEST-JUMP.                                              DTSCS7D
00644                                                                   DTSCS7D
00645 *-----------------------------------------------------            DTSCS7D
00646 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS7D
00647 *    BY USER                                                      DTSCS7D
00648 *-----------------------------------------------------            DTSCS7D
00649                                                                   DTSCS7D
00650      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS7D
00651                                                                   DTSCS7D
00652 *-----------------------------------------------------            DTSCS7D
00653 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS7D
00654 *-----------------------------------------------------            DTSCS7D
00655                                                                   DTSCS7D
00656      IF LCCM-MSG                                                  DTSCS7D
00657         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS7D
00658         SET CURSOR-SET-GOTO TO TRUE                               DTSCS7D
00659         GO TO P3000-EXIT.                                         DTSCS7D
00660                                                                   DTSCS7D
00661      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS7D
00662                                                                   DTSCS7D
00663      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS7D
00664                                                                   DTSCS7D
00665      IF L018-VALID                                                DTSCS7D
00666          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS7D
00667                                                                   DTSCS7D
00668 *-----------------------------------------------------            DTSCS7D
00669 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS7D
00670 *-----------------------------------------------------            DTSCS7D
00671                                                                   DTSCS7D
00672      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS7D
00673                         LCCM-SCR-HOLD-AREA.                       DTSCS7D
00674                                                                   DTSCS7D
00675      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS7D
00676                                                                   DTSCS7D
00677      SET RESP-JUMP TO TRUE.                                       DTSCS7D
00678  P3000-EXIT.                                                      DTSCS7D
00679      EXIT.                                                        DTSCS7D
00680 ******************************************************************DTSCS7D
00681 * CLEAR KEY WAS PRESSED                                          *DTSCS7D
00682 ******************************************************************DTSCS7D
00683                                                                   DTSCS7D
00684  P4000-REQUEST-CLEAR.                                             DTSCS7D
00685      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS7D
00686                                                                   DTSCS7D
00687      IF SCR-ACCESS-UPDATE                                         DTSCS7D
00688          PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT           DTSCS7D
00689      ELSE                                                         DTSCS7D
00690          PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT.             DTSCS7D
00691                                                                   DTSCS7D
00692 *-----------------------------------------------------            DTSCS7D
00693 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS7D
00694 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS7D
00695 *-----------------------------------------------------            DTSCS7D
00696                                                                   DTSCS7D
00697      IF LCCM-EMP-NO > ZERO                                        DTSCS7D
00698          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS7D
00699          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS7D
00700                                                                   DTSCS7D
00701      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS7D
00702                                                                   DTSCS7D
00703      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS7D
00704                                                                   DTSCS7D
00705      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS7D
00706                                                                   DTSCS7D
00707      SET RESP-SEND-MAP TO TRUE.                                   DTSCS7D
00708  P4000-EXIT.                                                      DTSCS7D
00709      EXIT.                                                        DTSCS7D
00710                                                                   DTSCS7D
00711 ******************************************************************DTSCS7D
00712 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS7D
00713 ******************************************************************DTSCS7D
00714                                                                   DTSCS7D
00715  P5000-CURSOR-TO-GOTO.                                            DTSCS7D
00716      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS7D
00717                                                                   DTSCS7D
00718      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS7D
00719  P5000-EXIT.                                                      DTSCS7D
00720      EXIT.                                                        DTSCS7D
00721                                                                   DTSCS7D
00722 ******************************************************************DTSCS7D
00723 * INQUIRY WAS REQUESTED                                          *DTSCS7D
00724 ******************************************************************DTSCS7D
00725                                                                   DTSCS7D
00726  P6000-REQUEST-INQUIRE.                                           DTSCS7D
00727      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS7D
00728                                                                   DTSCS7D
00729      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS7D
00730                                                                   DTSCS7D
00731      SET RESP-SEND-MAP TO TRUE.                                   DTSCS7D
00732                                                                   DTSCS7D
00733      IF SCR-ACCESS-UPDATE                                         DTSCS7D
00734          PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT           DTSCS7D
00735      ELSE                                                         DTSCS7D
00736          PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT.             DTSCS7D
00737                                                                   DTSCS7D
00738      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS7D
00739  P6000-EXIT.                                                      DTSCS7D
00740      EXIT.                                                        DTSCS7D
00741                                                                   DTSCS7D
00742 ******************************************************************DTSCS7D
00743 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED.                    *DTSCS7D
00744 ******************************************************************DTSCS7D
00745                                                                   DTSCS7D
00746  P7000-REQUEST-EDIT.                                              DTSCS7D
00747      PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT.              DTSCS7D
00748                                                                   DTSCS7D
00749      IF LCCM-F09-88                                               DTSCS7D
00750         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS7D
00751      ELSE                                                         DTSCS7D
00752         GO TO S899-ABEND.                                         DTSCS7D
00753                                                                   DTSCS7D
00754 *------------------------------------------------------           DTSCS7D
00755 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS7D
00756 *  IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST         DTSCS7D
00757 *  REMAIN IN 'CLEAR' STATUS.                                      DTSCS7D
00758 *------------------------------------------------------           DTSCS7D
00759                                                                   DTSCS7D
00760      IF LCCM-MSG                                                  DTSCS7D
00761         NEXT SENTENCE                                             DTSCS7D
00762      ELSE                                                         DTSCS7D
00763         PERFORM S8100-SET-LOCK-ATTRB THRU S8100-EXIT              DTSCS7D
00764         IF LCCM-F09-88                                            DTSCS7D
00765            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS7D
00766            MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID.              DTSCS7D
00767                                                                   DTSCS7D
00768      SET RESP-SEND-MAP TO TRUE.                                   DTSCS7D
00769                                                                   DTSCS7D
00770  P7000-EXIT.                                                      DTSCS7D
00771      EXIT.                                                        DTSCS7D
00772 ******************************************************************DTSCS7D
00773 * ADD FUNCTION WAS REQUESTED                                     *DTSCS7D
00774 ******************************************************************DTSCS7D
00775                                                                   DTSCS7D
00776  P7100-EDIT-ADD.                                                  DTSCS7D
00777 *-----------------------------------------------------            DTSCS7D
00778 *    ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE           DTSCS7D
00779 *    MAP-EMP-NO IS REQUIRED UNLESS MAP EMPLOYER NAME AND          DTSCS7D
00780 *    ADDRESS ARE ENTERED.  IF BOTH ARE ENTERED, DISPLAY           DTSCS7D
00781 *    ERROR MESSAGE.                                               DTSCS7D
00782 *-----------------------------------------------------            DTSCS7D
00783                                                                   DTSCS7D
00784      IF MAP-EMP-NO-1 GREATER SPACES                               DTSCS7D
00785      OR MAP-EMP-NO-2 GREATER SPACES                               DTSCS7D
00786         PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                   DTSCS7D
00787                                                                   DTSCS7D
00788      IF LCCM-MSG                                                  DTSCS7D
00789          GO TO P7100-EXIT.                                        DTSCS7D
00790                                                                   DTSCS7D
00791      MOVE MAP-FINL-IND-OK TO WRK-FINL-IND-OK.                     DTSCS7D
00792                                                                   DTSCS7D
00793      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS7D
00794      IF LCCM-MSG                                                  DTSCS7D
00795          GO TO P7100-EXIT.                                        DTSCS7D
00796                                                                   DTSCS7D
00797      IF MAP-MAIL-LABEL EQUAL 'L'                                  DTSCS7D
00798         MOVE L081-CLAIMANT-NAME   TO MAP-DE-NAME                  DTSCS7D
00799         MOVE SPACES               TO MAP-DE-ADDR1                 DTSCS7D
00800         MOVE SPACES               TO MAP-DE-ADDR2                 DTSCS7D
00801         MOVE SPACES               TO MAP-DE-CITY                  DTSCS7D
00802         MOVE SPACES               TO MAP-DE-STATE                 DTSCS7D
00803         MOVE SPACES               TO MAP-DE-ZIP                   DTSCS7D
00804         MOVE SPACES               TO MAP-DE-ATTN.                 DTSCS7D
00805                                                                   DTSCS7D
00806  P7100-EXIT.                                                      DTSCS7D
00807      EXIT.                                                        DTSCS7D
00808 ******************************************************************DTSCS7D
00809 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS7D
00810 ******************************************************************DTSCS7D
00811                                                                   DTSCS7D
00812  P8000-REQUEST-UPDATE.                                            DTSCS7D
00813      IF LCCM-SCR-ADD-LOCKED                                       DTSCS7D
00814         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS7D
00815      ELSE                                                         DTSCS7D
00816         GO TO S899-ABEND.                                         DTSCS7D
00817                                                                   DTSCS7D
00818      SET RESP-SEND-MAP TO TRUE.                                   DTSCS7D
00819  P8000-EXIT.                                                      DTSCS7D
00820      EXIT.                                                        DTSCS7D
00821                                                                   DTSCS7D
00822  P8100-ADD.                                                       DTSCS7D
00823      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS7D
00824                                                                   DTSCS7D
00825      PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT.              DTSCS7D
00826                                                                   DTSCS7D
00827      IF LCCM-F12-88                                               DTSCS7D
00828         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS7D
00829         GO TO P8100-EXIT.                                         DTSCS7D
00830                                                                   DTSCS7D
00831      IF  MAP-EMP-NO-1 NOT GREATER SPACES                          DTSCS7D
00832      AND MAP-EMP-NO-2 NOT GREATER SPACES                          DTSCS7D
00833      OR  MAP-MAIL-LABEL EQUAL 'L'                                 DTSCS7D
00834         GO TO P8100-ADD-1.                                        DTSCS7D
00835                                                                   DTSCS7D
00836      PERFORM S1100-EDIT-KEY  THRU S1100-EXIT.                     DTSCS7D
00837      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS7D
00838      MOVE ALL '?' TO WRK-MAILING-ADDRESS-AREA.                    DTSCS7D
00839                                                                   DTSCS7D
00840      MOVE MPRF-PRIMARY-NAME  TO L112-PRIMARY-NAME,                DTSCS7D
00841                                 L112-NAME.                        DTSCS7D
00842      MOVE MTAD-ADDRESS       TO L112-ADDRESS.                     DTSCS7D
00843                                                                   DTSCS7D
00844      GO TO P8100-ADD-2.                                           DTSCS7D
00845                                                                   DTSCS7D
00846  P8100-ADD-1.                                                     DTSCS7D
00847      MOVE MAP-DE-NAME        TO L112-PRIMARY-NAME,                DTSCS7D
00848                                 L112-NAME.                        DTSCS7D
00849      MOVE MAP-DE-ADDR1       TO L112-DELIV-LINE-1.                DTSCS7D
00850      MOVE MAP-DE-ADDR2       TO L112-DELIV-LINE-2.                DTSCS7D
00851      MOVE MAP-DE-CITY        TO L112-CITY.                        DTSCS7D
00852      MOVE MAP-DE-STATE       TO L112-ST.                          DTSCS7D
00853      MOVE MAP-DE-ZIP         TO L112-ZIP.                         DTSCS7D
00854      MOVE MAP-DE-ATTN        TO L112-ATTN-LINE.                   DTSCS7D
00855      MOVE SPACES             TO L112-ADVANCED-BARCODE.            DTSCS7D
00856                                                                   DTSCS7D
00857  P8100-ADD-2.                                                     DTSCS7D
00858      SET L112-TAD-ADDR-88     TO TRUE.                            DTSCS7D
00859      SET L112-ANCHOR-FIRST-88 TO TRUE.                            DTSCS7D
00860                                                                   DTSCS7D
00861      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS7D
00862                                                                   DTSCS7D
00863      MOVE L112-MAILING-ADDRESS  TO WRK-MAILING-ADDRESS.           DTSCS7D
00864      MOVE L112-ZIP              TO WRK-ZIP.                       DTSCS7D
00865      MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE.          DTSCS7D
00866                                                                   DTSCS7D
00867      IF MAP-MAIL-LABEL EQUAL 'L' OR 'Y'                           DTSCS7D
00868         PERFORM P8910-R901-RECORD THRU P8910-EXIT.                DTSCS7D
00869                                                                   DTSCS7D
00870      IF MAP-MAIL-LABEL NOT EQUAL 'L'                              DTSCS7D
00871         PERFORM P8980-R751-RECORD THRU P8980-EXIT.                DTSCS7D
00872                                                                   DTSCS7D
00873      MOVE LOW-VALUES    TO MAP-AREA.                              DTSCS7D
00874      PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT.              DTSCS7D
00875      IF LCCM-EMP-NO GREATER ZEROS                                 DTSCS7D
00876         MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                        DTSCS7D
00877         MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                       DTSCS7D
00878                                                                   DTSCS7D
00879      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS7D
00880      MOVE ZEROS               TO LCCM-EMP-NO.                     DTSCS7D
00881                                                                   DTSCS7D
00882      IF  MAP-MAIL-LABEL NOT GREATER SPACES                        DTSCS7D
00883      AND WRK-NO-DEFAULT NOT EQUAL 'Y'                             DTSCS7D
00884          MOVE 'Y' TO MAP-MAIL-LABEL.                              DTSCS7D
00885  P8100-EXIT.                                                      DTSCS7D
00886      EXIT.                                                        DTSCS7D
00887                                                                   DTSCS7D
00888 *****                                                             DTSCS7D
00889 *    MACIR901    LABEL REPORT RECORD.                             DTSCS7D
00890 *****                                                             DTSCS7D
00891  P8910-R901-RECORD.                                               DTSCS7D
00892      SET R901-ON-REQUEST-88 TO TRUE.                              DTSCS7D
00893                                                                   DTSCS7D
00894      MOVE LOW-VALUES TO R901-SORT-VAR-AREA.                       DTSCS7D
00895                                                                   DTSCS7D
00896      MOVE +01      TO R901-LABEL-CNT.                             DTSCS7D
00897                                                                   DTSCS7D
00898      MOVE LCCM-RESP-OP-ID TO R901-GRP1-OP-ID.                     DTSCS7D
00899                                                                   DTSCS7D
00900      MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO                          DTSCS7D
00901                         R901-EMP-NO.                              DTSCS7D
00902                                                                   DTSCS7D
00903      MOVE WRK-MAILING-ADDRESS TO R901-FMT-ADDR.                   DTSCS7D
00904                                                                   DTSCS7D
00905      MOVE WRK-ZIP TO R901-ZIP.                                    DTSCS7D
00906                                                                   DTSCS7D
00907      MOVE WRK-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE.          DTSCS7D
00908                                                                   DTSCS7D
00909      MOVE LENGTH OF R901-REC TO R901-LENGTH.                      DTSCS7D
00910                                                                   DTSCS7D
00911      MOVE R901-REC TO RSKL-REC.                                   DTSCS7D
00912                                                                   DTSCS7D
00913      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS7D
00914  P8910-EXIT.                                                      DTSCS7D
00915      EXIT.                                                        DTSCS7D
00916                                                                   DTSCS7D
00917 *****                                                             DTSCS7D
00918 *    MACIR901    ELF LABEL REPORT RECORD.                         DTSCS7D
00919 *****                                                             DTSCS7D
00920                                                                   DTSCS7D
00921  P8980-R751-RECORD.                                               DTSCS7D
00922      MOVE WRK-EMP-NO         TO R751-EMP-NO.                      DTSCS7D
00923      IF WRK-EMP-NO GREATER ZEROS                                  DTSCS7D
00924         MOVE MPRF-PRIMARY-NAME TO R751-EMP-PRIMARY-NAME           DTSCS7D
00925      ELSE                                                         DTSCS7D
00926         MOVE MAP-DE-NAME       TO R751-EMP-PRIMARY-NAME.          DTSCS7D
00927                                                                   DTSCS7D
00928      MOVE MAP-SSN-AREA TO L020-S-SSN-AREA.                        DTSCS7D
00929      PERFORM S020-SCREEN-SSN THRU S020-EXIT.                      DTSCS7D
00930      MOVE L020-SSN  TO R751-SSN.                                  DTSCS7D
00931                                                                   DTSCS7D
00932      MOVE MAP-CLAIMANT-NAME   TO R751-CLAIMANT-NAME.              DTSCS7D
00933      MOVE LCCM-OP-NAME        TO R751-OP-NAME.                    DTSCS7D
00934      MOVE LCCM-CURR-MAIL-DATE TO R751-MAIL-DATE.                  DTSCS7D
00935      MOVE LENGTH OF R751-REC  TO R751-LENGTH.                     DTSCS7D
00936                                                                   DTSCS7D
00937      IF MAP-WR-YRQ1-YR GREATER SPACES                             DTSCS7D
00938         MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA                  DTSCS7D
00939         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS7D
00940         MOVE L016-YRQ TO R751-YRQ                                 DTSCS7D
00941         MOVE R751-REC TO RSKL-REC                                 DTSCS7D
00942         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS7D
00943                                                                   DTSCS7D
00944      IF MAP-WR-YRQ2-YR GREATER SPACES                             DTSCS7D
00945         MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA                  DTSCS7D
00946         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS7D
00947         MOVE L016-YRQ TO R751-YRQ                                 DTSCS7D
00948         MOVE R751-REC TO RSKL-REC                                 DTSCS7D
00949         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS7D
00950                                                                   DTSCS7D
00951      IF MAP-WR-YRQ3-YR GREATER SPACES                             DTSCS7D
00952         MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA                  DTSCS7D
00953         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS7D
00954         MOVE L016-YRQ TO R751-YRQ                                 DTSCS7D
00955         MOVE R751-REC TO RSKL-REC                                 DTSCS7D
00956         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS7D
00957                                                                   DTSCS7D
00958      IF MAP-WR-YRQ4-YR GREATER SPACES                             DTSCS7D
00959         MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA                  DTSCS7D
00960         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS7D
00961         MOVE L016-YRQ TO R751-YRQ                                 DTSCS7D
00962         MOVE R751-REC TO RSKL-REC                                 DTSCS7D
00963         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS7D
00964                                                                   DTSCS7D
00965  P8980-EXIT.                                                      DTSCS7D
00966      EXIT.                                                        DTSCS7D
00967                                                                   DTSCS7D
00968 ******************************************************************DTSCS7D
00969 * LINKS TO UTILITY MODULES                                        DTSCS7D
00970 ******************************************************************DTSCS7D
00971                                                                   DTSCS7D
00972  S001-FROM-FED-8.                                                 DTSCS7D
00973      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS7D
00974      GO TO S001-LINK.                                             DTSCS7D
00975                                                                   DTSCS7D
00976  S001-FROM-ABS-DAY.                                               DTSCS7D
00977      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS7D
00978      GO TO S001-LINK.                                             DTSCS7D
00979                                                                   DTSCS7D
00980  S001-LINK.                                                       DTSCS7D
00981      EXEC CICS LINK                                               DTSCS7D
00982          PROGRAM  ('DTSCU001')                                    DTSCS7D
00983          COMMAREA (L001-COMM-AREA)                                DTSCS7D
00984      END-EXEC.                                                    DTSCS7D
00985  S001-EXIT.                                                       DTSCS7D
00986      EXIT.                                                        DTSCS7D
00987                                                                   DTSCS7D
00988  S004-FROM-5.                                                     DTSCS7D
00989      SET L004-FROM-5 TO TRUE.                                     DTSCS7D
00990      GO TO S004-LINK.                                             DTSCS7D
00991                                                                   DTSCS7D
00992  S004-FROM-DATE.                                                  DTSCS7D
00993      SET L004-FROM-DATE TO TRUE.                                  DTSCS7D
00994      GO TO S004-LINK.                                             DTSCS7D
00995                                                                   DTSCS7D
00996  S004-FROM-ABS.                                                   DTSCS7D
00997      SET L004-FROM-ABS TO TRUE.                                   DTSCS7D
00998      GO TO S004-LINK.                                             DTSCS7D
00999                                                                   DTSCS7D
01000  S004-LINK.                                                       DTSCS7D
01001      EXEC CICS LINK                                               DTSCS7D
01002          PROGRAM  ('DTSCU004')                                    DTSCS7D
01003          COMMAREA (L004-COMM-AREA)                                DTSCS7D
01004      END-EXEC.                                                    DTSCS7D
01005  S004-EXIT.                                                       DTSCS7D
01006      EXIT.                                                        DTSCS7D
01007                                                                   DTSCS7D
01008  S006-LINK.                                                       DTSCS7D
01009      EXEC CICS LINK                                               DTSCS7D
01010          PROGRAM ('DTSCU006')                                     DTSCS7D
01011          COMMAREA (L006-COMM-AREA)                                DTSCS7D
01012      END-EXEC.                                                    DTSCS7D
01013  S006-EXIT.                                                       DTSCS7D
01014      EXIT.                                                        DTSCS7D
01015                                                                   DTSCS7D
01016  S016-YRQ-FROM-SCREEN.                                            DTSCS7D
01017      EXEC CICS LINK                                               DTSCS7D
01018          PROGRAM('DTSCU016')                                      DTSCS7D
01019          COMMAREA(L016-COMM-AREA)                                 DTSCS7D
01020      END-EXEC.                                                    DTSCS7D
01021  S016-EXIT.                                                       DTSCS7D
01022      EXIT.                                                        DTSCS7D
01023                                                                   DTSCS7D
01024  S018-EMP-NO-FROM-SCREEN.                                         DTSCS7D
01025      EXEC CICS LINK                                               DTSCS7D
01026          PROGRAM('DTSCU018')                                      DTSCS7D
01027          COMMAREA(L018-COMM-AREA)                                 DTSCS7D
01028      END-EXEC.                                                    DTSCS7D
01029  S018-EXIT.                                                       DTSCS7D
01030      EXIT.                                                        DTSCS7D
01031                                                                   DTSCS7D
01032  S020-SCREEN-SSN.                                                 DTSCS7D
01033      EXEC CICS LINK                                               DTSCS7D
01034          PROGRAM  ('DTSCU020')                                    DTSCS7D
01035          COMMAREA (L020-COMM-AREA)                                DTSCS7D
01036      END-EXEC.                                                    DTSCS7D
01037  S020-EXIT.                                                       DTSCS7D
01038      EXIT.                                                        DTSCS7D
01039                                                                   DTSCS7D
01040  S072-EDIT-ADDRESS.                                               DTSCS7D
01041      EXEC CICS LINK                                               DTSCS7D
01042          PROGRAM  ('DTSCU072')                                    DTSCS7D
01043          COMMAREA (L072-COMM-AREA)                                DTSCS7D
01044      END-EXEC.                                                    DTSCS7D
01045  S072-EXIT.                                                       DTSCS7D
01046      EXIT.                                                        DTSCS7D
01047                                                                   DTSCS7D
01048  S081-CLAIMANT-NAME-LOOKUP.                                       DTSCS7D
01049      EXEC CICS LINK                                               DTSCS7D
01050          PROGRAM('DTSCU081')                                      DTSCS7D
01051          COMMAREA(L081-COMM-AREA)                                 DTSCS7D
01052      END-EXEC.                                                    DTSCS7D
01053                                                                   DTSCS7D
01054      IF L081-FILE-CLOSED                                          DTSCS7D
01055          MOVE L081-MSG-AREA TO LCCM-MSG-AREA                      DTSCS7D
01056          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS7D
01057          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS7D
01058          GO TO MAINLINE-EXIT.                                     DTSCS7D
01059  S081-EXIT.                                                       DTSCS7D
01060      EXIT.                                                        DTSCS7D
01061                                                                   DTSCS7D
01062 *S081A-CONVERT-CLAIMANT-NAME.                                     DTSCS7D
01063 *                                                                 DTSCS7D
01064 *    EXEC CICS LINK                                               DTSCS7D
01065 *       PROGRAM('ESP072D')                                        DTSCS7D
01066 *       COMMAREA(ESP072D-COMM-AREA)                               DTSCS7D
01067 *       LENGTH(COM-LEN)                                           DTSCS7D
01068 *    END-EXEC.                                                    DTSCS7D
01069                                                                   DTSCS7D
01070 *S081A-EXIT.                                                      DTSCS7D
01071      EXIT.                                                        DTSCS7D
01072                                                                   DTSCS7D
01073  S112-ADDR-FORMAT.                                                DTSCS7D
01074      EXEC CICS LINK                                               DTSCS7D
01075          PROGRAM('DTSCU112')                                      DTSCS7D
01076          COMMAREA(L112-COMM-AREA)                                 DTSCS7D
01077      END-EXEC.                                                    DTSCS7D
01078  S112-EXIT.                                                       DTSCS7D
01079      EXIT.                                                        DTSCS7D
01080                                                                   DTSCS7D
01081  S803-REQ-SCR-ID-EDIT.                                            DTSCS7D
01082      EXEC CICS LINK                                               DTSCS7D
01083          PROGRAM ('DTSCU803')                                     DTSCS7D
01084          COMMAREA (DFHCOMMAREA)                                   DTSCS7D
01085      END-EXEC.                                                    DTSCS7D
01086  S803-EXIT.                                                       DTSCS7D
01087      EXIT.                                                        DTSCS7D
01088                                                                   DTSCS7D
01089  S804-INVALID-KEY.                                                DTSCS7D
01090      EXEC CICS LINK                                               DTSCS7D
01091          PROGRAM ('DTSCU804')                                     DTSCS7D
01092          COMMAREA (DFHCOMMAREA)                                   DTSCS7D
01093      END-EXEC.                                                    DTSCS7D
01094  S804-EXIT.                                                       DTSCS7D
01095      EXIT.                                                        DTSCS7D
01096                                                                   DTSCS7D
01097  S805-MSG-AREA.                                                   DTSCS7D
01098      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS7D
01099                                                                   DTSCS7D
01100      EXEC CICS LINK                                               DTSCS7D
01101          PROGRAM ('DTSCU805')                                     DTSCS7D
01102          COMMAREA (L805-COMM-AREA)                                DTSCS7D
01103      END-EXEC.                                                    DTSCS7D
01104                                                                   DTSCS7D
01105      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS7D
01106  S805-EXIT.                                                       DTSCS7D
01107      EXIT.                                                        DTSCS7D
01108                                                                   DTSCS7D
01109  S810-READ.                                                       DTSCS7D
01110      SET L810-READ-88 TO TRUE.                                    DTSCS7D
01111      GO TO S810-IO.                                               DTSCS7D
01112                                                                   DTSCS7D
01113  S810-START-BROWSE.                                               DTSCS7D
01114      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS7D
01115      GO TO S810-IO.                                               DTSCS7D
01116                                                                   DTSCS7D
01117  S810-READ-NEXT.                                                  DTSCS7D
01118      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS7D
01119      GO TO S810-IO.                                               DTSCS7D
01120                                                                   DTSCS7D
01121  S810-READ-PREV.                                                  DTSCS7D
01122      SET L810-READ-PREV-88 TO TRUE.                               DTSCS7D
01123      GO TO S810-IO.                                               DTSCS7D
01124                                                                   DTSCS7D
01125  S810-END-BROWSE.                                                 DTSCS7D
01126      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS7D
01127      GO TO S810-IO.                                               DTSCS7D
01128                                                                   DTSCS7D
01129  S810-COUNT.                                                      DTSCS7D
01130      SET L810-COUNT-88 TO TRUE.                                   DTSCS7D
01131      GO TO S810-IO.                                               DTSCS7D
01132                                                                   DTSCS7D
01133  S810-IO.                                                         DTSCS7D
01134      EXEC CICS LINK                                               DTSCS7D
01135          PROGRAM ('DTSCU810')                                     DTSCS7D
01136          COMMAREA (L810-COMM-AREA)                                DTSCS7D
01137      END-EXEC.                                                    DTSCS7D
01138                                                                   DTSCS7D
01139      IF L810-FILE-CLOSED-88                                       DTSCS7D
01140          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS7D
01141          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS7D
01142          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS7D
01143          GO TO MAINLINE-EXIT.                                     DTSCS7D
01144  S810-EXIT.                                                       DTSCS7D
01145      EXIT.                                                        DTSCS7D
01146                                                                   DTSCS7D
01147  S825-WRITE.                                                      DTSCS7D
01148      SET L825-WRITE-88 TO TRUE.                                   DTSCS7D
01149      GO TO S825-O.                                                DTSCS7D
01150                                                                   DTSCS7D
01151  S825-O.                                                          DTSCS7D
01152                                                                   DTSCS7D
01153      EXEC CICS LINK                                               DTSCS7D
01154          PROGRAM ('DTSCU825')                                     DTSCS7D
01155          COMMAREA (L825-COMM-AREA)                                DTSCS7D
01156      END-EXEC.                                                    DTSCS7D
01157                                                                   DTSCS7D
01158      IF L825-FILE-CLOSED-88                                       DTSCS7D
01159          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS7D
01160          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS7D
01161          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS7D
01162          GO TO MAINLINE-EXIT.                                     DTSCS7D
01163  S825-EXIT.                                                       DTSCS7D
01164      EXIT.                                                        DTSCS7D
01165                                                                   DTSCS7D
01166  S851-SCREEN-PROCESSING.                                          DTSCS7D
01167      EXEC CICS LINK                                               DTSCS7D
01168          PROGRAM ('DTSCU851')                                     DTSCS7D
01169          COMMAREA (L851-COMM-AREA)                                DTSCS7D
01170      END-EXEC.                                                    DTSCS7D
01171  S851-EXIT.                                                       DTSCS7D
01172      EXIT.                                                        DTSCS7D
01173                                                                   DTSCS7D
01174  S899-ABEND.                                                      DTSCS7D
01175      EXEC CICS ABEND                                              DTSCS7D
01176          ABCODE(WRK-ABEND-CD)                                     DTSCS7D
01177      END-EXEC.                                                    DTSCS7D
01178  S899-EXIT.                                                       DTSCS7D
01179      EXIT.                                                        DTSCS7D
01180                                                                   DTSCS7D
01181 ******************************************************************DTSCS7D
01182 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS7D
01183 ******************************************************************DTSCS7D
01184                                                                   DTSCS7D
01185  S1000-SCREEN-EDITS.                                              DTSCS7D
01186      PERFORM S2600-WAGE-REQUEST THRU S2600-EXIT.                  DTSCS7D
01187                                                                   DTSCS7D
01188      IF LCCM-MSG                                                  DTSCS7D
01189          GO TO S1000-EXIT.                                        DTSCS7D
01190                                                                   DTSCS7D
01191      IF MAP-SSN-1 NOT GREATER SPACES                              DTSCS7D
01192         MOVE MSG-E7D1-AREA TO WRK-MSG-AREA                        DTSCS7D
01193         PERFORM S1195-ERROR THRU S1195-EXIT                       DTSCS7D
01194         GO TO S1000-EXIT.                                         DTSCS7D
01195                                                                   DTSCS7D
01196      IF MAP-MAIL-LABEL NOT EQUAL 'Y' AND 'N' AND 'L'              DTSCS7D
01197         MOVE 'Y'           TO WRK-NO-DEFAULT                      DTSCS7D
01198         MOVE MSG-E7D6-AREA TO WRK-MSG-AREA                        DTSCS7D
01199         PERFORM S1197-ERROR THRU S1197-EXIT                       DTSCS7D
01200         GO TO S1000-EXIT.                                         DTSCS7D
01201                                                                   DTSCS7D
01202  S1000-SE-1.                                                      DTSCS7D
01203      IF MAP-MAIL-LABEL EQUAL 'L'                                  DTSCS7D
01204         IF  MAP-EMP-NO-1   GREATER SPACES                         DTSCS7D
01205         OR  MAP-EMP-NO-2   GREATER SPACES                         DTSCS7D
01206         OR  MAP-DE-NAME    GREATER SPACES                         DTSCS7D
01207         AND MAP-DE-NAME    NOT EQUAL L081-CLAIMANT-NAME           DTSCS7D
01208         OR  MAP-DE-ADDR1   GREATER SPACES                         DTSCS7D
01209         AND MAP-DE-ADDR1   NOT EQUAL L081-CLAIMANT-STREET         DTSCS7D
01210         OR  MAP-DE-ADDR2   GREATER SPACES                         DTSCS7D
01211         OR  MAP-DE-CITY    GREATER SPACES                         DTSCS7D
01212         AND MAP-DE-CITY    NOT EQUAL L081-CLAIMANT-CITY           DTSCS7D
01213         OR  MAP-DE-STATE   GREATER SPACES                         DTSCS7D
01214         AND MAP-DE-STATE   NOT EQUAL L081-CLAIMANT-STATE          DTSCS7D
01215         OR  MAP-DE-ZIP     GREATER SPACES                         DTSCS7D
01216         AND MAP-DE-ZIP     NOT EQUAL L081-CLAIMANT-ZIP (1:5)      DTSCS7D
01217         OR  MAP-DE-ATTN    GREATER SPACES                         DTSCS7D
01218         OR  MAP-WR-YRQ1-YR GREATER SPACES                         DTSCS7D
01219         OR  MAP-WR-YRQ1-Q  GREATER SPACES                         DTSCS7D
01220         OR  MAP-WR-YRQ2-YR GREATER SPACES                         DTSCS7D
01221         OR  MAP-WR-YRQ2-Q  GREATER SPACES                         DTSCS7D
01222         OR  MAP-WR-YRQ3-YR GREATER SPACES                         DTSCS7D
01223         OR  MAP-WR-YRQ3-Q  GREATER SPACES                         DTSCS7D
01224         OR  MAP-WR-YRQ4-YR GREATER SPACES                         DTSCS7D
01225         OR  MAP-WR-YRQ4-Q  GREATER SPACES                         DTSCS7D
01226            MOVE MSG-E7D9-AREA TO WRK-MSG-AREA                     DTSCS7D
01227            PERFORM S1194-ERROR THRU S1194-EXIT                    DTSCS7D
01228            GO TO S1000-EXIT                                       DTSCS7D
01229         ELSE                                                      DTSCS7D
01230            GO TO S1000-EXIT.                                      DTSCS7D
01231                                                                   DTSCS7D
01232      IF  MAP-EMP-NO-1   NOT GREATER SPACES                        DTSCS7D
01233      AND MAP-EMP-NO-2   NOT GREATER SPACES                        DTSCS7D
01234      AND MAP-DE-NAME    NOT GREATER SPACES                        DTSCS7D
01235      AND MAP-DE-ADDR1   NOT GREATER SPACES                        DTSCS7D
01236      AND MAP-DE-ADDR2   NOT GREATER SPACES                        DTSCS7D
01237      AND MAP-DE-CITY    NOT GREATER SPACES                        DTSCS7D
01238      AND MAP-DE-STATE   NOT GREATER SPACES                        DTSCS7D
01239      AND MAP-DE-ZIP     NOT GREATER SPACES                        DTSCS7D
01240      AND MAP-DE-ATTN    NOT GREATER SPACES                        DTSCS7D
01241         MOVE MSG-E7D3-AREA TO WRK-MSG-AREA                        DTSCS7D
01242         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS7D
01243         GO TO S1000-EXIT.                                         DTSCS7D
01244                                                                   DTSCS7D
01245      IF (MAP-EMP-NO-1   GREATER SPACES                            DTSCS7D
01246      OR  MAP-EMP-NO-2   GREATER SPACES)                           DTSCS7D
01247      AND (MAP-DE-NAME   GREATER SPACES                            DTSCS7D
01248      OR  MAP-DE-ADDR1   GREATER SPACES                            DTSCS7D
01249      OR  MAP-DE-ADDR1   GREATER SPACES                            DTSCS7D
01250      OR  MAP-DE-CITY    GREATER SPACES                            DTSCS7D
01251      OR  MAP-DE-STATE   GREATER SPACES                            DTSCS7D
01252      OR  MAP-DE-ZIP     GREATER SPACES                            DTSCS7D
01253      OR  MAP-DE-ATTN    GREATER SPACES)                           DTSCS7D
01254         MOVE MSG-E7D4-AREA TO WRK-MSG-AREA                        DTSCS7D
01255         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS7D
01256         GO TO S1000-EXIT.                                         DTSCS7D
01257                                                                   DTSCS7D
01258      IF MAP-EMP-NO-1   GREATER SPACES                             DTSCS7D
01259      OR MAP-EMP-NO-2   GREATER SPACES                             DTSCS7D
01260          PERFORM S1110-READ-MPRF THRU S1110-EXIT                  DTSCS7D
01261          IF WRK-MPRF-NO-88                                        DTSCS7D
01262             MOVE MSG-E7D8-AREA TO WRK-MSG-AREA                    DTSCS7D
01263             PERFORM S1199-ERROR THRU S1199-EXIT                   DTSCS7D
01264             GO TO S1000-EXIT                                      DTSCS7D
01265          ELSE                                                     DTSCS7D
01266             MOVE WRK-EMP-NO TO LCCM-EMP-NO                        DTSCS7D
01267             GO TO S1000-EXIT.                                     DTSCS7D
01268                                                                   DTSCS7D
01269      IF MAP-MAIL-LABEL EQUAL 'N'                                  DTSCS7D
01270         IF MAP-DE-NAME GREATER SPACES                             DTSCS7D
01271            GO TO S1000-EXIT                                       DTSCS7D
01272         ELSE                                                      DTSCS7D
01273            MOVE MSG-E7D10-AREA TO WRK-MSG-AREA                    DTSCS7D
01274            PERFORM S1199-ERROR THRU S1199-EXIT                    DTSCS7D
01275            GO TO S1000-EXIT.                                      DTSCS7D
01276                                                                   DTSCS7D
01277      IF MAP-DE-NAME  NOT GREATER SPACES                           DTSCS7D
01278      OR MAP-DE-ADDR1 NOT GREATER SPACES                           DTSCS7D
01279      OR MAP-DE-CITY  NOT GREATER SPACES                           DTSCS7D
01280      OR MAP-DE-STATE NOT GREATER SPACES                           DTSCS7D
01281      OR MAP-DE-STATE NOT ALPHABETIC                               DTSCS7D
01282      OR MAP-DE-ZIP   NOT GREATER SPACES                           DTSCS7D
01283         MOVE MSG-E7D5-AREA TO WRK-MSG-AREA                        DTSCS7D
01284         PERFORM S1198-ERROR THRU S1198-EXIT                       DTSCS7D
01285         GO TO S1000-EXIT.                                         DTSCS7D
01286                                                                   DTSCS7D
01287      PERFORM S1200-FORMAT-FINALIST THRU S1200-EXIT.               DTSCS7D
01288                                                                   DTSCS7D
01289      IF L072-ADDRESS-VALID-88                                     DTSCS7D
01290         MOVE 'ADDRESS MADE STANDARD BY FINALIST' TO               DTSCS7D
01291              MAP-FINL-LITERAL.                                    DTSCS7D
01292                                                                   DTSCS7D
01293      IF L072-ADDRESS-VALID-88                                     DTSCS7D
01294      OR WRK-FINL-IND-OK EQUAL 'Y'                                 DTSCS7D
01295         MOVE L072-ATTN-LINE    TO MAP-DE-ATTN                     DTSCS7D
01296         MOVE L072-DELIV-LINE-1 TO MAP-DE-ADDR1                    DTSCS7D
01297         MOVE L072-DELIV-LINE-2 TO MAP-DE-ADDR2                    DTSCS7D
01298         MOVE L072-CITY         TO MAP-DE-CITY                     DTSCS7D
01299         MOVE L072-ST           TO MAP-DE-STATE                    DTSCS7D
01300         MOVE L072-ZIP (1:5)    TO MAP-DE-ZIP                      DTSCS7D
01301         MOVE L072-ZIP (7:4)    TO MAP-ZIP-W4                      DTSCS7D
01302      ELSE                                                         DTSCS7D
01303         MOVE MSG-E7D7-AREA TO WRK-MSG-AREA                        DTSCS7D
01304         PERFORM S1196-ERROR THRU S1196-EXIT.                      DTSCS7D
01305                                                                   DTSCS7D
01306  S1000-EXIT.                                                      DTSCS7D
01307      EXIT.                                                        DTSCS7D
01308                                                                   DTSCS7D
01309  S1100-EDIT-KEY.                                                  DTSCS7D
01310      PERFORM S1101-EMP-NO THRU S1101-EXIT.                        DTSCS7D
01311  S1100-EXIT.                                                      DTSCS7D
01312      EXIT.                                                        DTSCS7D
01313                                                                   DTSCS7D
01314  S1101-EMP-NO.                                                    DTSCS7D
01315      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS7D
01316                                                                   DTSCS7D
01317      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS7D
01318                                                                   DTSCS7D
01319      IF L018-NO-ENTRY                                             DTSCS7D
01320         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS7D
01321         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS7D
01322         GO TO S1101-EXIT.                                         DTSCS7D
01323                                                                   DTSCS7D
01324      IF L018-NOT-VALID                                            DTSCS7D
01325         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS7D
01326         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS7D
01327         GO TO S1101-EXIT.                                         DTSCS7D
01328                                                                   DTSCS7D
01329      MOVE L018-EMP-NO TO WRK-EMP-NO.                              DTSCS7D
01330  S1101-EXIT.                                                      DTSCS7D
01331      EXIT.                                                        DTSCS7D
01332                                                                   DTSCS7D
01333  S1110-READ-MPRF.                                                 DTSCS7D
01334      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS7D
01335                                                                   DTSCS7D
01336      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS7D
01337                                                                   DTSCS7D
01338      SET MPRF-PRF-88 TO TRUE.                                     DTSCS7D
01339                                                                   DTSCS7D
01340      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS7D
01341                                                                   DTSCS7D
01342      PERFORM S810-READ THRU S810-EXIT.                            DTSCS7D
01343                                                                   DTSCS7D
01344      IF L810-NO-REC-88                                            DTSCS7D
01345         SET WRK-MPRF-NO-88 TO TRUE                                DTSCS7D
01346      ELSE                                                         DTSCS7D
01347         MOVE MSKL-REC TO MPRF-REC                                 DTSCS7D
01348         SET WRK-MPRF-YES-88 TO TRUE                               DTSCS7D
01349         PERFORM S1120-READ-MTAD THRU S1120-EXIT.                  DTSCS7D
01350  S1110-EXIT.                                                      DTSCS7D
01351      EXIT.                                                        DTSCS7D
01352                                                                   DTSCS7D
01353  S1120-READ-MTAD.                                                 DTSCS7D
01354      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS7D
01355      MOVE WRK-EMP-NO TO MTAD-EMP-NO.                              DTSCS7D
01356      SET MTAD-TAD-88 TO TRUE.                                     DTSCS7D
01357      MOVE +001       TO MTAD-ID-NO.                               DTSCS7D
01358      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS7D
01359                                                                   DTSCS7D
01360      PERFORM S810-READ THRU S810-EXIT.                            DTSCS7D
01361      IF L810-NO-REC-88                                            DTSCS7D
01362         GO TO S899-ABEND.                                         DTSCS7D
01363                                                                   DTSCS7D
01364      MOVE MSKL-REC TO MTAD-REC.                                   DTSCS7D
01365  S1120-EXIT. EXIT.                                                DTSCS7D
01366                                                                   DTSCS7D
01367  S1194-ERROR.                                                     DTSCS7D
01368      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-LABEL-A.          DTSCS7D
01369                                                                   DTSCS7D
01370      MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA.                         DTSCS7D
01371      MOVE CATB-CURSOR   TO MAP-MAIL-LABEL-L.                      DTSCS7D
01372      SET CURSOR-SET-YES TO TRUE.                                  DTSCS7D
01373  S1194-EXIT.                                                      DTSCS7D
01374      EXIT.                                                        DTSCS7D
01375                                                                   DTSCS7D
01376  S1195-ERROR.                                                     DTSCS7D
01377      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A,              DTSCS7D
01378                                         MAP-SSN-2-A,              DTSCS7D
01379                                         MAP-SSN-3-A.              DTSCS7D
01380      MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA.                         DTSCS7D
01381      MOVE CATB-CURSOR   TO MAP-SSN-1-L.                           DTSCS7D
01382      SET CURSOR-SET-YES TO TRUE.                                  DTSCS7D
01383  S1195-EXIT.                                                      DTSCS7D
01384      EXIT.                                                        DTSCS7D
01385                                                                   DTSCS7D
01386  S1196-ERROR.                                                     DTSCS7D
01387      MOVE                                                         DTSCS7D
01388      'FINALIST COULD NOT CONFIRM ADDRESS, ACCEPT? (Y OR N)' TO    DTSCS7D
01389          MAP-FINL-LITERAL.                                        DTSCS7D
01390                                                                   DTSCS7D
01391      MOVE WRK-MSG-AREA               TO LCCM-MSG-AREA.            DTSCS7D
01392      MOVE CATB-CURSOR                TO MAP-FINL-IND-OK-L.        DTSCS7D
01393      MOVE CATB-ASKIP-NORM-MDTON      TO MAP-FINL-LITERAL-A.       DTSCS7D
01394      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-FINL-IND-OK-A.        DTSCS7D
01395      SET CURSOR-SET-YES TO TRUE.                                  DTSCS7D
01396  S1196-EXIT.                                                      DTSCS7D
01397      EXIT.                                                        DTSCS7D
01398                                                                   DTSCS7D
01399  S1197-ERROR.                                                     DTSCS7D
01400      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MAIL-LABEL-A.          DTSCS7D
01401                                                                   DTSCS7D
01402      IF LCCM-NO-MSG                                               DTSCS7D
01403         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01404         MOVE CATB-CURSOR TO MAP-MAIL-LABEL-L                      DTSCS7D
01405         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01406  S1197-EXIT.                                                      DTSCS7D
01407      EXIT.                                                        DTSCS7D
01408                                                                   DTSCS7D
01409  S1198-ERROR.                                                     DTSCS7D
01410      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DE-NAME-A             DTSCS7D
01411                                         MAP-DE-ADDR1-A            DTSCS7D
01412                                         MAP-DE-ADDR2-A            DTSCS7D
01413                                         MAP-DE-CITY-A             DTSCS7D
01414                                         MAP-DE-STATE-A            DTSCS7D
01415                                         MAP-DE-ZIP-A,             DTSCS7D
01416                                         MAP-DE-ATTN-A.            DTSCS7D
01417      IF LCCM-NO-MSG                                               DTSCS7D
01418         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01419         MOVE CATB-CURSOR TO MAP-DE-NAME-L                         DTSCS7D
01420         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01421  S1198-EXIT.                                                      DTSCS7D
01422      EXIT.                                                        DTSCS7D
01423                                                                   DTSCS7D
01424  S1199-ERROR.                                                     DTSCS7D
01425      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS7D
01426                                         MAP-EMP-NO-2-A.           DTSCS7D
01427                                                                   DTSCS7D
01428      IF LCCM-NO-MSG                                               DTSCS7D
01429         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01430         MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                        DTSCS7D
01431         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01432  S1199-EXIT.                                                      DTSCS7D
01433      EXIT.                                                        DTSCS7D
01434                                                                   DTSCS7D
01435  S1200-FORMAT-FINALIST.                                           DTSCS7D
01436      SET L072-MTAD-88  TO TRUE.                                   DTSCS7D
01437      MOVE SPACE        TO L072-ADDRESS.                           DTSCS7D
01438      MOVE MAP-DE-NAME  TO L072-NAME.                              DTSCS7D
01439      MOVE MAP-DE-ATTN  TO L072-ATTN-LINE.                         DTSCS7D
01440      MOVE MAP-DE-ADDR1 TO L072-DELIV-LINE-1.                      DTSCS7D
01441      MOVE MAP-DE-ADDR2 TO L072-DELIV-LINE-2.                      DTSCS7D
01442      MOVE MAP-DE-CITY  TO L072-CITY.                              DTSCS7D
01443      MOVE MAP-DE-STATE TO L072-ST.                                DTSCS7D
01444      MOVE MAP-DE-ZIP   TO L072-ZIP.                               DTSCS7D
01445                                                                   DTSCS7D
01446      PERFORM S072-EDIT-ADDRESS THRU S072-EXIT.                    DTSCS7D
01447                                                                   DTSCS7D
01448  S1200-EXIT.                                                      DTSCS7D
01449      EXIT.                                                        DTSCS7D
01450                                                                   DTSCS7D
01451  S1301-ERROR.                                                     DTSCS7D
01452      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-LABEL-A.         DTSCS7D
01453                                                                   DTSCS7D
01454      IF LCCM-NO-MSG                                               DTSCS7D
01455         MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                       DTSCS7D
01456         MOVE CATB-CURSOR   TO MAP-MAIL-LABEL-L                    DTSCS7D
01457         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01458  S1301-EXIT.                                                      DTSCS7D
01459      EXIT.                                                        DTSCS7D
01460                                                                   DTSCS7D
01461  S2600-WAGE-REQUEST.                                              DTSCS7D
01462      MOVE MAP-SSN-AREA TO L020-S-SSN-AREA.                        DTSCS7D
01463      PERFORM S020-SCREEN-SSN THRU S020-EXIT.                      DTSCS7D
01464      IF L020-NO-ENTRY                                             DTSCS7D
01465         GO TO S2600-EXIT                                          DTSCS7D
01466      ELSE                                                         DTSCS7D
01467      IF L020-NOT-VALID                                            DTSCS7D
01468         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS7D
01469         PERFORM S2601-ERROR THRU S2601-EXIT                       DTSCS7D
01470         GO TO S2600-EXIT.                                         DTSCS7D
01471                                                                   DTSCS7D
01472      MOVE L020-SSN TO L081-CLAIMANT-SSN.                          DTSCS7D
01473      PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT.            DTSCS7D
01474      IF L081-NAME-FOUND                                           DTSCS7D
01475         MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME              DTSCS7D
01476      ELSE                                                         DTSCS7D
01477         MOVE SPACES        TO MAP-CLAIMANT-NAME                   DTSCS7D
01478         MOVE MSG-E7D2-AREA TO WRK-MSG-AREA                        DTSCS7D
01479         PERFORM S2601-ERROR THRU S2601-EXIT                       DTSCS7D
01480         GO TO S2600-EXIT.                                         DTSCS7D
01481                                                                   DTSCS7D
01482      MOVE LCCM-CURR-RUN-DATE TO L004-DATE.                        DTSCS7D
01483      PERFORM S004-FROM-DATE  THRU S004-EXIT.                      DTSCS7D
01484      ADD +4                  TO L004-ABS-QTR.                     DTSCS7D
01485      PERFORM S004-FROM-ABS   THRU S004-EXIT.                      DTSCS7D
01486                                                                   DTSCS7D
01487      IF MAP-MAIL-LABEL EQUAL 'L'                                  DTSCS7D
01488         GO TO S2600-EXIT.                                         DTSCS7D
01489                                                                   DTSCS7D
01490      MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA.                    DTSCS7D
01491      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS7D
01492      IF L016-NO-ENTRY                                             DTSCS7D
01493         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS7D
01494         PERFORM S2602-ERROR THRU S2602-EXIT                       DTSCS7D
01495         GO TO S2600-EXIT                                          DTSCS7D
01496      ELSE                                                         DTSCS7D
01497         IF L016-NOT-VALID                                         DTSCS7D
01498         OR L016-YRQ >  L004-QTR-5-9                               DTSCS7D
01499            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS7D
01500            PERFORM S2602-ERROR THRU S2602-EXIT                    DTSCS7D
01501            GO TO S2600-EXIT.                                      DTSCS7D
01502                                                                   DTSCS7D
01503      IF  MAP-WR-YRQ2-YR NOT GREATER SPACES                        DTSCS7D
01504      AND MAP-WR-YRQ2-Q  NOT GREATER SPACES                        DTSCS7D
01505         GO TO S2600-CHECK-YRQ3.                                   DTSCS7D
01506                                                                   DTSCS7D
01507      MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA                     DTSCS7D
01508      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS7D
01509      IF L016-NO-ENTRY                                             DTSCS7D
01510         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS7D
01511         PERFORM S2603-ERROR THRU S2603-EXIT                       DTSCS7D
01512         GO TO S2600-EXIT                                          DTSCS7D
01513      ELSE                                                         DTSCS7D
01514         IF L016-NOT-VALID                                         DTSCS7D
01515         OR L016-YRQ >  L004-QTR-5-9                               DTSCS7D
01516            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS7D
01517            PERFORM S2603-ERROR THRU S2603-EXIT                    DTSCS7D
01518            GO TO S2600-EXIT.                                      DTSCS7D
01519                                                                   DTSCS7D
01520  S2600-CHECK-YRQ3.                                                DTSCS7D
01521      IF  MAP-WR-YRQ3-YR NOT GREATER SPACES                        DTSCS7D
01522      AND MAP-WR-YRQ3-Q  NOT GREATER SPACES                        DTSCS7D
01523         GO TO S2600-CHECK-YRQ4.                                   DTSCS7D
01524                                                                   DTSCS7D
01525      MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA                     DTSCS7D
01526      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS7D
01527      IF L016-NO-ENTRY                                             DTSCS7D
01528         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS7D
01529         PERFORM S2604-ERROR THRU S2604-EXIT                       DTSCS7D
01530         GO TO S2600-EXIT                                          DTSCS7D
01531      ELSE                                                         DTSCS7D
01532         IF L016-NOT-VALID                                         DTSCS7D
01533         OR L016-YRQ >  L004-QTR-5-9                               DTSCS7D
01534            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS7D
01535            PERFORM S2604-ERROR THRU S2604-EXIT                    DTSCS7D
01536            GO TO S2600-EXIT.                                      DTSCS7D
01537                                                                   DTSCS7D
01538  S2600-CHECK-YRQ4.                                                DTSCS7D
01539      IF  MAP-WR-YRQ4-YR NOT GREATER SPACES                        DTSCS7D
01540      AND MAP-WR-YRQ4-Q  NOT GREATER SPACES                        DTSCS7D
01541         GO TO S2600-EXIT.                                         DTSCS7D
01542                                                                   DTSCS7D
01543      MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA                     DTSCS7D
01544      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS7D
01545      IF L016-NO-ENTRY                                             DTSCS7D
01546         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS7D
01547         PERFORM S2605-ERROR THRU S2605-EXIT                       DTSCS7D
01548         GO TO S2600-EXIT                                          DTSCS7D
01549      ELSE                                                         DTSCS7D
01550         IF L016-NOT-VALID                                         DTSCS7D
01551         OR L016-YRQ >  L004-QTR-5-9                               DTSCS7D
01552            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS7D
01553            PERFORM S2605-ERROR THRU S2605-EXIT                    DTSCS7D
01554            GO TO S2600-EXIT.                                      DTSCS7D
01555  S2600-EXIT.                                                      DTSCS7D
01556      EXIT.                                                        DTSCS7D
01557                                                                   DTSCS7D
01558  S2601-ERROR.                                                     DTSCS7D
01559      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A               DTSCS7D
01560                                         MAP-SSN-2-A               DTSCS7D
01561                                         MAP-SSN-3-A.              DTSCS7D
01562      IF LCCM-NO-MSG                                               DTSCS7D
01563         MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                       DTSCS7D
01564         MOVE CATB-CURSOR   TO MAP-SSN-1-L                         DTSCS7D
01565         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01566  S2601-EXIT. EXIT.                                                DTSCS7D
01567                                                                   DTSCS7D
01568  S2602-ERROR.                                                     DTSCS7D
01569      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ1-YR-A          DTSCS7D
01570                                         MAP-WR-YRQ1-Q-A.          DTSCS7D
01571      IF LCCM-NO-MSG                                               DTSCS7D
01572         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01573         MOVE CATB-CURSOR TO MAP-WR-YRQ1-YR-L                      DTSCS7D
01574         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01575  S2602-EXIT.                                                      DTSCS7D
01576      EXIT.                                                        DTSCS7D
01577  S2603-ERROR.                                                     DTSCS7D
01578      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ2-YR-A          DTSCS7D
01579                                         MAP-WR-YRQ2-Q-A.          DTSCS7D
01580      IF LCCM-NO-MSG                                               DTSCS7D
01581         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01582         MOVE CATB-CURSOR TO MAP-WR-YRQ2-YR-L                      DTSCS7D
01583         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01584  S2603-EXIT.                                                      DTSCS7D
01585      EXIT.                                                        DTSCS7D
01586  S2604-ERROR.                                                     DTSCS7D
01587      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ3-YR-A          DTSCS7D
01588                                         MAP-WR-YRQ3-Q-A.          DTSCS7D
01589      IF LCCM-NO-MSG                                               DTSCS7D
01590         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01591         MOVE CATB-CURSOR TO MAP-WR-YRQ3-YR-L                      DTSCS7D
01592         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01593  S2604-EXIT.                                                      DTSCS7D
01594      EXIT.                                                        DTSCS7D
01595  S2605-ERROR.                                                     DTSCS7D
01596      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ4-YR-A          DTSCS7D
01597                                         MAP-WR-YRQ4-Q-A.          DTSCS7D
01598      IF LCCM-NO-MSG                                               DTSCS7D
01599         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS7D
01600         MOVE CATB-CURSOR TO MAP-WR-YRQ4-YR-L                      DTSCS7D
01601         SET CURSOR-SET-YES TO TRUE.                               DTSCS7D
01602  S2605-EXIT.                                                      DTSCS7D
01603      EXIT.                                                        DTSCS7D
01604      EJECT                                                        DTSCS7D
01605                                                                   DTSCS7D
01606  S8100-SET-LOCK-ATTRB.                                            DTSCS7D
01607      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS7D
01608                                   WRK-ATB-NUM.                    DTSCS7D
01609                                                                   DTSCS7D
01610      PERFORM S8900-SET-ATTRB THRU S8900-EXIT.                     DTSCS7D
01611                                                                   DTSCS7D
01612      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS7D
01613                                   MAP-EMP-NO-2-A                  DTSCS7D
01614                                   MAP-GOTO-A.                     DTSCS7D
01615  S8100-EXIT.                                                      DTSCS7D
01616      EXIT.                                                        DTSCS7D
01617                                                                   DTSCS7D
01618 ******************************************************************DTSCS7D
01619 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS7D
01620 ******************************************************************DTSCS7D
01621  S8200-SET-UPDATE-ATTRB.                                          DTSCS7D
01622      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS7D
01623                                                                   DTSCS7D
01624      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS7D
01625                                                                   DTSCS7D
01626      PERFORM S8900-SET-ATTRB THRU S8900-EXIT.                     DTSCS7D
01627  S8200-EXIT.                                                      DTSCS7D
01628      EXIT.                                                        DTSCS7D
01629                                                                   DTSCS7D
01630 ******************************************************************DTSCS7D
01631 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS7D
01632 ******************************************************************DTSCS7D
01633  S8300-SET-INQ-ATTRB.                                             DTSCS7D
01634      MOVE CATB-ASKIP-BRT-MDTON  TO WRK-ATB-AN                     DTSCS7D
01635                                    WRK-ATB-NUM.                   DTSCS7D
01636                                                                   DTSCS7D
01637      PERFORM S8900-SET-ATTRB THRU S8900-EXIT.                     DTSCS7D
01638  S8300-EXIT.                                                      DTSCS7D
01639      EXIT.                                                        DTSCS7D
01640                                                                   DTSCS7D
01641  S8900-SET-ATTRB.                                                 DTSCS7D
01642      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS7D
01643                                        MAP-EMP-NO-2-A.            DTSCS7D
01644                                                                   DTSCS7D
01645      MOVE CATB-ASKIP-BRT-MDTON  TO MAP-PRIMARY-NAME-A,            DTSCS7D
01646                                    MAP-TELEPHONE-A,               DTSCS7D
01647                                    MAP-CLAIMANT-NAME-A            DTSCS7D
01648                                    MAP-FINL-LITERAL-A.            DTSCS7D
01649                                                                   DTSCS7D
01650      MOVE WRK-ATB-NUM TO MAP-SSN-1-A                              DTSCS7D
01651                          MAP-SSN-2-A                              DTSCS7D
01652                          MAP-SSN-3-A                              DTSCS7D
01653                          MAP-WR-YRQ1-YR-A                         DTSCS7D
01654                          MAP-WR-YRQ1-Q-A                          DTSCS7D
01655                          MAP-WR-YRQ2-YR-A                         DTSCS7D
01656                          MAP-WR-YRQ2-Q-A                          DTSCS7D
01657                          MAP-WR-YRQ3-YR-A                         DTSCS7D
01658                          MAP-WR-YRQ3-Q-A                          DTSCS7D
01659                          MAP-WR-YRQ4-YR-A                         DTSCS7D
01660                          MAP-WR-YRQ4-Q-A.                         DTSCS7D
01661                                                                   DTSCS7D
01662      MOVE WRK-ATB-AN TO MAP-DE-NAME-A                             DTSCS7D
01663                         MAP-DE-ADDR1-A                            DTSCS7D
01664                         MAP-DE-ADDR2-A                            DTSCS7D
01665                         MAP-DE-CITY-A                             DTSCS7D
01666                         MAP-DE-STATE-A                            DTSCS7D
01667                         MAP-DE-ZIP-A                              DTSCS7D
01668                         MAP-DE-ATTN-A                             DTSCS7D
01669                         MAP-MAIL-LABEL-A                          DTSCS7D
01670                         MAP-FINL-IND-OK-A.                        DTSCS7D
01671                                                                   DTSCS7D
01672      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS7D
01673  S8900-EXIT.                                                      DTSCS7D
01674      EXIT.                                                        DTSCS7D
01675                                                                   DTSCS7D
01676 ******************************************************************DTSCS7D
01677 * MAP ROUTINES                                                   *DTSCS7D
01678 ******************************************************************DTSCS7D
01679  S9100-RECEIVE.                                                   DTSCS7D
01680      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS7D
01681                                                                   DTSCS7D
01682      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS7D
01683                                                                   DTSCS7D
01684      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS7D
01685                                                                   DTSCS7D
01686      MOVE L851-AID TO LCCM-AID.                                   DTSCS7D
01687                                                                   DTSCS7D
01688      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS7D
01689  S9100-EXIT.                                                      DTSCS7D
01690      EXIT.                                                        DTSCS7D
01691                                                                   DTSCS7D
01692  S9200-SEND-DATAONLY.                                             DTSCS7D
01693      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS7D
01694                                                                   DTSCS7D
01695      IF LCCM-NO-MSG                                               DTSCS7D
01696          NEXT SENTENCE                                            DTSCS7D
01697      ELSE                                                         DTSCS7D
01698          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS7D
01699                                                                   DTSCS7D
01700      IF CURSOR-SET-GOTO                                           DTSCS7D
01701          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS7D
01702      ELSE                                                         DTSCS7D
01703          MOVE CATB-CURSOR TO MAP-SSN-1-L.                         DTSCS7D
01704                                                                   DTSCS7D
01705      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS7D
01706                                                                   DTSCS7D
01707      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS7D
01708                                                                   DTSCS7D
01709      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS7D
01710  S9200-EXIT.                                                      DTSCS7D
01711      EXIT.                                                        DTSCS7D
01712                                                                   DTSCS7D
01713  S9300-SEND-MAP.                                                  DTSCS7D
01714      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS7D
01715                                                                   DTSCS7D
01716      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS7D
01717                                                                   DTSCS7D
01718      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS7D
01719                                                                   DTSCS7D
01720      IF SCR-ACCESS-UPDATE                                         DTSCS7D
01721          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS7D
01722      ELSE                                                         DTSCS7D
01723          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS7D
01724                                                                   DTSCS7D
01725      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS7D
01726                                                                   DTSCS7D
01727      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS7D
01728                                                                   DTSCS7D
01729      IF CURSOR-SET-NO                                             DTSCS7D
01730          MOVE CATB-CURSOR TO MAP-SSN-1-L.                         DTSCS7D
01731                                                                   DTSCS7D
01732      SET L851-SEND-88 TO TRUE.                                    DTSCS7D
01733                                                                   DTSCS7D
01734      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS7D
01735                                                                   DTSCS7D
01736      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS7D
01737  S9300-EXIT.                                                      DTSCS7D
01738      EXIT.                                                        DTSCS7D
01739                                                                   DTSCS7D
01740  S9310-UPDATE-FKEYS.                                              DTSCS7D
01741      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS7D
01742                                                                   DTSCS7D
01743      MOVE CFKD-ADD TO MAP-KEY-ADD.                                DTSCS7D
01744                                                                   DTSCS7D
01745      IF LCCM-SCR-CLEAR                                            DTSCS7D
01746          NEXT SENTENCE                                            DTSCS7D
01747      ELSE                                                         DTSCS7D
01748      IF LCCM-SCR-INQUIRE                                          DTSCS7D
01749          NEXT SENTENCE                                            DTSCS7D
01750      ELSE                                                         DTSCS7D
01751      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS7D
01752          MOVE LOW-VALUES TO MAP-KEY-ADD                           DTSCS7D
01753      ELSE                                                         DTSCS7D
01754          NEXT SENTENCE.                                           DTSCS7D
01755  S9310-EXIT.                                                      DTSCS7D
01756      EXIT.                                                        DTSCS7D
01757                                                                   DTSCS7D
01758  S9320-INQUIRY-FKEYS.                                             DTSCS7D
01759      MOVE LOW-VALUES TO MAP-KEY-ADD.                              DTSCS7D
01760                                                                   DTSCS7D
01761  S9320-EXIT.                                                      DTSCS7D
01762      EXIT.                                                        DTSCS7D
01763                                                                   DTSCS7D
01764  S9330-DSCR-FIELDS.                                               DTSCS7D
01765      MOVE LOW-VALUES TO MAP-PRIMARY-NAME,                         DTSCS7D
01766                         MAP-CLAIMANT-NAME,                        DTSCS7D
01767                         MAP-TELEPHONE.                            DTSCS7D
01768                                                                   DTSCS7D
01769      MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME                    CL**2
01770                                                                   DTSCS7D
01771      IF WRK-MPRF-YES-88                                           DTSCS7D
01772         MOVE MPRF-PRIMARY-NAME    TO MAP-PRIMARY-NAME             DTSCS7D
01773         MOVE MTAD-VOICE-1-AREA-CD TO WRK-VOICE-AREA-CD            DTSCS7D
01774         MOVE MTAD-VOICE-1-PREFIX  TO WRK-VOICE-PREFIX             DTSCS7D
01775         MOVE MTAD-VOICE-1-SUFFIX  TO WRK-VOICE-SUFFIX             DTSCS7D
01776         MOVE WRK-TELEPHONE-AREA   TO MAP-TELEPHONE                DTSCS7D
01777      ELSE                                                         DTSCS7D
01778         IF WRK-MPRF-NO-88                                         DTSCS7D
01779            MOVE '*** NOT FOUND ***' TO MAP-PRIMARY-NAME.          DTSCS7D
01780  S9330-EXIT.                                                      DTSCS7D
01781      EXIT.                                                        DTSCS7D
01782                                                                   DTSCS7D
01783  S9900-PREPARE-SEND.                                              DTSCS7D
01784      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS7D
01785                         LCCM-SCR-ID.                              DTSCS7D
01786                                                                   DTSCS7D
01787      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS7D
01788                                                                   DTSCS7D
01789      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS7D
01790                                                                   DTSCS7D
01791      IF  MAP-MAIL-LABEL NOT GREATER SPACES                        DTSCS7D
01792      AND WRK-NO-DEFAULT NOT EQUAL 'Y'                             DTSCS7D
01793         MOVE 'Y' TO MAP-MAIL-LABEL.                               DTSCS7D
01794  S9900-EXIT.                                                      DTSCS7D
01795      EXIT.                                                        DTSCS7D
