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