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