00001  IDENTIFICATION DIVISION.                                         11/19/09
00002  PROGRAM-ID.             DTSCU810.                                DTSCU810
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV021
00004  DATE-WRITTEN.           APRIL 1994.                              DTSCU810
00005  DATE-COMPILED.                                                   DTSCU810
00006                                                                   DTSCU810
00007                                                                   DTSCU810
00008 *****                                                             DTSCU810
00009 *                                                                 DTSCU810
00010 *    FUNCTION:  EMPLOYER MASTER FILE INPUT/OUTPUT - CICS.         DTSCU810
00011 *                                                                 DTSCU810
00012 *                                                                 DTSCU810
00013 *    NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE  DTSCU810
00014 *    NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE  DTSCU810
00015 *    NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE  DTSCU810
00016 *                                                                 DTSCU810
00017 *        SPECIFY TRUNC(OPT) DURING COMPILE OF DTSCU810.  TRUNC    DTSCU810
00018 *        (OPT) REDUCES CPU RESOURCE USAGE DURING COMPRESSION/     DTSCU810
00019 *        EXPANSION BY 50% (VS TRUNC(STD)).                        DTSCU810
00020 *                                                                 DTSCU810
00021 *    NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE  DTSCU810
00022 *    NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE  DTSCU810
00023 *    NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE  DTSCU810
00024 *                                                                 DTSCU810
00025 *                                                                 DTSCU810
00026 *    MODIFICATION LOG:                                            DTSCU810
00027 *                                                                 DTSCU810
00028 *    04/01/94  INITIAL DEVELOPMENT.                               DTSCU810
00029 *              WORK ORDER:                      PROGRAMMER: EHH   DTSCU810
00030 *                                                                 DTSCU810
00031 *    09/18/95  ADD IWHO RECORD CONSTRUCTION.                      DTSCU810
00032 *              WORK ORDER: JR                   PROGRAMMER: EHH   DTSCU810
00033 *                                                                 DTSCU810
00034 *    06/13/96  ADD MELF RECORD.                                   DTSCU810
00035 *              REFERENCE RFP: WARP II           PROGRAMMER: MJA   DTSCU810
00036 *                                                                 DTSCU810
00037 *    08/31/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCU810
00038 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU810
00039 *                                                                 DTSCU810
00040 *    04/18/2003  MODIFIED FOR NEW ELECTRONIC PAYMENT AIX RECORDS  DTSCU810
00041 *                DTSIITRT AND DTSIITRE.                           DTSCU810
00042 *                REFERENCE: EFT                 PROGRAMMER: GD    DTSCU810
00043 *                                                                 DTSCU810
00044 *    08/15/2003  MODIFIED FOR NEW VSAM FILES MSTH AND MSTI        DTSCU810
00045 *                REFERENCE: SPLIT MSTB FILE     PROGRAMMER: GD    DTSCU810
00046 *                                                                 DTSCU810
00047 *    10/23/2006  RECOMPILED FOR NEW VERSION OF DTSIP003 (IPES)    DTSCU810
00048 *                REFERENCE:                     PROGRAMMER: GD    DTSCU810
00049 *                                                                 DTSCU810
00050 *    11/13/2006  RECOMPILED FOR NEW VERSION OF DTSIP003 (IPES)    DTSCU810
00051 *                REFERENCE:                     PROGRAMMER: GD    DTSCU810
00052 *                                                                 DTSCU810
00053 *    11/13/2006  MODIFIED FOR NEW VSAM FILE MSTJ, AND NEW         DTSCU810
00054 *                RECORD TYPES MRRA AND MRWA.                      DTSCU810
00055 *                REFERENCE: PARTIAL XFERS       PROGRAMMER: GD    DTSCU810
00056 *                                                                 DTSCU810
00057 *    02/15/2008  UPDATED FOR MRFD, IRFD REFUND REC TYPES.         DTSCU810
00058 *                REFERENCE: CFO REFUNDS         PROGRAMMER: GD    DTSCU810
00059 *                                                                 DTSCU810
00060 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU810
00061 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU810
00062 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU810
00063 *                                                                 DTSCU810
00064 *                                                                 DTSCU810
00065 *    DESCRIPTION:                                                 DTSCU810
00066 *                                                                 DTSCU810
00067 *        ON-LINE MASTER FILE I/O.                                 DTSCU810
00068 *                                                                 DTSCU810
00069 *****                                                             DTSCU810
00070                                                                   DTSCU810
00071                                                                   DTSCU810
00072                                                                   DTSCU810
00073  ENVIRONMENT DIVISION.                                            DTSCU810
00074                                                                   DTSCU810
00075                                                                   DTSCU810
00076  DATA DIVISION.                                                   DTSCU810
00077                                                                   DTSCU810
00078  WORKING-STORAGE SECTION.                                         DTSCU810
000785 77  PAN-VALET PICTURE X(24) VALUE '021DTSCU810  11/19/09'.       DTSCU810
00079                                                                   DTSCU810
00080  01  WRK-AREA.                                                    DTSCU810
00081      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U810'.    DTSCU810
00082                                                                   DTSCU810
00083      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU810
00084                                                                   DTSCU810
00085                                                                   DTSCU810
00086      05  WRK-PROD-FILE-NAME-PREFIX   PIC  X(04)  VALUE 'DTSF'.    DTSCU810
00087                                                                   DTSCU810
00088      05  WRK-COMB-FILE-NAME-PREFIX   PIC  X(04)  VALUE 'DTSC'.    DTSCU810
00089                                                                   DTSCU810
00090                                                                   DTSCU810
00091      05  WRK-FILE-SUFFIXES.                                       DTSCU810
00092          10  FILLER                  PIC  X(04)  VALUE 'MSTA'.    DTSCU810
00093          10  FILLER                  PIC  X(04)  VALUE 'MSTB'.    DTSCU810
00094          10  FILLER                  PIC  X(04)  VALUE 'MSTC'.    DTSCU810
00095          10  FILLER                  PIC  X(04)  VALUE 'MSTD'.    DTSCU810
00096          10  FILLER                  PIC  X(04)  VALUE 'MSTH'.    DTSCU810
00097          10  FILLER                  PIC  X(04)  VALUE 'MSTI'.    DTSCU810
00098          10  FILLER                  PIC  X(04)  VALUE 'MSTJ'.    DTSCU810
00099      05  FILLER REDEFINES WRK-FILE-SUFFIXES.                      DTSCU810
00100          10  WRK-FILE-SUFFIX OCCURS 7 TIMES                       DTSCU810
00101                                      PIC  X(04).                  DTSCU810
00102                                                                   DTSCU810
00103                                                                   DTSCU810
00104      05  EMSG-NOT-AVAILABLE.                                      DTSCU810
00105          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU810
00106          10  FILLER                  PIC  X(06)  VALUE 'FILE'.    DTSCU810
00107          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU810
00108          10  FILLER                  PIC  X(33)                   DTSCU810
00109        VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.                 DTSCU810
00110                                                                   DTSCU810
00111                                                                   DTSCU810
00112      05  WRK-FILE-NAME.                                           DTSCU810
00113          10  WRK-FILE-NAME-PREFIX    PIC  X(04).                  DTSCU810
00114          10  WRK-FILE-NAME-SUFFIX    PIC  X(04).                  DTSCU810
00115                                                                   DTSCU810
00116                                                                   DTSCU810
00117      05  REC-TYPE-SUB                PIC S9(04)  COMP.            DTSCU810
00118                                                                   DTSCU810
00119      05  FILE-SUB                    PIC S9(04)  COMP.            DTSCU810
00120                                                                   DTSCU810
00121                                                                   DTSCU810
00122      05  MIO-REC-LENGTH              PIC S9(04)  COMP.            DTSCU810
00123                                                                   DTSCU810
00124      05  MIO-KEY-LENGTH              PIC S9(04)  COMP.            DTSCU810
00125                                                                   DTSCU810
00126      05  MIO-KEY-FILLER-LENGTH       PIC S9(04)  COMP.            DTSCU810
00127                                                                   DTSCU810
00128      05  MIO-KEY-FILLER-START        PIC S9(04)  COMP.            DTSCU810
00129                                                                   DTSCU810
00130                                                                   DTSCU810
00131      05  WRK-REC-LENGTH              PIC S9(04)  COMP.            DTSCU810
00132                                                                   DTSCU810
00133      05  WRK-DATA-LENGTH             PIC S9(04)  COMP.            DTSCU810
00134                                                                   DTSCU810
00135                                                                   DTSCU810
00136      05  OCC-COUNT-START             PIC S9(04)  COMP.            DTSCU810
00137                                                                   DTSCU810
00138      05  OCC-COUNT-X                 PIC  X(02).                  DTSCU810
00139      05  OCC-COUNT REDEFINES OCC-COUNT-X                          DTSCU810
00140                                      PIC S9(04)  COMP.            DTSCU810
00141                                                                   DTSCU810
00142                                                                   DTSCU810
00143      05  COUNT-COMPLETE-IND          PIC  X(01).                  DTSCU810
00144      EJECT                                                        DTSCU810
00145  01  MCMP-WORK-AREA.                                              DTSCU810
00146  ++INCLUDE DTSICCMP                                               DTSCU810
00147      EJECT                                                        DTSCU810
00148  01  MLEN-LENGTH-LITERALS.                                        DTSCU810
00149  ++INCLUDE DTSIMLEN                                               DTSCU810
00150      EJECT                                                        DTSCU810
00151  01  MIO-REC.                                                     DTSCU810
00152  ++INCLUDE DTSIMIO                                                DTSCU810
00153      EJECT                                                        DTSCU810
00154  01  WRK-REC.                                                     DTSCU810
00155  ++INCLUDE DTSIMSKL                                               DTSCU810
00156      SKIP3                                                        DTSCU810
00157          10  WRK-DATA-AREA REDEFINES MSKL-DATA-AREA.              DTSCU810
00158              15  WRK-DATA-CHAR OCCURS 1515 TIMES                  DTSCU810
00159                                INDEXED BY WRK-DATA-IDX            DTSCU810
00160                                          PIC  X(01).              DTSCU810
00161      SKIP3                                                        DTSCU810
00162  01  MPRF-REC REDEFINES WRK-REC.                                  DTSCU810
00163  ++INCLUDE DTSIMPRF                                               DTSCU810
00164      SKIP3                                                        DTSCU810
00165  01  MBAA-REC REDEFINES WRK-REC.                                  DTSCU810
00166  ++INCLUDE DTSIMBAA                                               DTSCU810
00167      SKIP3                                                        DTSCU810
00168  01  MFAS-REC REDEFINES WRK-REC.                                  DTSCU810
00169  ++INCLUDE DTSIMFAS                                               DTSCU810
00170      SKIP3                                                        DTSCU810
00171  01  MFSL-REC REDEFINES WRK-REC.                                  DTSCU810
00172  ++INCLUDE DTSIMFSL                                               DTSCU810
00173      SKIP3                                                        DTSCU810
00174  01  MOPO-REC REDEFINES WRK-REC.                                  DTSCU810
00175  ++INCLUDE DTSIMOPO                                               DTSCU810
00176      SKIP3                                                        DTSCU810
00177  01  MPAY-REC REDEFINES WRK-REC.                                  DTSCU810
00178  ++INCLUDE DTSIMPAY                                               DTSCU810
00179      SKIP3                                                        DTSCU810
00180  01  MREL-REC REDEFINES WRK-REC.                                  DTSCU810
00181  ++INCLUDE DTSIMREL                                               DTSCU810
00182      SKIP3                                                        DTSCU810
00183  01  MRFD-REC REDEFINES WRK-REC.                                  DTSCU810
00184  ++INCLUDE DTSIMRFD                                               DTSCU810
00185      SKIP3                                                        DTSCU810
00186  01  MRPT-REC REDEFINES WRK-REC.                                  DTSCU810
00187  ++INCLUDE DTSIMRPT                                               DTSCU810
00188      SKIP3                                                        DTSCU810
00189  01  MTCK-REC REDEFINES WRK-REC.                                  DTSCU810
00190  ++INCLUDE DTSIMTCK                                               DTSCU810
00191      SKIP3                                                        DTSCU810
00192  01  MTAA-REC REDEFINES WRK-REC.                                  DTSCU810
00193  ++INCLUDE DTSIMTAA                                               DTSCU810
00194      EJECT                                                        DTSCU810
00195  01  AIX-WORK-AREA.                                               DTSCU810
00196  ++INCLUDE DTSIXAIX                                               DTSCU810
00197      EJECT                                                        DTSCU810
00198  01  L821-COMM-AREA.                                              DTSCU810
00199      05  L821-CONTROL-AREA.                                       DTSCU810
00200  ++INCLUDE DTSIL821                                               DTSCU810
00201      SKIP3                                                        DTSCU810
00202      05  ISKL-REC.                                                DTSCU810
00203  ++INCLUDE DTSIISKL                                               DTSCU810
00204      SKIP3                                                        DTSCU810
00205      05  IBTB-REC REDEFINES ISKL-REC.                             DTSCU810
00206  ++INCLUDE DTSIIBTB                                               DTSCU810
00207      SKIP3                                                        DTSCU810
00208      05  IEIN-REC REDEFINES ISKL-REC.                             DTSCU810
00209  ++INCLUDE DTSIIEIN                                               DTSCU810
00210      SKIP3                                                        DTSCU810
00211      05  IFAN-REC REDEFINES ISKL-REC.                             DTSCU810
00212  ++INCLUDE DTSIIFAN                                               DTSCU810
00213      SKIP3                                                        DTSCU810
00214      05  IFID-REC REDEFINES ISKL-REC.                             DTSCU810
00215  ++INCLUDE DTSIIFID                                               DTSCU810
00216      SKIP3                                                        DTSCU810
00217      05  IOPN-REC REDEFINES ISKL-REC.                             DTSCU810
00218  ++INCLUDE DTSIIOPN                                               DTSCU810
00219      SKIP3                                                        DTSCU810
00220      05  IOPS-REC REDEFINES ISKL-REC.                             DTSCU810
00221  ++INCLUDE DTSIIOPS                                               DTSCU810
00222      SKIP3                                                        DTSCU810
00223      05  IPES-REC REDEFINES ISKL-REC.                             DTSCU810
00224  ++INCLUDE DTSIIPES                                               DTSCU810
00225      SKIP3                                                        DTSCU810
00226      05  IRFD-REC REDEFINES ISKL-REC.                             DTSCU810
00227  ++INCLUDE DTSIIRFD                                               DTSCU810
00228      SKIP3                                                        DTSCU810
00229      05  ITDS-REC REDEFINES ISKL-REC.                             DTSCU810
00230  ++INCLUDE DTSIITDS                                               DTSCU810
00231      SKIP3                                                        DTSCU810
00232      05  IZIP-REC REDEFINES ISKL-REC.                             DTSCU810
00233  ++INCLUDE DTSIIZIP                                               DTSCU810
00234      SKIP3                                                        DTSCU810
00235      05  IBTN-REC REDEFINES ISKL-REC.                             DTSCU810
00236  ++INCLUDE DTSIIBTN                                               DTSCU810
00237      SKIP3                                                        DTSCU810
00238      05  ITRT-REC REDEFINES ISKL-REC.                             DTSCU810
00239  ++INCLUDE DTSIITRT                                               DTSCU810
00240      SKIP3                                                        DTSCU810
00241      05  ITRE-REC REDEFINES ISKL-REC.                             DTSCU810
00242  ++INCLUDE DTSIITRE                                               DTSCU810
00243      EJECT                                                        DTSCU810
00244  LINKAGE SECTION.                                                 DTSCU810
00245      SKIP3                                                        DTSCU810
00246  01  DFHCOMMAREA.                                                 DTSCU810
00247      05  L810-CONTROL-BLOCK.                                      DTSCU810
00248  ++INCLUDE DTSIL810                                               DTSCU810
00249      SKIP3                                                        DTSCU810
00250      05  MCOMM-REC.                                               DTSCU810
00251  ++INCLUDE DTSIMSKL                                               DTSCU810
00252      EJECT                                                        DTSCU810
00253  PROCEDURE DIVISION.                                              DTSCU810
00254      SKIP2                                                        DTSCU810
00255      IF EIBTRNID = 'DTSC'                                         DTSCU810
00256          MOVE WRK-COMB-FILE-NAME-PREFIX                           DTSCU810
00257            TO WRK-FILE-NAME-PREFIX                                DTSCU810
00258      ELSE                                                         DTSCU810
00259          MOVE WRK-PROD-FILE-NAME-PREFIX                           DTSCU810
00260            TO WRK-FILE-NAME-PREFIX.                               DTSCU810
00261                                                                   DTSCU810
00262                                                                   DTSCU810
00263      MOVE +0 TO L810-RECORD-CNT.                                  DTSCU810
00264                                                                   DTSCU810
00265      MOVE SPACES TO L810-MSG-AREA.                                DTSCU810
00266                                                                   DTSCU810
00267      SET L810-OK-88 TO TRUE.                                      DTSCU810
00268                                                                   DTSCU810
00269                                                                   DTSCU810
00270      MOVE MSKL-REC-TYPE OF MCOMM-REC TO REC-TYPE-SUB.             DTSCU810
00271                                                                   DTSCU810
00272      IF (REC-TYPE-SUB < +1)                                       DTSCU810
00273             OR                                                    DTSCU810
00274         (REC-TYPE-SUB > MLEN-MAX-REC-TYPE)                        DTSCU810
00275          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00276                                                                   DTSCU810
00277                                                                   DTSCU810
00278      MOVE MLEN-FILE-ID (REC-TYPE-SUB) TO FILE-SUB.                DTSCU810
00279                                                                   DTSCU810
00280      IF FILE-SUB = +0                                             DTSCU810
00281          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00282                                                                   DTSCU810
00283      MOVE WRK-FILE-SUFFIX (FILE-SUB)                              DTSCU810
00284        TO WRK-FILE-NAME-SUFFIX.                                   DTSCU810
00285                                                                   DTSCU810
00286                                                                   DTSCU810
00287      IF L810-READ-88                                              DTSCU810
00288          PERFORM P1100-READ THRU P1100-EXIT                       DTSCU810
00289      ELSE                                                         DTSCU810
00290      IF L810-START-BROWSE-88                                      DTSCU810
00291          PERFORM P1200-START-BROWSE THRU P1200-EXIT               DTSCU810
00292      ELSE                                                         DTSCU810
00293      IF L810-READ-NEXT-88                                         DTSCU810
00294          PERFORM P1300-READ-NEXT THRU P1300-EXIT                  DTSCU810
00295      ELSE                                                         DTSCU810
00296      IF L810-READ-PREV-88                                         DTSCU810
00297          PERFORM P1400-READ-PREV THRU P1400-EXIT                  DTSCU810
00298      ELSE                                                         DTSCU810
00299      IF L810-COUNT-88                                             DTSCU810
00300          PERFORM P1500-COUNT THRU P1500-EXIT                      DTSCU810
00301      ELSE                                                         DTSCU810
00302      IF L810-END-BROWSE-88                                        DTSCU810
00303          PERFORM P1600-END-BROWSE THRU P1600-EXIT                 DTSCU810
00304      ELSE                                                         DTSCU810
00305      IF L810-WRITE-88                                             DTSCU810
00306          PERFORM P2100-WRITE THRU P2100-EXIT                      DTSCU810
00307      ELSE                                                         DTSCU810
00308      IF L810-REWRITE-88                                           DTSCU810
00309          PERFORM P2200-REWRITE THRU P2200-EXIT                    DTSCU810
00310      ELSE                                                         DTSCU810
00311      IF L810-DELETE-88                                            DTSCU810
00312          PERFORM P2300-DELETE THRU P2300-EXIT                     DTSCU810
00313      ELSE                                                         DTSCU810
00314      IF L810-READ-UPDATE-88                                       DTSCU810
00315          PERFORM P3100-READ-UPDATE THRU P3100-EXIT                DTSCU810
00316      ELSE                                                         DTSCU810
00317      IF L810-REWRITE-UPDATE-88                                    DTSCU810
00318          PERFORM P3200-REWRITE-UPDATE THRU P3200-EXIT             DTSCU810
00319      ELSE                                                         DTSCU810
00320          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00321                                                                   DTSCU810
00322                                                                   DTSCU810
00323      EXEC CICS                                                    DTSCU810
00324          RETURN                                                   DTSCU810
00325      END-EXEC.                                                    DTSCU810
00326                                                                   DTSCU810
00327                                                                   DTSCU810
00328      GOBACK.                                                      DTSCU810
00329      EJECT                                                        DTSCU810
00330  P1100-READ.                                                      DTSCU810
00331      MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.             DTSCU810
00332                                                                   DTSCU810
00333      MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH.                 DTSCU810
00334                                                                   DTSCU810
00335      EXEC CICS                                                    DTSCU810
00336          READ                                                     DTSCU810
00337              DATASET (WRK-FILE-NAME)                              DTSCU810
00338              INTO (MIO-REC)                                       DTSCU810
00339              LENGTH (MIO-REC-LENGTH)                              DTSCU810
00340              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00341              RESP (WRK-RESP-CD)                                   DTSCU810
00342      END-EXEC.                                                    DTSCU810
00343                                                                   DTSCU810
00344      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00345                         OR DFHRESP (SYSIDERR)                     DTSCU810
00346          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00347          GO TO P1100-EXIT.                                        DTSCU810
00348                                                                   DTSCU810
00349      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU810
00350          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSCU810
00351          GO TO P1100-EXIT.                                        DTSCU810
00352                                                                   DTSCU810
00353      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00354          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00355                                                                   DTSCU810
00356      PERFORM S2100-IO-TO-COMM THRU S2100-EXIT.                    DTSCU810
00357  P1100-EXIT.                                                      DTSCU810
00358      EXIT.                                                        DTSCU810
00359      EJECT                                                        DTSCU810
00360  P1200-START-BROWSE.                                              DTSCU810
00361      MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.             DTSCU810
00362                                                                   DTSCU810
00363      EXEC CICS                                                    DTSCU810
00364          STARTBR                                                  DTSCU810
00365              DATASET (WRK-FILE-NAME)                              DTSCU810
00366              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00367              RESP (WRK-RESP-CD)                                   DTSCU810
00368      END-EXEC.                                                    DTSCU810
00369                                                                   DTSCU810
00370      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00371                         OR DFHRESP (SYSIDERR)                     DTSCU810
00372          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00373          GO TO P1200-EXIT.                                        DTSCU810
00374                                                                   DTSCU810
00375      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU810
00376          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSCU810
00377          GO TO P1200-EXIT.                                        DTSCU810
00378                                                                   DTSCU810
00379      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00380          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00381                                                                   DTSCU810
00382      PERFORM P1300-READ-NEXT THRU P1300-EXIT.                     DTSCU810
00383  P1200-EXIT.                                                      DTSCU810
00384      EXIT.                                                        DTSCU810
00385      EJECT                                                        DTSCU810
00386  P1300-READ-NEXT.                                                 DTSCU810
00387      IF L810-READ-NEXT-88                                         DTSCU810
00388          MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.         DTSCU810
00389                                                                   DTSCU810
00390      MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH.                 DTSCU810
00391                                                                   DTSCU810
00392      EXEC CICS                                                    DTSCU810
00393          READNEXT                                                 DTSCU810
00394              DATASET (WRK-FILE-NAME)                              DTSCU810
00395              INTO (MIO-REC)                                       DTSCU810
00396              LENGTH (MIO-REC-LENGTH)                              DTSCU810
00397              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00398              RESP (WRK-RESP-CD)                                   DTSCU810
00399      END-EXEC.                                                    DTSCU810
00400                                                                   DTSCU810
00401      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00402                         OR DFHRESP (SYSIDERR)                     DTSCU810
00403          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00404          GO TO P1300-EXIT.                                        DTSCU810
00405                                                                   DTSCU810
00406      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU810
00407          PERFORM P1600-END-BROWSE THRU P1600-EXIT                 DTSCU810
00408          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSCU810
00409          GO TO P1300-EXIT.                                        DTSCU810
00410                                                                   DTSCU810
00411      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00412          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00413                                                                   DTSCU810
00414      IF (MIO-EMP-NO = MSKL-EMP-NO OF MCOMM-REC)                   DTSCU810
00415              AND                                                  DTSCU810
00416         (MIO-REC-TYPE = MSKL-REC-TYPE OF MCOMM-REC)               DTSCU810
00417          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU810
00418      ELSE                                                         DTSCU810
00419          PERFORM P1600-END-BROWSE THRU P1600-EXIT                 DTSCU810
00420          PERFORM S1100-NO-REC THRU S1100-EXIT.                    DTSCU810
00421  P1300-EXIT.                                                      DTSCU810
00422      EXIT.                                                        DTSCU810
00423      EJECT                                                        DTSCU810
00424  P1400-READ-PREV.                                                 DTSCU810
00425      MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.             DTSCU810
00426                                                                   DTSCU810
00427      MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH.                 DTSCU810
00428                                                                   DTSCU810
00429      EXEC CICS                                                    DTSCU810
00430          READPREV                                                 DTSCU810
00431              DATASET (WRK-FILE-NAME)                              DTSCU810
00432              INTO (MIO-REC)                                       DTSCU810
00433              LENGTH (MIO-REC-LENGTH)                              DTSCU810
00434              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00435              RESP (WRK-RESP-CD)                                   DTSCU810
00436      END-EXEC.                                                    DTSCU810
00437                                                                   DTSCU810
00438      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00439                         OR DFHRESP (SYSIDERR)                     DTSCU810
00440          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00441          GO TO P1400-EXIT.                                        DTSCU810
00442                                                                   DTSCU810
00443      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU810
00444          PERFORM P1600-END-BROWSE THRU P1600-EXIT                 DTSCU810
00445          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSCU810
00446          GO TO P1400-EXIT.                                        DTSCU810
00447                                                                   DTSCU810
00448      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00449          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00450                                                                   DTSCU810
00451      IF (MIO-EMP-NO = MSKL-EMP-NO OF MCOMM-REC)                   DTSCU810
00452              AND                                                  DTSCU810
00453         (MIO-REC-TYPE = MSKL-REC-TYPE OF MCOMM-REC)               DTSCU810
00454          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU810
00455      ELSE                                                         DTSCU810
00456          PERFORM P1600-END-BROWSE THRU P1600-EXIT                 DTSCU810
00457          PERFORM S1100-NO-REC THRU S1100-EXIT.                    DTSCU810
00458  P1400-EXIT.                                                      DTSCU810
00459      EXIT.                                                        DTSCU810
00460      EJECT                                                        DTSCU810
00461  P1500-COUNT.                                                     DTSCU810
00462      MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.             DTSCU810
00463                                                                   DTSCU810
00464      IF MSKL-AUY-88 OF MCOMM-REC OR MSKL-FAR-88 OF MCOMM-REC      DTSCU810
00465          MOVE LOW-VALUES TO MIO-KEY-AREA (12:5)                   DTSCU810
00466      ELSE                                                         DTSCU810
00467          MOVE LOW-VALUES TO MIO-KEY-FILLER.                       DTSCU810
00468                                                                   DTSCU810
00469      EXEC CICS                                                    DTSCU810
00470          STARTBR                                                  DTSCU810
00471              DATASET (WRK-FILE-NAME)                              DTSCU810
00472              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00473              RESP (WRK-RESP-CD)                                   DTSCU810
00474      END-EXEC.                                                    DTSCU810
00475                                                                   DTSCU810
00476      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00477                         OR DFHRESP (SYSIDERR)                     DTSCU810
00478          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00479          GO TO P1500-EXIT.                                        DTSCU810
00480                                                                   DTSCU810
00481      SET L810-NO-REC-88 TO TRUE.                                  DTSCU810
00482                                                                   DTSCU810
00483      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU810
00484          MOVE +0 TO L810-RECORD-CNT                               DTSCU810
00485          GO TO P1500-EXIT.                                        DTSCU810
00486                                                                   DTSCU810
00487      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00488          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00489                                                                   DTSCU810
00490                                                                   DTSCU810
00491      MOVE +0 TO L810-RECORD-CNT.                                  DTSCU810
00492                                                                   DTSCU810
00493      MOVE 'N' TO COUNT-COMPLETE-IND.                              DTSCU810
00494                                                                   DTSCU810
00495      PERFORM P1510-COUNT-LOOP THRU P1510-EXIT                     DTSCU810
00496          UNTIL COUNT-COMPLETE-IND = 'Y'.                          DTSCU810
00497  P1500-EXIT.                                                      DTSCU810
00498      EXIT.                                                        DTSCU810
00499      SKIP3                                                        DTSCU810
00500  P1510-COUNT-LOOP.                                                DTSCU810
00501      MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH.                 DTSCU810
00502                                                                   DTSCU810
00503      EXEC CICS                                                    DTSCU810
00504          READNEXT                                                 DTSCU810
00505              DATASET (WRK-FILE-NAME)                              DTSCU810
00506              INTO (MIO-REC)                                       DTSCU810
00507              LENGTH (MIO-REC-LENGTH)                              DTSCU810
00508              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00509              RESP (WRK-RESP-CD)                                   DTSCU810
00510      END-EXEC.                                                    DTSCU810
00511                                                                   DTSCU810
00512      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00513                         OR DFHRESP (SYSIDERR)                     DTSCU810
00514          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00515          MOVE 'Y' TO COUNT-COMPLETE-IND                           DTSCU810
00516          GO TO P1510-EXIT.                                        DTSCU810
00517                                                                   DTSCU810
00518      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU810
00519          PERFORM P1600-END-BROWSE THRU P1600-EXIT                 DTSCU810
00520          MOVE 'Y' TO COUNT-COMPLETE-IND                           DTSCU810
00521          GO TO P1510-EXIT.                                        DTSCU810
00522                                                                   DTSCU810
00523      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00524          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00525                                                                   DTSCU810
00526                                                                   DTSCU810
00527      IF MSKL-AUY-88 OF MCOMM-REC OR MSKL-FAR-88 OF MCOMM-REC      DTSCU810
00528          IF (MIO-KEY-AREA (1:11)                                  DTSCU810
00529                 = MSKL-KEY-AREA OF MCOMM-REC (1:11))              DTSCU810
00530              ADD +1 TO L810-RECORD-CNT                            DTSCU810
00531              SET L810-OK-88 TO TRUE                               DTSCU810
00532              MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF MCOMM-REC      DTSCU810
00533          ELSE                                                     DTSCU810
00534              PERFORM P1600-END-BROWSE THRU P1600-EXIT             DTSCU810
00535              MOVE 'Y' TO COUNT-COMPLETE-IND                       DTSCU810
00536      ELSE                                                         DTSCU810
00537          IF (MIO-EMP-NO = MSKL-EMP-NO OF MCOMM-REC)               DTSCU810
00538                  AND                                              DTSCU810
00539             (MIO-REC-TYPE = MSKL-REC-TYPE OF MCOMM-REC)           DTSCU810
00540              ADD +1 TO L810-RECORD-CNT                            DTSCU810
00541              SET L810-OK-88 TO TRUE                               DTSCU810
00542              MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF MCOMM-REC      DTSCU810
00543          ELSE                                                     DTSCU810
00544              PERFORM P1600-END-BROWSE THRU P1600-EXIT             DTSCU810
00545              MOVE 'Y' TO COUNT-COMPLETE-IND.                      DTSCU810
00546  P1510-EXIT.                                                      DTSCU810
00547      EXIT.                                                        DTSCU810
00548      EJECT                                                        DTSCU810
00549  P1600-END-BROWSE.                                                DTSCU810
00550                                                                   DTSCU810
00551      EXEC CICS                                                    DTSCU810
00552          ENDBR                                                    DTSCU810
00553              DATASET (WRK-FILE-NAME)                              DTSCU810
00554              RESP (WRK-RESP-CD)                                   DTSCU810
00555      END-EXEC.                                                    DTSCU810
00556                                                                   DTSCU810
00557      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00558                         OR DFHRESP (SYSIDERR)                     DTSCU810
00559          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00560          GO TO P1600-EXIT.                                        DTSCU810
00561                                                                   DTSCU810
00562      IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ)        DTSCU810
00563          NEXT SENTENCE                                            DTSCU810
00564      ELSE                                                         DTSCU810
00565          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00566  P1600-EXIT.                                                      DTSCU810
00567      EXIT.                                                        DTSCU810
00568      EJECT                                                        DTSCU810
00569  P2100-WRITE.                                                     DTSCU810
00570      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU810
00571                                                                   DTSCU810
00572      PERFORM P2110-INITIALIZE-KEY-FILLER THRU P2110-EXIT.         DTSCU810
00573                                                                   DTSCU810
00574      EXEC CICS                                                    DTSCU810
00575          WRITE                                                    DTSCU810
00576             DATASET (WRK-FILE-NAME)                               DTSCU810
00577             FROM (MIO-REC)                                        DTSCU810
00578             LENGTH (MIO-REC-LENGTH)                               DTSCU810
00579             RIDFLD (MIO-KEY-AREA)                                 DTSCU810
00580             RESP (WRK-RESP-CD)                                    DTSCU810
00581      END-EXEC.                                                    DTSCU810
00582                                                                   DTSCU810
00583      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00584                         OR DFHRESP (SYSIDERR)                     DTSCU810
00585          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00586          GO TO P2100-EXIT.                                        DTSCU810
00587                                                                   DTSCU810
00588      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00589          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00590                                                                   DTSCU810
00591                                                                   DTSCU810
00592      MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS.                      DTSCU810
00593                                                                   DTSCU810
00594      PERFORM S3200-CONSTRUCT-IPOST THRU S3200-EXIT.               DTSCU810
00595                                                                   DTSCU810
00596      PERFORM S3300-UPDATE-AIX THRU S3300-EXIT.                    DTSCU810
00597  P2100-EXIT.                                                      DTSCU810
00598      EXIT.                                                        DTSCU810
00599      SKIP3                                                        DTSCU810
00600  P2110-INITIALIZE-KEY-FILLER.                                     DTSCU810
00601      COMPUTE MIO-KEY-FILLER-START                                 DTSCU810
00602        = MLEN-KEY-LEN (REC-TYPE-SUB) + 1.                         DTSCU810
00603                                                                   DTSCU810
00604      COMPUTE MIO-KEY-FILLER-LENGTH                                DTSCU810
00605        = MLEN-MAX-KEY-LEN - MLEN-KEY-LEN (REC-TYPE-SUB).          DTSCU810
00606                                                                   DTSCU810
00607      IF MIO-KEY-FILLER-LENGTH > +0                                DTSCU810
00608          MOVE LOW-VALUES                                          DTSCU810
00609            TO MIO-KEY-AREA                                        DTSCU810
00610                 (MIO-KEY-FILLER-START:MIO-KEY-FILLER-LENGTH).     DTSCU810
00611  P2110-EXIT.                                                      DTSCU810
00612      EXIT.                                                        DTSCU810
00613      EJECT                                                        DTSCU810
00614  P2200-REWRITE.                                                   DTSCU810
00615      PERFORM P2900-PREPARE-FOR-UPDATE THRU P2900-EXIT.            DTSCU810
00616                                                                   DTSCU810
00617      IF L810-NO-REC-88                                            DTSCU810
00618          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00619                                                                   DTSCU810
00620      IF L810-FILE-CLOSED-88                                       DTSCU810
00621          GO TO P2200-EXIT.                                        DTSCU810
00622                                                                   DTSCU810
00623      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU810
00624                                                                   DTSCU810
00625      EXEC CICS                                                    DTSCU810
00626          REWRITE                                                  DTSCU810
00627             DATASET (WRK-FILE-NAME)                               DTSCU810
00628             FROM (MIO-REC)                                        DTSCU810
00629             LENGTH (MIO-REC-LENGTH)                               DTSCU810
00630             RESP (WRK-RESP-CD)                                    DTSCU810
00631      END-EXEC.                                                    DTSCU810
00632                                                                   DTSCU810
00633      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00634                         OR DFHRESP (SYSIDERR)                     DTSCU810
00635          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00636          GO TO P2200-EXIT.                                        DTSCU810
00637                                                                   DTSCU810
00638      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00639          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00640                                                                   DTSCU810
00641                                                                   DTSCU810
00642      PERFORM S3200-CONSTRUCT-IPOST THRU S3200-EXIT.               DTSCU810
00643                                                                   DTSCU810
00644      PERFORM S3300-UPDATE-AIX THRU S3300-EXIT.                    DTSCU810
00645  P2200-EXIT.                                                      DTSCU810
00646      EXIT.                                                        DTSCU810
00647      EJECT                                                        DTSCU810
00648  P2300-DELETE.                                                    DTSCU810
00649      PERFORM P2900-PREPARE-FOR-UPDATE THRU P2900-EXIT.            DTSCU810
00650                                                                   DTSCU810
00651      IF L810-NO-REC-88                                            DTSCU810
00652          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00653                                                                   DTSCU810
00654      IF L810-FILE-CLOSED-88                                       DTSCU810
00655          GO TO P2300-EXIT.                                        DTSCU810
00656                                                                   DTSCU810
00657      EXEC CICS                                                    DTSCU810
00658          DELETE                                                   DTSCU810
00659             DATASET (WRK-FILE-NAME)                               DTSCU810
00660             RESP (WRK-RESP-CD)                                    DTSCU810
00661      END-EXEC.                                                    DTSCU810
00662                                                                   DTSCU810
00663      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00664                         OR DFHRESP (SYSIDERR)                     DTSCU810
00665          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00666          GO TO P2300-EXIT.                                        DTSCU810
00667                                                                   DTSCU810
00668      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00669          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00670                                                                   DTSCU810
00671                                                                   DTSCU810
00672      MOVE LOW-VALUES TO POST-UPDATE-AIX-RECS.                     DTSCU810
00673                                                                   DTSCU810
00674      PERFORM S3300-UPDATE-AIX THRU S3300-EXIT.                    DTSCU810
00675  P2300-EXIT.                                                      DTSCU810
00676      EXIT.                                                        DTSCU810
00677      EJECT                                                        DTSCU810
00678  P2900-PREPARE-FOR-UPDATE.                                        DTSCU810
00679      MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.             DTSCU810
00680                                                                   DTSCU810
00681      MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH.                 DTSCU810
00682                                                                   DTSCU810
00683      EXEC CICS                                                    DTSCU810
00684          READ                                                     DTSCU810
00685              DATASET (WRK-FILE-NAME)                              DTSCU810
00686              INTO (MIO-REC)                                       DTSCU810
00687              LENGTH (MIO-REC-LENGTH)                              DTSCU810
00688              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00689              UPDATE                                               DTSCU810
00690              RESP (WRK-RESP-CD)                                   DTSCU810
00691      END-EXEC.                                                    DTSCU810
00692                                                                   DTSCU810
00693      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00694                         OR DFHRESP (SYSIDERR)                     DTSCU810
00695          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00696          GO TO P2900-EXIT.                                        DTSCU810
00697                                                                   DTSCU810
00698      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU810
00699          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSCU810
00700          GO TO P2900-EXIT.                                        DTSCU810
00701                                                                   DTSCU810
00702      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00703          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00704                                                                   DTSCU810
00705                                                                   DTSCU810
00706      IF MLEN-AIX-YES-88 (REC-TYPE-SUB)                            DTSCU810
00707          PERFORM S2110-IO-TO-WRK THRU S2110-EXIT                  DTSCU810
00708          PERFORM S3100-CONSTRUCT-IPRE THRU S3100-EXIT             DTSCU810
00709      ELSE                                                         DTSCU810
00710          MOVE LOW-VALUES TO PRE-UPDATE-AIX-RECS.                  DTSCU810
00711  P2900-EXIT.                                                      DTSCU810
00712      EXIT.                                                        DTSCU810
00713      EJECT                                                        DTSCU810
00714  P3100-READ-UPDATE.                                               DTSCU810
00715       IF (MSKL-HDR-88 OF MCOMM-REC)                               DTSCU810
00716              OR                                                   DTSCU810
00717          (MSKL-PRF-88 OF MCOMM-REC)                               DTSCU810
00718           NEXT SENTENCE                                           DTSCU810
00719       ELSE                                                        DTSCU810
00720           PERFORM S899-ABEND THRU S899-EXIT.                      DTSCU810
00721                                                                   DTSCU810
00722      MOVE MSKL-KEY-AREA OF MCOMM-REC TO MIO-KEY-AREA.             DTSCU810
00723                                                                   DTSCU810
00724      MOVE MLEN-MAX-MIO-REC-LEN TO MIO-REC-LENGTH.                 DTSCU810
00725                                                                   DTSCU810
00726      EXEC CICS                                                    DTSCU810
00727          READ                                                     DTSCU810
00728              DATASET (WRK-FILE-NAME)                              DTSCU810
00729              INTO (MIO-REC)                                       DTSCU810
00730              LENGTH (MIO-REC-LENGTH)                              DTSCU810
00731              RIDFLD (MIO-KEY-AREA)                                DTSCU810
00732              UPDATE                                               DTSCU810
00733              RESP (WRK-RESP-CD)                                   DTSCU810
00734      END-EXEC.                                                    DTSCU810
00735                                                                   DTSCU810
00736      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00737                         OR DFHRESP (SYSIDERR)                     DTSCU810
00738          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00739          GO TO P3100-EXIT.                                        DTSCU810
00740                                                                   DTSCU810
00741      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU810
00742          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSCU810
00743          GO TO P3100-EXIT.                                        DTSCU810
00744                                                                   DTSCU810
00745      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00746          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00747                                                                   DTSCU810
00748      PERFORM S2100-IO-TO-COMM THRU S2100-EXIT.                    DTSCU810
00749  P3100-EXIT.                                                      DTSCU810
00750      EXIT.                                                        DTSCU810
00751      EJECT                                                        DTSCU810
00752  P3200-REWRITE-UPDATE.                                            DTSCU810
00753      IF (MSKL-HDR-88 OF MCOMM-REC)                                DTSCU810
00754             OR                                                    DTSCU810
00755         (MSKL-PRF-88 OF MCOMM-REC)                                DTSCU810
00756          NEXT SENTENCE                                            DTSCU810
00757      ELSE                                                         DTSCU810
00758          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00759                                                                   DTSCU810
00760      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU810
00761                                                                   DTSCU810
00762      EXEC CICS                                                    DTSCU810
00763          REWRITE                                                  DTSCU810
00764             DATASET (WRK-FILE-NAME)                               DTSCU810
00765             FROM (MIO-REC)                                        DTSCU810
00766             LENGTH (MIO-REC-LENGTH)                               DTSCU810
00767             RESP (WRK-RESP-CD)                                    DTSCU810
00768      END-EXEC.                                                    DTSCU810
00769                                                                   DTSCU810
00770      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU810
00771                         OR DFHRESP (SYSIDERR)                     DTSCU810
00772          PERFORM S1200-FILE-CLOSED THRU S1200-EXIT                DTSCU810
00773          GO TO P3200-EXIT.                                        DTSCU810
00774                                                                   DTSCU810
00775      IF WRK-RESP-CD NOT = DFHRESP (NORMAL)                        DTSCU810
00776          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00777  P3200-EXIT.                                                      DTSCU810
00778      EXIT.                                                        DTSCU810
00779      EJECT                                                        DTSCU810
00780  S1100-NO-REC.                                                    DTSCU810
00781      SET L810-NO-REC-88 TO TRUE.                                  DTSCU810
00782  S1100-EXIT.                                                      DTSCU810
00783      EXIT.                                                        DTSCU810
00784      SKIP3                                                        DTSCU810
00785  S1200-FILE-CLOSED.                                               DTSCU810
00786      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU810
00787                                                                   DTSCU810
00788      MOVE EMSG-NOT-AVAILABLE TO L810-MSG-AREA.                    DTSCU810
00789                                                                   DTSCU810
00790      SET L810-FILE-CLOSED-88 TO TRUE.                             DTSCU810
00791  S1200-EXIT.                                                      DTSCU810
00792      EXIT.                                                        DTSCU810
00793      SKIP3                                                        DTSCU810
00794  S1300-AIX-NOT-AVAILABLE.                                         DTSCU810
00795      MOVE L821-MSG-AREA TO L810-MSG-AREA.                         DTSCU810
00796                                                                   DTSCU810
00797      SET L810-FILE-CLOSED-88 TO TRUE.                             DTSCU810
00798  S1300-EXIT.                                                      DTSCU810
00799      EXIT.                                                        DTSCU810
00800      EJECT                                                        DTSCU810
00801  S2100-IO-TO-COMM.                                                DTSCU810
00802      PERFORM S2110-IO-TO-WRK THRU S2110-EXIT.                     DTSCU810
00803                                                                   DTSCU810
00804      MOVE WRK-REC (1:WRK-REC-LENGTH)                              DTSCU810
00805        TO MCOMM-REC (1:WRK-REC-LENGTH).                           DTSCU810
00806  S2100-EXIT.                                                      DTSCU810
00807      EXIT.                                                        DTSCU810
00808      SKIP3                                                        DTSCU810
00809  S2110-IO-TO-WRK.                                                 DTSCU810
00810      MOVE MIO-KEY-AREA TO MSKL-KEY-AREA OF WRK-REC.               DTSCU810
00811                                                                   DTSCU810
00812      MOVE +0 TO MSKL-PURGE-DATE OF WRK-REC.                       DTSCU810
00813                                                                   DTSCU810
00814      PERFORM S7000-IO-DATA-TO-WRK-DATA THRU S7000-EXIT.           DTSCU810
00815                                                                   DTSCU810
00816      COMPUTE WRK-REC-LENGTH                                       DTSCU810
00817        = MLEN-MSKL-NONDATA-LEN + WRK-DATA-LENGTH.                 DTSCU810
00818  S2110-EXIT.                                                      DTSCU810
00819      EXIT.                                                        DTSCU810
00820      EJECT                                                        DTSCU810
00821  S2200-COMM-TO-IO.                                                DTSCU810
00822      PERFORM S2210-COMM-TO-WRK THRU S2210-EXIT.                   DTSCU810
00823                                                                   DTSCU810
00824      MOVE MSKL-KEY-AREA OF WRK-REC TO MIO-KEY-AREA.               DTSCU810
00825                                                                   DTSCU810
00826      PERFORM S6000-WRK-DATA-TO-IO-DATA THRU S6000-EXIT.           DTSCU810
00827                                                                   DTSCU810
00828      COMPUTE MIO-REC-LENGTH                                       DTSCU810
00829        = MLEN-MIO-NONDATA-LEN + MIO-DATA-LENGTH.                  DTSCU810
00830  S2200-EXIT.                                                      DTSCU810
00831      EXIT.                                                        DTSCU810
00832      SKIP3                                                        DTSCU810
00833  S2210-COMM-TO-WRK.                                               DTSCU810
00834      MOVE MLEN-MSKL-NONDATA-LEN TO WRK-REC-LENGTH.                DTSCU810
00835                                                                   DTSCU810
00836      SET MLEN-IDX TO REC-TYPE-SUB.                                DTSCU810
00837                                                                   DTSCU810
00838      MOVE MLEN-FIX-LEN (MLEN-IDX) TO WRK-DATA-LENGTH.             DTSCU810
00839                                                                   DTSCU810
00840      IF MLEN-OCC-MAX (MLEN-IDX) = +0                              DTSCU810
00841          ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH                    DTSCU810
00842          MOVE MCOMM-REC (1:WRK-REC-LENGTH)                        DTSCU810
00843            TO WRK-REC (1:WRK-REC-LENGTH)                          DTSCU810
00844          GO TO S2210-EXIT.                                        DTSCU810
00845                                                                   DTSCU810
00846      COMPUTE OCC-COUNT-START = WRK-DATA-LENGTH - 1.               DTSCU810
00847                                                                   DTSCU810
00848      MOVE MSKL-DATA-AREA OF MCOMM-REC (OCC-COUNT-START:2)         DTSCU810
00849        TO OCC-COUNT-X.                                            DTSCU810
00850                                                                   DTSCU810
00851      IF (OCC-COUNT < +0)                                          DTSCU810
00852            OR                                                     DTSCU810
00853         (OCC-COUNT > MLEN-OCC-MAX (MLEN-IDX))                     DTSCU810
00854          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00855                                                                   DTSCU810
00856      COMPUTE WRK-DATA-LENGTH = WRK-DATA-LENGTH                    DTSCU810
00857        + (OCC-COUNT * MLEN-VAR-LEN (MLEN-IDX)).                   DTSCU810
00858                                                                   DTSCU810
00859      IF WRK-DATA-LENGTH > MLEN-MAX-MSKL-DATA-LEN                  DTSCU810
00860          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU810
00861                                                                   DTSCU810
00862      ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH.                       DTSCU810
00863                                                                   DTSCU810
00864      MOVE MCOMM-REC (1:WRK-REC-LENGTH)                            DTSCU810
00865        TO WRK-REC (1:WRK-REC-LENGTH).                             DTSCU810
00866  S2210-EXIT.                                                      DTSCU810
00867      EXIT.                                                        DTSCU810
00868      EJECT                                                        DTSCU810
00869  ++INCLUDE DTSIP001                                               DTSCU810
00870      EJECT                                                        DTSCU810
00871  ++INCLUDE DTSIP002                                               DTSCU810
00872      EJECT                                                        DTSCU810
00873  S3300-UPDATE-AIX.                                                DTSCU810
00874      PERFORM S3310-AIX-LOOP THRU S3310-EXIT                       DTSCU810
00875          VARYING AIX-REC-SUB FROM 1 BY 1                          DTSCU810
00876          UNTIL (AIX-REC-SUB > AIX-REC-MAX).                       DTSCU810
00877  S3300-EXIT.                                                      DTSCU810
00878      EXIT.                                                        DTSCU810
00879      SKIP3                                                        DTSCU810
00880  S3310-AIX-LOOP.                                                  DTSCU810
00881      IF PRE-UPDATE-AIX-REC (AIX-REC-SUB)                          DTSCU810
00882        = POST-UPDATE-AIX-REC (AIX-REC-SUB)                        DTSCU810
00883          GO TO S3310-EXIT.                                        DTSCU810
00884                                                                   DTSCU810
00885      IF PRE-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES         DTSCU810
00886          MOVE PRE-UPDATE-AIX-REC (AIX-REC-SUB) TO ISKL-REC        DTSCU810
00887          PERFORM S3311-AIX-DELETE THRU S3311-EXIT                 DTSCU810
00888          IF L810-FILE-CLOSED-88                                   DTSCU810
00889              GO TO S3310-EXIT.                                    DTSCU810
00890                                                                   DTSCU810
00891      IF POST-UPDATE-AIX-REC (AIX-REC-SUB) NOT = LOW-VALUES        DTSCU810
00892          MOVE POST-UPDATE-AIX-REC (AIX-REC-SUB) TO ISKL-REC       DTSCU810
00893          PERFORM S3312-AIX-WRITE THRU S3312-EXIT.                 DTSCU810
00894  S3310-EXIT.                                                      DTSCU810
00895      EXIT.                                                        DTSCU810
00896      SKIP3                                                        DTSCU810
00897  S3311-AIX-DELETE.                                                DTSCU810
00898      PERFORM S821-AIX-READ THRU S821-EXIT.                        DTSCU810
00899                                                                   DTSCU810
00900      IF L821-FILE-CLOSED-88                                       DTSCU810
00901          PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT          DTSCU810
00902          GO TO S3311-EXIT.                                        DTSCU810
00903                                                                   DTSCU810
00904      IF L821-NO-REC-88                                            DTSCU810
00905          GO TO S3311-EXIT.                                        DTSCU810
00906                                                                   DTSCU810
00907      PERFORM S821-AIX-DELETE THRU S821-EXIT.                      DTSCU810
00908                                                                   DTSCU810
00909      IF L821-FILE-CLOSED-88                                       DTSCU810
00910          PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT.         DTSCU810
00911  S3311-EXIT.                                                      DTSCU810
00912      EXIT.                                                        DTSCU810
00913      SKIP3                                                        DTSCU810
00914  S3312-AIX-WRITE.                                                 DTSCU810
00915      PERFORM S821-AIX-READ THRU S821-EXIT.                        DTSCU810
00916                                                                   DTSCU810
00917      IF L821-FILE-CLOSED-88                                       DTSCU810
00918          PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT          DTSCU810
00919          GO TO S3312-EXIT.                                        DTSCU810
00920                                                                   DTSCU810
00921      IF NOT L821-NO-REC-88                                        DTSCU810
00922          GO TO S3312-EXIT.                                        DTSCU810
00923                                                                   DTSCU810
00924      PERFORM S821-AIX-WRITE THRU S821-EXIT.                       DTSCU810
00925                                                                   DTSCU810
00926      IF L821-FILE-CLOSED-88                                       DTSCU810
00927          PERFORM S1300-AIX-NOT-AVAILABLE THRU S1300-EXIT.         DTSCU810
00928  S3312-EXIT.                                                      DTSCU810
00929      EXIT.                                                        DTSCU810
00930      EJECT                                                        DTSCU810
00931  ++INCLUDE DTSIP003                                               DTSCU810
00932      EJECT                                                        DTSCU810
00933  ++INCLUDE DTSIP006                                               DTSCU810
00934      EJECT                                                        DTSCU810
00935  ++INCLUDE DTSIP007                                               DTSCU810
00936      EJECT                                                        DTSCU810
00937  S821-AIX-READ.                                                   DTSCU810
00938      SET L821-READ-88 TO TRUE.                                    DTSCU810
00939      GO TO S821-AIX-IO.                                           DTSCU810
00940                                                                   DTSCU810
00941  S821-AIX-DELETE.                                                 DTSCU810
00942      SET L821-DELETE-88 TO TRUE.                                  DTSCU810
00943      GO TO S821-AIX-IO.                                           DTSCU810
00944                                                                   DTSCU810
00945  S821-AIX-WRITE.                                                  DTSCU810
00946      SET L821-WRITE-88 TO TRUE.                                   DTSCU810
00947      GO TO S821-AIX-IO.                                           DTSCU810
00948                                                                   DTSCU810
00949  S821-AIX-IO.                                                     DTSCU810
00950                                                                   DTSCU810
00951      EXEC CICS                                                    DTSCU810
00952          LINK                                                     DTSCU810
00953              PROGRAM ('DTSCU821')                                 DTSCU810
00954              COMMAREA (L821-COMM-AREA)                            DTSCU810
00955      END-EXEC.                                                    DTSCU810
00956                                                                   DTSCU810
00957  S821-EXIT.                                                       DTSCU810
00958      EXIT.                                                        DTSCU810
00959      SKIP3                                                        DTSCU810
00960  S899-ABEND.                                                      DTSCU810
00961                                                                   DTSCU810
00962      EXEC CICS                                                    DTSCU810
00963          ABEND                                                    DTSCU810
00964              ABCODE (WRK-ABEND-CD)                                DTSCU810
00965      END-EXEC.                                                    DTSCU810
00966                                                                   DTSCU810
00967  S899-EXIT.                                                       DTSCU810
00968      EXIT.                                                        DTSCU810
