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