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