00001  IDENTIFICATION DIVISION.                                         08/15/02
00002  PROGRAM-ID.             DTSCS8A.                                 DTSCS8A
00003  AUTHOR.                 TRW.                                        LV003
00004  DATE-WRITTEN.           OCT 2001.                                DTSCS8A
00005  DATE-COMPILED.                                                   DTSCS8A
00006      SKIP3                                                        DTSCS8A
00007 *****                                                             DTSCS8A
00008 *                                                                 DTSCS8A
00009 *    FUNCTION:  ONLINE JOB REQUEST INQUIRY PROGRAM.               DTSCS8A
00010 *                                                                 DTSCS8A
00011 *                                                                 DTSCS8A
00012 *    MODIFICATION LOG:                                            DTSCS8A
00013 *                                                                 DTSCS8A
00014 *    11/20/01  INITIAL DEVELOPMENT.     COPIED FROM DTSCS86 & 68  DTSCS8A
00015 *              WORK ORDER:                      PROGRAMMER: JMO.  DTSCS8A
00016 *                                                                 DTSCS8A
00017 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS8A
00018 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS8A
00019 *              WORK ORDER:                      PROGRAMMER: XXX   DTSCS8A
00020 *                                                                 DTSCS8A
00021 *                                                                 DTSCS8A
00022 *  DESCRIPTION:                                                   DTSCS8A
00023 *                                                                 DTSCS8A
00024 *    CLEAR:                                                       DTSCS8A
00025 *                                                                 DTSCS8A
00026 *      DATA FIELDS DISPLAYED: NONE.                               DTSCS8A
00027 *      MESSAGE: NONE                                              DTSCS8A
00028 *                                                                 DTSCS8A
00029 *                                                                 DTSCS8A
00030 *    INQUIRY:                                                     DTSCS8A
00031 *                                                                 DTSCS8A
00032 *      CONTROL FIELD(S): BUSINESS AREA                            DTSCS8A
00033 *                                                                 DTSCS8A
00034 *      JUMP IN: USE CLEAR LOGIC.                                  DTSCS8A
00035 *                                                                 DTSCS8A
00036 *      ENTER: DISPLAY ALL JOBS AVAILABLE FOR ONLINE SUBMISSION    DTSCS8A
00037 *             FIELDS.                                             DTSCS8A
00038 *                                                                 DTSCS8A
00039 *      PRIOR: USING THE SUBSCRIPTS FROM THE COMMAREA              DTSCS8A
00040 *             DECREMENT SUB AND BUILD SCREEN                      DTSCS8A
00041 *                                                                 DTSCS8A
00042 *      NEXT:  USING THE SUBSCRIPTS FROM THE COMMAREA              DTSCS8A
00043 *             INCREMENT SUB AND BUILD SCREEN                      DTSCS8A
00044 *                                                                 DTSCS8A
00045 *                                                                 DTSCS8A
00046 *      WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS8A
00047 *      DO NOT "WRAP" PAGING.                                      DTSCS8A
00048 *                                                                 DTSCS8A
00049 *                                                                 DTSCS8A
00050 *                                                                 DTSCS8A
00051 *    UPDATE:                                                      DTSCS8A
00052 *                                                                 DTSCS8A
00053 *      NONE                                                       DTSCS8A
00054 *                                                                 DTSCS8A
00055 *                                                                 DTSCS8A
00056 *    RECORDS READ:                                                DTSCS8A
00057 *                                                                 DTSCS8A
00058 *      MASTER:                                                    DTSCS8A
00059 *                                                                 DTSCS8A
00060 *        NONE.                                                    DTSCS8A
00061 *                                                                 DTSCS8A
00062 *                                                                 DTSCS8A
00063 *      ALTERNATE INDEX:                                           DTSCS8A
00064 *                                                                 DTSCS8A
00065 *        NONE.                                                    DTSCS8A
00066 *                                                                 DTSCS8A
00067 *                                                                 DTSCS8A
00068 *      REFERENCE:                                                 DTSCS8A
00069 *                                                                 DTSCS8A
00070 *        NONE.                                                    DTSCS8A
00071 *                                                                 DTSCS8A
00072 *                                                                 DTSCS8A
00073 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS8A
00074 *                                                                 DTSCS8A
00075 *        NONE.                                                    DTSCS8A
00076 *                                                                 DTSCS8A
00077 *                                                                 DTSCS8A
00078 *    RECORDS UPDATED:                                             DTSCS8A
00079 *                                                                 DTSCS8A
00080 *      MASTER:                                                    DTSCS8A
00081 *                                                                 DTSCS8A
00082 *        NONE.                                                    DTSCS8A
00083 *                                                                 DTSCS8A
00084 *                                                                 DTSCS8A
00085 *      REFERENCE:                                                 DTSCS8A
00086 *                                                                 DTSCS8A
00087 *        NONE                                                     DTSCS8A
00088 *                                                                 DTSCS8A
00089 *                                                                 DTSCS8A
00090 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS8A
00091 *                                                                 DTSCS8A
00092 *        NONE.                                                    DTSCS8A
00093 *                                                                 DTSCS8A
00094 *                                                                 DTSCS8A
00095 *    ON-LINE EVENT FILE RECORDS WRITTEN:                          DTSCS8A
00096 *                                                                 DTSCS8A
00097 *      NONE.                                                      DTSCS8A
00098 *                                                                 DTSCS8A
00099 *                                                                 DTSCS8A
00100 *    MODULES (OTHER THAN STANDARD SCREEN PROCESSING               DTSCS8A
00101 *    UTILITY MODULES) LINKED TO:                                  DTSCS8A
00102 *                                                                 DTSCS8A
00103 *      DTSCU013 COUNT FROM SCREEN FORMAT/EDIT.                    DTSCS8A
00104 *                                                                 DTSCS8A
00105 *                                                                 DTSCS8A
00106 *    MAINTENANCE NOTES:                                           DTSCS8A
00107 *                                                                 DTSCS8A
00108 *3/21  MAX REPORTS  = 52                                          DTSCS8A
00109 *6/12  MAX REPORTS  = 20                                          DTSCS8A
00110 *      LINES / PAGE = 12                                          DTSCS8A
00111 *      REPORT INFO COMES FROM REDEFINED TABLE IN COPYBOOK         DTSCS8A
00112 *                                                                 DTSCS8A
00113 *****                                                             DTSCS8A
00114      SKIP3                                                        DTSCS8A
00115  ENVIRONMENT DIVISION.                                            DTSCS8A
00116      EJECT                                                        DTSCS8A
00117  DATA DIVISION.                                                   DTSCS8A
00118  WORKING-STORAGE SECTION.                                         DTSCS8A
001185 77  PAN-VALET PICTURE X(24) VALUE '003DTSCS8A   08/15/02'.       DTSCS8A
00119                                                                   DTSCS8A
00120  01  WRK-AREA.                                                    DTSCS8A
00121      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S8A '.    DTSCS8A
00122                                                                   DTSCS8A
00123      05  WRK-SCR-ID.                                              DTSCS8A
00124          10  WRK-SCR-ID-X            PIC  X(02)  VALUE '8A'.      DTSCS8A
00125      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '80'.      DTSCS8A
00126      05  WRK-REQ-PARM-SCR-ID         PIC  X(02)  VALUE '8B'.      DTSCS8A
00127                                                                   DTSCS8A
00128      05  WRK-MAX-REPORTS             PIC  9(03)  COMP-3           DTSCS8A
00129                                                  VALUE 20.        DTSCS8A
00130                                                                   DTSCS8A
00131      05  WRK-SLOTS-PER-SCREEN        PIC S9(02)  VALUE +12.       DTSCS8A
00132                                                                   DTSCS8A
00133      05  WRK-JOB-NAME                PIC  X(08).                  DTSCS8A
00134                                                                   DTSCS8A
00135      05  WRK-MSG-AREA                PIC  X(64) VALUE SPACES.     DTSCS8A
00136      SKIP1                                                        DTSCS8A
00137      05  WRK-BUS-AREA                PIC  X(02).                  DTSCS8A
00138                                                                   DTSCS8A
00139      05  WRK-SCREEN-STATE            PIC  X(01).                  DTSCS8A
00140          88  WRK-SCREEN-FINI-88      VALUE 'Y'.                   DTSCS8A
00141                                                                   DTSCS8A
00142      05  WRK-DISP-STATE              PIC  X(01).                  DTSCS8A
00143          88  WRK-FIRST-PAGE-88       VALUE 'Y'.                   DTSCS8A
00144                                                                   DTSCS8A
00145      05  WRK-USE-FILTER              PIC  X(01).                  DTSCS8A
00146          88  WRK-USE-REPT-NAME-88    VALUE 'R'.                   DTSCS8A
00147          88  WRK-USE-BUS-AREA-88     VALUE 'B'.                   DTSCS8A
00148                                                                   DTSCS8A
00149      05  WRK-SUB                     PIC S9(04)  COMP.            DTSCS8A
00150      05  WRK-SUB-START               PIC S9(04)  COMP.            DTSCS8A
00151      05  WRK-SUB-INCREMENTOR         PIC S9(04)  COMP.            DTSCS8A
00152      05  WRK-SCREEN-SLOT             PIC S9(04)  COMP.            DTSCS8A
00153                                                                   DTSCS8A
00154      EJECT                                                        DTSCS8A
00155  01  MSG-AREA.                                                    DTSCS8A
00156      05  MSG-E8A1-AREA.                                           DTSCS8A
00157          10  FILLER                 PIC  X(04)  VALUE 'E8A1'.     DTSCS8A
00158          10  FILLER                 PIC  X(30)                    DTSCS8A
00159                VALUE 'LINE NUMBER SELECTED IS NOT VA'.            DTSCS8A
00160          10  FILLER                 PIC  X(30)                    DTSCS8A
00161                VALUE 'LID                           '.            DTSCS8A
00162      EJECT                                                        DTSCS8A
00163  01  SCREEN-CONTROL.                                              DTSCS8A
00164      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS8A
00165          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS8A
00166          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS8A
00167      SKIP1                                                        DTSCS8A
00168      05  CURSOR-SET-IND              PIC X(01).                   DTSCS8A
00169          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS8A
00170          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS8A
00171          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS8A
00172      SKIP1                                                        DTSCS8A
00173      05  REQ-IND                     PIC X(01).                   DTSCS8A
00174          88  REQ-ERROR                       VALUE 'O'.           DTSCS8A
00175          88  REQ-JUMP                        VALUE 'J'.           DTSCS8A
00176          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS8A
00177          88  REQ-CLEAR                       VALUE 'C'.           DTSCS8A
00178          88  REQ-EDIT                        VALUE 'E'.           DTSCS8A
00179          88  REQ-UPDATE                      VALUE 'U'.           DTSCS8A
00180          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS8A
00181      SKIP1                                                        DTSCS8A
00182      05  RESP-IND                    PIC X(01).                   DTSCS8A
00183          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS8A
00184          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS8A
00185          88  RESP-JUMP                       VALUE 'J'.           DTSCS8A
00186          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS8A
00187      SKIP1                                                        DTSCS8A
00188      05  SCR-ATB-AN                  PIC  X(01).                  DTSCS8A
00189      05  SCR-ATB-NUM                 PIC  X(01).                  DTSCS8A
00190      EJECT                                                        DTSCS8A
00191  01  L001-COMM-AREA.                                              DTSCS8A
00192  ++INCLUDE DTSIL001                                               DTSCS8A
00193      EJECT                                                        DTSCS8A
00194  01  L013-COMM-AREA.                                              DTSCS8A
00195  ++INCLUDE DTSIL013                                               DTSCS8A
00196      EJECT                                                        DTSCS8A
00197 * ERROR MSG MODULE                                                DTSCS8A
00198  01  L805-COMM-AREA.                                              DTSCS8A
00199  ++INCLUDE DTSIL805                                               DTSCS8A
00200      EJECT                                                        DTSCS8A
00201 * REPORT INFO IN TABLE FORMAT                                     DTSCS8A
00202  ++INCLUDE OJRIC089                                               DTSCS8A
00203 * MAP DEFINITION                                                  DTSCS8A
00204  01  L851-COMM-AREA.                                              DTSCS8A
00205  ++INCLUDE DTSIL851                                               DTSCS8A
00206      SKIP3                                                        DTSCS8A
00207      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS8A
00208  ++INCLUDE DTSIS8A                                                DTSCS8A
00209      EJECT                                                        DTSCS8A
00210 * ATTRIBUTE LITERALS                                              DTSCS8A
00211  01  CATB-LITERALS.                                               DTSCS8A
00212  ++INCLUDE DTSICATB                                               DTSCS8A
00213      SKIP3                                                        DTSCS8A
00214 * FUNCTION KEY DESCRIPTION LITERALS                               DTSCS8A
00215  01  CFKD-LITERALS.                                               DTSCS8A
00216  ++INCLUDE DTSICFKD                                               DTSCS8A
00217      EJECT                                                        DTSCS8A
00218 * ERROR CODE MESSAGE LITERALS                                     DTSCS8A
00219  01  CECD-LITERALS.                                               DTSCS8A
00220  ++INCLUDE DTSICECD                                               DTSCS8A
00221      SKIP3                                                        DTSCS8A
00222 * PROMPT CODE MESSAGE LITERALS                                    DTSCS8A
00223  01  CPCD-LITERALS.                                               DTSCS8A
00224  ++INCLUDE DTSICPCD                                               DTSCS8A
00225      EJECT                                                        DTSCS8A
00226  LINKAGE SECTION.                                                 DTSCS8A
00227      SKIP3                                                        DTSCS8A
00228  01  DFHCOMMAREA.                                                 DTSCS8A
00229  ++INCLUDE DTSILCCM                                               DTSCS8A
00230      SKIP3                                                        DTSCS8A
00231              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS8A
00232                  20  LCCM-REPORT-SUB     PIC S9(04)  COMP.        DTSCS8A
00233                  20  LCCM-BUS-AREA       PIC  X(02).              DTSCS8A
00234                  20  LCCM-PAGE-NUM       PIC  9(02).              DTSCS8A
00235                  20  LCCM-SUBS-THIS-PAGE PIC S9(04)  COMP         DTSCS8A
00236                          OCCURS 12 TIMES.                         DTSCS8A
00237      EJECT                                                        DTSCS8A
00238 ******************************************************************DTSCS8A
00239 *                                                                *DTSCS8A
00240 ******************************************************************DTSCS8A
00241      SKIP1                                                        DTSCS8A
00242  PROCEDURE DIVISION.                                              DTSCS8A
00243      SKIP2                                                        DTSCS8A
00244      SET CURSOR-SET-NO TO TRUE.                                   DTSCS8A
00245      SKIP1                                                        DTSCS8A
00246      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS8A
00247      SKIP1                                                        DTSCS8A
00248      PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT                  DTSCS8A
00249          VARYING LCCM-NONUM-IDX FROM 1 BY 1                       DTSCS8A
00250          UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT                DTSCS8A
00251                                                                   DTSCS8A
00252      INITIALIZE WRK-SUB                                           DTSCS8A
00253                 WRK-SUB-START                                     DTSCS8A
00254                                                                   DTSCS8A
00255      MOVE SPACE TO REQ-IND                                        DTSCS8A
00256                                                                   DTSCS8A
00257      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT                DTSCS8A
00258      SKIP1                                                        DTSCS8A
00259 *-----------------------------------------------------            DTSCS8A
00260 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS8A
00261 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS8A
00262 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS8A
00263 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS8A
00264 *                                                                 DTSCS8A
00265 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS8A
00266 *    PROCESSED.                                                   DTSCS8A
00267 *                                                                 DTSCS8A
00268 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS8A
00269 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS8A
00270 *    WORK STATION OPERATOR.                                       DTSCS8A
00271 *-----------------------------------------------------            DTSCS8A
00272      SKIP1                                                        DTSCS8A
00273      INITIALIZE RESP-IND                                          DTSCS8A
00274      SKIP1                                                        DTSCS8A
00275      EVALUATE TRUE                                                DTSCS8A
00276          WHEN REQ-ERROR                                           DTSCS8A
00277              PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT          DTSCS8A
00278          WHEN REQ-JUMP                                            DTSCS8A
00279              PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT           DTSCS8A
00280          WHEN REQ-CLEAR                                           DTSCS8A
00281              PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT          DTSCS8A
00282          WHEN REQ-CURSOR-TO-GOTO                                  DTSCS8A
00283              PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT         DTSCS8A
00284          WHEN REQ-INQUIRE                                         DTSCS8A
00285              PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT        DTSCS8A
00286          WHEN OTHER                                               DTSCS8A
00287              GO TO S899-ABEND                                     DTSCS8A
00288      END-EVALUATE                                                 DTSCS8A
00289      SKIP3                                                        DTSCS8A
00290 *-----------------------------------------------------            DTSCS8A
00291 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS8A
00292 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS8A
00293 *-----------------------------------------------------            DTSCS8A
00294      SKIP1                                                        DTSCS8A
00295      EVALUATE TRUE                                                DTSCS8A
00296          WHEN RESP-SEND-MAP                                       DTSCS8A
00297              PERFORM S9300-SEND-MAP THRU S9300-EXIT               DTSCS8A
00298              SET LCCM-END-TASK-88 TO TRUE                         DTSCS8A
00299          WHEN RESP-SEND-MSGONLY OR RESP-CURSOR-TO-GOTO            DTSCS8A
00300              PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT          DTSCS8A
00301              SET LCCM-END-TASK-88 TO TRUE                         DTSCS8A
00302          WHEN RESP-JUMP                                           DTSCS8A
00303              SET LCCM-LINK-SCREEN-88 TO TRUE                      DTSCS8A
00304          WHEN OTHER                                               DTSCS8A
00305              GO TO S899-ABEND                                     DTSCS8A
00306      END-EVALUATE.                                                DTSCS8A
00307      SKIP3                                                        DTSCS8A
00308  MAINLINE-EXIT.                                                   DTSCS8A
00309                                                                   DTSCS8A
00310      EXEC CICS                                                    DTSCS8A
00311          RETURN                                                   DTSCS8A
00312      END-EXEC.                                                    DTSCS8A
00313                                                                   DTSCS8A
00314      GOBACK.                                                      DTSCS8A
00315      EJECT                                                        DTSCS8A
00316                                                                   DTSCS8A
00317  P0100-ACCESS-SEARCH.                                             DTSCS8A
00318      IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID           DTSCS8A
00319          MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX)          DTSCS8A
00320            TO SCR-ACCESS-IND.                                     DTSCS8A
00321  P0100-EXIT.                                                      DTSCS8A
00322      EXIT.                                                        DTSCS8A
00323 /*****************************************************************DTSCS8A
00324 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS8A
00325 ******************************************************************DTSCS8A
00326  P1000-ANALYZE-REQUEST.                                           DTSCS8A
00327      SKIP1                                                        DTSCS8A
00328 *-----------------------------------------------------            DTSCS8A
00329 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS8A
00330 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS8A
00331 *     REPLACED WITH ENTER)                                        DTSCS8A
00332 *-----------------------------------------------------            DTSCS8A
00333      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS8A
00334         SET LCCM-ENTER-88 TO TRUE                                 DTSCS8A
00335         SET REQ-CLEAR TO TRUE                                     DTSCS8A
00336         GO TO P1000-EXIT                                          DTSCS8A
00337      END-IF                                                       DTSCS8A
00338      SKIP3                                                        DTSCS8A
00339 *-----------------------------------------------------            DTSCS8A
00340 *      MAP IS RECEIVED                                            DTSCS8A
00341 *-----------------------------------------------------            DTSCS8A
00342      PERFORM S9100-RECEIVE THRU S9100-EXIT                        DTSCS8A
00343      SKIP3                                                        DTSCS8A
00344 *-----------------------------------------------------            DTSCS8A
00345 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS8A
00346 *    WORK STATION                                                 DTSCS8A
00347 *-----------------------------------------------------            DTSCS8A
00348      IF LCCM-CLEAR-88                                             DTSCS8A
00349         SET REQ-CLEAR TO TRUE                                     DTSCS8A
00350         GO TO P1000-EXIT                                          DTSCS8A
00351      END-IF                                                       DTSCS8A
00352      SKIP3                                                        DTSCS8A
00353 *-----------------------------------------------------            DTSCS8A
00354 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS8A
00355 *-----------------------------------------------------            DTSCS8A
00356      IF LCCM-PA2-88                                               DTSCS8A
00357          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS8A
00358          GO TO P1000-EXIT                                         DTSCS8A
00359      END-IF                                                       DTSCS8A
00360      SKIP3                                                        DTSCS8A
00361 *-----------------------------------------------------            DTSCS8A
00362 *   IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A               DTSCS8A
00363 *   REQUEST TO CLEAR THE SCREEN.                                  DTSCS8A
00364 *-----------------------------------------------------            DTSCS8A
00365      IF LCCM-F12-88                                               DTSCS8A
00366        MOVE LOW-VALUES TO MAP-AREA                                DTSCS8A
00367        SET REQ-CLEAR TO TRUE                                      DTSCS8A
00368        GO TO P1000-EXIT                                           DTSCS8A
00369      END-IF                                                       DTSCS8A
00370      SKIP3                                                        DTSCS8A
00371 *-----------------------------------------------------            DTSCS8A
00372 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS8A
00373 *-----------------------------------------------------            DTSCS8A
00374      IF LCCM-PA-88                                                DTSCS8A
00375        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS8A
00376        SET REQ-ERROR TO TRUE                                      DTSCS8A
00377        GO TO P1000-EXIT                                           DTSCS8A
00378      END-IF                                                       DTSCS8A
00379      SKIP3                                                        DTSCS8A
00380 *-----------------------------------------------------            DTSCS8A
00381 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS8A
00382 *-----------------------------------------------------            DTSCS8A
00383      IF LCCM-F03-88                                               DTSCS8A
00384         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS8A
00385         SET REQ-JUMP TO TRUE                                      DTSCS8A
00386         GO TO P1000-EXIT                                          DTSCS8A
00387      END-IF                                                       DTSCS8A
00388      SKIP3                                                        DTSCS8A
00389 *-----------------------------------------------------            DTSCS8A
00390 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS8A
00391 *-----------------------------------------------------            DTSCS8A
00392      IF LCCM-F04-88                                               DTSCS8A
00393         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS8A
00394         SET REQ-JUMP TO TRUE                                      DTSCS8A
00395         GO TO P1000-EXIT                                          DTSCS8A
00396      END-IF                                                       DTSCS8A
00397      SKIP3                                                        DTSCS8A
00398 *-----------------------------------------------------            DTSCS8A
00399 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS8A
00400 *    CORRESPONDENCE SCREEN                                        DTSCS8A
00401 *-----------------------------------------------------            DTSCS8A
00402      IF LCCM-F14-88                                               DTSCS8A
00403         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS8A
00404         SET REQ-JUMP TO TRUE                                      DTSCS8A
00405         GO TO P1000-EXIT                                          DTSCS8A
00406      END-IF                                                       DTSCS8A
00407      SKIP3                                                        DTSCS8A
00408 *-----------------------------------------------------            DTSCS8A
00409 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS8A
00410 *    REQUESTED SCREEN TYPE                                        DTSCS8A
00411 *-----------------------------------------------------            DTSCS8A
00412      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS8A
00413         CONTINUE                                                  DTSCS8A
00414      ELSE                                                         DTSCS8A
00415        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS8A
00416        SET REQ-JUMP TO TRUE                                       DTSCS8A
00417        GO TO P1000-EXIT                                           DTSCS8A
00418      END-IF                                                       DTSCS8A
00419      SKIP3                                                        DTSCS8A
00420 *-----------------------------------------------------            DTSCS8A
00421 *    IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN,               DTSCS8A
00422 *          PAGE UP), INDICATE INQUIRY REQUEST                     DTSCS8A
00423 *-----------------------------------------------------            DTSCS8A
00424      IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88               DTSCS8A
00425          SET REQ-INQUIRE TO TRUE                                  DTSCS8A
00426          GO TO P1000-EXIT                                         DTSCS8A
00427      END-IF                                                       DTSCS8A
00428      SKIP3                                                        DTSCS8A
00429 *-----------------------------------------------------            DTSCS8A
00430 *     ANY OTHER KEY IS INVALID                                    DTSCS8A
00431 *-----------------------------------------------------            DTSCS8A
00432      PERFORM S804-INVALID-KEY THRU S804-EXIT                      DTSCS8A
00433      SET REQ-ERROR TO TRUE.                                       DTSCS8A
00434  P1000-EXIT.                                                      DTSCS8A
00435      EXIT.                                                        DTSCS8A
00436      SKIP3                                                        DTSCS8A
00437 /*****************************************************************DTSCS8A
00438 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS8A
00439 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS8A
00440 ******************************************************************DTSCS8A
00441      SKIP1                                                        DTSCS8A
00442  P2000-REQUEST-ERROR.                                             DTSCS8A
00443      IF LCCM-MSG                                                  DTSCS8A
00444         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS8A
00445      ELSE                                                         DTSCS8A
00446         GO TO S899-ABEND                                          DTSCS8A
00447      END-IF.                                                      DTSCS8A
00448  P2000-EXIT.                                                      DTSCS8A
00449      EXIT.                                                        DTSCS8A
00450 /*****************************************************************DTSCS8A
00451 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS8A
00452 ******************************************************************DTSCS8A
00453      SKIP1                                                        DTSCS8A
00454  P3000-REQUEST-JUMP.                                              DTSCS8A
00455 *-----------------------------------------------------            DTSCS8A
00456 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS8A
00457 *    BY USER                                                      DTSCS8A
00458 *-----------------------------------------------------            DTSCS8A
00459      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT                  DTSCS8A
00460      SKIP3                                                        DTSCS8A
00461 *-----------------------------------------------------            DTSCS8A
00462 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS8A
00463 *-----------------------------------------------------            DTSCS8A
00464      IF LCCM-MSG                                                  DTSCS8A
00465         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS8A
00466         SET CURSOR-SET-GOTO TO TRUE                               DTSCS8A
00467         GO TO P3000-EXIT                                          DTSCS8A
00468      END-IF                                                       DTSCS8A
00469      SKIP3                                                        DTSCS8A
00470 *-----------------------------------------------------            DTSCS8A
00471 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS8A
00472 *-----------------------------------------------------            DTSCS8A
00473      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS8A
00474                         LCCM-SCR-HOLD-AREA                        DTSCS8A
00475      MOVE +0 TO LCCM-SCR-ABSTIME                                  DTSCS8A
00476      SET RESP-JUMP TO TRUE.                                       DTSCS8A
00477  P3000-EXIT.                                                      DTSCS8A
00478      EXIT.                                                        DTSCS8A
00479 /*****************************************************************DTSCS8A
00480 * CLEAR KEY WAS PRESSED                                          *DTSCS8A
00481 ******************************************************************DTSCS8A
00482      SKIP1                                                        DTSCS8A
00483  P4000-REQUEST-CLEAR.                                             DTSCS8A
00484 *-----------------------------------------------------            DTSCS8A
00485 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS8A
00486 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS8A
00487 *-----------------------------------------------------            DTSCS8A
00488      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA                        DTSCS8A
00489      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME             DTSCS8A
00490      SET LCCM-SCR-CLEAR TO TRUE                                   DTSCS8A
00491      SET RESP-SEND-MAP TO TRUE.                                   DTSCS8A
00492  P4000-EXIT.                                                      DTSCS8A
00493      EXIT.                                                        DTSCS8A
00494 /*****************************************************************DTSCS8A
00495 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS8A
00496 ******************************************************************DTSCS8A
00497      SKIP1                                                        DTSCS8A
00498  P5000-CURSOR-TO-GOTO.                                            DTSCS8A
00499      SET CURSOR-SET-GOTO TO TRUE                                  DTSCS8A
00500      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS8A
00501  P5000-EXIT.                                                      DTSCS8A
00502      EXIT.                                                        DTSCS8A
00503 /*****************************************************************DTSCS8A
00504 * INQUIRY WAS REQUESTED                                          *DTSCS8A
00505 ******************************************************************DTSCS8A
00506                                                                   DTSCS8A
00507  P6000-REQUEST-INQUIRE.                                           DTSCS8A
00508 *JMO BREAK UP INTO MULTIPLE PARAS                                 DTSCS8A
00509      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME             DTSCS8A
00510                                                                   DTSCS8A
00511      INSPECT MAP-BUS-AREA CONVERTING LOW-VALUE TO SPACES          DTSCS8A
00512      IF MAP-BUS-AREA = SPACES                                     DTSCS8A
00513         SET  WRK-USE-REPT-NAME-88 TO TRUE                         DTSCS8A
00514         MOVE CATB-CURSOR          TO MAP-SELECT-LINE-NO-L         DTSCS8A
00515         SET  CURSOR-SET-YES       TO TRUE                         DTSCS8A
00516      ELSE                                                         DTSCS8A
00517          MOVE MAP-BUSINESS-AREA  TO  L013-S-CNT-AREA              DTSCS8A
00518          MOVE +1                 TO  L013-MIN-CNT                 DTSCS8A
00519          MOVE +7                 TO  L013-MAX-CNT                 DTSCS8A
00520          PERFORM S013-SCREEN-COUNT  THRU S013-EXIT                DTSCS8A
00521          IF L013-VALID AND MAP-VALID-BUS-AREA                     DTSCS8A
00522             MOVE CATB-CURSOR         TO MAP-SELECT-LINE-NO-L      DTSCS8A
00523             SET CURSOR-SET-YES       TO TRUE                      DTSCS8A
00524             SET WRK-USE-BUS-AREA-88  TO TRUE                      DTSCS8A
00525             IF MAP-BUS-AREA(1:1) = SPACES                         DTSCS8A
00526                MOVE ZERO TO MAP-BUS-AREA(1:1)                     DTSCS8A
00527             ELSE                                                  DTSCS8A
00528                 IF MAP-BUS-AREA(2:1) = SPACES                     DTSCS8A
00529                    MOVE MAP-BUS-AREA(1:1) TO MAP-BUS-AREA(2:1)    DTSCS8A
00530                    MOVE ZERO TO MAP-BUS-AREA(1:1)                 DTSCS8A
00531                 END-IF                                            DTSCS8A
00532             END-IF                                                DTSCS8A
00533          ELSE                                                     DTSCS8A
00534              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS8A
00535              MOVE CATB-CURSOR          TO MAP-BUS-AREA-L          DTSCS8A
00536              PERFORM S1101-ERROR THRU S1101-EXIT                  DTSCS8A
00537          END-IF                                                   DTSCS8A
00538      END-IF                                                       DTSCS8A
00539                                                                   DTSCS8A
00540      IF LCCM-NO-MSG                                               DTSCS8A
00541         IF MAP-BUS-AREA = LCCM-BUS-AREA                           DTSCS8A
00542            EVALUATE TRUE                                          DTSCS8A
00543               WHEN LCCM-ENTER-88                                  DTSCS8A
00544                   PERFORM P6100-NO-PAGE THRU P6100-EXIT           DTSCS8A
00545               WHEN LCCM-F07-88                                    DTSCS8A
00546                   PERFORM P6200-PAGE-BACK THRU P6200-EXIT         DTSCS8A
00547               WHEN LCCM-F08-88                                    DTSCS8A
00548                   PERFORM P6300-PAGE-NEXT THRU P6300-EXIT         DTSCS8A
00549               WHEN OTHER                                          DTSCS8A
00550                   GO TO S899-ABEND                                DTSCS8A
00551            END-EVALUATE                                           DTSCS8A
00552         ELSE                                                      DTSCS8A
00553             SET LCCM-ENTER-88     TO TRUE                         DTSCS8A
00554             SET WRK-FIRST-PAGE-88 TO TRUE                         DTSCS8A
00555             PERFORM P6100-NO-PAGE THRU P6100-EXIT                 DTSCS8A
00556         END-IF                                                    DTSCS8A
00557                                                                   DTSCS8A
00558         IF LCCM-NO-MSG                                            DTSCS8A
00559            IF LCCM-SCR-ID = LCCM-REQ-SCR-ID                       DTSCS8A
00560               PERFORM                                             DTSCS8A
00561                  VARYING WRK-SUB                                  DTSCS8A
00562                  FROM 1 BY 1                                      DTSCS8A
00563                  UNTIL WRK-SUB > WRK-SLOTS-PER-SCREEN             DTSCS8A
00564                     MOVE 0 TO LCCM-SUBS-THIS-PAGE(WRK-SUB)        DTSCS8A
00565               END-PERFORM                                         DTSCS8A
00566                                                                   DTSCS8A
00567               PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT      DTSCS8A
00568            ELSE                                                   DTSCS8A
00569                SET RESP-JUMP TO TRUE                              DTSCS8A
00570                GO TO P6000-EXIT                                   DTSCS8A
00571            END-IF                                                 DTSCS8A
00572         END-IF                                                    DTSCS8A
00573      END-IF                                                       DTSCS8A
00574                                                                   DTSCS8A
00575      PERFORM S5900-SET-ATTRB THRU S5900-EXIT                      DTSCS8A
00576      SET RESP-SEND-MAP TO TRUE.                                   DTSCS8A
00577  P6000-EXIT.                                                      DTSCS8A
00578      EXIT.                                                        DTSCS8A
00579                                                                   DTSCS8A
00580  P6100-NO-PAGE.                                                   DTSCS8A
00581      IF WRK-FIRST-PAGE-88                                         DTSCS8A
00582         MOVE +1 TO WRK-SUB-START                                  DTSCS8A
00583         MOVE +1 TO WRK-SUB-INCREMENTOR                            DTSCS8A
00584         MOVE +1 TO WRK-SCREEN-SLOT                                DTSCS8A
00585         MOVE  1 TO LCCM-PAGE-NUM                                  DTSCS8A
00586         PERFORM                                                   DTSCS8A
00587            VARYING WRK-SUB                                        DTSCS8A
00588            FROM 1 BY 1                                            DTSCS8A
00589            UNTIL WRK-SUB > WRK-SLOTS-PER-SCREEN                   DTSCS8A
00590               MOVE SPACES TO MAP-LINE-DATA(WRK-SUB)               DTSCS8A
00591         END-PERFORM                                               DTSCS8A
00592      ELSE                                                         DTSCS8A
00593          IF MAP-SELECT-LINE-NO = SPACES OR LOW-VALUES             DTSCS8A
00594             MOVE CATB-CURSOR         TO MAP-SELECT-LINE-NO-L      DTSCS8A
00595             MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA              DTSCS8A
00596             PERFORM S1101-ERROR THRU S1101-EXIT                   DTSCS8A
00597          ELSE                                                     DTSCS8A
00598              MOVE MAP-SELECT-LINE-NO-AREA  TO  L013-S-CNT-AREA    DTSCS8A
00599              MOVE +1  TO L013-MIN-CNT                             DTSCS8A
00600              MOVE +12 TO L013-MAX-CNT                             DTSCS8A
00601              PERFORM S013-SCREEN-COUNT  THRU S013-EXIT            DTSCS8A
00602              IF L013-VALID                                        DTSCS8A
00603                MOVE L013-CNT TO MAP-SELECT-LINE-NO-N              DTSCS8A
00604                PERFORM P6150-PROCESS-SELECTED-LINE THRU P6150-EXITDTSCS8A
00605              ELSE                                                 DTSCS8A
00606                  PERFORM S1101-ERROR THRU S1101-EXIT              DTSCS8A
00607              END-IF                                               DTSCS8A
00608          END-IF                                                   DTSCS8A
00609      END-IF.                                                      DTSCS8A
00610  P6100-EXIT.                                                      DTSCS8A
00611      EXIT.                                                        DTSCS8A
00612                                                                   DTSCS8A
00613  P6150-PROCESS-SELECTED-LINE.                                     DTSCS8A
00614       MOVE LCCM-SUBS-THIS-PAGE(MAP-SELECT-LINE-NO-N)              DTSCS8A
00615                                 TO LCCM-REPORT-SUB                DTSCS8A
00616       MOVE WRK-REQ-PARM-SCR-ID  TO LCCM-REQ-SCR-ID.               DTSCS8A
00617  P6150-EXIT.                                                      DTSCS8A
00618      EXIT.                                                        DTSCS8A
00619                                                                   DTSCS8A
00620  P6200-PAGE-BACK.                                                 DTSCS8A
00621      IF LCCM-PAGE-NUM > 1                                         DTSCS8A
00622         COMPUTE WRK-SUB-START = LCCM-SUBS-THIS-PAGE(1) - 1        DTSCS8A
00623         MOVE -1 TO WRK-SUB-INCREMENTOR                            DTSCS8A
00624         MOVE WRK-SLOTS-PER-SCREEN TO WRK-SCREEN-SLOT              DTSCS8A
00625         COMPUTE LCCM-PAGE-NUM = LCCM-PAGE-NUM - 1                 DTSCS8A
00626      ELSE                                                         DTSCS8A
00627          MOVE PMSG-FIRST-PAGE TO WRK-MSG-AREA                     DTSCS8A
00628          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS8A
00629      END-IF.                                                      DTSCS8A
00630  P6200-EXIT.                                                      DTSCS8A
00631      EXIT.                                                        DTSCS8A
00632                                                                   DTSCS8A
00633  P6300-PAGE-NEXT.                                                 DTSCS8A
00634      IF LCCM-SUBS-THIS-PAGE(WRK-SLOTS-PER-SCREEN) > 0             DTSCS8A
00635         COMPUTE WRK-SUB-START =                                   DTSCS8A
00636              LCCM-SUBS-THIS-PAGE(WRK-SLOTS-PER-SCREEN) + 1        DTSCS8A
00637      END-IF                                                       DTSCS8A
00638                                                                   DTSCS8A
00639      IF WRK-SUB-START >  WRK-MAX-REPORTS OR                       DTSCS8A
00640            LCCM-SUBS-THIS-PAGE(WRK-SLOTS-PER-SCREEN) = 0          DTSCS8A
00641         MOVE PMSG-LAST-PAGE TO WRK-MSG-AREA                       DTSCS8A
00642         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS8A
00643      ELSE                                                         DTSCS8A
00644          MOVE +1 TO WRK-SUB-INCREMENTOR                           DTSCS8A
00645          MOVE +1 TO WRK-SCREEN-SLOT                               DTSCS8A
00646          COMPUTE LCCM-PAGE-NUM = LCCM-PAGE-NUM + 1                DTSCS8A
00647      END-IF.                                                      DTSCS8A
00648  P6300-EXIT.                                                      DTSCS8A
00649      EXIT.                                                        DTSCS8A
00650                                                                   DTSCS8A
00651  P6900-CONSTRUCT-SCREEN.                                          DTSCS8A
00652      INITIALIZE MAP-TABLE                                         DTSCS8A
00653      SET  LCCM-SCR-INQUIRE            TO TRUE                     DTSCS8A
00654      MOVE LCCM-CICS-REGION-NAME       TO MAP-CICS-REGION-NAME     DTSCS8A
00655      MOVE LCCM-TASK-START-DISP-DATE   TO MAP-SYS-DATE             DTSCS8A
00656      MOVE LCCM-TASK-START-DISP-TIME   TO MAP-SYS-TIME             DTSCS8A
00657                                                                   DTSCS8A
00658      PERFORM P6910-CHECK-FILTER THRU P6910-EXIT                   DTSCS8A
00659         VARYING WRK-SUB                                           DTSCS8A
00660         FROM WRK-SUB-START BY WRK-SUB-INCREMENTOR                 DTSCS8A
00661         UNTIL WRK-SCREEN-FINI-88                                  DTSCS8A
00662                                                                   DTSCS8A
00663      MOVE MAP-BUS-AREA TO LCCM-BUS-AREA.                          DTSCS8A
00664  P6900-EXIT.                                                      DTSCS8A
00665      EXIT.                                                        DTSCS8A
00666                                                                   DTSCS8A
00667  P6910-CHECK-FILTER.                                              DTSCS8A
00668      IF WRK-SUB > WRK-MAX-REPORTS OR WRK-SUB = ZERO               DTSCS8A
00669         SET WRK-SCREEN-FINI-88 TO TRUE                            DTSCS8A
00670      ELSE                                                         DTSCS8A
00671          IF WRK-USE-BUS-AREA-88                                   DTSCS8A
00672             IF FOJR-BUSINESS-AREA(WRK-SUB) = MAP-BUS-AREA         DTSCS8A
00673                PERFORM P6920-POPULATE-SCREEN THRU P6920-EXIT      DTSCS8A
00674             END-IF                                                DTSCS8A
00675          ELSE                                                     DTSCS8A
00676              PERFORM P6920-POPULATE-SCREEN THRU P6920-EXIT        DTSCS8A
00677          END-IF                                                   DTSCS8A
00678          IF WRK-SCREEN-SLOT > WRK-SLOTS-PER-SCREEN OR             DTSCS8A
00679             WRK-SCREEN-SLOT = ZERO                                DTSCS8A
00680             SET WRK-SCREEN-FINI-88 TO TRUE                        DTSCS8A
00681          END-IF                                                   DTSCS8A
00682      END-IF.                                                      DTSCS8A
00683  P6910-EXIT.                                                      DTSCS8A
00684      EXIT.                                                        DTSCS8A
00685                                                                   DTSCS8A
00686  P6920-POPULATE-SCREEN.                                           DTSCS8A
00687      MOVE FOJR-JOB-NAME(WRK-SUB) TO WRK-JOB-NAME                  DTSCS8A
00688      MOVE WRK-JOB-NAME(5:4)      TO MAP-JOB-NAME(WRK-SCREEN-SLOT) DTSCS8A
00689      MOVE FOJR-JOB-DESC(WRK-SUB) TO MAP-JOB-DESC(WRK-SCREEN-SLOT) DTSCS8A
00690      MOVE WRK-SCREEN-SLOT        TO MAP-LINE-NO(WRK-SCREEN-SLOT)  DTSCS8A
00691      MOVE WRK-SUB                TO                               DTSCS8A
00692             LCCM-SUBS-THIS-PAGE(WRK-SCREEN-SLOT)                  DTSCS8A
00693      COMPUTE WRK-SCREEN-SLOT = WRK-SCREEN-SLOT +                  DTSCS8A
00694                                WRK-SUB-INCREMENTOR.               DTSCS8A
00695  P6920-EXIT.                                                      DTSCS8A
00696      EXIT.                                                        DTSCS8A
00697                                                                   DTSCS8A
00698 /*****************************************************************DTSCS8A
00699 * LINKS TO UTILITY MODULES                                        DTSCS8A
00700 ******************************************************************DTSCS8A
00701      SKIP1                                                        DTSCS8A
00702  S013-SCREEN-COUNT.                                               DTSCS8A
00703      EXEC CICS LINK                                               DTSCS8A
00704          PROGRAM  ('DTSCU013')                                    DTSCS8A
00705          COMMAREA (L013-COMM-AREA)                                DTSCS8A
00706      END-EXEC.                                                    DTSCS8A
00707  S013-EXIT.                                                       DTSCS8A
00708      EXIT.                                                        DTSCS8A
00709      EJECT                                                        DTSCS8A
00710  S803-REQ-SCR-ID-EDIT.                                            DTSCS8A
00711      EXEC CICS LINK                                               DTSCS8A
00712          PROGRAM  ('DTSCU803')                                    DTSCS8A
00713          COMMAREA (DFHCOMMAREA)                                   DTSCS8A
00714      END-EXEC.                                                    DTSCS8A
00715  S803-EXIT.                                                       DTSCS8A
00716      EXIT.                                                        DTSCS8A
00717      SKIP3                                                        DTSCS8A
00718  S804-INVALID-KEY.                                                DTSCS8A
00719      EXEC CICS LINK                                               DTSCS8A
00720          PROGRAM  ('DTSCU804')                                    DTSCS8A
00721          COMMAREA (DFHCOMMAREA)                                   DTSCS8A
00722      END-EXEC.                                                    DTSCS8A
00723  S804-EXIT.                                                       DTSCS8A
00724      EXIT.                                                        DTSCS8A
00725      SKIP3                                                        DTSCS8A
00726  S805-MSG-AREA.                                                   DTSCS8A
00727      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS8A
00728      SKIP1                                                        DTSCS8A
00729      EXEC CICS LINK                                               DTSCS8A
00730          PROGRAM  ('DTSCU805')                                    DTSCS8A
00731          COMMAREA (L805-COMM-AREA)                                DTSCS8A
00732      END-EXEC.                                                    DTSCS8A
00733      SKIP1                                                        DTSCS8A
00734 *JMO - HERE IS WHERE THE 'DTS' IN THE MSG AREA IS COMING FROM     DTSCS8A
00735      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS8A
00736  S805-EXIT.                                                       DTSCS8A
00737      EXIT.                                                        DTSCS8A
00738                                                                   DTSCS8A
00739      SKIP3                                                        DTSCS8A
00740  S851-SCREEN-PROCESSING.                                          DTSCS8A
00741      EXEC CICS LINK                                               DTSCS8A
00742          PROGRAM  ('DTSCU851')                                    DTSCS8A
00743          COMMAREA (L851-COMM-AREA)                                DTSCS8A
00744      END-EXEC.                                                    DTSCS8A
00745  S851-EXIT.                                                       DTSCS8A
00746      EXIT.                                                        DTSCS8A
00747      SKIP3                                                        DTSCS8A
00748  S899-ABEND.                                                      DTSCS8A
00749      EXEC CICS ABEND                                              DTSCS8A
00750          ABCODE(WRK-ABEND-CD)                                     DTSCS8A
00751      END-EXEC.                                                    DTSCS8A
00752 *S899-EXIT.                                                       DTSCS8A
00753 *    EXIT.                                                        DTSCS8A
00754  S1101-ERROR.                                                     DTSCS8A
00755      MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA.                         DTSCS8A
00756  S1101-EXIT.                                                      DTSCS8A
00757      EXIT.                                                        DTSCS8A
00758                                                                   DTSCS8A
00759  S5900-SET-ATTRB.                                                 DTSCS8A
00760      MOVE CATB-UNPROT-BRT-AN-MDTON  TO MAP-SELECT-LINE-NO-A       DTSCS8A
00761      MOVE CATB-UNPROT-BRT-AN-MDTON  TO MAP-BUS-AREA-A             DTSCS8A
00762      MOVE CATB-UNPROT-BRT-AN-MDTON  TO MAP-GOTO-A                 DTSCS8A
00763      PERFORM                                                      DTSCS8A
00764          VARYING WRK-SUB                                          DTSCS8A
00765          FROM 1 BY 1                                              DTSCS8A
00766          UNTIL WRK-SUB > WRK-SLOTS-PER-SCREEN                     DTSCS8A
00767        MOVE CATB-PROT-NORM-MDTON  TO  MAP-LINE-A(WRK-SUB)         DTSCS8A
00768      END-PERFORM.                                                 DTSCS8A
00769  S5900-EXIT.                                                      DTSCS8A
00770      EXIT.                                                        DTSCS8A
00771                                                                   DTSCS8A
00772                                                                   DTSCS8A
00773 /*****************************************************************DTSCS8A
00774 * MAP ROUTINES                                                   *DTSCS8A
00775 ******************************************************************DTSCS8A
00776  S9100-RECEIVE.                                                   DTSCS8A
00777      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS8A
00778      SKIP1                                                        DTSCS8A
00779      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS8A
00780      SKIP1                                                        DTSCS8A
00781      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS8A
00782      SKIP1                                                        DTSCS8A
00783      MOVE L851-AID TO LCCM-AID.                                   DTSCS8A
00784      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS8A
00785  S9100-EXIT.                                                      DTSCS8A
00786      EXIT.                                                        DTSCS8A
00787      SKIP3                                                        DTSCS8A
00788  S9200-SEND-DATAONLY.                                             DTSCS8A
00789      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS8A
00790      SKIP1                                                        DTSCS8A
00791      IF LCCM-NO-MSG                                               DTSCS8A
00792          NEXT SENTENCE                                            DTSCS8A
00793      ELSE                                                         DTSCS8A
00794          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS8A
00795      SKIP1                                                        DTSCS8A
00796      IF CURSOR-SET-GOTO                                           DTSCS8A
00797          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS8A
00798      ELSE                                                         DTSCS8A
00799          MOVE CATB-CURSOR TO MAP-BUS-AREA-L.                      DTSCS8A
00800      SKIP1                                                        DTSCS8A
00801      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS8A
00802      SKIP1                                                        DTSCS8A
00803      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS8A
00804      SKIP1                                                        DTSCS8A
00805      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS8A
00806  S9200-EXIT.                                                      DTSCS8A
00807      EXIT.                                                        DTSCS8A
00808      SKIP3                                                        DTSCS8A
00809  S9300-SEND-MAP.                                                  DTSCS8A
00810      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS8A
00811      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS8A
00812      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS8A
00813      SKIP1                                                        DTSCS8A
00814      PERFORM S5900-SET-ATTRB THRU S5900-EXIT .                    DTSCS8A
00815      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS8A
00816      SKIP1                                                        DTSCS8A
00817      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS8A
00818                                                                   DTSCS8A
00819      IF CURSOR-SET-NO                                             DTSCS8A
00820          MOVE CATB-CURSOR TO MAP-BUS-AREA-L.                      DTSCS8A
00821      SKIP1                                                        DTSCS8A
00822      SET L851-SEND-88 TO TRUE.                                    DTSCS8A
00823      SKIP1                                                        DTSCS8A
00824      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS8A
00825      SKIP1                                                        DTSCS8A
00826      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS8A
00827  S9300-EXIT.                                                      DTSCS8A
00828      EXIT.                                                        DTSCS8A
00829                                                                   DTSCS8A
00830  S9320-INQUIRY-FKEYS.                                             DTSCS8A
00831      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS8A
00832      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS8A
00833  S9320-EXIT.                                                      DTSCS8A
00834      EXIT.                                                        DTSCS8A
00835      EJECT                                                        DTSCS8A
00836  S9900-PREPARE-SEND.                                              DTSCS8A
00837      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS8A
00838                         LCCM-SCR-ID.                              DTSCS8A
00839      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS8A
00840      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS8A
00841  S9900-EXIT.                                                      DTSCS8A
00842      EXIT.                                                        DTSCS8A
