00001  IDENTIFICATION DIVISION.                                         01/02/06
00002  PROGRAM-ID.             DTSCU372.                                DTSCU372
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV010
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSCU372
00005  DATE-COMPILED.                                                   DTSCU372
00006      SKIP3                                                        DTSCU372
00007 *****                                                             DTSCU372
00008 *                                                                 DTSCU372
00009 *    FUNCTION:  BATCH HEADER RECORD INQUIRY/UPDATE.               DTSCU372
00010 *                                                                 DTSCU372
00011 *                                                                 DTSCU372
00012 *    MODIFICATION LOG:                                            DTSCU372
00013 *                                                                 DTSCU372
00014 *    12/04/91  INITIAL DEVELOPMENT.                               DTSCU372
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU372
00016 *                                                                 DTSCU372
00017 *    05/30/94  MODIFY FOR MONTANA.                                DTSCU372
00018 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU372
00019 *                                                                 DTSCU372
00020 *    05/11/95  AHDR-*-ITEM-CNT  WERE CHANGED TO  AHDR-*-TRAN-CNT. DTSCU372
00021 *              THEY NO LONGER INCLUDE THE CHECKS IN THE COUNTS.   DTSCU372
00022 *              WORK ORDER: CR076                PROGRAMMER: RHC   DTSCU372
00023 *                                                                 DTSCU372
00024 *    12/31/96  ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER    DTSCU372
00025 *              BATCHES.  ONLY USED BY DTSBD140 SO TO SAVE MONEY   DTSCU372
00026 *              THIS PROGRAM WASN'T RECOMPILED.                    DTSCU372
00027 *              WORK ORDER:                      PROGRAMMER: MJA   DTSCU372
00028 *                                                                 DTSCU372
00029 *    11/05/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCU372
00030 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU372
00031 *                                                                 DTSCU372
00032 *    02/08/2002  MODIFIED TO PASS ANNUAL BATCH INDICATOR.         DTSCU372
00033 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSCU372
00034 *                                                                 DTSCU372
00035 *    12/19/2005  RECOMPILED FOR NEW VERSION OF AHDR.              DTSCU372
00036 *                REFERENCE:                     PROGRAMMER: GD    DTSCU372
00037 *                                                                 DTSCU372
00038 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU372
00039 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU372
00040 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU372
00041 *                                                                 DTSCU372
00042 *                                                                 DTSCU372
00043 *  DESCRIPTION:                                                   DTSCU372
00044 *                                                                 DTSCU372
00045 *    DTSCU372 IS PASSED L372-BATCH-NO AND L372-UPDATE-AREA.       DTSCU372
00046 *                                                                 DTSCU372
00047 *    READ THE BATCH HEADER RECORD SPECIFIED BY                    DTSCU372
00048 *    L372-BATCH-NO.                                               DTSCU372
00049 *                                                                 DTSCU372
00050 *    ADD L372-CHNG-* TO AHDR-*.                                   DTSCU372
00051 *                                                                 DTSCU372
00052 *    IF L372-CHNG-ATC-FILE-ITEM-CNT > +0                          DTSCU372
00053 *        ADD L372-CHNG-ATC-FILE-ITEM-CNT TO AHDR-LAST-USED-ITEM-NODTSCU372
00054 *                                                                 DTSCU372
00055 *    MOVE AHDR DATA ELEMENTS TO CORRESPONDING                     DTSCU372
00056 *    L372-RETURN-AREA DATA ELEMENTS.                              DTSCU372
00057 *                                                                 DTSCU372
00058 *    REWRITE THE BATCH HEADER RECORD.                             DTSCU372
00059 *                                                                 DTSCU372
00060 *                                                                 DTSCU372
00061 *****                                                             DTSCU372
00062      SKIP3                                                        DTSCU372
00063  ENVIRONMENT DIVISION.                                            DTSCU372
00064      SKIP3                                                        DTSCU372
00065  DATA DIVISION.                                                   DTSCU372
00066      SKIP3                                                        DTSCU372
00067  WORKING-STORAGE SECTION.                                         DTSCU372
000675 77  PAN-VALET PICTURE X(24) VALUE '010DTSCU372  01/02/06'.       DTSCU372
00068  01  WRK-AREA.                                                    DTSCU372
00069      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U372'.    DTSCU372
00070                                                                   DTSCU372
00071      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU372
00072                                                                   DTSCU372
00073      05  WRK-ITEM-CNT                PIC S9(05)  COMP-3.          DTSCU372
00074      EJECT                                                        DTSCU372
00075  01  L823-COMM-AREA.                                              DTSCU372
00076      05  L823-CONTROL-BLOCK.                                      DTSCU372
00077  ++INCLUDE DTSIL823                                               DTSCU372
00078      SKIP3                                                        DTSCU372
00079      05  ASKL-REC.                                                DTSCU372
00080  ++INCLUDE DTSIASKL                                               DTSCU372
00081      SKIP3                                                        DTSCU372
00082      05  AHDR-REC REDEFINES ASKL-REC.                             DTSCU372
00083  ++INCLUDE DTSIAHDR                                               DTSCU372
00084      EJECT                                                        DTSCU372
00085  01  EMSG-AREA.                                                   DTSCU372
00086  ++INCLUDE DTSICECD                                               DTSCU372
00087      EJECT                                                        DTSCU372
00088  LINKAGE SECTION.                                                 DTSCU372
00089      SKIP3                                                        DTSCU372
00090  01  DFHCOMMAREA.                                                 DTSCU372
00091      EJECT                                                        DTSCU372
00092  ++INCLUDE DTSIL372                                               DTSCU372
00093      EJECT                                                        DTSCU372
00094  PROCEDURE DIVISION.                                              DTSCU372
00095                                                                   DTSCU372
00096                                                                   DTSCU372
00097      SET L372-RESULT-OK TO TRUE.                                  DTSCU372
00098                                                                   DTSCU372
00099      SET L372-BATCH-BALANCED-NO-88 TO TRUE.                       DTSCU372
00100                                                                   DTSCU372
00101      SET L372-BATCH-HELD-NO-88 TO TRUE.                           DTSCU372
00102                                                                   DTSCU372
00103      SET L372-ANNUAL-BATCH-NO-88 TO TRUE.                         DTSCU372
00104                                                                   DTSCU372
00105      MOVE +0 TO L372-LAST-USED-ITEM-NO                            DTSCU372
00106                 L372-ATC-FILE-TRAN-CNT                            DTSCU372
00107                 L372-ATC-FILE-REMIT-AMT                           DTSCU372
00108                 L372-CONTROL-TRAN-CNT                             DTSCU372
00109                 L372-CONTROL-REMIT-AMT.                           DTSCU372
00110                                                                   DTSCU372
00111      MOVE SPACES TO L372-MSG-AREA.                                DTSCU372
00112                                                                   DTSCU372
00113                                                                   DTSCU372
00114      MOVE LOW-VALUES TO AHDR-KEY-AREA.                            DTSCU372
00115                                                                   DTSCU372
00116      MOVE L372-BATCH-NO TO AHDR-BATCH-NO.                         DTSCU372
00117                                                                   DTSCU372
00118      MOVE +0 TO AHDR-ITEM-NO.                                     DTSCU372
00119                                                                   DTSCU372
00120      PERFORM S823-READ THRU S823-EXIT.                            DTSCU372
00121                                                                   DTSCU372
00122      IF L823-OK-88                                                DTSCU372
00123          IF L372-INQUIRE                                          DTSCU372
00124              PERFORM P2000-INQUIRE-HEAD-REC THRU P2000-EXIT       DTSCU372
00125          ELSE                                                     DTSCU372
00126          IF L372-UPDATE                                           DTSCU372
00127              PERFORM P1000-MODIFY-HEAD-REC THRU P1000-EXIT        DTSCU372
00128          ELSE                                                     DTSCU372
00129              GO TO S899-ABEND                                     DTSCU372
00130      ELSE                                                         DTSCU372
00131      IF L823-NO-REC-88                                            DTSCU372
00132         SET L372-REC-NOT-FOUND TO TRUE                            DTSCU372
00133         MOVE EMSG-NO-AHDR-RECORD TO L372-MSG-AREA                 DTSCU372
00134      ELSE                                                         DTSCU372
00135      IF L823-FILE-CLOSED-88                                       DTSCU372
00136         SET L372-FILE-CLOSED TO TRUE                              DTSCU372
00137         MOVE L823-MSG-AREA TO L372-MSG-AREA                       DTSCU372
00138      ELSE                                                         DTSCU372
00139         GO TO S899-ABEND.                                         DTSCU372
00140                                                                   DTSCU372
00141                                                                   DTSCU372
00142      EXEC CICS                                                    DTSCU372
00143          RETURN                                                   DTSCU372
00144      END-EXEC.                                                    DTSCU372
00145                                                                   DTSCU372
00146                                                                   DTSCU372
00147      GOBACK.                                                      DTSCU372
00148      EJECT                                                        DTSCU372
00149  P1000-MODIFY-HEAD-REC.                                           DTSCU372
00150      IF L372-CHNG-LAST-USED-ITEM-NO > AHDR-LAST-USED-ITEM-NO      DTSCU372
00151          MOVE L372-CHNG-LAST-USED-ITEM-NO                         DTSCU372
00152            TO AHDR-LAST-USED-ITEM-NO.                             DTSCU372
00153                                                                   DTSCU372
00154      IF L372-CHNG-INCR-LAST-USED-Y-88                             DTSCU372
00155         COMPUTE WRK-ITEM-CNT = AHDR-LAST-USED-ITEM-NO + 1         DTSCU372
00156         IF WRK-ITEM-CNT > +999                                    DTSCU372
00157             GO TO S899-ABEND                                      DTSCU372
00158         ELSE                                                      DTSCU372
00159             MOVE WRK-ITEM-CNT TO AHDR-LAST-USED-ITEM-NO.          DTSCU372
00160                                                                   DTSCU372
00161      ADD L372-CHNG-ATC-FILE-TRAN-CNT  TO AHDR-ATC-FILE-TRAN-CNT.  DTSCU372
00162                                                                   DTSCU372
00163      ADD L372-CHNG-ATC-FILE-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT. DTSCU372
00164                                                                   DTSCU372
00165                                                                   DTSCU372
00166      IF (AHDR-ATC-FILE-TRAN-CNT = AHDR-CONTROL-TRAN-CNT)          DTSCU372
00167                AND                                                DTSCU372
00168         (AHDR-ATC-FILE-REMIT-AMT = AHDR-CONTROL-REMIT-AMT)        DTSCU372
00169          SET AHDR-BATCH-BALANCED-YES-88 TO TRUE                   DTSCU372
00170      ELSE                                                         DTSCU372
00171          SET AHDR-BATCH-BALANCED-NO-88 TO TRUE.                   DTSCU372
00172                                                                   DTSCU372
00173                                                                   DTSCU372
00174      PERFORM P2000-INQUIRE-HEAD-REC THRU P2000-EXIT.              DTSCU372
00175                                                                   DTSCU372
00176                                                                   DTSCU372
00177      PERFORM S823-REWRITE THRU S823-EXIT.                         DTSCU372
00178                                                                   DTSCU372
00179      IF L823-OK-88                                                DTSCU372
00180          NEXT SENTENCE                                            DTSCU372
00181      ELSE                                                         DTSCU372
00182      IF L823-FILE-CLOSED-88                                       DTSCU372
00183          SET L372-FILE-CLOSED TO TRUE                             DTSCU372
00184          MOVE L823-MSG-AREA TO L372-MSG-AREA                      DTSCU372
00185      ELSE                                                         DTSCU372
00186          GO TO S899-ABEND.                                        DTSCU372
00187                                                                   DTSCU372
00188  P1000-EXIT.                                                      DTSCU372
00189      EXIT.                                                        DTSCU372
00190      EJECT                                                        DTSCU372
00191  P2000-INQUIRE-HEAD-REC.                                          DTSCU372
00192      MOVE AHDR-BATCH-BALANCED-IND TO L372-BATCH-BALANCED-IND.     DTSCU372
00193                                                                   DTSCU372
00194      MOVE AHDR-BATCH-HELD-IND TO L372-BATCH-HELD-IND.             DTSCU372
00195                                                                   DTSCU372
00196      MOVE AHDR-ANNUAL-BATCH-IND TO L372-ANNUAL-BATCH-IND.         DTSCU372
00197                                                                   DTSCU372
00198      MOVE AHDR-LAST-USED-ITEM-NO TO L372-LAST-USED-ITEM-NO.       DTSCU372
00199                                                                   DTSCU372
00200      MOVE AHDR-ATC-FILE-TRAN-CNT TO L372-ATC-FILE-TRAN-CNT.       DTSCU372
00201                                                                   DTSCU372
00202      MOVE AHDR-ATC-FILE-REMIT-AMT TO L372-ATC-FILE-REMIT-AMT.     DTSCU372
00203                                                                   DTSCU372
00204      MOVE AHDR-CONTROL-TRAN-CNT TO L372-CONTROL-TRAN-CNT.         DTSCU372
00205                                                                   DTSCU372
00206      MOVE AHDR-CONTROL-REMIT-AMT TO L372-CONTROL-REMIT-AMT.       DTSCU372
00207  P2000-EXIT.                                                      DTSCU372
00208      EXIT.                                                        DTSCU372
00209      EJECT                                                        DTSCU372
00210  S823-READ.                                                       DTSCU372
00211      SET L823-READ-88 TO TRUE.                                    DTSCU372
00212      GO TO S823-IO.                                               DTSCU372
00213                                                                   DTSCU372
00214 *S823-START-BROWSE.                                               DTSCU372
00215 *****SET L823-START-BROWSE-88 TO TRUE.                            DTSCU372
00216 *****GO TO S823-IO.                                               DTSCU372
00217                                                                   DTSCU372
00218 *S823-READ-NEXT.                                                  DTSCU372
00219 *****SET L823-READ-NEXT-88 TO TRUE.                               DTSCU372
00220 *****GO TO S823-IO.                                               DTSCU372
00221                                                                   DTSCU372
00222 *S823-READ-PREV.                                                  DTSCU372
00223 *****SET L823-READ-PREV-88 TO TRUE.                               DTSCU372
00224 *****GO TO S823-IO.                                               DTSCU372
00225                                                                   DTSCU372
00226 *S823-END-BROWSE.                                                 DTSCU372
00227 *****SET L823-END-BROWSE-88 TO TRUE.                              DTSCU372
00228 *****GO TO S823-IO.                                               DTSCU372
00229                                                                   DTSCU372
00230  S823-REWRITE.                                                    DTSCU372
00231      SET L823-REWRITE-88 TO TRUE.                                 DTSCU372
00232      GO TO S823-IO.                                               DTSCU372
00233                                                                   DTSCU372
00234 *S823-WRITE.                                                      DTSCU372
00235 *****SET L823-WRITE-88 TO TRUE.                                   DTSCU372
00236 *****GO TO S823-IO.                                               DTSCU372
00237                                                                   DTSCU372
00238 *S823-DELETE.                                                     DTSCU372
00239 *****SET L823-DELETE-88 TO TRUE.                                  DTSCU372
00240 *****GO TO S823-IO.                                               DTSCU372
00241                                                                   DTSCU372
00242  S823-IO.                                                         DTSCU372
00243      EXEC CICS                                                    DTSCU372
00244          LINK                                                     DTSCU372
00245              PROGRAM('DTSCU823')                                  DTSCU372
00246              COMMAREA(L823-COMM-AREA)                             DTSCU372
00247      END-EXEC.                                                    DTSCU372
00248  S823-EXIT.                                                       DTSCU372
00249      EXIT.                                                        DTSCU372
00250      EJECT                                                        DTSCU372
00251  S899-ABEND.                                                      DTSCU372
00252      EXEC CICS                                                    DTSCU372
00253          ABEND                                                    DTSCU372
00254              ABCODE (WRK-ABEND-CD)                                DTSCU372
00255      END-EXEC.                                                    DTSCU372
00256  S899-EXIT.                                                       DTSCU372
00257      EXIT.                                                        DTSCU372
