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