00001  IDENTIFICATION DIVISION.                                         07/08/08
00002  PROGRAM-ID.             DTSCU821.                                DTSCU821
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV012
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU821
00005  DATE-COMPILED.                                                   DTSCU821
00006      SKIP3                                                        DTSCU821
00007 *****                                                             DTSCU821
00008 *                                                                 DTSCU821
00009 *    FUNCTION:  ALTERNATE INDEX FILE INPUT/OUTPUT.                DTSCU821
00010 *                                                                 DTSCU821
00011 *                                                                 DTSCU821
00012 *    MODIFICATION LOG:                                            DTSCU821
00013 *                                                                 DTSCU821
00014 *    11/13/91  INITIAL DEVELOPMENT.                               DTSCU821
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU821
00016 *                                                                 DTSCU821
00017 *    04/12/94  MODIFIED FOR MONTANA.                              DTSCU821
00018 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCU821
00019 *                                                                 DTSCU821
00020 *    09/18/95  IWHO RECORD PROCESSING ADDED.                      DTSCU821
00021 *              WORK ORDER: JR                   PROGRAMMER: EHH   DTSCU821
00022 *                                                                 DTSCU821
00023 *    08/31/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCU821
00024 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU821
00025 *                                                                 DTSCU821
00026 *                                                                 DTSCU821
00027 *    04/24/2004  RECOMPILED FOR NEW IIPES COPYBOOK                DTSCU821
00028 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: ZL1   DTSCU821
00029 *                                                                 DTSCU821
00030 *    02/15/2008  UPDATED FOR IRFD REFUND AIX RECORD.              DTSCU821
00031 *                REFERENCE: CFO REFUNDS         PROGRAMMER: GD    DTSCU821
00032 *                                                                 DTSCU821
00033 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU821
00034 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU821
00035 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU821
00036 *                                                                 DTSCU821
00037 *                                                                 DTSCU821
00038 *    DESCRIPTION:                                                 DTSCU821
00039 *                                                                 DTSCU821
00040 *        DTSCU821 PERFORMS ALL REQUIRED ALTERNATE INDEX FILE      DTSCU821
00041 *        INPUT/OUTPUT.  DTSCU821'S COMMAREA CONSISTS OF           DTSCU821
00042 *        DTSIL821, FOLLOWED BY DTSIISKL. SEE DFHCOMMAREA          DTSCU821
00043 *        OF THIS MODULE FOR AN EXAMPLE.                           DTSCU821
00044 *                                                                 DTSCU821
00045 *                                                                 DTSCU821
00046 *    GENERAL SPECIFICATIONS:                                      DTSCU821
00047 *                                                                 DTSCU821
00048 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSCU821
00049 *        MODULE.                                                  DTSCU821
00050 *                                                                 DTSCU821
00051 *        IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN      DTSCU821
00052 *        NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED,           DTSCU821
00053 *        THEN ABEND THE MODULE (TOLERATE AN INVREQ FROM AN        DTSCU821
00054 *        ENDBR).                                                  DTSCU821
00055 *                                                                 DTSCU821
00056 *        SPECIFY IIO-REC AS THE INTO OR FROM AREA OF THE CICS     DTSCU821
00057 *        FILE COMMAND.                                            DTSCU821
00058 *                                                                 DTSCU821
00059 *        SPECIFY ISKL-KEY-AREA OF IIO-REC AS THE RIDFLD OF        DTSCU821
00060 *        THE CICS FILE COMMANDS.                                  DTSCU821
00061 *                                                                 DTSCU821
00062 *                                                                 DTSCU821
00063 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSCU821
00064 *                                                                 DTSCU821
00065 *    READ                                                         DTSCU821
00066 *                                                                 DTSCU821
00067 *    STARTBR                                                      DTSCU821
00068 *        PERFORM A STARTBR.  IF THE STARTBR IS                    DTSCU821
00069 *        SUCCESSFUL, THEN PERFORM A READNEXT.  IF THE             DTSCU821
00070 *        READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN        DTSCU821
00071 *        L821-NO-REC-88.  IF THE READNEXT YIELDS A REC-TYPE       DTSCU821
00072 *        NOT EQUAL TO THE REQUESTED REC-TYPE (ISKL-REC-TYPE OF    DTSCU821
00073 *        IIO-REC NOT EQUAL TO ISKL-REC-TYPE OF ICOMM-REC), THEN   DTSCU821
00074 *        RETURN L821-NO-REC-88.                                   DTSCU821
00075 *                                                                 DTSCU821
00076 *        IF THE READNEXT YIELDS A L821-NO-REC-88, THEN ISSUE      DTSCU821
00077 *        AN ENDBR.                                                DTSCU821
00078 *                                                                 DTSCU821
00079 *    READNEXT                                                     DTSCU821
00080 *        PRIOR TO THE READNEXT, MOVE ISKL-KEY-AREA OF             DTSCU821
00081 *        ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC.  IF THE           DTSCU821
00082 *        READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN        DTSCU821
00083 *        L821-NO-REC-88.  IF THE READNEXT YIELDS A REC-TYPE       DTSCU821
00084 *        NOT EQUAL TO THE REQUESTED REC-TYPE (ISKL-REC-TYPE OF    DTSCU821
00085 *        IIO-REC NOT EQUAL TO ISKL-REC-TYPE OF ICOMM-REC), THEN   DTSCU821
00086 *        RETURN L821-NO-REC-88.                                   DTSCU821
00087 *                                                                 DTSCU821
00088 *        IF THE READNEXT YIELDS A L821-NO-REC-88, THEN ISSUE      DTSCU821
00089 *        AN ENDBR.                                                DTSCU821
00090 *                                                                 DTSCU821
00091 *    READPREV                                                     DTSCU821
00092 *        PRIOR TO THE READPREV, MOVE ISKL-KEY-AREA OF             DTSCU821
00093 *        ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC.  IF THE           DTSCU821
00094 *        READPREV YIELDS AN END FILE CONDITION, THEN RETURN       DTSCU821
00095 *        L821-NO-REC-88.  IF THE READPREV YIELDS A REC-TYPE       DTSCU821
00096 *        NOT EQUAL TO THE REQUESTED REC-TYPE (ISKL-REC-TYPE OF    DTSCU821
00097 *        IIO-REC NOT EQUAL TO ISKL-REC-TYPE OF ICOMM-REC), THEN   DTSCU821
00098 *        RETURN L821-NO-REC-88.                                   DTSCU821
00099 *                                                                 DTSCU821
00100 *        IF THE READPREV YIELDS A L821-NO-REC-88, THEN ISSUE      DTSCU821
00101 *        AN ENDBR.                                                DTSCU821
00102 *                                                                 DTSCU821
00103 *    ENDBR                                                        DTSCU821
00104 *        TOLERATE THE INVREQ CONDITION.                           DTSCU821
00105 *                                                                 DTSCU821
00106 *    WRITE                                                        DTSCU821
00107 *        PRIOR TO THE MOVE FROM ICOMM-REC TO IIO-REC, INITIALIZE  DTSCU821
00108 *        THE APPROPRIATE I***-KEY-FILLER AREA TO LOW-VALUES.      DTSCU821
00109 *                                                                 DTSCU821
00110 *    REWRITE                                                      DTSCU821
00111 *        REWRITE IS NOT A VALID COMMAND.  THE ALTERNATE INDEX     DTSCU821
00112 *        FILE KEY AREA IS EQUAL TO THE ALTERNATE INDEX FILE       DTSCU821
00113 *        RECORD, THUS A REWRITE COMMAND IS NOT POSSIBLE.          DTSCU821
00114 *                                                                 DTSCU821
00115 *    DELETE                                                       DTSCU821
00116 *        READ (WITH UPDATE) THE RECORD.  IF NOT FOUND, THEN ABEND.DTSCU821
00117 *        DELETE.                                                  DTSCU821
00118 *                                                                 DTSCU821
00119 *****                                                             DTSCU821
00120      SKIP3                                                        DTSCU821
00121  ENVIRONMENT DIVISION.                                            DTSCU821
00122      SKIP3                                                        DTSCU821
00123  DATA DIVISION.                                                   DTSCU821
00124      SKIP3                                                        DTSCU821
00125  WORKING-STORAGE SECTION.                                         DTSCU821
001255 77  PAN-VALET PICTURE X(24) VALUE '012DTSCU821  07/08/08'.       DTSCU821
00126      SKIP3                                                        DTSCU821
00127  01  WRK-AREA.                                                    DTSCU821
00128      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U821'.    DTSCU821
00129                                                                   DTSCU821
00130      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU821
00131                                                                   DTSCU821
00132                                                                   DTSCU821
00133      05  WRK-PROD-FILE-NAME          PIC  X(08)  VALUE 'DTSFAIX'. DTSCU821
00134                                                                   DTSCU821
00135      05  WRK-COMB-FILE-NAME          PIC  X(08)  VALUE 'DTSCAIX'. DTSCU821
00136                                                                   DTSCU821
00137                                                                   DTSCU821
00138      05  EMSG-NOT-AVAILABLE.                                      DTSCU821
00139          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU821
00140          10  FILLER                  PIC  X(06)  VALUE 'FILE  '.  DTSCU821
00141          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU821
00142          10  FILLER                  PIC  X(33)                   DTSCU821
00143        VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.                 DTSCU821
00144                                                                   DTSCU821
00145                                                                   DTSCU821
00146      05  WRK-FILE-NAME               PIC  X(08).                  DTSCU821
00147                                                                   DTSCU821
00148                                                                   DTSCU821
00149      05  WRK-REC-LENGTH              PIC S9(04)  COMP.            DTSCU821
00150      EJECT                                                        DTSCU821
00151  01  ILEN-LENGTH-LITERALS.                                        DTSCU821
00152  ++INCLUDE DTSIILEN                                               DTSCU821
00153      EJECT                                                        DTSCU821
00154  01  IIO-REC.                                                     DTSCU821
00155  ++INCLUDE DTSIISKL                                               DTSCU821
00156      EJECT                                                        DTSCU821
00157  LINKAGE SECTION.                                                 DTSCU821
00158      SKIP3                                                        DTSCU821
00159  01  DFHCOMMAREA.                                                 DTSCU821
00160      05  L821-CONTROL-BLOCK.                                      DTSCU821
00161  ++INCLUDE  DTSIL821                                              DTSCU821
00162      SKIP3                                                        DTSCU821
00163      05  ICOMM-REC.                                               DTSCU821
00164  ++INCLUDE DTSIISKL                                               DTSCU821
00165      SKIP3                                                        DTSCU821
00166      05  IBTB-REC REDEFINES ICOMM-REC.                            DTSCU821
00167  ++INCLUDE DTSIIBTB                                               DTSCU821
00168      SKIP3                                                        DTSCU821
00169      05  IEIN-REC REDEFINES ICOMM-REC.                            DTSCU821
00170  ++INCLUDE DTSIIEIN                                               DTSCU821
00171      SKIP3                                                        DTSCU821
00172      05  IFAN-REC REDEFINES ICOMM-REC.                            DTSCU821
00173  ++INCLUDE DTSIIFAN                                               DTSCU821
00174      SKIP3                                                        DTSCU821
00175      05  IFID-REC REDEFINES ICOMM-REC.                            DTSCU821
00176  ++INCLUDE DTSIIFID                                               DTSCU821
00177      SKIP3                                                        DTSCU821
00178      05  IOPN-REC REDEFINES ICOMM-REC.                            DTSCU821
00179  ++INCLUDE DTSIIOPN                                               DTSCU821
00180      SKIP3                                                        DTSCU821
00181      05  IOPS-REC REDEFINES ICOMM-REC.                            DTSCU821
00182  ++INCLUDE DTSIIOPS                                               DTSCU821
00183      SKIP3                                                        DTSCU821
00184      05  IPES-REC REDEFINES ICOMM-REC.                            DTSCU821
00185  ++INCLUDE DTSIIPES                                               DTSCU821
00186      SKIP3                                                        DTSCU821
00187      05  ITDS-REC REDEFINES ICOMM-REC.                            DTSCU821
00188  ++INCLUDE DTSIITDS                                               DTSCU821
00189      SKIP3                                                        DTSCU821
00190      05  IZIP-REC REDEFINES ICOMM-REC.                            DTSCU821
00191  ++INCLUDE DTSIIZIP                                               DTSCU821
00192      SKIP3                                                        DTSCU821
00193      05  IBTN-REC REDEFINES ICOMM-REC.                            DTSCU821
00194  ++INCLUDE DTSIIBTN                                               DTSCU821
00195      SKIP3                                                        DTSCU821
00196      05  IENM-REC REDEFINES ICOMM-REC.                            DTSCU821
00197  ++INCLUDE DTSIIENM                                               DTSCU821
00198      SKIP3                                                        DTSCU821
00199      05  IEAL-REC REDEFINES ICOMM-REC.                            DTSCU821
00200  ++INCLUDE DTSIIEAL                                               DTSCU821
00201      SKIP3                                                        DTSCU821
00202      05  IEAE-REC REDEFINES ICOMM-REC.                            DTSCU821
00203  ++INCLUDE DTSIIEAE                                               DTSCU821
00204      SKIP3                                                        DTSCU821
00205      05  IEBX-REC REDEFINES ICOMM-REC.                            DTSCU821
00206  ++INCLUDE DTSIIEBX                                               DTSCU821
00207      SKIP3                                                        DTSCU821
00208      05  IEOP-REC REDEFINES ICOMM-REC.                            DTSCU821
00209  ++INCLUDE DTSIIEOP                                               DTSCU821
00210      SKIP3                                                        DTSCU821
00211      05  IESR-REC REDEFINES ICOMM-REC.                            DTSCU821
00212  ++INCLUDE DTSIIESR                                               DTSCU821
00213      SKIP3                                                        DTSCU821
00214      05  IEER-REC REDEFINES ICOMM-REC.                            DTSCU821
00215  ++INCLUDE DTSIIEER                                               DTSCU821
00216      SKIP3                                                        DTSCU821
00217      05  IEET-REC REDEFINES ICOMM-REC.                            DTSCU821
00218  ++INCLUDE DTSIIEET                                               DTSCU821
00219      SKIP3                                                        DTSCU821
00220      05  IEPR-REC REDEFINES ICOMM-REC.                            DTSCU821
00221  ++INCLUDE DTSIIEPR                                               DTSCU821
00222                                                                   DTSCU821
00223      05  ITRT-REC REDEFINES ICOMM-REC.                            DTSCU821
00224  ++INCLUDE DTSIITRT                                               DTSCU821
00225                                                                   DTSCU821
00226      05  ITRE-REC REDEFINES ICOMM-REC.                            DTSCU821
00227  ++INCLUDE DTSIITRE                                               DTSCU821
00228                                                                   DTSCU821
00229      05  IRFD-REC REDEFINES ICOMM-REC.                            DTSCU821
00230  ++INCLUDE DTSIIRFD                                               DTSCU821
00231      EJECT                                                        DTSCU821
00232  PROCEDURE DIVISION.                                              DTSCU821
00233      SKIP2                                                        DTSCU821
00234      IF EIBTRNID = 'DTSC'                                         DTSCU821
00235          MOVE WRK-COMB-FILE-NAME TO WRK-FILE-NAME                 DTSCU821
00236      ELSE                                                         DTSCU821
00237          MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME.                DTSCU821
00238                                                                   DTSCU821
00239                                                                   DTSCU821
00240      MOVE SPACES TO L821-MSG-AREA.                                DTSCU821
00241                                                                   DTSCU821
00242      SET L821-OK-88 TO TRUE.                                      DTSCU821
00243                                                                   DTSCU821
00244                                                                   DTSCU821
00245      IF L821-READ-NEXT-88                                         DTSCU821
00246          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU821
00247      ELSE                                                         DTSCU821
00248      IF L821-READ-88                                              DTSCU821
00249          PERFORM P1100-READ THRU P1100-EXIT                       DTSCU821
00250      ELSE                                                         DTSCU821
00251      IF L821-START-BROWSE-88                                      DTSCU821
00252          PERFORM P2100-START-BROWSE THRU P2100-EXIT               DTSCU821
00253      ELSE                                                         DTSCU821
00254      IF L821-END-BROWSE-88                                        DTSCU821
00255          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU821
00256      ELSE                                                         DTSCU821
00257      IF L821-READ-PREV-88                                         DTSCU821
00258          PERFORM P2300-READ-PREV THRU P2300-EXIT                  DTSCU821
00259      ELSE                                                         DTSCU821
00260      IF L821-WRITE-88                                             DTSCU821
00261          PERFORM P3100-WRITE THRU P3100-EXIT                      DTSCU821
00262      ELSE                                                         DTSCU821
00263      IF L821-DELETE-88                                            DTSCU821
00264          PERFORM P3300-DELETE THRU P3300-EXIT                     DTSCU821
00265      ELSE                                                         DTSCU821
00266          GO TO S899-ABEND.                                        DTSCU821
00267                                                                   DTSCU821
00268                                                                   DTSCU821
00269      EXEC CICS                                                    DTSCU821
00270          RETURN                                                   DTSCU821
00271      END-EXEC.                                                    DTSCU821
00272                                                                   DTSCU821
00273                                                                   DTSCU821
00274      GOBACK.                                                      DTSCU821
00275      EJECT                                                        DTSCU821
00276  P1100-READ.                                                      DTSCU821
00277      MOVE LOW-VALUE TO IIO-REC.                                   DTSCU821
00278                                                                   DTSCU821
00279      MOVE ISKL-KEY-AREA OF ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. DTSCU821
00280                                                                   DTSCU821
00281      MOVE ILEN-LENGTH TO WRK-REC-LENGTH.                          DTSCU821
00282                                                                   DTSCU821
00283      EXEC CICS                                                    DTSCU821
00284          READ                                                     DTSCU821
00285              DATASET (WRK-FILE-NAME)                              DTSCU821
00286              INTO (IIO-REC)                                       DTSCU821
00287              LENGTH (WRK-REC-LENGTH)                              DTSCU821
00288              RIDFLD (ISKL-KEY-AREA OF IIO-REC)                    DTSCU821
00289              RESP (WRK-RESP-CD)                                   DTSCU821
00290      END-EXEC.                                                    DTSCU821
00291                                                                   DTSCU821
00292      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU821
00293                         OR DFHRESP (SYSIDERR)                     DTSCU821
00294          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00295          GO TO P1100-EXIT.                                        DTSCU821
00296                                                                   DTSCU821
00297      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU821
00298          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00299          GO TO P1100-EXIT.                                        DTSCU821
00300                                                                   DTSCU821
00301      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00302          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU821
00303      ELSE                                                         DTSCU821
00304          GO TO S899-ABEND.                                        DTSCU821
00305  P1100-EXIT.                                                      DTSCU821
00306      EXIT.                                                        DTSCU821
00307      EJECT                                                        DTSCU821
00308  P2100-START-BROWSE.                                              DTSCU821
00309      MOVE LOW-VALUE TO IIO-REC.                                   DTSCU821
00310                                                                   DTSCU821
00311      MOVE ISKL-KEY-AREA OF ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. DTSCU821
00312                                                                   DTSCU821
00313      EXEC CICS                                                    DTSCU821
00314          STARTBR                                                  DTSCU821
00315              DATASET (WRK-FILE-NAME)                              DTSCU821
00316              RIDFLD (ISKL-KEY-AREA OF IIO-REC)                    DTSCU821
00317              RESP (WRK-RESP-CD)                                   DTSCU821
00318      END-EXEC.                                                    DTSCU821
00319                                                                   DTSCU821
00320      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU821
00321                         OR DFHRESP (SYSIDERR)                     DTSCU821
00322          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00323          GO TO P2100-EXIT.                                        DTSCU821
00324                                                                   DTSCU821
00325      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU821
00326          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00327          GO TO P2100-EXIT.                                        DTSCU821
00328                                                                   DTSCU821
00329      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00330          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU821
00331      ELSE                                                         DTSCU821
00332          GO TO S899-ABEND.                                        DTSCU821
00333  P2100-EXIT.                                                      DTSCU821
00334      EXIT.                                                        DTSCU821
00335      EJECT                                                        DTSCU821
00336  P2200-READ-NEXT.                                                 DTSCU821
00337      IF L821-READ-NEXT-88                                         DTSCU821
00338          MOVE LOW-VALUE TO IIO-REC                                DTSCU821
00339          MOVE ISKL-KEY-AREA OF ICOMM-REC                          DTSCU821
00340            TO ISKL-KEY-AREA OF IIO-REC.                           DTSCU821
00341                                                                   DTSCU821
00342      MOVE ILEN-LENGTH TO WRK-REC-LENGTH.                          DTSCU821
00343                                                                   DTSCU821
00344      EXEC CICS                                                    DTSCU821
00345          READNEXT                                                 DTSCU821
00346              DATASET (WRK-FILE-NAME)                              DTSCU821
00347              INTO (IIO-REC)                                       DTSCU821
00348              LENGTH (WRK-REC-LENGTH)                              DTSCU821
00349              RIDFLD (ISKL-KEY-AREA OF IIO-REC)                    DTSCU821
00350              RESP (WRK-RESP-CD)                                   DTSCU821
00351      END-EXEC.                                                    DTSCU821
00352                                                                   DTSCU821
00353      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU821
00354                         OR DFHRESP (SYSIDERR)                     DTSCU821
00355          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00356          GO TO P2200-EXIT.                                        DTSCU821
00357                                                                   DTSCU821
00358      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU821
00359          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00360          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU821
00361          GO TO P2200-EXIT.                                        DTSCU821
00362                                                                   DTSCU821
00363      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00364          NEXT SENTENCE                                            DTSCU821
00365      ELSE                                                         DTSCU821
00366          GO TO S899-ABEND.                                        DTSCU821
00367                                                                   DTSCU821
00368      IF ISKL-REC-TYPE OF IIO-REC = ISKL-REC-TYPE OF ICOMM-REC     DTSCU821
00369          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU821
00370      ELSE                                                         DTSCU821
00371          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00372          PERFORM P2400-END-BROWSE THRU P2400-EXIT.                DTSCU821
00373  P2200-EXIT.                                                      DTSCU821
00374      EXIT.                                                        DTSCU821
00375      EJECT                                                        DTSCU821
00376  P2300-READ-PREV.                                                 DTSCU821
00377      MOVE LOW-VALUE TO IIO-REC.                                   DTSCU821
00378                                                                   DTSCU821
00379      MOVE ISKL-KEY-AREA OF ICOMM-REC                              DTSCU821
00380        TO ISKL-KEY-AREA OF IIO-REC.                               DTSCU821
00381                                                                   DTSCU821
00382      MOVE ILEN-LENGTH TO WRK-REC-LENGTH.                          DTSCU821
00383                                                                   DTSCU821
00384      EXEC CICS                                                    DTSCU821
00385          READPREV                                                 DTSCU821
00386              DATASET (WRK-FILE-NAME)                              DTSCU821
00387              INTO (IIO-REC)                                       DTSCU821
00388              LENGTH (WRK-REC-LENGTH)                              DTSCU821
00389              RIDFLD (ISKL-KEY-AREA OF IIO-REC)                    DTSCU821
00390              RESP (WRK-RESP-CD)                                   DTSCU821
00391      END-EXEC.                                                    DTSCU821
00392                                                                   DTSCU821
00393      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU821
00394                         OR DFHRESP (SYSIDERR)                     DTSCU821
00395          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00396          GO TO P2300-EXIT.                                        DTSCU821
00397                                                                   DTSCU821
00398      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU821
00399          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00400          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU821
00401          GO TO P2300-EXIT.                                        DTSCU821
00402                                                                   DTSCU821
00403      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00404          NEXT SENTENCE                                            DTSCU821
00405      ELSE                                                         DTSCU821
00406          GO TO S899-ABEND.                                        DTSCU821
00407                                                                   DTSCU821
00408      IF ISKL-REC-TYPE OF IIO-REC = ISKL-REC-TYPE OF ICOMM-REC     DTSCU821
00409          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU821
00410      ELSE                                                         DTSCU821
00411          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00412          PERFORM P2400-END-BROWSE THRU P2400-EXIT.                DTSCU821
00413  P2300-EXIT.                                                      DTSCU821
00414      EXIT.                                                        DTSCU821
00415      EJECT                                                        DTSCU821
00416  P2400-END-BROWSE.                                                DTSCU821
00417                                                                   DTSCU821
00418      EXEC CICS                                                    DTSCU821
00419          ENDBR                                                    DTSCU821
00420              DATASET (WRK-FILE-NAME)                              DTSCU821
00421              RESP (WRK-RESP-CD)                                   DTSCU821
00422      END-EXEC.                                                    DTSCU821
00423                                                                   DTSCU821
00424      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU821
00425                         OR DFHRESP (SYSIDERR)                     DTSCU821
00426          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00427          GO TO P2400-EXIT.                                        DTSCU821
00428                                                                   DTSCU821
00429      IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ)        DTSCU821
00430          NEXT SENTENCE                                            DTSCU821
00431      ELSE                                                         DTSCU821
00432          GO TO S899-ABEND.                                        DTSCU821
00433  P2400-EXIT.                                                      DTSCU821
00434      EXIT.                                                        DTSCU821
00435      EJECT                                                        DTSCU821
00436  P3100-WRITE.                                                     DTSCU821
00437      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU821
00438                                                                   DTSCU821
00439      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU821
00440                                                                   DTSCU821
00441      EXEC CICS                                                    DTSCU821
00442          WRITE                                                    DTSCU821
00443              DATASET (WRK-FILE-NAME)                              DTSCU821
00444              FROM (IIO-REC)                                       DTSCU821
00445              LENGTH (WRK-REC-LENGTH)                              DTSCU821
00446              RIDFLD (ISKL-KEY-AREA OF IIO-REC)                    DTSCU821
00447              RESP (WRK-RESP-CD)                                   DTSCU821
00448      END-EXEC.                                                    DTSCU821
00449                                                                   DTSCU821
00450      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU821
00451                         OR DFHRESP (SYSIDERR)                     DTSCU821
00452          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00453          GO TO P3100-EXIT.                                        DTSCU821
00454                                                                   DTSCU821
00455      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00456          NEXT SENTENCE                                            DTSCU821
00457      ELSE                                                         DTSCU821
00458          GO TO S899-ABEND.                                        DTSCU821
00459  P3100-EXIT.                                                      DTSCU821
00460      EXIT.                                                        DTSCU821
00461      EJECT                                                        DTSCU821
00462  P3300-DELETE.                                                    DTSCU821
00463                                                                   DTSCU821
00464      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU821
00465                                                                   DTSCU821
00466      IF L821-NO-REC-88                                            DTSCU821
00467          GO TO S899-ABEND                                         DTSCU821
00468      ELSE                                                         DTSCU821
00469      IF L821-FILE-CLOSED-88                                       DTSCU821
00470          GO TO P3300-EXIT.                                        DTSCU821
00471                                                                   DTSCU821
00472      EXEC CICS                                                    DTSCU821
00473          DELETE                                                   DTSCU821
00474              DATASET (WRK-FILE-NAME)                              DTSCU821
00475              RESP (WRK-RESP-CD)                                   DTSCU821
00476      END-EXEC.                                                    DTSCU821
00477                                                                   DTSCU821
00478      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU821
00479                         OR DFHRESP (SYSIDERR)                     DTSCU821
00480          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00481          GO TO P3300-EXIT.                                        DTSCU821
00482                                                                   DTSCU821
00483      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00484          NEXT SENTENCE                                            DTSCU821
00485      ELSE                                                         DTSCU821
00486          GO TO S899-ABEND.                                        DTSCU821
00487  P3300-EXIT.                                                      DTSCU821
00488      EXIT.                                                        DTSCU821
00489      EJECT                                                        DTSCU821
00490  S1100-NOT-AVAILABLE.                                             DTSCU821
00491      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU821
00492                                                                   DTSCU821
00493      MOVE EMSG-NOT-AVAILABLE TO L821-MSG-AREA.                    DTSCU821
00494                                                                   DTSCU821
00495      SET L821-FILE-CLOSED-88 TO TRUE.                             DTSCU821
00496  S1100-EXIT.                                                      DTSCU821
00497      EXIT.                                                        DTSCU821
00498      SKIP3                                                        DTSCU821
00499  S1200-NOT-FOUND.                                                 DTSCU821
00500      SET L821-NO-REC-88 TO TRUE.                                  DTSCU821
00501  S1200-EXIT.                                                      DTSCU821
00502      EXIT.                                                        DTSCU821
00503      EJECT                                                        DTSCU821
00504  S2100-IO-TO-COMM.                                                DTSCU821
00505      GO TO S2101-MOVE                                             DTSCU821
00506            S2102-MOVE                                             DTSCU821
00507            S2103-MOVE                                             DTSCU821
00508            S2104-MOVE                                             DTSCU821
00509            S2105-MOVE                                             DTSCU821
00510            S2106-MOVE                                             DTSCU821
00511            S2107-MOVE                                             DTSCU821
00512            S2108-MOVE                                             DTSCU821
00513            S2109-MOVE                                             DTSCU821
00514            S2110-MOVE                                             DTSCU821
00515            S2111-MOVE                                             DTSCU821
00516            S2112-MOVE                                             DTSCU821
00517            S2113-MOVE                                             DTSCU821
00518            S2114-MOVE                                             DTSCU821
00519            S2115-MOVE                                             DTSCU821
00520            S2116-MOVE                                             DTSCU821
00521            S2117-MOVE                                             DTSCU821
00522            S2118-MOVE                                             DTSCU821
00523            S2119-MOVE                                             DTSCU821
00524            S2120-MOVE                                             DTSCU821
00525            S2121-MOVE                                             DTSCU821
00526            S2122-MOVE                                             DTSCU821
00527        DEPENDING ON ISKL-REC-TYPE OF IIO-REC.                     DTSCU821
00528                                                                   DTSCU821
00529      GO TO S899-ABEND.                                            DTSCU821
00530      SKIP3                                                        DTSCU821
00531  S2101-MOVE.                                                      DTSCU821
00532      MOVE IIO-REC TO IBTB-REC.                                    DTSCU821
00533      GO TO S2100-EXIT.                                            DTSCU821
00534      SKIP3                                                        DTSCU821
00535  S2102-MOVE.                                                      DTSCU821
00536      MOVE IIO-REC TO IEIN-REC.                                    DTSCU821
00537      GO TO S2100-EXIT.                                            DTSCU821
00538      SKIP3                                                        DTSCU821
00539  S2103-MOVE.                                                      DTSCU821
00540      MOVE IIO-REC TO IFAN-REC.                                    DTSCU821
00541      GO TO S2100-EXIT.                                            DTSCU821
00542      SKIP3                                                        DTSCU821
00543  S2104-MOVE.                                                      DTSCU821
00544      MOVE IIO-REC TO IFID-REC.                                    DTSCU821
00545      GO TO S2100-EXIT.                                            DTSCU821
00546      SKIP3                                                        DTSCU821
00547  S2105-MOVE.                                                      DTSCU821
00548      MOVE IIO-REC TO IOPN-REC.                                    DTSCU821
00549      GO TO S2100-EXIT.                                            DTSCU821
00550      SKIP3                                                        DTSCU821
00551  S2106-MOVE.                                                      DTSCU821
00552      MOVE IIO-REC TO IOPS-REC.                                    DTSCU821
00553      GO TO S2100-EXIT.                                            DTSCU821
00554      SKIP3                                                        DTSCU821
00555  S2107-MOVE.                                                      DTSCU821
00556      MOVE IIO-REC TO IPES-REC.                                    DTSCU821
00557      GO TO S2100-EXIT.                                            DTSCU821
00558      SKIP3                                                        DTSCU821
00559  S2108-MOVE.                                                      DTSCU821
00560      MOVE IIO-REC TO ITDS-REC.                                    DTSCU821
00561      GO TO S2100-EXIT.                                            DTSCU821
00562      SKIP3                                                        DTSCU821
00563  S2109-MOVE.                                                      DTSCU821
00564      MOVE IIO-REC TO IZIP-REC.                                    DTSCU821
00565      GO TO S2100-EXIT.                                            DTSCU821
00566      SKIP3                                                        DTSCU821
00567  S2110-MOVE.                                                      DTSCU821
00568      MOVE IIO-REC TO IBTN-REC.                                    DTSCU821
00569      GO TO S2100-EXIT.                                            DTSCU821
00570      SKIP3                                                        DTSCU821
00571  S2111-MOVE.                                                      DTSCU821
00572      MOVE IIO-REC TO IENM-REC.                                    DTSCU821
00573      GO TO S2100-EXIT.                                            DTSCU821
00574      SKIP3                                                        DTSCU821
00575  S2112-MOVE.                                                      DTSCU821
00576      MOVE IIO-REC TO IEAL-REC.                                    DTSCU821
00577      GO TO S2100-EXIT.                                            DTSCU821
00578      SKIP3                                                        DTSCU821
00579  S2113-MOVE.                                                      DTSCU821
00580      MOVE IIO-REC TO IEAE-REC.                                    DTSCU821
00581      GO TO S2100-EXIT.                                            DTSCU821
00582      SKIP3                                                        DTSCU821
00583  S2114-MOVE.                                                      DTSCU821
00584      MOVE IIO-REC TO IEBX-REC.                                    DTSCU821
00585      GO TO S2100-EXIT.                                            DTSCU821
00586      SKIP3                                                        DTSCU821
00587  S2115-MOVE.                                                      DTSCU821
00588      MOVE IIO-REC TO IEOP-REC.                                    DTSCU821
00589      GO TO S2100-EXIT.                                            DTSCU821
00590      SKIP3                                                        DTSCU821
00591  S2116-MOVE.                                                      DTSCU821
00592      MOVE IIO-REC TO IESR-REC.                                    DTSCU821
00593      GO TO S2100-EXIT.                                            DTSCU821
00594      SKIP3                                                        DTSCU821
00595  S2117-MOVE.                                                      DTSCU821
00596      MOVE IIO-REC TO IEER-REC.                                    DTSCU821
00597      GO TO S2100-EXIT.                                            DTSCU821
00598      SKIP3                                                        DTSCU821
00599  S2118-MOVE.                                                      DTSCU821
00600      MOVE IIO-REC TO IEET-REC.                                    DTSCU821
00601      GO TO S2100-EXIT.                                            DTSCU821
00602      SKIP3                                                        DTSCU821
00603  S2119-MOVE.                                                      DTSCU821
00604      MOVE IIO-REC TO IEPR-REC.                                    DTSCU821
00605      GO TO S2100-EXIT.                                            DTSCU821
00606      SKIP3                                                        DTSCU821
00607  S2120-MOVE.                                                      DTSCU821
00608      MOVE IIO-REC TO ITRT-REC.                                    DTSCU821
00609      GO TO S2100-EXIT.                                            DTSCU821
00610      SKIP3                                                        DTSCU821
00611  S2121-MOVE.                                                      DTSCU821
00612      MOVE IIO-REC TO ITRE-REC.                                    DTSCU821
00613      GO TO S2100-EXIT.                                            DTSCU821
00614      SKIP3                                                        DTSCU821
00615  S2122-MOVE.                                                      DTSCU821
00616      MOVE IIO-REC TO IRFD-REC.                                    DTSCU821
00617      GO TO S2100-EXIT.                                            DTSCU821
00618      SKIP3                                                        DTSCU821
00619  S2100-EXIT.                                                      DTSCU821
00620      EXIT.                                                        DTSCU821
00621      EJECT                                                        DTSCU821
00622  S2200-COMM-TO-IO.                                                DTSCU821
00623      GO TO S2201-MOVE                                             DTSCU821
00624            S2202-MOVE                                             DTSCU821
00625            S2203-MOVE                                             DTSCU821
00626            S2204-MOVE                                             DTSCU821
00627            S2205-MOVE                                             DTSCU821
00628            S2206-MOVE                                             DTSCU821
00629            S2207-MOVE                                             DTSCU821
00630            S2208-MOVE                                             DTSCU821
00631            S2209-MOVE                                             DTSCU821
00632            S2210-MOVE                                             DTSCU821
00633            S2211-MOVE                                             DTSCU821
00634            S2212-MOVE                                             DTSCU821
00635            S2213-MOVE                                             DTSCU821
00636            S2214-MOVE                                             DTSCU821
00637            S2215-MOVE                                             DTSCU821
00638            S2216-MOVE                                             DTSCU821
00639            S2217-MOVE                                             DTSCU821
00640            S2218-MOVE                                             DTSCU821
00641            S2219-MOVE                                             DTSCU821
00642            S2220-MOVE                                             DTSCU821
00643            S2221-MOVE                                             DTSCU821
00644            S2222-MOVE                                             DTSCU821
00645        DEPENDING ON ISKL-REC-TYPE OF ICOMM-REC.                   DTSCU821
00646                                                                   DTSCU821
00647      GO TO S899-ABEND.                                            DTSCU821
00648      SKIP3                                                        DTSCU821
00649  S2201-MOVE.                                                      DTSCU821
00650      MOVE LOW-VALUES TO IBTB-KEY-FILLER.                          DTSCU821
00651      MOVE IBTB-REC TO IIO-REC.                                    DTSCU821
00652      GO TO S2200-EXIT.                                            DTSCU821
00653      SKIP3                                                        DTSCU821
00654  S2202-MOVE.                                                      DTSCU821
00655      MOVE LOW-VALUES TO IEIN-KEY-FILLER.                          DTSCU821
00656      MOVE IEIN-REC TO IIO-REC.                                    DTSCU821
00657      GO TO S2200-EXIT.                                            DTSCU821
00658      SKIP3                                                        DTSCU821
00659  S2203-MOVE.                                                      DTSCU821
00660      MOVE LOW-VALUES TO IFAN-KEY-FILLER.                          DTSCU821
00661      MOVE IFAN-REC TO IIO-REC.                                    DTSCU821
00662      GO TO S2200-EXIT.                                            DTSCU821
00663      SKIP3                                                        DTSCU821
00664  S2204-MOVE.                                                      DTSCU821
00665      MOVE LOW-VALUES TO IFID-KEY-FILLER.                          DTSCU821
00666      MOVE IFID-REC TO IIO-REC.                                    DTSCU821
00667      GO TO S2200-EXIT.                                            DTSCU821
00668      SKIP3                                                        DTSCU821
00669  S2205-MOVE.                                                      DTSCU821
00670      MOVE LOW-VALUES TO IOPN-KEY-FILLER.                          DTSCU821
00671      MOVE IOPN-REC TO IIO-REC.                                    DTSCU821
00672      GO TO S2200-EXIT.                                            DTSCU821
00673      SKIP3                                                        DTSCU821
00674  S2206-MOVE.                                                      DTSCU821
00675      MOVE LOW-VALUES TO IOPS-KEY-FILLER.                          DTSCU821
00676      MOVE IOPS-REC TO IIO-REC.                                    DTSCU821
00677      GO TO S2200-EXIT.                                            DTSCU821
00678      SKIP3                                                        DTSCU821
00679  S2207-MOVE.                                                      DTSCU821
00680      MOVE LOW-VALUES TO IPES-KEY-FILLER.                          DTSCU821
00681      MOVE IPES-REC TO IIO-REC.                                    DTSCU821
00682      GO TO S2200-EXIT.                                            DTSCU821
00683      SKIP3                                                        DTSCU821
00684  S2208-MOVE.                                                      DTSCU821
00685      MOVE LOW-VALUES TO ITDS-KEY-FILLER.                          DTSCU821
00686      MOVE ITDS-REC TO IIO-REC.                                    DTSCU821
00687      GO TO S2200-EXIT.                                            DTSCU821
00688      SKIP3                                                        DTSCU821
00689  S2209-MOVE.                                                      DTSCU821
00690      MOVE LOW-VALUES TO IZIP-KEY-FILLER.                          DTSCU821
00691      MOVE IZIP-REC TO IIO-REC.                                    DTSCU821
00692      GO TO S2200-EXIT.                                            DTSCU821
00693      SKIP3                                                        DTSCU821
00694  S2210-MOVE.                                                      DTSCU821
00695      MOVE LOW-VALUES TO IBTN-KEY-FILLER.                          DTSCU821
00696      MOVE IBTN-REC TO IIO-REC.                                    DTSCU821
00697      GO TO S2200-EXIT.                                            DTSCU821
00698      SKIP3                                                        DTSCU821
00699  S2211-MOVE.                                                      DTSCU821
00700      MOVE LOW-VALUES TO IENM-KEY-FILLER.                          DTSCU821
00701      MOVE IENM-REC TO IIO-REC.                                    DTSCU821
00702      GO TO S2200-EXIT.                                            DTSCU821
00703      SKIP3                                                        DTSCU821
00704  S2212-MOVE.                                                      DTSCU821
00705      MOVE LOW-VALUES TO IEAL-KEY-FILLER.                          DTSCU821
00706      MOVE IEAL-REC TO IIO-REC.                                    DTSCU821
00707      GO TO S2200-EXIT.                                            DTSCU821
00708      SKIP3                                                        DTSCU821
00709  S2213-MOVE.                                                      DTSCU821
00710      MOVE LOW-VALUES TO IEAE-KEY-FILLER.                          DTSCU821
00711      MOVE IEAE-REC TO IIO-REC.                                    DTSCU821
00712      GO TO S2200-EXIT.                                            DTSCU821
00713      SKIP3                                                        DTSCU821
00714  S2214-MOVE.                                                      DTSCU821
00715      MOVE LOW-VALUES TO IEBX-KEY-FILLER.                          DTSCU821
00716      MOVE IEBX-REC TO IIO-REC.                                    DTSCU821
00717      GO TO S2200-EXIT.                                            DTSCU821
00718      SKIP3                                                        DTSCU821
00719  S2215-MOVE.                                                      DTSCU821
00720      MOVE LOW-VALUES TO IEOP-KEY-FILLER.                          DTSCU821
00721      MOVE IEOP-REC TO IIO-REC.                                    DTSCU821
00722      GO TO S2200-EXIT.                                            DTSCU821
00723      SKIP3                                                        DTSCU821
00724  S2216-MOVE.                                                      DTSCU821
00725      MOVE LOW-VALUES TO IESR-KEY-FILLER.                          DTSCU821
00726      MOVE IESR-REC TO IIO-REC.                                    DTSCU821
00727      GO TO S2200-EXIT.                                            DTSCU821
00728      SKIP3                                                        DTSCU821
00729  S2217-MOVE.                                                      DTSCU821
00730      MOVE LOW-VALUES TO IEER-KEY-FILLER.                          DTSCU821
00731      MOVE IEER-REC TO IIO-REC.                                    DTSCU821
00732      GO TO S2200-EXIT.                                            DTSCU821
00733      SKIP3                                                        DTSCU821
00734  S2218-MOVE.                                                      DTSCU821
00735      MOVE LOW-VALUES TO IEET-KEY-FILLER.                          DTSCU821
00736      MOVE IEET-REC TO IIO-REC.                                    DTSCU821
00737      GO TO S2200-EXIT.                                            DTSCU821
00738      SKIP3                                                        DTSCU821
00739  S2219-MOVE.                                                      DTSCU821
00740      MOVE LOW-VALUES TO IEPR-KEY-FILLER.                          DTSCU821
00741      MOVE IEPR-REC TO IIO-REC.                                    DTSCU821
00742      GO TO S2200-EXIT.                                            DTSCU821
00743      SKIP3                                                        DTSCU821
00744  S2220-MOVE.                                                      DTSCU821
00745      MOVE LOW-VALUES TO ITRT-KEY-FILLER.                          DTSCU821
00746      MOVE ITRT-REC TO IIO-REC.                                    DTSCU821
00747      GO TO S2200-EXIT.                                            DTSCU821
00748      SKIP3                                                        DTSCU821
00749  S2221-MOVE.                                                      DTSCU821
00750      MOVE LOW-VALUES TO ITRE-KEY-FILLER.                          DTSCU821
00751      MOVE ITRE-REC TO IIO-REC.                                    DTSCU821
00752      GO TO S2200-EXIT.                                            DTSCU821
00753      SKIP3                                                        DTSCU821
00754  S2222-MOVE.                                                      DTSCU821
00755      MOVE LOW-VALUES TO IRFD-KEY-FILLER.                          DTSCU821
00756      MOVE IRFD-REC TO IIO-REC.                                    DTSCU821
00757      GO TO S2200-EXIT.                                            DTSCU821
00758      SKIP3                                                        DTSCU821
00759  S2200-EXIT.                                                      DTSCU821
00760      EXIT.                                                        DTSCU821
00761      EJECT                                                        DTSCU821
00762  S2300-CALCULATE-LENGTH.                                          DTSCU821
00763      MOVE ILEN-LENGTH TO WRK-REC-LENGTH.                          DTSCU821
00764  S2300-EXIT.                                                      DTSCU821
00765      EXIT.                                                        DTSCU821
00766      EJECT                                                        DTSCU821
00767  S3100-READ-UPDATE.                                               DTSCU821
00768      MOVE LOW-VALUE TO IIO-REC.                                   DTSCU821
00769                                                                   DTSCU821
00770      MOVE ISKL-KEY-AREA OF ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. DTSCU821
00771                                                                   DTSCU821
00772      MOVE ILEN-LENGTH TO WRK-REC-LENGTH.                          DTSCU821
00773                                                                   DTSCU821
00774      EXEC CICS                                                    DTSCU821
00775          READ                                                     DTSCU821
00776              DATASET (WRK-FILE-NAME)                              DTSCU821
00777              INTO (IIO-REC)                                       DTSCU821
00778              LENGTH (WRK-REC-LENGTH)                              DTSCU821
00779              RIDFLD (ISKL-KEY-AREA OF IIO-REC)                    DTSCU821
00780              UPDATE                                               DTSCU821
00781              RESP (WRK-RESP-CD)                                   DTSCU821
00782      END-EXEC.                                                    DTSCU821
00783                                                                   DTSCU821
00784      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU821
00785                         OR DFHRESP (SYSIDERR)                     DTSCU821
00786          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU821
00787          GO TO S3100-EXIT.                                        DTSCU821
00788                                                                   DTSCU821
00789      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU821
00790          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU821
00791          GO TO S3100-EXIT.                                        DTSCU821
00792                                                                   DTSCU821
00793      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU821
00794          NEXT SENTENCE                                            DTSCU821
00795      ELSE                                                         DTSCU821
00796          GO TO S899-ABEND.                                        DTSCU821
00797  S3100-EXIT.                                                      DTSCU821
00798      EXIT.                                                        DTSCU821
00799      EJECT                                                        DTSCU821
00800  S899-ABEND.                                                      DTSCU821
00801                                                                   DTSCU821
00802      EXEC CICS                                                    DTSCU821
00803          ABEND                                                    DTSCU821
00804              ABCODE (WRK-ABEND-CD)                                DTSCU821
00805      END-EXEC.                                                    DTSCU821
00806                                                                   DTSCU821
00807  S899-EXIT.                                                       DTSCU821
00808      EXIT.                                                        DTSCU821
