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