00001  IDENTIFICATION DIVISION.                                         02/07/12
00002  PROGRAM-ID.             DTSCU831.                                DTSCU831
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV009
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU831
00005  DATE-COMPILED.                                                   DTSCU831
00006      SKIP3                                                        DTSCU831
00007 *****                                                             DTSCU831
00008 *                                                                 DTSCU831
00009 *    FUNCTION:  REFERENCE FILE INPUT/OUTPUT.                      DTSCU831
00010 *                                                                 DTSCU831
00011 *                                                                 DTSCU831
00012 *    MODIFICATION LOG:                                            DTSCU831
00013 *                                                                 DTSCU831
00014 *    11/12/91  INITIAL DEVELOPMENT.                               DTSCU831
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU831
00016 *                                                                 DTSCU831
00017 *    04/01/94  MODIFIED FOR MONTANA.                              DTSCU831
00018 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU831
00019 *                                                                 DTSCU831
00020 *    08/12/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCU831
00021 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU831
00022 *                                                                 DTSCU831
00023 *    05/09/2000  ADDED FFIS RECORD (2121/2221-MOVE) LOGIC.        DTSCU831
00024 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: ZL1   DTSCU831
00025 *                                                                 DTSCU831
00026 *                                                                 DTSCU831
00027 *    05/15/2002  ADDED FAFD RECORD (2121/2221-MOVE) LOGIC.        DTSCU831
00028 *                REFERENCE: HOUSEHOLD           PROGRAMMER: ZL1   DTSCU831
00029 *                                                                 DTSCU831
00030 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU831
00031 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU831
00032 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU831
00033 *                                                                 DTSCU831
00034 *                                                                 DTSCU831
00035 *    DESCRIPTION:                                                 DTSCU831
00036 *                                                                 DTSCU831
00037 *        DTSCU831 PERFORMS ALL REQUIRED REFERENCE FILE            DTSCU831
00038 *        INPUT/OUTPUT.  DTSCU831'S COMMAREA CONSISTS OF           DTSCU831
00039 *        DTSIL831, FOLLOWED BY DTSIFSKL. SEE DFHCOMMAREA          DTSCU831
00040 *        OF THIS MODULE FOR AN EXAMPLE.                           DTSCU831
00041 *                                                                 DTSCU831
00042 *                                                                 DTSCU831
00043 *                                                                 DTSCU831
00044 *****                                                             DTSCU831
00045      SKIP3                                                        DTSCU831
00046  ENVIRONMENT DIVISION.                                            DTSCU831
00047      SKIP3                                                        DTSCU831
00048  DATA DIVISION.                                                   DTSCU831
00049      SKIP3                                                        DTSCU831
00050  WORKING-STORAGE SECTION.                                         DTSCU831
000505 77  PAN-VALET PICTURE X(24) VALUE '009DTSCU831  02/07/12'.       DTSCU831
00051      SKIP3                                                        DTSCU831
00052  01  WRK-AREA.                                                    DTSCU831
00053      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U831'.    DTSCU831
00054      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU831
00055                                                                   DTSCU831
00056 *****05  WRK-TEST-FILE-NAME          PIC X(08)  VALUE 'DTSFREF'.  DTSCU831
00057 *****05  WRK-TCL-FILE-NAME           PIC X(08)  VALUE 'DTSTREF'.  DTSCU831
00058      05  WRK-PROD-FILE-NAME          PIC X(08)  VALUE 'DTSFREF'.  DTSCU831
00059                                                                   DTSCU831
00060      05  EMSG-NOT-AVAILABLE.                                      DTSCU831
00061          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU831
00062          10  FILLER                  PIC  X(06)  VALUE 'FILE  '.  DTSCU831
00063          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU831
00064          10  FILLER                  PIC  X(33)                   DTSCU831
00065                VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.         DTSCU831
00066      SKIP3                                                        DTSCU831
00067 *****05  WRK-CICS-APPLID             PIC X(08).                   DTSCU831
00068                                                                   DTSCU831
00069 *****05  WRK-CICS-OP-ID              PIC X(08).                   DTSCU831
00070 *********88  WRK-TCL-OP-ID-88       VALUES 'CE0756'               DTSCU831
00071 *******************************************'CE3568'               DTSCU831
00072 *******************************************'C84986'.              DTSCU831
00073                                                                   DTSCU831
00074      05  WRK-FILE-NAME               PIC X(08).                   DTSCU831
00075                                                                   DTSCU831
00076      05  WRK-REC-LENGTH              PIC S9(04)  COMP.            DTSCU831
00077      EJECT                                                        DTSCU831
00078  01  FLEN-LITERALS.                                               DTSCU831
00079  ++INCLUDE DTSIFLEN                                               DTSCU831
00080      EJECT                                                        DTSCU831
00081  01  FIO-REC.                                                     DTSCU831
00082  ++INCLUDE DTSIFSKL                                               DTSCU831
00083      EJECT                                                        DTSCU831
00084  LINKAGE SECTION.                                                 DTSCU831
00085      SKIP3                                                        DTSCU831
00086  01  DFHCOMMAREA.                                                 DTSCU831
00087      05  L831-CONTROL-BLOCK.                                      DTSCU831
00088  ++INCLUDE DTSIL831                                               DTSCU831
00089      SKIP3                                                        DTSCU831
00090      05  FCOMM-REC.                                               DTSCU831
00091  ++INCLUDE DTSIFSKL                                               DTSCU831
00092      SKIP3                                                        DTSCU831
00093      05  FAFD-REC REDEFINES FCOMM-REC.                            DTSCU831
00094  ++INCLUDE DTSIFAFD                                               DTSCU831
00095      SKIP3                                                        DTSCU831
00096      05  FCYR-REC REDEFINES FCOMM-REC.                            DTSCU831
00097  ++INCLUDE DTSIFCYR                                               DTSCU831
00098      SKIP3                                                        DTSCU831
00099      05  FFAT-REC REDEFINES FCOMM-REC.                            DTSCU831
00100  ++INCLUDE DTSIFFAT                                               DTSCU831
00101      SKIP3                                                        DTSCU831
00102      05  FFAZ-REC REDEFINES FCOMM-REC.                            DTSCU831
00103  ++INCLUDE DTSIFFAZ                                               DTSCU831
00104      SKIP3                                                        DTSCU831
00105      05  FFID-REC REDEFINES FCOMM-REC.                            DTSCU831
00106  ++INCLUDE DTSIFFID                                               DTSCU831
00107      SKIP3                                                        DTSCU831
00108      05  FFIS-REC REDEFINES FCOMM-REC.                            DTSCU831
00109  ++INCLUDE DTSIFFIS                                               DTSCU831
00110      SKIP3                                                        DTSCU831
00111      05  FOPR-REC REDEFINES FCOMM-REC.                            DTSCU831
00112  ++INCLUDE DTSIFOPR                                               DTSCU831
00113      SKIP3                                                        DTSCU831
00114      05  FQTR-REC REDEFINES FCOMM-REC.                            DTSCU831
00115  ++INCLUDE DTSIFQTR                                               DTSCU831
00116      SKIP3                                                        DTSCU831
00117      05  FSEL-REC REDEFINES FCOMM-REC.                            DTSCU831
00118  ++INCLUDE DTSIFSEL                                               DTSCU831
00119      SKIP3                                                        DTSCU831
00120      05  FUIR-REC REDEFINES FCOMM-REC.                            DTSCU831
00121  ++INCLUDE DTSIFUIR                                               DTSCU831
00122      SKIP3                                                        DTSCU831
00123      05  F581-REC REDEFINES FCOMM-REC.                            DTSCU831
00124  ++INCLUDE DTSIF581                                               DTSCU831
00125      EJECT                                                        DTSCU831
00126  PROCEDURE DIVISION.                                              DTSCU831
00127      SKIP2                                                        DTSCU831
00128 *****EXEC CICS                                                    DTSCU831
00129 *****    ASSIGN                                                   DTSCU831
00130 *****       APPLID (WRK-CICS-APPLID)                              DTSCU831
00131 *****END-EXEC.                                                    DTSCU831
00132 *****                                                             DTSCU831
00133 *****IF WRK-CICS-APPLID = 'CICSAORT'                              DTSCU831
00134 *****   EXEC CICS                                                 DTSCU831
00135 *****       ASSIGN                                                DTSCU831
00136 *****          USERID (WRK-CICS-OP-ID)                            DTSCU831
00137 *****   END-EXEC                                                  DTSCU831
00138 *****                                                             DTSCU831
00139 *****   IF WRK-TCL-OP-ID-88                                       DTSCU831
00140 *****      MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME                DTSCU831
00141 *****   ELSE                                                      DTSCU831
00142 *****      MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME               DTSCU831
00143 *****ELSE                                                         DTSCU831
00144                                                                   DTSCU831
00145                                                                   DTSCU831
00146                                                                   DTSCU831
00147      MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME.                    DTSCU831
00148                                                                   DTSCU831
00149      MOVE SPACES TO L831-MSG-AREA.                                DTSCU831
00150                                                                   DTSCU831
00151      SET L831-OK-88 TO TRUE.                                      DTSCU831
00152                                                                   DTSCU831
00153      IF L831-READ-NEXT-88                                         DTSCU831
00154          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU831
00155      ELSE                                                         DTSCU831
00156      IF L831-READ-88                                              DTSCU831
00157          PERFORM P1100-READ THRU P1100-EXIT                       DTSCU831
00158      ELSE                                                         DTSCU831
00159      IF L831-START-BROWSE-88                                      DTSCU831
00160          PERFORM P2100-START-BROWSE THRU P2100-EXIT               DTSCU831
00161      ELSE                                                         DTSCU831
00162      IF L831-END-BROWSE-88                                        DTSCU831
00163          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU831
00164      ELSE                                                         DTSCU831
00165      IF L831-READ-PREV-88                                         DTSCU831
00166          PERFORM P2300-READ-PREV THRU P2300-EXIT                  DTSCU831
00167      ELSE                                                         DTSCU831
00168      IF L831-WRITE-88                                             DTSCU831
00169          PERFORM P3100-WRITE THRU P3100-EXIT                      DTSCU831
00170      ELSE                                                         DTSCU831
00171      IF L831-REWRITE-88                                           DTSCU831
00172          PERFORM P3200-REWRITE THRU P3200-EXIT                    DTSCU831
00173      ELSE                                                         DTSCU831
00174      IF L831-DELETE-88                                            DTSCU831
00175          PERFORM P3300-DELETE THRU P3300-EXIT                     DTSCU831
00176      ELSE                                                         DTSCU831
00177          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00178      SKIP2                                                        DTSCU831
00179      EXEC CICS                                                    DTSCU831
00180          RETURN                                                   DTSCU831
00181      END-EXEC.                                                    DTSCU831
00182      SKIP2                                                        DTSCU831
00183      GOBACK.                                                      DTSCU831
00184      EJECT                                                        DTSCU831
00185  P1100-READ.                                                      DTSCU831
00186      MOVE LOW-VALUES TO FIO-REC.                                  DTSCU831
00187                                                                   DTSCU831
00188      MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
00189                                                                   DTSCU831
00190      MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH.                     DTSCU831
00191                                                                   DTSCU831
00192      EXEC CICS                                                    DTSCU831
00193          READ                                                     DTSCU831
00194              DATASET (WRK-FILE-NAME)                              DTSCU831
00195              INTO (FIO-REC)                                       DTSCU831
00196              LENGTH (WRK-REC-LENGTH)                              DTSCU831
00197              RIDFLD (FSKL-KEY-AREA OF FIO-REC)                    DTSCU831
00198              RESP (WRK-RESP-CD)                                   DTSCU831
00199      END-EXEC.                                                    DTSCU831
00200                                                                   DTSCU831
00201      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU831
00202                         OR DFHRESP (SYSIDERR)                     DTSCU831
00203          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00204          GO TO P1100-EXIT.                                        DTSCU831
00205                                                                   DTSCU831
00206      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU831
00207          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00208          GO TO P1100-EXIT.                                        DTSCU831
00209                                                                   DTSCU831
00210      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00211          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU831
00212      ELSE                                                         DTSCU831
00213          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00214  P1100-EXIT.                                                      DTSCU831
00215      EXIT.                                                        DTSCU831
00216      EJECT                                                        DTSCU831
00217  P2100-START-BROWSE.                                              DTSCU831
00218      MOVE LOW-VALUES TO FIO-REC.                                  DTSCU831
00219                                                                   DTSCU831
00220      MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
00221                                                                   DTSCU831
00222      EXEC CICS                                                    DTSCU831
00223          STARTBR                                                  DTSCU831
00224              DATASET (WRK-FILE-NAME)                              DTSCU831
00225              RIDFLD (FSKL-KEY-AREA OF FIO-REC)                    DTSCU831
00226              RESP (WRK-RESP-CD)                                   DTSCU831
00227      END-EXEC.                                                    DTSCU831
00228                                                                   DTSCU831
00229      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU831
00230                         OR DFHRESP (SYSIDERR)                     DTSCU831
00231          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00232          GO TO P2100-EXIT.                                        DTSCU831
00233                                                                   DTSCU831
00234      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU831
00235          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00236          GO TO P2100-EXIT.                                        DTSCU831
00237                                                                   DTSCU831
00238      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00239          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU831
00240      ELSE                                                         DTSCU831
00241          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00242  P2100-EXIT.                                                      DTSCU831
00243      EXIT.                                                        DTSCU831
00244      EJECT                                                        DTSCU831
00245  P2200-READ-NEXT.                                                 DTSCU831
00246      IF L831-READ-NEXT-88                                         DTSCU831
00247          MOVE LOW-VALUES TO FIO-REC                               DTSCU831
00248          MOVE FSKL-KEY-AREA OF FCOMM-REC                          DTSCU831
00249            TO FSKL-KEY-AREA OF FIO-REC.                           DTSCU831
00250                                                                   DTSCU831
00251      MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH.                     DTSCU831
00252                                                                   DTSCU831
00253      EXEC CICS                                                    DTSCU831
00254          READNEXT                                                 DTSCU831
00255              DATASET (WRK-FILE-NAME)                              DTSCU831
00256              INTO (FIO-REC)                                       DTSCU831
00257              LENGTH (WRK-REC-LENGTH)                              DTSCU831
00258              RIDFLD (FSKL-KEY-AREA OF FIO-REC)                    DTSCU831
00259              RESP (WRK-RESP-CD)                                   DTSCU831
00260      END-EXEC.                                                    DTSCU831
00261                                                                   DTSCU831
00262      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU831
00263                         OR DFHRESP (SYSIDERR)                     DTSCU831
00264          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00265          GO TO P2200-EXIT.                                        DTSCU831
00266                                                                   DTSCU831
00267      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU831
00268          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00269          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU831
00270          GO TO P2200-EXIT.                                        DTSCU831
00271                                                                   DTSCU831
00272      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00273          NEXT SENTENCE                                            DTSCU831
00274      ELSE                                                         DTSCU831
00275          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00276                                                                   DTSCU831
00277      IF FSKL-REC-TYPE OF FIO-REC = FSKL-REC-TYPE OF FCOMM-REC     DTSCU831
00278          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU831
00279      ELSE                                                         DTSCU831
00280          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00281          PERFORM P2400-END-BROWSE THRU P2400-EXIT.                DTSCU831
00282  P2200-EXIT.                                                      DTSCU831
00283      EXIT.                                                        DTSCU831
00284      EJECT                                                        DTSCU831
00285  P2300-READ-PREV.                                                 DTSCU831
00286      MOVE LOW-VALUES TO FIO-REC.                                  DTSCU831
00287                                                                   DTSCU831
00288      MOVE FSKL-KEY-AREA OF FCOMM-REC                              DTSCU831
00289        TO FSKL-KEY-AREA OF FIO-REC.                               DTSCU831
00290                                                                   DTSCU831
00291      MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH.                     DTSCU831
00292                                                                   DTSCU831
00293      EXEC CICS                                                    DTSCU831
00294          READPREV                                                 DTSCU831
00295              DATASET (WRK-FILE-NAME)                              DTSCU831
00296              INTO (FIO-REC)                                       DTSCU831
00297              LENGTH (WRK-REC-LENGTH)                              DTSCU831
00298              RIDFLD (FSKL-KEY-AREA OF FIO-REC)                    DTSCU831
00299              RESP (WRK-RESP-CD)                                   DTSCU831
00300      END-EXEC.                                                    DTSCU831
00301                                                                   DTSCU831
00302      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU831
00303                         OR DFHRESP (SYSIDERR)                     DTSCU831
00304          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00305          GO TO P2300-EXIT.                                        DTSCU831
00306                                                                   DTSCU831
00307      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU831
00308          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00309          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU831
00310          GO TO P2300-EXIT.                                        DTSCU831
00311                                                                   DTSCU831
00312      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00313          NEXT SENTENCE                                            DTSCU831
00314      ELSE                                                         DTSCU831
00315          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00316                                                                   DTSCU831
00317      IF FSKL-REC-TYPE OF FIO-REC = FSKL-REC-TYPE OF FCOMM-REC     DTSCU831
00318          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU831
00319      ELSE                                                         DTSCU831
00320          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00321          PERFORM P2400-END-BROWSE THRU P2400-EXIT.                DTSCU831
00322  P2300-EXIT.                                                      DTSCU831
00323      EXIT.                                                        DTSCU831
00324      EJECT                                                        DTSCU831
00325  P2400-END-BROWSE.                                                DTSCU831
00326                                                                   DTSCU831
00327      EXEC CICS                                                    DTSCU831
00328          ENDBR                                                    DTSCU831
00329              DATASET (WRK-FILE-NAME)                              DTSCU831
00330              RESP (WRK-RESP-CD)                                   DTSCU831
00331      END-EXEC.                                                    DTSCU831
00332                                                                   DTSCU831
00333      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU831
00334                         OR DFHRESP (SYSIDERR)                     DTSCU831
00335          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00336          GO TO P2400-EXIT.                                        DTSCU831
00337                                                                   DTSCU831
00338      IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ)        DTSCU831
00339          NEXT SENTENCE                                            DTSCU831
00340      ELSE                                                         DTSCU831
00341          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00342  P2400-EXIT.                                                      DTSCU831
00343      EXIT.                                                        DTSCU831
00344      EJECT                                                        DTSCU831
00345  P3100-WRITE.                                                     DTSCU831
00346      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU831
00347                                                                   DTSCU831
00348      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU831
00349                                                                   DTSCU831
00350      EXEC CICS                                                    DTSCU831
00351          WRITE                                                    DTSCU831
00352              DATASET (WRK-FILE-NAME)                              DTSCU831
00353              FROM (FIO-REC)                                       DTSCU831
00354              LENGTH (WRK-REC-LENGTH)                              DTSCU831
00355              RIDFLD (FSKL-KEY-AREA OF FIO-REC)                    DTSCU831
00356              RESP (WRK-RESP-CD)                                   DTSCU831
00357      END-EXEC.                                                    DTSCU831
00358                                                                   DTSCU831
00359      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU831
00360                         OR DFHRESP (SYSIDERR)                     DTSCU831
00361          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00362          GO TO P3100-EXIT.                                        DTSCU831
00363                                                                   DTSCU831
00364      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00365          NEXT SENTENCE                                            DTSCU831
00366      ELSE                                                         DTSCU831
00367          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00368  P3100-EXIT.                                                      DTSCU831
00369      EXIT.                                                        DTSCU831
00370      EJECT                                                        DTSCU831
00371  P3200-REWRITE.                                                   DTSCU831
00372      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU831
00373                                                                   DTSCU831
00374      IF L831-NO-REC-88                                            DTSCU831
00375          PERFORM S899-ABEND THRU S899-EXIT                        DTSCU831
00376      ELSE                                                         DTSCU831
00377      IF L831-FILE-CLOSED-88                                       DTSCU831
00378          GO TO P3200-EXIT.                                        DTSCU831
00379                                                                   DTSCU831
00380      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU831
00381                                                                   DTSCU831
00382      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU831
00383                                                                   DTSCU831
00384      EXEC CICS                                                    DTSCU831
00385          REWRITE                                                  DTSCU831
00386              DATASET (WRK-FILE-NAME)                              DTSCU831
00387              FROM (FIO-REC)                                       DTSCU831
00388              LENGTH (WRK-REC-LENGTH)                              DTSCU831
00389              RESP (WRK-RESP-CD)                                   DTSCU831
00390      END-EXEC.                                                    DTSCU831
00391                                                                   DTSCU831
00392      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU831
00393                         OR DFHRESP (SYSIDERR)                     DTSCU831
00394          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00395          GO TO P3200-EXIT.                                        DTSCU831
00396                                                                   DTSCU831
00397      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00398          NEXT SENTENCE                                            DTSCU831
00399      ELSE                                                         DTSCU831
00400          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00401  P3200-EXIT.                                                      DTSCU831
00402      EXIT.                                                        DTSCU831
00403      EJECT                                                        DTSCU831
00404  P3300-DELETE.                                                    DTSCU831
00405      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU831
00406                                                                   DTSCU831
00407      IF L831-NO-REC-88                                            DTSCU831
00408          PERFORM S899-ABEND THRU S899-EXIT                        DTSCU831
00409      ELSE                                                         DTSCU831
00410      IF L831-FILE-CLOSED-88                                       DTSCU831
00411          GO TO P3300-EXIT.                                        DTSCU831
00412                                                                   DTSCU831
00413      EXEC CICS                                                    DTSCU831
00414          DELETE                                                   DTSCU831
00415              DATASET (WRK-FILE-NAME)                              DTSCU831
00416              RESP (WRK-RESP-CD)                                   DTSCU831
00417      END-EXEC.                                                    DTSCU831
00418                                                                   DTSCU831
00419      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU831
00420                         OR DFHRESP (SYSIDERR)                     DTSCU831
00421          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00422          GO TO P3300-EXIT.                                        DTSCU831
00423                                                                   DTSCU831
00424      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00425          NEXT SENTENCE                                            DTSCU831
00426      ELSE                                                         DTSCU831
00427          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00428  P3300-EXIT.                                                      DTSCU831
00429      EXIT.                                                        DTSCU831
00430      EJECT                                                        DTSCU831
00431  S1100-NOT-AVAILABLE.                                             DTSCU831
00432      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU831
00433                                                                   DTSCU831
00434      MOVE EMSG-NOT-AVAILABLE TO L831-MSG-AREA.                    DTSCU831
00435                                                                   DTSCU831
00436      SET L831-FILE-CLOSED-88 TO TRUE.                             DTSCU831
00437  S1100-EXIT.                                                      DTSCU831
00438      EXIT.                                                        DTSCU831
00439      SKIP3                                                        DTSCU831
00440  S1200-NOT-FOUND.                                                 DTSCU831
00441      SET L831-NO-REC-88 TO TRUE.                                  DTSCU831
00442  S1200-EXIT.                                                      DTSCU831
00443      EXIT.                                                        DTSCU831
00444      EJECT                                                        DTSCU831
00445  S2100-IO-TO-COMM.                                                DTSCU831
00446      GO TO S2101-MOVE                                             DTSCU831
00447            S2102-MOVE                                             DTSCU831
00448            S2103-MOVE                                             DTSCU831
00449            S2104-MOVE                                             DTSCU831
00450            S2105-MOVE                                             DTSCU831
00451            S2106-MOVE                                             DTSCU831
00452            S2107-MOVE                                             DTSCU831
00453            S2108-MOVE                                             DTSCU831
00454            S2109-MOVE                                             DTSCU831
00455            S2110-MOVE                                             DTSCU831
00456            S2111-MOVE                                             DTSCU831
00457            S2112-MOVE                                             DTSCU831
00458            S2113-MOVE                                             DTSCU831
00459            S2114-MOVE                                             DTSCU831
00460            S2115-MOVE                                             DTSCU831
00461            S2116-MOVE                                             DTSCU831
00462            S2117-MOVE                                             DTSCU831
00463            S2118-MOVE                                             DTSCU831
00464            S2119-MOVE                                             DTSCU831
00465            S2120-MOVE                                             DTSCU831
00466        DEPENDING ON FSKL-REC-TYPE OF FIO-REC.                     DTSCU831
00467                                                                   DTSCU831
00468      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00469      SKIP3                                                        DTSCU831
00470  S2101-MOVE.                                                      DTSCU831
00471      MOVE FIO-REC TO FCYR-REC.                                    DTSCU831
00472      GO TO S2100-EXIT.                                            DTSCU831
00473      SKIP3                                                        DTSCU831
00474  S2102-MOVE.                                                      DTSCU831
00475      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00476      GO TO S2100-EXIT.                                            DTSCU831
00477      SKIP3                                                        DTSCU831
00478  S2103-MOVE.                                                      DTSCU831
00479      MOVE FIO-REC TO FFAT-REC.                                    DTSCU831
00480      GO TO S2100-EXIT.                                            DTSCU831
00481      SKIP3                                                        DTSCU831
00482  S2104-MOVE.                                                      DTSCU831
00483      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00484      GO TO S2100-EXIT.                                            DTSCU831
00485      SKIP3                                                        DTSCU831
00486  S2105-MOVE.                                                      DTSCU831
00487      MOVE FIO-REC TO FFAZ-REC.                                    DTSCU831
00488      GO TO S2100-EXIT.                                            DTSCU831
00489      SKIP3                                                        DTSCU831
00490  S2106-MOVE.                                                      DTSCU831
00491      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00492      GO TO S2100-EXIT.                                            DTSCU831
00493      SKIP3                                                        DTSCU831
00494  S2107-MOVE.                                                      DTSCU831
00495      MOVE FIO-REC TO FFID-REC.                                    DTSCU831
00496      GO TO S2100-EXIT.                                            DTSCU831
00497      SKIP3                                                        DTSCU831
00498  S2108-MOVE.                                                      DTSCU831
00499      MOVE FIO-REC TO FFIS-REC.                                    DTSCU831
00500      GO TO S2100-EXIT.                                            DTSCU831
00501      SKIP3                                                        DTSCU831
00502  S2109-MOVE.                                                      DTSCU831
00503      MOVE FIO-REC TO FOPR-REC.                                    DTSCU831
00504      GO TO S2100-EXIT.                                            DTSCU831
00505      SKIP3                                                        DTSCU831
00506  S2110-MOVE.                                                      DTSCU831
00507      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00508      GO TO S2100-EXIT.                                            DTSCU831
00509      SKIP3                                                        DTSCU831
00510  S2111-MOVE.                                                      DTSCU831
00511      MOVE FIO-REC TO FQTR-REC.                                    DTSCU831
00512      GO TO S2100-EXIT.                                            DTSCU831
00513      SKIP3                                                        DTSCU831
00514  S2112-MOVE.                                                      DTSCU831
00515      MOVE FIO-REC TO FAFD-REC.                                    DTSCU831
00516      GO TO S2100-EXIT.                                            DTSCU831
00517      SKIP3                                                        DTSCU831
00518  S2113-MOVE.                                                      DTSCU831
00519      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00520      GO TO S2100-EXIT.                                            DTSCU831
00521      SKIP3                                                        DTSCU831
00522  S2114-MOVE.                                                      DTSCU831
00523      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00524      GO TO S2100-EXIT.                                            DTSCU831
00525      SKIP3                                                        DTSCU831
00526  S2115-MOVE.                                                      DTSCU831
00527      MOVE FIO-REC TO FSEL-REC.                                    DTSCU831
00528      GO TO S2100-EXIT.                                            DTSCU831
00529      SKIP3                                                        DTSCU831
00530  S2116-MOVE.                                                      DTSCU831
00531      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00532      GO TO S2100-EXIT.                                            DTSCU831
00533      SKIP3                                                        DTSCU831
00534  S2117-MOVE.                                                      DTSCU831
00535      MOVE FIO-REC TO FUIR-REC.                                    DTSCU831
00536      GO TO S2100-EXIT.                                            DTSCU831
00537      SKIP3                                                        DTSCU831
00538  S2118-MOVE.                                                      DTSCU831
00539      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00540      GO TO S2100-EXIT.                                            DTSCU831
00541      SKIP3                                                        DTSCU831
00542  S2119-MOVE.                                                      DTSCU831
00543      MOVE FIO-REC TO F581-REC.                                    DTSCU831
00544      GO TO S2100-EXIT.                                            DTSCU831
00545      SKIP3                                                        DTSCU831
00546  S2120-MOVE.                                                      DTSCU831
00547      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00548      GO TO S2100-EXIT.                                            DTSCU831
00549      SKIP3                                                        DTSCU831
00550  S2100-EXIT.                                                      DTSCU831
00551      EXIT.                                                        DTSCU831
00552      EJECT                                                        DTSCU831
00553  S2200-COMM-TO-IO.                                                DTSCU831
00554      GO TO S2201-MOVE                                             DTSCU831
00555            S2202-MOVE                                             DTSCU831
00556            S2203-MOVE                                             DTSCU831
00557            S2204-MOVE                                             DTSCU831
00558            S2205-MOVE                                             DTSCU831
00559            S2206-MOVE                                             DTSCU831
00560            S2207-MOVE                                             DTSCU831
00561            S2208-MOVE                                             DTSCU831
00562            S2209-MOVE                                             DTSCU831
00563            S2210-MOVE                                             DTSCU831
00564            S2211-MOVE                                             DTSCU831
00565            S2212-MOVE                                             DTSCU831
00566            S2213-MOVE                                             DTSCU831
00567            S2214-MOVE                                             DTSCU831
00568            S2215-MOVE                                             DTSCU831
00569            S2216-MOVE                                             DTSCU831
00570            S2217-MOVE                                             DTSCU831
00571            S2218-MOVE                                             DTSCU831
00572            S2219-MOVE                                             DTSCU831
00573            S2220-MOVE                                             DTSCU831
00574        DEPENDING ON FSKL-REC-TYPE OF FCOMM-REC.                   DTSCU831
00575                                                                   DTSCU831
00576      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00577      SKIP3                                                        DTSCU831
00578  S2201-MOVE.                                                      DTSCU831
00579      MOVE LOW-VALUES TO FCYR-KEY-FILLER.                          DTSCU831
00580      MOVE FCYR-REC TO FIO-REC.                                    DTSCU831
00581      GO TO S2200-EXIT.                                            DTSCU831
00582      SKIP3                                                        DTSCU831
00583  S2202-MOVE.                                                      DTSCU831
00584      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00585      GO TO S2200-EXIT.                                            DTSCU831
00586      SKIP3                                                        DTSCU831
00587  S2203-MOVE.                                                      DTSCU831
00588      MOVE LOW-VALUES TO FFAT-KEY-FILLER.                          DTSCU831
00589      MOVE FFAT-REC TO FIO-REC.                                    DTSCU831
00590      GO TO S2200-EXIT.                                            DTSCU831
00591      SKIP3                                                        DTSCU831
00592  S2204-MOVE.                                                      DTSCU831
00593      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00594      GO TO S2200-EXIT.                                            DTSCU831
00595      SKIP3                                                        DTSCU831
00596  S2205-MOVE.                                                      DTSCU831
00597      MOVE LOW-VALUES TO FFAZ-KEY-FILLER.                          DTSCU831
00598      MOVE FFAZ-REC TO FIO-REC.                                    DTSCU831
00599      GO TO S2200-EXIT.                                            DTSCU831
00600      SKIP3                                                        DTSCU831
00601  S2206-MOVE.                                                      DTSCU831
00602      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00603      GO TO S2200-EXIT.                                            DTSCU831
00604      SKIP3                                                        DTSCU831
00605  S2207-MOVE.                                                      DTSCU831
00606      MOVE LOW-VALUES TO FFID-KEY-FILLER.                          DTSCU831
00607      MOVE FFID-REC TO FIO-REC.                                    DTSCU831
00608      GO TO S2200-EXIT.                                            DTSCU831
00609      SKIP3                                                        DTSCU831
00610  S2208-MOVE.                                                      DTSCU831
00611      MOVE LOW-VALUES TO FFIS-KEY-FILLER.                          DTSCU831
00612      MOVE FFIS-REC TO FIO-REC.                                    DTSCU831
00613      GO TO S2200-EXIT.                                            DTSCU831
00614      SKIP3                                                        DTSCU831
00615  S2209-MOVE.                                                      DTSCU831
00616      MOVE LOW-VALUES TO FOPR-KEY-FILLER.                          DTSCU831
00617      MOVE FOPR-REC TO FIO-REC.                                    DTSCU831
00618      GO TO S2200-EXIT.                                            DTSCU831
00619      SKIP3                                                        DTSCU831
00620  S2210-MOVE.                                                      DTSCU831
00621      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00622      GO TO S2200-EXIT.                                            DTSCU831
00623      SKIP3                                                        DTSCU831
00624  S2211-MOVE.                                                      DTSCU831
00625      MOVE LOW-VALUES TO FQTR-KEY-FILLER.                          DTSCU831
00626      MOVE FQTR-REC TO FIO-REC.                                    DTSCU831
00627      GO TO S2200-EXIT.                                            DTSCU831
00628      SKIP3                                                        DTSCU831
00629  S2212-MOVE.                                                      DTSCU831
00630      MOVE LOW-VALUES TO FAFD-KEY-FILLER.                          DTSCU831
00631      MOVE FAFD-REC TO FIO-REC.                                    DTSCU831
00632      GO TO S2200-EXIT.                                            DTSCU831
00633      SKIP3                                                        DTSCU831
00634  S2213-MOVE.                                                      DTSCU831
00635      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00636      GO TO S2200-EXIT.                                            DTSCU831
00637      SKIP3                                                        DTSCU831
00638  S2214-MOVE.                                                      DTSCU831
00639      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00640      GO TO S2200-EXIT.                                            DTSCU831
00641      SKIP3                                                        DTSCU831
00642  S2215-MOVE.                                                      DTSCU831
00643      MOVE LOW-VALUES TO FSEL-KEY-FILLER.                          DTSCU831
00644      MOVE FSEL-REC TO FIO-REC.                                    DTSCU831
00645      GO TO S2200-EXIT.                                            DTSCU831
00646      SKIP3                                                        DTSCU831
00647  S2216-MOVE.                                                      DTSCU831
00648      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00649      GO TO S2200-EXIT.                                            DTSCU831
00650      SKIP3                                                        DTSCU831
00651  S2217-MOVE.                                                      DTSCU831
00652      MOVE LOW-VALUES TO FUIR-KEY-FILLER.                          DTSCU831
00653      MOVE FUIR-REC TO FIO-REC.                                    DTSCU831
00654      GO TO S2200-EXIT.                                            DTSCU831
00655      SKIP3                                                        DTSCU831
00656  S2218-MOVE.                                                      DTSCU831
00657      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00658      GO TO S2200-EXIT.                                            DTSCU831
00659      SKIP3                                                        DTSCU831
00660  S2219-MOVE.                                                      DTSCU831
00661      MOVE LOW-VALUES TO F581-KEY-FILLER.                          DTSCU831
00662      MOVE F581-REC TO FIO-REC.                                    DTSCU831
00663      GO TO S2200-EXIT.                                            DTSCU831
00664      SKIP3                                                        DTSCU831
00665  S2220-MOVE.                                                      DTSCU831
00666      PERFORM S899-ABEND THRU S899-EXIT.                           DTSCU831
00667      GO TO S2200-EXIT.                                            DTSCU831
00668      SKIP3                                                        DTSCU831
00669  S2200-EXIT.                                                      DTSCU831
00670      EXIT.                                                        DTSCU831
00671      EJECT                                                        DTSCU831
00672  S2300-CALCULATE-LENGTH.                                          DTSCU831
00673      IF (FSKL-REC-TYPE OF FCOMM-REC < +1)                         DTSCU831
00674             OR                                                    DTSCU831
00675         (FSKL-REC-TYPE OF FCOMM-REC > FLEN-MAX-REC-ID)            DTSCU831
00676          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00677                                                                   DTSCU831
00678      SET FLEN-IDX TO FSKL-REC-TYPE OF FCOMM-REC.                  DTSCU831
00679                                                                   DTSCU831
00680      IF FLEN-REC-LEN (FLEN-IDX) = +0                              DTSCU831
00681          PERFORM S899-ABEND THRU S899-EXIT                        DTSCU831
00682      ELSE                                                         DTSCU831
00683          MOVE FLEN-REC-LEN (FLEN-IDX) TO WRK-REC-LENGTH.          DTSCU831
00684  S2300-EXIT.                                                      DTSCU831
00685      EXIT.                                                        DTSCU831
00686      EJECT                                                        DTSCU831
00687  S3100-READ-UPDATE.                                               DTSCU831
00688      MOVE LOW-VALUES TO FIO-REC.                                  DTSCU831
00689                                                                   DTSCU831
00690      MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
00691                                                                   DTSCU831
00692      MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH.                     DTSCU831
00693                                                                   DTSCU831
00694      EXEC CICS                                                    DTSCU831
00695          READ                                                     DTSCU831
00696              DATASET (WRK-FILE-NAME)                              DTSCU831
00697              INTO (FIO-REC)                                       DTSCU831
00698              LENGTH (WRK-REC-LENGTH)                              DTSCU831
00699              RIDFLD (FSKL-KEY-AREA OF FIO-REC)                    DTSCU831
00700              UPDATE                                               DTSCU831
00701              RESP (WRK-RESP-CD)                                   DTSCU831
00702      END-EXEC.                                                    DTSCU831
00703                                                                   DTSCU831
00704      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU831
00705                         OR DFHRESP (SYSIDERR)                     DTSCU831
00706          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU831
00707          GO TO S3100-EXIT.                                        DTSCU831
00708                                                                   DTSCU831
00709      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU831
00710          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU831
00711          GO TO S3100-EXIT.                                        DTSCU831
00712                                                                   DTSCU831
00713      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU831
00714          NEXT SENTENCE                                            DTSCU831
00715      ELSE                                                         DTSCU831
00716          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU831
00717  S3100-EXIT.                                                      DTSCU831
00718      EXIT.                                                        DTSCU831
00719      EJECT                                                        DTSCU831
00720  S899-ABEND.                                                      DTSCU831
00721                                                                   DTSCU831
00722      EXEC CICS                                                    DTSCU831
00723          ABEND                                                    DTSCU831
00724              ABCODE (WRK-ABEND-CD)                                DTSCU831
00725      END-EXEC.                                                    DTSCU831
00726                                                                   DTSCU831
00727  S899-EXIT.                                                       DTSCU831
00728      EXIT.                                                        DTSCU831
