00001  IDENTIFICATION DIVISION.                                         09/30/98
00002  PROGRAM-ID.             DTSCU827.                                DTSCU827
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           APRIL 1994.                              DTSCU827
00005  DATE-COMPILED.                                                   DTSCU827
00006      SKIP3                                                        DTSCU827
00007 *****                                                             DTSCU827
00008 *                                                                 DTSCU827
00009 *    FUNCTION:  VSAM KSDS WORK FILE INPUT/OUTPUT.                 DTSCU827
00010 *                                                                 DTSCU827
00011 *                                                                 DTSCU827
00012 *    MODIFICATION LOG:                                            DTSCU827
00013 *                                                                 DTSCU827
00014 *    04/12/94  INITIAL DEVELOPMENT.                               DTSCU827
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCU827
00016 *                                                                 DTSCU827
00017 *    09/29/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 *                                                                 DTSCU827
00024 *                                                                 DTSCU827
00025 *    DESCRIPTION:                                                 DTSCU827
00026 *                                                                 DTSCU827
00027 *        DTSCU827 PERFORMS ALL REQUIRED VSAM WORK FILE               CL**2
00028 *        INPUT/OUTPUT.  DTSCU827'S COMMAREA CONSISTS OF              CL**2
00029 *        DTSIL827, FOLLOWED BY DTSIVSKL. SEE DFHCOMMAREA             CL**2
00030 *        OF THIS MODULE FOR AN EXAMPLE.                           DTSCU827
00031 *                                                                 DTSCU827
00032 *****                                                             DTSCU827
00033      SKIP3                                                        DTSCU827
00034  ENVIRONMENT DIVISION.                                            DTSCU827
00035      SKIP3                                                        DTSCU827
00036  DATA DIVISION.                                                   DTSCU827
00037      SKIP3                                                        DTSCU827
00038  WORKING-STORAGE SECTION.                                         DTSCU827
000385 77  PAN-VALET PICTURE X(24) VALUE '004DTSCU827  09/30/98'.       DTSCU827
00039      SKIP3                                                        DTSCU827
00040  01  WRK-AREA.                                                    DTSCU827
00041      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U827'.    DTSCU827
00042                                                                      CL**2
00043      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU827
00044                                                                      CL**2
00045 *****05  WRK-TEST-FILE-NAME          PIC X(08)  VALUE 'DTSFWRK'.     CL**2
00046                                                                      CL**2
00047 *****05  WRK-TCL-FILE-NAME           PIC X(08)  VALUE 'DTSTWRK'.     CL**2
00048                                                                      CL**2
00049      05  WRK-PROD-FILE-NAME          PIC X(08)  VALUE 'DTSFWRK'.     CL**2
00050                                                                      CL**2
00051      05  EMSG-NOT-AVAILABLE.                                      DTSCU827
00052          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU827
00053          10  FILLER                  PIC  X(06)  VALUE 'FILE  '.  DTSCU827
00054          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU827
00055          10  FILLER                  PIC  X(33)                   DTSCU827
00056                VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.         DTSCU827
00057                                                                      CL**2
00058                                                                      CL**2
00059 *****05  WRK-CICS-APPLID             PIC X(08).                      CL**2
00060                                                                      CL**2
00061 *****05  WRK-CICS-OP-ID              PIC X(08).                      CL**2
00062 *********88  WRK-TCL-OP-ID-88       VALUES 'CE0756'                  CL**2
00063 *******************************************'CE3568'                  CL**2
00064 *******************************************'C84986'.                 CL**2
00065                                                                      CL**2
00066      05  WRK-FILE-NAME               PIC X(08).                   DTSCU827
00067                                                                      CL**2
00068      05  WRK-REC-LENGTH              PIC S9(04)  COMP.            DTSCU827
00069      EJECT                                                        DTSCU827
00070  01  VLEN-LITERALS.                                               DTSCU827
00071  ++INCLUDE DTSIVLEN                                                  CL**3
00072      EJECT                                                        DTSCU827
00073  01  VIO-REC.                                                     DTSCU827
00074  ++INCLUDE DTSIVSKL                                                  CL**3
00075      EJECT                                                        DTSCU827
00076  LINKAGE SECTION.                                                 DTSCU827
00077      SKIP3                                                        DTSCU827
00078  01  DFHCOMMAREA.                                                 DTSCU827
00079      05  L827-CONTROL-BLOCK.                                      DTSCU827
00080  ++INCLUDE DTSIL827                                                  CL**3
00081      SKIP3                                                        DTSCU827
00082      05  VCOMM-REC.                                               DTSCU827
00083  ++INCLUDE DTSIVSKL                                                  CL**3
00084      SKIP3                                                        DTSCU827
00085      05  VCOR-REC REDEFINES VCOMM-REC.                            DTSCU827
00086  ++INCLUDE DTSIVCOR                                                  CL**3
00087      EJECT                                                        DTSCU827
00088  PROCEDURE DIVISION.                                              DTSCU827
00089      SKIP2                                                        DTSCU827
00090 *****EXEC CICS                                                    DTSCU827
00091 *****    ASSIGN                                                   DTSCU827
00092 *****       APPLID (WRK-CICS-APPLID)                              DTSCU827
00093 *****END-EXEC.                                                    DTSCU827
00094 *****                                                                CL**2
00095 *****IF WRK-CICS-APPLID = 'CICSAORT'                              DTSCU827
00096 *****   EXEC CICS                                                 DTSCU827
00097 *****       ASSIGN                                                DTSCU827
00098 *****          USERID (WRK-CICS-OP-ID)                            DTSCU827
00099 *****   END-EXEC                                                  DTSCU827
00100 *****                                                                CL**2
00101 *****   IF WRK-TCL-OP-ID-88                                       DTSCU827
00102 *****      MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME                DTSCU827
00103 *****   ELSE                                                      DTSCU827
00104 *****      MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME               DTSCU827
00105 *****ELSE                                                         DTSCU827
00106         MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME.                 DTSCU827
00107                                                                      CL**2
00108      MOVE SPACES TO L827-MSG-AREA.                                DTSCU827
00109                                                                      CL**4
00110      SET L827-OK-88 TO TRUE.                                      DTSCU827
00111                                                                      CL**2
00112      IF L827-READ-NEXT-88                                         DTSCU827
00113          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU827
00114      ELSE                                                         DTSCU827
00115      IF L827-READ-88                                              DTSCU827
00116          PERFORM P1100-READ THRU P1100-EXIT                       DTSCU827
00117      ELSE                                                         DTSCU827
00118      IF L827-START-BROWSE-88                                      DTSCU827
00119          PERFORM P2100-START-BROWSE THRU P2100-EXIT               DTSCU827
00120      ELSE                                                         DTSCU827
00121      IF L827-END-BROWSE-88                                        DTSCU827
00122          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU827
00123      ELSE                                                         DTSCU827
00124      IF L827-READ-PREV-88                                         DTSCU827
00125          PERFORM P2300-READ-PREV THRU P2300-EXIT                  DTSCU827
00126      ELSE                                                         DTSCU827
00127      IF L827-WRITE-88                                             DTSCU827
00128          PERFORM P3100-WRITE THRU P3100-EXIT                      DTSCU827
00129      ELSE                                                         DTSCU827
00130      IF L827-REWRITE-88                                           DTSCU827
00131          PERFORM P3200-REWRITE THRU P3200-EXIT                    DTSCU827
00132      ELSE                                                         DTSCU827
00133      IF L827-DELETE-88                                            DTSCU827
00134          PERFORM P3300-DELETE THRU P3300-EXIT                     DTSCU827
00135      ELSE                                                         DTSCU827
00136          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00137                                                                      CL**4
00138                                                                      CL**4
00139      EXEC CICS                                                    DTSCU827
00140          RETURN                                                   DTSCU827
00141      END-EXEC.                                                    DTSCU827
00142                                                                      CL**4
00143                                                                      CL**4
00144      GOBACK.                                                      DTSCU827
00145      EJECT                                                        DTSCU827
00146  P1100-READ.                                                      DTSCU827
00147      MOVE LOW-VALUES TO VIO-REC.                                  DTSCU827
00148                                                                      CL**4
00149      MOVE VSKL-KEY-AREA OF VCOMM-REC TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
00150                                                                      CL**4
00151      MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU827
00152                                                                      CL**2
00153      EXEC CICS                                                    DTSCU827
00154          READ                                                     DTSCU827
00155              DATASET (WRK-FILE-NAME)                              DTSCU827
00156              INTO (VIO-REC)                                       DTSCU827
00157              LENGTH (WRK-REC-LENGTH)                              DTSCU827
00158              RIDFLD (VSKL-KEY-AREA OF VIO-REC)                    DTSCU827
00159              RESP (WRK-RESP-CD)                                   DTSCU827
00160      END-EXEC.                                                    DTSCU827
00161                                                                      CL**2
00162      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU827
00163                         OR DFHRESP (SYSIDERR)                     DTSCU827
00164          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00165          GO TO P1100-EXIT.                                        DTSCU827
00166                                                                      CL**2
00167      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU827
00168          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00169          GO TO P1100-EXIT.                                        DTSCU827
00170                                                                      CL**2
00171      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00172          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU827
00173      ELSE                                                         DTSCU827
00174          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00175  P1100-EXIT.                                                      DTSCU827
00176      EXIT.                                                        DTSCU827
00177      EJECT                                                        DTSCU827
00178  P2100-START-BROWSE.                                              DTSCU827
00179      MOVE LOW-VALUES TO VIO-REC.                                  DTSCU827
00180                                                                      CL**4
00181      MOVE VSKL-KEY-AREA OF VCOMM-REC TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
00182                                                                      CL**2
00183      EXEC CICS                                                    DTSCU827
00184          STARTBR                                                  DTSCU827
00185              DATASET (WRK-FILE-NAME)                              DTSCU827
00186              RIDFLD (VSKL-KEY-AREA OF VIO-REC)                    DTSCU827
00187              RESP (WRK-RESP-CD)                                   DTSCU827
00188      END-EXEC.                                                    DTSCU827
00189                                                                      CL**2
00190      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU827
00191                         OR DFHRESP (SYSIDERR)                     DTSCU827
00192          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00193          GO TO P2100-EXIT.                                        DTSCU827
00194                                                                      CL**2
00195      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU827
00196          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00197          GO TO P2100-EXIT.                                        DTSCU827
00198                                                                      CL**2
00199      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00200          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU827
00201      ELSE                                                         DTSCU827
00202          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00203  P2100-EXIT.                                                      DTSCU827
00204      EXIT.                                                        DTSCU827
00205      EJECT                                                        DTSCU827
00206  P2200-READ-NEXT.                                                 DTSCU827
00207      IF L827-READ-NEXT-88                                         DTSCU827
00208          MOVE LOW-VALUES TO VIO-REC                               DTSCU827
00209          MOVE VSKL-KEY-AREA OF VCOMM-REC                          DTSCU827
00210            TO VSKL-KEY-AREA OF VIO-REC.                           DTSCU827
00211                                                                      CL**2
00212      MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU827
00213                                                                      CL**2
00214      EXEC CICS                                                    DTSCU827
00215          READNEXT                                                 DTSCU827
00216              DATASET (WRK-FILE-NAME)                              DTSCU827
00217              INTO (VIO-REC)                                       DTSCU827
00218              LENGTH (WRK-REC-LENGTH)                              DTSCU827
00219              RIDFLD (VSKL-KEY-AREA OF VIO-REC)                    DTSCU827
00220              RESP (WRK-RESP-CD)                                   DTSCU827
00221      END-EXEC.                                                    DTSCU827
00222                                                                      CL**2
00223      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU827
00224                         OR DFHRESP (SYSIDERR)                     DTSCU827
00225          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00226          GO TO P2200-EXIT.                                        DTSCU827
00227                                                                      CL**2
00228      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU827
00229          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00230          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU827
00231          GO TO P2200-EXIT.                                        DTSCU827
00232                                                                      CL**2
00233      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00234          NEXT SENTENCE                                            DTSCU827
00235      ELSE                                                         DTSCU827
00236          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00237                                                                      CL**2
00238      IF VSKL-REC-TYPE OF VIO-REC = VSKL-REC-TYPE OF VCOMM-REC     DTSCU827
00239          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU827
00240      ELSE                                                         DTSCU827
00241          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00242          PERFORM P2400-END-BROWSE THRU P2400-EXIT.                DTSCU827
00243  P2200-EXIT.                                                      DTSCU827
00244      EXIT.                                                        DTSCU827
00245      EJECT                                                        DTSCU827
00246  P2300-READ-PREV.                                                 DTSCU827
00247      MOVE LOW-VALUES TO VIO-REC.                                  DTSCU827
00248                                                                      CL**4
00249      MOVE VSKL-KEY-AREA OF VCOMM-REC                              DTSCU827
00250        TO VSKL-KEY-AREA OF VIO-REC.                               DTSCU827
00251                                                                      CL**2
00252      MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU827
00253                                                                      CL**2
00254      EXEC CICS                                                    DTSCU827
00255          READPREV                                                 DTSCU827
00256              DATASET (WRK-FILE-NAME)                              DTSCU827
00257              INTO (VIO-REC)                                       DTSCU827
00258              LENGTH (WRK-REC-LENGTH)                              DTSCU827
00259              RIDFLD (VSKL-KEY-AREA OF VIO-REC)                    DTSCU827
00260              RESP (WRK-RESP-CD)                                   DTSCU827
00261      END-EXEC.                                                    DTSCU827
00262                                                                      CL**2
00263      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU827
00264                         OR DFHRESP (SYSIDERR)                     DTSCU827
00265          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00266          GO TO P2300-EXIT.                                        DTSCU827
00267                                                                      CL**2
00268      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU827
00269          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00270          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU827
00271          GO TO P2300-EXIT.                                        DTSCU827
00272                                                                      CL**2
00273      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00274          NEXT SENTENCE                                            DTSCU827
00275      ELSE                                                         DTSCU827
00276          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00277                                                                      CL**2
00278      IF VSKL-REC-TYPE OF VIO-REC = VSKL-REC-TYPE OF VCOMM-REC     DTSCU827
00279          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU827
00280      ELSE                                                         DTSCU827
00281          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00282          PERFORM P2400-END-BROWSE THRU P2400-EXIT.                DTSCU827
00283  P2300-EXIT.                                                      DTSCU827
00284      EXIT.                                                        DTSCU827
00285      EJECT                                                        DTSCU827
00286  P2400-END-BROWSE.                                                DTSCU827
00287      EXEC CICS                                                    DTSCU827
00288          ENDBR                                                    DTSCU827
00289              DATASET (WRK-FILE-NAME)                              DTSCU827
00290              RESP (WRK-RESP-CD)                                   DTSCU827
00291      END-EXEC.                                                    DTSCU827
00292                                                                      CL**2
00293      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU827
00294                         OR DFHRESP (SYSIDERR)                     DTSCU827
00295          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00296          GO TO P2400-EXIT.                                        DTSCU827
00297                                                                      CL**2
00298      IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ)        DTSCU827
00299          NEXT SENTENCE                                            DTSCU827
00300      ELSE                                                         DTSCU827
00301          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00302  P2400-EXIT.                                                      DTSCU827
00303      EXIT.                                                        DTSCU827
00304      EJECT                                                        DTSCU827
00305  P3100-WRITE.                                                     DTSCU827
00306      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU827
00307                                                                      CL**4
00308      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU827
00309                                                                      CL**2
00310      EXEC CICS                                                    DTSCU827
00311          WRITE                                                    DTSCU827
00312              DATASET (WRK-FILE-NAME)                              DTSCU827
00313              FROM (VIO-REC)                                       DTSCU827
00314              LENGTH (WRK-REC-LENGTH)                              DTSCU827
00315              RIDFLD (VSKL-KEY-AREA OF VIO-REC)                    DTSCU827
00316              RESP (WRK-RESP-CD)                                   DTSCU827
00317      END-EXEC.                                                    DTSCU827
00318                                                                      CL**2
00319      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU827
00320                         OR DFHRESP (SYSIDERR)                     DTSCU827
00321          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00322          GO TO P3100-EXIT.                                        DTSCU827
00323                                                                      CL**2
00324      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00325          NEXT SENTENCE                                            DTSCU827
00326      ELSE                                                         DTSCU827
00327          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00328  P3100-EXIT.                                                      DTSCU827
00329      EXIT.                                                        DTSCU827
00330      EJECT                                                        DTSCU827
00331  P3200-REWRITE.                                                   DTSCU827
00332      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU827
00333                                                                      CL**4
00334      IF L827-NO-REC-88                                            DTSCU827
00335          PERFORM S899-ABEND THRU S899-EXIT                        DTSCU827
00336      ELSE                                                         DTSCU827
00337      IF L827-FILE-CLOSED-88                                       DTSCU827
00338          GO TO P3200-EXIT.                                        DTSCU827
00339                                                                      CL**2
00340      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU827
00341                                                                      CL**4
00342      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU827
00343                                                                      CL**2
00344      EXEC CICS                                                    DTSCU827
00345          REWRITE                                                  DTSCU827
00346              DATASET (WRK-FILE-NAME)                              DTSCU827
00347              FROM (VIO-REC)                                       DTSCU827
00348              LENGTH (WRK-REC-LENGTH)                              DTSCU827
00349              RESP (WRK-RESP-CD)                                   DTSCU827
00350      END-EXEC.                                                    DTSCU827
00351                                                                      CL**2
00352      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU827
00353                         OR DFHRESP (SYSIDERR)                     DTSCU827
00354          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00355          GO TO P3200-EXIT.                                        DTSCU827
00356                                                                      CL**2
00357      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00358          NEXT SENTENCE                                            DTSCU827
00359      ELSE                                                         DTSCU827
00360          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00361  P3200-EXIT.                                                      DTSCU827
00362      EXIT.                                                        DTSCU827
00363      EJECT                                                        DTSCU827
00364  P3300-DELETE.                                                    DTSCU827
00365      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU827
00366                                                                      CL**4
00367      IF L827-NO-REC-88                                            DTSCU827
00368          PERFORM S899-ABEND THRU S899-EXIT                        DTSCU827
00369      ELSE                                                         DTSCU827
00370      IF L827-FILE-CLOSED-88                                       DTSCU827
00371          GO TO P3300-EXIT.                                        DTSCU827
00372                                                                      CL**2
00373      EXEC CICS                                                    DTSCU827
00374          DELETE                                                   DTSCU827
00375              DATASET (WRK-FILE-NAME)                              DTSCU827
00376              RESP (WRK-RESP-CD)                                   DTSCU827
00377      END-EXEC.                                                    DTSCU827
00378                                                                      CL**2
00379      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU827
00380                         OR DFHRESP (SYSIDERR)                     DTSCU827
00381          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00382          GO TO P3300-EXIT.                                        DTSCU827
00383                                                                      CL**2
00384      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00385          NEXT SENTENCE                                            DTSCU827
00386      ELSE                                                         DTSCU827
00387          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00388  P3300-EXIT.                                                      DTSCU827
00389      EXIT.                                                        DTSCU827
00390      EJECT                                                        DTSCU827
00391  S1100-NOT-AVAILABLE.                                             DTSCU827
00392      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU827
00393                                                                      CL**4
00394      MOVE EMSG-NOT-AVAILABLE TO L827-MSG-AREA.                    DTSCU827
00395                                                                      CL**4
00396      SET L827-FILE-CLOSED-88 TO TRUE.                             DTSCU827
00397  S1100-EXIT.                                                      DTSCU827
00398      EXIT.                                                        DTSCU827
00399      SKIP3                                                        DTSCU827
00400  S1200-NOT-FOUND.                                                 DTSCU827
00401      SET L827-NO-REC-88 TO TRUE.                                  DTSCU827
00402  S1200-EXIT.                                                      DTSCU827
00403      EXIT.                                                        DTSCU827
00404      EJECT                                                        DTSCU827
00405 ******************************************************************DTSCU827
00406 *  IF ADDITIONAL RECORD TYPES ARE ADDED, SEE DTSCU823 AND            CL**2
00407 *  DTSCU831 FOR EXAMPLES OF THE FOLLOWING THREE PARAGRAPH SETS.      CL**2
00408 ******************************************************************DTSCU827
00409      SKIP3                                                        DTSCU827
00410  S2100-IO-TO-COMM.                                                DTSCU827
00411      IF VSKL-COR-88 OF VIO-REC                                    DTSCU827
00412          MOVE VIO-REC TO VCOR-REC                                 DTSCU827
00413      ELSE                                                         DTSCU827
00414          GO TO S899-ABEND.                                        DTSCU827
00415  S2100-EXIT.                                                      DTSCU827
00416      EXIT.                                                        DTSCU827
00417      SKIP3                                                        DTSCU827
00418  S2200-COMM-TO-IO.                                                DTSCU827
00419      IF VSKL-COR-88 OF VCOMM-REC                                  DTSCU827
00420          MOVE LOW-VALUES TO VCOR-KEY-FILLER                       DTSCU827
00421          MOVE VCOR-REC TO VIO-REC                                 DTSCU827
00422      ELSE                                                         DTSCU827
00423          GO TO S899-ABEND.                                        DTSCU827
00424  S2200-EXIT.                                                      DTSCU827
00425      EXIT.                                                        DTSCU827
00426      SKIP3                                                        DTSCU827
00427  S2300-CALCULATE-LENGTH.                                          DTSCU827
00428      IF VSKL-COR-88 OF VIO-REC                                    DTSCU827
00429          MOVE VLEN-COR-LENGTH TO WRK-REC-LENGTH                   DTSCU827
00430      ELSE                                                         DTSCU827
00431          GO TO S899-ABEND.                                        DTSCU827
00432  S2300-EXIT.                                                      DTSCU827
00433      EXIT.                                                        DTSCU827
00434      EJECT                                                        DTSCU827
00435  S3100-READ-UPDATE.                                               DTSCU827
00436      MOVE LOW-VALUES TO VIO-REC.                                  DTSCU827
00437                                                                      CL**4
00438      MOVE VSKL-KEY-AREA OF VCOMM-REC TO VSKL-KEY-AREA OF VIO-REC. DTSCU827
00439                                                                      CL**4
00440      MOVE VLEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU827
00441                                                                      CL**2
00442      EXEC CICS                                                    DTSCU827
00443          READ                                                     DTSCU827
00444              DATASET (WRK-FILE-NAME)                              DTSCU827
00445              INTO (VIO-REC)                                       DTSCU827
00446              LENGTH (WRK-REC-LENGTH)                              DTSCU827
00447              RIDFLD (VSKL-KEY-AREA OF VIO-REC)                    DTSCU827
00448              UPDATE                                               DTSCU827
00449              RESP (WRK-RESP-CD)                                   DTSCU827
00450      END-EXEC.                                                    DTSCU827
00451                                                                      CL**2
00452      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU827
00453                         OR DFHRESP (SYSIDERR)                     DTSCU827
00454          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU827
00455          GO TO S3100-EXIT.                                        DTSCU827
00456                                                                      CL**2
00457      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU827
00458          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU827
00459          GO TO S3100-EXIT.                                        DTSCU827
00460                                                                      CL**2
00461      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU827
00462          NEXT SENTENCE                                            DTSCU827
00463      ELSE                                                         DTSCU827
00464          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU827
00465  S3100-EXIT.                                                      DTSCU827
00466      EXIT.                                                        DTSCU827
00467      EJECT                                                        DTSCU827
00468  S899-ABEND.                                                      DTSCU827
00469                                                                      CL**2
00470      EXEC CICS                                                    DTSCU827
00471          ABEND                                                    DTSCU827
00472              ABCODE (WRK-ABEND-CD)                                DTSCU827
00473      END-EXEC.                                                    DTSCU827
00474                                                                      CL**2
00475  S899-EXIT.                                                       DTSCU827
00476      EXIT.                                                        DTSCU827
