00001  IDENTIFICATION DIVISION.                                         07/02/03
00002  PROGRAM-ID.             DTSCS75.                                 DTSCS75
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV009
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS75
00005  DATE-COMPILED.                                                   DTSCS75
00006      SKIP3                                                        DTSCS75
00007 *****                                                             DTSCS75
00008 *                                                                 DTSCS75
00009 *    FUNCTION:  TICKLER BY DESTINATION SEARCH                     DTSCS75
00010 *               SCREEN PROCESSOR.                                 DTSCS75
00011 *                                                                 DTSCS75
00012 *                                                                 DTSCS75
00013 *    MODIFICATION LOG:                                            DTSCS75
00014 *                                                                 DTSCS75
00015 *    09/28/98  INITIAL DEVELOPMENT.     COPIED FROM MACCS75.      DTSCS75
00016 *              WORK ORDER:                      PROGRAMMER: ZL1.  DTSCS75
00017 *                                                                 DTSCS75
00018 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS75
00019 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS75
00020 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCS75
00021 *                                                                 DTSCS75
00022 *                                                                 DTSCS75
00023 *  DESCRIPTION:                                                   DTSCS75
00024 *                                                                 DTSCS75
00025 *                                                                 DTSCS75
00026 *    CLEAR:                                                       DTSCS75
00027 *                                                                 DTSCS75
00028 *      FIELD DISPLAYED :NONE.  UPROTECT MAP-SRCH-DEST,            DTSCS75
00029 *       MAP-SRCH-ACK-IND, MAP-SRCH-TRIG-START-DATE, AND           DTSCS75
00030 *       MAP-SRCH-TRIG-END-DATE.                                   DTSCS75
00031 *                                                                 DTSCS75
00032 *                                                                 DTSCS75
00033 *    INQUIRY:                                                     DTSCS75
00034 *                                                                 DTSCS75
00035 *      CONTROL FIELD(S): MAP-SRCH-DEST, MAP-SRCH-ACK-IND,         DTSCS75
00036 *                        MAP-SRCH-TRIG-START-DATE, AND            DTSCS75
00037 *                        MAP-SRCH-TRIG-END-DATE.                  DTSCS75
00038 *                                                                 DTSCS75
00039 *      JUMP IN: IF LCCM-EMP-NO = LCCM-SCR75-HOLD-AREA EMP-NO      DTSCS75
00040 *                 START A SEARCH AT THE AIX INDEX RECORD WHOSE    DTSCS75
00041 *                 KEY IS IN LCCM-SCR75-HOLD-AREA                  DTSCS75
00042 *               ELSE                                              DTSCS75
00043 *                   CLEAR.                                        DTSCS75
00044 *                                                                 DTSCS75
00045 *      ENTER: REDISPLAY SAME STUFF.                               DTSCS75
00046 *                                                                 DTSCS75
00047 *      F07, F08: DO NOT BOTHER TO 'WRAP' PAGING.                  DTSCS75
00048 *                                                                 DTSCS75
00049 *      JUMP OUT: IF A LINE NO IS BEING SELECTED:                  DTSCS75
00050 *                                                                 DTSCS75
00051 *                  UPDATE LCCM-EMP-NO                             DTSCS75
00052 *                                                                 DTSCS75
00053 *                  STORE AIX RECORD REPRESENTING LINE NO          DTSCS75
00054 *                    SELECTED IN LCCM-SCR75-HOLD-AREA             DTSCS75
00055 *                                                                 DTSCS75
00056 *                  STORE MAP-SRCH-ACK-IND, MAP-SRCH-TRIG          DTSCS75
00057 *                        -START-ATE, AND MAP-SRCH-TRIG-END-DATE   DTSCS75
00058 *                        IN LCCM-SCR-75-HOLD-AREA (MAP-SRCH-DEST  DTSCS75
00059 *                        IS IN THE AIX RECORD)                    DTSCS75
00060 *                                                                 DTSCS75
00061 *                  IF (JUMP TO SCREEN '74 REQUESTED)              DTSCS75
00062 *                      CONSTRUCT LCCM-SCR74-HOLD-AREA.            DTSCS75
00063 *                                                                 DTSCS75
00064 *      PROTECT THE 'CONTROL' FIELDS DURING A SEARCH -             DTSCS75
00065 *      LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED.      DTSCS75
00066 *      THE USER MUST PRESS THE CLEAR KEY BEFORE RESTARTING        DTSCS75
00067 *      A SEARCH.                                                  DTSCS75
00068 *                                                                 DTSCS75
00069 *      DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE         DTSCS75
00070 *      LCCM-SCR-HOLD-AREA TO HOLD THE FROM 1 TO 12 AIX            DTSCS75
00071 *      RECORDS FROM WHICH THE 1 TO 12 LINES OF THE DISPLAY        DTSCS75
00072 *      WERE CONSTRUCTED.  WHEN THE USER SELECTS A 'LINE NO',      DTSCS75
00073 *      THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA IS USED       DTSCS75
00074 *      TO DETERMINE WHICH EMPLOYER WAS SELECTED.                  DTSCS75
00075 *                                                                 DTSCS75
00076 *      DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE         DTSCS75
00077 *      THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA TO            DTSCS75
00078 *      CONTROL PAGING.                                            DTSCS75
00079 *                                                                 DTSCS75
00080 *                                                                 DTSCS75
00081 *    UPDATE:                                                      DTSCS75
00082 *                                                                 DTSCS75
00083 *      NONE.                                                      DTSCS75
00084 *                                                                 DTSCS75
00085 *                                                                 DTSCS75
00086 *    RECORDS READ:                                                DTSCS75
00087 *                                                                 DTSCS75
00088 *      MASTER:                                                    DTSCS75
00089 *                                                                 DTSCS75
00090 *        MPRF                                                     DTSCS75
00091 *        MTCK                                                     DTSCS75
00092 *                                                                 DTSCS75
00093 *                                                                 DTSCS75
00094 *      ALTERNATE INDEX:                                           DTSCS75
00095 *                                                                 DTSCS75
00096 *        ITDS                                                     DTSCS75
00097 *                                                                 DTSCS75
00098 *                                                                 DTSCS75
00099 *      REFERENCE:                                                 DTSCS75
00100 *                                                                 DTSCS75
00101 *        NONE.                                                    DTSCS75
00102 *                                                                 DTSCS75
00103 *                                                                 DTSCS75
00104 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS75
00105 *                                                                 DTSCS75
00106 *        NONE.                                                    DTSCS75
00107 *                                                                 DTSCS75
00108 *                                                                 DTSCS75
00109 *    RECORDS UPDATED:                                             DTSCS75
00110 *                                                                 DTSCS75
00111 *      MASTER:                                                    DTSCS75
00112 *                                                                 DTSCS75
00113 *        NONE.                                                    DTSCS75
00114 *                                                                 DTSCS75
00115 *                                                                 DTSCS75
00116 *      REFERENCE:                                                 DTSCS75
00117 *                                                                 DTSCS75
00118 *        NONE.                                                    DTSCS75
00119 *                                                                 DTSCS75
00120 *                                                                 DTSCS75
00121 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS75
00122 *                                                                 DTSCS75
00123 *        NONE.                                                    DTSCS75
00124 *                                                                 DTSCS75
00125 *                                                                 DTSCS75
00126 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS75
00127 *                                                                 DTSCS75
00128 *      NONE.                                                      DTSCS75
00129 *                                                                 DTSCS75
00130 *                                                                 DTSCS75
00131 *    TEMPORARY STORAGE USAGE:                                     DTSCS75
00132 *                                                                 DTSCS75
00133 *      NONE.                                                      DTSCS75
00134 *                                                                 DTSCS75
00135 *                                                                 DTSCS75
00136 *    MODULES LINKED TO:                                           DTSCS75
00137 *                                                                 DTSCS75
00138 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS75
00139 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS75
00140 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS75
00141 *      DTSCU821  ALTERNATE INDEX FILE INPUT/OUTPUT.               DTSCS75
00142 *                                                                 DTSCS75
00143 *                                                                 DTSCS75
00144 *    VERMONT REFERENCE:                                           DTSCS75
00145 *                                                                 DTSCS75
00146 *       TXC620C                                                   DTSCS75
00147 *                                                                 DTSCS75
00148 *                                                                 DTSCS75
00149 *    NOTES TO JEFF:                                               DTSCS75
00150 *                                                                 DTSCS75
00151 *    .  THIS SCREEN SHOULD BE VERY MUCH LIKE TXC620C.  OBVIOUSLY, DTSCS75
00152 *       DTSCS67 IS ALSO A POSSIBLE MODEL.                         DTSCS75
00153 *                                                                 DTSCS75
00154 *    .  PROBABLY THE ONLY DEPARTURE FROM VERMONT IS THAT IF A     DTSCS75
00155 *       LINE NUMBER IS SPECIFIED IN SELECT LINE NO AND THE        DTSCS75
00156 *       ENTER KEY IS PRESSED, THEN JUMP TO SCREEN 74.  THIS       DTSCS75
00157 *       IS THE SAME KIND OF CHANGE WE MADE FOR MONTANA ON         DTSCS75
00158 *       SCREEN 12, 66, AND 67.                                    DTSCS75
00159 *                                                                 DTSCS75
00160 *                                                                 DTSCS75
00161 *****                                                             DTSCS75
00162                                                                   DTSCS75
00163  ENVIRONMENT DIVISION.                                            DTSCS75
00164                                                                   DTSCS75
00165  DATA DIVISION.                                                   DTSCS75
00166                                                                   DTSCS75
00167  WORKING-STORAGE SECTION.                                         DTSCS75
001675 77  PAN-VALET PICTURE X(24) VALUE '009DTSCS75   07/02/03'.       DTSCS75
00168                                                                   DTSCS75
00169  01  WRK-TS-AREA.                                                 DTSCS75
00170      05  WRK-TS-SCREEN-75-IND        PIC  X(02).                  DTSCS75
00171          88  WRK-TS-SCREEN-75-YES      VALUE '75'.                DTSCS75
00172      05  WRK-TS-KEY-AREA             PIC  X(796).                 DTSCS75
00173      05  FILLER REDEFINES WRK-TS-KEY-AREA.                        DTSCS75
00174          10  WRK-TS-KEY OCCURS 12 TIMES.                          DTSCS75
00175              15  FILLER                  PIC  X(64).              DTSCS75
00176      05  WRK-SCR-FIRST-ADDL          PIC X(04).                   DTSCS75
00177      05  WRK-ADDL-CTR REDEFINES WRK-SCR-FIRST-ADDL PIC S9(04).    DTSCS75
00178                                                                   DTSCS75
00179  01  WRK-AREA.                                                    DTSCS75
00180      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S75 '.    DTSCS75
00181                                                                   DTSCS75
00182      05  WRK-SCR-ID.                                              DTSCS75
00183          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 75.        DTSCS75
00184                                                                   DTSCS75
00185      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '70'.      DTSCS75
00186                                                                   DTSCS75
00187      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS75
00188          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS75
00189          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS75
00190                                                                   DTSCS75
00191      05  CURSOR-SET-IND              PIC X(01).                   DTSCS75
00192          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS75
00193          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS75
00194          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS75
00195                                                                   DTSCS75
00196      05  REQ-IND                     PIC X(01).                   DTSCS75
00197          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS75
00198          88  REQ-ERROR                       VALUE 'O'.           DTSCS75
00199          88  REQ-JUMP                        VALUE 'J'.           DTSCS75
00200          88  REQ-UPDATE                      VALUE 'U'.           DTSCS75
00201          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS75
00202          88  REQ-CLEAR                       VALUE 'C'.           DTSCS75
00203          88  REQ-EDIT                        VALUE 'E'.           DTSCS75
00204                                                                   DTSCS75
00205      05  RESP-IND                    PIC X(01).                   DTSCS75
00206          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS75
00207          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS75
00208          88  RESP-JUMP                       VALUE 'J'.           DTSCS75
00209          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS75
00210                                                                   DTSCS75
00211      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS75
00212                                                                   DTSCS75
00213      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS75
00214      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS75
00215                                                                   DTSCS75
00216      05  WRK-DEST-OP-ID              PIC  X(08).                  DTSCS75
00217                                                                   DTSCS75
00218      05  INQUIRY-CONTROL-AREA.                                    DTSCS75
00219          10  LAST-REC-NUM            PIC S9(08)  COMP.            DTSCS75
00220          10  WS-REC-NUM              PIC S9(08)  COMP.            DTSCS75
00221                                                                   DTSCS75
00222          10  SCR-REC-KEY-AREA           PIC  X(96).               DTSCS75
00223          10  WRK-SCR-KEY-AREA.                                    DTSCS75
00224              15  WRK-SCR-TDS-KEY        PIC  X(64).               DTSCS75
00225              15  WRK-TRIGGER-DATE-FROM  PIC S9(08) COMP-3.        DTSCS75
00226              15  WRK-TRIGGER-DATE-TO    PIC S9(08) COMP-3.        DTSCS75
00227              15  WRK-ACKNOWLEDGED-IND   PIC  X(01).               DTSCS75
00228                                                                   DTSCS75
00229      05  WRK-TS-FOUND-IND            PIC  X(01).                  DTSCS75
00230          88  WRK-TS-FOUND-YES        VALUE 'Y'.                   DTSCS75
00231          88  WRK-TS-FOUND-NO         VALUE 'N'.                   DTSCS75
00232                                                                   DTSCS75
00233      05  WRK-CTR                     PIC S9(04)  COMP.            DTSCS75
00234                                                                   DTSCS75
00235      05  WRK-CTR2                    PIC S9(04)  COMP.            DTSCS75
00236                                                                   DTSCS75
00237      05  WRK-SUB                     PIC S9(04)  COMP.            DTSCS75
00238                                                                   DTSCS75
00239      05  WRK-REALLY-WANT-IND          PIC X(01).                  DTSCS75
00240          88  WRK-REALLY-WANT-IT             VALUE 'Y'.            DTSCS75
00241          88  WRK-REALLY-DO-NOT-WANT-IT      VALUE 'N'.            DTSCS75
00242                                                                   DTSCS75
00243      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS75
00244                                                                   DTSCS75
00245      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS75
00246          10  FILLER                  PIC X(05).                   DTSCS75
00247          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS75
00248          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS75
00249                                                                   DTSCS75
00250      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS75
00251          10  FILLER                  PIC X(05).                   DTSCS75
00252          10  WRK-DISPLAY-DATE.                                    DTSCS75
00253              15  WRK-DISPLAY-YR          PIC X(02).               DTSCS75
00254              15  WRK-DISPLAY-MO          PIC X(02).               DTSCS75
00255              15  WRK-DISPLAY-DA          PIC X(02).               DTSCS75
00256                                                                   DTSCS75
00257  01  MSG-LITERALS.                                                DTSCS75
00258      05  MSG-E751-AREA.                                           DTSCS75
00259          10  FILLER                  PIC  X(04)  VALUE 'E751'.    DTSCS75
00260          10  MSG-EMP-NO-IN-ERR           PIC 999B999.             DTSCS75
00261          10  MSG-E751-MSG                PIC X(50) VALUE          DTSCS75
00262          ' ALTERNATE INDEX FILE ERROR - CONTACT DP'.              DTSCS75
00263      EJECT                                                        DTSCS75
00264  01  L001-COMM-AREA.                                              DTSCS75
00265  ++INCLUDE DTSIL001                                               DTSCS75
00266      EJECT                                                        DTSCS75
00267  01  L015-COMM-AREA.                                              DTSCS75
00268  ++INCLUDE DTSIL015                                               DTSCS75
00269      EJECT                                                        DTSCS75
00270  01  L805-COMM-AREA.                                              DTSCS75
00271  ++INCLUDE DTSIL805                                               DTSCS75
00272      EJECT                                                        DTSCS75
00273  01  L810-COMM-AREA.                                              DTSCS75
00274      05  L810-CONTROL-BLOCK.                                      DTSCS75
00275  ++INCLUDE DTSIL810                                               DTSCS75
00276      EJECT                                                        DTSCS75
00277      05  MSKL-REC.                                                DTSCS75
00278  ++INCLUDE DTSIMSKL                                               DTSCS75
00279      EJECT                                                        DTSCS75
00280  01  MPRF-REC.                                                    DTSCS75
00281  ++INCLUDE DTSIMPRF                                               DTSCS75
00282      EJECT                                                        DTSCS75
00283  01  MTCK-REC.                                                    DTSCS75
00284  ++INCLUDE DTSIMTCK                                               DTSCS75
00285      EJECT                                                        DTSCS75
00286  01  L821-COMM-AREA.                                              DTSCS75
00287      05  L821-CONTROL-BLOCK.                                      DTSCS75
00288  ++INCLUDE DTSIL821                                               DTSCS75
00289                                                                   DTSCS75
00290      05  ISKL-REC.                                                DTSCS75
00291  ++INCLUDE DTSIISKL                                               DTSCS75
00292      05  FILLER REDEFINES ISKL-REC.                               DTSCS75
00293  ++INCLUDE DTSIITDS                                               DTSCS75
00294                                                                   DTSCS75
00295  01  L851-COMM-AREA.                                              DTSCS75
00296  ++INCLUDE DTSIL851                                               DTSCS75
00297      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS75
00298  ++INCLUDE DTSIS75                                                DTSCS75
00299      EJECT                                                        DTSCS75
00300  01  CATB-LITERALS.                                               DTSCS75
00301  ++INCLUDE DTSICATB                                               DTSCS75
00302                                                                   DTSCS75
00303  01  CFKD-LITERALS.                                               DTSCS75
00304  ++INCLUDE DTSICFKD                                               DTSCS75
00305                                                                   DTSCS75
00306  01  CECD-LITERALS.                                               DTSCS75
00307  ++INCLUDE DTSICECD                                               DTSCS75
00308                                                                   DTSCS75
00309  01  CPCD-LITERALS.                                               DTSCS75
00310  ++INCLUDE DTSICPCD                                               DTSCS75
00311      EJECT                                                        DTSCS75
00312  LINKAGE SECTION.                                                 DTSCS75
00313                                                                   DTSCS75
00314  01  DFHCOMMAREA.                                                 DTSCS75
00315  ++INCLUDE DTSILCCM                                               DTSCS75
00316      EJECT                                                        DTSCS75
00317 ******************************************************************DTSCS75
00318 *                                                                *DTSCS75
00319 ******************************************************************DTSCS75
00320                                                                   DTSCS75
00321  PROCEDURE DIVISION.                                              DTSCS75
00322                                                                   DTSCS75
00323      MOVE LOW-VALUES     TO MAP-AREA.                             DTSCS75
00324      SET CURSOR-SET-NO   TO TRUE.                                 DTSCS75
00325                                                                   DTSCS75
00326      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS75
00327        TO SCR-ACCESS-IND.                                         DTSCS75
00328                                                                   DTSCS75
00329      MOVE +0 TO WRK-CTR                                           DTSCS75
00330                 WRK-CTR2                                          DTSCS75
00331                 WRK-SUB.                                          DTSCS75
00332                                                                   DTSCS75
00333 *-----------------------------------------------------            DTSCS75
00334 * DETERMINE IF THERE IS INFORMATION HELD FROM THE PREVIOUS        DTSCS75
00335 * TASK AND SET THE APPROPRIATE INDICATORS/COUNTERS                DTSCS75
00336 *-----------------------------------------------------            DTSCS75
00337      MOVE LCCM-SCR-HOLD-AREA   TO WRK-TS-AREA.                    DTSCS75
00338      MOVE LCCM-SCR75-HOLD-AREA TO WRK-SCR-KEY-AREA.               DTSCS75
00339                                                                   DTSCS75
00340      IF WRK-TS-SCREEN-75-YES                                      DTSCS75
00341         SET WRK-TS-FOUND-YES TO TRUE                              DTSCS75
00342      ELSE                                                         DTSCS75
00343         MOVE +0 TO WRK-ADDL-CTR                                   DTSCS75
00344         SET WRK-TS-FOUND-NO  TO TRUE.                             DTSCS75
00345                                                                   DTSCS75
00346      MOVE SPACE TO REQ-IND.                                       DTSCS75
00347                                                                   DTSCS75
00348      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS75
00349                                                                   DTSCS75
00350 *-----------------------------------------------------            DTSCS75
00351 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS75
00352 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS75
00353 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS75
00354 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS75
00355 *                                                                 DTSCS75
00356 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS75
00357 *    PROCESSED.                                                   DTSCS75
00358 *                                                                 DTSCS75
00359 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS75
00360 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS75
00361 *    WORK STATION OPERATOR.                                       DTSCS75
00362 *-----------------------------------------------------            DTSCS75
00363                                                                   DTSCS75
00364      MOVE SPACE TO RESP-IND.                                      DTSCS75
00365                                                                   DTSCS75
00366      IF REQ-ERROR                                                 DTSCS75
00367         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS75
00368      ELSE                                                         DTSCS75
00369      IF REQ-JUMP                                                  DTSCS75
00370         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS75
00371      ELSE                                                         DTSCS75
00372      IF REQ-CLEAR                                                 DTSCS75
00373         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS75
00374      ELSE                                                         DTSCS75
00375      IF REQ-CURSOR-TO-GOTO                                        DTSCS75
00376         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS75
00377      ELSE                                                         DTSCS75
00378      IF REQ-INQUIRE                                               DTSCS75
00379         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS75
00380      ELSE                                                         DTSCS75
00381         GO TO S899-ABEND.                                         DTSCS75
00382                                                                   DTSCS75
00383 *-----------------------------------------------------            DTSCS75
00384 *    SAVE THE SCREEN INFORMATION THAT HAS BEEN BUILT              DTSCS75
00385 *    FOR LATER IF THE USER RETURNS TO THIS SCREEN                 DTSCS75
00386 *-----------------------------------------------------            DTSCS75
00387      MOVE WRK-SCR-KEY-AREA TO LCCM-SCR75-HOLD-AREA.               DTSCS75
00388                                                                   DTSCS75
00389 *-----------------------------------------------------            DTSCS75
00390 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS75
00391 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS75
00392 *-----------------------------------------------------            DTSCS75
00393      IF RESP-SEND-MAP                                             DTSCS75
00394          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS75
00395          SET LCCM-END-TASK-88 TO TRUE                             DTSCS75
00396      ELSE                                                         DTSCS75
00397      IF RESP-SEND-MSGONLY                                         DTSCS75
00398          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS75
00399          SET LCCM-END-TASK-88 TO TRUE                             DTSCS75
00400      ELSE                                                         DTSCS75
00401      IF RESP-JUMP                                                 DTSCS75
00402          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS75
00403      ELSE                                                         DTSCS75
00404      IF RESP-CURSOR-TO-GOTO                                       DTSCS75
00405          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS75
00406          SET LCCM-END-TASK-88 TO TRUE                             DTSCS75
00407      ELSE                                                         DTSCS75
00408          GO TO S899-ABEND.                                        DTSCS75
00409                                                                   DTSCS75
00410  MAINLINE-EXIT.                                                   DTSCS75
00411                                                                   DTSCS75
00412      EXEC CICS                                                    DTSCS75
00413          RETURN                                                   DTSCS75
00414      END-EXEC.                                                    DTSCS75
00415                                                                   DTSCS75
00416      GOBACK.                                                      DTSCS75
00417      EJECT                                                        DTSCS75
00418 /*****************************************************************DTSCS75
00419 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS75
00420 ******************************************************************DTSCS75
00421  P1000-ANALYZE-REQUEST.                                           DTSCS75
00422 *-----------------------------------------------------            DTSCS75
00423 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS75
00424 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS75
00425 *     REPLACED WITH ENTER)                                        DTSCS75
00426 *-----------------------------------------------------            DTSCS75
00427      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS75
00428         SET LCCM-ENTER-88 TO TRUE                                 DTSCS75
00429         PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT             DTSCS75
00430 * THE FOLLOWING LINE WILL START THE SEARCH BASED ON THE KEY FIELDSDTSCS75
00431 * FROM A PREVIOUS SEARCH                                          DTSCS75
00432 ******* SET REQ-INQUIRE TO TRUE                                   DTSCS75
00433         GO TO P1000-EXIT.                                         DTSCS75
00434                                                                   DTSCS75
00435 *-----------------------------------------------------            DTSCS75
00436 *      MAP IS RECEIVED                                            DTSCS75
00437 *-----------------------------------------------------            DTSCS75
00438      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS75
00439                                                                   DTSCS75
00440 *-----------------------------------------------------            DTSCS75
00441 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS75
00442 *    WORK STATION                                                 DTSCS75
00443 *-----------------------------------------------------            DTSCS75
00444      IF LCCM-CLEAR-88                                             DTSCS75
00445         SET REQ-CLEAR TO TRUE                                     DTSCS75
00446         GO TO P1000-EXIT.                                         DTSCS75
00447                                                                   DTSCS75
00448 *-----------------------------------------------------            DTSCS75
00449 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS75
00450 *-----------------------------------------------------            DTSCS75
00451      IF LCCM-PA2-88                                               DTSCS75
00452          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS75
00453          GO TO P1000-EXIT.                                        DTSCS75
00454                                                                   DTSCS75
00455 *-----------------------------------------------------            DTSCS75
00456 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS75
00457 *-----------------------------------------------------            DTSCS75
00458      IF LCCM-PA-88                                                DTSCS75
00459        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS75
00460        SET REQ-ERROR TO TRUE                                      DTSCS75
00461        GO TO P1000-EXIT.                                          DTSCS75
00462                                                                   DTSCS75
00463 *-----------------------------------------------------            DTSCS75
00464 *    IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS                DTSCS75
00465 *    CLEAR SCREEN                                                 DTSCS75
00466 *-----------------------------------------------------            DTSCS75
00467      IF LCCM-F12-88                                               DTSCS75
00468         MOVE LOW-VALUES TO MAP-AREA                               DTSCS75
00469         SET REQ-CLEAR TO TRUE                                     DTSCS75
00470         GO TO P1000-EXIT.                                         DTSCS75
00471                                                                   DTSCS75
00472 *-----------------------------------------------------            DTSCS75
00473 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS75
00474 *-----------------------------------------------------            DTSCS75
00475      IF LCCM-F03-88                                               DTSCS75
00476         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS75
00477         SET REQ-JUMP TO TRUE                                      DTSCS75
00478         GO TO P1000-EXIT.                                         DTSCS75
00479                                                                   DTSCS75
00480 *-----------------------------------------------------            DTSCS75
00481 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS75
00482 *-----------------------------------------------------            DTSCS75
00483      IF LCCM-F04-88                                               DTSCS75
00484         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS75
00485         SET REQ-JUMP TO TRUE                                      DTSCS75
00486         GO TO P1000-EXIT.                                         DTSCS75
00487                                                                   DTSCS75
00488 *---------------------------------------------------------        DTSCS75
00489 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS75
00490 *    CORRESPONDENCE SCREEN.                                       DTSCS75
00491 *---------------------------------------------------------        DTSCS75
00492                                                                   DTSCS75
00493      IF LCCM-F14-88                                               DTSCS75
00494         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS75
00495         SET REQ-JUMP TO TRUE                                      DTSCS75
00496         GO TO P1000-EXIT.                                         DTSCS75
00497                                                                   DTSCS75
00498 *-----------------------------------------------------            DTSCS75
00499 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS75
00500 *    REQUESTED SCREEN TYPE                                        DTSCS75
00501 *-----------------------------------------------------            DTSCS75
00502 *    IF LCCM-F17-88                                               DTSCS75
00503 *    OR LCCM-F19-88                                               DTSCS75
00504 *    OR LCCM-F20-88                                               DTSCS75
00505 *    OR LCCM-F21-88                                               DTSCS75
00506 *       SET REQ-JUMP TO TRUE                                      DTSCS75
00507 *       GO TO P1000-EXIT                                          DTSCS75
00508 *    ELSE                                                         DTSCS75
00509      IF  (MAP-SCREEN-ID  = LOW-VALUES OR SPACES)                  DTSCS75
00510      AND (MAP-LINE-NUMBER = LOW-VALUES OR SPACES)                 DTSCS75
00511         NEXT SENTENCE                                             DTSCS75
00512      ELSE                                                         DTSCS75
00513         SET REQ-JUMP TO TRUE                                      DTSCS75
00514         GO TO P1000-EXIT.                                         DTSCS75
00515                                                                   DTSCS75
00516 *-----------------------------------------------------            DTSCS75
00517 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS75
00518 *    REQUESTED SCREEN TYPE                                        DTSCS75
00519 *-----------------------------------------------------            DTSCS75
00520      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS75
00521         NEXT SENTENCE                                             DTSCS75
00522      ELSE                                                         DTSCS75
00523        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS75
00524        SET REQ-JUMP TO TRUE                                       DTSCS75
00525        GO TO P1000-EXIT.                                          DTSCS75
00526                                                                   DTSCS75
00527 *-----------------------------------------------------            DTSCS75
00528 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS75
00529 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS75
00530 *-----------------------------------------------------            DTSCS75
00531      IF LCCM-F07-88                                               DTSCS75
00532      OR LCCM-F08-88                                               DTSCS75
00533      OR LCCM-ENTER-88                                             DTSCS75
00534          SET REQ-INQUIRE TO TRUE                                  DTSCS75
00535          GO TO P1000-EXIT.                                        DTSCS75
00536                                                                   DTSCS75
00537 *-----------------------------------------------------            DTSCS75
00538 *     ANY OTHER KEY IS INVALID                                    DTSCS75
00539 *-----------------------------------------------------            DTSCS75
00540      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS75
00541      SET REQ-ERROR TO TRUE.                                       DTSCS75
00542  P1000-EXIT.                                                      DTSCS75
00543      EXIT.                                                        DTSCS75
00544                                                                   DTSCS75
00545 ******************************************************************DTSCS75
00546 *                                                                 DTSCS75
00547 *      JUMP IN: IF LCCM-EMP-NO = LCCM-SCR75-HOLD-AREA EMP-NO      DTSCS75
00548 *                                                                 DTSCS75
00549 *                 START A SEARCH AT THE ITDS RECORD WHOSE         DTSCS75
00550 *                 KEY IS IN LCCM-SCR75-HOLD-AREA                  DTSCS75
00551 *               ELSE                                              DTSCS75
00552 *                 CLEAR (BUT LEAVE THE REQUESTED KEY FIELDS)      DTSCS75
00553 ******************************************************************DTSCS75
00554                                                                   DTSCS75
00555  P1200-CHECK-HOLD-AREA.                                           DTSCS75
00556      MOVE +0                      TO WRK-ADDL-CTR                 DTSCS75
00557                                                                   DTSCS75
00558      MOVE WRK-SCR-TDS-KEY TO ITDS-KEY-AREA                        DTSCS75
00559      IF ITDS-TDS-88                                               DTSCS75
00560 * LINE MOVED TO ONLY SHOW CRITERIA IF JUMP-EMP = LCCM-EMP         DTSCS75
00561 ******* PERFORM P1201-REQUEST-FIELDS THRU P1201-EXIT              DTSCS75
00562         IF ITDS-EMP-NO = LCCM-EMP-NO                              DTSCS75
00563            SET WRK-TS-FOUND-YES TO TRUE                           DTSCS75
00564         ELSE                                                      DTSCS75
00565            SET WRK-TS-FOUND-NO TO TRUE                            DTSCS75
00566      ELSE                                                         DTSCS75
00567         SET WRK-TS-FOUND-NO TO TRUE.                              DTSCS75
00568                                                                   DTSCS75
00569      IF WRK-TS-FOUND-YES                                          DTSCS75
00570 *  CRITERIA ONLY SHOWED IF JUMP EMP-NO = LCCM-EMP-NO              DTSCS75
00571         SET REQ-INQUIRE TO TRUE                                   DTSCS75
00572         PERFORM P1201-REQUEST-FIELDS THRU P1201-EXIT              DTSCS75
00573         SET WRK-TS-SCREEN-75-YES TO TRUE                          DTSCS75
00574         MOVE WRK-SCR-TDS-KEY TO WRK-TS-KEY(1)                     DTSCS75
00575         MOVE +1 TO WRK-ADDL-CTR                                   DTSCS75
00576      ELSE                                                         DTSCS75
00577 * IF NO PREVIOUS SEARCH CRITERIA OR DID NOT MATCH SEND CLEAR SCREEDTSCS75
00578         SET REQ-CLEAR TO TRUE                                     DTSCS75
00579         MOVE +0 TO WRK-ADDL-CTR                                   DTSCS75
00580      END-IF.                                                      DTSCS75
00581  P1200-EXIT.                                                      DTSCS75
00582      EXIT.                                                        DTSCS75
00583                                                                   DTSCS75
00584  P1201-REQUEST-FIELDS.                                            DTSCS75
00585      IF WRK-TRIGGER-DATE-FROM > 0                                 DTSCS75
00586         MOVE  WRK-TRIGGER-DATE-FROM TO WRK-DISPLAY                DTSCS75
00587         MOVE WRK-DISPLAY-MO TO MAP-TRIGGER-DATE-FROM-MO           DTSCS75
00588         MOVE WRK-DISPLAY-DA TO MAP-TRIGGER-DATE-FROM-DA           DTSCS75
00589         MOVE WRK-DISPLAY-YR TO MAP-TRIGGER-DATE-FROM-YR           DTSCS75
00590      END-IF                                                       DTSCS75
00591      IF WRK-TRIGGER-DATE-TO < 99999999                            DTSCS75
00592         MOVE  WRK-TRIGGER-DATE-TO TO WRK-DISPLAY                  DTSCS75
00593         MOVE WRK-DISPLAY-MO TO MAP-TRIGGER-DATE-TO-MO             DTSCS75
00594         MOVE WRK-DISPLAY-DA TO MAP-TRIGGER-DATE-TO-DA             DTSCS75
00595         MOVE WRK-DISPLAY-YR TO MAP-TRIGGER-DATE-TO-YR             DTSCS75
00596      END-IF                                                       DTSCS75
00597      MOVE  WRK-ACKNOWLEDGED-IND  TO MAP-ACKNOWLEDGED-IND.         DTSCS75
00598      MOVE ITDS-DEST-OP-ID TO MAP-DEST-OP-ID.                      DTSCS75
00599  P1201-EXIT.                                                      DTSCS75
00600      EXIT.                                                        DTSCS75
00601 /*****************************************************************DTSCS75
00602 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS75
00603 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS75
00604 ******************************************************************DTSCS75
00605                                                                   DTSCS75
00606  P2000-REQUEST-ERROR.                                             DTSCS75
00607      IF LCCM-MSG                                                  DTSCS75
00608         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS75
00609      ELSE                                                         DTSCS75
00610         GO TO S899-ABEND.                                         DTSCS75
00611  P2000-EXIT.                                                      DTSCS75
00612      EXIT.                                                        DTSCS75
00613 /*****************************************************************DTSCS75
00614 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS75
00615 ******************************************************************DTSCS75
00616                                                                   DTSCS75
00617  P3000-REQUEST-JUMP.                                              DTSCS75
00618      PERFORM P3001-SELECTION-LINE-EDIT THRU P3001-EXIT            DTSCS75
00619                                                                   DTSCS75
00620      IF NOT LCCM-MSG                                              DTSCS75
00621         PERFORM P3500-BUILD-TS-AREAS THRU P3500-EXIT.             DTSCS75
00622                                                                   DTSCS75
00623 *-----------------------------------------------------            DTSCS75
00624 *   IF ERROR DETECTED AND DATA ON SCREEN THEN SAVE IT             DTSCS75
00625 *-----------------------------------------------------            DTSCS75
00626                                                                   DTSCS75
00627      IF LCCM-MSG                                                  DTSCS75
00628         PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT               DTSCS75
00629         SET RESP-SEND-MAP TO TRUE                                 DTSCS75
00630         GO TO P3000-EXIT.                                         DTSCS75
00631                                                                   DTSCS75
00632 *-----------------------------------------------------            DTSCS75
00633 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS75
00634 *-----------------------------------------------------            DTSCS75
00635      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS75
00636                         LCCM-SCR-HOLD-AREA.                       DTSCS75
00637      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS75
00638      SET RESP-JUMP TO TRUE.                                       DTSCS75
00639  P3000-EXIT.                                                      DTSCS75
00640      EXIT.                                                        DTSCS75
00641                                                                   DTSCS75
00642 ******************************************************************DTSCS75
00643 * IF A JUMP-KEY WAS PRESSED OK                                    DTSCS75
00644 * IF A SCREEN ID ENTERED (NOT GOTO) THEN LINE NUMBER REQUIRED     DTSCS75
00645 * IF A LINE NUMBER WAS ENTERED IT MUST EXIST ON THE SCREEN        DTSCS75
00646 ******************************************************************DTSCS75
00647  P3001-SELECTION-LINE-EDIT.                                       DTSCS75
00648 *****IF MAP-GOTO EQUAL SPACES    CODE COMMENTED OUT ON 08/24/94.  DTSCS75
00649 ****************OR LOW-VALUES    USER REPORTED ABEND IN SCREEN 12.DTSCS75
00650 ****************OR WRK-SCR-ID    EHH.                             DTSCS75
00651         IF MAP-LINE-NUMBER EQUAL LOW-VALUES OR SPACES             DTSCS75
00652            IF MAP-SCREEN-ID EQUAL LOW-VALUES OR SPACES            DTSCS75
00653               NEXT SENTENCE                                       DTSCS75
00654            ELSE                                                   DTSCS75
00655               MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA            DTSCS75
00656               PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT        DTSCS75
00657         ELSE                                                      DTSCS75
00658         IF WRK-TS-FOUND-YES                                       DTSCS75
00659            IF (NOT MAP-LINE-NUMBER-VALID)                         DTSCS75
00660            OR (MAP-LINE-NUMBER-N > WRK-ADDL-CTR)                  DTSCS75
00661               MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA           DTSCS75
00662               PERFORM S1901-MAP-LINE-ERROR THRU S1901-EXIT.       DTSCS75
00663  P3001-EXIT.                                                      DTSCS75
00664      EXIT.                                                        DTSCS75
00665                                                                   DTSCS75
00666  P3500-BUILD-TS-AREAS.                                            DTSCS75
00667      IF WRK-TS-FOUND-YES                                          DTSCS75
00668         IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES                 DTSCS75
00669            NEXT SENTENCE                                          DTSCS75
00670         ELSE                                                      DTSCS75
00671            MOVE WRK-TS-KEY(MAP-LINE-NUMBER-N) TO ITDS-KEY-AREA    DTSCS75
00672            MOVE ITDS-KEY-AREA TO WRK-SCR-TDS-KEY                  DTSCS75
00673            PERFORM P3501-FIND-EMP-NO THRU P3501-EXIT.             DTSCS75
00674                                                                   DTSCS75
00675      PERFORM P3502-REQ-SCR-ID THRU P3502-EXIT.                    DTSCS75
00676      PERFORM P3510-BUILD-JUMP-AREA THRU P3510-EXIT.               DTSCS75
00677                                                                   DTSCS75
00678 *-----------------------------------------------------            DTSCS75
00679 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS75
00680 *    BY USER                                                      DTSCS75
00681 *-----------------------------------------------------            DTSCS75
00682      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT                  DTSCS75
00683 *-----------------------------------------------------            DTSCS75
00684 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS75
00685 *-----------------------------------------------------            DTSCS75
00686      IF LCCM-MSG                                                  DTSCS75
00687         SET CURSOR-SET-YES TO TRUE                                DTSCS75
00688         IF MAP-GOTO EQUAL SPACES                                  DTSCS75
00689                     OR LOW-VALUES                                 DTSCS75
00690                     OR WRK-SCR-ID                                 DTSCS75
00691            MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SCREEN-ID-A      DTSCS75
00692            MOVE CATB-CURSOR TO MAP-SCREEN-ID-L                    DTSCS75
00693         ELSE                                                      DTSCS75
00694            MOVE CATB-CURSOR TO MAP-GOTO-L.                        DTSCS75
00695  P3500-EXIT. EXIT.                                                DTSCS75
00696                                                                   DTSCS75
00697 /*****************************************************************DTSCS75
00698 * EMPLOYER NUMBER IS AT A DIFFERENT DISPLACEMENT FOR EACH TYPE    DTSCS75
00699 ******************************************************************DTSCS75
00700  P3501-FIND-EMP-NO.                                               DTSCS75
00701      MOVE ITDS-EMP-NO TO LCCM-EMP-NO.                             DTSCS75
00702  P3501-EXIT.                                                      DTSCS75
00703      EXIT.                                                        DTSCS75
00704                                                                   DTSCS75
00705 /*****************************************************************DTSCS75
00706 * DETERMINE WHICH SCREEN WILL BE JUMPED TO BASED ON               DTSCS75
00707 *             FUNCTION KEY                                        DTSCS75
00708 *             SELECTED SCREEN                                     DTSCS75
00709 *             GOTO OPTION   (OVERRIDES FUNCTION OR SELECTED)      DTSCS75
00710 ******************************************************************DTSCS75
00711  P3502-REQ-SCR-ID.                                                DTSCS75
00712      MOVE LOW-VALUES TO LCCM-REQ-SCR-ID.                          DTSCS75
00713                                                                   DTSCS75
00714      IF LCCM-F03-88                                               DTSCS75
00715         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS75
00716      ELSE                                                         DTSCS75
00717      IF LCCM-F04-88                                               DTSCS75
00718         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS75
00719      ELSE                                                         DTSCS75
00720      IF LCCM-F14-88                                               DTSCS75
00721         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS75
00722      ELSE                                                         DTSCS75
00723 *    IF LCCM-F17-88                                               DTSCS75
00724 *       MOVE '11'    TO LCCM-REQ-SCR-ID                           DTSCS75
00725 *    ELSE                                                         DTSCS75
00726 *    IF LCCM-F19-88                                               DTSCS75
00727 *       MOVE '31'    TO LCCM-REQ-SCR-ID                           DTSCS75
00728 *    ELSE                                                         DTSCS75
00729 *    IF LCCM-F20-88                                               DTSCS75
00730 *       MOVE '41'    TO LCCM-REQ-SCR-ID                           DTSCS75
00731 *    ELSE                                                         DTSCS75
00732 *    IF LCCM-F21-88                                               DTSCS75
00733 *       MOVE '74'    TO LCCM-REQ-SCR-ID                           DTSCS75
00734 *    ELSE                                                         DTSCS75
00735         IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID          DTSCS75
00736            IF MAP-SCREEN-ID = SPACES OR LOW-VALUES                DTSCS75
00737               IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES           DTSCS75
00738                  NEXT SENTENCE                                    DTSCS75
00739               ELSE                                                DTSCS75
00740                  IF WRK-TS-FOUND-YES                              DTSCS75
00741                     MOVE '74' TO LCCM-REQ-SCR-ID                  DTSCS75
00742                  ELSE                                             DTSCS75
00743                     NEXT SENTENCE                                 DTSCS75
00744            ELSE                                                   DTSCS75
00745               MOVE MAP-SCREEN-ID TO LCCM-REQ-SCR-ID               DTSCS75
00746         ELSE                                                      DTSCS75
00747            MOVE MAP-GOTO TO LCCM-REQ-SCR-ID.                      DTSCS75
00748                                                                   DTSCS75
00749      IF LCCM-REQ-SCR-ID = LOW-VALUES OR SPACES OR WRK-SCR-ID      DTSCS75
00750          MOVE EMSG-INVALID-TRANS-ID TO WRK-MSG-AREA               DTSCS75
00751          PERFORM S2001-SELECT-SCREEN-ERROR THRU S2001-EXIT.       DTSCS75
00752  P3502-EXIT.                                                      DTSCS75
00753      EXIT.                                                        DTSCS75
00754                                                                   DTSCS75
00755 /*****************************************************************DTSCS75
00756 * SELECTED LINE SELECTED TYPE AND SELECTED JUMP WILL BUILD THE    DTSCS75
00757 * SPECIFIC 'KEY' FOR THE CORRECT DISPLAY PAGE WHEN JUMP HAPPENS   DTSCS75
00758 ******************************************************************DTSCS75
00759  P3510-BUILD-JUMP-AREA.                                           DTSCS75
00760      IF WRK-TS-FOUND-YES                                          DTSCS75
00761         IF MAP-LINE-NUMBER = LOW-VALUES OR SPACES                 DTSCS75
00762            NEXT SENTENCE                                          DTSCS75
00763         ELSE                                                      DTSCS75
00764         IF (LCCM-REQ-SCR-ID = '74')                               DTSCS75
00765             PERFORM P3574-TS-FOR-74 THRU P3574-EXIT.              DTSCS75
00766  P3510-EXIT.                                                      DTSCS75
00767      EXIT.                                                        DTSCS75
00768                                                                   DTSCS75
00769  P3574-TS-FOR-74.                                                 DTSCS75
00770      MOVE LOW-VALUES TO LCCM-SCR74-HOLD-AREA.                     DTSCS75
00771      MOVE LOW-VALUES TO MTCK-KEY-AREA.                            DTSCS75
00772      SET MTCK-TCK-88 TO TRUE.                                     DTSCS75
00773      MOVE ITDS-ESTB-ABSTIME TO MTCK-ESTB-ABSTIME.                 DTSCS75
00774      MOVE ITDS-EMP-NO TO MTCK-EMP-NO.                             DTSCS75
00775      MOVE MTCK-KEY-AREA TO LCCM-SCR74-HOLD-AREA.                  DTSCS75
00776                                                                   DTSCS75
00777  P3574-EXIT. EXIT.                                                DTSCS75
00778                                                                   DTSCS75
00779 /*****************************************************************DTSCS75
00780 * CLEAR KEY WAS PRESSED                                          *DTSCS75
00781 ******************************************************************DTSCS75
00782                                                                   DTSCS75
00783  P4000-REQUEST-CLEAR.                                             DTSCS75
00784      PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT                DTSCS75
00785      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS75
00786                                                                   DTSCS75
00787      MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L.                        DTSCS75
00788                                                                   DTSCS75
00789      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
00790      MOVE 'N' TO WRK-TS-FOUND-IND.                                DTSCS75
00791 *-----------------------------------------------------            DTSCS75
00792 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS75
00793 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS75
00794 *-----------------------------------------------------            DTSCS75
00795                                                                   DTSCS75
00796 *****MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS75
00797                                                                   DTSCS75
00798      MOVE LOW-VALUES TO WRK-SCR-KEY-AREA                          DTSCS75
00799      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA                        DTSCS75
00800      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS75
00801                                                                   DTSCS75
00802      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS75
00803                                                                   DTSCS75
00804      SET RESP-SEND-MAP TO TRUE.                                   DTSCS75
00805  P4000-EXIT.                                                      DTSCS75
00806      EXIT.                                                        DTSCS75
00807 /*****************************************************************DTSCS75
00808 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS75
00809 ******************************************************************DTSCS75
00810                                                                   DTSCS75
00811  P5000-CURSOR-TO-GOTO.                                            DTSCS75
00812      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS75
00813      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS75
00814  P5000-EXIT.                                                      DTSCS75
00815      EXIT.                                                        DTSCS75
00816 /*****************************************************************DTSCS75
00817 * INQUIRY WAS REQUESTED                                          *DTSCS75
00818 ******************************************************************DTSCS75
00819                                                                   DTSCS75
00820  P6000-REQUEST-INQUIRE.                                           DTSCS75
00821      SET RESP-SEND-MAP  TO TRUE                                   DTSCS75
00822      MOVE SPACES        TO MAP-TABLE                              DTSCS75
00823      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS75
00824      IF WRK-TS-FOUND-NO                                           DTSCS75
00825         SET LCCM-ENTER-88 TO TRUE.                                DTSCS75
00826                                                                   DTSCS75
00827      IF LCCM-SCR-CLEAR                                            DTSCS75
00828      OR WRK-ADDL-CTR = 0                                          DTSCS75
00829         PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.               DTSCS75
00830                                                                   DTSCS75
00831      MOVE 'I'                        TO LCCM-SCR-STATUS.          DTSCS75
00832      MOVE LCCM-TASK-START-ABSTIME    TO LCCM-SCR-ABSTIME.         DTSCS75
00833      IF LCCM-MSG                                                  DTSCS75
00834         GO TO P6000-EXIT.                                         DTSCS75
00835                                                                   DTSCS75
00836      IF LCCM-F08-88                                               DTSCS75
00837         MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA            DTSCS75
00838      ELSE                                                         DTSCS75
00839         MOVE WRK-TS-KEY(1)           TO ITDS-KEY-AREA             DTSCS75
00840         MOVE WRK-TS-KEY(1)           TO WRK-SCR-TDS-KEY           DTSCS75
00841      END-IF.                                                      DTSCS75
00842                                                                   DTSCS75
00843      MOVE ITDS-DEST-OP-ID TO WRK-DEST-OP-ID                       DTSCS75
00844      MOVE +0 TO WRK-ADDL-CTR                                      DTSCS75
00845                 WRK-CTR                                           DTSCS75
00846      PERFORM S821-START-BROWSE       THRU S821-EXIT.              DTSCS75
00847      IF L821-NO-REC-88                                            DTSCS75
00848         MOVE EMSG-SEARCH-CRITERIA       TO LCCM-MSG-ID            DTSCS75
00849         MOVE LOW-VALUES TO WRK-SCR-KEY-AREA.                      DTSCS75
00850                                                                   DTSCS75
00851 *-NOTE -----------------------------------------------            DTSCS75
00852 *   AT THIS POINT EITHER THE KEY IS OK TO PROCESS OR IN ERROR     DTSCS75
00853 *-----------------------------------------------------            DTSCS75
00854                                                                   DTSCS75
00855      IF LCCM-MSG                                                  DTSCS75
00856         GO TO P6000-EXIT                                          DTSCS75
00857      ELSE                                                         DTSCS75
00858      IF LCCM-ENTER-88                                             DTSCS75
00859          PERFORM P6100-NO-PAGE THRU P6100-EXIT                    DTSCS75
00860      ELSE                                                         DTSCS75
00861      IF LCCM-F07-88                                               DTSCS75
00862          PERFORM P6200-PAGE-BACK THRU P6200-EXIT                  DTSCS75
00863      ELSE                                                         DTSCS75
00864      IF LCCM-F08-88                                               DTSCS75
00865          PERFORM P6300-PAGE-NEXT THRU P6300-EXIT                  DTSCS75
00866      ELSE                                                         DTSCS75
00867          GO TO S899-ABEND.                                        DTSCS75
00868                                                                   DTSCS75
00869      IF L821-OK-88                                                DTSCS75
00870         PERFORM S821-END-BROWSE THRU S821-EXIT                    DTSCS75
00871      END-IF.                                                      DTSCS75
00872                                                                   DTSCS75
00873      IF WRK-CTR > 0                                               DTSCS75
00874         MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L                     DTSCS75
00875         SET CURSOR-SET-YES TO TRUE                                DTSCS75
00876         SET WRK-TS-SCREEN-75-YES TO TRUE                          DTSCS75
00877         MOVE WRK-TS-AREA TO LCCM-SCR-HOLD-AREA                    DTSCS75
00878         SET WRK-TS-FOUND-YES TO TRUE                              DTSCS75
00879         MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A          DTSCS75
00880         MOVE CATB-UNPROT-BRT-NUM-MDTON                            DTSCS75
00881           TO MAP-LINE-NUMBER-A                                    DTSCS75
00882      ELSE                                                         DTSCS75
00883         SET WRK-TS-FOUND-NO TO TRUE                               DTSCS75
00884         MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA                     DTSCS75
00885         MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID.                 DTSCS75
00886  P6000-EXIT.                                                      DTSCS75
00887      EXIT.                                                        DTSCS75
00888                                                                   DTSCS75
00889 /*****************************************************************DTSCS75
00890 * ENTER KEY WAS PRESSED                                          *DTSCS75
00891 ******************************************************************DTSCS75
00892  P6100-NO-PAGE.                                                   DTSCS75
00893                                                                   DTSCS75
00894         MOVE ITDS-KEY-AREA              TO WRK-SCR-TDS-KEY        DTSCS75
00895         MOVE ITDS-KEY-AREA              TO WRK-TS-KEY(1)          DTSCS75
00896         PERFORM P6900-CONSTRUCT-SCREEN     THRU P6900-EXIT        DTSCS75
00897         VARYING WRK-SUB FROM 1 BY 1                               DTSCS75
00898          UNTIL WRK-SUB > 12                                       DTSCS75
00899             OR L821-NO-REC-88.                                    DTSCS75
00900  P6100-EXIT.                                                      DTSCS75
00901      EXIT.                                                        DTSCS75
00902 /*****************************************************************DTSCS75
00903 *                   ////                                         *DTSCS75
00904 ******************************************************************DTSCS75
00905  P6200-PAGE-BACK.                                                 DTSCS75
00906         PERFORM S821-READ-PREV            THRU S821-EXIT          DTSCS75
00907         PERFORM S821-READ-PREV            THRU S821-EXIT          DTSCS75
00908         IF L821-NO-REC-88                                         DTSCS75
00909            MOVE WRK-TS-KEY(1)             TO ITDS-KEY-AREA        DTSCS75
00910            MOVE ITDS-KEY-AREA              TO WRK-SCR-TDS-KEY     DTSCS75
00911            MOVE 1 TO WRK-SUB                                      DTSCS75
00912            PERFORM S821-START-BROWSE THRU S821-EXIT               DTSCS75
00913            PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT         DTSCS75
00914            PERFORM S821-END-BROWSE THRU S821-EXIT                 DTSCS75
00915            MOVE 2 TO WRK-SUB                                      DTSCS75
00916            SET L821-NO-REC-88 TO TRUE                             DTSCS75
00917         ELSE                                                      DTSCS75
00918            MOVE ITDS-KEY-AREA             TO WRK-SCR-TDS-KEY      DTSCS75
00919            MOVE ITDS-KEY-AREA             TO WRK-TS-KEY(1)        DTSCS75
00920            PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT         DTSCS75
00921            VARYING WRK-SUB FROM 1 BY 1                            DTSCS75
00922             UNTIL WRK-SUB > 12                                    DTSCS75
00923              OR L821-NO-REC-88.                                   DTSCS75
00924                                                                   DTSCS75
00925         IF L821-NO-REC-88                                         DTSCS75
00926         AND WRK-ADDL-CTR < 12                                     DTSCS75
00927         MOVE PMSG-FIRST-PAGE         TO LCCM-MSG-ID               DTSCS75
00928         IF WRK-ADDL-CTR = 0                                       DTSCS75
00929            MOVE WRK-TS-KEY(1) TO ITDS-KEY-AREA                    DTSCS75
00930         ELSE                                                      DTSCS75
00931            MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA         DTSCS75
00932         END-IF                                                    DTSCS75
00933         PERFORM S821-START-BROWSE       THRU S821-EXIT            DTSCS75
00934         IF L821-OK-88                                             DTSCS75
00935            PERFORM S821-READ-NEXT         THRU S821-EXIT          DTSCS75
00936            SET LCCM-F08-88 TO TRUE                                DTSCS75
00937            PERFORM P6900-CONSTRUCT-SCREEN     THRU P6900-EXIT     DTSCS75
00938            VARYING WRK-SUB FROM WRK-SUB BY 1                      DTSCS75
00939              UNTIL WRK-SUB > 12                                   DTSCS75
00940                OR L821-NO-REC-88.                                 DTSCS75
00941  P6200-EXIT.                                                      DTSCS75
00942      EXIT.                                                        DTSCS75
00943                                                                   DTSCS75
00944 /*****************************************************************DTSCS75
00945 *                                                                *DTSCS75
00946 ******************************************************************DTSCS75
00947  P6300-PAGE-NEXT.                                                 DTSCS75
00948      PERFORM S821-READ-NEXT         THRU S821-EXIT                DTSCS75
00949      IF L821-NO-REC-88                                            DTSCS75
00950         MOVE WRK-TS-KEY(1)           TO ITDS-KEY-AREA             DTSCS75
00951         PERFORM S821-START-BROWSE       THRU S821-EXIT            DTSCS75
00952         IF L821-NO-REC-88                                         DTSCS75
00953            MOVE EMSG-NO-RECORD       TO LCCM-MSG-ID               DTSCS75
00954         ELSE                                                      DTSCS75
00955            MOVE PMSG-LAST-PAGE         TO LCCM-MSG-ID             DTSCS75
00956            MOVE ISKL-KEY-AREA              TO WRK-SCR-TDS-KEY     DTSCS75
00957            MOVE ISKL-KEY-AREA              TO WRK-TS-KEY(1)       DTSCS75
00958            PERFORM P6900-CONSTRUCT-SCREEN     THRU P6900-EXIT     DTSCS75
00959            VARYING WRK-SUB FROM 1 BY 1                            DTSCS75
00960             UNTIL WRK-SUB > 12                                    DTSCS75
00961               OR L821-NO-REC-88                                   DTSCS75
00962      ELSE                                                         DTSCS75
00963         PERFORM P6900-CONSTRUCT-SCREEN     THRU P6900-EXIT        DTSCS75
00964         VARYING WRK-SUB FROM 1 BY 1                               DTSCS75
00965           UNTIL WRK-SUB > 12                                      DTSCS75
00966             OR L821-NO-REC-88.                                    DTSCS75
00967 * THIS CORRECTS A PROBLEM WITH THE LAST PAGE BEING BLANK          DTSCS75
00968 * ON A PGDN - PROBLEM IS I NEED TO READ THRU X # OF RECORDS       DTSCS75
00969 * LOOKING FOR THE NEXT ONE THAT MEETS THE CRITERIA                DTSCS75
00970 * SO IF I DIDN'T FIND ANY I WANT TO REBUILD THE SCREEN AS IT WAS  DTSCS75
00971      IF WRK-ADDL-CTR = 0                                          DTSCS75
00972         MOVE WRK-TS-KEY(1)           TO ISKL-KEY-AREA             DTSCS75
00973         MOVE PMSG-LAST-PAGE         TO LCCM-MSG-ID                DTSCS75
00974         PERFORM S821-START-BROWSE       THRU S821-EXIT            DTSCS75
00975         IF L821-NO-REC-88                                         DTSCS75
00976            MOVE EMSG-NO-RECORD       TO LCCM-MSG-ID               DTSCS75
00977         ELSE                                                      DTSCS75
00978            MOVE ISKL-KEY-AREA              TO WRK-SCR-TDS-KEY     DTSCS75
00979            MOVE ISKL-KEY-AREA              TO WRK-TS-KEY(1)       DTSCS75
00980            PERFORM P6900-CONSTRUCT-SCREEN     THRU P6900-EXIT     DTSCS75
00981            VARYING WRK-SUB FROM 1 BY 1                            DTSCS75
00982             UNTIL WRK-SUB > 12                                    DTSCS75
00983               OR L821-NO-REC-88.                                  DTSCS75
00984  P6300-EXIT.                                                      DTSCS75
00985      EXIT.                                                        DTSCS75
00986 /*****************************************************************DTSCS75
00987 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS75
00988 ******************************************************************DTSCS75
00989  P6900-CONSTRUCT-SCREEN.                                          DTSCS75
00990                                                                   DTSCS75
00991      SET WRK-REALLY-WANT-IT TO TRUE                               DTSCS75
00992      PERFORM P6910-DO-WE-WANT-IT THRU P6910-EXIT                  DTSCS75
00993      IF WRK-REALLY-DO-NOT-WANT-IT                                 DTSCS75
00994         SUBTRACT 1 FROM WRK-SUB                                   DTSCS75
00995         IF LCCM-F07-88                                            DTSCS75
00996            PERFORM S821-READ-PREV         THRU S821-EXIT          DTSCS75
00997         ELSE                                                      DTSCS75
00998            PERFORM S821-READ-NEXT THRU S821-EXIT                  DTSCS75
00999         END-IF                                                    DTSCS75
01000         GO TO P6900-EXIT                                          DTSCS75
01001      END-IF                                                       DTSCS75
01002                                                                   DTSCS75
01003      ADD 1 TO WRK-ADDL-CTR                                        DTSCS75
01004      IF LCCM-F07-88                                               DTSCS75
01005         PERFORM P6920-PUSH-STACK THRU P6920-EXIT                  DTSCS75
01006          VARYING WRK-CTR FROM WRK-SUB BY -1                       DTSCS75
01007          UNTIL WRK-CTR < 2.                                       DTSCS75
01008                                                                   DTSCS75
01009      IF LCCM-F07-88                                               DTSCS75
01010         COMPUTE WRK-CTR = 1                                       DTSCS75
01011      ELSE                                                         DTSCS75
01012         COMPUTE WRK-CTR = WRK-SUB.                                DTSCS75
01013                                                                   DTSCS75
01014      MOVE SPACES TO MAP-LINE-DATA(WRK-CTR)                        DTSCS75
01015      MOVE ITDS-KEY-AREA              TO WRK-TS-KEY(WRK-CTR)       DTSCS75
01016      PERFORM P6930-READ-FORMAT-TCK THRU P6930-EXIT.               DTSCS75
01017                                                                   DTSCS75
01018                                                                   DTSCS75
01019      MOVE WRK-CTR                      TO MAP-LINE-NO(WRK-CTR).   DTSCS75
01020                                                                   DTSCS75
01021      IF L821-NO-REC-88                                            DTSCS75
01022         GO TO P6900-EXIT.                                         DTSCS75
01023                                                                   DTSCS75
01024      IF LCCM-F07-88                                               DTSCS75
01025         MOVE ITDS-KEY-AREA             TO WRK-TS-KEY(1)           DTSCS75
01026         PERFORM S821-READ-PREV         THRU S821-EXIT             DTSCS75
01027      ELSE                                                         DTSCS75
01028         MOVE ITDS-KEY-AREA             TO WRK-TS-KEY(WRK-ADDL-CTR)DTSCS75
01029         PERFORM S821-READ-NEXT THRU S821-EXIT.                    DTSCS75
01030  P6900-EXIT. EXIT.                                                DTSCS75
01031                                                                   DTSCS75
01032  P6910-DO-WE-WANT-IT.                                             DTSCS75
01033      IF ITDS-TRIGGER-DATE < WRK-TRIGGER-DATE-FROM                 DTSCS75
01034      OR ITDS-TRIGGER-DATE > WRK-TRIGGER-DATE-TO                   DTSCS75
01035         SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE                     DTSCS75
01036         GO TO P6910-EXIT.                                         DTSCS75
01037                                                                   DTSCS75
01038      IF MAP-ACKNOWLEDGED-IND = LOW-VALUES OR SPACES               DTSCS75
01039         GO TO P6910-EXIT                                          DTSCS75
01040      ELSE                                                         DTSCS75
01041      IF MAP-ACKNOWLEDGED-IND  = 'Y'                               DTSCS75
01042      AND ITDS-ACKNOWLEDGED-DATE > +0                              DTSCS75
01043         GO TO P6910-EXIT                                          DTSCS75
01044      ELSE                                                         DTSCS75
01045      IF MAP-ACKNOWLEDGED-IND  = 'N'                               DTSCS75
01046      AND ITDS-ACKNOWLEDGED-DATE = +0                              DTSCS75
01047         GO TO P6910-EXIT                                          DTSCS75
01048      ELSE                                                         DTSCS75
01049         SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE                     DTSCS75
01050         GO TO P6910-EXIT                                          DTSCS75
01051      END-IF.                                                      DTSCS75
01052                                                                   DTSCS75
01053                                                                   DTSCS75
01054      SET WRK-REALLY-DO-NOT-WANT-IT TO TRUE.                       DTSCS75
01055  P6910-EXIT.                                                      DTSCS75
01056      EXIT.                                                        DTSCS75
01057  P6920-PUSH-STACK.                                                DTSCS75
01058      COMPUTE WRK-CTR2 = WRK-CTR - 1                               DTSCS75
01059      MOVE MAP-LINE-DATA(WRK-CTR2) TO MAP-LINE-DATA(WRK-CTR)       DTSCS75
01060      MOVE WRK-TS-KEY(WRK-CTR2) TO WRK-TS-KEY(WRK-CTR)             DTSCS75
01061      MOVE WRK-CTR TO MAP-LINE-NO(WRK-CTR).                        DTSCS75
01062  P6920-EXIT. EXIT.                                                DTSCS75
01063                                                                   DTSCS75
01064  P6930-READ-FORMAT-TCK.                                           DTSCS75
01065      PERFORM P6935-READ-MTCK THRU P6935-EXIT.                     DTSCS75
01066                                                                   DTSCS75
01067      PERFORM P6936-READ-MPRF THRU P6936-EXIT.                     DTSCS75
01068                                                                   DTSCS75
01069      MOVE MPRF-PRIMARY-NAME  TO MAP-PRIMARY-NAME(WRK-CTR)         DTSCS75
01070                                                                   DTSCS75
01071      IF ITDS-ACKNOWLEDGED-DATE > 0                                DTSCS75
01072         MOVE ITDS-ACKNOWLEDGED-DATE TO L001-FED-8-DATE-9          DTSCS75
01073         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCS75
01074         MOVE L001-SLASH-DATE TO MAP-ACKNOWLEDGE-DATE(WRK-CTR)     DTSCS75
01075      END-IF.                                                      DTSCS75
01076                                                                   DTSCS75
01077      MOVE MTCK-TYPE TO MAP-TYPE(WRK-CTR)                          DTSCS75
01078      MOVE MTCK-SOURCE-OP-ID TO MAP-SOURCE(WRK-CTR)                DTSCS75
01079      MOVE MTCK-EMP-NO TO MAP-EMP-NO(WRK-CTR).                     DTSCS75
01080                                                                   DTSCS75
01081      MOVE MTCK-TRIGGER-DATE TO L001-FED-8-DATE-9.                 DTSCS75
01082      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS75
01083      MOVE L001-SLASH-DATE TO MAP-TRIGGER-DATE(WRK-CTR).           DTSCS75
01084                                                                   DTSCS75
01085  P6930-EXIT. EXIT.                                                DTSCS75
01086                                                                   DTSCS75
01087  P6935-READ-MTCK.                                                 DTSCS75
01088      MOVE LOW-VALUES TO MTCK-KEY-AREA.                            DTSCS75
01089      MOVE ITDS-EMP-NO TO MTCK-EMP-NO.                             DTSCS75
01090      MOVE ITDS-ESTB-ABSTIME TO MTCK-ESTB-ABSTIME.                 DTSCS75
01091      SET MTCK-TCK-88 TO TRUE.                                     DTSCS75
01092                                                                   DTSCS75
01093      MOVE MTCK-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS75
01094                                                                   DTSCS75
01095      PERFORM S810-READ THRU S810-EXIT.                            DTSCS75
01096                                                                   DTSCS75
01097      IF L810-NO-REC-88                                            DTSCS75
01098         MOVE MTCK-EMP-NO TO MSG-EMP-NO-IN-ERR                     DTSCS75
01099         MOVE MSG-E751-AREA TO LCCM-MSG-AREA                       DTSCS75
01100         SET LCCM-REQ-SCR-SF-88 TO TRUE                            DTSCS75
01101         SET LCCM-LINK-SCREEN-88 TO TRUE                           DTSCS75
01102         GO TO MAINLINE-EXIT.                                      DTSCS75
01103                                                                   DTSCS75
01104      MOVE MSKL-REC TO MTCK-REC.                                   DTSCS75
01105  P6935-EXIT. EXIT.                                                DTSCS75
01106                                                                   DTSCS75
01107  P6936-READ-MPRF.                                                 DTSCS75
01108      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS75
01109      MOVE ITDS-EMP-NO TO MPRF-EMP-NO.                             DTSCS75
01110      SET MPRF-PRF-88 TO TRUE.                                     DTSCS75
01111                                                                   DTSCS75
01112      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS75
01113                                                                   DTSCS75
01114      PERFORM S810-READ THRU S810-EXIT.                            DTSCS75
01115                                                                   DTSCS75
01116      IF L810-NO-REC-88                                            DTSCS75
01117          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS75
01118          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS75
01119      ELSE                                                         DTSCS75
01120          MOVE MSKL-REC TO MPRF-REC.                               DTSCS75
01121  P6936-EXIT. EXIT.                                                DTSCS75
01122                                                                   DTSCS75
01123 /*****************************************************************DTSCS75
01124 * LINKS TO UTILITY MODULES                                        DTSCS75
01125 ******************************************************************DTSCS75
01126                                                                   DTSCS75
01127  S001-FROM-FED-8.                                                 DTSCS75
01128      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS75
01129      GO TO S001-DATE.                                             DTSCS75
01130                                                                   DTSCS75
01131                                                                   DTSCS75
01132  S001-DATE.                                                       DTSCS75
01133      EXEC CICS LINK                                               DTSCS75
01134          PROGRAM('DTSCU001')                                      DTSCS75
01135          COMMAREA(L001-COMM-AREA)                                 DTSCS75
01136      END-EXEC.                                                    DTSCS75
01137  S001-EXIT.                                                       DTSCS75
01138      EXIT.                                                        DTSCS75
01139                                                                   DTSCS75
01140                                                                   DTSCS75
01141  S015-DATE-FROM-SCREEN.                                           DTSCS75
01142      EXEC CICS LINK                                               DTSCS75
01143          PROGRAM('DTSCU015')                                      DTSCS75
01144          COMMAREA(L015-COMM-AREA)                                 DTSCS75
01145      END-EXEC.                                                    DTSCS75
01146  S015-EXIT.                                                       DTSCS75
01147      EXIT.                                                        DTSCS75
01148                                                                   DTSCS75
01149  S803-REQ-SCR-ID-EDIT.                                            DTSCS75
01150      EXEC CICS LINK                                               DTSCS75
01151          PROGRAM ('DTSCU803')                                     DTSCS75
01152          COMMAREA (DFHCOMMAREA)                                   DTSCS75
01153      END-EXEC.                                                    DTSCS75
01154  S803-EXIT.                                                       DTSCS75
01155      EXIT.                                                        DTSCS75
01156                                                                   DTSCS75
01157  S804-INVALID-KEY.                                                DTSCS75
01158      EXEC CICS LINK                                               DTSCS75
01159          PROGRAM ('DTSCU804')                                     DTSCS75
01160          COMMAREA (DFHCOMMAREA)                                   DTSCS75
01161      END-EXEC.                                                    DTSCS75
01162  S804-EXIT.                                                       DTSCS75
01163      EXIT.                                                        DTSCS75
01164                                                                   DTSCS75
01165  S805-MSG-AREA.                                                   DTSCS75
01166      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS75
01167                                                                   DTSCS75
01168      EXEC CICS LINK                                               DTSCS75
01169          PROGRAM ('DTSCU805')                                     DTSCS75
01170          COMMAREA (L805-COMM-AREA)                                DTSCS75
01171      END-EXEC.                                                    DTSCS75
01172                                                                   DTSCS75
01173      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS75
01174  S805-EXIT.                                                       DTSCS75
01175      EXIT.                                                        DTSCS75
01176      EJECT                                                        DTSCS75
01177  S810-READ.                                                       DTSCS75
01178      SET L810-READ-88 TO TRUE.                                    DTSCS75
01179      GO TO S810-IO.                                               DTSCS75
01180                                                                   DTSCS75
01181  S810-START-BROWSE.                                               DTSCS75
01182      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS75
01183      GO TO S810-IO.                                               DTSCS75
01184                                                                   DTSCS75
01185  S810-READ-NEXT.                                                  DTSCS75
01186      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS75
01187      GO TO S810-IO.                                               DTSCS75
01188                                                                   DTSCS75
01189  S810-READ-PREV.                                                  DTSCS75
01190      SET L810-READ-PREV-88 TO TRUE.                               DTSCS75
01191      GO TO S810-IO.                                               DTSCS75
01192                                                                   DTSCS75
01193  S810-END-BROWSE.                                                 DTSCS75
01194      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS75
01195      GO TO S810-IO.                                               DTSCS75
01196                                                                   DTSCS75
01197  S810-COUNT.                                                      DTSCS75
01198      SET L810-COUNT-88 TO TRUE.                                   DTSCS75
01199      GO TO S810-IO.                                               DTSCS75
01200                                                                   DTSCS75
01201  S810-REWRITE.                                                    DTSCS75
01202      SET L810-REWRITE-88 TO TRUE.                                 DTSCS75
01203      GO TO S810-IO.                                               DTSCS75
01204                                                                   DTSCS75
01205  S810-WRITE.                                                      DTSCS75
01206      SET L810-WRITE-88 TO TRUE.                                   DTSCS75
01207      GO TO S810-IO.                                               DTSCS75
01208                                                                   DTSCS75
01209  S810-DELETE.                                                     DTSCS75
01210      SET L810-DELETE-88 TO TRUE.                                  DTSCS75
01211      GO TO S810-IO.                                               DTSCS75
01212                                                                   DTSCS75
01213  S810-IO.                                                         DTSCS75
01214                                                                   DTSCS75
01215      EXEC CICS LINK                                               DTSCS75
01216          PROGRAM ('DTSCU810')                                     DTSCS75
01217          COMMAREA (L810-COMM-AREA)                                DTSCS75
01218      END-EXEC.                                                    DTSCS75
01219                                                                   DTSCS75
01220      IF L810-FILE-CLOSED-88                                       DTSCS75
01221          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS75
01222          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS75
01223          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS75
01224          GO TO MAINLINE-EXIT.                                     DTSCS75
01225  S810-EXIT.                                                       DTSCS75
01226      EXIT.                                                        DTSCS75
01227      EJECT                                                        DTSCS75
01228  S821-START-BROWSE.                                               DTSCS75
01229      SET L821-START-BROWSE-88 TO TRUE.                            DTSCS75
01230      GO TO S821-MASTER-IO.                                        DTSCS75
01231  S821-END-BROWSE.                                                 DTSCS75
01232      SET L821-END-BROWSE-88 TO TRUE.                              DTSCS75
01233      GO TO S821-MASTER-IO.                                        DTSCS75
01234  S821-READ-PREV.                                                  DTSCS75
01235      SET L821-READ-PREV-88 TO TRUE.                               DTSCS75
01236      GO TO S821-MASTER-IO.                                        DTSCS75
01237  S821-READ-NEXT.                                                  DTSCS75
01238      SET L821-READ-NEXT-88 TO TRUE.                               DTSCS75
01239      GO TO S821-MASTER-IO.                                        DTSCS75
01240  S821-MASTER-IO.                                                  DTSCS75
01241      EXEC CICS LINK                                               DTSCS75
01242          PROGRAM ('DTSCU821')                                     DTSCS75
01243          COMMAREA (L821-COMM-AREA)                                DTSCS75
01244      END-EXEC.                                                    DTSCS75
01245      IF L821-FILE-CLOSED-88                                       DTSCS75
01246          MOVE L821-MSG-AREA TO LCCM-MSG-AREA                      DTSCS75
01247          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS75
01248          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS75
01249          GO TO MAINLINE-EXIT                                      DTSCS75
01250      ELSE                                                         DTSCS75
01251         PERFORM S821A-SIMULATE-NO-REC THRU S821A-EXIT.            DTSCS75
01252  S821-EXIT. EXIT.                                                 DTSCS75
01253                                                                   DTSCS75
01254  S821A-SIMULATE-NO-REC.                                           DTSCS75
01255      IF NOT L821-OK-88                                            DTSCS75
01256         GO TO S821A-EXIT.                                         DTSCS75
01257                                                                   DTSCS75
01258      IF (ITDS-TDS-88)                                             DTSCS75
01259      AND ITDS-DEST-OP-ID  NOT = WRK-DEST-OP-ID                    DTSCS75
01260         SET L821-END-BROWSE-88 TO TRUE                            DTSCS75
01261         EXEC CICS LINK                                            DTSCS75
01262              PROGRAM ('DTSCU821')                                 DTSCS75
01263              COMMAREA (L821-COMM-AREA)                            DTSCS75
01264         END-EXEC                                                  DTSCS75
01265         IF WRK-ADDL-CTR > 0                                       DTSCS75
01266            MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA         DTSCS75
01267         END-IF                                                    DTSCS75
01268         SET L821-NO-REC-88 TO TRUE                                DTSCS75
01269         GO TO S821A-EXIT.                                         DTSCS75
01270 * I BELIEVE THAT WE CAN SET A BREAK ON RANGE OF DATES             DTSCS75
01271      IF ITDS-TRIGGER-DATE < WRK-TRIGGER-DATE-FROM                 DTSCS75
01272         SET L821-END-BROWSE-88 TO TRUE                            DTSCS75
01273         EXEC CICS LINK                                            DTSCS75
01274              PROGRAM ('DTSCU821')                                 DTSCS75
01275              COMMAREA (L821-COMM-AREA)                            DTSCS75
01276         END-EXEC                                                  DTSCS75
01277         IF WRK-ADDL-CTR > 0                                       DTSCS75
01278            MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA         DTSCS75
01279         END-IF                                                    DTSCS75
01280         SET L821-NO-REC-88 TO TRUE                                DTSCS75
01281         GO TO S821A-EXIT.                                         DTSCS75
01282                                                                   DTSCS75
01283      IF ITDS-TRIGGER-DATE > WRK-TRIGGER-DATE-TO                   DTSCS75
01284      AND (NOT LCCM-F07-88)                                        DTSCS75
01285         SET L821-END-BROWSE-88 TO TRUE                            DTSCS75
01286         EXEC CICS LINK                                            DTSCS75
01287              PROGRAM ('DTSCU821')                                 DTSCS75
01288              COMMAREA (L821-COMM-AREA)                            DTSCS75
01289         END-EXEC                                                  DTSCS75
01290         IF WRK-ADDL-CTR > 0                                       DTSCS75
01291            MOVE WRK-TS-KEY(WRK-ADDL-CTR) TO ITDS-KEY-AREA         DTSCS75
01292         END-IF                                                    DTSCS75
01293         SET L821-NO-REC-88 TO TRUE                                DTSCS75
01294         GO TO S821A-EXIT.                                         DTSCS75
01295  S821A-EXIT. EXIT.                                                DTSCS75
01296                                                                   DTSCS75
01297                                                                   DTSCS75
01298  S891-WRITE-TS.                                                   DTSCS75
01299      MOVE WRK-TS-AREA TO LCCM-SCR-HOLD-AREA.                      DTSCS75
01300  S891-EXIT. EXIT.                                                 DTSCS75
01301                                                                   DTSCS75
01302  S851-SCREEN-PROCESSING.                                          DTSCS75
01303      EXEC CICS LINK                                               DTSCS75
01304          PROGRAM ('DTSCU851')                                     DTSCS75
01305          COMMAREA (L851-COMM-AREA)                                DTSCS75
01306      END-EXEC.                                                    DTSCS75
01307  S851-EXIT.                                                       DTSCS75
01308      EXIT.                                                        DTSCS75
01309                                                                   DTSCS75
01310  S899-ABEND.                                                      DTSCS75
01311      EXEC CICS ABEND                                              DTSCS75
01312          ABCODE(WRK-ABEND-CD)                                     DTSCS75
01313      END-EXEC.                                                    DTSCS75
01314  S899-EXIT.                                                       DTSCS75
01315      EXIT.                                                        DTSCS75
01316 /*****************************************************************DTSCS75
01317 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS75
01318 ******************************************************************DTSCS75
01319                                                                   DTSCS75
01320  S1000-SCREEN-EDITS.                                              DTSCS75
01321                                                                   DTSCS75
01322      MOVE +0  TO WRK-CTR                                          DTSCS75
01323      PERFORM S1100-DEST-OP-ID         THRU S1100-EXIT.            DTSCS75
01324      PERFORM S1200-ACKNOWLEDGED-IND   THRU S1200-EXIT.            DTSCS75
01325      PERFORM S1300-TRIGGER-DATE-RANGE THRU S1300-EXIT.            DTSCS75
01326                                                                   DTSCS75
01327  S1000-EXIT. EXIT.                                                DTSCS75
01328      EJECT                                                        DTSCS75
01329 /**************************************************************** DTSCS75
01330 *  EDIT DEST-OP-ID REQUIRED                                       DTSCS75
01331 *  WASN'T SURE WE WANTED RESTRICTIONS INCLUDE OR COMMENT OUT      DTSCS75
01332 ***************************************************************** DTSCS75
01333  S1100-DEST-OP-ID.                                                DTSCS75
01334      IF MAP-DEST-OP-ID = LOW-VALUES OR SPACES                     DTSCS75
01335 ***********MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA           DTSCS75
01336 ***********PERFORM S1101-ERROR          THRU S1101-EXIT           DTSCS75
01337 ***********GO TO S1100-EXIT.                                      DTSCS75
01338                                                                   DTSCS75
01339          MOVE LCCM-OP-ID TO MAP-DEST-OP-ID.                       DTSCS75
01340                                                                   DTSCS75
01341      MOVE LOW-VALUES TO ITDS-KEY-AREA                             DTSCS75
01342      SET ITDS-TDS-88 TO TRUE                                      DTSCS75
01343      MOVE MAP-DEST-OP-ID TO ITDS-DEST-OP-ID                       DTSCS75
01344                                 WRK-DEST-OP-ID                    DTSCS75
01345         MOVE ZEROS TO ITDS-TRIGGER-DATE                           DTSCS75
01346                       ITDS-ESTB-ABSTIME                           DTSCS75
01347                       ITDS-TYPE                                   DTSCS75
01348                       ITDS-ACKNOWLEDGED-DATE                      DTSCS75
01349                       ITDS-EMP-NO                                 DTSCS75
01350            MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1).                   DTSCS75
01351  S1100-EXIT. EXIT.                                                DTSCS75
01352                                                                   DTSCS75
01353  S1101-ERROR.                                                     DTSCS75
01354      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DEST-OP-ID-A           DTSCS75
01355      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
01356      IF LCCM-NO-MSG                                               DTSCS75
01357         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS75
01358         MOVE CATB-CURSOR              TO MAP-DEST-OP-ID-L.        DTSCS75
01359  S1101-EXIT. EXIT.                                                DTSCS75
01360                                                                   DTSCS75
01361                                                                   DTSCS75
01362 /**************************************************************** DTSCS75
01363 *  ACTIVE ASSIGNMENTS INCLUDED IN SEARCH                          DTSCS75
01364 ***************************************************************** DTSCS75
01365  S1200-ACKNOWLEDGED-IND.                                          DTSCS75
01366      MOVE SPACES TO WRK-ACKNOWLEDGED-IND                          DTSCS75
01367      IF MAP-ACKNOWLEDGED-IND = LOW-VALUES OR SPACES               DTSCS75
01368         MOVE 'N' TO WRK-ACKNOWLEDGED-IND                          DTSCS75
01369         MOVE 'N' TO MAP-ACKNOWLEDGED-IND                          DTSCS75
01370      ELSE                                                         DTSCS75
01371      IF MAP-ACKNOWLEDGED-VALID                                    DTSCS75
01372         MOVE MAP-ACKNOWLEDGED-IND TO WRK-ACKNOWLEDGED-IND         DTSCS75
01373      ELSE                                                         DTSCS75
01374         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS75
01375         PERFORM S1201-ERROR THRU S1201-EXIT.                      DTSCS75
01376  S1200-EXIT. EXIT.                                                DTSCS75
01377                                                                   DTSCS75
01378  S1201-ERROR.                                                     DTSCS75
01379      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACKNOWLEDGED-IND-A     DTSCS75
01380      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
01381      IF LCCM-NO-MSG                                               DTSCS75
01382         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS75
01383         MOVE CATB-CURSOR              TO MAP-ACKNOWLEDGED-IND-L.  DTSCS75
01384  S1201-EXIT. EXIT.                                                DTSCS75
01385 /**************************************************************** DTSCS75
01386 * A PARTICULAR RANGE OF DATES INCLUDED IN SEARCH                  DTSCS75
01387 ***************************************************************** DTSCS75
01388  S1300-TRIGGER-DATE-RANGE.                                        DTSCS75
01389      MOVE +0 TO WRK-TRIGGER-DATE-FROM                             DTSCS75
01390      MOVE +99999999 TO WRK-TRIGGER-DATE-TO                        DTSCS75
01391                                                                   DTSCS75
01392      MOVE MAP-TRIGGER-DATE-FROM-AREA TO L015-S-DATE-AREA.         DTSCS75
01393      PERFORM S015-DATE-FROM-SCREEN   THRU S015-EXIT.              DTSCS75
01394                                                                   DTSCS75
01395      IF L015-NO-ENTRY                                             DTSCS75
01396         MOVE +0 TO WRK-TRIGGER-DATE-FROM                          DTSCS75
01397      ELSE                                                         DTSCS75
01398      IF L015-NOT-VALID                                            DTSCS75
01399         MOVE +0 TO WRK-TRIGGER-DATE-FROM                          DTSCS75
01400         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS75
01401         PERFORM S1301-ERROR          THRU S1301-EXIT              DTSCS75
01402      ELSE                                                         DTSCS75
01403         MOVE L015-DATE TO WRK-TRIGGER-DATE-FROM                   DTSCS75
01404      END-IF.                                                      DTSCS75
01405                                                                   DTSCS75
01406      MOVE MAP-TRIGGER-DATE-TO-AREA   TO L015-S-DATE-AREA.         DTSCS75
01407      PERFORM S015-DATE-FROM-SCREEN   THRU S015-EXIT.              DTSCS75
01408                                                                   DTSCS75
01409      IF L015-NO-ENTRY                                             DTSCS75
01410         MOVE +99999999 TO WRK-TRIGGER-DATE-TO                     DTSCS75
01411      ELSE                                                         DTSCS75
01412      IF L015-NOT-VALID                                            DTSCS75
01413         MOVE +99999999 TO WRK-TRIGGER-DATE-TO                     DTSCS75
01414         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS75
01415         PERFORM S1302-ERROR          THRU S1302-EXIT              DTSCS75
01416      ELSE                                                         DTSCS75
01417         MOVE L015-DATE TO WRK-TRIGGER-DATE-TO                     DTSCS75
01418      END-IF.                                                      DTSCS75
01419                                                                   DTSCS75
01420      IF WRK-TRIGGER-DATE-TO < WRK-TRIGGER-DATE-FROM               DTSCS75
01421         MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS75
01422         PERFORM S1301-ERROR          THRU S1301-EXIT              DTSCS75
01423         PERFORM S1302-ERROR          THRU S1302-EXIT              DTSCS75
01424      END-IF.                                                      DTSCS75
01425      MOVE WRK-TRIGGER-DATE-FROM TO ITDS-TRIGGER-DATE.             DTSCS75
01426      MOVE ITDS-KEY-AREA TO WRK-TS-KEY(1).                         DTSCS75
01427  S1300-EXIT. EXIT.                                                DTSCS75
01428                                                                   DTSCS75
01429  S1301-ERROR.                                                     DTSCS75
01430      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS75
01431                                   TO MAP-TRIGGER-DATE-FROM-YR-A   DTSCS75
01432                                      MAP-TRIGGER-DATE-FROM-MO-A   DTSCS75
01433                                      MAP-TRIGGER-DATE-FROM-DA-A   DTSCS75
01434      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
01435      IF LCCM-NO-MSG                                               DTSCS75
01436         MOVE WRK-MSG-AREA         TO LCCM-MSG-AREA                DTSCS75
01437         MOVE CATB-CURSOR          TO MAP-TRIGGER-DATE-FROM-MO-L.  DTSCS75
01438  S1301-EXIT. EXIT.                                                DTSCS75
01439                                                                   DTSCS75
01440  S1302-ERROR.                                                     DTSCS75
01441      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TRIGGER-DATE-TO-YR-A  DTSCS75
01442                                         MAP-TRIGGER-DATE-TO-MO-A  DTSCS75
01443                                         MAP-TRIGGER-DATE-TO-DA-A  DTSCS75
01444      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
01445      IF LCCM-NO-MSG                                               DTSCS75
01446         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS75
01447         MOVE CATB-CURSOR              TO MAP-TRIGGER-DATE-TO-MO-L.DTSCS75
01448  S1302-EXIT. EXIT.                                                DTSCS75
01449                                                                   DTSCS75
01450 /**************************************************************** DTSCS75
01451 *  SCREEN SELECT AND LINE NUMBER ERROR ROUTINES                   DTSCS75
01452 ***************************************************************** DTSCS75
01453  S1901-MAP-LINE-ERROR.                                            DTSCS75
01454      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LINE-NUMBER-A         DTSCS75
01455      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
01456      IF LCCM-NO-MSG                                               DTSCS75
01457         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS75
01458         MOVE CATB-CURSOR              TO MAP-LINE-NUMBER-L.       DTSCS75
01459  S1901-EXIT. EXIT.                                                DTSCS75
01460                                                                   DTSCS75
01461  S2001-SELECT-SCREEN-ERROR.                                       DTSCS75
01462      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SCREEN-ID-A            DTSCS75
01463      SET CURSOR-SET-YES TO TRUE.                                  DTSCS75
01464      IF LCCM-NO-MSG                                               DTSCS75
01465         MOVE WRK-MSG-AREA             TO LCCM-MSG-AREA            DTSCS75
01466         MOVE CATB-CURSOR              TO MAP-SCREEN-ID-L.         DTSCS75
01467  S2001-EXIT. EXIT.                                                DTSCS75
01468 ******************************************************************DTSCS75
01469 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS75
01470 ******************************************************************DTSCS75
01471  S5300-SET-INQ-ATTRB.                                             DTSCS75
01472      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS75
01473                                    WRK-ATB-NUM.                   DTSCS75
01474                                                                   DTSCS75
01475      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS75
01476  S5300-EXIT.                                                      DTSCS75
01477      EXIT.                                                        DTSCS75
01478                                                                   DTSCS75
01479  S5900-SET-ATTRB.                                                 DTSCS75
01480      MOVE LOW-VALUES TO                 MAP-DEST-OP-ID-A          DTSCS75
01481                                         MAP-ACKNOWLEDGED-IND-A    DTSCS75
01482                                         MAP-TRIGGER-DATE-FROM-YR-ADTSCS75
01483                                         MAP-TRIGGER-DATE-FROM-MO-ADTSCS75
01484                                         MAP-TRIGGER-DATE-FROM-DA-ADTSCS75
01485                                         MAP-TRIGGER-DATE-TO-YR-A  DTSCS75
01486                                         MAP-TRIGGER-DATE-TO-MO-A  DTSCS75
01487                                         MAP-TRIGGER-DATE-TO-DA-A  DTSCS75
01488      PERFORM S5910-TABLE THRU S5910-EXIT                          DTSCS75
01489      VARYING WRK-CTR FROM 1 BY 1                                  DTSCS75
01490      UNTIL WRK-CTR > 12.                                          DTSCS75
01491      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS75
01492  S5900-EXIT. EXIT.                                                DTSCS75
01493                                                                   DTSCS75
01494  S5910-TABLE.                                                     DTSCS75
01495      MOVE CATB-ASKIP-BRT-MDTON TO MAP-LINE-A(WRK-CTR).            DTSCS75
01496  S5910-EXIT. EXIT.                                                DTSCS75
01497 /***************************************************************  DTSCS75
01498 * THESE ATTRIBUTES ARE BUILT PRIOR TO THE SEND BASED ON THE       DTSCS75
01499 * SEARCH RESULTS AND SCREEN STATUS                                DTSCS75
01500 ****************************************************************  DTSCS75
01501  S5920-ATTRIBUTES.                                                DTSCS75
01502      IF WRK-TS-FOUND-YES                                          DTSCS75
01503          MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SCREEN-ID-A         DTSCS75
01504      ELSE                                                         DTSCS75
01505      IF WRK-TS-FOUND-NO                                           DTSCS75
01506         MOVE CATB-ASKIP-NORM-MDTON TO MAP-SCREEN-ID-A.            DTSCS75
01507                                                                   DTSCS75
01508      IF WRK-TS-FOUND-YES                                          DTSCS75
01509          MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-LINE-NUMBER-A      DTSCS75
01510      ELSE                                                         DTSCS75
01511      IF WRK-TS-FOUND-NO                                           DTSCS75
01512         MOVE CATB-ASKIP-NORM-MDTON TO MAP-LINE-NUMBER-A.          DTSCS75
01513                                                                   DTSCS75
01514      IF WRK-TS-FOUND-NO AND MAP-DEST-OP-ID-A = LOW-VALUES         DTSCS75
01515          MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-DEST-OP-ID-A        DTSCS75
01516      ELSE                                                         DTSCS75
01517      IF WRK-TS-FOUND-YES                                          DTSCS75
01518         MOVE CATB-ASKIP-NORM-MDTON      TO MAP-DEST-OP-ID-A.      DTSCS75
01519                                                                   DTSCS75
01520      IF WRK-TS-FOUND-NO AND MAP-ACKNOWLEDGED-IND-A = LOW-VALUES   DTSCS75
01521          MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-ACKNOWLEDGED-IND-A  DTSCS75
01522      ELSE                                                         DTSCS75
01523      IF WRK-TS-FOUND-YES                                          DTSCS75
01524         MOVE CATB-ASKIP-NORM-MDTON    TO MAP-ACKNOWLEDGED-IND-A.  DTSCS75
01525                                                                   DTSCS75
01526      IF WRK-TS-FOUND-NO                                           DTSCS75
01527      AND MAP-TRIGGER-DATE-FROM-MO-A = LOW-VALUES                  DTSCS75
01528          MOVE CATB-UNPROT-BRT-NUM-MDTON                           DTSCS75
01529            TO MAP-TRIGGER-DATE-FROM-MO-A                          DTSCS75
01530          MOVE CATB-UNPROT-BRT-NUM-MDTON                           DTSCS75
01531            TO MAP-TRIGGER-DATE-FROM-DA-A                          DTSCS75
01532          MOVE CATB-UNPROT-BRT-NUM-MDTON                           DTSCS75
01533            TO MAP-TRIGGER-DATE-FROM-YR-A                          DTSCS75
01534      ELSE                                                         DTSCS75
01535      IF WRK-TS-FOUND-YES                                          DTSCS75
01536         MOVE CATB-ASKIP-NORM-MDTON                                DTSCS75
01537            TO MAP-TRIGGER-DATE-FROM-MO-A                          DTSCS75
01538         MOVE CATB-ASKIP-NORM-MDTON                                DTSCS75
01539            TO MAP-TRIGGER-DATE-FROM-DA-A                          DTSCS75
01540         MOVE CATB-ASKIP-NORM-MDTON TO MAP-TRIGGER-DATE-FROM-YR-A. DTSCS75
01541                                                                   DTSCS75
01542      IF WRK-TS-FOUND-NO                                           DTSCS75
01543       AND MAP-TRIGGER-DATE-TO-MO-A = LOW-VALUES                   DTSCS75
01544          MOVE CATB-UNPROT-BRT-NUM-MDTON                           DTSCS75
01545            TO MAP-TRIGGER-DATE-TO-MO-A                            DTSCS75
01546          MOVE CATB-UNPROT-BRT-NUM-MDTON                           DTSCS75
01547            TO MAP-TRIGGER-DATE-TO-DA-A                            DTSCS75
01548          MOVE CATB-UNPROT-BRT-NUM-MDTON                           DTSCS75
01549            TO MAP-TRIGGER-DATE-TO-YR-A                            DTSCS75
01550      ELSE                                                         DTSCS75
01551      IF WRK-TS-FOUND-YES                                          DTSCS75
01552         MOVE CATB-ASKIP-NORM-MDTON                                DTSCS75
01553            TO MAP-TRIGGER-DATE-TO-MO-A                            DTSCS75
01554         MOVE CATB-ASKIP-NORM-MDTON                                DTSCS75
01555            TO MAP-TRIGGER-DATE-TO-DA-A                            DTSCS75
01556         MOVE CATB-ASKIP-NORM-MDTON                                DTSCS75
01557            TO MAP-TRIGGER-DATE-TO-YR-A.                           DTSCS75
01558                                                                   DTSCS75
01559  S5920-EXIT. EXIT.                                                DTSCS75
01560      EJECT                                                        DTSCS75
01561 /*****************************************************************DTSCS75
01562 * MAP ROUTINES                                                   *DTSCS75
01563 ******************************************************************DTSCS75
01564  S9100-RECEIVE.                                                   DTSCS75
01565      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS75
01566                                                                   DTSCS75
01567      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS75
01568                                                                   DTSCS75
01569      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS75
01570                                                                   DTSCS75
01571      MOVE L851-AID TO LCCM-AID.                                   DTSCS75
01572      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS75
01573  S9100-EXIT.                                                      DTSCS75
01574      EXIT.                                                        DTSCS75
01575                                                                   DTSCS75
01576  S9200-SEND-DATAONLY.                                             DTSCS75
01577      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS75
01578                                                                   DTSCS75
01579      IF LCCM-NO-MSG                                               DTSCS75
01580          NEXT SENTENCE                                            DTSCS75
01581      ELSE                                                         DTSCS75
01582          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS75
01583                                                                   DTSCS75
01584      IF CURSOR-SET-GOTO                                           DTSCS75
01585          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS75
01586      ELSE                                                         DTSCS75
01587      IF CURSOR-SET-NO                                             DTSCS75
01588          MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L.                    DTSCS75
01589                                                                   DTSCS75
01590      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS75
01591                                                                   DTSCS75
01592      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS75
01593                                                                   DTSCS75
01594      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS75
01595  S9200-EXIT.                                                      DTSCS75
01596      EXIT.                                                        DTSCS75
01597                                                                   DTSCS75
01598  S9300-SEND-MAP.                                                  DTSCS75
01599      PERFORM S5920-ATTRIBUTES THRU S5920-EXIT.                    DTSCS75
01600      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS75
01601      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS75
01602      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS75
01603      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS75
01604                                                                   DTSCS75
01605      IF SCR-ACCESS-UPDATE                                         DTSCS75
01606          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS75
01607      ELSE                                                         DTSCS75
01608          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS75
01609                                                                   DTSCS75
01610      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS75
01611                                                                   DTSCS75
01612      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS75
01613                                                                   DTSCS75
01614      IF CURSOR-SET-NO                                             DTSCS75
01615          MOVE CATB-CURSOR TO MAP-DEST-OP-ID-L.                    DTSCS75
01616                                                                   DTSCS75
01617      SET L851-SEND-88 TO TRUE.                                    DTSCS75
01618                                                                   DTSCS75
01619      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS75
01620                                                                   DTSCS75
01621      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS75
01622  S9300-EXIT.                                                      DTSCS75
01623      EXIT.                                                        DTSCS75
01624                                                                   DTSCS75
01625  S9310-UPDATE-FKEYS.                                              DTSCS75
01626      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS75
01627                                                                   DTSCS75
01628  S9310-EXIT.                                                      DTSCS75
01629      EXIT.                                                        DTSCS75
01630                                                                   DTSCS75
01631  S9320-INQUIRY-FKEYS.                                             DTSCS75
01632      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS75
01633      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS75
01634      MOVE CFKD-NEW-SEARCH TO MAP-KEY-TICK-INQ.                    DTSCS75
01635                                                                   DTSCS75
01636 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS75
01637  S9320-EXIT.                                                      DTSCS75
01638      EXIT.                                                        DTSCS75
01639                                                                   DTSCS75
01640 *S9321-JUMP-KEYS.                                                 DTSCS75
01641 *****MOVE CFKD-REG-INQ       TO MAP-KEY-REG-INQ.                  DTSCS75
01642 *****MOVE CFKD-COLL-INQ      TO MAP-KEY-COLL-INQ.                 DTSCS75
01643 *****MOVE CFKD-QTR-INQ       TO MAP-KEY-QTR-INQ.                  DTSCS75
01644 *****MOVE CFKD-TICK-INQ      TO MAP-KEY-TICK-INQ.                 DTSCS75
01645 *S9321-EXIT.                                                      DTSCS75
01646 *****EXIT.                                                        DTSCS75
01647                                                                   DTSCS75
01648  S9330-DSCR-FIELDS.                                               DTSCS75
01649  S9330-EXIT. EXIT.                                                DTSCS75
01650                                                                   DTSCS75
01651                                                                   DTSCS75
01652  S9900-PREPARE-SEND.                                              DTSCS75
01653      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS75
01654                         LCCM-SCR-ID.                              DTSCS75
01655      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS75
01656      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS75
01657  S9900-EXIT.                                                      DTSCS75
01658      EXIT.                                                        DTSCS75
