00001  IDENTIFICATION DIVISION.                                         11/16/00
00002  PROGRAM-ID.             DTSCS77.                                 DTSCS77
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV049
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS77
00005  DATE-COMPILED.                                                   DTSCS77
00006      SKIP3                                                        DTSCS77
00007 *****                                                             DTSCS77
00008 *                                                                 DTSCS77
00009 *    FUNCTION:  CORRESPONDENCE QUEUE INITIATION                   DTSCS77
00010 *               SCREEN PROCESSOR.                                 DTSCS77
00011 *                                                                 DTSCS77
00012 *                                                                 DTSCS77
00013 *    MODIFICATION LOG:                                            DTSCS77
00014 *                                                                 DTSCS77
00015 *    10/02/98  INITIAL DEVELOPMENT.          COPIED FROM MACCS77  DTSCS77
00016 *              WORK ORDER:                      PROGRAMMER: ZL1.  DTSCS77
00017 *                                                                 DTSCS77
00018 *    06/22/1999  FOPR-EMAIL-ADDRESS AND FFID-EMAIL-ADDRESS TO     DTSCS77
00019 *                CORRESPONDENCE QUEUE RECORD - PER DC             DTSCS77
00020 *                SPECIFICATIONS.                                  DTSCS77
00021 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS77
00022 *                                                                 DTSCS77
00023 *    09/14/1999  PER A REQUEST FROM KAMI PEEL, CHANGED THE        DTSCS77
00024 *                CORRESPONDENCE QUEUE RECORD FIELD SEPARATOR      DTSCS77
00025 *                CHARACTER FROM '^' TO '*'.  ATTEMPT TO           DTSCS77
00026 *                COMPENSATE FOR BUGS IN EXTRA! 6.4.               DTSCS77
00027 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS77
00028 *                                                                 DTSCS77
00029 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS77
00030 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS77
00031 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS77
00032 *                                                                 DTSCS77
00033 *                                                                 DTSCS77
00034 *  DESCRIPTION:                                                   DTSCS77
00035 *                                                                 DTSCS77
00036 *                                                                 DTSCS77
00037 *    CLEAR:                                                       DTSCS77
00038 *                                                                 DTSCS77
00039 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS77
00040 *                                                                 DTSCS77
00041 *                                                                 DTSCS77
00042 *    JUMP:                                                        DTSCS77
00043 *                                                                 DTSCS77
00044 *      NONE.                                                      DTSCS77
00045 *                                                                 DTSCS77
00046 *                                                                 DTSCS77
00047 *    INQUIRY:                                                     DTSCS77
00048 *                                                                 DTSCS77
00049 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS77
00050 *                                                                 DTSCS77
00051 *      JUMP IN: DISPLAY PRIMARY  NAME ASSOCIATED WITH LCCM-EMP-NO.DTSCS77
00052 *                                                                 DTSCS77
00053 *      ENTER: DISPLAY PRIMARY  NAME ASSOCIATED WITH LCCM-EMP-NO.  DTSCS77
00054 *                                                                 DTSCS77
00055 *      STANDARD LCCM-EMP-NO.                                      DTSCS77
00056 *                                                                 DTSCS77
00057 *                                                                 DTSCS77
00058 *    UPDATE:                                                      DTSCS77
00059 *                                                                 DTSCS77
00060 *      ADD                                                        DTSCS77
00061 *                                                                 DTSCS77
00062 *        DOES NOT UPDATE THE MASTER FILE.  RATHER, WRITES ONE     DTSCS77
00063 *        CORRESPONDENCE RECORD TO THE VSAM KSDS WORK FILE.        DTSCS77
00064 *                                                                 DTSCS77
00065 *        OPERATION SHOULD BE SIMILAR TO 'ADD' FUNCTION ON         DTSCS77
00066 *        OTHER SCREENS (F09, CONFIRM OR CANCEL).                  DTSCS77
00067 *                                                                 DTSCS77
00068 *                                                                 DTSCS77
00069 *    RECORDS READ:                                                DTSCS77
00070 *                                                                 DTSCS77
00071 *      MASTER:                                                    DTSCS77
00072 *                                                                 DTSCS77
00073 *        MPRF                                                     DTSCS77
00074 *        MLIN                                                     DTSCS77
00075 *        MDPC                                                     DTSCS77
00076 *        MOPO                                                     DTSCS77
00077 *                                                                 DTSCS77
00078 *                                                                 DTSCS77
00079 *      ALTERNATE INDEX:                                           DTSCS77
00080 *                                                                 DTSCS77
00081 *        NONE.                                                    DTSCS77
00082 *                                                                 DTSCS77
00083 *                                                                 DTSCS77
00084 *      REFERENCE:                                                 DTSCS77
00085 *                                                                 DTSCS77
00086 *        NONE.                                                    DTSCS77
00087 *                                                                 DTSCS77
00088 *                                                                 DTSCS77
00089 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS77
00090 *                                                                 DTSCS77
00091 *        NONE.                                                    DTSCS77
00092 *                                                                 DTSCS77
00093 *                                                                 DTSCS77
00094 *    RECORDS UPDATED:                                             DTSCS77
00095 *                                                                 DTSCS77
00096 *      MASTER:                                                    DTSCS77
00097 *                                                                 DTSCS77
00098 *        MEVL (WRITE)                                             DTSCS77
00099 *        MTCK (WRITE)                                             DTSCS77
00100 *                                                                 DTSCS77
00101 *                                                                 DTSCS77
00102 *      REFERENCE:                                                 DTSCS77
00103 *                                                                 DTSCS77
00104 *        NONE.                                                    DTSCS77
00105 *                                                                 DTSCS77
00106 *                                                                 DTSCS77
00107 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS77
00108 *                                                                 DTSCS77
00109 *        NONE.                                                    DTSCS77
00110 *                                                                 DTSCS77
00111 *                                                                 DTSCS77
00112 *    VSAM KSDS WORK FILE RECORDS WRITTEN:                         DTSCS77
00113 *                                                                 DTSCS77
00114 *      DTSIVCOR  CORRESPONDENCE QUEUE RECORD.                     DTSCS77
00115 *                                                                 DTSCS77
00116 *                                                                 DTSCS77
00117 *    TEMPORARY STORAGE USAGE:                                     DTSCS77
00118 *                                                                 DTSCS77
00119 *      NONE.                                                      DTSCS77
00120 *                                                                 DTSCS77
00121 *                                                                 DTSCS77
00122 *    MODULES LINKED TO:                                           DTSCS77
00123 *                                                                 DTSCS77
00124 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS77
00125 *      DTSCU013  COUNT FROM SCREEN (INTEGER) FORMAT/EDIT.         DTSCS77
00126 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS77
00127 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS77
00128 *      DTSCU018  CERT NO FROM SCREEN FORMAT/EDIT.                 DTSCS77
00129 *      DTSCU061  FIELD ZIP / FIELD REP ID.                        DTSCS77
00130 *      DTSCU062  FIELD REP ID EDIT/DESCRIPTION.                   DTSCS77
00131 *      DTSCU071  NAME EDIT/CONVERSION.                            DTSCS77
00132 *      DTSCU075  COOPERATING AGENCY ADDRESS LOOKUP.               DTSCS77
00133 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS77
00134 *      DTSCU111  ADDRESS LOOKUP.                                  DTSCS77
00135 *      MACCU112  FORMAT ADDRESS FOR MAILING.                      DTSCS77
00136 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS77
00137 *      DTSCU827  VSAM KSDS WORK FILE INPUT/OUTPUT.                DTSCS77
00138 *                                                                 DTSCS77
00139 *                                                                 DTSCS77
00140 *    VERMONT REFERENCE:                                           DTSCS77
00141 *                                                                 DTSCS77
00142 *        NONE.                                                    DTSCS77
00143 *                                                                 DTSCS77
00144 *****                                                             DTSCS77
00145      SKIP3                                                        DTSCS77
00146  ENVIRONMENT DIVISION.                                            DTSCS77
00147      SKIP3                                                        DTSCS77
00148  DATA DIVISION.                                                   DTSCS77
00149      SKIP3                                                        DTSCS77
00150  WORKING-STORAGE SECTION.                                         DTSCS77
001505 77  PAN-VALET PICTURE X(24) VALUE '049DTSCS77   11/16/00'.       DTSCS77
00151      SKIP3                                                        DTSCS77
00152  01  SW-AREA.                                                     DTSCS77
00153      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S77 '.    DTSCS77
00154      SKIP1                                                        DTSCS77
00155      05  WRK-SCR-ID.                                              DTSCS77
00156          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 77.        DTSCS77
00157      SKIP1                                                        DTSCS77
00158      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '70'.      DTSCS77
00159      SKIP1                                                        DTSCS77
00160      05  WRK-TEXT-MAX                PIC S9(04)  COMP  VALUE +6.  DTSCS77
00161      SKIP3                                                        DTSCS77
00162      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS77
00163          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS77
00164          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS77
00165      SKIP1                                                        DTSCS77
00166      05  CURSOR-SET-IND              PIC X(01).                   DTSCS77
00167          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS77
00168          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS77
00169          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS77
00170      SKIP1                                                        DTSCS77
00171      05  REQ-IND                     PIC X(01).                   DTSCS77
00172          88  REQ-ERROR                       VALUE 'O'.           DTSCS77
00173          88  REQ-JUMP                        VALUE 'J'.           DTSCS77
00174          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS77
00175          88  REQ-CLEAR                       VALUE 'C'.           DTSCS77
00176          88  REQ-EDIT                        VALUE 'E'.           DTSCS77
00177          88  REQ-UPDATE                      VALUE 'U'.           DTSCS77
00178          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS77
00179      SKIP1                                                        DTSCS77
00180      05  RESP-IND                    PIC X(01).                   DTSCS77
00181          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS77
00182          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS77
00183          88  RESP-JUMP                       VALUE 'J'.           DTSCS77
00184          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS77
00185      SKIP1                                                        DTSCS77
00186      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS77
00187      SKIP1                                                        DTSCS77
00188      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS77
00189      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS77
00190      SKIP3                                                        DTSCS77
00191      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS77
00192      SKIP3                                                        DTSCS77
00193      05  WRK-CERT-NO                 PIC  9(08).                  DTSCS77
00194                                                                   DTSCS77
00195      05  WRK-EDIT-CERT-NO REDEFINES WRK-CERT-NO.                  DTSCS77
00196          10  WRK-EDIT-CERT-NO1       PIC 9(4).                    DTSCS77
00197          10  WRK-EDIT-CERT-NO2       PIC 9(4).                    DTSCS77
00198      SKIP1                                                        DTSCS77
00199      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS77
00200          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS77
00201          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS77
00202      SKIP3                                                        DTSCS77
00203      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS77
00204      SKIP1                                                        DTSCS77
00205      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS77
00206          10  FILLER                  PIC X(05).                   DTSCS77
00207          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS77
00208          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS77
00209      SKIP1                                                        DTSCS77
00210      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS77
00211          10  FILLER                  PIC X(05).                   DTSCS77
00212          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS77
00213          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS77
00214          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS77
00215      SKIP1                                                        DTSCS77
00216      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS77
00217          10  FILLER                  PIC X(08).                   DTSCS77
00218          10  WRK-DISPLAY-QTR-YR      PIC X(02).                   DTSCS77
00219          10  WRK-DISPLAY-QTR-Q       PIC X(01).                   DTSCS77
00220      SKIP1                                                        DTSCS77
00221      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS77
00222          10  FILLER                  PIC X(08).                   DTSCS77
00223          10  WRK-DISPLAY-ADDR-ID-NO  PIC X(03).                   DTSCS77
00224      SKIP1                                                        DTSCS77
00225      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS77
00226          10  FILLER                  PIC X(02).                   DTSCS77
00227          10  WRK-DISPLAY-SSN-1       PIC X(03).                   DTSCS77
00228          10  WRK-DISPLAY-SSN-2       PIC X(02).                   DTSCS77
00229          10  WRK-DISPLAY-SSN-3       PIC X(04).                   DTSCS77
00230      SKIP3                                                        DTSCS77
00231      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS77
00232          10  FILLER                  PIC X(05).                   DTSCS77
00233          10  WRK-DISPLAY-CERT-NO1    PIC X(02).                   DTSCS77
00234          10  WRK-DISPLAY-CERT-NO2    PIC X(04).                   DTSCS77
00235      SKIP3                                                        DTSCS77
00236      05  WRK-TEXT-SUB                PIC S9(04)        COMP.      DTSCS77
00237      SKIP1                                                        DTSCS77
00238      05  WRK-REC-CNT                 PIC S9(04)        COMP.      DTSCS77
00239      SKIP1                                                        DTSCS77
00240      05  MAILING-ADDR-IND            PIC  X(01).                  DTSCS77
00241          88  MAILING-ADDR-YES-88            VALUE 'Y'.            DTSCS77
00242          88  MAILING-ADDR-NO-88             VALUE 'N'.            DTSCS77
00243      SKIP3                                                        DTSCS77
00244      05  WP-CONSTRUCTION-AREA.                                    DTSCS77
00245          10  COR-SEP-CHAR            PIC  X(01)  VALUE '*'.       DTSCS77
00246          10  COR-MAX                 PIC S9(04) COMP VALUE +1580. DTSCS77
00247          10  WRK-MAX                 PIC S9(04) COMP VALUE +50.   DTSCS77
00248          10  COR-CNT                 PIC S9(04)  COMP.            DTSCS77
00249          10  WRK-FIRST               PIC S9(04)  COMP.            DTSCS77
00250          10  WRK-LAST                PIC S9(04)  COMP.            DTSCS77
00251          10  WRK-SUB                 PIC S9(04)  COMP.            DTSCS77
00252          10  COR-FIRST               PIC S9(04)  COMP.            DTSCS77
00253          10  COR-LAST                PIC S9(04)  COMP.            DTSCS77
00254          10  COR-LENGTH              PIC S9(04)  COMP.            DTSCS77
00255          10  WRK-AREA.                                            DTSCS77
00256              15  WRK-CHAR OCCURS 50 TIMES                         DTSCS77
00257                           INDEXED BY WRK-IDX                      DTSCS77
00258                                      PIC  X(01).                  DTSCS77
00259 *****EJECT                                                        DTSCS77
00260 *01  MSG-LITERALS.                                                DTSCS77
00261 *****05  MSG-E771-AREA.                                           DTSCS77
00262 *****    10  FILLER                  PIC  X(04)  VALUE 'E771'.    DTSCS77
00263 *****    10  FILLER                  PIC  X(30)                   DTSCS77
00264 *****          VALUE '                              '.            DTSCS77
00265 *****    10  FILLER                  PIC  X(30)                   DTSCS77
00266 *****          VALUE '                              '.            DTSCS77
00267      EJECT                                                        DTSCS77
00268  01  L001-COMM-AREA.                                              DTSCS77
00269  ++INCLUDE DTSIL001                                               DTSCS77
00270      EJECT                                                        DTSCS77
00271  01  L013-COMM-AREA.                                              DTSCS77
00272  ++INCLUDE DTSIL013                                               DTSCS77
00273      EJECT                                                        DTSCS77
00274  01  L015-COMM-AREA.                                              DTSCS77
00275  ++INCLUDE DTSIL015                                               DTSCS77
00276      EJECT                                                        DTSCS77
00277  01  L018-COMM-AREA.                                              DTSCS77
00278  ++INCLUDE DTSIL018                                               DTSCS77
00279      EJECT                                                        DTSCS77
00280  01  L028-COMM-AREA.                                              DTSCS77
00281  ++INCLUDE DTSIL028                                               DTSCS77
00282      EJECT                                                        DTSCS77
00283  01  L061-COMM-AREA.                                              DTSCS77
00284  ++INCLUDE DTSIL061                                               DTSCS77
00285      EJECT                                                        DTSCS77
00286  01  L062-COMM-AREA.                                              DTSCS77
00287  ++INCLUDE DTSIL062                                               DTSCS77
00288      EJECT                                                        DTSCS77
00289  01  L071-COMM-AREA.                                              DTSCS77
00290  ++INCLUDE DTSIL071                                               DTSCS77
00291      EJECT                                                        DTSCS77
00292  01  L075-COMM-AREA.                                              DTSCS77
00293  ++INCLUDE DTSIL075                                               DTSCS77
00294      EJECT                                                        DTSCS77
00295  01  L082-COMM-AREA.                                              DTSCS77
00296  ++INCLUDE DTSIL082                                               DTSCS77
00297      EJECT                                                        DTSCS77
00298  01  L111-COMM-AREA.                                              DTSCS77
00299  ++INCLUDE DTSIL111                                               DTSCS77
00300      EJECT                                                        DTSCS77
00301  01  L112-COMM-AREA.                                              DTSCS77
00302  ++INCLUDE DTSIL112                                               DTSCS77
00303      EJECT                                                        DTSCS77
00304  01  L221-COMM-AREA.                                              DTSCS77
00305  ++INCLUDE DTSIL221                                               DTSCS77
00306      EJECT                                                        DTSCS77
00307  01  L805-COMM-AREA.                                              DTSCS77
00308  ++INCLUDE DTSIL805                                               DTSCS77
00309      EJECT                                                        DTSCS77
00310  01  L810-COMM-AREA.                                              DTSCS77
00311      05  L810-CONTROL-BLOCK.                                      DTSCS77
00312  ++INCLUDE DTSIL810                                               DTSCS77
00313      EJECT                                                        DTSCS77
00314      05  MSKL-REC.                                                DTSCS77
00315  ++INCLUDE DTSIMSKL                                               DTSCS77
00316      EJECT                                                        DTSCS77
00317  01  MPRF-REC.                                                    DTSCS77
00318  ++INCLUDE DTSIMPRF                                               DTSCS77
00319      EJECT                                                        DTSCS77
00320  01  MLIN-REC.                                                    DTSCS77
00321  ++INCLUDE DTSIMLIN                                               DTSCS77
00322      EJECT                                                        DTSCS77
00323  01  MDPC-REC.                                                    DTSCS77
00324  ++INCLUDE DTSIMDPC                                               DTSCS77
00325      EJECT                                                        DTSCS77
00326  01  MOPO-REC.                                                    DTSCS77
00327  ++INCLUDE DTSIMOPO                                               DTSCS77
00328      EJECT                                                        DTSCS77
00329  01  MEVL-REC.                                                    DTSCS77
00330  ++INCLUDE DTSIMEVL                                               DTSCS77
00331      EJECT                                                        DTSCS77
00332  01  MTCK-REC.                                                    DTSCS77
00333  ++INCLUDE DTSIMTCK                                               DTSCS77
00334      EJECT                                                        DTSCS77
00335  01  L827-COMM-AREA.                                              DTSCS77
00336      05  L827-CONTROL-BLOCK.                                      DTSCS77
00337  ++INCLUDE DTSIL827                                               DTSCS77
00338      EJECT                                                        DTSCS77
00339      05  VSKL-REC.                                                DTSCS77
00340  ++INCLUDE DTSIVSKL                                               DTSCS77
00341      EJECT                                                        DTSCS77
00342  01  VCOR-REC.                                                    DTSCS77
00343  ++INCLUDE DTSIVCOR                                               DTSCS77
00344      EJECT                                                        DTSCS77
00345  01  L851-COMM-AREA.                                              DTSCS77
00346  ++INCLUDE DTSIL851                                               DTSCS77
00347      SKIP3                                                        DTSCS77
00348      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS77
00349  ++INCLUDE DTSIS77                                                DTSCS77
00350      EJECT                                                        DTSCS77
00351  01  CATB-LITERALS.                                               DTSCS77
00352  ++INCLUDE DTSICATB                                               DTSCS77
00353      SKIP3                                                        DTSCS77
00354  01  CFKD-LITERALS.                                               DTSCS77
00355  ++INCLUDE DTSICFKD                                               DTSCS77
00356      SKIP3                                                        DTSCS77
00357  01  CECD-LITERALS.                                               DTSCS77
00358  ++INCLUDE DTSICECD                                               DTSCS77
00359      SKIP3                                                        DTSCS77
00360  01  CPCD-LITERALS.                                               DTSCS77
00361  ++INCLUDE DTSICPCD                                               DTSCS77
00362      EJECT                                                        DTSCS77
00363  LINKAGE SECTION.                                                 DTSCS77
00364      SKIP3                                                        DTSCS77
00365  01  DFHCOMMAREA.                                                 DTSCS77
00366  ++INCLUDE DTSILCCM                                               DTSCS77
00367      EJECT                                                        DTSCS77
00368 ******************************************************************DTSCS77
00369 *                                                                *DTSCS77
00370 ******************************************************************DTSCS77
00371      SKIP1                                                        DTSCS77
00372  PROCEDURE DIVISION.                                              DTSCS77
00373      SKIP2                                                        DTSCS77
00374      MOVE +0 TO WRK-EMP-NO.                                       DTSCS77
00375      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS77
00376      SKIP1                                                        DTSCS77
00377      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS77
00378      SKIP1                                                        DTSCS77
00379      SET CURSOR-SET-NO TO TRUE.                                   DTSCS77
00380      SKIP1                                                        DTSCS77
00381      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS77
00382        TO SCR-ACCESS-IND.                                         DTSCS77
00383      SKIP3                                                        DTSCS77
00384      MOVE SPACE TO REQ-IND.                                       DTSCS77
00385      SKIP1                                                        DTSCS77
00386      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS77
00387      SKIP1                                                        DTSCS77
00388 *-----------------------------------------------------            DTSCS77
00389 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS77
00390 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS77
00391 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS77
00392 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS77
00393 *                                                                 DTSCS77
00394 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS77
00395 *    PROCESSED.                                                   DTSCS77
00396 *                                                                 DTSCS77
00397 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS77
00398 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS77
00399 *    WORK STATION OPERATOR.                                       DTSCS77
00400 *-----------------------------------------------------            DTSCS77
00401      SKIP1                                                        DTSCS77
00402      MOVE SPACE TO RESP-IND.                                      DTSCS77
00403      SKIP1                                                        DTSCS77
00404      IF REQ-ERROR                                                 DTSCS77
00405         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS77
00406      ELSE                                                         DTSCS77
00407      IF REQ-JUMP                                                  DTSCS77
00408         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS77
00409      ELSE                                                         DTSCS77
00410      IF REQ-CLEAR                                                 DTSCS77
00411         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS77
00412      ELSE                                                         DTSCS77
00413      IF REQ-CURSOR-TO-GOTO                                        DTSCS77
00414         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS77
00415      ELSE                                                         DTSCS77
00416      IF REQ-INQUIRE                                               DTSCS77
00417         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS77
00418      ELSE                                                         DTSCS77
00419      IF REQ-EDIT                                                  DTSCS77
00420         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS77
00421      ELSE                                                         DTSCS77
00422      IF REQ-UPDATE                                                DTSCS77
00423         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS77
00424      ELSE                                                         DTSCS77
00425         GO TO S899-ABEND.                                         DTSCS77
00426      SKIP3                                                        DTSCS77
00427 *-----------------------------------------------------            DTSCS77
00428 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS77
00429 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS77
00430 *-----------------------------------------------------            DTSCS77
00431      SKIP1                                                        DTSCS77
00432      IF RESP-SEND-MAP                                             DTSCS77
00433          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS77
00434          SET LCCM-END-TASK-88 TO TRUE                             DTSCS77
00435      ELSE                                                         DTSCS77
00436      IF RESP-SEND-MSGONLY                                         DTSCS77
00437          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS77
00438          SET LCCM-END-TASK-88 TO TRUE                             DTSCS77
00439      ELSE                                                         DTSCS77
00440      IF RESP-JUMP                                                 DTSCS77
00441          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
00442      ELSE                                                         DTSCS77
00443      IF RESP-CURSOR-TO-GOTO                                       DTSCS77
00444          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS77
00445          SET LCCM-END-TASK-88 TO TRUE                             DTSCS77
00446      ELSE                                                         DTSCS77
00447          GO TO S899-ABEND.                                        DTSCS77
00448      SKIP3                                                        DTSCS77
00449  MAINLINE-EXIT.                                                   DTSCS77
00450      SKIP1                                                        DTSCS77
00451      EXEC CICS                                                    DTSCS77
00452          RETURN                                                   DTSCS77
00453      END-EXEC.                                                    DTSCS77
00454      SKIP2                                                        DTSCS77
00455      GOBACK.                                                      DTSCS77
00456      EJECT                                                        DTSCS77
00457 /*****************************************************************DTSCS77
00458 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS77
00459 ******************************************************************DTSCS77
00460  P1000-ANALYZE-REQUEST.                                           DTSCS77
00461      SKIP1                                                        DTSCS77
00462 *-----------------------------------------------------            DTSCS77
00463 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS77
00464 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS77
00465 *     REPLACED WITH ENTER)                                        DTSCS77
00466 *-----------------------------------------------------            DTSCS77
00467      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS77
00468         SET LCCM-ENTER-88 TO TRUE                                 DTSCS77
00469         SET REQ-INQUIRE TO TRUE                                   DTSCS77
00470         IF LCCM-EMP-NO > ZERO                                     DTSCS77
00471             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS77
00472             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS77
00473         END-IF                                                    DTSCS77
00474         GO TO P1000-EXIT.                                         DTSCS77
00475      SKIP3                                                        DTSCS77
00476 *-----------------------------------------------------            DTSCS77
00477 *      MAP IS RECEIVED                                            DTSCS77
00478 *-----------------------------------------------------            DTSCS77
00479      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS77
00480      SKIP3                                                        DTSCS77
00481 *-----------------------------------------------------            DTSCS77
00482 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS77
00483 *    WORK STATION                                                 DTSCS77
00484 *-----------------------------------------------------            DTSCS77
00485      IF LCCM-CLEAR-88                                             DTSCS77
00486         SET REQ-CLEAR TO TRUE                                     DTSCS77
00487         GO TO P1000-EXIT.                                         DTSCS77
00488      SKIP3                                                        DTSCS77
00489 *-----------------------------------------------------            DTSCS77
00490 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS77
00491 *-----------------------------------------------------            DTSCS77
00492      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS77
00493         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS77
00494         GO TO P1000-EXIT.                                         DTSCS77
00495      SKIP3                                                        DTSCS77
00496 *-----------------------------------------------------            DTSCS77
00497 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS77
00498 *-----------------------------------------------------            DTSCS77
00499      IF LCCM-PA2-88                                               DTSCS77
00500          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS77
00501          GO TO P1000-EXIT.                                        DTSCS77
00502      SKIP3                                                        DTSCS77
00503 *-----------------------------------------------------            DTSCS77
00504 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS77
00505 *-----------------------------------------------------            DTSCS77
00506      IF LCCM-PA-88                                                DTSCS77
00507        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS77
00508        SET REQ-ERROR TO TRUE                                      DTSCS77
00509        GO TO P1000-EXIT.                                          DTSCS77
00510      SKIP3                                                        DTSCS77
00511 *-----------------------------------------------------            DTSCS77
00512 *    IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS                DTSCS77
00513 *    CLEAR SCREEN.                                                DTSCS77
00514 *-----------------------------------------------------            DTSCS77
00515      IF LCCM-F12-88                                               DTSCS77
00516         MOVE LOW-VALUES TO MAP-AREA                               DTSCS77
00517         SET REQ-CLEAR TO TRUE                                     DTSCS77
00518         GO TO P1000-EXIT.                                         DTSCS77
00519      SKIP3                                                        DTSCS77
00520 *-----------------------------------------------------            DTSCS77
00521 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS77
00522 *-----------------------------------------------------            DTSCS77
00523      IF LCCM-F03-88                                               DTSCS77
00524         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS77
00525         SET REQ-JUMP TO TRUE                                      DTSCS77
00526         GO TO P1000-EXIT.                                         DTSCS77
00527      SKIP3                                                        DTSCS77
00528 *-----------------------------------------------------            DTSCS77
00529 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS77
00530 *-----------------------------------------------------            DTSCS77
00531      IF LCCM-F04-88                                               DTSCS77
00532         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS77
00533         SET REQ-JUMP TO TRUE                                      DTSCS77
00534         GO TO P1000-EXIT.                                         DTSCS77
00535      SKIP3                                                        DTSCS77
00536 *-----------------------------------------------------            DTSCS77
00537 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS77
00538 *    CORRESPONDENCE SCREEN                                        DTSCS77
00539 *-----------------------------------------------------            DTSCS77
00540      IF LCCM-F14-88                                               DTSCS77
00541         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS77
00542         SET REQ-JUMP TO TRUE                                      DTSCS77
00543         GO TO P1000-EXIT.                                         DTSCS77
00544      SKIP3                                                        DTSCS77
00545 *-----------------------------------------------------            DTSCS77
00546 *    IF JUMP KEY PRESSED, JUMP TO THE REQUESTED SCREEN            DTSCS77
00547 *-----------------------------------------------------            DTSCS77
00548 *    IF LCCM-F21-88                                               DTSCS77
00549 *       MOVE '73' TO LCCM-REQ-SCR-ID                              DTSCS77
00550 *       SET REQ-JUMP TO TRUE                                      DTSCS77
00551 *       GO TO P1000-EXIT.                                         DTSCS77
00552 *    SKIP1                                                        DTSCS77
00553 *    IF LCCM-F22-88                                               DTSCS77
00554 *       MOVE '74' TO LCCM-REQ-SCR-ID                              DTSCS77
00555 *       SET REQ-JUMP TO TRUE                                      DTSCS77
00556 *       GO TO P1000-EXIT.                                         DTSCS77
00557 *    SKIP3                                                        DTSCS77
00558 *-----------------------------------------------------            DTSCS77
00559 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS77
00560 *    REQUESTED SCREEN TYPE                                        DTSCS77
00561 *-----------------------------------------------------            DTSCS77
00562      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS77
00563         NEXT SENTENCE                                             DTSCS77
00564      ELSE                                                         DTSCS77
00565        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS77
00566        SET REQ-JUMP TO TRUE                                       DTSCS77
00567        GO TO P1000-EXIT.                                          DTSCS77
00568      SKIP3                                                        DTSCS77
00569 *-----------------------------------------------------            DTSCS77
00570 *    IF REQUEST TO UPDATE THE DATA (MOD)                          DTSCS77
00571 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS77
00572 *-----------------------------------------------------            DTSCS77
00573      IF LCCM-F09-88                                               DTSCS77
00574         IF SCR-ACCESS-UPDATE                                      DTSCS77
00575            SET REQ-EDIT TO TRUE                                   DTSCS77
00576            GO TO P1000-EXIT                                       DTSCS77
00577         ELSE                                                      DTSCS77
00578            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS77
00579            SET REQ-ERROR TO TRUE                                  DTSCS77
00580            GO TO P1000-EXIT.                                      DTSCS77
00581      SKIP3                                                        DTSCS77
00582 *-----------------------------------------------------            DTSCS77
00583 *    IF INQUIRY TYPE KEY PRESSED (ENTER) INDICATE                 DTSCS77
00584 *          INQUIRY REQUEST.                                       DTSCS77
00585 *-----------------------------------------------------            DTSCS77
00586      IF LCCM-ENTER-88                                             DTSCS77
00587          SET REQ-INQUIRE TO TRUE                                  DTSCS77
00588          GO TO P1000-EXIT.                                        DTSCS77
00589      SKIP3                                                        DTSCS77
00590 *-----------------------------------------------------            DTSCS77
00591 *     ANY OTHER KEY IS INVALID                                    DTSCS77
00592 *-----------------------------------------------------            DTSCS77
00593      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS77
00594      SET REQ-ERROR TO TRUE.                                       DTSCS77
00595  P1000-EXIT.                                                      DTSCS77
00596      EXIT.                                                        DTSCS77
00597      SKIP3                                                        DTSCS77
00598 ******************************************************************DTSCS77
00599 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS77
00600 ******************************************************************DTSCS77
00601      SKIP1                                                        DTSCS77
00602  P1100-UPDATE-LOCKED.                                             DTSCS77
00603 *-----------------------------------------------------            DTSCS77
00604 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS77
00605 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS77
00606 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS77
00607 *-----------------------------------------------------            DTSCS77
00608      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS77
00609         SET REQ-UPDATE TO TRUE                                    DTSCS77
00610      ELSE                                                         DTSCS77
00611         SET REQ-ERROR TO TRUE                                     DTSCS77
00612         IF LCCM-SCR-ADD-LOCKED                                    DTSCS77
00613            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS77
00614         ELSE                                                      DTSCS77
00615            GO TO S899-ABEND.                                      DTSCS77
00616  P1100-EXIT.                                                      DTSCS77
00617      EXIT.                                                        DTSCS77
00618 /*****************************************************************DTSCS77
00619 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS77
00620 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS77
00621 ******************************************************************DTSCS77
00622      SKIP1                                                        DTSCS77
00623  P2000-REQUEST-ERROR.                                             DTSCS77
00624      IF LCCM-MSG                                                  DTSCS77
00625         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS77
00626      ELSE                                                         DTSCS77
00627         GO TO S899-ABEND.                                         DTSCS77
00628  P2000-EXIT.                                                      DTSCS77
00629      EXIT.                                                        DTSCS77
00630 /*****************************************************************DTSCS77
00631 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS77
00632 ******************************************************************DTSCS77
00633      SKIP1                                                        DTSCS77
00634  P3000-REQUEST-JUMP.                                              DTSCS77
00635 *-----------------------------------------------------            DTSCS77
00636 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS77
00637 *    BY USER                                                      DTSCS77
00638 *-----------------------------------------------------            DTSCS77
00639      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS77
00640      SKIP3                                                        DTSCS77
00641 *-----------------------------------------------------            DTSCS77
00642 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS77
00643 *-----------------------------------------------------            DTSCS77
00644      IF LCCM-MSG                                                  DTSCS77
00645         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS77
00646         SET CURSOR-SET-GOTO TO TRUE                               DTSCS77
00647         GO TO P3000-EXIT.                                         DTSCS77
00648      SKIP3                                                        DTSCS77
00649      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS77
00650      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS77
00651      IF L018-VALID                                                DTSCS77
00652          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS77
00653      SKIP3                                                        DTSCS77
00654 *-----------------------------------------------------            DTSCS77
00655 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS77
00656 *-----------------------------------------------------            DTSCS77
00657      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS77
00658                         LCCM-SCR-HOLD-AREA.                       DTSCS77
00659      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS77
00660      SET RESP-JUMP TO TRUE.                                       DTSCS77
00661  P3000-EXIT.                                                      DTSCS77
00662      EXIT.                                                        DTSCS77
00663 /*****************************************************************DTSCS77
00664 * CLEAR KEY WAS PRESSED                                          *DTSCS77
00665 ******************************************************************DTSCS77
00666      SKIP1                                                        DTSCS77
00667  P4000-REQUEST-CLEAR.                                             DTSCS77
00668      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS77
00669      SKIP1                                                        DTSCS77
00670      IF SCR-ACCESS-UPDATE                                         DTSCS77
00671          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS77
00672      ELSE                                                         DTSCS77
00673          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS77
00674      SKIP3                                                        DTSCS77
00675 *-----------------------------------------------------            DTSCS77
00676 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS77
00677 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS77
00678 *-----------------------------------------------------            DTSCS77
00679      IF LCCM-EMP-NO > ZERO                                        DTSCS77
00680          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS77
00681          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS77
00682      SKIP1                                                        DTSCS77
00683      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS77
00684      SKIP1                                                        DTSCS77
00685      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS77
00686      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS77
00687      SKIP1                                                        DTSCS77
00688      SET RESP-SEND-MAP TO TRUE.                                   DTSCS77
00689  P4000-EXIT.                                                      DTSCS77
00690      EXIT.                                                        DTSCS77
00691 /*****************************************************************DTSCS77
00692 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS77
00693 ******************************************************************DTSCS77
00694      SKIP1                                                        DTSCS77
00695  P5000-CURSOR-TO-GOTO.                                            DTSCS77
00696      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS77
00697      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS77
00698  P5000-EXIT.                                                      DTSCS77
00699      EXIT.                                                        DTSCS77
00700 /*****************************************************************DTSCS77
00701 * INQUIRY WAS REQUESTED                                          *DTSCS77
00702 ******************************************************************DTSCS77
00703      SKIP1                                                        DTSCS77
00704  P6000-REQUEST-INQUIRE.                                           DTSCS77
00705      MOVE LOW-VALUES TO MAP-FLD-REP-ID                            DTSCS77
00706                         MAP-MAILING-LINE-1                        DTSCS77
00707                         MAP-MAILING-LINE-2                        DTSCS77
00708                         MAP-MAILING-LINE-3                        DTSCS77
00709                         MAP-MAILING-LINE-4                        DTSCS77
00710                         MAP-MAILING-LINE-5.                       DTSCS77
00711      SKIP1                                                        DTSCS77
00712      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS77
00713      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS77
00714      SKIP1                                                        DTSCS77
00715      SET RESP-SEND-MAP TO TRUE.                                   DTSCS77
00716      SKIP1                                                        DTSCS77
00717      IF SCR-ACCESS-UPDATE                                         DTSCS77
00718          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS77
00719      ELSE                                                         DTSCS77
00720          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS77
00721      SKIP1                                                        DTSCS77
00722      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS77
00723      IF LCCM-MSG                                                  DTSCS77
00724          GO TO P6000-EXIT.                                        DTSCS77
00725      SKIP1                                                        DTSCS77
00726      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS77
00727      IF LCCM-MSG                                                  DTSCS77
00728          GO TO P6000-EXIT.                                        DTSCS77
00729      SKIP1                                                        DTSCS77
00730      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS77
00731      SKIP1                                                        DTSCS77
00732      SKIP1                                                        DTSCS77
00733      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS77
00734      SKIP1                                                        DTSCS77
00735      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS77
00736  P6000-EXIT.                                                      DTSCS77
00737      EXIT.                                                        DTSCS77
00738 /*****************************************************************DTSCS77
00739 *                                                                *DTSCS77
00740 ******************************************************************DTSCS77
00741      SKIP1                                                        DTSCS77
00742  P6900-CONSTRUCT-SCREEN.                                          DTSCS77
00743      PERFORM S4000-MAILING-ADDR THRU S4000-EXIT.                  DTSCS77
00744      SKIP1                                                        DTSCS77
00745      MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST.                     DTSCS77
00746      MOVE WRK-EMP-NO TO L061-EMP-NO.                              DTSCS77
00747      PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT.                  DTSCS77
00748      MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID.                      DTSCS77
00749      SKIP1                                                        DTSCS77
00750      MOVE LCCM-RESP-OP-ID TO MAP-CORR-OP-ID.                      DTSCS77
00751      SKIP1                                                        DTSCS77
00752      MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID.               DTSCS77
00753  P6900-EXIT.                                                      DTSCS77
00754      EXIT.                                                        DTSCS77
00755 /*****************************************************************DTSCS77
00756 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED.                    *DTSCS77
00757 ******************************************************************DTSCS77
00758      SKIP1                                                        DTSCS77
00759  P7000-REQUEST-EDIT.                                              DTSCS77
00760      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS77
00761      SKIP1                                                        DTSCS77
00762      IF LCCM-F09-88                                               DTSCS77
00763         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS77
00764      ELSE                                                         DTSCS77
00765         GO TO S899-ABEND.                                         DTSCS77
00766      SKIP3                                                        DTSCS77
00767 *------------------------------------------------------           DTSCS77
00768 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS77
00769 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS77
00770 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS77
00771 *------------------------------------------------------           DTSCS77
00772      SKIP1                                                        DTSCS77
00773      IF LCCM-MSG                                                  DTSCS77
00774         NEXT SENTENCE                                             DTSCS77
00775      ELSE                                                         DTSCS77
00776         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS77
00777         IF LCCM-F09-88                                            DTSCS77
00778            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS77
00779            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID.                  DTSCS77
00780      SKIP1                                                        DTSCS77
00781      SET RESP-SEND-MAP TO TRUE.                                   DTSCS77
00782  P7000-EXIT.                                                      DTSCS77
00783      EXIT.                                                        DTSCS77
00784 /*****************************************************************DTSCS77
00785 * ADD FUNCTION WAS REQUESTED                                     *DTSCS77
00786 ******************************************************************DTSCS77
00787      SKIP1                                                        DTSCS77
00788  P7100-EDIT-ADD.                                                  DTSCS77
00789 *-----------------------------------------------------            DTSCS77
00790 *    ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE           DTSCS77
00791 *-----------------------------------------------------            DTSCS77
00792 *****IF NOT LCCM-SCR-CLEAR                                        DTSCS77
00793 *****   MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS77
00794 *****   GO TO P7100-EXIT.                                         DTSCS77
00795      SKIP3                                                        DTSCS77
00796 *-----------------------------------------------------            DTSCS77
00797 *    MAP-EMP-NO IS REQUIRED                                       DTSCS77
00798 *-----------------------------------------------------            DTSCS77
00799      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS77
00800      IF LCCM-MSG                                                  DTSCS77
00801          GO TO P7100-EXIT.                                        DTSCS77
00802      SKIP1                                                        DTSCS77
00803      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS77
00804  P7100-EXIT.                                                      DTSCS77
00805      EXIT.                                                        DTSCS77
00806 /*****************************************************************DTSCS77
00807 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS77
00808 ******************************************************************DTSCS77
00809      SKIP1                                                        DTSCS77
00810  P8000-REQUEST-UPDATE.                                            DTSCS77
00811      IF LCCM-SCR-ADD-LOCKED                                       DTSCS77
00812         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS77
00813      ELSE                                                         DTSCS77
00814         GO TO S899-ABEND.                                         DTSCS77
00815      SKIP1                                                        DTSCS77
00816      SET RESP-SEND-MAP TO TRUE.                                   DTSCS77
00817  P8000-EXIT.                                                      DTSCS77
00818      EXIT.                                                        DTSCS77
00819 /*****************************************************************DTSCS77
00820 *                                                                *DTSCS77
00821 ******************************************************************DTSCS77
00822      SKIP1                                                        DTSCS77
00823  P8100-ADD.                                                       DTSCS77
00824      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS77
00825      SKIP1                                                        DTSCS77
00826      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS77
00827      SKIP2                                                        DTSCS77
00828      IF LCCM-F12-88                                               DTSCS77
00829         MOVE PMSG-ADD-CANCELED        TO LCCM-MSG-ID              DTSCS77
00830         GO TO P8100-EXIT.                                         DTSCS77
00831      SKIP2                                                        DTSCS77
00832      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS77
00833      SKIP1                                                        DTSCS77
00834      MOVE 'A' TO L221-UPDATE-FUNCTION.                            DTSCS77
00835      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS77
00836      IF LCCM-MSG                                                  DTSCS77
00837          GO TO P8100-EXIT.                                        DTSCS77
00838      SKIP1                                                        DTSCS77
00839      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS77
00840      SKIP2                                                        DTSCS77
00841      PERFORM P8200-ADD-VCOR THRU P8200-EXIT.                      DTSCS77
00842      SKIP1                                                        DTSCS77
00843      PERFORM P8300-ADD-MEVL THRU P8300-EXIT.                      DTSCS77
00844      SKIP1                                                        DTSCS77
00845      PERFORM P8400-ADD-MTCK THRU P8400-EXIT.                      DTSCS77
00846      SKIP2                                                        DTSCS77
00847      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS77
00848      SKIP2                                                        DTSCS77
00849      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS77
00850      SKIP2                                                        DTSCS77
00851      MOVE LOW-VALUES TO MAP-FLD-REP-ID                            DTSCS77
00852                         MAP-MAILING-LINE-1                        DTSCS77
00853                         MAP-MAILING-LINE-2                        DTSCS77
00854                         MAP-MAILING-LINE-3                        DTSCS77
00855                         MAP-MAILING-LINE-4                        DTSCS77
00856                         MAP-MAILING-LINE-5.                       DTSCS77
00857      SKIP1                                                        DTSCS77
00858      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS77
00859  P8100-EXIT.                                                      DTSCS77
00860      EXIT.                                                        DTSCS77
00861      SKIP3                                                        DTSCS77
00862  P8200-ADD-VCOR.                                                  DTSCS77
00863      MOVE LOW-VALUES TO VCOR-REC.                                 DTSCS77
00864      SET VCOR-COR-88 TO TRUE.                                     DTSCS77
00865      MOVE MAP-QUEUE-OP-ID TO VCOR-QUEUE-ID.                       DTSCS77
00866      MOVE LCCM-TASK-START-ABSTIME TO VCOR-ESTB-ABSTIME.           DTSCS77
00867      SKIP1                                                        DTSCS77
00868      MOVE +0 TO COR-CNT.                                          DTSCS77
00869      SKIP1                                                        DTSCS77
00870      MOVE MAP-TEMPLATE-ID TO WRK-AREA.                            DTSCS77
00871      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00872      SKIP1                                                        DTSCS77
00873      MOVE MAP-QUEUE-OP-ID TO WRK-AREA.                            DTSCS77
00874      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00875      SKIP1                                                        DTSCS77
00876      MOVE SPACES TO WRK-AREA.                                     DTSCS77
00877      MOVE WRK-EMP-NO TO WRK-DISPLAY.                              DTSCS77
00878      MOVE WRK-DISPLAY-EMP-NO-1 TO WRK-AREA (1:3).                 DTSCS77
00879      MOVE WRK-DISPLAY-EMP-NO-2 TO WRK-AREA (5:3).                 DTSCS77
00880      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00881      SKIP1                                                        DTSCS77
00882      MOVE MPRF-PRIMARY-NAME TO WRK-AREA.                          DTSCS77
00883      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00884      SKIP1                                                        DTSCS77
00885      MOVE MAP-CORR-OP-ID TO WRK-AREA.                             DTSCS77
00886      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00887      SKIP1                                                        DTSCS77
00888      MOVE MAP-CORR-OP-ID TO L082-OP-ID.                           DTSCS77
00889      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                    DTSCS77
00890      IF (L082-VALID-OP) AND (L082-EXTERNAL-88)                    DTSCS77
00891          PERFORM P8210-CORR-OP THRU P8210-EXIT                    DTSCS77
00892      ELSE                                                         DTSCS77
00893          MOVE SPACES TO WRK-AREA                                  DTSCS77
00894          PERFORM P8290-WRKTOCOR THRU P8290-EXIT                   DTSCS77
00895              5 TIMES.                                             DTSCS77
00896      SKIP1                                                        DTSCS77
00897 *    MOVE MAP-LIEN-CERT-AREA TO L028-S-NO-AREA.                   DTSCS77
00898 *    PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT.             DTSCS77
00899 *    MOVE L028-NO TO WRK-AREA.                                    DTSCS77
00900      MOVE SPACES TO WRK-AREA.                                     DTSCS77
00901      MOVE MAP-CERT-NUM1 TO WRK-AREA (1:2).                        DTSCS77
00902      MOVE MAP-CERT-NUM2 TO WRK-AREA (4:4).                        DTSCS77
00903      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00904      SKIP1                                                        DTSCS77
00905      MOVE MAP-COPY-CNT TO WRK-AREA.                               DTSCS77
00906      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00907      SKIP1                                                        DTSCS77
00908      MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9.                DTSCS77
00909      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS77
00910      MOVE L001-SLASH-DATE TO WRK-AREA.                            DTSCS77
00911      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00912      SKIP1                                                        DTSCS77
00913      MOVE MAP-CORR-DATE-AREA TO L015-S-DATE-AREA.                 DTSCS77
00914      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS77
00915      MOVE L015-DATE TO L001-FED-8-DATE-9.                         DTSCS77
00916      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS77
00917      MOVE L001-SLASH-DATE TO WRK-AREA.                            DTSCS77
00918      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00919      SKIP1                                                        DTSCS77
00920      MOVE MAP-ADDR-TYPE TO WRK-AREA.                              DTSCS77
00921      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00922      SKIP1                                                        DTSCS77
00923      MOVE MAP-ADDR-ID-NO TO WRK-AREA.                             DTSCS77
00924      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00925      SKIP1                                                        DTSCS77
00926      MOVE MAP-MAILING-LINE-1 TO WRK-AREA.                         DTSCS77
00927      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00928      SKIP1                                                        DTSCS77
00929      MOVE MAP-MAILING-LINE-2 TO WRK-AREA.                         DTSCS77
00930      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00931      SKIP1                                                        DTSCS77
00932      MOVE MAP-MAILING-LINE-3 TO WRK-AREA.                         DTSCS77
00933      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00934      SKIP1                                                        DTSCS77
00935      MOVE MAP-MAILING-LINE-4 TO WRK-AREA.                         DTSCS77
00936      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00937      SKIP1                                                        DTSCS77
00938      MOVE MAP-MAILING-LINE-5 TO WRK-AREA.                         DTSCS77
00939      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00940      SKIP1                                                        DTSCS77
00941      IF MAP-ADDR-OPO-88                                           DTSCS77
00942          PERFORM P8220-OPO THRU P8220-EXIT                        DTSCS77
00943      ELSE                                                         DTSCS77
00944          MOVE SPACES TO WRK-AREA                                  DTSCS77
00945          PERFORM P8290-WRKTOCOR THRU P8290-EXIT                   DTSCS77
00946              3 TIMES.                                             DTSCS77
00947      SKIP1                                                        DTSCS77
00948      MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID.                      DTSCS77
00949      PERFORM S062-FLD-REP-DSCR THRU S062-EXIT.                    DTSCS77
00950      IF (MAP-FLD-REP-NONE-88)                                     DTSCS77
00951            OR                                                     DTSCS77
00952         (L062-NOT-VALID)                                          DTSCS77
00953          MOVE SPACES TO WRK-AREA                                  DTSCS77
00954          PERFORM P8290-WRKTOCOR THRU P8290-EXIT                   DTSCS77
00955              15 TIMES                                             DTSCS77
00956      ELSE                                                         DTSCS77
00957          PERFORM P8230-FLD-REP THRU P8230-EXIT.                   DTSCS77
00958      SKIP1                                                        DTSCS77
00959      IF MAP-CORR-STATE = SPACES OR LOW-VALUES                     DTSCS77
00960          MOVE SPACES TO WRK-AREA                                  DTSCS77
00961          PERFORM P8290-WRKTOCOR THRU P8290-EXIT                   DTSCS77
00962              5 TIMES                                              DTSCS77
00963      ELSE                                                         DTSCS77
00964          MOVE MAP-CORR-STATE TO L075-LOOKUP-STATE                 DTSCS77
00965          SET L075-LOOKUP-ADDR-88 TO TRUE                          DTSCS77
00966          PERFORM S075-LOOKUP-COOP-STATE THRU S075-EXIT            DTSCS77
00967          IF L075-ADDR-FOUND-88                                    DTSCS77
00968              PERFORM P8240-CORR-STATE THRU P8240-EXIT             DTSCS77
00969          ELSE                                                     DTSCS77
00970              MOVE SPACES TO WRK-AREA                              DTSCS77
00971              PERFORM P8290-WRKTOCOR THRU P8290-EXIT               DTSCS77
00972                  5 TIMES.                                         DTSCS77
00973      SKIP2                                                        DTSCS77
00974      MOVE VCOR-REC TO VSKL-REC.                                   DTSCS77
00975      PERFORM S827-WRITE THRU S827-EXIT.                           DTSCS77
00976  P8200-EXIT.                                                      DTSCS77
00977      EXIT.                                                        DTSCS77
00978      SKIP3                                                        DTSCS77
00979  P8210-CORR-OP.                                                   DTSCS77
00980      MOVE L082-NAME TO L071-NAM.                                  DTSCS77
00981      SET L071-FROM-LAST-NAME-FIRST TO TRUE.                       DTSCS77
00982      PERFORM S071-NAME-CONVERSION THRU S071-EXIT.                 DTSCS77
00983      MOVE L071-NAM TO WRK-AREA.                                   DTSCS77
00984      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00985      SKIP1                                                        DTSCS77
00986      MOVE L082-TITLE TO WRK-AREA.                                 DTSCS77
00987      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00988      SKIP1                                                        DTSCS77
00989      MOVE L082-UNIT-NAME TO WRK-AREA.                             DTSCS77
00990      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
00991      SKIP1                                                        DTSCS77
00992      MOVE SPACES TO WRK-AREA.                                     DTSCS77
00993      STRING '('                      DELIMITED BY SIZE            DTSCS77
00994             L082-VOICE-1-AREA-CD     DELIMITED BY SIZE            DTSCS77
00995             ') '                     DELIMITED BY SIZE            DTSCS77
00996             L082-VOICE-1-PREFIX      DELIMITED BY SIZE            DTSCS77
00997             '-'                      DELIMITED BY SIZE            DTSCS77
00998             L082-VOICE-1-SUFFIX      DELIMITED BY SIZE            DTSCS77
00999             '-'                      DELIMITED BY SIZE            DTSCS77
01000             L082-VOICE-1-EXT         DELIMITED BY SIZE            DTSCS77
01001          INTO WRK-AREA.                                           DTSCS77
01002      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01003      SKIP1                                                        DTSCS77
01004      MOVE L082-EMAIL-ADDRESS TO WRK-AREA.                         DTSCS77
01005      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01006  P8210-EXIT.                                                      DTSCS77
01007      EXIT.                                                        DTSCS77
01008      SKIP3                                                        DTSCS77
01009  P8220-OPO.                                                       DTSCS77
01010      MOVE LOW-VALUES TO MOPO-KEY-AREA.                            DTSCS77
01011      MOVE WRK-EMP-NO TO MOPO-EMP-NO.                              DTSCS77
01012      SET MOPO-OPO-88 TO TRUE.                                     DTSCS77
01013      MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA.                 DTSCS77
01014      PERFORM S013-ADDR-NUM THRU S013-EXIT.                        DTSCS77
01015      MOVE L013-CNT TO MOPO-ID-NO.                                 DTSCS77
01016      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS77
01017      PERFORM S810-READ THRU S810-EXIT.                            DTSCS77
01018      IF L810-NO-REC-88                                            DTSCS77
01019          MOVE SPACES TO WRK-AREA                                  DTSCS77
01020          PERFORM P8290-WRKTOCOR THRU P8290-EXIT                   DTSCS77
01021              3 TIMES                                              DTSCS77
01022          GO TO P8220-EXIT.                                        DTSCS77
01023      SKIP1                                                        DTSCS77
01024      MOVE MSKL-REC TO MOPO-REC.                                   DTSCS77
01025      SKIP1                                                        DTSCS77
01026      MOVE MOPO-TITLE TO WRK-AREA.                                 DTSCS77
01027      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01028      SKIP1                                                        DTSCS77
01029      MOVE MOPO-NAME TO L071-NAM.                                  DTSCS77
01030      SET L071-FROM-LAST-NAME-FIRST TO TRUE.                       DTSCS77
01031      PERFORM S071-NAME-CONVERSION THRU S071-EXIT.                 DTSCS77
01032      MOVE L071-NAM TO WRK-AREA.                                   DTSCS77
01033      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01034      SKIP1                                                        DTSCS77
01035      MOVE SPACES TO WRK-AREA.                                     DTSCS77
01036      IF MOPO-SSN = +0                                             DTSCS77
01037          NEXT SENTENCE                                            DTSCS77
01038      ELSE                                                         DTSCS77
01039          MOVE MOPO-SSN TO WRK-DISPLAY                             DTSCS77
01040          STRING WRK-DISPLAY-SSN-1   DELIMITED BY SIZE             DTSCS77
01041                 '-'                 DELIMITED BY SIZE             DTSCS77
01042                 WRK-DISPLAY-SSN-3   DELIMITED BY SIZE             DTSCS77
01043                 '-'                 DELIMITED BY SIZE             DTSCS77
01044                 WRK-DISPLAY-SSN-2   DELIMITED BY SIZE             DTSCS77
01045              INTO                                                 DTSCS77
01046                  WRK-AREA.                                        DTSCS77
01047      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01048  P8220-EXIT.                                                      DTSCS77
01049      EXIT.                                                        DTSCS77
01050      SKIP3                                                        DTSCS77
01051  P8230-FLD-REP.                                                   DTSCS77
01052      MOVE L062-FLD-REP-ID TO WRK-AREA.                            DTSCS77
01053      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01054      SKIP1                                                        DTSCS77
01055      MOVE L062-NAME TO L071-NAM.                                  DTSCS77
01056      SET L071-FROM-LAST-NAME-FIRST TO TRUE.                       DTSCS77
01057      PERFORM S071-NAME-CONVERSION THRU S071-EXIT.                 DTSCS77
01058      MOVE L071-NAM TO WRK-AREA.                                   DTSCS77
01059      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01060      SKIP1                                                        DTSCS77
01061      SET L112-FID-MAILING-ADDR-88 TO TRUE.                        DTSCS77
01062      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS77
01063      MOVE SPACES TO L112-PRIMARY-NAME.                            DTSCS77
01064      MOVE L062-NAME TO L112-NAME.                                 DTSCS77
01065      MOVE SPACES TO L112-TITLE.                                   DTSCS77
01066      SKIP1                                                        DTSCS77
01067      MOVE L062-MAIL-ADDR TO L112-ADDRESS.                         DTSCS77
01068      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS77
01069      SKIP1                                                        DTSCS77
01070      PERFORM P8231-MOVE-ADDR THRU P8231-EXIT                      DTSCS77
01071          VARYING L112-MAILING-IDX FROM 1 BY 1                     DTSCS77
01072          UNTIL L112-MAILING-IDX > +5.                             DTSCS77
01073      SKIP1                                                        DTSCS77
01074      SET L112-FID-PHYSICAL-ADDR-88 TO TRUE.                       DTSCS77
01075      MOVE L062-PHYSICAL-ADDR TO L112-ADDRESS.                     DTSCS77
01076      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS77
01077      SKIP1                                                        DTSCS77
01078      PERFORM P8231-MOVE-ADDR THRU P8231-EXIT                      DTSCS77
01079          VARYING L112-MAILING-IDX FROM 1 BY 1                     DTSCS77
01080          UNTIL L112-MAILING-IDX > +5.                             DTSCS77
01081      SKIP1                                                        DTSCS77
01082      MOVE SPACES TO WRK-AREA.                                     DTSCS77
01083      STRING '('                 DELIMITED BY SIZE                 DTSCS77
01084             L062-VOICE-1-AREA-CD DELIMITED BY SIZE                DTSCS77
01085             ') '                DELIMITED BY SIZE                 DTSCS77
01086             L062-VOICE-1-PREFIX DELIMITED BY SIZE                 DTSCS77
01087             '-'                 DELIMITED BY SIZE                 DTSCS77
01088             L062-VOICE-1-SUFFIX DELIMITED BY SIZE                 DTSCS77
01089             '-'                 DELIMITED BY SIZE                 DTSCS77
01090             L062-VOICE-1-EXT    DELIMITED BY SIZE                 DTSCS77
01091          INTO                                                     DTSCS77
01092              WRK-AREA.                                            DTSCS77
01093      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01094      SKIP1                                                        DTSCS77
01095      MOVE SPACES TO WRK-AREA.                                     DTSCS77
01096      STRING '('                 DELIMITED BY SIZE                 DTSCS77
01097             L062-FAX-AREA-CD    DELIMITED BY SIZE                 DTSCS77
01098             ') '                DELIMITED BY SIZE                 DTSCS77
01099             L062-FAX-PREFIX     DELIMITED BY SIZE                 DTSCS77
01100             '-'                 DELIMITED BY SIZE                 DTSCS77
01101             L062-FAX-SUFFIX     DELIMITED BY SIZE                 DTSCS77
01102             '-'                 DELIMITED BY SIZE                 DTSCS77
01103             L062-FAX-EXT        DELIMITED BY SIZE                 DTSCS77
01104          INTO                                                     DTSCS77
01105              WRK-AREA.                                            DTSCS77
01106      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01107      SKIP1                                                        DTSCS77
01108      MOVE L062-EMAIL-ADDRESS TO WRK-AREA.                         DTSCS77
01109      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01110  P8230-EXIT.                                                      DTSCS77
01111      EXIT.                                                        DTSCS77
01112      SKIP3                                                        DTSCS77
01113  P8231-MOVE-ADDR.                                                 DTSCS77
01114      MOVE L112-MAILING-LINE (L112-MAILING-IDX) TO WRK-AREA.       DTSCS77
01115      PERFORM P8290-WRKTOCOR THRU P8290-EXIT.                      DTSCS77
01116  P8231-EXIT.                                                      DTSCS77
01117      EXIT.                                                        DTSCS77
01118      SKIP3                                                        DTSCS77
01119  P8240-CORR-STATE.                                                DTSCS77
01120      SET L112-TAA-ADDR-88 TO TRUE.                                DTSCS77
01121      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS77
01122      MOVE SPACE TO L112-PRIMARY-NAME                              DTSCS77
01123                    L112-TITLE.                                    DTSCS77
01124      MOVE L075-NAME TO L112-NAME.                                 DTSCS77
01125      SKIP1                                                        DTSCS77
01126      MOVE L075-ADDRESS TO L112-ADDRESS.                           DTSCS77
01127      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS77
01128      SKIP1                                                        DTSCS77
01129      PERFORM P8231-MOVE-ADDR THRU P8231-EXIT                      DTSCS77
01130          VARYING L112-MAILING-IDX FROM 1 BY 1                     DTSCS77
01131          UNTIL L112-MAILING-IDX > +5.                             DTSCS77
01132  P8240-EXIT.                                                      DTSCS77
01133      EXIT.                                                        DTSCS77
01134      SKIP3                                                        DTSCS77
01135  P8290-WRKTOCOR.                                                  DTSCS77
01136      INSPECT WRK-AREA                                             DTSCS77
01137          CONVERTING COR-SEP-CHAR TO SPACE.                        DTSCS77
01138      SKIP1                                                        DTSCS77
01139      MOVE +0 TO WRK-FIRST                                         DTSCS77
01140                 WRK-LAST.                                         DTSCS77
01141      PERFORM P8291-WRK-CHAR-SCAN THRU P8291-EXIT                  DTSCS77
01142          VARYING WRK-SUB FROM 1 BY 1                              DTSCS77
01143          UNTIL WRK-SUB > WRK-MAX.                                 DTSCS77
01144      IF WRK-FIRST = +0                                            DTSCS77
01145          NEXT SENTENCE                                            DTSCS77
01146      ELSE                                                         DTSCS77
01147          PERFORM P8292-MOVE-WRK THRU P8292-EXIT.                  DTSCS77
01148      IF COR-CNT < COR-MAX                                         DTSCS77
01149          ADD +1 TO COR-CNT                                        DTSCS77
01150          MOVE COR-SEP-CHAR TO VCOR-DATA (COR-CNT:1).              DTSCS77
01151  P8290-EXIT.                                                      DTSCS77
01152      EXIT.                                                        DTSCS77
01153      SKIP3                                                        DTSCS77
01154  P8291-WRK-CHAR-SCAN.                                             DTSCS77
01155      IF WRK-CHAR (WRK-SUB) = SPACES OR LOW-VALUES                 DTSCS77
01156          GO TO P8291-EXIT.                                        DTSCS77
01157      SKIP1                                                        DTSCS77
01158      IF WRK-FIRST = +0                                            DTSCS77
01159          MOVE WRK-SUB TO WRK-FIRST.                               DTSCS77
01160      MOVE WRK-SUB TO WRK-LAST.                                    DTSCS77
01161  P8291-EXIT.                                                      DTSCS77
01162      EXIT.                                                        DTSCS77
01163      SKIP3                                                        DTSCS77
01164  P8292-MOVE-WRK.                                                  DTSCS77
01165      COMPUTE COR-FIRST = COR-CNT + 1.                             DTSCS77
01166      SKIP1                                                        DTSCS77
01167      IF COR-FIRST > COR-MAX                                       DTSCS77
01168          GO TO P8292-EXIT.                                        DTSCS77
01169      SKIP1                                                        DTSCS77
01170      COMPUTE COR-LENGTH = WRK-LAST - WRK-FIRST + 1.               DTSCS77
01171      SKIP1                                                        DTSCS77
01172      COMPUTE COR-LAST = COR-CNT + COR-LENGTH.                     DTSCS77
01173      SKIP1                                                        DTSCS77
01174      IF COR-LAST > COR-MAX                                        DTSCS77
01175          COMPUTE COR-LENGTH = COR-MAX - COR-CNT.                  DTSCS77
01176      SKIP1                                                        DTSCS77
01177      MOVE WRK-AREA (WRK-FIRST:COR-LENGTH)                         DTSCS77
01178        TO VCOR-DATA (COR-FIRST:COR-LENGTH).                       DTSCS77
01179      SKIP1                                                        DTSCS77
01180      COMPUTE COR-CNT = COR-CNT + COR-LENGTH.                      DTSCS77
01181  P8292-EXIT.                                                      DTSCS77
01182      EXIT.                                                        DTSCS77
01183      EJECT                                                        DTSCS77
01184  P8300-ADD-MEVL.                                                  DTSCS77
01185      MOVE LOW-VALUES TO MEVL-REC.                                 DTSCS77
01186      MOVE WRK-EMP-NO TO MEVL-EMP-NO.                              DTSCS77
01187      SET MEVL-EVL-88 TO TRUE.                                     DTSCS77
01188      MOVE LCCM-TASK-START-DATE TO MEVL-DATE.                      DTSCS77
01189      MOVE LCCM-TASK-START-TIME TO MEVL-TIME.                      DTSCS77
01190      SKIP1                                                        DTSCS77
01191      MOVE +0 TO MEVL-PURGE-DATE.                                  DTSCS77
01192      SKIP1                                                        DTSCS77
01193      MOVE SPACES TO MEVL-TEXT.                                    DTSCS77
01194      STRING 'CORRESPONDENCE: '    DELIMITED BY SIZE               DTSCS77
01195             MAP-TEMPLATE-ID       DELIMITED BY SIZE               DTSCS77
01196          INTO                                                     DTSCS77
01197              MEVL-TEXT.                                           DTSCS77
01198      SKIP1                                                        DTSCS77
01199      MOVE MAP-CORR-OP-ID TO MEVL-SOURCE.                          DTSCS77
01200      SKIP1                                                        DTSCS77
01201      SET MEVL-NOT-CONVERTED-88 TO TRUE.                           DTSCS77
01202      SKIP1                                                        DTSCS77
01203      MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE                    DTSCS77
01204                                 MEVL-CHNG-DATE.                   DTSCS77
01205      SKIP1                                                        DTSCS77
01206      MOVE MEVL-REC TO MSKL-REC.                                   DTSCS77
01207      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS77
01208  P8300-EXIT.                                                      DTSCS77
01209      EXIT.                                                        DTSCS77
01210      EJECT                                                        DTSCS77
01211  P8400-ADD-MTCK.                                                  DTSCS77
01212      MOVE MAP-TRIGGER-DATE-AREA TO L015-S-DATE-AREA.              DTSCS77
01213      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS77
01214      IF L015-VALID                                                DTSCS77
01215          NEXT SENTENCE                                            DTSCS77
01216      ELSE                                                         DTSCS77
01217          GO TO P8400-EXIT.                                        DTSCS77
01218      SKIP1                                                        DTSCS77
01219      MOVE LOW-VALUES TO MTCK-REC.                                 DTSCS77
01220      SKIP1                                                        DTSCS77
01221      MOVE WRK-EMP-NO TO MTCK-EMP-NO.                              DTSCS77
01222      SET MTCK-TCK-88 TO TRUE.                                     DTSCS77
01223      MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME.           DTSCS77
01224      SKIP1                                                        DTSCS77
01225      MOVE +0 TO MTCK-PURGE-DATE.                                  DTSCS77
01226      SKIP1                                                        DTSCS77
01227      SET MTCK-TYPE-MANUAL-88 TO TRUE.                             DTSCS77
01228      MOVE L015-DATE TO MTCK-TRIGGER-DATE.                         DTSCS77
01229      MOVE +0 TO MTCK-ACKNOWLEDGED-DATE.                           DTSCS77
01230      MOVE MAP-CORR-OP-ID TO MTCK-SOURCE-OP-ID                     DTSCS77
01231                             MTCK-DEST-OP-ID.                      DTSCS77
01232      SKIP1                                                        DTSCS77
01233      SET MTCK-NOT-CONVERTED-88 TO TRUE.                           DTSCS77
01234      MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE                    DTSCS77
01235                                 MTCK-CHNG-DATE.                   DTSCS77
01236      SKIP1                                                        DTSCS77
01237      MOVE +0 TO MTCK-TEXT-CNT.                                    DTSCS77
01238      PERFORM P8410-TEXT THRU P8410-EXIT                           DTSCS77
01239          VARYING WRK-TEXT-SUB FROM 1 BY 1                         DTSCS77
01240          UNTIL WRK-TEXT-SUB > WRK-TEXT-MAX.                       DTSCS77
01241      SKIP1                                                        DTSCS77
01242      MOVE MTCK-REC TO MSKL-REC.                                   DTSCS77
01243      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS77
01244  P8400-EXIT.                                                      DTSCS77
01245      EXIT.                                                        DTSCS77
01246      SKIP3                                                        DTSCS77
01247  P8410-TEXT.                                                      DTSCS77
01248      INSPECT MAP-TEXT (WRK-TEXT-SUB)                              DTSCS77
01249          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01250      SKIP1                                                        DTSCS77
01251      MOVE MAP-TEXT (WRK-TEXT-SUB)                                 DTSCS77
01252        TO MTCK-TEXT (WRK-TEXT-SUB).                               DTSCS77
01253      IF MAP-TEXT (WRK-TEXT-SUB) = SPACES                          DTSCS77
01254          NEXT SENTENCE                                            DTSCS77
01255      ELSE                                                         DTSCS77
01256          MOVE WRK-TEXT-SUB TO MTCK-TEXT-CNT.                      DTSCS77
01257  P8410-EXIT.                                                      DTSCS77
01258      EXIT.                                                        DTSCS77
01259      EJECT                                                        DTSCS77
01260  P8810-LOCK-EMPLOYER.                                             DTSCS77
01261      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS77
01262      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS77
01263      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS77
01264      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS77
01265      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS77
01266      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS77
01267      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS77
01268      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS77
01269      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS77
01270      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS77
01271  P8810-EXIT.                                                      DTSCS77
01272      EXIT.                                                        DTSCS77
01273      EJECT                                                        DTSCS77
01274 /*****************************************************************DTSCS77
01275 * LINKS TO UTILITY MODULES                                        DTSCS77
01276 ******************************************************************DTSCS77
01277      SKIP1                                                        DTSCS77
01278  S001-FROM-FED-8.                                                 DTSCS77
01279      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS77
01280      GO TO S001-DATE.                                             DTSCS77
01281      SKIP1                                                        DTSCS77
01282  S001-DATE.                                                       DTSCS77
01283      EXEC CICS LINK                                               DTSCS77
01284          PROGRAM('DTSCU001')                                      DTSCS77
01285          COMMAREA(L001-COMM-AREA)                                 DTSCS77
01286      END-EXEC.                                                    DTSCS77
01287  S001-EXIT.                                                       DTSCS77
01288      EXIT.                                                        DTSCS77
01289      SKIP3                                                        DTSCS77
01290  S013-ADDR-NUM.                                                   DTSCS77
01291      MOVE +1 TO L013-MIN-CNT.                                     DTSCS77
01292      MOVE +999 TO L013-MAX-CNT.                                   DTSCS77
01293      GO TO S013-COUNT-FROM-SCREEN.                                DTSCS77
01294      SKIP1                                                        DTSCS77
01295  S013-COPY-CNT.                                                   DTSCS77
01296      MOVE +1 TO L013-MIN-CNT.                                     DTSCS77
01297      MOVE +99 TO L013-MAX-CNT.                                    DTSCS77
01298      GO TO S013-COUNT-FROM-SCREEN.                                DTSCS77
01299      SKIP1                                                        DTSCS77
01300  S013-COUNT-FROM-SCREEN.                                          DTSCS77
01301      EXEC CICS LINK                                               DTSCS77
01302          PROGRAM('DTSCU013')                                      DTSCS77
01303          COMMAREA(L013-COMM-AREA)                                 DTSCS77
01304      END-EXEC.                                                    DTSCS77
01305  S013-EXIT.                                                       DTSCS77
01306      EXIT.                                                        DTSCS77
01307      SKIP3                                                        DTSCS77
01308  S015-DATE-FROM-SCREEN.                                           DTSCS77
01309      EXEC CICS LINK                                               DTSCS77
01310          PROGRAM('DTSCU015')                                      DTSCS77
01311          COMMAREA(L015-COMM-AREA)                                 DTSCS77
01312      END-EXEC.                                                    DTSCS77
01313  S015-EXIT.                                                       DTSCS77
01314      EXIT.                                                        DTSCS77
01315      SKIP3                                                        DTSCS77
01316  S018-EMP-NO-FROM-SCREEN.                                         DTSCS77
01317      EXEC CICS LINK                                               DTSCS77
01318          PROGRAM('DTSCU018')                                      DTSCS77
01319          COMMAREA(L018-COMM-AREA)                                 DTSCS77
01320      END-EXEC.                                                    DTSCS77
01321  S018-EXIT.                                                       DTSCS77
01322      EXIT.                                                        DTSCS77
01323      SKIP3                                                        DTSCS77
01324  S028-CERT-NO-FROM-SCREEN.                                        DTSCS77
01325      EXEC CICS LINK                                               DTSCS77
01326          PROGRAM('DTSCU028')                                      DTSCS77
01327          COMMAREA(L028-COMM-AREA)                                 DTSCS77
01328      END-EXEC.                                                    DTSCS77
01329  S028-EXIT.                                                       DTSCS77
01330      EXIT.                                                        DTSCS77
01331      SKIP3                                                        DTSCS77
01332  S061-FLD-REP-LOOKUP.                                             DTSCS77
01333      EXEC CICS LINK                                               DTSCS77
01334          PROGRAM('DTSCU061')                                      DTSCS77
01335          COMMAREA(L061-COMM-AREA)                                 DTSCS77
01336      END-EXEC.                                                    DTSCS77
01337      SKIP1                                                        DTSCS77
01338      IF L061-FILE-CLOSED                                          DTSCS77
01339          MOVE L061-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01340          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01341          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01342          GO TO MAINLINE-EXIT.                                     DTSCS77
01343  S061-EXIT.                                                       DTSCS77
01344      EXIT.                                                        DTSCS77
01345      SKIP3                                                        DTSCS77
01346  S062-FLD-REP-DSCR.                                               DTSCS77
01347      EXEC CICS LINK                                               DTSCS77
01348          PROGRAM('DTSCU062')                                      DTSCS77
01349          COMMAREA(L062-COMM-AREA)                                 DTSCS77
01350      END-EXEC.                                                    DTSCS77
01351      SKIP1                                                        DTSCS77
01352      IF L062-FILE-CLOSED                                          DTSCS77
01353          MOVE L062-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01354          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01355          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01356          GO TO MAINLINE-EXIT.                                     DTSCS77
01357  S062-EXIT.                                                       DTSCS77
01358      EXIT.                                                        DTSCS77
01359      SKIP3                                                        DTSCS77
01360  S071-NAME-CONVERSION.                                            DTSCS77
01361      EXEC CICS LINK                                               DTSCS77
01362          PROGRAM('DTSCU071')                                      DTSCS77
01363          COMMAREA(L071-COMM-AREA)                                 DTSCS77
01364      END-EXEC.                                                    DTSCS77
01365  S071-EXIT.                                                       DTSCS77
01366      EXIT.                                                        DTSCS77
01367      SKIP3                                                        DTSCS77
01368  S075-LOOKUP-COOP-STATE.                                          DTSCS77
01369      EXEC CICS LINK                                               DTSCS77
01370          PROGRAM('DTSCU075')                                      DTSCS77
01371          COMMAREA(L075-COMM-AREA)                                 DTSCS77
01372      END-EXEC.                                                    DTSCS77
01373      SKIP1                                                        DTSCS77
01374      IF L075-FILE-CLOSED-88                                       DTSCS77
01375          MOVE L075-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01376          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01377          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01378          GO TO MAINLINE-EXIT.                                     DTSCS77
01379  S075-EXIT.                                                       DTSCS77
01380      EXIT.                                                        DTSCS77
01381      SKIP3                                                        DTSCS77
01382  S082-OP-ID-LOOKUP.                                               DTSCS77
01383      EXEC CICS LINK                                               DTSCS77
01384          PROGRAM('DTSCU082')                                      DTSCS77
01385          COMMAREA(L082-COMM-AREA)                                 DTSCS77
01386      END-EXEC.                                                    DTSCS77
01387      SKIP1                                                        DTSCS77
01388      IF L082-FILE-CLOSED                                          DTSCS77
01389          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01390          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01391          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01392          GO TO MAINLINE-EXIT.                                     DTSCS77
01393  S082-EXIT.                                                       DTSCS77
01394      EXIT.                                                        DTSCS77
01395      SKIP3                                                        DTSCS77
01396  S111-ADDR-LOOKUP.                                                DTSCS77
01397      EXEC CICS LINK                                               DTSCS77
01398          PROGRAM('DTSCU111')                                      DTSCS77
01399          COMMAREA(L111-COMM-AREA)                                 DTSCS77
01400      END-EXEC.                                                    DTSCS77
01401      SKIP1                                                        DTSCS77
01402      IF L111-FILE-CLOSED-88                                       DTSCS77
01403          MOVE L111-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01404          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01405          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01406          GO TO MAINLINE-EXIT.                                     DTSCS77
01407  S111-EXIT.                                                       DTSCS77
01408      EXIT.                                                        DTSCS77
01409      SKIP3                                                        DTSCS77
01410  S112-ADDR-FORMAT.                                                DTSCS77
01411      EXEC CICS LINK                                               DTSCS77
01412          PROGRAM('DTSCU112')                                      DTSCS77
01413          COMMAREA(L112-COMM-AREA)                                 DTSCS77
01414      END-EXEC.                                                    DTSCS77
01415  S112-EXIT.                                                       DTSCS77
01416      EXIT.                                                        DTSCS77
01417      SKIP3                                                        DTSCS77
01418  S221-EMP-LOCK.                                                   DTSCS77
01419      SET L221-START-UPDATE TO TRUE.                               DTSCS77
01420      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS77
01421      SKIP1                                                        DTSCS77
01422  S221-EMP-UNLOCK.                                                 DTSCS77
01423      SET L221-END-UPDATE TO TRUE.                                 DTSCS77
01424      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS77
01425      SKIP1                                                        DTSCS77
01426  S221-EMP-LOCK-UNLOCK.                                            DTSCS77
01427      EXEC CICS LINK                                               DTSCS77
01428          PROGRAM('DTSCU221')                                      DTSCS77
01429          COMMAREA(L221-COMM-AREA)                                 DTSCS77
01430      END-EXEC.                                                    DTSCS77
01431      SKIP1                                                        DTSCS77
01432      IF L221-FILE-CLOSED                                          DTSCS77
01433          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01434          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01435          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01436          GO TO MAINLINE-EXIT.                                     DTSCS77
01437      SKIP1                                                        DTSCS77
01438      IF L221-NOT-OK                                               DTSCS77
01439          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS77
01440  S221-EXIT.                                                       DTSCS77
01441      EXIT.                                                        DTSCS77
01442      SKIP3                                                        DTSCS77
01443  S803-REQ-SCR-ID-EDIT.                                            DTSCS77
01444      EXEC CICS LINK                                               DTSCS77
01445          PROGRAM ('DTSCU803')                                     DTSCS77
01446          COMMAREA (DFHCOMMAREA)                                   DTSCS77
01447      END-EXEC.                                                    DTSCS77
01448  S803-EXIT.                                                       DTSCS77
01449      EXIT.                                                        DTSCS77
01450      SKIP3                                                        DTSCS77
01451  S804-INVALID-KEY.                                                DTSCS77
01452      EXEC CICS LINK                                               DTSCS77
01453          PROGRAM ('DTSCU804')                                     DTSCS77
01454          COMMAREA (DFHCOMMAREA)                                   DTSCS77
01455      END-EXEC.                                                    DTSCS77
01456  S804-EXIT.                                                       DTSCS77
01457      EXIT.                                                        DTSCS77
01458      SKIP3                                                        DTSCS77
01459  S805-MSG-AREA.                                                   DTSCS77
01460      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS77
01461      SKIP1                                                        DTSCS77
01462      EXEC CICS LINK                                               DTSCS77
01463          PROGRAM ('DTSCU805')                                     DTSCS77
01464          COMMAREA (L805-COMM-AREA)                                DTSCS77
01465      END-EXEC.                                                    DTSCS77
01466      SKIP1                                                        DTSCS77
01467      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS77
01468  S805-EXIT.                                                       DTSCS77
01469      EXIT.                                                        DTSCS77
01470      EJECT                                                        DTSCS77
01471  S810-READ.                                                       DTSCS77
01472      SET L810-READ-88 TO TRUE.                                    DTSCS77
01473      GO TO S810-IO.                                               DTSCS77
01474      SKIP1                                                        DTSCS77
01475  S810-START-BROWSE.                                               DTSCS77
01476      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS77
01477      GO TO S810-IO.                                               DTSCS77
01478      SKIP1                                                        DTSCS77
01479  S810-READ-NEXT.                                                  DTSCS77
01480      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS77
01481      GO TO S810-IO.                                               DTSCS77
01482      SKIP1                                                        DTSCS77
01483  S810-READ-PREV.                                                  DTSCS77
01484      SET L810-READ-PREV-88 TO TRUE.                               DTSCS77
01485      GO TO S810-IO.                                               DTSCS77
01486      SKIP1                                                        DTSCS77
01487  S810-END-BROWSE.                                                 DTSCS77
01488      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS77
01489      GO TO S810-IO.                                               DTSCS77
01490      SKIP1                                                        DTSCS77
01491  S810-COUNT.                                                      DTSCS77
01492      SET L810-COUNT-88 TO TRUE.                                   DTSCS77
01493      GO TO S810-IO.                                               DTSCS77
01494      SKIP1                                                        DTSCS77
01495  S810-REWRITE.                                                    DTSCS77
01496      SET L810-REWRITE-88 TO TRUE.                                 DTSCS77
01497      GO TO S810-IO.                                               DTSCS77
01498      SKIP1                                                        DTSCS77
01499  S810-WRITE.                                                      DTSCS77
01500      SET L810-WRITE-88 TO TRUE.                                   DTSCS77
01501      GO TO S810-IO.                                               DTSCS77
01502      SKIP1                                                        DTSCS77
01503  S810-DELETE.                                                     DTSCS77
01504      SET L810-DELETE-88 TO TRUE.                                  DTSCS77
01505      GO TO S810-IO.                                               DTSCS77
01506      SKIP1                                                        DTSCS77
01507  S810-IO.                                                         DTSCS77
01508      SKIP1                                                        DTSCS77
01509      EXEC CICS LINK                                               DTSCS77
01510          PROGRAM ('DTSCU810')                                     DTSCS77
01511          COMMAREA (L810-COMM-AREA)                                DTSCS77
01512      END-EXEC.                                                    DTSCS77
01513      SKIP1                                                        DTSCS77
01514      IF L810-FILE-CLOSED-88                                       DTSCS77
01515          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01516          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01517          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01518          GO TO MAINLINE-EXIT.                                     DTSCS77
01519  S810-EXIT.                                                       DTSCS77
01520      EXIT.                                                        DTSCS77
01521      EJECT                                                        DTSCS77
01522  S827-WRITE.                                                      DTSCS77
01523      SET L827-WRITE-88 TO TRUE.                                   DTSCS77
01524      GO TO S827-IO.                                               DTSCS77
01525      SKIP1                                                        DTSCS77
01526  S827-IO.                                                         DTSCS77
01527      SKIP1                                                        DTSCS77
01528      EXEC CICS LINK                                               DTSCS77
01529          PROGRAM ('DTSCU827')                                     DTSCS77
01530          COMMAREA (L827-COMM-AREA)                                DTSCS77
01531      END-EXEC.                                                    DTSCS77
01532      SKIP1                                                        DTSCS77
01533      IF L827-FILE-CLOSED-88                                       DTSCS77
01534          MOVE L827-MSG-AREA TO LCCM-MSG-AREA                      DTSCS77
01535          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS77
01536          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS77
01537          GO TO MAINLINE-EXIT.                                     DTSCS77
01538  S827-EXIT.                                                       DTSCS77
01539      EXIT.                                                        DTSCS77
01540      EJECT                                                        DTSCS77
01541  S851-SCREEN-PROCESSING.                                          DTSCS77
01542      EXEC CICS LINK                                               DTSCS77
01543          PROGRAM ('DTSCU851')                                     DTSCS77
01544          COMMAREA (L851-COMM-AREA)                                DTSCS77
01545      END-EXEC.                                                    DTSCS77
01546  S851-EXIT.                                                       DTSCS77
01547      EXIT.                                                        DTSCS77
01548      SKIP3                                                        DTSCS77
01549  S899-ABEND.                                                      DTSCS77
01550      EXEC CICS ABEND                                              DTSCS77
01551          ABCODE(WRK-ABEND-CD)                                     DTSCS77
01552      END-EXEC.                                                    DTSCS77
01553  S899-EXIT.                                                       DTSCS77
01554      EXIT.                                                        DTSCS77
01555 /*****************************************************************DTSCS77
01556 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS77
01557 ******************************************************************DTSCS77
01558      SKIP1                                                        DTSCS77
01559  S1000-SCREEN-EDITS.                                              DTSCS77
01560      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS77
01561      IF LCCM-MSG                                                  DTSCS77
01562          GO TO S1000-EXIT.                                        DTSCS77
01563      SKIP1                                                        DTSCS77
01564      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS77
01565      SKIP1                                                        DTSCS77
01566      PERFORM S1200-TEMPLATE-ID THRU S1200-EXIT.                   DTSCS77
01567      PERFORM S1300-ADDR-TYPE THRU S1300-EXIT.                     DTSCS77
01568      PERFORM S1400-ADDR-ID-NO THRU S1400-EXIT.                    DTSCS77
01569      PERFORM S1500-CORR-OP-ID THRU S1500-EXIT.                    DTSCS77
01570      PERFORM S1600-FLD-REP-ID THRU S1600-EXIT.                    DTSCS77
01571      PERFORM S1650-LIEN-CERT  THRU S1650-EXIT.                    DTSCS77
01572      PERFORM S1700-COPY-CNT THRU S1700-EXIT.                      DTSCS77
01573      PERFORM S1800-CORR-DATE THRU S1800-EXIT.                     DTSCS77
01574      PERFORM S2100-CORR-STATE THRU S2100-EXIT.                    DTSCS77
01575      PERFORM S1900-TRIGGER-DATE THRU S1900-EXIT.                  DTSCS77
01576      PERFORM S2200-QUEUE-OP-ID THRU S2200-EXIT.                   DTSCS77
01577      SKIP1                                                        DTSCS77
01578      PERFORM S4000-MAILING-ADDR THRU S4000-EXIT.                  DTSCS77
01579  S1000-EXIT. EXIT.                                                DTSCS77
01580      EJECT                                                        DTSCS77
01581  S1100-EDIT-KEY.                                                  DTSCS77
01582      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS77
01583  S1100-EXIT. EXIT.                                                DTSCS77
01584 /*****************************************************************DTSCS77
01585 *                                                                 DTSCS77
01586 ******************************************************************DTSCS77
01587  S1101-EMP-NO.                                                    DTSCS77
01588      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS77
01589      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS77
01590      SKIP1                                                        DTSCS77
01591      IF L018-NO-ENTRY                                             DTSCS77
01592         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS77
01593         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS77
01594         GO TO S1101-EXIT.                                         DTSCS77
01595      SKIP1                                                        DTSCS77
01596      IF L018-NOT-VALID                                            DTSCS77
01597         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS77
01598         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS77
01599         GO TO S1101-EXIT.                                         DTSCS77
01600      SKIP1                                                        DTSCS77
01601      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS77
01602  S1101-EXIT. EXIT.                                                DTSCS77
01603      SKIP3                                                        DTSCS77
01604  S1110-READ-MPRF.                                                 DTSCS77
01605      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS77
01606      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS77
01607      SET MPRF-PRF-88 TO TRUE.                                     DTSCS77
01608      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS77
01609      PERFORM S810-READ THRU S810-EXIT.                            DTSCS77
01610      IF L810-NO-REC-88                                            DTSCS77
01611          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS77
01612          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS77
01613      ELSE                                                         DTSCS77
01614          MOVE MSKL-REC TO MPRF-REC                                DTSCS77
01615          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS77
01616  S1110-EXIT.                                                      DTSCS77
01617      EXIT.                                                        DTSCS77
01618      SKIP3                                                        DTSCS77
01619  S1199-ERROR.                                                     DTSCS77
01620      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS77
01621                                         MAP-EMP-NO-2-A.           DTSCS77
01622      IF LCCM-NO-MSG                                               DTSCS77
01623         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01624         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS77
01625         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01626  S1199-EXIT. EXIT.                                                DTSCS77
01627 /*****************************************************************DTSCS77
01628 *                                                                 DTSCS77
01629 ******************************************************************DTSCS77
01630  S1200-TEMPLATE-ID.                                               DTSCS77
01631      INSPECT MAP-TEMPLATE-ID                                      DTSCS77
01632          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01633      SKIP1                                                        DTSCS77
01634      IF MAP-TEMPLATE-ID = SPACES                                  DTSCS77
01635          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS77
01636          PERFORM S1201-ERROR THRU S1201-EXIT.                     DTSCS77
01637  S1200-EXIT. EXIT.                                                DTSCS77
01638      SKIP3                                                        DTSCS77
01639  S1201-ERROR.                                                     DTSCS77
01640      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TEMPLATE-ID-A.         DTSCS77
01641      IF LCCM-NO-MSG                                               DTSCS77
01642         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01643         MOVE CATB-CURSOR             TO MAP-TEMPLATE-ID-L         DTSCS77
01644         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01645  S1201-EXIT. EXIT.                                                DTSCS77
01646 /*****************************************************************DTSCS77
01647 *                                                                 DTSCS77
01648 ******************************************************************DTSCS77
01649  S1300-ADDR-TYPE.                                                 DTSCS77
01650      IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES                      DTSCS77
01651          SET MAP-ADDR-TAX-88 TO TRUE                              DTSCS77
01652      ELSE                                                         DTSCS77
01653      IF MAP-ADDR-VALID-88                                         DTSCS77
01654          NEXT SENTENCE                                            DTSCS77
01655      ELSE                                                         DTSCS77
01656          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01657          PERFORM S1301-ERROR THRU S1301-EXIT.                     DTSCS77
01658  S1300-EXIT. EXIT.                                                DTSCS77
01659      SKIP3                                                        DTSCS77
01660  S1301-ERROR.                                                     DTSCS77
01661      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A.           DTSCS77
01662      IF LCCM-NO-MSG                                               DTSCS77
01663         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01664         MOVE CATB-CURSOR             TO MAP-ADDR-TYPE-L           DTSCS77
01665         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01666  S1301-EXIT. EXIT.                                                DTSCS77
01667 /*****************************************************************DTSCS77
01668 *                                                                 DTSCS77
01669 ******************************************************************DTSCS77
01670  S1400-ADDR-ID-NO.                                                DTSCS77
01671      INSPECT MAP-ADDR-ID-NO                                       DTSCS77
01672          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01673      SKIP1                                                        DTSCS77
01674      IF MAP-ADDR-TAD-88                                           DTSCS77
01675         PERFORM S1410-ADDR-TAD THRU S1410-EXIT                    DTSCS77
01676         GO TO S1400-EXIT.                                         DTSCS77
01677      SKIP1                                                        DTSCS77
01678      IF MAP-ADDR-ID-NO = SPACES                                   DTSCS77
01679          IF MAP-ADDR-NONE-88                                      DTSCS77
01680              GO TO S1400-EXIT                                     DTSCS77
01681          ELSE                                                     DTSCS77
01682              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS77
01683              PERFORM S1401-ERROR THRU S1401-EXIT                  DTSCS77
01684              GO TO S1400-EXIT.                                    DTSCS77
01685      SKIP1                                                        DTSCS77
01686      IF MAP-ADDR-NONE-88                                          DTSCS77
01687          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS77
01688          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS77
01689          GO TO S1400-EXIT.                                        DTSCS77
01690      SKIP1                                                        DTSCS77
01691      MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA.                 DTSCS77
01692      MOVE   +1 TO L013-MIN-CNT                                    DTSCS77
01693      MOVE +999 TO L013-MAX-CNT.                                   DTSCS77
01694      PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT.               DTSCS77
01695      SKIP1                                                        DTSCS77
01696      IF L013-VALID                                                DTSCS77
01697          MOVE L013-CNT TO MAP-ADDR-ID-NO-Z                        DTSCS77
01698          IF MAP-ADDR-TAA-OPO-88                                   DTSCS77
01699              PERFORM S1420-ADDR-TAA-OPO THRU S1420-EXIT           DTSCS77
01700          ELSE                                                     DTSCS77
01701          IF MAP-ADDR-LIN-88                                       DTSCS77
01702              PERFORM S1430-ADDR-LIN THRU S1430-EXIT               DTSCS77
01703          ELSE                                                     DTSCS77
01704          IF MAP-ADDR-DPC-88                                       DTSCS77
01705              PERFORM S1440-ADDR-DPC THRU S1440-EXIT               DTSCS77
01706          ELSE                                                     DTSCS77
01707              NEXT SENTENCE                                        DTSCS77
01708      ELSE                                                         DTSCS77
01709      IF L013-NO-ENTRY                                             DTSCS77
01710          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS77
01711          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS77
01712      ELSE                                                         DTSCS77
01713      IF L013-INVALID-NEGATIVE                                     DTSCS77
01714          MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA               DTSCS77
01715          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS77
01716      ELSE                                                         DTSCS77
01717      IF L013-EXCEEDS-MIN-MAX                                      DTSCS77
01718          MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS77
01719          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS77
01720      ELSE                                                         DTSCS77
01721          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01722          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS77
01723  S1400-EXIT. EXIT.                                                DTSCS77
01724      SKIP3                                                        DTSCS77
01725  S1401-ERROR.                                                     DTSCS77
01726      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A.         DTSCS77
01727      IF LCCM-NO-MSG                                               DTSCS77
01728         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01729         MOVE CATB-CURSOR             TO MAP-ADDR-ID-NO-L          DTSCS77
01730         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01731  S1401-EXIT. EXIT.                                                DTSCS77
01732      SKIP3                                                        DTSCS77
01733  S1410-ADDR-TAD.                                                  DTSCS77
01734      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS77
01735      IF MAP-ADDR-TAX-88                                           DTSCS77
01736          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS77
01737          SET L111-ID-NO-TAD-MAIL-88 TO TRUE                       DTSCS77
01738      ELSE                                                         DTSCS77
01739      IF MAP-ADDR-PHY-88                                           DTSCS77
01740          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS77
01741          SET L111-ID-NO-TAD-PHYS-88 TO TRUE                       DTSCS77
01742      ELSE                                                         DTSCS77
01743          GO TO S899-ABEND.                                        DTSCS77
01744      SKIP1                                                        DTSCS77
01745      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS77
01746      SKIP1                                                        DTSCS77
01747      IF L111-ADDR-NOT-FOUND-88                                    DTSCS77
01748         MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                      DTSCS77
01749         PERFORM S1401-ERROR THRU S1401-EXIT.                      DTSCS77
01750  S1410-EXIT.                                                      DTSCS77
01751      EXIT.                                                        DTSCS77
01752      SKIP3                                                        DTSCS77
01753  S1420-ADDR-TAA-OPO.                                              DTSCS77
01754      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS77
01755      IF MAP-ADDR-TAX-ALT-88                                       DTSCS77
01756          SET L111-LOOKUP-TAA-88 TO TRUE                           DTSCS77
01757      ELSE                                                         DTSCS77
01758      IF MAP-ADDR-OPO-88                                           DTSCS77
01759          SET L111-LOOKUP-OPO-88 TO TRUE                           DTSCS77
01760      ELSE                                                         DTSCS77
01761          GO TO S899-ABEND.                                        DTSCS77
01762      SKIP1                                                        DTSCS77
01763      IF L013-CNT = +0                                             DTSCS77
01764          MOVE 1                   TO L111-ID-NO                   DTSCS77
01765      ELSE                                                         DTSCS77
01766          MOVE L013-CNT            TO L111-ID-NO.                  DTSCS77
01767      SKIP1                                                        DTSCS77
01768      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS77
01769      SKIP1                                                        DTSCS77
01770      IF L111-ADDR-NOT-FOUND-88                                    DTSCS77
01771         MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                      DTSCS77
01772         PERFORM S1401-ERROR THRU S1401-EXIT.                      DTSCS77
01773  S1420-EXIT.                                                      DTSCS77
01774      EXIT.                                                        DTSCS77
01775      SKIP3                                                        DTSCS77
01776  S1430-ADDR-LIN.                                                  DTSCS77
01777      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS77
01778      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS77
01779      SET MSKL-LIN-88 TO TRUE.                                     DTSCS77
01780      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS77
01781      IF L013-CNT > L810-RECORD-CNT                                DTSCS77
01782          MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                     DTSCS77
01783          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS77
01784  S1430-EXIT.                                                      DTSCS77
01785      EXIT.                                                        DTSCS77
01786      SKIP3                                                        DTSCS77
01787  S1440-ADDR-DPC.                                                  DTSCS77
01788      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS77
01789      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS77
01790      SET MSKL-DPC-88 TO TRUE.                                     DTSCS77
01791      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS77
01792      IF L013-CNT > L810-RECORD-CNT                                DTSCS77
01793          MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                     DTSCS77
01794          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS77
01795  S1440-EXIT.                                                      DTSCS77
01796      EXIT.                                                        DTSCS77
01797 /*****************************************************************DTSCS77
01798 *                                                                 DTSCS77
01799 ******************************************************************DTSCS77
01800  S1500-CORR-OP-ID.                                                DTSCS77
01801      INSPECT MAP-CORR-OP-ID                                       DTSCS77
01802          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01803      SKIP1                                                        DTSCS77
01804      IF MAP-CORR-OP-ID = SPACES                                   DTSCS77
01805          MOVE LCCM-RESP-OP-ID TO MAP-CORR-OP-ID.                  DTSCS77
01806      SKIP1                                                        DTSCS77
01807      IF MAP-CORR-OP-ID = LCCM-OP-ID                               DTSCS77
01808          MOVE MAP-CORR-OP-ID TO LCCM-RESP-OP-ID                   DTSCS77
01809          GO TO S1500-EXIT.                                        DTSCS77
01810      SKIP1                                                        DTSCS77
01811      MOVE MAP-CORR-OP-ID TO L082-OP-ID.                           DTSCS77
01812      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                    DTSCS77
01813      IF (L082-VALID-OP) AND (L082-EXTERNAL-88)                    DTSCS77
01814          MOVE MAP-CORR-OP-ID TO LCCM-RESP-OP-ID                   DTSCS77
01815      ELSE                                                         DTSCS77
01816          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01817          PERFORM S1501-ERROR THRU S1501-EXIT.                     DTSCS77
01818  S1500-EXIT. EXIT.                                                DTSCS77
01819      SKIP3                                                        DTSCS77
01820  S1501-ERROR.                                                     DTSCS77
01821      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CORR-OP-ID-A.          DTSCS77
01822      IF LCCM-NO-MSG                                               DTSCS77
01823         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01824         MOVE CATB-CURSOR             TO MAP-CORR-OP-ID-L          DTSCS77
01825         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01826  S1501-EXIT. EXIT.                                                DTSCS77
01827 /*****************************************************************DTSCS77
01828 *                                                                 DTSCS77
01829 ******************************************************************DTSCS77
01830  S1600-FLD-REP-ID.                                                DTSCS77
01831      INSPECT MAP-FLD-REP-ID                                       DTSCS77
01832          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01833      SKIP1                                                        DTSCS77
01834      IF MAP-FLD-REP-ID = SPACES                                   DTSCS77
01835          MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST                  DTSCS77
01836          MOVE WRK-EMP-NO TO L061-EMP-NO                           DTSCS77
01837          PERFORM S061-FLD-REP-LOOKUP THRU S061-EXIT               DTSCS77
01838          MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID                   DTSCS77
01839          GO TO S1600-EXIT.                                        DTSCS77
01840      SKIP1                                                        DTSCS77
01841      IF MAP-FLD-REP-NONE-88                                       DTSCS77
01842          GO TO S1600-EXIT.                                        DTSCS77
01843      SKIP1                                                        DTSCS77
01844      MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID.                      DTSCS77
01845      PERFORM S062-FLD-REP-DSCR THRU S062-EXIT.                    DTSCS77
01846      IF L062-NOT-VALID                                            DTSCS77
01847          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01848          PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS77
01849          GO TO S1600-EXIT.                                        DTSCS77
01850  S1600-EXIT. EXIT.                                                DTSCS77
01851      SKIP3                                                        DTSCS77
01852  S1601-ERROR.                                                     DTSCS77
01853      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-REP-ID-A.          DTSCS77
01854      IF LCCM-NO-MSG                                               DTSCS77
01855         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01856         MOVE CATB-CURSOR             TO MAP-FLD-REP-ID-L          DTSCS77
01857         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01858  S1601-EXIT. EXIT.                                                DTSCS77
01859 /*****************************************************************DTSCS77
01860 *                                                                 DTSCS77
01861 ******************************************************************DTSCS77
01862  S1650-LIEN-CERT.                                                 DTSCS77
01863      INSPECT MAP-CERT-NUM1                                        DTSCS77
01864          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01865      SKIP1                                                        DTSCS77
01866      INSPECT MAP-CERT-NUM2                                        DTSCS77
01867          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01868      SKIP1                                                        DTSCS77
01869      IF MAP-CERT-NUM1 = SPACES AND MAP-CERT-NUM2 = SPACES         DTSCS77
01870          GO TO S1650-EXIT.                                        DTSCS77
01871      SKIP1                                                        DTSCS77
01872      MOVE MAP-LIEN-CERT-AREA TO L028-S-NO-AREA.                   DTSCS77
01873                                                                   DTSCS77
01874      PERFORM S028-CERT-NO-FROM-SCREEN THRU S028-EXIT.             DTSCS77
01875      SKIP1                                                        DTSCS77
01876      IF L028-VALID                                                DTSCS77
01877          NEXT SENTENCE                                            DTSCS77
01878      ELSE                                                         DTSCS77
01879      IF L028-NO-ENTRY                                             DTSCS77
01880          NEXT SENTENCE                                            DTSCS77
01881      ELSE                                                         DTSCS77
01882          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01883          PERFORM S1651-ERROR THRU S1651-EXIT.                     DTSCS77
01884                                                                   DTSCS77
01885      MOVE L028-NO TO WRK-CERT-NO.                                 DTSCS77
01886                                                                   DTSCS77
01887      MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9.                DTSCS77
01888                                                                   DTSCS77
01889      IF L001-FED-8-MO > 09                                        DTSCS77
01890         ADD 1 TO L001-FED-8-YR.                                   DTSCS77
01891                                                                   DTSCS77
01892      IF WRK-EDIT-CERT-NO1  > L001-FED-8-YR                        DTSCS77
01893          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01894          PERFORM S1651-ERROR THRU S1651-EXIT.                     DTSCS77
01895                                                                   DTSCS77
01896  S1650-EXIT. EXIT.                                                DTSCS77
01897      SKIP3                                                        DTSCS77
01898  S1651-ERROR.                                                     DTSCS77
01899      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CERT-NUM1-A           DTSCS77
01900                                         MAP-CERT-NUM2-A.          DTSCS77
01901      IF LCCM-NO-MSG                                               DTSCS77
01902         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01903         MOVE CATB-CURSOR             TO MAP-CERT-NUM1-L           DTSCS77
01904         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01905  S1651-EXIT. EXIT.                                                DTSCS77
01906 /*****************************************************************DTSCS77
01907 *                                                                 DTSCS77
01908 ******************************************************************DTSCS77
01909  S1700-COPY-CNT.                                                  DTSCS77
01910      INSPECT MAP-COPY-CNT                                         DTSCS77
01911          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
01912      SKIP1                                                        DTSCS77
01913      IF MAP-COPY-CNT = SPACES                                     DTSCS77
01914          MOVE 1 TO MAP-COPY-CNT-Z                                 DTSCS77
01915          GO TO S1700-EXIT.                                        DTSCS77
01916      SKIP1                                                        DTSCS77
01917      MOVE MAP-COPY-CNT-AREA TO L013-S-CNT-AREA.                   DTSCS77
01918      MOVE +1 TO  L013-MIN-CNT.                                    DTSCS77
01919      MOVE +99 TO L013-MAX-CNT.                                    DTSCS77
01920      PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT.               DTSCS77
01921      SKIP1                                                        DTSCS77
01922      IF L013-VALID                                                DTSCS77
01923          MOVE L013-CNT TO MAP-COPY-CNT-Z                          DTSCS77
01924      ELSE                                                         DTSCS77
01925      IF L013-NO-ENTRY                                             DTSCS77
01926          NEXT SENTENCE                                            DTSCS77
01927      ELSE                                                         DTSCS77
01928      IF L013-INVALID-NEGATIVE                                     DTSCS77
01929          MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA               DTSCS77
01930          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS77
01931      ELSE                                                         DTSCS77
01932      IF L013-EXCEEDS-MIN-MAX                                      DTSCS77
01933          MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS77
01934          PERFORM S1701-ERROR THRU S1701-EXIT                      DTSCS77
01935      ELSE                                                         DTSCS77
01936          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
01937          PERFORM S1701-ERROR THRU S1701-EXIT.                     DTSCS77
01938  S1700-EXIT. EXIT.                                                DTSCS77
01939      SKIP3                                                        DTSCS77
01940  S1701-ERROR.                                                     DTSCS77
01941      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COPY-CNT-A.           DTSCS77
01942      IF LCCM-NO-MSG                                               DTSCS77
01943         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01944         MOVE CATB-CURSOR             TO MAP-COPY-CNT-L            DTSCS77
01945         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01946  S1701-EXIT. EXIT.                                                DTSCS77
01947 /*****************************************************************DTSCS77
01948 *                                                                 DTSCS77
01949 ******************************************************************DTSCS77
01950  S1800-CORR-DATE.                                                 DTSCS77
01951      MOVE MAP-CORR-DATE-AREA TO L015-S-DATE-AREA.                 DTSCS77
01952      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS77
01953      SKIP1                                                        DTSCS77
01954      IF L015-NO-ENTRY                                             DTSCS77
01955          MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY                   DTSCS77
01956          MOVE WRK-DISPLAY-MO TO MAP-CORR-MO                       DTSCS77
01957          MOVE WRK-DISPLAY-DA TO MAP-CORR-DA                       DTSCS77
01958          MOVE WRK-DISPLAY-YR TO MAP-CORR-YR                       DTSCS77
01959      ELSE                                                         DTSCS77
01960      IF L015-NOT-VALID                                            DTSCS77
01961          MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA             DTSCS77
01962          PERFORM S1801-ERROR          THRU S1801-EXIT             DTSCS77
01963      ELSE                                                         DTSCS77
01964      IF L015-DATE < LCCM-CURR-RUN-DATE                            DTSCS77
01965          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS77
01966          PERFORM S1801-ERROR THRU S1801-EXIT.                     DTSCS77
01967  S1800-EXIT. EXIT.                                                DTSCS77
01968      SKIP3                                                        DTSCS77
01969  S1801-ERROR.                                                     DTSCS77
01970      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CORR-MO-A             DTSCS77
01971                                         MAP-CORR-DA-A             DTSCS77
01972                                         MAP-CORR-YR-A.            DTSCS77
01973      IF LCCM-NO-MSG                                               DTSCS77
01974         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
01975         MOVE CATB-CURSOR             TO MAP-CORR-MO-L             DTSCS77
01976         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
01977  S1801-EXIT. EXIT.                                                DTSCS77
01978 /*****************************************************************DTSCS77
01979 *                                                                 DTSCS77
01980 ******************************************************************DTSCS77
01981  S1900-TRIGGER-DATE.                                              DTSCS77
01982      MOVE MAP-TRIGGER-DATE-AREA TO L015-S-DATE-AREA.              DTSCS77
01983      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS77
01984      SKIP1                                                        DTSCS77
01985      IF L015-NO-ENTRY                                             DTSCS77
01986          NEXT SENTENCE                                            DTSCS77
01987      ELSE                                                         DTSCS77
01988      IF L015-NOT-VALID                                            DTSCS77
01989          MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA             DTSCS77
01990          PERFORM S1901-ERROR          THRU S1901-EXIT             DTSCS77
01991      ELSE                                                         DTSCS77
01992      IF L015-DATE < LCCM-CURR-RUN-DATE                            DTSCS77
01993          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS77
01994          PERFORM S1901-ERROR THRU S1901-EXIT.                     DTSCS77
01995  S1900-EXIT. EXIT.                                                DTSCS77
01996      SKIP3                                                        DTSCS77
01997  S1901-ERROR.                                                     DTSCS77
01998      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TRIGGER-MO-A          DTSCS77
01999                                         MAP-TRIGGER-DA-A          DTSCS77
02000                                         MAP-TRIGGER-YR-A.         DTSCS77
02001      IF LCCM-NO-MSG                                               DTSCS77
02002         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
02003         MOVE CATB-CURSOR             TO MAP-TRIGGER-MO-L          DTSCS77
02004         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
02005  S1901-EXIT. EXIT.                                                DTSCS77
02006 /*****************************************************************DTSCS77
02007 *                                                                 DTSCS77
02008 ******************************************************************DTSCS77
02009  S2100-CORR-STATE.                                                DTSCS77
02010      IF MAP-CORR-STATE = SPACE OR LOW-VALUE                       DTSCS77
02011          GO TO S2100-EXIT.                                        DTSCS77
02012      MOVE MAP-CORR-STATE TO L075-LOOKUP-STATE.                    DTSCS77
02013      SET L075-LOOKUP-ADDR-88 TO TRUE.                             DTSCS77
02014      PERFORM S075-LOOKUP-COOP-STATE THRU S075-EXIT.               DTSCS77
02015      IF L075-ADDR-FOUND-88                                        DTSCS77
02016          NEXT SENTENCE                                            DTSCS77
02017      ELSE                                                         DTSCS77
02018          MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA             DTSCS77
02019          PERFORM S2101-ERROR          THRU S2101-EXIT.            DTSCS77
02020  S2100-EXIT. EXIT.                                                DTSCS77
02021      SKIP3                                                        DTSCS77
02022  S2101-ERROR.                                                     DTSCS77
02023      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-CORR-STATE-A.         DTSCS77
02024      IF LCCM-NO-MSG                                               DTSCS77
02025         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
02026         MOVE CATB-CURSOR             TO MAP-CORR-STATE-L          DTSCS77
02027         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
02028  S2101-EXIT. EXIT.                                                DTSCS77
02029 /*****************************************************************DTSCS77
02030 *                                                                 DTSCS77
02031 ******************************************************************DTSCS77
02032  S2200-QUEUE-OP-ID.                                               DTSCS77
02033      INSPECT MAP-QUEUE-OP-ID                                      DTSCS77
02034          CONVERTING LOW-VALUES TO SPACES.                         DTSCS77
02035      SKIP1                                                        DTSCS77
02036      IF MAP-QUEUE-OP-ID = SPACES                                  DTSCS77
02037          MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID.           DTSCS77
02038      SKIP1                                                        DTSCS77
02039      IF MAP-QUEUE-OP-ID = LCCM-CORR-QUEUE-OP-ID                   DTSCS77
02040          GO TO S2200-EXIT.                                        DTSCS77
02041      SKIP1                                                        DTSCS77
02042      MOVE MAP-QUEUE-OP-ID TO L082-OP-ID.                          DTSCS77
02043      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                    DTSCS77
02044      IF L082-VALID-OP                                             DTSCS77
02045          MOVE MAP-QUEUE-OP-ID TO LCCM-CORR-QUEUE-OP-ID            DTSCS77
02046      ELSE                                                         DTSCS77
02047          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS77
02048          PERFORM S2201-ERROR THRU S2201-EXIT.                     DTSCS77
02049  S2200-EXIT. EXIT.                                                DTSCS77
02050      SKIP3                                                        DTSCS77
02051  S2201-ERROR.                                                     DTSCS77
02052      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-QUEUE-OP-ID-A.         DTSCS77
02053      IF LCCM-NO-MSG                                               DTSCS77
02054         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS77
02055         MOVE CATB-CURSOR             TO MAP-QUEUE-OP-ID-L         DTSCS77
02056         SET CURSOR-SET-YES TO TRUE.                               DTSCS77
02057  S2201-EXIT. EXIT.                                                DTSCS77
02058      EJECT                                                        DTSCS77
02059  S4000-MAILING-ADDR.                                              DTSCS77
02060      MOVE LOW-VALUES TO MAP-MAILING-LINE-1                        DTSCS77
02061                         MAP-MAILING-LINE-2                        DTSCS77
02062                         MAP-MAILING-LINE-3                        DTSCS77
02063                         MAP-MAILING-LINE-4                        DTSCS77
02064                         MAP-MAILING-LINE-5.                       DTSCS77
02065      SKIP1                                                        DTSCS77
02066      IF MAP-ADDR-NONE-88                                          DTSCS77
02067          GO TO S4000-EXIT.                                        DTSCS77
02068      SKIP1                                                        DTSCS77
02069      IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES)                    DTSCS77
02070             OR                                                    DTSCS77
02071         (MAP-ADDR-VALID-88)                                       DTSCS77
02072          NEXT SENTENCE                                            DTSCS77
02073      ELSE                                                         DTSCS77
02074          GO TO S4000-EXIT.                                        DTSCS77
02075      SKIP1                                                        DTSCS77
02076      MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA.                 DTSCS77
02077      PERFORM S013-ADDR-NUM THRU S013-EXIT.                        DTSCS77
02078      SKIP1                                                        DTSCS77
02079      IF L013-NO-ENTRY                                             DTSCS77
02080          IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES)                DTSCS77
02081                OR                                                 DTSCS77
02082             (MAP-ADDR-TAD-88)                                     DTSCS77
02083              NEXT SENTENCE                                        DTSCS77
02084          ELSE                                                     DTSCS77
02085              GO TO S4000-EXIT                                     DTSCS77
02086      ELSE                                                         DTSCS77
02087      IF L013-VALID                                                DTSCS77
02088          NEXT SENTENCE                                            DTSCS77
02089      ELSE                                                         DTSCS77
02090          GO TO S4000-EXIT.                                        DTSCS77
02091      SKIP1                                                        DTSCS77
02092      IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES)                    DTSCS77
02093            OR                                                     DTSCS77
02094         (MAP-ADDR-TAD-88)                                         DTSCS77
02095          PERFORM S4100-TAD-ADDR THRU S4100-EXIT                   DTSCS77
02096      ELSE                                                         DTSCS77
02097      IF MAP-ADDR-TAA-OPO-88                                       DTSCS77
02098          PERFORM S4200-TAA-OPO-ADDR THRU S4200-EXIT               DTSCS77
02099      ELSE                                                         DTSCS77
02100      IF MAP-ADDR-LIN-88                                           DTSCS77
02101          PERFORM S4300-LIN-ADDR THRU S4300-EXIT                   DTSCS77
02102      ELSE                                                         DTSCS77
02103      IF MAP-ADDR-DPC-88                                           DTSCS77
02104          PERFORM S4400-DPC-ADDR THRU S4400-EXIT.                  DTSCS77
02105  S4000-EXIT.                                                      DTSCS77
02106      EXIT.                                                        DTSCS77
02107      SKIP3                                                        DTSCS77
02108  S4100-TAD-ADDR.                                                  DTSCS77
02109      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS77
02110      IF (MAP-ADDR-TYPE = SPACES OR LOW-VALUES)                    DTSCS77
02111            OR                                                     DTSCS77
02112         (MAP-ADDR-TAX-88)                                         DTSCS77
02113          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS77
02114          SET L111-ID-NO-TAD-MAIL-88 TO TRUE                       DTSCS77
02115      ELSE                                                         DTSCS77
02116      IF MAP-ADDR-PHY-88                                           DTSCS77
02117          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS77
02118          SET L111-ID-NO-TAD-PHYS-88 TO TRUE                       DTSCS77
02119      ELSE                                                         DTSCS77
02120          GO TO S899-ABEND.                                        DTSCS77
02121      SKIP1                                                        DTSCS77
02122      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS77
02123      IF L111-ADDR-NOT-FOUND-88                                    DTSCS77
02124          GO TO S4100-EXIT.                                        DTSCS77
02125      SKIP1                                                        DTSCS77
02126      MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE.                       DTSCS77
02127      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS77
02128      MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME.                 DTSCS77
02129      MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA.             DTSCS77
02130      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS77
02131      SKIP1                                                        DTSCS77
02132      MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1.              DTSCS77
02133      MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2.              DTSCS77
02134      MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3.              DTSCS77
02135      MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4.              DTSCS77
02136      MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5.              DTSCS77
02137  S4100-EXIT.                                                      DTSCS77
02138      EXIT.                                                        DTSCS77
02139      SKIP3                                                        DTSCS77
02140  S4200-TAA-OPO-ADDR.                                              DTSCS77
02141      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS77
02142      IF MAP-ADDR-TAX-ALT-88                                       DTSCS77
02143          SET L111-LOOKUP-TAA-88 TO TRUE                           DTSCS77
02144      ELSE                                                         DTSCS77
02145      IF MAP-ADDR-OPO-88                                           DTSCS77
02146          SET L111-LOOKUP-OPO-88 TO TRUE                           DTSCS77
02147      ELSE                                                         DTSCS77
02148          GO TO S899-ABEND.                                        DTSCS77
02149      SKIP1                                                        DTSCS77
02150      IF L013-CNT = +0                                             DTSCS77
02151          MOVE 1                   TO L111-ID-NO                   DTSCS77
02152      ELSE                                                         DTSCS77
02153          MOVE L013-CNT TO L111-ID-NO.                             DTSCS77
02154      SKIP1                                                        DTSCS77
02155      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS77
02156      IF L111-ADDR-NOT-FOUND-88                                    DTSCS77
02157          GO TO S4200-EXIT.                                        DTSCS77
02158      SKIP1                                                        DTSCS77
02159      MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE.                       DTSCS77
02160      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS77
02161      MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME.                 DTSCS77
02162      MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA.             DTSCS77
02163      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS77
02164      SKIP1                                                        DTSCS77
02165      MOVE L112-MAILING-LINE-1 TO MAP-MAILING-LINE-1.              DTSCS77
02166      MOVE L112-MAILING-LINE-2 TO MAP-MAILING-LINE-2.              DTSCS77
02167      MOVE L112-MAILING-LINE-3 TO MAP-MAILING-LINE-3.              DTSCS77
02168      MOVE L112-MAILING-LINE-4 TO MAP-MAILING-LINE-4.              DTSCS77
02169      MOVE L112-MAILING-LINE-5 TO MAP-MAILING-LINE-5.              DTSCS77
02170  S4200-EXIT.                                                      DTSCS77
02171      EXIT.                                                        DTSCS77
02172      SKIP3                                                        DTSCS77
02173  S4300-LIN-ADDR.                                                  DTSCS77
02174      MOVE LOW-VALUES TO MLIN-KEY-AREA.                            DTSCS77
02175      MOVE WRK-EMP-NO TO MLIN-EMP-NO.                              DTSCS77
02176      SET MLIN-LIN-88 TO TRUE.                                     DTSCS77
02177      MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS77
02178      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS77
02179      MOVE +0 TO WRK-REC-CNT.                                      DTSCS77
02180      PERFORM S4310-SCAN-MLIN THRU S4310-EXIT                      DTSCS77
02181          UNTIL L810-NO-REC-88.                                    DTSCS77
02182  S4300-EXIT.                                                      DTSCS77
02183      EXIT.                                                        DTSCS77
02184      SKIP3                                                        DTSCS77
02185  S4310-SCAN-MLIN.                                                 DTSCS77
02186      ADD +1 TO WRK-REC-CNT.                                       DTSCS77
02187      IF WRK-REC-CNT = L013-CNT                                    DTSCS77
02188          MOVE MSKL-REC TO MLIN-REC                                DTSCS77
02189          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS77
02190          SET L810-NO-REC-88 TO TRUE                               DTSCS77
02191          MOVE MLIN-ADDRESS-LINE-1 TO MAP-MAILING-LINE-1           DTSCS77
02192          MOVE MLIN-ADDRESS-LINE-2 TO MAP-MAILING-LINE-2           DTSCS77
02193          MOVE MLIN-ADDRESS-LINE-3 TO MAP-MAILING-LINE-3           DTSCS77
02194          MOVE MLIN-ADDRESS-LINE-4 TO MAP-MAILING-LINE-4           DTSCS77
02195          MOVE MLIN-ADDRESS-LINE-5 TO MAP-MAILING-LINE-5           DTSCS77
02196          MOVE MLIN-CERTIFICATE-NO TO WRK-DISPLAY                  DTSCS77
02197          MOVE WRK-DISPLAY-CERT-NO1  TO MAP-CERT-NUM1              DTSCS77
02198          MOVE WRK-DISPLAY-CERT-NO2  TO MAP-CERT-NUM2              DTSCS77
02199 *        IF MLIN-CERTIFICATE-NO = ZERO                            DTSCS77
02200 *            MOVE SPACES TO MAP-LIEN-CERT                         DTSCS77
02201 *        END-IF                                                   DTSCS77
02202          GO TO S4310-EXIT.                                        DTSCS77
02203      SKIP1                                                        DTSCS77
02204      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS77
02205  S4310-EXIT.                                                      DTSCS77
02206      EXIT.                                                        DTSCS77
02207      SKIP3                                                        DTSCS77
02208  S4400-DPC-ADDR.                                                  DTSCS77
02209      MOVE LOW-VALUES TO MDPC-KEY-AREA.                            DTSCS77
02210      MOVE WRK-EMP-NO TO MDPC-EMP-NO.                              DTSCS77
02211      SET MDPC-DPC-88 TO TRUE.                                     DTSCS77
02212      MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS77
02213      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS77
02214      MOVE +0 TO WRK-REC-CNT.                                      DTSCS77
02215      PERFORM S4410-SCAN-MDPC THRU S4410-EXIT                      DTSCS77
02216          UNTIL L810-NO-REC-88.                                    DTSCS77
02217  S4400-EXIT.                                                      DTSCS77
02218      EXIT.                                                        DTSCS77
02219      SKIP3                                                        DTSCS77
02220  S4410-SCAN-MDPC.                                                 DTSCS77
02221      ADD +1 TO WRK-REC-CNT.                                       DTSCS77
02222      IF WRK-REC-CNT = L013-CNT                                    DTSCS77
02223          MOVE MSKL-REC TO MDPC-REC                                DTSCS77
02224          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS77
02225          SET L810-NO-REC-88 TO TRUE                               DTSCS77
02226          MOVE MDPC-MAILING-LINE-1                                 DTSCS77
02227            TO MAP-MAILING-LINE-1                                  DTSCS77
02228          MOVE MDPC-MAILING-LINE-2                                 DTSCS77
02229            TO MAP-MAILING-LINE-2                                  DTSCS77
02230          MOVE MDPC-MAILING-LINE-3                                 DTSCS77
02231            TO MAP-MAILING-LINE-3                                  DTSCS77
02232          MOVE MDPC-MAILING-LINE-4                                 DTSCS77
02233            TO MAP-MAILING-LINE-4                                  DTSCS77
02234          MOVE MDPC-MAILING-LINE-5                                 DTSCS77
02235            TO MAP-MAILING-LINE-5                                  DTSCS77
02236              GO TO S4410-EXIT.                                    DTSCS77
02237      SKIP1                                                        DTSCS77
02238      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS77
02239  S4410-EXIT.                                                      DTSCS77
02240      EXIT.                                                        DTSCS77
02241 /*****************************************************************DTSCS77
02242 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS77
02243 ******************************************************************DTSCS77
02244  S5100-SET-LOCK-ATTRB.                                            DTSCS77
02245      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS77
02246                                   WRK-ATB-NUM.                    DTSCS77
02247      SKIP1                                                        DTSCS77
02248      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS77
02249      SKIP1                                                        DTSCS77
02250      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS77
02251                                   MAP-EMP-NO-2-A                  DTSCS77
02252                                   MAP-GOTO-A.                     DTSCS77
02253  S5100-EXIT.                                                      DTSCS77
02254      EXIT.                                                        DTSCS77
02255      SKIP3                                                        DTSCS77
02256 ******************************************************************DTSCS77
02257 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS77
02258 ******************************************************************DTSCS77
02259  S5200-SET-UPDATE-ATTRB.                                          DTSCS77
02260      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS77
02261      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS77
02262      SKIP1                                                        DTSCS77
02263      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS77
02264  S5200-EXIT.                                                      DTSCS77
02265      EXIT.                                                        DTSCS77
02266      SKIP3                                                        DTSCS77
02267 ******************************************************************DTSCS77
02268 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS77
02269 ******************************************************************DTSCS77
02270  S5300-SET-INQ-ATTRB.                                             DTSCS77
02271      MOVE CATB-ASKIP-BRT-MDTON  TO WRK-ATB-AN                     DTSCS77
02272                                    WRK-ATB-NUM.                   DTSCS77
02273      SKIP1                                                        DTSCS77
02274      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS77
02275      SKIP1                                                        DTSCS77
02276      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-ADDR-TYPE-A.            DTSCS77
02277      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-ADDR-ID-NO-A.          DTSCS77
02278  S5300-EXIT.                                                      DTSCS77
02279      EXIT.                                                        DTSCS77
02280      SKIP3                                                        DTSCS77
02281  S5900-SET-ATTRB.                                                 DTSCS77
02282      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS77
02283                                        MAP-EMP-NO-2-A.            DTSCS77
02284      SKIP1                                                        DTSCS77
02285      MOVE WRK-ATB-AN            TO MAP-TEMPLATE-ID-A.             DTSCS77
02286      SKIP1                                                        DTSCS77
02287      MOVE WRK-ATB-AN            TO MAP-ADDR-TYPE-A.               DTSCS77
02288      SKIP1                                                        DTSCS77
02289      MOVE WRK-ATB-NUM           TO MAP-ADDR-ID-NO-A.              DTSCS77
02290      SKIP1                                                        DTSCS77
02291      MOVE WRK-ATB-AN            TO MAP-CORR-OP-ID-A.              DTSCS77
02292      SKIP1                                                        DTSCS77
02293      MOVE WRK-ATB-AN            TO MAP-FLD-REP-ID-A.              DTSCS77
02294      SKIP1                                                        DTSCS77
02295      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A              DTSCS77
02296                                   MAP-MAILING-LINE-1-A            DTSCS77
02297                                   MAP-MAILING-LINE-2-A            DTSCS77
02298                                   MAP-MAILING-LINE-3-A            DTSCS77
02299                                   MAP-MAILING-LINE-4-A            DTSCS77
02300                                   MAP-MAILING-LINE-5-A.           DTSCS77
02301      SKIP1                                                        DTSCS77
02302      MOVE WRK-ATB-NUM TO MAP-COPY-CNT-A.                          DTSCS77
02303      SKIP1                                                        DTSCS77
02304      MOVE WRK-ATB-NUM TO MAP-CERT-NUM1-A                          DTSCS77
02305                          MAP-CERT-NUM2-A.                         DTSCS77
02306      SKIP1                                                        DTSCS77
02307      MOVE WRK-ATB-NUM TO MAP-CORR-MO-A                            DTSCS77
02308                          MAP-CORR-DA-A                            DTSCS77
02309                          MAP-CORR-YR-A.                           DTSCS77
02310      SKIP1                                                        DTSCS77
02311      MOVE WRK-ATB-AN  TO MAP-CORR-STATE-A.                        DTSCS77
02312      SKIP1                                                        DTSCS77
02313      MOVE WRK-ATB-NUM TO MAP-TRIGGER-MO-A                         DTSCS77
02314                          MAP-TRIGGER-DA-A                         DTSCS77
02315                          MAP-TRIGGER-YR-A.                        DTSCS77
02316      SKIP1                                                        DTSCS77
02317      PERFORM S5910-TEXT-LINE THRU S5910-EXIT                      DTSCS77
02318          VARYING MAP-TEXT-IDX FROM 1 BY 1                         DTSCS77
02319          UNTIL MAP-TEXT-IDX > WRK-TEXT-MAX.                       DTSCS77
02320      SKIP1                                                        DTSCS77
02321      MOVE WRK-ATB-AN TO MAP-QUEUE-OP-ID-A.                        DTSCS77
02322      SKIP1                                                        DTSCS77
02323      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS77
02324  S5900-EXIT.                                                      DTSCS77
02325      EXIT.                                                        DTSCS77
02326      SKIP3                                                        DTSCS77
02327  S5910-TEXT-LINE.                                                 DTSCS77
02328      MOVE WRK-ATB-AN TO MAP-TEXT-A (MAP-TEXT-IDX).                DTSCS77
02329  S5910-EXIT.                                                      DTSCS77
02330      EXIT.                                                        DTSCS77
02331 /*****************************************************************DTSCS77
02332 * MAP ROUTINES                                                   *DTSCS77
02333 ******************************************************************DTSCS77
02334  S9100-RECEIVE.                                                   DTSCS77
02335      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS77
02336      SKIP1                                                        DTSCS77
02337      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS77
02338      SKIP1                                                        DTSCS77
02339      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS77
02340      SKIP1                                                        DTSCS77
02341      MOVE L851-AID TO LCCM-AID.                                   DTSCS77
02342      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS77
02343  S9100-EXIT.                                                      DTSCS77
02344      EXIT.                                                        DTSCS77
02345      SKIP3                                                        DTSCS77
02346  S9200-SEND-DATAONLY.                                             DTSCS77
02347      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS77
02348      SKIP1                                                        DTSCS77
02349      IF LCCM-NO-MSG                                               DTSCS77
02350          NEXT SENTENCE                                            DTSCS77
02351      ELSE                                                         DTSCS77
02352          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS77
02353      SKIP1                                                        DTSCS77
02354      IF CURSOR-SET-GOTO                                           DTSCS77
02355          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS77
02356      ELSE                                                         DTSCS77
02357          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS77
02358      SKIP1                                                        DTSCS77
02359      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS77
02360      SKIP1                                                        DTSCS77
02361      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS77
02362      SKIP1                                                        DTSCS77
02363      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS77
02364  S9200-EXIT.                                                      DTSCS77
02365      EXIT.                                                        DTSCS77
02366      SKIP3                                                        DTSCS77
02367  S9300-SEND-MAP.                                                  DTSCS77
02368      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS77
02369      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS77
02370      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS77
02371      SKIP1                                                        DTSCS77
02372      IF SCR-ACCESS-UPDATE                                         DTSCS77
02373          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS77
02374      ELSE                                                         DTSCS77
02375          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS77
02376      SKIP1                                                        DTSCS77
02377      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS77
02378      SKIP1                                                        DTSCS77
02379      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS77
02380      SKIP1                                                        DTSCS77
02381      IF CURSOR-SET-NO                                             DTSCS77
02382          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS77
02383      SKIP1                                                        DTSCS77
02384      SET L851-SEND-88 TO TRUE.                                    DTSCS77
02385      SKIP1                                                        DTSCS77
02386      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS77
02387      SKIP1                                                        DTSCS77
02388      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS77
02389  S9300-EXIT.                                                      DTSCS77
02390      EXIT.                                                        DTSCS77
02391      SKIP3                                                        DTSCS77
02392  S9310-UPDATE-FKEYS.                                              DTSCS77
02393      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS77
02394      SKIP1                                                        DTSCS77
02395      MOVE CFKD-ADD TO MAP-KEY-ADD.                                DTSCS77
02396      SKIP1                                                        DTSCS77
02397      IF LCCM-SCR-CLEAR                                            DTSCS77
02398          NEXT SENTENCE                                            DTSCS77
02399      ELSE                                                         DTSCS77
02400      IF LCCM-SCR-INQUIRE                                          DTSCS77
02401          NEXT SENTENCE                                            DTSCS77
02402      ELSE                                                         DTSCS77
02403      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS77
02404          MOVE LOW-VALUES TO MAP-KEY-ADD                           DTSCS77
02405      ELSE                                                         DTSCS77
02406          NEXT SENTENCE.                                           DTSCS77
02407  S9310-EXIT.                                                      DTSCS77
02408      EXIT.                                                        DTSCS77
02409      SKIP3                                                        DTSCS77
02410  S9320-INQUIRY-FKEYS.                                             DTSCS77
02411      MOVE LOW-VALUES TO MAP-KEY-ADD.                              DTSCS77
02412      SKIP1                                                        DTSCS77
02413 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS77
02414  S9320-EXIT.                                                      DTSCS77
02415      EXIT.                                                        DTSCS77
02416      SKIP3                                                        DTSCS77
02417 *S9321-JUMP-KEYS.                                                 DTSCS77
02418 *    MOVE 'F21=EVENT LOG' TO MAP-KEY-EVL.                         DTSCS77
02419 *    MOVE 'F22=TICKLER' TO MAP-KEY-TCK.                           DTSCS77
02420 *S9321-EXIT.                                                      DTSCS77
02421      EXIT.                                                        DTSCS77
02422      SKIP3                                                        DTSCS77
02423  S9330-DSCR-FIELDS.                                               DTSCS77
02424      MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                         DTSCS77
02425      IF WRK-MPRF-YES-88                                           DTSCS77
02426          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.              DTSCS77
02427      SKIP1                                                        DTSCS77
02428      IF MAP-CORR-OP-ID = LOW-VALUES OR SPACES                     DTSCS77
02429          MOVE LOW-VALUES TO MAP-CORR-OP-ID-DESC                   DTSCS77
02430      ELSE                                                         DTSCS77
02431      IF MAP-CORR-OP-ID = LCCM-OP-ID                               DTSCS77
02432          MOVE LCCM-OP-NAME TO MAP-CORR-OP-ID-DESC                 DTSCS77
02433      ELSE                                                         DTSCS77
02434          MOVE MAP-CORR-OP-ID TO L082-OP-ID                        DTSCS77
02435          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS77
02436          MOVE L082-NAME TO MAP-CORR-OP-ID-DESC.                   DTSCS77
02437      SKIP1                                                        DTSCS77
02438      IF MAP-FLD-REP-ID = SPACES OR LOW-VALUES                     DTSCS77
02439          MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC                   DTSCS77
02440      ELSE                                                         DTSCS77
02441      IF MAP-FLD-REP-NONE-88                                       DTSCS77
02442          MOVE LOW-VALUES TO MAP-FLD-REP-ID-DESC                   DTSCS77
02443      ELSE                                                         DTSCS77
02444          MOVE MAP-FLD-REP-ID TO L062-FLD-REP-ID                   DTSCS77
02445          PERFORM S062-FLD-REP-DSCR THRU S062-EXIT                 DTSCS77
02446          MOVE L062-NAME TO MAP-FLD-REP-ID-DESC.                   DTSCS77
02447      SKIP1                                                        DTSCS77
02448      IF MAP-QUEUE-OP-ID = LOW-VALUES OR SPACES                    DTSCS77
02449          MOVE LOW-VALUES TO MAP-QUEUE-OP-ID-DESC                  DTSCS77
02450      ELSE                                                         DTSCS77
02451      IF MAP-QUEUE-OP-ID = LCCM-OP-ID                              DTSCS77
02452          MOVE LCCM-OP-NAME TO MAP-QUEUE-OP-ID-DESC                DTSCS77
02453      ELSE                                                         DTSCS77
02454          MOVE MAP-QUEUE-OP-ID TO L082-OP-ID                       DTSCS77
02455          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS77
02456          MOVE L082-NAME TO MAP-QUEUE-OP-ID-DESC.                  DTSCS77
02457  S9330-EXIT.                                                      DTSCS77
02458      EXIT.                                                        DTSCS77
02459      SKIP3                                                        DTSCS77
02460  S9900-PREPARE-SEND.                                              DTSCS77
02461      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS77
02462                         LCCM-SCR-ID.                              DTSCS77
02463      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS77
02464      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS77
02465  S9900-EXIT.                                                      DTSCS77
02466      EXIT.                                                        DTSCS77
