00001  IDENTIFICATION DIVISION.                                         08/11/98
00002  PROGRAM-ID.             DTSCU829.                                DTSCU829
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV005
00004  DATE-WRITTEN.           APRIL 1994.                              DTSCU829
00005  DATE-COMPILED.                                                   DTSCU829
00006      SKIP3                                                        DTSCU829
00007 *****                                                             DTSCU829
00008 *                                                                 DTSCU829
00009 *    FUNCTION:  TEMPORARY STORAGE INPUT/OUTPUT.                   DTSCU829
00010 *                                                                 DTSCU829
00011 *                                                                 DTSCU829
00012 *    MODIFICATION LOG:                                            DTSCU829
00013 *                                                                 DTSCU829
00014 *    04/04/94  INITIAL DEVELOPMENT.                               DTSCU829
00015 *              WORK ORDER:                      PROGRAMMER: EHH   DTSCU829
00016 *                                                                 DTSCU829
00017 *    08/11/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00019 *                                                                    CL**2
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00023 *                                                                 DTSCU829
00024 *                                                                 DTSCU829
00025 *    DESCRIPTION:                                                 DTSCU829
00026 *                                                                 DTSCU829
00027 *        DTSCU829 PERFORMS ALL REQUIRED TEMPORARY STORAGE            CL**2
00028 *        INPUT/OUTPUT.  DTSCU829'S COMMAREA CONSISTS OF              CL**2
00029 *        DTSIL829, FOLLOWED BY A TEMPORARY STORAGE RECORD            CL**2
00030 *        AREA.                                                    DTSCU829
00031 *                                                                 DTSCU829
00032 *                                                                 DTSCU829
00033 *                                                                 DTSCU829
00034 *****                                                             DTSCU829
00035      SKIP3                                                        DTSCU829
00036  ENVIRONMENT DIVISION.                                            DTSCU829
00037      SKIP3                                                        DTSCU829
00038  DATA DIVISION.                                                   DTSCU829
00039      SKIP3                                                        DTSCU829
00040  WORKING-STORAGE SECTION.                                         DTSCU829
000405 77  PAN-VALET PICTURE X(24) VALUE '005DTSCU829  08/11/98'.       DTSCU829
00041      SKIP3                                                        DTSCU829
00042  01  WRK-AREA.                                                    DTSCU829
00043      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U829'.    DTSCU829
00044      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU829
00045                                                                      CL**2
00046      05  MAX-REC-LENGTH              PIC S9(04)  COMP VALUE +4089.DTSCU829
00047      EJECT                                                        DTSCU829
00048  LINKAGE SECTION.                                                 DTSCU829
00049      SKIP3                                                        DTSCU829
00050  01  DFHCOMMAREA.                                                 DTSCU829
00051      05  L829-CONTROL-BLOCK.                                      DTSCU829
00052  ++INCLUDE DTSIL829                                                  CL**5
00053      SKIP3                                                        DTSCU829
00054      05  L829-REC                        PIC  X(4089).            DTSCU829
00055      EJECT                                                        DTSCU829
00056  PROCEDURE DIVISION.                                              DTSCU829
00057      SKIP2                                                        DTSCU829
00058      SET L829-OK-88 TO TRUE.                                      DTSCU829
00059                                                                      CL**2
00060      IF L829-READ-ITEM-88                                         DTSCU829
00061          PERFORM P1100-READ-ITEM THRU P1100-EXIT                  DTSCU829
00062      ELSE                                                         DTSCU829
00063      IF L829-READ-NEXT-88                                         DTSCU829
00064          PERFORM P1200-READ-NEXT THRU P1200-EXIT                  DTSCU829
00065      ELSE                                                         DTSCU829
00066      IF L829-WRITE-88                                             DTSCU829
00067          PERFORM P2100-WRITE THRU P2100-EXIT                      DTSCU829
00068      ELSE                                                         DTSCU829
00069      IF L829-REWRITE-88                                           DTSCU829
00070          PERFORM P2200-REWRITE THRU P2200-EXIT                    DTSCU829
00071      ELSE                                                         DTSCU829
00072      IF L829-DELETE-QUEUE-88                                      DTSCU829
00073          PERFORM P2300-DELETE-QUEUE THRU P2300-EXIT               DTSCU829
00074      ELSE                                                         DTSCU829
00075          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00076      SKIP2                                                        DTSCU829
00077      EXEC CICS                                                    DTSCU829
00078          RETURN                                                   DTSCU829
00079      END-EXEC.                                                    DTSCU829
00080      SKIP2                                                        DTSCU829
00081      GOBACK.                                                      DTSCU829
00082      EJECT                                                        DTSCU829
00083  P1100-READ-ITEM.                                                 DTSCU829
00084      IF (L829-REC-LENGTH < +1)                                    DTSCU829
00085            OR                                                     DTSCU829
00086         (L829-REC-LENGTH > MAX-REC-LENGTH)                        DTSCU829
00087          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00088                                                                      CL**2
00089      EXEC CICS                                                    DTSCU829
00090          READQ TS                                                 DTSCU829
00091              QUEUE (L829-QUEUE-NAME)                              DTSCU829
00092              INTO (L829-REC)                                      DTSCU829
00093              LENGTH (L829-REC-LENGTH)                             DTSCU829
00094              ITEM (L829-ITEM-NO)                                  DTSCU829
00095              RESP (WRK-RESP-CD)                                   DTSCU829
00096      END-EXEC.                                                    DTSCU829
00097                                                                      CL**2
00098      IF WRK-RESP-CD = DFHRESP (ITEMERR)                           DTSCU829
00099          PERFORM S1100-ITEMERR THRU S1100-EXIT                    DTSCU829
00100      ELSE                                                         DTSCU829
00101      IF WRK-RESP-CD = DFHRESP (QIDERR)                            DTSCU829
00102          PERFORM S1200-QIDERR THRU S1200-EXIT                     DTSCU829
00103      ELSE                                                         DTSCU829
00104      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU829
00105          NEXT SENTENCE                                            DTSCU829
00106      ELSE                                                         DTSCU829
00107          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00108  P1100-EXIT.                                                      DTSCU829
00109      EXIT.                                                        DTSCU829
00110      EJECT                                                        DTSCU829
00111  P1200-READ-NEXT.                                                 DTSCU829
00112      IF (L829-REC-LENGTH < +1)                                    DTSCU829
00113            OR                                                     DTSCU829
00114         (L829-REC-LENGTH > MAX-REC-LENGTH)                        DTSCU829
00115          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00116                                                                      CL**2
00117      EXEC CICS                                                    DTSCU829
00118          READQ TS                                                 DTSCU829
00119              QUEUE (L829-QUEUE-NAME)                              DTSCU829
00120              INTO (L829-REC)                                      DTSCU829
00121              LENGTH (L829-REC-LENGTH)                             DTSCU829
00122              NEXT                                                 DTSCU829
00123              RESP (WRK-RESP-CD)                                   DTSCU829
00124      END-EXEC.                                                    DTSCU829
00125                                                                      CL**2
00126      IF WRK-RESP-CD = DFHRESP (ITEMERR)                           DTSCU829
00127          PERFORM S1100-ITEMERR THRU S1100-EXIT                    DTSCU829
00128      ELSE                                                         DTSCU829
00129      IF WRK-RESP-CD = DFHRESP (QIDERR)                            DTSCU829
00130          PERFORM S1200-QIDERR THRU S1200-EXIT                     DTSCU829
00131      ELSE                                                         DTSCU829
00132      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU829
00133          NEXT SENTENCE                                            DTSCU829
00134      ELSE                                                         DTSCU829
00135          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00136  P1200-EXIT.                                                      DTSCU829
00137      EXIT.                                                        DTSCU829
00138      EJECT                                                        DTSCU829
00139  P2100-WRITE.                                                     DTSCU829
00140      IF (L829-REC-LENGTH < +1)                                    DTSCU829
00141            OR                                                     DTSCU829
00142         (L829-REC-LENGTH > MAX-REC-LENGTH)                        DTSCU829
00143          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00144                                                                      CL**2
00145      IF L829-AUXILIARY-STORAGE-88                                 DTSCU829
00146                                                                      CL**2
00147          EXEC CICS                                                DTSCU829
00148              WRITEQ TS                                            DTSCU829
00149                  QUEUE (L829-QUEUE-NAME)                          DTSCU829
00150                  FROM (L829-REC)                                  DTSCU829
00151                  LENGTH (L829-REC-LENGTH)                         DTSCU829
00152                  AUXILIARY                                        DTSCU829
00153                  RESP (WRK-RESP-CD)                               DTSCU829
00154          END-EXEC                                                 DTSCU829
00155                                                                      CL**2
00156      ELSE                                                         DTSCU829
00157      IF L829-DEFAULT-STORAGE-88 OR L829-MAIN-STORAGE-88           DTSCU829
00158                                                                      CL**2
00159          EXEC CICS                                                DTSCU829
00160              WRITEQ TS                                            DTSCU829
00161                  QUEUE (L829-QUEUE-NAME)                          DTSCU829
00162                  FROM (L829-REC)                                  DTSCU829
00163                  LENGTH (L829-REC-LENGTH)                         DTSCU829
00164                  MAIN                                             DTSCU829
00165                  RESP (WRK-RESP-CD)                               DTSCU829
00166          END-EXEC                                                 DTSCU829
00167                                                                      CL**2
00168      ELSE                                                         DTSCU829
00169          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00170                                                                      CL**2
00171      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU829
00172          NEXT SENTENCE                                            DTSCU829
00173      ELSE                                                         DTSCU829
00174          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00175  P2100-EXIT.                                                      DTSCU829
00176      EXIT.                                                        DTSCU829
00177      EJECT                                                        DTSCU829
00178  P2200-REWRITE.                                                   DTSCU829
00179      IF (L829-REC-LENGTH < +1)                                    DTSCU829
00180            OR                                                     DTSCU829
00181         (L829-REC-LENGTH > MAX-REC-LENGTH)                        DTSCU829
00182          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00183                                                                      CL**2
00184      IF L829-AUXILIARY-STORAGE-88                                 DTSCU829
00185                                                                      CL**2
00186          EXEC CICS                                                DTSCU829
00187              WRITEQ TS                                            DTSCU829
00188                  QUEUE (L829-QUEUE-NAME)                          DTSCU829
00189                  REWRITE  ITEM (L829-ITEM-NO)                     DTSCU829
00190                  FROM (L829-REC)                                  DTSCU829
00191                  LENGTH (L829-REC-LENGTH)                         DTSCU829
00192                  AUXILIARY                                        DTSCU829
00193                  RESP (WRK-RESP-CD)                               DTSCU829
00194          END-EXEC                                                 DTSCU829
00195                                                                      CL**2
00196      ELSE                                                         DTSCU829
00197      IF L829-DEFAULT-STORAGE-88 OR L829-MAIN-STORAGE-88           DTSCU829
00198                                                                      CL**2
00199          EXEC CICS                                                DTSCU829
00200              WRITEQ TS                                            DTSCU829
00201                  QUEUE (L829-QUEUE-NAME)                          DTSCU829
00202                  REWRITE  ITEM (L829-ITEM-NO)                     DTSCU829
00203                  FROM (L829-REC)                                  DTSCU829
00204                  LENGTH (L829-REC-LENGTH)                         DTSCU829
00205                  MAIN                                             DTSCU829
00206                  RESP (WRK-RESP-CD)                               DTSCU829
00207          END-EXEC                                                 DTSCU829
00208                                                                      CL**2
00209      ELSE                                                         DTSCU829
00210          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00211                                                                      CL**2
00212      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU829
00213          NEXT SENTENCE                                            DTSCU829
00214      ELSE                                                         DTSCU829
00215          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00216  P2200-EXIT.                                                      DTSCU829
00217      EXIT.                                                        DTSCU829
00218      EJECT                                                        DTSCU829
00219  P2300-DELETE-QUEUE.                                              DTSCU829
00220      EXEC CICS                                                    DTSCU829
00221          DELETEQ TS                                               DTSCU829
00222              QUEUE (L829-QUEUE-NAME)                              DTSCU829
00223              RESP (WRK-RESP-CD)                                   DTSCU829
00224      END-EXEC.                                                    DTSCU829
00225                                                                      CL**2
00226      IF WRK-RESP-CD = DFHRESP (QIDERR)                            DTSCU829
00227          PERFORM S1200-QIDERR THRU S1200-EXIT                     DTSCU829
00228      ELSE                                                         DTSCU829
00229      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU829
00230          NEXT SENTENCE                                            DTSCU829
00231      ELSE                                                         DTSCU829
00232          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU829
00233  P2300-EXIT.                                                      DTSCU829
00234      EXIT.                                                        DTSCU829
00235      EJECT                                                        DTSCU829
00236  S1100-ITEMERR.                                                   DTSCU829
00237      SET L829-ITEMERR-88 TO TRUE.                                 DTSCU829
00238  S1100-EXIT.                                                      DTSCU829
00239      EXIT.                                                        DTSCU829
00240      SKIP3                                                        DTSCU829
00241  S1200-QIDERR.                                                    DTSCU829
00242      SET L829-QIDERR-88 TO TRUE.                                  DTSCU829
00243  S1200-EXIT.                                                      DTSCU829
00244      EXIT.                                                        DTSCU829
00245      EJECT                                                        DTSCU829
00246  S899-ABEND.                                                      DTSCU829
00247                                                                      CL**2
00248      EXEC CICS                                                    DTSCU829
00249          ABEND                                                    DTSCU829
00250              ABCODE (WRK-ABEND-CD)                                DTSCU829
00251      END-EXEC.                                                    DTSCU829
00252                                                                      CL**2
00253  S899-EXIT.                                                       DTSCU829
00254      EXIT.                                                        DTSCU829
