00001  IDENTIFICATION DIVISION.                                         04/24/07
00002  PROGRAM-ID.             DTSCS18.                                 DTSCS18
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV006
00004  DATE-WRITTEN.           APRIL 1994.                              DTSCS18
00005  DATE-COMPILED.                                                   DTSCS18
00006      SKIP3                                                        DTSCS18
00007 *****                                                             DTSCS18
00008 *                                                                 DTSCS18
00009 *    FUNCTION:  RELATIONSHIP INQUIRY                              DTSCS18
00010 *               SCREEN PROCESSOR.                                 DTSCS18
00011 *                                                                 DTSCS18
00012 *                                                                 DTSCS18
00013 *    MODIFICATION LOG:                                            DTSCS18
00014 *                                                                 DTSCS18
00015 *    10/29/1998  INITIAL DEVELOPMENT.        COPIED FROM MACCS18. DTSCS18
00016 *                WORK ORDER:                    PROGRAMMER: ZL1   DTSCS18
00017 *                                                                 DTSCS18
00018 *    10/23/2006  REPLACED EXPERIENCE TRANSFERRED CODE BY          DTSCS18
00019 *                PERCENTAGE OF EXPERIENCE TRANSFERRED.            DTSCS18
00020 *                WORK ORDER:                    PROGRAMMER: GD    DTSCS18
00021 *                                                                 DTSCS18
00022 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS18
00023 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS18
00024 *                WORK ORDER:                    PROGRAMMER: XXX   DTSCS18
00025 *                                                                 DTSCS18
00026 *                                                                 DTSCS18
00027 *  DESCRIPTION:                                                   DTSCS18
00028 *                                                                 DTSCS18
00029 *                                                                 DTSCS18
00030 *    CLEAR:                                                       DTSCS18
00031 *                                                                 DTSCS18
00032 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS18
00033 *                                                                 DTSCS18
00034 *                                                                 DTSCS18
00035 *    JUMP:                                                        DTSCS18
00036 *                                                                 DTSCS18
00037 *      F17  REGISTRATION INQUIRY (11)                             DTSCS18
00038 *      F21  RELATIONSHIP INQUIRY/UPDATE (19)                      DTSCS18
00039 *                                                                 DTSCS18
00040 *                                                                 DTSCS18
00041 *    INQUIRY:                                                     DTSCS18
00042 *                                                                 DTSCS18
00043 *      CONTROL FIELD(S): MAP-EMP-NO                               DTSCS18
00044 *                                                                 DTSCS18
00045 *      JUMP IN: IF LCCM-EMP-NO = LCCM-SCR18-HOLD-AREA EMP-NO      DTSCS18
00046 *                 DISPLAY THE PAGE OF INFORMATION INDICATED       DTSCS18
00047 *                 BY LCCM-SCR18-HOLD-AREA                         DTSCS18
00048 *               ELSE                                              DTSCS18
00049 *                 DISPLAY FIRST PAGE OF INFORMATION ASSOCIATED    DTSCS18
00050 *                 WITH LCCM-EMP-NO.                               DTSCS18
00051 *                                                                 DTSCS18
00052 *      ENTER, F05, F06, F07, F08: STANDARD PAGING.                DTSCS18
00053 *                                                                 DTSCS18
00054 *               DISPLAY SEQUENCE: RELATIONSHIPS IN WHICH          DTSCS18
00055 *                                 MAP-EMP-NO IS THE SUCCESSOR     DTSCS18
00056 *                                 DESCENDING ON MREL-EFF-DATE     DTSCS18
00057 *                                                                 DTSCS18
00058 *                                       FOLLOWED BY               DTSCS18
00059 *                                                                 DTSCS18
00060 *                                 RELATIONSHIPS IN WHICH          DTSCS18
00061 *                                 MAP-EMP-NO IS THE PREDECESSOR   DTSCS18
00062 *                                 DESCENDING ON IPES-EFF-DATE.    DTSCS18
00063 *                                                                 DTSCS18
00064 *       PAGE INITIALLY DISPLAYED:  FIRST                          DTSCS18
00065 *                                                                 DTSCS18
00066 *                                                                 DTSCS18
00067 *      JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE.                DTSCS18
00068 *                                                                 DTSCS18
00069 *                STORE INFORMATION REPRESENTING PAGE CURRENTLY    DTSCS18
00070 *                DISPLAYED IN LCCM-SCR18-HOLD-AREA.               DTSCS18
00071 *                                                                 DTSCS18
00072 *                IF A LINE NO IS BEING SELECTED:                  DTSCS18
00073 *                  IF (JUMP TO SCREEN '19' REQUESTED)             DTSCS18
00074 *                      CONSTRUCT LCCM-SCR19-HOLD-AREA.            DTSCS18
00075 *                                                                 DTSCS18
00076 *                                                                 DTSCS18
00077 *      STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA.    DTSCS18
00078 *                                                                 DTSCS18
00079 *                                                                 DTSCS18
00080 *      DURING A DISPLAY OF THE RESULTS OF AN INQUIRY, USE         DTSCS18
00081 *      LCCM-SCR-HOLD-AREA TO HOLD THE RECORD KEYS OF THE          DTSCS18
00082 *      FROM 1 TO 16 MREL OR IPES RECORDS FROM WHICH THE           DTSCS18
00083 *      LINES OF THE DISPLAY WERE CONSTRUCTED.                     DTSCS18
00084 *                                                                 DTSCS18
00085 *                                                                 DTSCS18
00086 *      WHEN THE USER SELECTS A 'LINE NO', THE INFORMATION         DTSCS18
00087 *      STORED IN LCCM-SCR-HOLD-AREA IS USED TO DETERMINE WHICH    DTSCS18
00088 *      MREL RECORD OR IPES RECORD WAS SELECTED.                   DTSCS18
00089 *                                                                 DTSCS18
00090 *                                                                 DTSCS18
00091 *    UPDATE:                                                      DTSCS18
00092 *                                                                 DTSCS18
00093 *      NONE.                                                      DTSCS18
00094 *                                                                 DTSCS18
00095 *                                                                 DTSCS18
00096 *    RECORDS READ:                                                DTSCS18
00097 *                                                                 DTSCS18
00098 *      MASTER:                                                    DTSCS18
00099 *                                                                 DTSCS18
00100 *        MPRF                                                     DTSCS18
00101 *        MREL                                                     DTSCS18
00102 *                                                                 DTSCS18
00103 *                                                                 DTSCS18
00104 *      ALTERNATE INDEX:                                           DTSCS18
00105 *                                                                 DTSCS18
00106 *        IPES.                                                    DTSCS18
00107 *                                                                 DTSCS18
00108 *                                                                 DTSCS18
00109 *      REFERENCE:                                                 DTSCS18
00110 *                                                                 DTSCS18
00111 *        NONE.                                                    DTSCS18
00112 *                                                                 DTSCS18
00113 *                                                                 DTSCS18
00114 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS18
00115 *                                                                 DTSCS18
00116 *        NONE.                                                    DTSCS18
00117 *                                                                 DTSCS18
00118 *                                                                 DTSCS18
00119 *    RECORDS UPDATED:                                             DTSCS18
00120 *                                                                 DTSCS18
00121 *      MASTER:                                                    DTSCS18
00122 *                                                                 DTSCS18
00123 *        NONE.                                                    DTSCS18
00124 *                                                                 DTSCS18
00125 *                                                                 DTSCS18
00126 *      REFERENCE:                                                 DTSCS18
00127 *                                                                 DTSCS18
00128 *        NONE.                                                    DTSCS18
00129 *                                                                 DTSCS18
00130 *                                                                 DTSCS18
00131 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS18
00132 *                                                                 DTSCS18
00133 *        NONE.                                                    DTSCS18
00134 *                                                                 DTSCS18
00135 *                                                                 DTSCS18
00136 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS18
00137 *                                                                 DTSCS18
00138 *      NONE.                                                      DTSCS18
00139 *                                                                 DTSCS18
00140 *                                                                 DTSCS18
00141 *    TEMPORARY STORAGE USAGE:                                     DTSCS18
00142 *                                                                 DTSCS18
00143 *      S  OVERFLOW FROM LCCM-SCR-HOLD-AREA.                       DTSCS18
00144 *                                                                 DTSCS18
00145 *                                                                 DTSCS18
00146 *    MODULES LINKED TO:                                           DTSCS18
00147 *                                                                 DTSCS18
00148 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS18
00149 *      DTSCU810  MASTER FILE INPUT/OUPUT.                         DTSCS18
00150 *      DTSCU821  ALTERNATE INDEX FILE INPUT/OUTPUT.               DTSCS18
00151 *      DTSCU829  TEMPORARY STORAGE INPUT/OUTPUT.                  DTSCS18
00152 *                                                                 DTSCS18
00153 *                                                                 DTSCS18
00154 *    VERMONT REFERENCE:                                           DTSCS18
00155 *                                                                 DTSCS18
00156 *       NONE.                                                     DTSCS18
00157 *                                                                 DTSCS18
00158 *****                                                             DTSCS18
00159      SKIP3                                                        DTSCS18
00160  ENVIRONMENT DIVISION.                                            DTSCS18
00161      SKIP3                                                        DTSCS18
00162  DATA DIVISION.                                                   DTSCS18
00163      SKIP3                                                        DTSCS18
00164  WORKING-STORAGE SECTION.                                         DTSCS18
001645 77  PAN-VALET PICTURE X(24) VALUE '006DTSCS18   04/24/07'.       DTSCS18
00165      SKIP3                                                        DTSCS18
00166  01  WRK-AREA.                                                    DTSCS18
00167      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S18 '.    DTSCS18
00168      SKIP1                                                        DTSCS18
00169      05  WRK-SCR-ID.                                              DTSCS18
00170          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 18.        DTSCS18
00171      SKIP1                                                        DTSCS18
00172      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '10'.      DTSCS18
00173                                                                   DTSCS18
00174      05  LINES-PER-PAGE              PIC S9(04)  COMP  VALUE +16. DTSCS18
00175      SKIP3                                                        DTSCS18
00176      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS18
00177          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS18
00178          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS18
00179      SKIP1                                                        DTSCS18
00180      05  CURSOR-SET-IND              PIC X(01).                   DTSCS18
00181          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS18
00182          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS18
00183          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS18
00184          88  CURSOR-SET-LINE-NUMBER          VALUE 'L'.           DTSCS18
00185      SKIP1                                                        DTSCS18
00186      05  REQ-IND                     PIC X(01).                   DTSCS18
00187          88  REQ-ERROR                       VALUE 'O'.           DTSCS18
00188          88  REQ-JUMP                        VALUE 'J'.           DTSCS18
00189          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS18
00190          88  REQ-CLEAR                       VALUE 'C'.           DTSCS18
00191 *********88  REQ-EDIT                        VALUE 'E'.           DTSCS18
00192 *********88  REQ-UPDATE                      VALUE 'U'.           DTSCS18
00193          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS18
00194      SKIP1                                                        DTSCS18
00195      05  RESP-IND                    PIC X(01).                   DTSCS18
00196          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS18
00197          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS18
00198          88  RESP-JUMP                       VALUE 'J'.           DTSCS18
00199          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS18
00200      SKIP1                                                        DTSCS18
00201      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS18
00202      SKIP1                                                        DTSCS18
00203      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS18
00204      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS18
00205      SKIP3                                                        DTSCS18
00206      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS18
00207      SKIP3                                                        DTSCS18
00208      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS18
00209      SKIP1                                                        DTSCS18
00210      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS18
00211          10  FILLER                  PIC X(05).                   DTSCS18
00212          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS18
00213          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS18
00214      SKIP3                                                        DTSCS18
00215      05  LINE-OCC                    PIC S9(04)  COMP.            DTSCS18
00216      SKIP3                                                        DTSCS18
00217      05  SCR-HOLD-AREA.                                           DTSCS18
00218          10  SCR-HOLD-EMP-NO         PIC S9(07)  COMP-3.          DTSCS18
00219          10  SCR-HOLD-CURR-PAGE-NUM  PIC S9(04)  COMP.            DTSCS18
00220      SKIP3                                                        DTSCS18
00221      05  INQUIRY-CONTROL-AREA.                                    DTSCS18
00222          10  ITEM-LENGTH         PIC S9(04)  COMP  VALUE +16.     DTSCS18
00223          10  ITEM-MAX            PIC S9(05)  COMP  VALUE +32760.  DTSCS18
00224          10  TBL-ITEM-MAX        PIC S9(04)  COMP  VALUE +100.    DTSCS18
00225                                                                   DTSCS18
00226          10  LAST-PAGE-NUM       PIC S9(04)  COMP.                DTSCS18
00227          10  CURR-PAGE-NUM       PIC S9(04)  COMP.                DTSCS18
00228      SKIP1                                                        DTSCS18
00229          10  ITEM-SUB            PIC S9(04)  COMP.                DTSCS18
00230      SKIP1                                                        DTSCS18
00231          10  ITEM-CNT            PIC S9(04)  COMP.                DTSCS18
00232      SKIP1                                                        DTSCS18
00233          10  TBL-ITEM OCCURS 100 TIMES                            DTSCS18
00234                                  PIC  X(16).                      DTSCS18
00235      SKIP3                                                        DTSCS18
00236      05  LS19-AREA.                                               DTSCS18
00237  ++INCLUDE DTSILS19                                               DTSCS18
00238 *****EJECT                                                        DTSCS18
00239 *01  MSG-LITERALS.                                                DTSCS18
00240 *****05  MSG-E181-AREA.                                           DTSCS18
00241 *****    10  FILLER                  PIC  X(04)  VALUE 'E181'.    DTSCS18
00242 *****    10  FILLER                  PIC  X(30)                   DTSCS18
00243 *****          VALUE '                              '.            DTSCS18
00244 *****    10  FILLER                  PIC  X(30)                   DTSCS18
00245 *****          VALUE '                              '.            DTSCS18
00246      EJECT                                                        DTSCS18
00247  01  L001-COMM-AREA.                                              DTSCS18
00248  ++INCLUDE DTSIL001                                               DTSCS18
00249      EJECT                                                        DTSCS18
00250  01  L013-COMM-AREA.                                              DTSCS18
00251  ++INCLUDE DTSIL013                                               DTSCS18
00252      EJECT                                                        DTSCS18
00253  01  L018-COMM-AREA.                                              DTSCS18
00254  ++INCLUDE DTSIL018                                               DTSCS18
00255      EJECT                                                        DTSCS18
00256  01  L805-COMM-AREA.                                              DTSCS18
00257  ++INCLUDE DTSIL805                                               DTSCS18
00258      EJECT                                                        DTSCS18
00259  01  L810-COMM-AREA.                                              DTSCS18
00260      05  L810-CONTROL-BLOCK.                                      DTSCS18
00261  ++INCLUDE DTSIL810                                               DTSCS18
00262      EJECT                                                        DTSCS18
00263      05  MSKL-REC.                                                DTSCS18
00264  ++INCLUDE DTSIMSKL                                               DTSCS18
00265      EJECT                                                        DTSCS18
00266  01  MPRF-REC.                                                    DTSCS18
00267  ++INCLUDE DTSIMPRF                                               DTSCS18
00268      EJECT                                                        DTSCS18
00269  01  MREL-REC.                                                    DTSCS18
00270  ++INCLUDE DTSIMREL                                               DTSCS18
00271      EJECT                                                        DTSCS18
00272  01  L821-COMM-AREA.                                              DTSCS18
00273      05  L821-CONTROL-BLOCK.                                      DTSCS18
00274  ++INCLUDE DTSIL821                                               DTSCS18
00275      SKIP3                                                        DTSCS18
00276      05  ISKL-REC.                                                DTSCS18
00277  ++INCLUDE DTSIISKL                                               DTSCS18
00278      EJECT                                                        DTSCS18
00279  01  IPES-REC.                                                    DTSCS18
00280  ++INCLUDE DTSIIPES                                               DTSCS18
00281      EJECT                                                        DTSCS18
00282  01  L829-COMM-AREA.                                              DTSCS18
00283      05  L829-CONTROL-BLOCK.                                      DTSCS18
00284  ++INCLUDE DTSIL829                                               DTSCS18
00285      SKIP3                                                        DTSCS18
00286      05  L829-REC                 PIC  X(16).                     DTSCS18
00287      EJECT                                                        DTSCS18
00288  01  L851-COMM-AREA.                                              DTSCS18
00289  ++INCLUDE DTSIL851                                               DTSCS18
00290      SKIP3                                                        DTSCS18
00291      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS18
00292  ++INCLUDE DTSIS18                                                DTSCS18
00293      EJECT                                                        DTSCS18
00294  01  CATB-LITERALS.                                               DTSCS18
00295  ++INCLUDE DTSICATB                                               DTSCS18
00296      SKIP3                                                        DTSCS18
00297  01  CFKD-LITERALS.                                               DTSCS18
00298  ++INCLUDE DTSICFKD                                               DTSCS18
00299      SKIP3                                                        DTSCS18
00300  01  CECD-LITERALS.                                               DTSCS18
00301  ++INCLUDE DTSICECD                                               DTSCS18
00302      SKIP3                                                        DTSCS18
00303  01  CPCD-LITERALS.                                               DTSCS18
00304  ++INCLUDE DTSICPCD                                               DTSCS18
00305      EJECT                                                        DTSCS18
00306  LINKAGE SECTION.                                                 DTSCS18
00307      SKIP3                                                        DTSCS18
00308  01  DFHCOMMAREA.                                                 DTSCS18
00309  ++INCLUDE DTSILCCM                                               DTSCS18
00310      SKIP3                                                        DTSCS18
00311              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS18
00312                  20  LCCM-SCR-HOLD-LINE-CNT  PIC S9(04)  COMP.    DTSCS18
00313                  20  LCCM-SCR-HOLD-LINE-KEY-AREA                  DTSCS18
00314                                      OCCURS 16 TIMES              DTSCS18
00315                                              PIC  X(16).          DTSCS18
00316      EJECT                                                        DTSCS18
00317 ******************************************************************DTSCS18
00318 *                                                                *DTSCS18
00319 ******************************************************************DTSCS18
00320      SKIP1                                                        DTSCS18
00321  PROCEDURE DIVISION.                                              DTSCS18
00322      SKIP2                                                        DTSCS18
00323      MOVE +0 TO WRK-EMP-NO.                                       DTSCS18
00324      SKIP1                                                        DTSCS18
00325      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS18
00326      SKIP1                                                        DTSCS18
00327      SET CURSOR-SET-NO TO TRUE.                                   DTSCS18
00328      SKIP1                                                        DTSCS18
00329      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS18
00330        TO SCR-ACCESS-IND.                                         DTSCS18
00331      SKIP3                                                        DTSCS18
00332      MOVE SPACE TO REQ-IND.                                       DTSCS18
00333      SKIP1                                                        DTSCS18
00334      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS18
00335      SKIP1                                                        DTSCS18
00336 *-----------------------------------------------------            DTSCS18
00337 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS18
00338 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS18
00339 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS18
00340 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS18
00341 *                                                                 DTSCS18
00342 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS18
00343 *    PROCESSED.                                                   DTSCS18
00344 *                                                                 DTSCS18
00345 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS18
00346 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS18
00347 *    WORK STATION OPERATOR.                                       DTSCS18
00348 *-----------------------------------------------------            DTSCS18
00349      SKIP1                                                        DTSCS18
00350      MOVE SPACE TO RESP-IND.                                      DTSCS18
00351      SKIP1                                                        DTSCS18
00352      IF REQ-ERROR                                                 DTSCS18
00353         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS18
00354      ELSE                                                         DTSCS18
00355      IF REQ-JUMP                                                  DTSCS18
00356         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS18
00357      ELSE                                                         DTSCS18
00358      IF REQ-CLEAR                                                 DTSCS18
00359         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS18
00360      ELSE                                                         DTSCS18
00361      IF REQ-CURSOR-TO-GOTO                                        DTSCS18
00362         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS18
00363      ELSE                                                         DTSCS18
00364      IF REQ-INQUIRE                                               DTSCS18
00365         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS18
00366      ELSE                                                         DTSCS18
00367 *****IF REQ-EDIT                                                  DTSCS18
00368 *****   PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS18
00369 *****ELSE                                                         DTSCS18
00370 *****IF REQ-UPDATE                                                DTSCS18
00371 *****   PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS18
00372 *****ELSE                                                         DTSCS18
00373         GO TO S899-ABEND.                                         DTSCS18
00374      SKIP3                                                        DTSCS18
00375 *-----------------------------------------------------            DTSCS18
00376 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS18
00377 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS18
00378 *-----------------------------------------------------            DTSCS18
00379      SKIP1                                                        DTSCS18
00380      IF RESP-SEND-MAP                                             DTSCS18
00381          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS18
00382          SET LCCM-END-TASK-88 TO TRUE                             DTSCS18
00383      ELSE                                                         DTSCS18
00384      IF RESP-SEND-MSGONLY                                         DTSCS18
00385          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS18
00386          SET LCCM-END-TASK-88 TO TRUE                             DTSCS18
00387      ELSE                                                         DTSCS18
00388      IF RESP-JUMP                                                 DTSCS18
00389          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS18
00390      ELSE                                                         DTSCS18
00391      IF RESP-CURSOR-TO-GOTO                                       DTSCS18
00392          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS18
00393          SET LCCM-END-TASK-88 TO TRUE                             DTSCS18
00394      ELSE                                                         DTSCS18
00395          GO TO S899-ABEND.                                        DTSCS18
00396      SKIP3                                                        DTSCS18
00397  MAINLINE-EXIT.                                                   DTSCS18
00398      SKIP1                                                        DTSCS18
00399      EXEC CICS                                                    DTSCS18
00400          RETURN                                                   DTSCS18
00401      END-EXEC.                                                    DTSCS18
00402      SKIP2                                                        DTSCS18
00403      GOBACK.                                                      DTSCS18
00404      EJECT                                                        DTSCS18
00405 /*****************************************************************DTSCS18
00406 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS18
00407 ******************************************************************DTSCS18
00408  P1000-ANALYZE-REQUEST.                                           DTSCS18
00409      SKIP1                                                        DTSCS18
00410 *-----------------------------------------------------            DTSCS18
00411 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS18
00412 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS18
00413 *     REPLACED WITH ENTER)                                        DTSCS18
00414 *-----------------------------------------------------            DTSCS18
00415      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS18
00416         SET LCCM-ENTER-88 TO TRUE                                 DTSCS18
00417         SET REQ-INQUIRE TO TRUE                                   DTSCS18
00418         IF LCCM-EMP-NO > ZERO                                     DTSCS18
00419             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS18
00420             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS18
00421         END-IF                                                    DTSCS18
00422         GO TO P1000-EXIT.                                         DTSCS18
00423      SKIP3                                                        DTSCS18
00424 *-----------------------------------------------------            DTSCS18
00425 *      MAP IS RECEIVED                                            DTSCS18
00426 *-----------------------------------------------------            DTSCS18
00427      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS18
00428      SKIP3                                                        DTSCS18
00429 *-----------------------------------------------------            DTSCS18
00430 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS18
00431 *    WORK STATION                                                 DTSCS18
00432 *-----------------------------------------------------            DTSCS18
00433      IF LCCM-CLEAR-88                                             DTSCS18
00434         SET REQ-CLEAR TO TRUE                                     DTSCS18
00435         GO TO P1000-EXIT.                                         DTSCS18
00436      SKIP3                                                        DTSCS18
00437 *-----------------------------------------------------            DTSCS18
00438 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS18
00439 *-----------------------------------------------------            DTSCS18
00440 *****IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS18
00441 *****   PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS18
00442 *****   GO TO P1000-EXIT.                                         DTSCS18
00443 *****SKIP3                                                        DTSCS18
00444 *-----------------------------------------------------            DTSCS18
00445 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS18
00446 *-----------------------------------------------------            DTSCS18
00447      IF LCCM-PA2-88                                               DTSCS18
00448          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS18
00449          GO TO P1000-EXIT.                                        DTSCS18
00450      SKIP3                                                        DTSCS18
00451 *-----------------------------------------------------            DTSCS18
00452 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS18
00453 *-----------------------------------------------------            DTSCS18
00454      IF LCCM-PA-88                                                DTSCS18
00455        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS18
00456        SET REQ-ERROR TO TRUE                                      DTSCS18
00457        GO TO P1000-EXIT.                                          DTSCS18
00458      SKIP3                                                        DTSCS18
00459 *-----------------------------------------------------            DTSCS18
00460 *    IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN           DTSCS18
00461 *    CLEAR SCREEN                                                 DTSCS18
00462 *-----------------------------------------------------            DTSCS18
00463      IF LCCM-F12-88                                               DTSCS18
00464         MOVE LOW-VALUES TO MAP-AREA                               DTSCS18
00465         SET REQ-CLEAR TO TRUE                                     DTSCS18
00466         GO TO P1000-EXIT.                                         DTSCS18
00467      SKIP3                                                        DTSCS18
00468 *-----------------------------------------------------            DTSCS18
00469 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS18
00470 *-----------------------------------------------------            DTSCS18
00471      IF LCCM-F03-88                                               DTSCS18
00472         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS18
00473         SET REQ-JUMP TO TRUE                                      DTSCS18
00474         GO TO P1000-EXIT.                                         DTSCS18
00475      SKIP3                                                        DTSCS18
00476 *-----------------------------------------------------            DTSCS18
00477 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS18
00478 *-----------------------------------------------------            DTSCS18
00479      IF LCCM-F04-88                                               DTSCS18
00480         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS18
00481         SET REQ-JUMP TO TRUE                                      DTSCS18
00482         GO TO P1000-EXIT.                                         DTSCS18
00483      SKIP3                                                        DTSCS18
00484 *-----------------------------------------------------            DTSCS18
00485 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS18
00486 *    CORRESPONDENCE SCREEN                                        DTSCS18
00487 *-----------------------------------------------------            DTSCS18
00488      IF LCCM-F14-88                                               DTSCS18
00489         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS18
00490         SET REQ-JUMP TO TRUE                                      DTSCS18
00491         GO TO P1000-EXIT.                                         DTSCS18
00492      SKIP3                                                        DTSCS18
00493 *    IF LCCM-F17-88                                               DTSCS18
00494 *        MOVE '11' TO LCCM-REQ-SCR-ID                             DTSCS18
00495 *        SET REQ-JUMP TO TRUE                                     DTSCS18
00496 *        GO TO P1000-EXIT.                                        DTSCS18
00497 *                                                                 DTSCS18
00498 *    IF LCCM-F21-88                                               DTSCS18
00499 *        MOVE '19' TO LCCM-REQ-SCR-ID                             DTSCS18
00500 *        SET REQ-JUMP TO TRUE                                     DTSCS18
00501 *        GO TO P1000-EXIT.                                        DTSCS18
00502 *    SKIP3                                                        DTSCS18
00503 *-----------------------------------------------------            DTSCS18
00504 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS18
00505 *    REQUESTED SCREEN TYPE                                        DTSCS18
00506 *-----------------------------------------------------            DTSCS18
00507      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS18
00508         NEXT SENTENCE                                             DTSCS18
00509      ELSE                                                         DTSCS18
00510        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS18
00511        SET REQ-JUMP TO TRUE                                       DTSCS18
00512        GO TO P1000-EXIT.                                          DTSCS18
00513      SKIP3                                                        DTSCS18
00514 *-----------------------------------------------------            DTSCS18
00515 *    IF REQUEST TO UPDATE THE DATA (MOD)                          DTSCS18
00516 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS18
00517 *-----------------------------------------------------            DTSCS18
00518 *****IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F11-88                 DTSCS18
00519 *****   IF SCR-ACCESS-UPDATE                                      DTSCS18
00520 *****      SET REQ-EDIT TO TRUE                                   DTSCS18
00521 *****      GO TO P1000-EXIT                                       DTSCS18
00522 *****   ELSE                                                      DTSCS18
00523 *****      PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS18
00524 *****      SET REQ-ERROR TO TRUE                                  DTSCS18
00525 *****      GO TO P1000-EXIT.                                      DTSCS18
00526 *****SKIP3                                                        DTSCS18
00527 *-----------------------------------------------------            DTSCS18
00528 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS18
00529 *          F8), INDICATE INQUIRY REQUEST                          DTSCS18
00530 *-----------------------------------------------------            DTSCS18
00531      IF LCCM-INQUIRY-88                                           DTSCS18
00532          IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES                DTSCS18
00533              SET REQ-INQUIRE TO TRUE                              DTSCS18
00534              GO TO P1000-EXIT                                     DTSCS18
00535          ELSE                                                     DTSCS18
00536              MOVE '19' TO LCCM-REQ-SCR-ID                         DTSCS18
00537              SET REQ-JUMP TO TRUE                                 DTSCS18
00538              GO TO P1000-EXIT.                                    DTSCS18
00539      SKIP3                                                        DTSCS18
00540 *-----------------------------------------------------            DTSCS18
00541 *     ANY OTHER KEY IS INVALID                                    DTSCS18
00542 *-----------------------------------------------------            DTSCS18
00543      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS18
00544      SET REQ-ERROR TO TRUE.                                       DTSCS18
00545  P1000-EXIT.                                                      DTSCS18
00546      EXIT.                                                        DTSCS18
00547      SKIP3                                                        DTSCS18
00548 ******************************************************************DTSCS18
00549 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS18
00550 ******************************************************************DTSCS18
00551      SKIP1                                                        DTSCS18
00552 *P1100-UPDATE-LOCKED.                                             DTSCS18
00553 *-----------------------------------------------------            DTSCS18
00554 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS18
00555 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS18
00556 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS18
00557 *-----------------------------------------------------            DTSCS18
00558 *****IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS18
00559 *****   SET REQ-UPDATE TO TRUE                                    DTSCS18
00560 *****ELSE                                                         DTSCS18
00561 *****   SET REQ-ERROR TO TRUE                                     DTSCS18
00562 *****   IF LCCM-SCR-ADD-LOCKED                                    DTSCS18
00563 *****      MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS18
00564 *****   ELSE                                                      DTSCS18
00565 *****   IF LCCM-SCR-MOD-LOCKED                                    DTSCS18
00566 *****      MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS18
00567 *****   ELSE                                                      DTSCS18
00568 *****   IF LCCM-SCR-DEL-LOCKED                                    DTSCS18
00569 *****      MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID                   DTSCS18
00570 *****   ELSE                                                      DTSCS18
00571 *****      GO TO S899-ABEND.                                      DTSCS18
00572 *P1100-EXIT.                                                      DTSCS18
00573 *****EXIT.                                                        DTSCS18
00574 /*****************************************************************DTSCS18
00575 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS18
00576 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS18
00577 ******************************************************************DTSCS18
00578      SKIP1                                                        DTSCS18
00579  P2000-REQUEST-ERROR.                                             DTSCS18
00580      IF LCCM-MSG                                                  DTSCS18
00581         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS18
00582      ELSE                                                         DTSCS18
00583         GO TO S899-ABEND.                                         DTSCS18
00584  P2000-EXIT.                                                      DTSCS18
00585      EXIT.                                                        DTSCS18
00586 /*****************************************************************DTSCS18
00587 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS18
00588 ******************************************************************DTSCS18
00589      SKIP1                                                        DTSCS18
00590  P3000-REQUEST-JUMP.                                              DTSCS18
00591 *-----------------------------------------------------            DTSCS18
00592 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS18
00593 *    BY USER                                                      DTSCS18
00594 *-----------------------------------------------------            DTSCS18
00595      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS18
00596      SKIP3                                                        DTSCS18
00597 *-----------------------------------------------------            DTSCS18
00598 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS18
00599 *-----------------------------------------------------            DTSCS18
00600      IF LCCM-MSG                                                  DTSCS18
00601         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS18
00602         SET CURSOR-SET-GOTO TO TRUE                               DTSCS18
00603         GO TO P3000-EXIT.                                         DTSCS18
00604      SKIP3                                                        DTSCS18
00605      IF LCCM-REQ-SCR-ID = '19'                                    DTSCS18
00606          MOVE MAP-LINE-NUMBER-AREA TO L013-S-CNT-AREA             DTSCS18
00607          PERFORM S013-LINE-NUMBER THRU S013-EXIT                  DTSCS18
00608          IF L013-NO-ENTRY                                         DTSCS18
00609              PERFORM P3200-SCREEN-EMP-NO THRU P3200-EXIT          DTSCS18
00610          ELSE                                                     DTSCS18
00611          IF L013-NOT-VALID                                        DTSCS18
00612              MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA           DTSCS18
00613          ELSE                                                     DTSCS18
00614              PERFORM P3100-LINE-NUMBER THRU P3100-EXIT            DTSCS18
00615      ELSE                                                         DTSCS18
00616          PERFORM P3200-SCREEN-EMP-NO THRU P3200-EXIT.             DTSCS18
00617                                                                   DTSCS18
00618      IF LCCM-MSG                                                  DTSCS18
00619          SET CURSOR-SET-LINE-NUMBER TO TRUE                       DTSCS18
00620          SET RESP-SEND-MSGONLY TO TRUE                            DTSCS18
00621          GO TO P3000-EXIT.                                        DTSCS18
00622      SKIP3                                                        DTSCS18
00623 *-----------------------------------------------------            DTSCS18
00624 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS18
00625 *-----------------------------------------------------            DTSCS18
00626      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS18
00627                         LCCM-SCR-HOLD-AREA.                       DTSCS18
00628      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS18
00629      SET RESP-JUMP TO TRUE.                                       DTSCS18
00630  P3000-EXIT.                                                      DTSCS18
00631      EXIT.                                                        DTSCS18
00632      SKIP3                                                        DTSCS18
00633  P3100-LINE-NUMBER.                                               DTSCS18
00634      MOVE LCCM-SCR18-HOLD-AREA TO SCR-HOLD-AREA.                  DTSCS18
00635      IF (SCR-HOLD-CURR-PAGE-NUM = +0)                             DTSCS18
00636            OR                                                     DTSCS18
00637         (L013-CNT < +1)                                           DTSCS18
00638            OR                                                     DTSCS18
00639         (L013-CNT > LCCM-SCR-HOLD-LINE-CNT)                       DTSCS18
00640          MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA               DTSCS18
00641      ELSE                                                         DTSCS18
00642          MOVE LOW-VALUES TO LS19-AREA                             DTSCS18
00643          MOVE SCR-HOLD-EMP-NO TO LS19-EMP-NO                      DTSCS18
00644          MOVE LCCM-SCR-HOLD-LINE-KEY-AREA (L013-CNT)              DTSCS18
00645            TO LS19-REC-KEY-AREA                                   DTSCS18
00646          MOVE LS19-AREA TO LCCM-SCR19-HOLD-AREA.                  DTSCS18
00647  P3100-EXIT.                                                      DTSCS18
00648      EXIT.                                                        DTSCS18
00649      SKIP3                                                        DTSCS18
00650  P3200-SCREEN-EMP-NO.                                             DTSCS18
00651      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS18
00652      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS18
00653      IF L018-VALID                                                DTSCS18
00654          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS18
00655  P3200-EXIT.                                                      DTSCS18
00656      EXIT.                                                        DTSCS18
00657 /*****************************************************************DTSCS18
00658 * CLEAR KEY WAS PRESSED                                          *DTSCS18
00659 ******************************************************************DTSCS18
00660      SKIP1                                                        DTSCS18
00661  P4000-REQUEST-CLEAR.                                             DTSCS18
00662      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS18
00663      SKIP1                                                        DTSCS18
00664      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS18
00665      SKIP3                                                        DTSCS18
00666 *-----------------------------------------------------            DTSCS18
00667 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS18
00668 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS18
00669 *-----------------------------------------------------            DTSCS18
00670      IF LCCM-EMP-NO > ZERO                                        DTSCS18
00671          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS18
00672          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS18
00673      SKIP1                                                        DTSCS18
00674      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS18
00675      SKIP1                                                        DTSCS18
00676      MOVE LOW-VALUES TO LCCM-SCR18-HOLD-AREA                      DTSCS18
00677                         LCCM-SCR-HOLD-AREA.                       DTSCS18
00678      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS18
00679      SKIP1                                                        DTSCS18
00680      SET RESP-SEND-MAP TO TRUE.                                   DTSCS18
00681  P4000-EXIT.                                                      DTSCS18
00682      EXIT.                                                        DTSCS18
00683 /*****************************************************************DTSCS18
00684 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS18
00685 ******************************************************************DTSCS18
00686      SKIP1                                                        DTSCS18
00687  P5000-CURSOR-TO-GOTO.                                            DTSCS18
00688      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS18
00689      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS18
00690  P5000-EXIT.                                                      DTSCS18
00691      EXIT.                                                        DTSCS18
00692 /*****************************************************************DTSCS18
00693 * INQUIRY WAS REQUESTED                                          *DTSCS18
00694 ******************************************************************DTSCS18
00695      SKIP1                                                        DTSCS18
00696  P6000-REQUEST-INQUIRE.                                           DTSCS18
00697 *--------------------------------------------------------------   DTSCS18
00698 *    THE RELATIONSHIPS ASSOCIATED WITH EMPLOYER 000 001           DTSCS18
00699 *    MIGHT BE REPRESENTED BY THE FOLLOWING MREL AND MPES          DTSCS18
00700 *    RECORDS.  EMPLOYER 000 001 IS THE "SUCCESSOR" IN THREE       DTSCS18
00701 *    RELATIONSHIPS (REPRESENTED BY THE THREE MREL RECORDS)        DTSCS18
00702 *    AND EMPLOYER 000 001 IS THE "PREDECESSOR" IN TWO             DTSCS18
00703 *    RELATIONSHIPS (REPRESENTED BY THE TWO IPES RECORDS)          DTSCS18
00704 *                                                                 DTSCS18
00705 *    THE "ITEM" COLUMN INDICATES THE "ITEM"                       DTSCS18
00706 *    NUMBER UNDER WHICH THE FOLLOWING CODE STORES                 DTSCS18
00707 *    THE MREL KEY AREA ASSOCIATED WITH THE MREL OR IPES           DTSCS18
00708 *    RECORD.  THE "LINE" COLUMN INDICATES THE "LINE" ON           DTSCS18
00709 *    WHICH THE RELATIONSHIP IS TO BE DISPLAYED.                   DTSCS18
00710 *                                                                 DTSCS18
00711 *    NOTICE THE "ITEMS" AND THE "LINES" RUN IN OPPOSITE           DTSCS18
00712 *    SEQUENCE.                                                    DTSCS18
00713 *                                                                 DTSCS18
00714 *                                                                 DTSCS18
00715 *                                           LINE      ITEM        DTSCS18
00716 *                                                                 DTSCS18
00717 *    MREL  000001  01/01/92  000011           3         3         DTSCS18
00718 *    MREL  000001  01/01/93  000012           2         4         DTSCS18
00719 *    MREL  000001  01/01/94  000013           1         5         DTSCS18
00720 *                                                                 DTSCS18
00721 *    IPES  000001  05/13/93  000021           5         1         DTSCS18
00722 *    IPES  000001  03/12/94  000019           4         2         DTSCS18
00723 *                                                                 DTSCS18
00724 *--------------------------------------------------------------   DTSCS18
00725      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS18
00726      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS18
00727      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS18
00728      SKIP1                                                        DTSCS18
00729      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS18
00730      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS18
00731      SKIP1                                                        DTSCS18
00732      SET RESP-SEND-MAP TO TRUE.                                   DTSCS18
00733      SKIP1                                                        DTSCS18
00734      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS18
00735      SKIP1                                                        DTSCS18
00736      MOVE LCCM-SCR18-HOLD-AREA TO SCR-HOLD-AREA.                  DTSCS18
00737      MOVE LOW-VALUES TO LCCM-SCR18-HOLD-AREA                      DTSCS18
00738                         LCCM-SCR-HOLD-AREA.                       DTSCS18
00739      SKIP1                                                        DTSCS18
00740      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS18
00741      IF LCCM-MSG                                                  DTSCS18
00742          GO TO P6000-EXIT.                                        DTSCS18
00743      SKIP1                                                        DTSCS18
00744      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS18
00745      IF LCCM-MSG                                                  DTSCS18
00746          GO TO P6000-EXIT.                                        DTSCS18
00747      SKIP1                                                        DTSCS18
00748      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS18
00749      SKIP1                                                        DTSCS18
00750      MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.                  DTSCS18
00751      SKIP1                                                        DTSCS18
00752      MOVE +0 TO ITEM-CNT.                                         DTSCS18
00753      SKIP1                                                        DTSCS18
00754      PERFORM P6100-STORE-ITEMS THRU P6100-EXIT.                   DTSCS18
00755      SKIP1                                                        DTSCS18
00756      PERFORM P6200-LOCATE-PAGE THRU P6200-EXIT.                   DTSCS18
00757      IF LCCM-MSG                                                  DTSCS18
00758          IF ITEM-CNT > TBL-ITEM-MAX                               DTSCS18
00759              PERFORM S829-DELETE-QUEUE THRU S829-EXIT             DTSCS18
00760              GO TO P6000-EXIT                                     DTSCS18
00761          ELSE                                                     DTSCS18
00762              GO TO P6000-EXIT.                                    DTSCS18
00763      SKIP1                                                        DTSCS18
00764      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS18
00765      SKIP1                                                        DTSCS18
00766      IF ITEM-CNT > TBL-ITEM-MAX                                   DTSCS18
00767          PERFORM S829-DELETE-QUEUE THRU S829-EXIT.                DTSCS18
00768      SKIP1                                                        DTSCS18
00769      MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO.                          DTSCS18
00770      MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM.                DTSCS18
00771      MOVE SCR-HOLD-AREA TO LCCM-SCR18-HOLD-AREA.                  DTSCS18
00772      SKIP1                                                        DTSCS18
00773      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS18
00774      SKIP1                                                        DTSCS18
00775      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A.         DTSCS18
00776      MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L.                       DTSCS18
00777      SET CURSOR-SET-YES TO TRUE.                                  DTSCS18
00778  P6000-EXIT.                                                      DTSCS18
00779      EXIT.                                                        DTSCS18
00780      EJECT                                                        DTSCS18
00781  P6100-STORE-ITEMS.                                               DTSCS18
00782      MOVE LOW-VALUES TO IPES-KEY-AREA.                            DTSCS18
00783      SET IPES-PES-88 TO TRUE.                                     DTSCS18
00784      MOVE WRK-EMP-NO TO IPES-PRED-EMP-NO.                         DTSCS18
00785      MOVE IPES-KEY-AREA TO ISKL-KEY-AREA.                         DTSCS18
00786      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS18
00787      PERFORM P6110-BROWSE-IPES THRU P6110-EXIT                    DTSCS18
00788          UNTIL L821-NO-REC-88.                                    DTSCS18
00789      SKIP1                                                        DTSCS18
00790      MOVE LOW-VALUES TO MREL-KEY-AREA.                            DTSCS18
00791      MOVE WRK-EMP-NO TO MREL-EMP-NO.                              DTSCS18
00792      SET MREL-REL-88 TO TRUE.                                     DTSCS18
00793      MOVE MREL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS18
00794      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS18
00795      PERFORM P6120-BROWSE-MREL THRU P6120-EXIT                    DTSCS18
00796          UNTIL L810-NO-REC-88.                                    DTSCS18
00797  P6100-EXIT.                                                      DTSCS18
00798      EXIT.                                                        DTSCS18
00799      SKIP3                                                        DTSCS18
00800  P6110-BROWSE-IPES.                                               DTSCS18
00801      MOVE ISKL-REC TO IPES-REC.                                   DTSCS18
00802      IF IPES-PRED-EMP-NO = WRK-EMP-NO                             DTSCS18
00803          NEXT SENTENCE                                            DTSCS18
00804      ELSE                                                         DTSCS18
00805          PERFORM S821-END-BROWSE THRU S821-EXIT                   DTSCS18
00806          SET L821-NO-REC-88 TO TRUE                               DTSCS18
00807          GO TO P6110-EXIT.                                        DTSCS18
00808      SKIP1                                                        DTSCS18
00809      MOVE LOW-VALUES TO MREL-KEY-AREA.                            DTSCS18
00810      MOVE IPES-SUC-EMP-NO TO MREL-EMP-NO.                         DTSCS18
00811      SET MREL-REL-88 TO TRUE.                                     DTSCS18
00812      MOVE IPES-EFF-DATE TO MREL-EFF-DATE                          DTSCS18
00813      MOVE IPES-PRED-EMP-NO TO MREL-PRED-EMP-NO.                   DTSCS18
00814      SKIP1                                                        DTSCS18
00815      PERFORM P6190-STORE-ITEM THRU P6190-EXIT.                    DTSCS18
00816      SKIP1                                                        DTSCS18
00817      PERFORM S821-READ-NEXT THRU S821-EXIT.                       DTSCS18
00818  P6110-EXIT.                                                      DTSCS18
00819      EXIT.                                                        DTSCS18
00820      SKIP3                                                        DTSCS18
00821  P6120-BROWSE-MREL.                                               DTSCS18
00822      MOVE MSKL-REC TO MREL-REC.                                   DTSCS18
00823      SKIP1                                                        DTSCS18
00824      PERFORM P6190-STORE-ITEM THRU P6190-EXIT.                    DTSCS18
00825      SKIP1                                                        DTSCS18
00826      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS18
00827  P6120-EXIT.                                                      DTSCS18
00828      EXIT.                                                        DTSCS18
00829      SKIP3                                                        DTSCS18
00830  P6190-STORE-ITEM.                                                DTSCS18
00831      IF ITEM-CNT < TBL-ITEM-MAX                                   DTSCS18
00832          ADD +1 TO ITEM-CNT                                       DTSCS18
00833          MOVE MREL-KEY-AREA TO TBL-ITEM (ITEM-CNT)                DTSCS18
00834          GO TO P6190-EXIT.                                        DTSCS18
00835      SKIP1                                                        DTSCS18
00836      IF ITEM-CNT = TBL-ITEM-MAX                                   DTSCS18
00837          PERFORM S829-DELETE-QUEUE THRU S829-EXIT.                DTSCS18
00838      SKIP1                                                        DTSCS18
00839      IF ITEM-CNT < ITEM-MAX                                       DTSCS18
00840          ADD +1 TO ITEM-CNT                                       DTSCS18
00841          MOVE MREL-KEY-AREA TO L829-REC                           DTSCS18
00842          PERFORM S829-WRITE THRU S829-EXIT.                       DTSCS18
00843  P6190-EXIT.                                                      DTSCS18
00844      EXIT.                                                        DTSCS18
00845      EJECT                                                        DTSCS18
00846  P6200-LOCATE-PAGE.                                               DTSCS18
00847      IF ITEM-CNT = +0                                             DTSCS18
00848          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS18
00849          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS18
00850          MOVE +0 TO LAST-PAGE-NUM                                 DTSCS18
00851                     CURR-PAGE-NUM                                 DTSCS18
00852          GO TO P6200-EXIT.                                        DTSCS18
00853                                                                   DTSCS18
00854      COMPUTE LAST-PAGE-NUM                                        DTSCS18
00855        = ((ITEM-CNT - 1) / LINES-PER-PAGE) + 1.                   DTSCS18
00856                                                                   DTSCS18
00857      IF SCR-HOLD-AREA = LOW-VALUES                                DTSCS18
00858          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS18
00859          GO TO P6200-EXIT.                                        DTSCS18
00860                                                                   DTSCS18
00861      IF SCR-HOLD-EMP-NO = WRK-EMP-NO                              DTSCS18
00862          NEXT SENTENCE                                            DTSCS18
00863      ELSE                                                         DTSCS18
00864          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS18
00865          GO TO P6200-EXIT.                                        DTSCS18
00866                                                                   DTSCS18
00867      IF LCCM-ENTER-88                                             DTSCS18
00868          MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM             DTSCS18
00869      ELSE                                                         DTSCS18
00870      IF LCCM-F05-88                                               DTSCS18
00871          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS18
00872      ELSE                                                         DTSCS18
00873      IF LCCM-F06-88                                               DTSCS18
00874          MOVE LAST-PAGE-NUM TO CURR-PAGE-NUM                      DTSCS18
00875      ELSE                                                         DTSCS18
00876      IF LCCM-F07-88                                               DTSCS18
00877          COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1       DTSCS18
00878      ELSE                                                         DTSCS18
00879      IF LCCM-F08-88                                               DTSCS18
00880          COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1       DTSCS18
00881      ELSE                                                         DTSCS18
00882          GO TO S899-ABEND.                                        DTSCS18
00883                                                                   DTSCS18
00884      IF CURR-PAGE-NUM < +1                                        DTSCS18
00885          MOVE +1 TO CURR-PAGE-NUM                                 DTSCS18
00886      ELSE                                                         DTSCS18
00887      IF CURR-PAGE-NUM > LAST-PAGE-NUM                             DTSCS18
00888          MOVE LAST-PAGE-NUM TO CURR-PAGE-NUM.                     DTSCS18
00889  P6200-EXIT.                                                      DTSCS18
00890      EXIT.                                                        DTSCS18
00891 /*****************************************************************DTSCS18
00892 *                                                                *DTSCS18
00893 ******************************************************************DTSCS18
00894      SKIP1                                                        DTSCS18
00895  P6900-CONSTRUCT-SCREEN.                                          DTSCS18
00896      MOVE +0 TO LINE-OCC                                          DTSCS18
00897                 LCCM-SCR-HOLD-LINE-CNT.                           DTSCS18
00898                                                                   DTSCS18
00899      COMPUTE ITEM-SUB                                             DTSCS18
00900        = ITEM-CNT - ((CURR-PAGE-NUM - 1) * LINES-PER-PAGE).       DTSCS18
00901                                                                   DTSCS18
00902      PERFORM P6910-BUILD-LINE THRU P6910-EXIT                     DTSCS18
00903          UNTIL (LINE-OCC NOT < LINES-PER-PAGE)                    DTSCS18
00904                     OR                                            DTSCS18
00905                (ITEM-SUB < +1).                                   DTSCS18
00906                                                                   DTSCS18
00907      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS18
00908  P6900-EXIT.                                                      DTSCS18
00909      EXIT.                                                        DTSCS18
00910      SKIP3                                                        DTSCS18
00911  P6910-BUILD-LINE.                                                DTSCS18
00912      IF ITEM-SUB > TBL-ITEM-MAX                                   DTSCS18
00913          COMPUTE L829-ITEM-NO = ITEM-SUB - TBL-ITEM-MAX           DTSCS18
00914          PERFORM S829-READ-ITEM THRU S829-EXIT                    DTSCS18
00915          IF L829-NO-REC-88                                        DTSCS18
00916              GO TO S899-ABEND                                     DTSCS18
00917          ELSE                                                     DTSCS18
00918              MOVE L829-REC TO MREL-KEY-AREA                       DTSCS18
00919      ELSE                                                         DTSCS18
00920          MOVE TBL-ITEM (ITEM-SUB) TO MREL-KEY-AREA.               DTSCS18
00921                                                                   DTSCS18
00922      SUBTRACT 1 FROM ITEM-SUB.                                    DTSCS18
00923                                                                   DTSCS18
00924      MOVE MREL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS18
00925      PERFORM S810-READ THRU S810-EXIT.                            DTSCS18
00926      IF L810-NO-REC-88                                            DTSCS18
00927          GO TO P6910-EXIT.                                        DTSCS18
00928                                                                   DTSCS18
00929      MOVE MSKL-REC TO MREL-REC.                                   DTSCS18
00930                                                                   DTSCS18
00931      ADD +1 TO LINE-OCC                                           DTSCS18
00932                LCCM-SCR-HOLD-LINE-CNT.                            DTSCS18
00933                                                                   DTSCS18
00934      MOVE MREL-KEY-AREA                                           DTSCS18
00935        TO LCCM-SCR-HOLD-LINE-KEY-AREA (LCCM-SCR-HOLD-LINE-CNT).   DTSCS18
00936                                                                   DTSCS18
00937      MOVE LINE-OCC TO MAP-LINE-NO (LINE-OCC).                     DTSCS18
00938                                                                   DTSCS18
00939      IF MREL-EMP-NO = WRK-EMP-NO                                  DTSCS18
00940          MOVE MREL-PRED-EMP-NO TO WRK-DISPLAY                     DTSCS18
00941          MOVE WRK-DISPLAY-EMP-NO-1                                DTSCS18
00942            TO MAP-PRED-EMP-NO-1 (LINE-OCC)                        DTSCS18
00943          MOVE WRK-DISPLAY-EMP-NO-2                                DTSCS18
00944            TO MAP-PRED-EMP-NO-2 (LINE-OCC)                        DTSCS18
00945      ELSE                                                         DTSCS18
00946          MOVE MREL-EMP-NO TO WRK-DISPLAY                          DTSCS18
00947          MOVE WRK-DISPLAY-EMP-NO-1                                DTSCS18
00948            TO MAP-SUC-EMP-NO-1 (LINE-OCC)                         DTSCS18
00949          MOVE WRK-DISPLAY-EMP-NO-2                                DTSCS18
00950            TO MAP-SUC-EMP-NO-2 (LINE-OCC).                        DTSCS18
00951                                                                   DTSCS18
00952      MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9.                     DTSCS18
00953      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS18
00954      MOVE L001-SLASH-DATE TO MAP-EFF-DATE (LINE-OCC).             DTSCS18
00955                                                                   DTSCS18
00956      MOVE MREL-RELATIONSHIP-CD                                    DTSCS18
00957        TO MAP-RELATIONSHIP-CD (LINE-OCC).                         DTSCS18
00958                                                                   DTSCS18
00959 **   MOVE MREL-EXP-TRNSF-CD                                       DTSCS18
00960 **     TO MAP-EXP-TRNSF-CD (LINE-OCC).                            DTSCS18
00961                                                                   DTSCS18
00962      IF MREL-PORTION-EXP-TRNSF = +0                               DTSCS18
00963          NEXT SENTENCE                                            DTSCS18
00964      ELSE                                                         DTSCS18
00965          COMPUTE MAP-PORTION-EXP-TRNSF (LINE-OCC)                 DTSCS18
00966            = MREL-PORTION-EXP-TRNSF * 100.                        DTSCS18
00967                                                                   DTSCS18
00968      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS18
00969      IF MREL-EMP-NO = WRK-EMP-NO                                  DTSCS18
00970          MOVE MREL-PRED-EMP-NO TO MPRF-EMP-NO                     DTSCS18
00971      ELSE                                                         DTSCS18
00972          MOVE MREL-EMP-NO TO MPRF-EMP-NO.                         DTSCS18
00973      SET MPRF-PRF-88 TO TRUE.                                     DTSCS18
00974      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS18
00975      PERFORM S810-READ THRU S810-EXIT.                            DTSCS18
00976      IF L810-NO-REC-88                                            DTSCS18
00977          MOVE 'EMPLOYER IS ARCHIVED'                              DTSCS18
00978            TO MAP-LINE-PRIMARY-NAME (LINE-OCC)                    DTSCS18
00979      ELSE                                                         DTSCS18
00980          MOVE MSKL-REC TO MPRF-REC                                DTSCS18
00981          MOVE MPRF-PRIMARY-NAME                                   DTSCS18
00982            TO MAP-LINE-PRIMARY-NAME (LINE-OCC).                   DTSCS18
00983  P6910-EXIT.                                                      DTSCS18
00984      EXIT.                                                        DTSCS18
00985      EJECT                                                        DTSCS18
00986  P6990-PAGE-NUMBER.                                               DTSCS18
00987      MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE.                         DTSCS18
00988      MOVE LAST-PAGE-NUM TO MAP-LAST-PAGE.                         DTSCS18
00989                                                                   DTSCS18
00990      IF CURR-PAGE-NUM = +1                                        DTSCS18
00991          IF LAST-PAGE-NUM = +1                                    DTSCS18
00992              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS18
00993          ELSE                                                     DTSCS18
00994              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS18
00995      ELSE                                                         DTSCS18
00996          IF CURR-PAGE-NUM = LAST-PAGE-NUM                         DTSCS18
00997              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS18
00998  P6990-EXIT.                                                      DTSCS18
00999      EXIT.                                                        DTSCS18
01000 /*****************************************************************DTSCS18
01001 * LINKS TO UTILITY MODULES                                        DTSCS18
01002 ******************************************************************DTSCS18
01003      SKIP1                                                        DTSCS18
01004  S001-FROM-FED-8.                                                 DTSCS18
01005      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS18
01006      GO TO S001-DATE.                                             DTSCS18
01007      SKIP1                                                        DTSCS18
01008  S001-FROM-ABS-DATE.                                              DTSCS18
01009      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS18
01010      GO TO S001-DATE.                                             DTSCS18
01011      SKIP1                                                        DTSCS18
01012  S001-DATE.                                                       DTSCS18
01013      EXEC CICS LINK                                               DTSCS18
01014          PROGRAM('DTSCU001')                                      DTSCS18
01015          COMMAREA(L001-COMM-AREA)                                 DTSCS18
01016      END-EXEC.                                                    DTSCS18
01017  S001-EXIT.                                                       DTSCS18
01018      EXIT.                                                        DTSCS18
01019      SKIP3                                                        DTSCS18
01020  S013-LINE-NUMBER.                                                DTSCS18
01021      MOVE +1 TO L013-MIN-CNT.                                     DTSCS18
01022      MOVE LINES-PER-PAGE TO L013-MAX-CNT.                         DTSCS18
01023      GO TO S013-COUNT-FROM-SCREEN.                                DTSCS18
01024      SKIP1                                                        DTSCS18
01025  S013-COUNT-FROM-SCREEN.                                          DTSCS18
01026      EXEC CICS LINK                                               DTSCS18
01027          PROGRAM('DTSCU013')                                      DTSCS18
01028          COMMAREA(L013-COMM-AREA)                                 DTSCS18
01029      END-EXEC.                                                    DTSCS18
01030  S013-EXIT.                                                       DTSCS18
01031      EXIT.                                                        DTSCS18
01032      SKIP3                                                        DTSCS18
01033  S018-EMP-NO-FROM-SCREEN.                                         DTSCS18
01034      EXEC CICS LINK                                               DTSCS18
01035          PROGRAM('DTSCU018')                                      DTSCS18
01036          COMMAREA(L018-COMM-AREA)                                 DTSCS18
01037      END-EXEC.                                                    DTSCS18
01038  S018-EXIT.                                                       DTSCS18
01039      EXIT.                                                        DTSCS18
01040      SKIP3                                                        DTSCS18
01041  S803-REQ-SCR-ID-EDIT.                                            DTSCS18
01042      EXEC CICS LINK                                               DTSCS18
01043          PROGRAM ('DTSCU803')                                     DTSCS18
01044          COMMAREA (DFHCOMMAREA)                                   DTSCS18
01045      END-EXEC.                                                    DTSCS18
01046  S803-EXIT.                                                       DTSCS18
01047      EXIT.                                                        DTSCS18
01048      SKIP3                                                        DTSCS18
01049  S804-INVALID-KEY.                                                DTSCS18
01050      EXEC CICS LINK                                               DTSCS18
01051          PROGRAM ('DTSCU804')                                     DTSCS18
01052          COMMAREA (DFHCOMMAREA)                                   DTSCS18
01053      END-EXEC.                                                    DTSCS18
01054  S804-EXIT.                                                       DTSCS18
01055      EXIT.                                                        DTSCS18
01056      SKIP3                                                        DTSCS18
01057  S805-MSG-AREA.                                                   DTSCS18
01058      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS18
01059      SKIP1                                                        DTSCS18
01060      EXEC CICS LINK                                               DTSCS18
01061          PROGRAM ('DTSCU805')                                     DTSCS18
01062          COMMAREA (L805-COMM-AREA)                                DTSCS18
01063      END-EXEC.                                                    DTSCS18
01064      SKIP1                                                        DTSCS18
01065      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS18
01066  S805-EXIT.                                                       DTSCS18
01067      EXIT.                                                        DTSCS18
01068      EJECT                                                        DTSCS18
01069  S810-READ.                                                       DTSCS18
01070      SET L810-READ-88 TO TRUE.                                    DTSCS18
01071      GO TO S810-IO.                                               DTSCS18
01072      SKIP1                                                        DTSCS18
01073  S810-START-BROWSE.                                               DTSCS18
01074      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS18
01075      GO TO S810-IO.                                               DTSCS18
01076      SKIP1                                                        DTSCS18
01077  S810-READ-NEXT.                                                  DTSCS18
01078      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS18
01079      GO TO S810-IO.                                               DTSCS18
01080      SKIP1                                                        DTSCS18
01081 *S810-READ-PREV.                                                  DTSCS18
01082 *****SET L810-READ-PREV-88 TO TRUE.                               DTSCS18
01083 *****GO TO S810-IO.                                               DTSCS18
01084 *****SKIP1                                                        DTSCS18
01085 *S810-END-BROWSE.                                                 DTSCS18
01086 *****SET L810-END-BROWSE-88 TO TRUE.                              DTSCS18
01087 *****GO TO S810-IO.                                               DTSCS18
01088 *****SKIP1                                                        DTSCS18
01089 *S810-COUNT.                                                      DTSCS18
01090 *****SET L810-COUNT-88 TO TRUE.                                   DTSCS18
01091 *****GO TO S810-IO.                                               DTSCS18
01092 *****SKIP1                                                        DTSCS18
01093 *S810-REWRITE.                                                    DTSCS18
01094 *****SET L810-REWRITE-88 TO TRUE.                                 DTSCS18
01095 *****GO TO S810-IO.                                               DTSCS18
01096 *****SKIP1                                                        DTSCS18
01097 *S810-WRITE.                                                      DTSCS18
01098 *****SET L810-WRITE-88 TO TRUE.                                   DTSCS18
01099 *****GO TO S810-IO.                                               DTSCS18
01100 *****SKIP1                                                        DTSCS18
01101 *S810-DELETE.                                                     DTSCS18
01102 *****SET L810-DELETE-88 TO TRUE.                                  DTSCS18
01103 *****GO TO S810-IO.                                               DTSCS18
01104      SKIP1                                                        DTSCS18
01105  S810-IO.                                                         DTSCS18
01106      SKIP1                                                        DTSCS18
01107      EXEC CICS LINK                                               DTSCS18
01108          PROGRAM ('DTSCU810')                                     DTSCS18
01109          COMMAREA (L810-COMM-AREA)                                DTSCS18
01110      END-EXEC.                                                    DTSCS18
01111      SKIP1                                                        DTSCS18
01112      IF L810-FILE-CLOSED-88                                       DTSCS18
01113          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS18
01114          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS18
01115          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS18
01116          GO TO MAINLINE-EXIT.                                     DTSCS18
01117  S810-EXIT.                                                       DTSCS18
01118      EXIT.                                                        DTSCS18
01119      EJECT                                                        DTSCS18
01120 *S821-READ.                                                       DTSCS18
01121 *****SET L821-READ-88 TO TRUE.                                    DTSCS18
01122 *****GO TO S821-I.                                                DTSCS18
01123      SKIP1                                                        DTSCS18
01124  S821-START-BROWSE.                                               DTSCS18
01125      SET L821-START-BROWSE-88 TO TRUE.                            DTSCS18
01126      GO TO S821-I.                                                DTSCS18
01127      SKIP1                                                        DTSCS18
01128  S821-READ-NEXT.                                                  DTSCS18
01129      SET L821-READ-NEXT-88 TO TRUE.                               DTSCS18
01130      GO TO S821-I.                                                DTSCS18
01131      SKIP1                                                        DTSCS18
01132 *S821-READ-PREV.                                                  DTSCS18
01133 *****SET L821-READ-PREV-88 TO TRUE.                               DTSCS18
01134 *****GO TO S821-I.                                                DTSCS18
01135      SKIP1                                                        DTSCS18
01136  S821-END-BROWSE.                                                 DTSCS18
01137      SET L821-END-BROWSE-88 TO TRUE.                              DTSCS18
01138      GO TO S821-I.                                                DTSCS18
01139      SKIP1                                                        DTSCS18
01140  S821-I.                                                          DTSCS18
01141      SKIP1                                                        DTSCS18
01142      EXEC CICS LINK                                               DTSCS18
01143          PROGRAM ('DTSCU821')                                     DTSCS18
01144          COMMAREA (L821-COMM-AREA)                                DTSCS18
01145      END-EXEC.                                                    DTSCS18
01146      SKIP1                                                        DTSCS18
01147      IF L821-FILE-CLOSED-88                                       DTSCS18
01148          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS18
01149          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS18
01150          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS18
01151          GO TO MAINLINE-EXIT.                                     DTSCS18
01152  S821-EXIT.                                                       DTSCS18
01153      EXIT.                                                        DTSCS18
01154      EJECT                                                        DTSCS18
01155  S829-READ-ITEM.                                                  DTSCS18
01156      SET L829-READ-ITEM-88 TO TRUE.                               DTSCS18
01157      GO TO S829-IO.                                               DTSCS18
01158      SKIP1                                                        DTSCS18
01159  S829-WRITE.                                                      DTSCS18
01160      SET L829-WRITE-88 TO TRUE.                                   DTSCS18
01161      GO TO S829-IO.                                               DTSCS18
01162      SKIP1                                                        DTSCS18
01163  S829-DELETE-QUEUE.                                               DTSCS18
01164      SET L829-DELETE-QUEUE-88 TO TRUE.                            DTSCS18
01165      GO TO S829-IO.                                               DTSCS18
01166      SKIP1                                                        DTSCS18
01167  S829-IO.                                                         DTSCS18
01168 *    COMPUTE L829-COMM-AREA-LENGTH                                DTSCS18
01169 *      = L829-CONTROL-BLOCK-LENGTH + ITEM-LENGTH.                 DTSCS18
01170      MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX.          DTSCS18
01171      MOVE 'S' TO L829-QUEUE-NAME-SUFFIX.                          DTSCS18
01172      MOVE ITEM-LENGTH TO L829-REC-LENGTH.                         DTSCS18
01173      SET L829-DEFAULT-STORAGE-88 TO TRUE.                         DTSCS18
01174      SKIP1                                                        DTSCS18
01175      EXEC CICS                                                    DTSCS18
01176          LINK                                                     DTSCS18
01177              PROGRAM ('DTSCU829')                                 DTSCS18
01178              COMMAREA (L829-COMM-AREA)                            DTSCS18
01179      END-EXEC.                                                    DTSCS18
01180  S829-EXIT.                                                       DTSCS18
01181      EXIT.                                                        DTSCS18
01182      EJECT                                                        DTSCS18
01183  S851-SCREEN-PROCESSING.                                          DTSCS18
01184      EXEC CICS LINK                                               DTSCS18
01185          PROGRAM ('DTSCU851')                                     DTSCS18
01186          COMMAREA (L851-COMM-AREA)                                DTSCS18
01187      END-EXEC.                                                    DTSCS18
01188  S851-EXIT.                                                       DTSCS18
01189      EXIT.                                                        DTSCS18
01190      SKIP3                                                        DTSCS18
01191  S899-ABEND.                                                      DTSCS18
01192      EXEC CICS ABEND                                              DTSCS18
01193          ABCODE(WRK-ABEND-CD)                                     DTSCS18
01194      END-EXEC.                                                    DTSCS18
01195  S899-EXIT.                                                       DTSCS18
01196      EXIT.                                                        DTSCS18
01197      EJECT                                                        DTSCS18
01198  S1100-EDIT-KEY.                                                  DTSCS18
01199      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS18
01200  S1100-EXIT. EXIT.                                                DTSCS18
01201 /*****************************************************************DTSCS18
01202 *                                                                 DTSCS18
01203 ******************************************************************DTSCS18
01204  S1101-EMP-NO.                                                    DTSCS18
01205      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS18
01206      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS18
01207      SKIP1                                                        DTSCS18
01208      IF L018-NO-ENTRY                                             DTSCS18
01209         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS18
01210         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS18
01211         GO TO S1101-EXIT.                                         DTSCS18
01212      SKIP1                                                        DTSCS18
01213      IF L018-NOT-VALID                                            DTSCS18
01214         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS18
01215         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS18
01216         GO TO S1101-EXIT.                                         DTSCS18
01217      SKIP1                                                        DTSCS18
01218      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS18
01219  S1101-EXIT. EXIT.                                                DTSCS18
01220      SKIP3                                                        DTSCS18
01221  S1110-READ-MPRF.                                                 DTSCS18
01222      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS18
01223      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS18
01224      SET MPRF-PRF-88 TO TRUE.                                     DTSCS18
01225      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS18
01226      PERFORM S810-READ THRU S810-EXIT.                            DTSCS18
01227      IF L810-NO-REC-88                                            DTSCS18
01228          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS18
01229          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS18
01230      ELSE                                                         DTSCS18
01231          MOVE MSKL-REC TO MPRF-REC.                               DTSCS18
01232  S1110-EXIT.                                                      DTSCS18
01233      EXIT.                                                        DTSCS18
01234      SKIP3                                                        DTSCS18
01235  S1199-ERROR.                                                     DTSCS18
01236      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS18
01237                                         MAP-EMP-NO-2-A.           DTSCS18
01238      IF LCCM-NO-MSG                                               DTSCS18
01239         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS18
01240         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS18
01241         SET CURSOR-SET-YES TO TRUE.                               DTSCS18
01242  S1199-EXIT. EXIT.                                                DTSCS18
01243      SKIP3                                                        DTSCS18
01244 *S1299-ERROR.                                                     DTSCS18
01245 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LINE-NUMBER-A.        DTSCS18
01246 *****IF LCCM-NO-MSG                                               DTSCS18
01247 *****   MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS18
01248 *****   MOVE CATB-CURSOR             TO MAP-LINE-NUMBER-L         DTSCS18
01249 *****   SET CURSOR-SET-YES TO TRUE.                               DTSCS18
01250 *S1299-EXIT. EXIT.                                                DTSCS18
01251 /*****************************************************************DTSCS18
01252 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS18
01253 ******************************************************************DTSCS18
01254  S5300-SET-INQ-ATTRB.                                             DTSCS18
01255      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS18
01256                                    WRK-ATB-NUM.                   DTSCS18
01257      SKIP1                                                        DTSCS18
01258      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS18
01259  S5300-EXIT.                                                      DTSCS18
01260      EXIT.                                                        DTSCS18
01261      SKIP3                                                        DTSCS18
01262  S5900-SET-ATTRB.                                                 DTSCS18
01263      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS18
01264                                        MAP-EMP-NO-2-A.            DTSCS18
01265      SKIP1                                                        DTSCS18
01266      MOVE CATB-ASKIP-BRT-MDTOFF    TO MAP-PRIMARY-NAME-A.         DTSCS18
01267      SKIP1                                                        DTSCS18
01268      MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-CURR-PAGE-A                DTSCS18
01269                                    MAP-LAST-PAGE-A.               DTSCS18
01270                                                                   DTSCS18
01271      PERFORM                                                      DTSCS18
01272         VARYING LINE-OCC FROM 1 BY 1                              DTSCS18
01273         UNTIL LINE-OCC > LINES-PER-PAGE                           DTSCS18
01274           MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-LINE-A (LINE-OCC)     DTSCS18
01275      END-PERFORM.                                                 DTSCS18
01276                                                                   DTSCS18
01277      MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-LINE-NUMBER-A.            DTSCS18
01278      SKIP1                                                        DTSCS18
01279      MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A.                DTSCS18
01280  S5900-EXIT.                                                      DTSCS18
01281      EXIT.                                                        DTSCS18
01282 /*****************************************************************DTSCS18
01283 * MAP ROUTINES                                                   *DTSCS18
01284 ******************************************************************DTSCS18
01285  S9100-RECEIVE.                                                   DTSCS18
01286      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS18
01287      SKIP1                                                        DTSCS18
01288      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS18
01289      SKIP1                                                        DTSCS18
01290      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS18
01291      SKIP1                                                        DTSCS18
01292      MOVE L851-AID TO LCCM-AID.                                   DTSCS18
01293      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS18
01294  S9100-EXIT.                                                      DTSCS18
01295      EXIT.                                                        DTSCS18
01296      SKIP3                                                        DTSCS18
01297  S9200-SEND-DATAONLY.                                             DTSCS18
01298      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS18
01299      SKIP1                                                        DTSCS18
01300      IF LCCM-NO-MSG                                               DTSCS18
01301          NEXT SENTENCE                                            DTSCS18
01302      ELSE                                                         DTSCS18
01303          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS18
01304      SKIP1                                                        DTSCS18
01305      IF CURSOR-SET-GOTO                                           DTSCS18
01306          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS18
01307      ELSE                                                         DTSCS18
01308      IF CURSOR-SET-LINE-NUMBER                                    DTSCS18
01309          MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L                    DTSCS18
01310      ELSE                                                         DTSCS18
01311          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS18
01312      SKIP1                                                        DTSCS18
01313      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS18
01314      SKIP1                                                        DTSCS18
01315      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS18
01316      SKIP1                                                        DTSCS18
01317      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS18
01318  S9200-EXIT.                                                      DTSCS18
01319      EXIT.                                                        DTSCS18
01320      SKIP3                                                        DTSCS18
01321  S9300-SEND-MAP.                                                  DTSCS18
01322      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS18
01323      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS18
01324      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS18
01325      SKIP1                                                        DTSCS18
01326      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS18
01327      SKIP1                                                        DTSCS18
01328      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS18
01329      SKIP1                                                        DTSCS18
01330      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS18
01331      SKIP1                                                        DTSCS18
01332      IF CURSOR-SET-NO                                             DTSCS18
01333          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS18
01334      SKIP1                                                        DTSCS18
01335      SET L851-SEND-88 TO TRUE.                                    DTSCS18
01336      SKIP1                                                        DTSCS18
01337      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS18
01338      SKIP1                                                        DTSCS18
01339      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS18
01340  S9300-EXIT.                                                      DTSCS18
01341      EXIT.                                                        DTSCS18
01342      SKIP3                                                        DTSCS18
01343  S9320-INQUIRY-FKEYS.                                             DTSCS18
01344      MOVE CFKD-FIRST TO MAP-KEY-FIRST.                            DTSCS18
01345      MOVE CFKD-LAST TO MAP-KEY-LAST.                              DTSCS18
01346      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS18
01347      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS18
01348      SKIP1                                                        DTSCS18
01349 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS18
01350  S9320-EXIT.                                                      DTSCS18
01351      EXIT.                                                        DTSCS18
01352      SKIP3                                                        DTSCS18
01353 *S9321-JUMP-KEYS.                                                 DTSCS18
01354 *    MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ.                        DTSCS18
01355 *    MOVE 'F21=REL' TO MAP-KEY-REL-UPDATE.                        DTSCS18
01356 *S9321-EXIT.                                                      DTSCS18
01357 *    EXIT.                                                        DTSCS18
01358      SKIP3                                                        DTSCS18
01359  S9330-DSCR-FIELDS.                                               DTSCS18
01360  S9330-EXIT.                                                      DTSCS18
01361      EXIT.                                                        DTSCS18
01362      SKIP3                                                        DTSCS18
01363  S9900-PREPARE-SEND.                                              DTSCS18
01364      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS18
01365                         LCCM-SCR-ID.                              DTSCS18
01366      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS18
01367      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS18
01368  S9900-EXIT.                                                      DTSCS18
01369      EXIT.                                                        DTSCS18
