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