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