00001  IDENTIFICATION DIVISION.                                         10/07/98
00002  PROGRAM-ID.             DTSCS99.                                 DTSCS99
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           SEPTEMBER 1998.                             CL**2
00005  DATE-COMPILED.                                                   DTSCS99
00006                                                                   DTSCS99
00007 *****                                                             DTSCS99
00008 *                                                                 DTSCS99
00009 *    FUNCTION:  EMPLOYER ON-LINE UPDATE LOCK INQUIRY/UPDATE       DTSCS99
00010 *               SCREEN PROCESSOR.                                 DTSCS99
00011 *                                                                 DTSCS99
00012 *                                                                 DTSCS99
00013 *    MODIFICATION LOG:                                            DTSCS99
00014 *                                                                 DTSCS99
00015 *    09/28/1998  INITIAL DEVELOPMENT.                                CL**2
00016 *                WORK ORDER:                      PROGRAMMER: GD     CL**2
00017 *                                                                 DTSCS99
00018 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX    CL**2
00019 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX    CL**2
00020 *                WORK ORDER:                      PROGRAMMER: XXX    CL**2
00021 *                                                                 DTSCS99
00022 *                                                                 DTSCS99
00023 *  DESCRIPTION:                                                   DTSCS99
00024 *                                                                 DTSCS99
00025 *    CLEAR:                                                       DTSCS99
00026 *                                                                 DTSCS99
00027 *      DATA FIELDS DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).      DTSCS99
00028 *                                                                 DTSCS99
00029 *                                                                 DTSCS99
00030 *    INQUIRY:                                                     DTSCS99
00031 *                                                                 DTSCS99
00032 *      CONTROL FIELDS(S): MAP-EMP-NO.                             DTSCS99
00033 *                                                                 DTSCS99
00034 *      JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO.         DTSCS99
00035 *                                                                 DTSCS99
00036 *      ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO.            DTSCS99
00037 *                                                                 DTSCS99
00038 *      STANDARD LCCM-EMP-NO MAINTENANCE LOGIC.                    DTSCS99
00039 *                                                                 DTSCS99
00040 *                                                                 DTSCS99
00041 *    UPDATE:                                                      DTSCS99
00042 *                                                                 DTSCS99
00043 *      MOD                                                        DTSCS99
00044 *                                                                 DTSCS99
00045 *                                                                 DTSCS99
00046 *    RECORDS READ:                                                DTSCS99
00047 *                                                                 DTSCS99
00048 *      MASTER:                                                    DTSCS99
00049 *                                                                 DTSCS99
00050 *        MPRF.                                                    DTSCS99
00051 *                                                                 DTSCS99
00052 *                                                                 DTSCS99
00053 *      ALTERNATE INDEX:                                           DTSCS99
00054 *                                                                 DTSCS99
00055 *        NONE.                                                    DTSCS99
00056 *                                                                 DTSCS99
00057 *                                                                 DTSCS99
00058 *      REFERENCE:                                                 DTSCS99
00059 *                                                                 DTSCS99
00060 *        NONE.                                                    DTSCS99
00061 *                                                                 DTSCS99
00062 *                                                                 DTSCS99
00063 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS99
00064 *                                                                 DTSCS99
00065 *        NONE.                                                    DTSCS99
00066 *                                                                 DTSCS99
00067 *                                                                 DTSCS99
00068 *    RECORDS UPDATED:                                             DTSCS99
00069 *                                                                 DTSCS99
00070 *      MASTER:                                                    DTSCS99
00071 *                                                                 DTSCS99
00072 *        MPRF (MOD).                                              DTSCS99
00073 *         OBVIOUSLY, THIS MODULE BYPASSES THE EMPLOYER ON-LINE    DTSCS99
00074 *         UPDATE LOCKING PROCEDURES (THIS IS THE MODULE THAT      DTSCS99
00075 *         ALLOWS THE SYSTEM USERS TO MAINTAIN THE EMPLOYER        DTSCS99
00076 *         ON-LINE UPDATE LOCK).                                   DTSCS99
00077 *                                                                 DTSCS99
00078 *         THE ONLY MPRF FIELDS MODIFIED ARE MPRF-UPDATE-START-    DTSCS99
00079 *         ABSTIME AND MPRF-UPDATE-END-ABSTIME.                    DTSCS99
00080 *                                                                 DTSCS99
00081 *         IF MPRF IS MODIFIED, THEN WRITE A DTSIR905 RECORD          CL**2
00082 *         REFLECTING THE EVENT.                                   DTSCS99
00083 *                                                                 DTSCS99
00084 *                                                                 DTSCS99
00085 *      REFERENCE:                                                 DTSCS99
00086 *                                                                 DTSCS99
00087 *        NONE.                                                    DTSCS99
00088 *                                                                 DTSCS99
00089 *                                                                 DTSCS99
00090 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS99
00091 *                                                                 DTSCS99
00092 *        NONE.                                                    DTSCS99
00093 *                                                                 DTSCS99
00094 *                                                                 DTSCS99
00095 *    ON-LINE EVENT FILE RECORDS WRITTEN:                          DTSCS99
00096 *                                                                 DTSCS99
00097 *     DTSIR905  ON-LINE RECOVERY/RESTART (905R1) REPORT RECORD.      CL**2
00098 *                                                                 DTSCS99
00099 *                                                                 DTSCS99
00100 *    MODULES LINKED TO:                                           DTSCS99
00101 *                                                                 DTSCS99
00102 *     DTSCU001  DATE EDIT/CONVERSION.                                CL**2
00103 *     DTSCU018  EMP-NO FROM SCREEN FORMAT/EDIT.                      CL**2
00104 *     DTSCU810  MASTER I/O.                                          CL**2
00105 *     DTSCU825  ON-LINE EVENT FILE O.                                CL**2
00106 *                                                                 DTSCS99
00107 *                                                                 DTSCS99
00108 *****                                                             DTSCS99
00109      SKIP3                                                        DTSCS99
00110  ENVIRONMENT DIVISION.                                            DTSCS99
00111      SKIP3                                                        DTSCS99
00112  DATA DIVISION.                                                   DTSCS99
00113      SKIP3                                                        DTSCS99
00114  WORKING-STORAGE SECTION.                                         DTSCS99
001145 77  PAN-VALET PICTURE X(24) VALUE '004DTSCS99   10/07/98'.       DTSCS99
00115      SKIP3                                                        DTSCS99
00116  01  WRK-AREA.                                                    DTSCS99
00117      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S99 '.    DTSCS99
00118      SKIP1                                                        DTSCS99
00119      05  WRK-SCR-ID.                                              DTSCS99
00120          10  WRK-SCR-ID-9            PIC  9(02)  VALUE  99.       DTSCS99
00121      SKIP1                                                        DTSCS99
00122      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '90'.      DTSCS99
00123      SKIP3                                                        DTSCS99
00124      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS99
00125          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS99
00126          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS99
00127      SKIP1                                                        DTSCS99
00128      05  CURSOR-SET-IND              PIC X(01).                   DTSCS99
00129          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS99
00130          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS99
00131          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS99
00132      SKIP1                                                        DTSCS99
00133      05  REQ-IND                     PIC X(01).                   DTSCS99
00134          88  REQ-ERROR                       VALUE 'O'.           DTSCS99
00135          88  REQ-JUMP                        VALUE 'J'.           DTSCS99
00136          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS99
00137          88  REQ-CLEAR                       VALUE 'C'.           DTSCS99
00138          88  REQ-EDIT                        VALUE 'E'.           DTSCS99
00139          88  REQ-UPDATE                      VALUE 'U'.           DTSCS99
00140          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS99
00141      SKIP1                                                        DTSCS99
00142      05  RESP-IND                    PIC X(01).                   DTSCS99
00143          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS99
00144          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS99
00145          88  RESP-JUMP                       VALUE 'J'.           DTSCS99
00146          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS99
00147      SKIP1                                                        DTSCS99
00148      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS99
00149      SKIP1                                                        DTSCS99
00150      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS99
00151          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS99
00152          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS99
00153      SKIP1                                                        DTSCS99
00154      05  WRK-NEW-KEY-IND             PIC  X(01).                  DTSCS99
00155      SKIP1                                                        DTSCS99
00156      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS99
00157      SKIP1                                                        DTSCS99
00158      05  WRK-ATB-AN               PIC  X(01).                     DTSCS99
00159      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS99
00160      SKIP3                                                        DTSCS99
00161      05  WRK-DISPLAY                 PIC  9(09).                  DTSCS99
00162      SKIP1                                                        DTSCS99
00163      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS99
00164          10  FILLER                  PIC  X(03).                  DTSCS99
00165          10  WRK-DISPLAY-YR          PIC  X(02).                  DTSCS99
00166          10  WRK-DISPLAY-MO          PIC  X(02).                  DTSCS99
00167          10  WRK-DISPLAY-DA          PIC  X(02).                  DTSCS99
00168      SKIP1                                                        DTSCS99
00169      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS99
00170          10  FILLER                  PIC  X(03).                  DTSCS99
00171          10  WRK-DISPLAY-HR          PIC  X(02).                  DTSCS99
00172          10  WRK-DISPLAY-MIN         PIC  X(02).                  DTSCS99
00173          10  WRK-DISPLAY-SEC         PIC  X(02).                  DTSCS99
00174      EJECT                                                        DTSCS99
00175  01  L018-COMM-AREA.                                              DTSCS99
00176  ++INCLUDE DTSIL018                                                  CL**2
00177      EJECT                                                        DTSCS99
00178  01  L805-COMM-AREA.                                              DTSCS99
00179  ++INCLUDE DTSIL805                                                  CL**2
00180      EJECT                                                        DTSCS99
00181  01  L810-COMM-AREA.                                              DTSCS99
00182      05  L810-CONTROL-BLOCK.                                      DTSCS99
00183  ++INCLUDE DTSIL810                                                  CL**2
00184      EJECT                                                        DTSCS99
00185      05  MSKL-REC.                                                DTSCS99
00186  ++INCLUDE DTSIMSKL                                                  CL**2
00187      EJECT                                                        DTSCS99
00188  01  MPRF-REC.                                                    DTSCS99
00189  ++INCLUDE DTSIMPRF                                                  CL**2
00190      EJECT                                                        DTSCS99
00191  01  L825-COMM-AREA.                                              DTSCS99
00192      05  L825-CONTROL-BLOCK.                                      DTSCS99
00193  ++INCLUDE DTSIL825                                                  CL**2
00194      EJECT                                                        DTSCS99
00195      05  RSKL-REC.                                                DTSCS99
00196  ++INCLUDE DTSIRSK1                                                  CL**2
00197      EJECT                                                        DTSCS99
00198  01  R905-REC.                                                    DTSCS99
00199  ++INCLUDE DTSIR905                                                  CL**2
00200      EJECT                                                        DTSCS99
00201 * MAP DEFINITION                                                  DTSCS99
00202  01  L851-COMM-AREA.                                              DTSCS99
00203  ++INCLUDE DTSIL851                                                  CL**2
00204      SKIP3                                                        DTSCS99
00205      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS99
00206  ++INCLUDE DTSIS99                                                   CL**2
00207      EJECT                                                        DTSCS99
00208  01  CATB-LITERALS.                                               DTSCS99
00209  ++INCLUDE DTSICATB                                                  CL**2
00210      SKIP3                                                        DTSCS99
00211  01  CFKD-LITERALS.                                               DTSCS99
00212  ++INCLUDE DTSICFKD                                                  CL**2
00213      SKIP3                                                        DTSCS99
00214  01  CECD-LITERALS.                                               DTSCS99
00215  ++INCLUDE DTSICECD                                                  CL**2
00216      SKIP3                                                        DTSCS99
00217  01  CPCD-LITERALS.                                               DTSCS99
00218  ++INCLUDE DTSICPCD                                                  CL**2
00219      EJECT                                                        DTSCS99
00220  LINKAGE SECTION.                                                 DTSCS99
00221      SKIP3                                                        DTSCS99
00222  01  DFHCOMMAREA.                                                 DTSCS99
00223  ++INCLUDE DTSILCCM                                                  CL**2
00224      EJECT                                                        DTSCS99
00225 ******************************************************************DTSCS99
00226 *                                                                *DTSCS99
00227 ******************************************************************DTSCS99
00228      SKIP1                                                        DTSCS99
00229  PROCEDURE DIVISION.                                              DTSCS99
00230      SKIP2                                                        DTSCS99
00231      MOVE +0 TO WRK-EMP-NO.                                       DTSCS99
00232      SKIP1                                                        DTSCS99
00233      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS99
00234      SKIP1                                                        DTSCS99
00235      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS99
00236      SKIP1                                                        DTSCS99
00237      SET CURSOR-SET-NO TO TRUE.                                   DTSCS99
00238      SKIP1                                                        DTSCS99
00239      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9)                  DTSCS99
00240        TO SCR-ACCESS-IND.                                         DTSCS99
00241      SKIP3                                                        DTSCS99
00242      MOVE SPACE TO REQ-IND.                                       DTSCS99
00243      SKIP1                                                        DTSCS99
00244      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS99
00245      SKIP1                                                        DTSCS99
00246 *-----------------------------------------------------            DTSCS99
00247 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS99
00248 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS99
00249 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS99
00250 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS99
00251 *                                                                 DTSCS99
00252 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS99
00253 *    PROCESSED.                                                   DTSCS99
00254 *                                                                 DTSCS99
00255 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS99
00256 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS99
00257 *    WORK STATION OPERATOR.                                       DTSCS99
00258 *-----------------------------------------------------            DTSCS99
00259      SKIP1                                                        DTSCS99
00260      MOVE SPACE TO RESP-IND.                                      DTSCS99
00261      SKIP1                                                        DTSCS99
00262      IF REQ-ERROR                                                 DTSCS99
00263         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS99
00264      ELSE                                                         DTSCS99
00265      IF REQ-JUMP                                                  DTSCS99
00266         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS99
00267      ELSE                                                         DTSCS99
00268      IF REQ-CLEAR                                                 DTSCS99
00269         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS99
00270      ELSE                                                         DTSCS99
00271      IF REQ-CURSOR-TO-GOTO                                        DTSCS99
00272         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS99
00273      ELSE                                                         DTSCS99
00274      IF REQ-INQUIRE                                               DTSCS99
00275         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS99
00276      ELSE                                                         DTSCS99
00277      IF REQ-EDIT                                                  DTSCS99
00278         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS99
00279      ELSE                                                         DTSCS99
00280      IF REQ-UPDATE                                                DTSCS99
00281         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS99
00282      ELSE                                                         DTSCS99
00283         GO TO S899-ABEND.                                         DTSCS99
00284      SKIP3                                                        DTSCS99
00285 *-----------------------------------------------------            DTSCS99
00286 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS99
00287 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS99
00288 *-----------------------------------------------------            DTSCS99
00289      SKIP1                                                        DTSCS99
00290      IF RESP-SEND-MAP                                             DTSCS99
00291          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS99
00292          SET LCCM-END-TASK-88 TO TRUE                             DTSCS99
00293      ELSE                                                         DTSCS99
00294      IF RESP-SEND-MSGONLY                                         DTSCS99
00295          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS99
00296          SET LCCM-END-TASK-88 TO TRUE                             DTSCS99
00297      ELSE                                                         DTSCS99
00298      IF RESP-JUMP                                                 DTSCS99
00299          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS99
00300      ELSE                                                         DTSCS99
00301      IF RESP-CURSOR-TO-GOTO                                       DTSCS99
00302          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS99
00303          SET LCCM-END-TASK-88 TO TRUE                             DTSCS99
00304      ELSE                                                         DTSCS99
00305          GO TO S899-ABEND.                                        DTSCS99
00306      SKIP3                                                        DTSCS99
00307  MAINLINE-EXIT.                                                   DTSCS99
00308      SKIP1                                                        DTSCS99
00309      EXEC CICS                                                    DTSCS99
00310          RETURN                                                   DTSCS99
00311      END-EXEC.                                                    DTSCS99
00312      SKIP2                                                        DTSCS99
00313      GOBACK.                                                      DTSCS99
00314 /*****************************************************************DTSCS99
00315 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS99
00316 ******************************************************************DTSCS99
00317  P1000-ANALYZE-REQUEST.                                           DTSCS99
00318      SKIP1                                                        DTSCS99
00319 *-----------------------------------------------------            DTSCS99
00320 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS99
00321 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS99
00322 *     REPLACED WITH ENTER)                                        DTSCS99
00323 *-----------------------------------------------------            DTSCS99
00324      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS99
00325         SET LCCM-ENTER-88 TO TRUE                                 DTSCS99
00326         SET REQ-INQUIRE TO TRUE                                   DTSCS99
00327         IF LCCM-EMP-NO > ZERO                                     DTSCS99
00328             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS99
00329             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS99
00330         END-IF                                                    DTSCS99
00331         GO TO P1000-EXIT.                                         DTSCS99
00332      SKIP3                                                        DTSCS99
00333 *-----------------------------------------------------            DTSCS99
00334 *      MAP IS RECEIVED                                            DTSCS99
00335 *-----------------------------------------------------            DTSCS99
00336      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS99
00337      SKIP3                                                        DTSCS99
00338 *-----------------------------------------------------            DTSCS99
00339 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS99
00340 *    WORK STATION                                                 DTSCS99
00341 *-----------------------------------------------------            DTSCS99
00342      IF LCCM-CLEAR-88                                             DTSCS99
00343         SET REQ-CLEAR TO TRUE                                     DTSCS99
00344         GO TO P1000-EXIT.                                         DTSCS99
00345      SKIP3                                                        DTSCS99
00346 *-----------------------------------------------------            DTSCS99
00347 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS99
00348 *-----------------------------------------------------            DTSCS99
00349      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS99
00350         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS99
00351         GO TO P1000-EXIT.                                         DTSCS99
00352      SKIP3                                                        DTSCS99
00353 *-----------------------------------------------------            DTSCS99
00354 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS99
00355 *-----------------------------------------------------            DTSCS99
00356      IF LCCM-PA2-88                                               DTSCS99
00357          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS99
00358          GO TO P1000-EXIT.                                        DTSCS99
00359      SKIP3                                                        DTSCS99
00360 *-----------------------------------------------------            DTSCS99
00361 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS99
00362 *-----------------------------------------------------            DTSCS99
00363      IF LCCM-PA-88                                                DTSCS99
00364        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS99
00365        SET REQ-ERROR TO TRUE                                      DTSCS99
00366        GO TO P1000-EXIT.                                          DTSCS99
00367      SKIP3                                                        DTSCS99
00368 *-----------------------------------------------------               CL**2
00369 *    F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A                    CL**2
00370 *    REQUEST TO CLEAR THE SCREEN                                     CL**2
00371 *-----------------------------------------------------               CL**2
00372      IF LCCM-F12-88                                                  CL**2
00373         MOVE LOW-VALUE TO MAP-AREA                                   CL**2
00374         SET REQ-CLEAR TO TRUE                                        CL**2
00375         GO TO P1000-EXIT.                                            CL**2
00376      SKIP3                                                           CL**2
00377 *-----------------------------------------------------            DTSCS99
00378 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS99
00379 *-----------------------------------------------------            DTSCS99
00380      IF LCCM-F03-88                                               DTSCS99
00381         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS99
00382         SET REQ-JUMP TO TRUE                                      DTSCS99
00383         GO TO P1000-EXIT.                                         DTSCS99
00384      SKIP3                                                        DTSCS99
00385 *-----------------------------------------------------            DTSCS99
00386 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS99
00387 *-----------------------------------------------------            DTSCS99
00388      IF LCCM-F04-88                                               DTSCS99
00389         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS99
00390         SET REQ-JUMP TO TRUE                                      DTSCS99
00391         GO TO P1000-EXIT.                                         DTSCS99
00392      SKIP3                                                        DTSCS99
00393 *-----------------------------------------------------            DTSCS99
00394 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS99
00395 *    CORRESPONDENCE SCREEN                                        DTSCS99
00396 *-----------------------------------------------------            DTSCS99
00397      IF LCCM-F14-88                                               DTSCS99
00398         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS99
00399         SET REQ-JUMP TO TRUE                                      DTSCS99
00400         GO TO P1000-EXIT.                                         DTSCS99
00401      SKIP3                                                        DTSCS99
00402 *-----------------------------------------------------            DTSCS99
00403 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS99
00404 *    REQUESTED SCREEN TYPE                                        DTSCS99
00405 *-----------------------------------------------------            DTSCS99
00406      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS99
00407         NEXT SENTENCE                                             DTSCS99
00408      ELSE                                                         DTSCS99
00409        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS99
00410        SET REQ-JUMP TO TRUE                                       DTSCS99
00411        GO TO P1000-EXIT.                                          DTSCS99
00412      SKIP3                                                        DTSCS99
00413 *-----------------------------------------------------            DTSCS99
00414 *    IF REQUEST TO UPDATE THE DATA (MOD)                          DTSCS99
00415 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS99
00416 *-----------------------------------------------------            DTSCS99
00417      IF LCCM-F10-88                                               DTSCS99
00418         IF SCR-ACCESS-UPDATE                                      DTSCS99
00419            SET REQ-EDIT TO TRUE                                   DTSCS99
00420            GO TO P1000-EXIT                                       DTSCS99
00421         ELSE                                                      DTSCS99
00422            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS99
00423            SET REQ-ERROR TO TRUE                                  DTSCS99
00424            GO TO P1000-EXIT.                                      DTSCS99
00425      SKIP3                                                        DTSCS99
00426 *-----------------------------------------------------            DTSCS99
00427 *    IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN,               DTSCS99
00428 *          PAGE UP), INDICATE INQUIRY REQUEST                     DTSCS99
00429 *-----------------------------------------------------            DTSCS99
00430      IF LCCM-ENTER-88                                             DTSCS99
00431          SET REQ-INQUIRE TO TRUE                                  DTSCS99
00432          GO TO P1000-EXIT.                                        DTSCS99
00433      SKIP3                                                        DTSCS99
00434 *-----------------------------------------------------            DTSCS99
00435 *     ANY OTHER KEY IS INVALID                                    DTSCS99
00436 *-----------------------------------------------------            DTSCS99
00437      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS99
00438      SET REQ-ERROR TO TRUE.                                       DTSCS99
00439  P1000-EXIT.                                                      DTSCS99
00440      EXIT.                                                        DTSCS99
00441      SKIP3                                                        DTSCS99
00442 ******************************************************************DTSCS99
00443 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS99
00444 ******************************************************************DTSCS99
00445      SKIP1                                                        DTSCS99
00446  P1100-UPDATE-LOCKED.                                             DTSCS99
00447 *-----------------------------------------------------            DTSCS99
00448 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS99
00449 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS99
00450 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS99
00451 *-----------------------------------------------------            DTSCS99
00452      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS99
00453         SET REQ-UPDATE TO TRUE                                    DTSCS99
00454      ELSE                                                         DTSCS99
00455         SET REQ-ERROR TO TRUE                                     DTSCS99
00456         IF LCCM-SCR-MOD-LOCKED                                    DTSCS99
00457            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS99
00458         ELSE                                                      DTSCS99
00459            GO TO S899-ABEND.                                      DTSCS99
00460  P1100-EXIT.                                                      DTSCS99
00461      EXIT.                                                        DTSCS99
00462 /*****************************************************************DTSCS99
00463 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS99
00464 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS99
00465 ******************************************************************DTSCS99
00466      SKIP1                                                        DTSCS99
00467  P2000-REQUEST-ERROR.                                             DTSCS99
00468      IF LCCM-MSG                                                  DTSCS99
00469         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS99
00470      ELSE                                                         DTSCS99
00471         GO TO S899-ABEND.                                         DTSCS99
00472  P2000-EXIT.                                                      DTSCS99
00473      EXIT.                                                        DTSCS99
00474 /*****************************************************************DTSCS99
00475 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS99
00476 ******************************************************************DTSCS99
00477      SKIP1                                                        DTSCS99
00478  P3000-REQUEST-JUMP.                                              DTSCS99
00479 *-----------------------------------------------------            DTSCS99
00480 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS99
00481 *    BY USER                                                      DTSCS99
00482 *-----------------------------------------------------            DTSCS99
00483      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS99
00484      SKIP3                                                        DTSCS99
00485 *-----------------------------------------------------            DTSCS99
00486 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS99
00487 *-----------------------------------------------------            DTSCS99
00488      IF LCCM-MSG                                                  DTSCS99
00489         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS99
00490         SET CURSOR-SET-GOTO TO TRUE                               DTSCS99
00491         GO TO P3000-EXIT.                                         DTSCS99
00492      SKIP3                                                        DTSCS99
00493      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS99
00494      PERFORM S018-EMP-NO THRU S018-EXIT.                          DTSCS99
00495      IF L018-VALID                                                DTSCS99
00496          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS99
00497      SKIP3                                                        DTSCS99
00498 *-----------------------------------------------------            DTSCS99
00499 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS99
00500 *-----------------------------------------------------            DTSCS99
00501      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS99
00502                         LCCM-SCR-HOLD-AREA.                       DTSCS99
00503      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS99
00504      SET RESP-JUMP TO TRUE.                                       DTSCS99
00505  P3000-EXIT.                                                      DTSCS99
00506      EXIT.                                                        DTSCS99
00507 /*****************************************************************DTSCS99
00508 * CLEAR KEY WAS PRESSED                                          *DTSCS99
00509 ******************************************************************DTSCS99
00510      SKIP1                                                        DTSCS99
00511  P4000-REQUEST-CLEAR.                                             DTSCS99
00512      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS99
00513      SKIP3                                                        DTSCS99
00514 *-----------------------------------------------------            DTSCS99
00515 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS99
00516 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS99
00517 *-----------------------------------------------------            DTSCS99
00518      IF LCCM-EMP-NO > ZERO                                        DTSCS99
00519          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS99
00520          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS99
00521      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS99
00522      SKIP1                                                        DTSCS99
00523      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS99
00524      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS99
00525      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS99
00526      SET RESP-SEND-MAP TO TRUE.                                   DTSCS99
00527  P4000-EXIT.                                                      DTSCS99
00528      EXIT.                                                        DTSCS99
00529 /*****************************************************************DTSCS99
00530 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS99
00531 ******************************************************************DTSCS99
00532      SKIP1                                                        DTSCS99
00533  P5000-CURSOR-TO-GOTO.                                            DTSCS99
00534      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS99
00535      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS99
00536  P5000-EXIT.                                                      DTSCS99
00537      EXIT.                                                        DTSCS99
00538 /*****************************************************************DTSCS99
00539 * INQUIRY WAS REQUESTED                                          *DTSCS99
00540 ******************************************************************DTSCS99
00541      SKIP1                                                        DTSCS99
00542  P6000-REQUEST-INQUIRE.                                           DTSCS99
00543      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS99
00544      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS99
00545      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS99
00546      SKIP1                                                        DTSCS99
00547      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS99
00548      SKIP1                                                        DTSCS99
00549      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS99
00550      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS99
00551      SKIP1                                                        DTSCS99
00552      PERFORM S1001-EDIT-KEY THRU S1001-EXIT.                      DTSCS99
00553      SKIP1                                                        DTSCS99
00554      IF LCCM-MSG                                                  DTSCS99
00555          NEXT SENTENCE                                            DTSCS99
00556      ELSE                                                         DTSCS99
00557      IF LCCM-ENTER-88                                             DTSCS99
00558          PERFORM P6100-NO-PAGE THRU P6100-EXIT                    DTSCS99
00559      ELSE                                                         DTSCS99
00560          GO TO S899-ABEND.                                        DTSCS99
00561      SKIP1                                                        DTSCS99
00562      SET RESP-SEND-MAP TO TRUE.                                   DTSCS99
00563  P6000-EXIT.                                                      DTSCS99
00564      EXIT.                                                        DTSCS99
00565      EJECT                                                        DTSCS99
00566  P6100-NO-PAGE.                                                   DTSCS99
00567      PERFORM S1190-READ-MPRF THRU S1190-EXIT.                     DTSCS99
00568      SKIP1                                                        DTSCS99
00569      IF LCCM-MSG                                                  DTSCS99
00570          GO TO P6100-EXIT.                                        DTSCS99
00571      SKIP1                                                        DTSCS99
00572      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS99
00573  P6100-EXIT.                                                      DTSCS99
00574      EXIT.                                                        DTSCS99
00575 /*****************************************************************DTSCS99
00576 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS99
00577 ******************************************************************DTSCS99
00578      SKIP1                                                        DTSCS99
00579  P6900-CONSTRUCT-SCREEN.                                          DTSCS99
00580      IF SCR-ACCESS-UPDATE                                         DTSCS99
00581           PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.         DTSCS99
00582      SKIP3                                                        DTSCS99
00583      IF MPRF-UPDATE-ACTIVE-88                                     DTSCS99
00584          MOVE 'Y' TO MAP-UPDATE-IND                               DTSCS99
00585      ELSE                                                         DTSCS99
00586          MOVE 'N' TO MAP-UPDATE-IND.                              DTSCS99
00587      SKIP1                                                        DTSCS99
00588      MOVE MPRF-UPDATE-TASK-ID TO MAP-UPDATE-TASK-ID.              DTSCS99
00589      MOVE MPRF-UPDATE-OP-ID TO MAP-UPDATE-OP-ID.                  DTSCS99
00590      MOVE MPRF-UPDATE-TERMID TO MAP-UPDATE-TERMID.                DTSCS99
00591      MOVE MPRF-UPDATE-NETNAME TO MAP-UPDATE-NETNAME.                 CL**2
00592      MOVE MPRF-UPDATE-SCR-ID TO MAP-UPDATE-SCR-ID.                DTSCS99
00593      MOVE MPRF-UPDATE-FUNCTION TO MAP-UPDATE-FUNCTION.            DTSCS99
00594      SKIP1                                                        DTSCS99
00595      MOVE MPRF-UPDATE-START-DATE TO WRK-DISPLAY.                  DTSCS99
00596      MOVE '  /  /  ' TO MAP-UPDATE-START-DATE.                    DTSCS99
00597      MOVE WRK-DISPLAY-MO TO MAP-UPDATE-START-DATE (1:2).          DTSCS99
00598      MOVE WRK-DISPLAY-DA TO MAP-UPDATE-START-DATE (4:2).          DTSCS99
00599      MOVE WRK-DISPLAY-YR TO MAP-UPDATE-START-DATE (7:2).          DTSCS99
00600      SKIP1                                                        DTSCS99
00601      MOVE MPRF-UPDATE-START-TIME TO WRK-DISPLAY.                  DTSCS99
00602      MOVE '  :  :  ' TO MAP-UPDATE-START-TIME.                    DTSCS99
00603      MOVE WRK-DISPLAY-HR TO MAP-UPDATE-START-TIME (1:2).          DTSCS99
00604      MOVE WRK-DISPLAY-MIN TO MAP-UPDATE-START-TIME (4:2).         DTSCS99
00605      MOVE WRK-DISPLAY-SEC TO MAP-UPDATE-START-TIME (7:2).         DTSCS99
00606      SKIP3                                                        DTSCS99
00607      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS99
00608      SKIP1                                                        DTSCS99
00609      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS99
00610  P6900-EXIT.                                                      DTSCS99
00611      EXIT.                                                        DTSCS99
00612 /*****************************************************************DTSCS99
00613 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED.        *DTSCS99
00614 ******************************************************************DTSCS99
00615      SKIP1                                                        DTSCS99
00616  P7000-REQUEST-EDIT.                                              DTSCS99
00617      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS99
00618      SKIP1                                                        DTSCS99
00619      IF LCCM-F10-88                                               DTSCS99
00620         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS99
00621      ELSE                                                         DTSCS99
00622         GO TO S899-ABEND.                                         DTSCS99
00623      SKIP3                                                        DTSCS99
00624 *------------------------------------------------------           DTSCS99
00625 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS99
00626 *  IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN  DTSCS99
00627 *  IN A 'CLEAR' STATE.  THE SCREEN MUST BE IN 'INQUIRE' STATUS    DTSCS99
00628 *  IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED.                   DTSCS99
00629 *------------------------------------------------------           DTSCS99
00630      SKIP1                                                        DTSCS99
00631      IF LCCM-MSG                                                  DTSCS99
00632         NEXT SENTENCE                                             DTSCS99
00633      ELSE                                                         DTSCS99
00634         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS99
00635         IF LCCM-F10-88                                            DTSCS99
00636            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS99
00637            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID.                  DTSCS99
00638      SKIP1                                                        DTSCS99
00639      SET RESP-SEND-MAP TO TRUE.                                   DTSCS99
00640  P7000-EXIT.                                                      DTSCS99
00641      EXIT.                                                        DTSCS99
00642 /*****************************************************************DTSCS99
00643 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS99
00644 ******************************************************************DTSCS99
00645      SKIP1                                                        DTSCS99
00646  P7200-EDIT-MOD.                                                  DTSCS99
00647 *-----------------------------------------------------            DTSCS99
00648 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS99
00649 *    INQUIRED                                                     DTSCS99
00650 *-----------------------------------------------------            DTSCS99
00651      IF NOT LCCM-SCR-INQUIRE                                      DTSCS99
00652         PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT               DTSCS99
00653         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS99
00654         GO TO P7200-EXIT.                                         DTSCS99
00655      SKIP3                                                        DTSCS99
00656 *-----------------------------------------------------            DTSCS99
00657 *    MAP-OP-ID MAY NOT BE CHANGED DURING THE MOD                  DTSCS99
00658 *-----------------------------------------------------            DTSCS99
00659      PERFORM S1001-EDIT-KEY THRU S1001-EXIT.                      DTSCS99
00660      IF LCCM-MSG                                                  DTSCS99
00661          GO TO P7200-EXIT.                                        DTSCS99
00662      SKIP1                                                        DTSCS99
00663      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS99
00664          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS99
00665          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS99
00666          GO TO P7200-EXIT.                                        DTSCS99
00667      SKIP1                                                        DTSCS99
00668      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS99
00669  P7200-EXIT.                                                      DTSCS99
00670      EXIT.                                                        DTSCS99
00671 /*****************************************************************DTSCS99
00672 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS99
00673 ******************************************************************DTSCS99
00674      SKIP1                                                        DTSCS99
00675  P8000-REQUEST-UPDATE.                                            DTSCS99
00676      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS99
00677      SKIP1                                                        DTSCS99
00678      IF LCCM-SCR-MOD-LOCKED                                       DTSCS99
00679         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS99
00680      ELSE                                                         DTSCS99
00681         GO TO S899-ABEND.                                         DTSCS99
00682      SKIP1                                                        DTSCS99
00683      SET RESP-SEND-MAP TO TRUE.                                   DTSCS99
00684  P8000-EXIT.                                                      DTSCS99
00685      EXIT.                                                        DTSCS99
00686 /*****************************************************************DTSCS99
00687 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS99
00688 ******************************************************************DTSCS99
00689      SKIP1                                                        DTSCS99
00690  P8200-MOD.                                                       DTSCS99
00691      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS99
00692      SKIP1                                                        DTSCS99
00693      IF LCCM-F12-88                                               DTSCS99
00694         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS99
00695         GO TO P8200-EXIT.                                         DTSCS99
00696      SKIP1                                                        DTSCS99
00697      PERFORM S1001-EDIT-KEY THRU S1001-EXIT.                      DTSCS99
00698      SKIP1                                                        DTSCS99
00699      PERFORM S1190-READ-MPRF THRU S1190-EXIT.                     DTSCS99
00700      IF LCCM-MSG                                                  DTSCS99
00701          GO TO P8200-EXIT.                                        DTSCS99
00702      SKIP1                                                        DTSCS99
00703      PERFORM P8900-UPDATE THRU P8900-EXIT.                        DTSCS99
00704      SKIP1                                                        DTSCS99
00705      MOVE MPRF-REC TO MSKL-REC.                                   DTSCS99
00706      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS99
00707      SKIP1                                                        DTSCS99
00708 *--------------------------------------------------------         DTSCS99
00709 *    REFRESH THE SCREEN.                                          DTSCS99
00710 *--------------------------------------------------------         DTSCS99
00711      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS99
00712      SKIP3                                                        DTSCS99
00713      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS99
00714      SKIP1                                                        DTSCS99
00715      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS99
00716  P8200-EXIT.                                                      DTSCS99
00717      EXIT.                                                        DTSCS99
00718      EJECT                                                        DTSCS99
00719  P8900-UPDATE.                                                    DTSCS99
00720      IF MPRF-UPDATE-ACTIVE-88                                     DTSCS99
00721          IF MAP-UPDATE-IND = 'Y'                                  DTSCS99
00722              GO TO P8900-EXIT                                     DTSCS99
00723          ELSE                                                     DTSCS99
00724              NEXT SENTENCE                                        DTSCS99
00725      ELSE                                                         DTSCS99
00726          IF MAP-UPDATE-IND = 'N'                                  DTSCS99
00727              GO TO P8900-EXIT                                     DTSCS99
00728          ELSE                                                     DTSCS99
00729              NEXT SENTENCE.                                       DTSCS99
00730      SKIP1                                                        DTSCS99
00731      IF MAP-UPDATE-IND = 'Y'                                      DTSCS99
00732          SET MPRF-UPDATE-ACTIVE-88 TO TRUE                        DTSCS99
00733      ELSE                                                         DTSCS99
00734          MOVE LCCM-TASK-START-ABSTIME TO MPRF-UPDATE-END-ABSTIME. DTSCS99
00735      SKIP1                                                        DTSCS99
00736      MOVE LCCM-TASK-ID TO MPRF-UPDATE-TASK-ID.                    DTSCS99
00737      MOVE LCCM-OP-ID TO MPRF-UPDATE-OP-ID.                        DTSCS99
00738      MOVE LCCM-CICS-TERM-ID TO MPRF-UPDATE-TERMID.                DTSCS99
00739      MOVE LCCM-TASK-NETNAME TO MPRF-UPDATE-NETNAME.                  CL**2
00740      MOVE LCCM-TASK-START-DATE TO MPRF-UPDATE-START-DATE.         DTSCS99
00741      MOVE LCCM-TASK-START-TIME TO MPRF-UPDATE-START-TIME.         DTSCS99
00742      MOVE WRK-SCR-ID TO MPRF-UPDATE-SCR-ID.                       DTSCS99
00743      SET MPRF-UPDATE-MODIFY-88 TO TRUE.                           DTSCS99
00744      SKIP1                                                        DTSCS99
00745      MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.                   DTSCS99
00746      SKIP3                                                        DTSCS99
00747      PERFORM P8910-CREATE-R905 THRU P8910-EXIT.                   DTSCS99
00748  P8900-EXIT.                                                      DTSCS99
00749      EXIT.                                                        DTSCS99
00750      SKIP3                                                        DTSCS99
00751  P8910-CREATE-R905.                                               DTSCS99
00752      MOVE WRK-EMP-NO TO R905-EMP-NO.                              DTSCS99
00753      MOVE LCCM-TASK-START-DATE TO R905-SYS-DATE.                  DTSCS99
00754      MOVE LCCM-TASK-START-TIME TO R905-SYS-TIME.                  DTSCS99
00755      MOVE LCCM-OP-ID TO R905-OP-ID.                               DTSCS99
00756      MOVE MAP-UPDATE-IND TO R905-UPDATE-IND.                      DTSCS99
00757      MOVE MPRF-UPDATE-TASK-ID       TO R905-UPDATE-TASK-ID.       DTSCS99
00758      MOVE MPRF-UPDATE-OP-ID         TO R905-UPDATE-OP-ID.            CL**4
00759      MOVE MPRF-UPDATE-TERMID        TO R905-UPDATE-TERMID.        DTSCS99
00760      MOVE MPRF-UPDATE-NETNAME       TO R905-UPDATE-NETNAME.          CL**2
00761      MOVE MPRF-UPDATE-START-DATE    TO R905-UPDATE-START-DATE.    DTSCS99
00762      MOVE MPRF-UPDATE-START-TIME    TO R905-UPDATE-START-TIME.    DTSCS99
00763      MOVE MPRF-UPDATE-SCR-ID        TO R905-UPDATE-SCR-ID.        DTSCS99
00764      MOVE MPRF-UPDATE-FUNCTION      TO R905-UPDATE-FUNCTION.      DTSCS99
00765                                                                      CL**4
00766      MOVE LOW-VALUES TO R905-PADDING-FOR-SYNCSORT.                   CL**4
00767                                                                      CL**4
00768      MOVE LENGTH OF R905-REC TO R905-LENGTH.                         CL**4
00769                                                                      CL**4
00770      MOVE R905-REC TO RSKL-REC.                                   DTSCS99
00771                                                                      CL**4
00772      PERFORM S825-WRITE THRU S825-EXIT.                              CL**4
00773  P8910-EXIT.                                                      DTSCS99
00774      EXIT.                                                        DTSCS99
00775 /*****************************************************************DTSCS99
00776 * LINKS TO UTILITY MODULES                                        DTSCS99
00777 ******************************************************************DTSCS99
00778      SKIP1                                                        DTSCS99
00779  S018-EMP-NO.                                                     DTSCS99
00780      EXEC CICS LINK                                               DTSCS99
00781          PROGRAM('DTSCU018')                                         CL**2
00782          COMMAREA(L018-COMM-AREA)                                 DTSCS99
00783      END-EXEC.                                                    DTSCS99
00784  S018-EXIT.                                                       DTSCS99
00785      EXIT.                                                        DTSCS99
00786      SKIP3                                                        DTSCS99
00787  S803-REQ-SCR-ID-EDIT.                                            DTSCS99
00788      EXEC CICS LINK                                               DTSCS99
00789          PROGRAM ('DTSCU803')                                        CL**2
00790          COMMAREA (DFHCOMMAREA)                                   DTSCS99
00791      END-EXEC.                                                    DTSCS99
00792  S803-EXIT.                                                       DTSCS99
00793      EXIT.                                                        DTSCS99
00794      SKIP3                                                        DTSCS99
00795  S804-INVALID-KEY.                                                DTSCS99
00796      EXEC CICS LINK                                               DTSCS99
00797          PROGRAM ('DTSCU804')                                        CL**2
00798          COMMAREA (DFHCOMMAREA)                                   DTSCS99
00799      END-EXEC.                                                    DTSCS99
00800  S804-EXIT.                                                       DTSCS99
00801      EXIT.                                                        DTSCS99
00802      SKIP3                                                        DTSCS99
00803  S805-MSG-AREA.                                                   DTSCS99
00804      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS99
00805      SKIP1                                                        DTSCS99
00806      EXEC CICS LINK                                               DTSCS99
00807          PROGRAM ('DTSCU805')                                        CL**2
00808          COMMAREA (L805-COMM-AREA)                                DTSCS99
00809      END-EXEC.                                                    DTSCS99
00810      SKIP1                                                        DTSCS99
00811      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS99
00812  S805-EXIT.                                                       DTSCS99
00813      EXIT.                                                        DTSCS99
00814      EJECT                                                        DTSCS99
00815  S810-READ.                                                       DTSCS99
00816      SET L810-READ-88 TO TRUE.                                    DTSCS99
00817      GO TO S810-IO.                                               DTSCS99
00818      SKIP1                                                        DTSCS99
00819  S810-START-BROWSE.                                               DTSCS99
00820      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS99
00821      GO TO S810-IO.                                               DTSCS99
00822      SKIP1                                                        DTSCS99
00823  S810-READ-NEXT.                                                  DTSCS99
00824      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS99
00825      GO TO S810-IO.                                               DTSCS99
00826      SKIP1                                                        DTSCS99
00827  S810-READ-PREV.                                                  DTSCS99
00828      SET L810-READ-PREV-88 TO TRUE.                               DTSCS99
00829      GO TO S810-IO.                                               DTSCS99
00830      SKIP1                                                        DTSCS99
00831  S810-END-BROWSE.                                                 DTSCS99
00832      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS99
00833      GO TO S810-IO.                                               DTSCS99
00834      SKIP1                                                        DTSCS99
00835  S810-REWRITE.                                                    DTSCS99
00836      SET L810-REWRITE-88 TO TRUE.                                 DTSCS99
00837      GO TO S810-IO.                                               DTSCS99
00838      SKIP1                                                        DTSCS99
00839  S810-WRITE.                                                      DTSCS99
00840      SET L810-WRITE-88 TO TRUE.                                   DTSCS99
00841      GO TO S810-IO.                                               DTSCS99
00842      SKIP1                                                        DTSCS99
00843  S810-DELETE.                                                     DTSCS99
00844      SET L810-DELETE-88 TO TRUE.                                  DTSCS99
00845      GO TO S810-IO.                                               DTSCS99
00846      SKIP1                                                        DTSCS99
00847  S810-IO.                                                         DTSCS99
00848      SKIP1                                                        DTSCS99
00849      EXEC CICS LINK                                               DTSCS99
00850          PROGRAM ('DTSCU810')                                        CL**2
00851          COMMAREA (L810-COMM-AREA)                                DTSCS99
00852      END-EXEC.                                                    DTSCS99
00853      SKIP1                                                        DTSCS99
00854      IF L810-FILE-CLOSED-88                                       DTSCS99
00855          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS99
00856          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS99
00857          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS99
00858          GO TO MAINLINE-EXIT.                                     DTSCS99
00859  S810-EXIT.                                                       DTSCS99
00860      EXIT.                                                        DTSCS99
00861      EJECT                                                        DTSCS99
00862  S825-WRITE.                                                      DTSCS99
00863      SET L825-WRITE-88 TO TRUE.                                   DTSCS99
00864      GO TO S825-O.                                                DTSCS99
00865      SKIP1                                                        DTSCS99
00866  S825-O.                                                          DTSCS99
00867      SKIP1                                                        DTSCS99
00868      EXEC CICS LINK                                               DTSCS99
00869          PROGRAM ('DTSCU825')                                        CL**2
00870          COMMAREA (L825-COMM-AREA)                                DTSCS99
00871      END-EXEC.                                                    DTSCS99
00872      SKIP1                                                        DTSCS99
00873      IF L825-FILE-CLOSED-88                                       DTSCS99
00874          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS99
00875          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS99
00876          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS99
00877          GO TO MAINLINE-EXIT.                                     DTSCS99
00878  S825-EXIT.                                                       DTSCS99
00879      EXIT.                                                        DTSCS99
00880      EJECT                                                        DTSCS99
00881  S851-SCREEN-PROCESSING.                                          DTSCS99
00882      EXEC CICS LINK                                               DTSCS99
00883          PROGRAM ('DTSCU851')                                        CL**2
00884          COMMAREA (L851-COMM-AREA)                                DTSCS99
00885      END-EXEC.                                                    DTSCS99
00886  S851-EXIT.                                                       DTSCS99
00887      EXIT.                                                        DTSCS99
00888      SKIP3                                                        DTSCS99
00889  S899-ABEND.                                                      DTSCS99
00890      EXEC CICS ABEND                                              DTSCS99
00891          ABCODE(WRK-ABEND-CD)                                     DTSCS99
00892      END-EXEC.                                                    DTSCS99
00893  S899-EXIT.                                                       DTSCS99
00894      EXIT.                                                        DTSCS99
00895 /*****************************************************************DTSCS99
00896 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS99
00897 ******************************************************************DTSCS99
00898      SKIP1                                                        DTSCS99
00899  S1000-SCREEN-EDITS.                                              DTSCS99
00900      PERFORM S1100-EMP-NO THRU S1100-EXIT.                        DTSCS99
00901      SKIP1                                                        DTSCS99
00902      IF LCCM-MSG                                                  DTSCS99
00903          GO TO S1000-EXIT.                                        DTSCS99
00904      SKIP1                                                        DTSCS99
00905      PERFORM S1190-READ-MPRF THRU S1190-EXIT.                     DTSCS99
00906      SKIP1                                                        DTSCS99
00907      IF LCCM-MSG                                                  DTSCS99
00908          GO TO S1000-EXIT.                                        DTSCS99
00909      SKIP1                                                        DTSCS99
00910      PERFORM S1200-UPDATE-IND THRU S1200-EXIT.                    DTSCS99
00911  S1000-EXIT.                                                      DTSCS99
00912      EXIT.                                                        DTSCS99
00913      SKIP3                                                        DTSCS99
00914  S1001-EDIT-KEY.                                                  DTSCS99
00915      PERFORM S1100-EMP-NO THRU S1100-EXIT.                        DTSCS99
00916  S1001-EXIT.                                                      DTSCS99
00917      EXIT.                                                        DTSCS99
00918      EJECT                                                        DTSCS99
00919  S1100-EMP-NO.                                                    DTSCS99
00920      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS99
00921      PERFORM S018-EMP-NO THRU S018-EXIT.                          DTSCS99
00922      IF L018-NO-ENTRY                                             DTSCS99
00923          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS99
00924          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS99
00925      ELSE                                                         DTSCS99
00926      IF L018-NOT-VALID                                            DTSCS99
00927          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS99
00928          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS99
00929      ELSE                                                         DTSCS99
00930          MOVE L018-EMP-NO TO WRK-EMP-NO.                          DTSCS99
00931  S1100-EXIT.                                                      DTSCS99
00932      EXIT.                                                        DTSCS99
00933      SKIP3                                                        DTSCS99
00934  S1190-READ-MPRF.                                                 DTSCS99
00935      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS99
00936      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS99
00937      SET MPRF-PRF-88 TO TRUE.                                     DTSCS99
00938      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS99
00939      PERFORM S810-READ THRU S810-EXIT.                            DTSCS99
00940      IF L810-NO-REC-88                                            DTSCS99
00941          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS99
00942          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS99
00943      ELSE                                                         DTSCS99
00944          SET WRK-MPRF-YES-88 TO TRUE                              DTSCS99
00945          MOVE MSKL-REC TO MPRF-REC.                               DTSCS99
00946  S1190-EXIT.                                                      DTSCS99
00947      EXIT.                                                        DTSCS99
00948      SKIP3                                                        DTSCS99
00949  S1199-ERROR.                                                     DTSCS99
00950      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS99
00951                                       MAP-EMP-NO-2-A.             DTSCS99
00952      IF LCCM-NO-MSG                                               DTSCS99
00953          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS99
00954          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                       DTSCS99
00955          SET CURSOR-SET-YES TO TRUE.                              DTSCS99
00956  S1199-EXIT.                                                      DTSCS99
00957      EXIT.                                                        DTSCS99
00958      EJECT                                                        DTSCS99
00959  S1200-UPDATE-IND.                                                DTSCS99
00960      IF MAP-UPDATE-IND = SPACES OR LOW-VALUES                     DTSCS99
00961          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS99
00962          PERFORM S1299-ERROR THRU S1299-EXIT                      DTSCS99
00963      ELSE                                                         DTSCS99
00964      IF MAP-UPDATE-IND = 'N' OR 'Y'                               DTSCS99
00965          NEXT SENTENCE                                            DTSCS99
00966      ELSE                                                         DTSCS99
00967          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS99
00968          PERFORM S1299-ERROR THRU S1299-EXIT.                     DTSCS99
00969  S1200-EXIT.                                                      DTSCS99
00970      EXIT.                                                        DTSCS99
00971      SKIP3                                                        DTSCS99
00972  S1299-ERROR.                                                     DTSCS99
00973      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UPDATE-IND-A.          DTSCS99
00974      IF LCCM-NO-MSG                                               DTSCS99
00975          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS99
00976          MOVE CATB-CURSOR TO MAP-UPDATE-IND-L                     DTSCS99
00977          SET CURSOR-SET-YES TO TRUE.                              DTSCS99
00978  S1299-EXIT.                                                      DTSCS99
00979      EXIT.                                                        DTSCS99
00980 /*****************************************************************DTSCS99
00981 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS99
00982 ******************************************************************DTSCS99
00983  S5100-SET-LOCK-ATTRB.                                            DTSCS99
00984      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS99
00985                                 WRK-ATB-NUM.                      DTSCS99
00986      SKIP1                                                        DTSCS99
00987      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS99
00988      SKIP1                                                        DTSCS99
00989      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS99
00990                                 MAP-EMP-NO-2-A                    DTSCS99
00991                                 MAP-GOTO-A.                       DTSCS99
00992  S5100-EXIT.                                                      DTSCS99
00993      EXIT.                                                        DTSCS99
00994      SKIP3                                                        DTSCS99
00995 ******************************************************************DTSCS99
00996 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS99
00997 ******************************************************************DTSCS99
00998  S5200-SET-UPDATE-ATTRB.                                          DTSCS99
00999      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS99
01000      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS99
01001      SKIP1                                                        DTSCS99
01002      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS99
01003  S5200-EXIT.                                                      DTSCS99
01004      EXIT.                                                        DTSCS99
01005      SKIP3                                                        DTSCS99
01006 ******************************************************************DTSCS99
01007 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS99
01008 ******************************************************************DTSCS99
01009  S5300-SET-INQ-ATTRB.                                             DTSCS99
01010      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS99
01011                                   WRK-ATB-NUM.                    DTSCS99
01012      SKIP1                                                        DTSCS99
01013      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS99
01014  S5300-EXIT.                                                      DTSCS99
01015      EXIT.                                                        DTSCS99
01016      SKIP3                                                        DTSCS99
01017  S5900-SET-ATTRB.                                                 DTSCS99
01018      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS99
01019                                      MAP-EMP-NO-2-A.              DTSCS99
01020      SKIP1                                                        DTSCS99
01021      SKIP1                                                        DTSCS99
01022      MOVE WRK-ATB-AN TO MAP-UPDATE-IND-A.                         DTSCS99
01023      SKIP1                                                        DTSCS99
01024      MOVE CATB-ASKIP-BRT-MDTON                                    DTSCS99
01025        TO MAP-PRIMARY-NAME-A                                         CL**2
01026           MAP-UPDATE-TASK-ID-A                                    DTSCS99
01027           MAP-UPDATE-OP-ID-A                                      DTSCS99
01028           MAP-UPDATE-TERMID-A                                     DTSCS99
01029           MAP-UPDATE-NETNAME-A                                       CL**2
01030           MAP-UPDATE-SCR-ID-A                                     DTSCS99
01031           MAP-UPDATE-FUNCTION-A                                   DTSCS99
01032           MAP-UPDATE-START-DATE-A                                 DTSCS99
01033           MAP-UPDATE-START-TIME-A.                                DTSCS99
01034      SKIP1                                                        DTSCS99
01035      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS99
01036  S5900-EXIT.                                                      DTSCS99
01037      EXIT.                                                        DTSCS99
01038 /*****************************************************************DTSCS99
01039 * MAP ROUTINES                                                   *DTSCS99
01040 ******************************************************************DTSCS99
01041  S9100-RECEIVE.                                                   DTSCS99
01042      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS99
01043      SKIP1                                                        DTSCS99
01044      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS99
01045      SKIP1                                                        DTSCS99
01046      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS99
01047      SKIP1                                                        DTSCS99
01048      MOVE L851-AID TO LCCM-AID.                                   DTSCS99
01049      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS99
01050  S9100-EXIT.                                                      DTSCS99
01051      EXIT.                                                        DTSCS99
01052      SKIP3                                                        DTSCS99
01053  S9200-SEND-DATAONLY.                                             DTSCS99
01054      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS99
01055      SKIP1                                                        DTSCS99
01056      IF LCCM-NO-MSG                                               DTSCS99
01057          NEXT SENTENCE                                            DTSCS99
01058      ELSE                                                         DTSCS99
01059          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS99
01060      SKIP1                                                        DTSCS99
01061      IF CURSOR-SET-GOTO                                           DTSCS99
01062          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS99
01063      ELSE                                                         DTSCS99
01064          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS99
01065      SKIP1                                                        DTSCS99
01066      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS99
01067      SKIP1                                                        DTSCS99
01068      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS99
01069      SKIP1                                                        DTSCS99
01070      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS99
01071  S9200-EXIT.                                                      DTSCS99
01072      EXIT.                                                        DTSCS99
01073      SKIP3                                                        DTSCS99
01074  S9300-SEND-MAP.                                                  DTSCS99
01075      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS99
01076      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS99
01077      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS99
01078      SKIP1                                                        DTSCS99
01079      IF SCR-ACCESS-UPDATE                                         DTSCS99
01080          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS99
01081      ELSE                                                         DTSCS99
01082          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS99
01083      SKIP1                                                        DTSCS99
01084      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS99
01085      SKIP1                                                        DTSCS99
01086      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS99
01087      SKIP1                                                        DTSCS99
01088      IF CURSOR-SET-NO                                             DTSCS99
01089          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS99
01090      SKIP1                                                        DTSCS99
01091      SET L851-SEND-88 TO TRUE.                                    DTSCS99
01092      SKIP1                                                        DTSCS99
01093      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS99
01094      SKIP1                                                        DTSCS99
01095      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS99
01096  S9300-EXIT.                                                      DTSCS99
01097      EXIT.                                                        DTSCS99
01098      SKIP3                                                        DTSCS99
01099  S9310-UPDATE-FKEYS.                                              DTSCS99
01100      MOVE CFKD-MOD TO MAP-KEY-MOD.                                DTSCS99
01101      SKIP1                                                        DTSCS99
01102      IF LCCM-SCR-CLEAR                                            DTSCS99
01103          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS99
01104      ELSE                                                         DTSCS99
01105      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS99
01106          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS99
01107      ELSE                                                         DTSCS99
01108          NEXT SENTENCE.                                           DTSCS99
01109  S9310-EXIT.                                                      DTSCS99
01110      EXIT.                                                        DTSCS99
01111      SKIP3                                                        DTSCS99
01112  S9320-INQUIRY-FKEYS.                                             DTSCS99
01113      MOVE LOW-VALUES TO MAP-KEY-MOD.                              DTSCS99
01114  S9320-EXIT.                                                      DTSCS99
01115      EXIT.                                                        DTSCS99
01116      SKIP3                                                        DTSCS99
01117  S9330-DSCR-FIELDS.                                               DTSCS99
01118      MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                            CL**3
01119      IF WRK-MPRF-YES-88                                           DTSCS99
01120          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.                 CL**2
01121  S9330-EXIT.                                                      DTSCS99
01122      EXIT.                                                        DTSCS99
01123      SKIP3                                                        DTSCS99
01124  S9900-PREPARE-SEND.                                              DTSCS99
01125      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS99
01126                         LCCM-SCR-ID.                              DTSCS99
01127      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS99
01128      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS99
01129  S9900-EXIT.                                                      DTSCS99
01130      EXIT.                                                        DTSCS99
