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