00001  IDENTIFICATION DIVISION.                                         11/16/11
00002  PROGRAM-ID.             DTSCU823.                                DTSCU823
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV010
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU823
00005  DATE-COMPILED.                                                   DTSCU823
00006      SKIP3                                                        DTSCU823
00007 *****                                                             DTSCU823
00008 *                                                                 DTSCU823
00009 *    FUNCTION:  ACCOUNTING TRANSACTION FILE INPUT/OUTPUT.         DTSCU823
00010 *                                                                 DTSCU823
00011 *                                                                 DTSCU823
00012 *    MODIFICATION LOG:                                            DTSCU823
00013 *                                                                 DTSCU823
00014 *    11/12/91  INITIAL DEVELOPMENT.                               DTSCU823
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU823
00016 *                                                                 DTSCU823
00017 *    04/12/94  MODIFIED FOR MONTANA.                              DTSCU823
00018 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCU823
00019 *                                                                 DTSCU823
00020 *    01/31/97  ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER    DTSCU823
00021 *              BATCHES.  ONLY USED BY DTSBD140 SO TO SAVE MONEY   DTSCU823
00022 *              THIS PROGRAM WASN'T RECOMPILED.                    DTSCU823
00023 *              WORK ORDER:                      PROGRAMMER: MJA   DTSCU823
00024 *                                                                 DTSCU823
00025 *    12/27/2001  MODIFIED FOR ANNUAL REPORT ACCOUNTING TRANSACTIONDTSCU823
00026 *                WORK ORDER: HOUSEHOLD            PROGRAMMER: GD  DTSCU823
00027 *                                                                 DTSCU823
00028 *    12/19/2005  RECOMPILED FOR NEW VERSION OF AHDR.              DTSCU823
00029 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU823
00030 *                                                                 DTSCU823
00031 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU823
00032 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU823
00033 *                WORK ORDER:                      PROGRAMMER: XXX DTSCU823
00034 *                                                                 DTSCU823
00035 *                                                                 DTSCU823
00036 *    DESCRIPTION:                                                 DTSCU823
00037 *                                                                 DTSCU823
00038 *        DTSCU823 PERFORMS ALL REQUIRED ACCOUNTING TRANSACTION    DTSCU823
00039 *        FILE INPUT/OUTPUT.  DTSCU823'S COMMAREA CONSISTS OF      DTSCU823
00040 *        DTSIL823, FOLLOWED BY DTSIASKL. SEE DFHCOMMAREA          DTSCU823
00041 *        OF THIS MODULE FOR AN EXAMPLE.                           DTSCU823
00042 *                                                                 DTSCU823
00043 *                                                                 DTSCU823
00044 *    GENERAL SPECIFICATIONS:                                      DTSCU823
00045 *                                                                 DTSCU823
00046 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSCU823
00047 *        MODULE.                                                  DTSCU823
00048 *                                                                 DTSCU823
00049 *        IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN      DTSCU823
00050 *        NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED,           DTSCU823
00051 *        THEN ABEND THE MODULE (TOLERATE INVREQ FROM A            DTSCU823
00052 *        ENDBR).                                                  DTSCU823
00053 *                                                                 DTSCU823
00054 *        SPECIFY AIO-REC AS THE INTO OR FROM AREA OF THE CICS     DTSCU823
00055 *        FILE COMMAND.                                            DTSCU823
00056 *                                                                 DTSCU823
00057 *        SPECIFY ASKL-KEY OF AIO-REC AS THE RIDFLD OF THE CICS    DTSCU823
00058 *        FILE COMMANDS.                                           DTSCU823
00059 *                                                                 DTSCU823
00060 *        WHEN MOVING DATA FROM DFHCOMMAREA RECORDS TO AIO-REC     DTSCU823
00061 *        (PRIOR TO A WRITE OR REWRITE), REFER TO AHDR-REC,        DTSCU823
00062 *        ARPT-REC, ETC (NOT ACOMM-REC).  IF AN UNKNOWN REC-TYPE   DTSCU823
00063 *        IS ENCOUNTERED, THEN ABEND THE MODULE.                   DTSCU823
00064 *                                                                 DTSCU823
00065 *        WHEN MOVING DATA FROM AIO-REC TO DFHCOMMAREA (AFTER      DTSCU823
00066 *        A SUCCESSFUL READ, READ UPDATE, STARTBR, READNEXT,       DTSCU823
00067 *        OR READPREV) REFER TO AHDR-REC, ARPT-REC, ETC (NOT       DTSCU823
00068 *        ACOMM-REC).  IF AN UNKNOWN REC-TYPE IS ENCOUNTERED,      DTSCU823
00069 *        THEN ABEND THE MODULE.                                   DTSCU823
00070 *                                                                 DTSCU823
00071 *                                                                 DTSCU823
00072 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSCU823
00073 *                                                                 DTSCU823
00074 *    READ                                                         DTSCU823
00075 *                                                                 DTSCU823
00076 *    STARTBR                                                      DTSCU823
00077 *                                                                 DTSCU823
00078 *        PERFORM A STARTBR.  IF THE STARTBR IS                    DTSCU823
00079 *        SUCCESSFUL, THEN PERFORM A READNEXT.  IF THE             DTSCU823
00080 *        READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN        DTSCU823
00081 *        L823-NO-REC-88.                                          DTSCU823
00082 *                                                                 DTSCU823
00083 *        IF THE READNEXT RETURNS A L823-NO-REC-88, THEN           DTSCU823
00084 *        ISSUE AN ENDBR.                                          DTSCU823
00085 *                                                                 DTSCU823
00086 *    READNEXT                                                     DTSCU823
00087 *        PRIOR TO THE READNEXT, MOVE ASKL-KEY-AREA OF             DTSCU823
00088 *        ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC.  IF THE           DTSCU823
00089 *        READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN        DTSCU823
00090 *        L823-NO-REC-88.                                          DTSCU823
00091 *                                                                 DTSCU823
00092 *        IF THE READNEXT RETURN A L823-NO-REC-88, THEN            DTSCU823
00093 *        ISSUE AN ENDBR.                                          DTSCU823
00094 *                                                                 DTSCU823
00095 *    READPREV                                                     DTSCU823
00096 *        PRIOR TO THE READPREV, MOVE ASKL-KEY-AREA OF             DTSCU823
00097 *        ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC.  IF THE           DTSCU823
00098 *        READPREV YIELDS AN ENDFILE CONDITION, THEN RETURN        DTSCU823
00099 *        L823-NO-REC-88.                                          DTSCU823
00100 *                                                                 DTSCU823
00101 *        IF THE READPREV RETURN A L823-NO-REC-88, THEN            DTSCU823
00102 *        ISSUE AN ENDBR.                                          DTSCU823
00103 *                                                                 DTSCU823
00104 *    ENDBR                                                        DTSCU823
00105 *        TOLERATE THE INVREQ CONDITION.                           DTSCU823
00106 *                                                                 DTSCU823
00107 *    WRITE                                                        DTSCU823
00108 *                                                                 DTSCU823
00109 *    REWRITE                                                      DTSCU823
00110 *                                                                 DTSCU823
00111 *    DELETE                                                       DTSCU823
00112 *        READ (UPDATE) THE RECORD TO BE DELETED.  IF RECORD NOT   DTSCU823
00113 *        FOUND, ABEND THE MODULE.                                 DTSCU823
00114 *                                                                 DTSCU823
00115 *        DELETE.                                                  DTSCU823
00116 *                                                                 DTSCU823
00117 *****                                                             DTSCU823
00118      SKIP3                                                        DTSCU823
00119  ENVIRONMENT DIVISION.                                            DTSCU823
00120      SKIP3                                                        DTSCU823
00121  DATA DIVISION.                                                   DTSCU823
00122      SKIP3                                                        DTSCU823
00123  WORKING-STORAGE SECTION.                                         DTSCU823
001235 77  PAN-VALET PICTURE X(24) VALUE '010DTSCU823  11/16/11'.       DTSCU823
00124      SKIP3                                                        DTSCU823
00125  01  WRK-AREA.                                                    DTSCU823
00126      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U823'.    DTSCU823
00127      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU823
00128                                                                   DTSCU823
00129      05  WRK-PROD-FILE-NAME          PIC  X(08)  VALUE 'DTSFATC'. DTSCU823
00130                                                                   DTSCU823
00131      05  EMSG-NOT-AVAILABLE.                                      DTSCU823
00132          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU823
00133          10  FILLER                  PIC  X(06)  VALUE 'FILE  '.  DTSCU823
00134          10  EMSG-FILE-NAME          PIC  X(08).                  DTSCU823
00135          10  FILLER                  PIC  X(33)                   DTSCU823
00136        VALUE '  NOT AVAILABLE  PLEASE TRY LATER'.                 DTSCU823
00137      SKIP3                                                        DTSCU823
00138 *****05  WRK-CICS-APPLID             PIC  X(08).                  DTSCU823
00139                                                                   DTSCU823
00140 *****05  WRK-CICS-OP-ID              PIC  X(08).                  DTSCU823
00141 *********88  WRK-TCL-OP-ID-88          VALUE 'CE0756'             DTSCU823
00142 *********************************************'CE3568'             DTSCU823
00143 *********************************************'C84986'.            DTSCU823
00144                                                                   DTSCU823
00145      05  WRK-FILE-NAME               PIC  X(08).                  DTSCU823
00146                                                                   DTSCU823
00147      05  WRK-REC-LENGTH              PIC S9(04)  COMP.            DTSCU823
00148      EJECT                                                        DTSCU823
00149  01  ALEN-LITERALS.                                               DTSCU823
00150  ++INCLUDE DTSIALEN                                               DTSCU823
00151      EJECT                                                        DTSCU823
00152  01  AIO-REC.                                                     DTSCU823
00153  ++INCLUDE DTSIASKL                                               DTSCU823
00154      EJECT                                                        DTSCU823
00155  LINKAGE SECTION.                                                 DTSCU823
00156      SKIP3                                                        DTSCU823
00157  01  DFHCOMMAREA.                                                 DTSCU823
00158      05  L823-CONTROL-BLOCK.                                      DTSCU823
00159  ++INCLUDE DTSIL823                                               DTSCU823
00160      SKIP3                                                        DTSCU823
00161      05  ACOMM-REC.                                               DTSCU823
00162  ++INCLUDE DTSIASKL                                               DTSCU823
00163      SKIP3                                                        DTSCU823
00164      05  AHDR-REC REDEFINES ACOMM-REC.                            DTSCU823
00165  ++INCLUDE DTSIAHDR                                               DTSCU823
00166      SKIP3                                                        DTSCU823
00167      05  ARPT-REC REDEFINES ACOMM-REC.                            DTSCU823
00168  ++INCLUDE DTSIARPT                                               DTSCU823
00169      SKIP3                                                        DTSCU823
00170      05  APAY-REC REDEFINES ACOMM-REC.                            DTSCU823
00171  ++INCLUDE DTSIAPAY                                               DTSCU823
00172      SKIP3                                                        DTSCU823
00173      05  AADJ-REC REDEFINES ACOMM-REC.                            DTSCU823
00174  ++INCLUDE DTSIAADJ                                               DTSCU823
00175      EJECT                                                        DTSCU823
00176      05  AATX-REC REDEFINES ACOMM-REC.                            DTSCU823
00177  ++INCLUDE DTSIAATX                                               DTSCU823
00178      EJECT                                                        DTSCU823
00179  PROCEDURE DIVISION.                                              DTSCU823
00180                                                                   DTSCU823
00181 *****EXEC CICS                                                    DTSCU823
00182 *****    ASSIGN                                                   DTSCU823
00183 *****       APPLID (WRK-CICS-APPLID)                              DTSCU823
00184 *****END-EXEC.                                                    DTSCU823
00185 *****                                                             DTSCU823
00186 *****IF WRK-CICS-APPLID = 'CICSAORT'                              DTSCU823
00187 *****   EXEC CICS                                                 DTSCU823
00188 *****       ASSIGN                                                DTSCU823
00189 *****          USERID (WRK-CICS-OP-ID)                            DTSCU823
00190 *****   END-EXEC                                                  DTSCU823
00191 *****                                                             DTSCU823
00192 *****   IF WRK-TCL-OP-ID-88                                       DTSCU823
00193 *****      MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME                DTSCU823
00194 *****   ELSE                                                      DTSCU823
00195 *****      MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME               DTSCU823
00196 *****ELSE                                                         DTSCU823
00197         MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME.                 DTSCU823
00198                                                                   DTSCU823
00199                                                                   DTSCU823
00200      MOVE SPACES TO L823-MSG-AREA.                                DTSCU823
00201                                                                   DTSCU823
00202      SET L823-OK-88 TO TRUE.                                      DTSCU823
00203                                                                   DTSCU823
00204      IF L823-READ-NEXT-88                                         DTSCU823
00205          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU823
00206      ELSE                                                         DTSCU823
00207      IF L823-READ-88                                              DTSCU823
00208          PERFORM P1100-READ THRU P1100-EXIT                       DTSCU823
00209      ELSE                                                         DTSCU823
00210      IF L823-START-BROWSE-88                                      DTSCU823
00211          PERFORM P2100-START-BROWSE THRU P2100-EXIT               DTSCU823
00212      ELSE                                                         DTSCU823
00213      IF L823-END-BROWSE-88                                        DTSCU823
00214          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU823
00215      ELSE                                                         DTSCU823
00216      IF L823-READ-PREV-88                                         DTSCU823
00217          PERFORM P2300-READ-PREV THRU P2300-EXIT                  DTSCU823
00218      ELSE                                                         DTSCU823
00219      IF L823-WRITE-88                                             DTSCU823
00220          PERFORM P3100-WRITE THRU P3100-EXIT                      DTSCU823
00221      ELSE                                                         DTSCU823
00222      IF L823-REWRITE-88                                           DTSCU823
00223          PERFORM P3200-REWRITE THRU P3200-EXIT                    DTSCU823
00224      ELSE                                                         DTSCU823
00225      IF L823-DELETE-88                                            DTSCU823
00226          PERFORM P3300-DELETE THRU P3300-EXIT                     DTSCU823
00227      ELSE                                                         DTSCU823
00228          GO TO S899-ABEND.                                        DTSCU823
00229                                                                   DTSCU823
00230                                                                   DTSCU823
00231      EXEC CICS                                                    DTSCU823
00232          RETURN                                                   DTSCU823
00233      END-EXEC.                                                    DTSCU823
00234                                                                   DTSCU823
00235                                                                   DTSCU823
00236      GOBACK.                                                      DTSCU823
00237      EJECT                                                        DTSCU823
00238  P1100-READ.                                                      DTSCU823
00239      MOVE LOW-VALUE TO AIO-REC.                                   DTSCU823
00240                                                                   DTSCU823
00241      MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
00242                                                                   DTSCU823
00243      MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU823
00244                                                                   DTSCU823
00245      EXEC CICS                                                    DTSCU823
00246          READ                                                     DTSCU823
00247              DATASET (WRK-FILE-NAME)                              DTSCU823
00248              INTO (AIO-REC)                                       DTSCU823
00249              LENGTH (WRK-REC-LENGTH)                              DTSCU823
00250              RIDFLD (ASKL-KEY-AREA OF AIO-REC)                    DTSCU823
00251              RESP (WRK-RESP-CD)                                   DTSCU823
00252      END-EXEC.                                                    DTSCU823
00253                                                                   DTSCU823
00254      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU823
00255                         OR DFHRESP (SYSIDERR)                     DTSCU823
00256          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00257          GO TO P1100-EXIT.                                        DTSCU823
00258                                                                   DTSCU823
00259      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU823
00260          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU823
00261          GO TO P1100-EXIT.                                        DTSCU823
00262                                                                   DTSCU823
00263      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00264          PERFORM S2100-IO-TO-COMM THRU S2100-EXIT                 DTSCU823
00265      ELSE                                                         DTSCU823
00266          GO TO S899-ABEND.                                        DTSCU823
00267  P1100-EXIT.                                                      DTSCU823
00268      EXIT.                                                        DTSCU823
00269      EJECT                                                        DTSCU823
00270  P2100-START-BROWSE.                                              DTSCU823
00271      MOVE LOW-VALUE TO AIO-REC.                                   DTSCU823
00272                                                                   DTSCU823
00273      MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
00274                                                                   DTSCU823
00275      EXEC CICS                                                    DTSCU823
00276          STARTBR                                                  DTSCU823
00277              DATASET (WRK-FILE-NAME)                              DTSCU823
00278              RIDFLD (ASKL-KEY-AREA OF AIO-REC)                    DTSCU823
00279              RESP (WRK-RESP-CD)                                   DTSCU823
00280      END-EXEC.                                                    DTSCU823
00281                                                                   DTSCU823
00282      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU823
00283                         OR DFHRESP (SYSIDERR)                     DTSCU823
00284          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00285          GO TO P2100-EXIT.                                        DTSCU823
00286                                                                   DTSCU823
00287      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU823
00288          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU823
00289          GO TO P2100-EXIT.                                        DTSCU823
00290                                                                   DTSCU823
00291      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00292          PERFORM P2200-READ-NEXT THRU P2200-EXIT                  DTSCU823
00293      ELSE                                                         DTSCU823
00294          GO TO S899-ABEND.                                        DTSCU823
00295  P2100-EXIT.                                                      DTSCU823
00296      EXIT.                                                        DTSCU823
00297      EJECT                                                        DTSCU823
00298  P2200-READ-NEXT.                                                 DTSCU823
00299      IF L823-READ-NEXT-88                                         DTSCU823
00300          MOVE LOW-VALUE TO AIO-REC                                DTSCU823
00301          MOVE ASKL-KEY-AREA OF ACOMM-REC                          DTSCU823
00302            TO ASKL-KEY-AREA OF AIO-REC.                           DTSCU823
00303                                                                   DTSCU823
00304      MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU823
00305                                                                   DTSCU823
00306      EXEC CICS                                                    DTSCU823
00307          READNEXT                                                 DTSCU823
00308              DATASET (WRK-FILE-NAME)                              DTSCU823
00309              INTO (AIO-REC)                                       DTSCU823
00310              LENGTH (WRK-REC-LENGTH)                              DTSCU823
00311              RIDFLD (ASKL-KEY-AREA OF AIO-REC)                    DTSCU823
00312              RESP (WRK-RESP-CD)                                   DTSCU823
00313      END-EXEC.                                                    DTSCU823
00314                                                                   DTSCU823
00315      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU823
00316                         OR DFHRESP (SYSIDERR)                     DTSCU823
00317          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00318          GO TO P2200-EXIT.                                        DTSCU823
00319                                                                   DTSCU823
00320      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU823
00321          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU823
00322          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU823
00323          GO TO P2200-EXIT.                                        DTSCU823
00324                                                                   DTSCU823
00325      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00326          NEXT SENTENCE                                            DTSCU823
00327      ELSE                                                         DTSCU823
00328          GO TO S899-ABEND.                                        DTSCU823
00329                                                                   DTSCU823
00330      PERFORM S2100-IO-TO-COMM THRU S2100-EXIT.                    DTSCU823
00331  P2200-EXIT.                                                      DTSCU823
00332      EXIT.                                                        DTSCU823
00333      EJECT                                                        DTSCU823
00334  P2300-READ-PREV.                                                 DTSCU823
00335      MOVE LOW-VALUE TO AIO-REC.                                   DTSCU823
00336                                                                   DTSCU823
00337      MOVE ASKL-KEY-AREA OF ACOMM-REC                              DTSCU823
00338        TO ASKL-KEY-AREA OF AIO-REC.                               DTSCU823
00339                                                                   DTSCU823
00340      MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU823
00341                                                                   DTSCU823
00342      EXEC CICS                                                    DTSCU823
00343          READPREV                                                 DTSCU823
00344              DATASET (WRK-FILE-NAME)                              DTSCU823
00345              INTO (AIO-REC)                                       DTSCU823
00346              LENGTH (WRK-REC-LENGTH)                              DTSCU823
00347              RIDFLD (ASKL-KEY-AREA OF AIO-REC)                    DTSCU823
00348              RESP (WRK-RESP-CD)                                   DTSCU823
00349      END-EXEC.                                                    DTSCU823
00350                                                                   DTSCU823
00351      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU823
00352                         OR DFHRESP (SYSIDERR)                     DTSCU823
00353          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00354          GO TO P2300-EXIT.                                        DTSCU823
00355                                                                   DTSCU823
00356      IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE)       DTSCU823
00357          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU823
00358          PERFORM P2400-END-BROWSE THRU P2400-EXIT                 DTSCU823
00359          GO TO P2300-EXIT.                                        DTSCU823
00360                                                                   DTSCU823
00361      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00362          NEXT SENTENCE                                            DTSCU823
00363      ELSE                                                         DTSCU823
00364          GO TO S899-ABEND.                                        DTSCU823
00365                                                                   DTSCU823
00366      PERFORM S2100-IO-TO-COMM THRU S2100-EXIT.                    DTSCU823
00367  P2300-EXIT.                                                      DTSCU823
00368      EXIT.                                                        DTSCU823
00369      EJECT                                                        DTSCU823
00370  P2400-END-BROWSE.                                                DTSCU823
00371                                                                   DTSCU823
00372      EXEC CICS                                                    DTSCU823
00373          ENDBR                                                    DTSCU823
00374              DATASET (WRK-FILE-NAME)                              DTSCU823
00375              RESP (WRK-RESP-CD)                                   DTSCU823
00376      END-EXEC.                                                    DTSCU823
00377                                                                   DTSCU823
00378      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU823
00379                         OR DFHRESP (SYSIDERR)                     DTSCU823
00380          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00381          GO TO P2400-EXIT.                                        DTSCU823
00382                                                                   DTSCU823
00383      IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ)        DTSCU823
00384          NEXT SENTENCE                                            DTSCU823
00385      ELSE                                                         DTSCU823
00386          GO TO S899-ABEND.                                        DTSCU823
00387  P2400-EXIT.                                                      DTSCU823
00388      EXIT.                                                        DTSCU823
00389      EJECT                                                        DTSCU823
00390  P3100-WRITE.                                                     DTSCU823
00391      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU823
00392                                                                   DTSCU823
00393      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU823
00394                                                                   DTSCU823
00395      EXEC CICS                                                    DTSCU823
00396          WRITE                                                    DTSCU823
00397              DATASET (WRK-FILE-NAME)                              DTSCU823
00398              FROM (AIO-REC)                                       DTSCU823
00399              LENGTH (WRK-REC-LENGTH)                              DTSCU823
00400              RIDFLD (ASKL-KEY-AREA OF AIO-REC)                    DTSCU823
00401              RESP (WRK-RESP-CD)                                   DTSCU823
00402      END-EXEC.                                                    DTSCU823
00403                                                                   DTSCU823
00404      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU823
00405                         OR DFHRESP (SYSIDERR)                     DTSCU823
00406          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00407          GO TO P3100-EXIT.                                        DTSCU823
00408                                                                   DTSCU823
00409      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00410          NEXT SENTENCE                                            DTSCU823
00411      ELSE                                                         DTSCU823
00412          GO TO S899-ABEND.                                        DTSCU823
00413  P3100-EXIT.                                                      DTSCU823
00414      EXIT.                                                        DTSCU823
00415      EJECT                                                        DTSCU823
00416  P3200-REWRITE.                                                   DTSCU823
00417      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU823
00418                                                                   DTSCU823
00419      IF L823-NO-REC-88                                            DTSCU823
00420          GO TO S899-ABEND                                         DTSCU823
00421      ELSE                                                         DTSCU823
00422      IF L823-FILE-CLOSED-88                                       DTSCU823
00423          GO TO P3200-EXIT.                                        DTSCU823
00424                                                                   DTSCU823
00425      PERFORM S2200-COMM-TO-IO THRU S2200-EXIT.                    DTSCU823
00426                                                                   DTSCU823
00427      PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT.              DTSCU823
00428                                                                   DTSCU823
00429      EXEC CICS                                                    DTSCU823
00430          REWRITE                                                  DTSCU823
00431              DATASET (WRK-FILE-NAME)                              DTSCU823
00432              FROM (AIO-REC)                                       DTSCU823
00433              LENGTH (WRK-REC-LENGTH)                              DTSCU823
00434              RESP (WRK-RESP-CD)                                   DTSCU823
00435      END-EXEC.                                                    DTSCU823
00436                                                                   DTSCU823
00437      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU823
00438                         OR DFHRESP (SYSIDERR)                     DTSCU823
00439          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00440          GO TO P3200-EXIT.                                        DTSCU823
00441                                                                   DTSCU823
00442      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00443          NEXT SENTENCE                                            DTSCU823
00444      ELSE                                                         DTSCU823
00445          GO TO S899-ABEND.                                        DTSCU823
00446  P3200-EXIT.                                                      DTSCU823
00447      EXIT.                                                        DTSCU823
00448      EJECT                                                        DTSCU823
00449  P3300-DELETE.                                                    DTSCU823
00450      PERFORM S3100-READ-UPDATE THRU S3100-EXIT.                   DTSCU823
00451                                                                   DTSCU823
00452      IF L823-NO-REC-88                                            DTSCU823
00453          GO TO S899-ABEND                                         DTSCU823
00454      ELSE                                                         DTSCU823
00455      IF L823-FILE-CLOSED-88                                       DTSCU823
00456          GO TO P3300-EXIT.                                        DTSCU823
00457                                                                   DTSCU823
00458      EXEC CICS                                                    DTSCU823
00459          DELETE                                                   DTSCU823
00460              DATASET (WRK-FILE-NAME)                              DTSCU823
00461              RESP (WRK-RESP-CD)                                   DTSCU823
00462      END-EXEC.                                                    DTSCU823
00463                                                                   DTSCU823
00464      IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN)     DTSCU823
00465                         OR DFHRESP (SYSIDERR)                     DTSCU823
00466          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00467          GO TO P3300-EXIT.                                        DTSCU823
00468                                                                   DTSCU823
00469      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00470          NEXT SENTENCE                                            DTSCU823
00471      ELSE                                                         DTSCU823
00472          GO TO S899-ABEND.                                        DTSCU823
00473  P3300-EXIT.                                                      DTSCU823
00474      EXIT.                                                        DTSCU823
00475      EJECT                                                        DTSCU823
00476  S1100-NOT-AVAILABLE.                                             DTSCU823
00477      MOVE WRK-FILE-NAME TO EMSG-FILE-NAME.                        DTSCU823
00478                                                                   DTSCU823
00479      MOVE EMSG-NOT-AVAILABLE TO L823-MSG-AREA.                    DTSCU823
00480                                                                   DTSCU823
00481      SET L823-FILE-CLOSED-88 TO TRUE.                             DTSCU823
00482  S1100-EXIT.                                                      DTSCU823
00483      EXIT.                                                        DTSCU823
00484      SKIP3                                                        DTSCU823
00485  S1200-NOT-FOUND.                                                 DTSCU823
00486      SET L823-NO-REC-88 TO TRUE.                                  DTSCU823
00487  S1200-EXIT.                                                      DTSCU823
00488      EXIT.                                                        DTSCU823
00489      EJECT                                                        DTSCU823
00490  S2100-IO-TO-COMM.                                                DTSCU823
00491      IF ASKL-ADJ-88 OF AIO-REC                                    DTSCU823
00492         MOVE AIO-REC TO AADJ-REC                                  DTSCU823
00493      ELSE                                                         DTSCU823
00494      IF ASKL-HDR-88 OF AIO-REC                                    DTSCU823
00495         MOVE AIO-REC TO AHDR-REC                                  DTSCU823
00496      ELSE                                                         DTSCU823
00497      IF ASKL-PAY-88 OF AIO-REC                                    DTSCU823
00498         MOVE AIO-REC TO APAY-REC                                  DTSCU823
00499      ELSE                                                         DTSCU823
00500      IF ASKL-RPT-88 OF AIO-REC                                    DTSCU823
00501         MOVE AIO-REC TO ARPT-REC                                  DTSCU823
00502      ELSE                                                         DTSCU823
00503      IF ASKL-ATX-88 OF AIO-REC                                    DTSCU823
00504         MOVE AIO-REC TO AATX-REC                                  DTSCU823
00505      ELSE                                                         DTSCU823
00506         GO TO S899-ABEND.                                         DTSCU823
00507      SKIP3                                                        DTSCU823
00508  S2100-EXIT.                                                      DTSCU823
00509      EXIT.                                                        DTSCU823
00510      EJECT                                                        DTSCU823
00511  S2200-COMM-TO-IO.                                                DTSCU823
00512      IF ASKL-ADJ-88 OF ACOMM-REC                                  DTSCU823
00513         MOVE AADJ-REC TO AIO-REC                                  DTSCU823
00514      ELSE                                                         DTSCU823
00515      IF ASKL-HDR-88 OF ACOMM-REC                                  DTSCU823
00516         MOVE AHDR-REC TO AIO-REC                                  DTSCU823
00517      ELSE                                                         DTSCU823
00518      IF ASKL-PAY-88 OF ACOMM-REC                                  DTSCU823
00519         MOVE APAY-REC TO AIO-REC                                  DTSCU823
00520      ELSE                                                         DTSCU823
00521      IF ASKL-RPT-88 OF ACOMM-REC                                  DTSCU823
00522         MOVE ARPT-REC TO AIO-REC                                  DTSCU823
00523      ELSE                                                         DTSCU823
00524      IF ASKL-ATX-88 OF ACOMM-REC                                  DTSCU823
00525         MOVE AATX-REC TO AIO-REC                                  DTSCU823
00526      ELSE                                                         DTSCU823
00527         GO TO S899-ABEND.                                         DTSCU823
00528      SKIP3                                                        DTSCU823
00529  S2200-EXIT.                                                      DTSCU823
00530      EXIT.                                                        DTSCU823
00531      EJECT                                                        DTSCU823
00532  S2300-CALCULATE-LENGTH.                                          DTSCU823
00533      IF ASKL-ADJ-88 OF ACOMM-REC                                  DTSCU823
00534         MOVE ALEN-ADJ-LENGTH TO WRK-REC-LENGTH                    DTSCU823
00535      ELSE                                                         DTSCU823
00536      IF ASKL-HDR-88 OF ACOMM-REC                                  DTSCU823
00537         MOVE ALEN-HDR-LENGTH TO WRK-REC-LENGTH                    DTSCU823
00538      ELSE                                                         DTSCU823
00539      IF ASKL-PAY-88 OF ACOMM-REC                                  DTSCU823
00540         MOVE ALEN-PAY-LENGTH TO WRK-REC-LENGTH                    DTSCU823
00541      ELSE                                                         DTSCU823
00542      IF ASKL-RPT-88 OF ACOMM-REC                                  DTSCU823
00543         MOVE ALEN-RPT-LENGTH TO WRK-REC-LENGTH                    DTSCU823
00544      ELSE                                                         DTSCU823
00545      IF ASKL-ATX-88 OF ACOMM-REC                                  DTSCU823
00546         MOVE ALEN-ATX-LENGTH TO WRK-REC-LENGTH                    DTSCU823
00547      ELSE                                                         DTSCU823
00548         GO TO S899-ABEND.                                         DTSCU823
00549  S2300-EXIT.                                                      DTSCU823
00550      EXIT.                                                        DTSCU823
00551      EJECT                                                        DTSCU823
00552  S3100-READ-UPDATE.                                               DTSCU823
00553      MOVE LOW-VALUE TO AIO-REC.                                   DTSCU823
00554                                                                   DTSCU823
00555      MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
00556                                                                   DTSCU823
00557      MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH.                      DTSCU823
00558                                                                   DTSCU823
00559      EXEC CICS                                                    DTSCU823
00560          READ                                                     DTSCU823
00561              DATASET (WRK-FILE-NAME)                              DTSCU823
00562              INTO (AIO-REC)                                       DTSCU823
00563              LENGTH (WRK-REC-LENGTH)                              DTSCU823
00564              RIDFLD (ASKL-KEY-AREA OF AIO-REC)                    DTSCU823
00565              UPDATE                                               DTSCU823
00566              RESP (WRK-RESP-CD)                                   DTSCU823
00567      END-EXEC.                                                    DTSCU823
00568                                                                   DTSCU823
00569      IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED)     DTSCU823
00570                         OR DFHRESP (SYSIDERR)                     DTSCU823
00571          PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT              DTSCU823
00572          GO TO S3100-EXIT.                                        DTSCU823
00573                                                                   DTSCU823
00574      IF WRK-RESP-CD = DFHRESP (NOTFND)                            DTSCU823
00575          PERFORM S1200-NOT-FOUND THRU S1200-EXIT                  DTSCU823
00576          GO TO S3100-EXIT.                                        DTSCU823
00577                                                                   DTSCU823
00578      IF WRK-RESP-CD = DFHRESP (NORMAL)                            DTSCU823
00579          NEXT SENTENCE                                            DTSCU823
00580      ELSE                                                         DTSCU823
00581          GO TO S899-ABEND.                                        DTSCU823
00582  S3100-EXIT.                                                      DTSCU823
00583      EXIT.                                                        DTSCU823
00584      EJECT                                                        DTSCU823
00585  S899-ABEND.                                                      DTSCU823
00586      EXEC CICS                                                    DTSCU823
00587          ABEND                                                    DTSCU823
00588              ABCODE (WRK-ABEND-CD)                                DTSCU823
00589      END-EXEC.                                                    DTSCU823
00590  S899-EXIT.                                                       DTSCU823
00591      EXIT.                                                        DTSCU823
