00001  IDENTIFICATION DIVISION.                                         12/14/04
00002  PROGRAM-ID.             DTSCU371.                                DTSCU371
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV009
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSCU371
00005  DATE-COMPILED.                                                   DTSCU371
00006      SKIP3                                                        DTSCU371
00007 *****                                                             DTSCU371
00008 *                                                                 DTSCU371
00009 *    FUNCTION:  ACCOUNTING TRANSACTION FILE RECORD DELETION.      DTSCU371
00010 *                                                                 DTSCU371
00011 *                                                                 DTSCU371
00012 *    MODIFICATION LOG:                                            DTSCU371
00013 *                                                                 DTSCU371
00014 *    12/04/91  INITIAL DEVELOPMENT.                               DTSCU371
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU371
00016 *                                                                 DTSCU371
00017 *    05/31/94  MODIFIED FOR MONTNANA.                             DTSCU371
00018 *              WORK ORDER:                      PROGRAMMER: EHH   DTSCU371
00019 *                                                                 DTSCU371
00020 *    05/11/95  AHDR-*-ITEM-CNT  WERE CHANGED TO  AHDR-*-TRAN-CNT. DTSCU371
00021 *              THEY NO LONGER INCLUDE THE CHECKS IN THE COUNTS.   DTSCU371
00022 *              WORK ORDER: CR076                PROGRAMMER: RHC   DTSCU371
00023 *                                                                 DTSCU371
00024 *    11/05/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCU371
00025 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU371
00026 *                                                                 DTSCU371
00027 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU371
00028 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU371
00029 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU371
00030 *                                                                 DTSCU371
00031 *                                                                 DTSCU371
00032 *  DESCRIPTION:                                                   DTSCU371
00033 *                                                                 DTSCU371
00034 *    DTSCU371 IS PASSED L371-DOC-NO.  DTSCU371 ATTEMPS TO DELETE  DTSCU371
00035 *    THE ACCOUNTING TRANSACTION FILE RECORD SPECIFIED BY          DTSCU371
00036 *    L371-DOC-NO.                                                 DTSCU371
00037 *                                                                 DTSCU371
00038 *    READ THE ACCOUNTING TRANSACTION FILE RECORD                  DTSCU371
00039 *    SPECIFIED BY L371-DOC-NO.                                    DTSCU371
00040 *                                                                 DTSCU371
00041 *    CONSTRUCT DTSIL372.                                          DTSCU371
00042 *                                                                 DTSCU371
00043 *    DELETE THE ACCOUNTING TRANSACTION FILE RECORD.               DTSCU371
00044 *                                                                 DTSCU371
00045 *    LINK TO DTSCU372 TO UPDATE THE BATCH HEADER RECORD.          DTSCU371
00046 *                                                                 DTSCU371
00047 *                                                                 DTSCU371
00048 *****                                                             DTSCU371
00049      SKIP3                                                        DTSCU371
00050  ENVIRONMENT DIVISION.                                            DTSCU371
00051      SKIP3                                                        DTSCU371
00052  DATA DIVISION.                                                   DTSCU371
00053      SKIP3                                                        DTSCU371
00054  WORKING-STORAGE SECTION.                                         DTSCU371
000545 77  PAN-VALET PICTURE X(24) VALUE '009DTSCU371  12/14/04'.       DTSCU371
00055      SKIP3                                                        DTSCU371
00056  01  WRK-AREA.                                                    DTSCU371
00057      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'U371'.    DTSCU371
00058                                                                   DTSCU371
00059      05  WRK-RESP-CD                 PIC S9(08)  COMP.            DTSCU371
00060      EJECT                                                        DTSCU371
00061  01  L372-COMM-AREA.                                              DTSCU371
00062  ++INCLUDE DTSIL372                                               DTSCU371
00063      EJECT                                                        DTSCU371
00064  01  L823-COMM-AREA.                                              DTSCU371
00065      05  L823-CONTROL-BLOCK.                                      DTSCU371
00066  ++INCLUDE DTSIL823                                               DTSCU371
00067      SKIP3                                                        DTSCU371
00068      05  ASKL-REC.                                                DTSCU371
00069  ++INCLUDE DTSIASKL                                               DTSCU371
00070      EJECT                                                        DTSCU371
00071      05  ARPT-REC REDEFINES ASKL-REC.                             DTSCU371
00072  ++INCLUDE DTSIARPT                                               DTSCU371
00073      EJECT                                                        DTSCU371
00074      05  AATX-REC REDEFINES ASKL-REC.                             DTSCU371
00075  ++INCLUDE DTSIAATX                                               DTSCU371
00076      EJECT                                                        DTSCU371
00077      05  APAY-REC REDEFINES ASKL-REC.                             DTSCU371
00078  ++INCLUDE DTSIAPAY                                               DTSCU371
00079      EJECT                                                        DTSCU371
00080      05  AADJ-REC REDEFINES ASKL-REC.                             DTSCU371
00081  ++INCLUDE DTSIAADJ                                               DTSCU371
00082      EJECT                                                        DTSCU371
00083  01  EMSG-AREA.                                                   DTSCU371
00084  ++INCLUDE DTSICECD                                               DTSCU371
00085      EJECT                                                        DTSCU371
00086  LINKAGE SECTION.                                                 DTSCU371
00087      SKIP3                                                        DTSCU371
00088  01  DFHCOMMAREA.                                                 DTSCU371
00089  ++INCLUDE DTSIL371                                               DTSCU371
00090      EJECT                                                        DTSCU371
00091  PROCEDURE DIVISION.                                              DTSCU371
00092                                                                   DTSCU371
00093      MOVE SPACES TO L371-MSG-AREA                                 DTSCU371
00094                     L371-RESULT-IND.                              DTSCU371
00095                                                                   DTSCU371
00096      SET L371-RESULT-OK TO TRUE.                                  DTSCU371
00097                                                                   DTSCU371
00098                                                                   DTSCU371
00099      MOVE LOW-VALUES TO ASKL-KEY-AREA.                            DTSCU371
00100                                                                   DTSCU371
00101      MOVE L371-DOC-NO TO ASKL-DOC-NO.                             DTSCU371
00102                                                                   DTSCU371
00103      PERFORM S823-READ THRU S823-EXIT.                            DTSCU371
00104                                                                   DTSCU371
00105      IF L823-OK-88                                                DTSCU371
00106         PERFORM P1000-PROCESS THRU P1000-EXIT                     DTSCU371
00107      ELSE                                                         DTSCU371
00108      IF L823-NO-REC-88                                            DTSCU371
00109         SET L371-REC-NOT-FOUND TO TRUE                            DTSCU371
00110         MOVE EMSG-NO-RECORD TO L371-MSG-AREA                      DTSCU371
00111      ELSE                                                         DTSCU371
00112      IF L823-FILE-CLOSED-88                                       DTSCU371
00113         SET L371-FILE-CLOSED TO TRUE                              DTSCU371
00114         MOVE L823-MSG-AREA TO L371-MSG-AREA                       DTSCU371
00115      ELSE                                                         DTSCU371
00116         GO TO S899-ABEND.                                         DTSCU371
00117                                                                   DTSCU371
00118                                                                   DTSCU371
00119      EXEC CICS                                                    DTSCU371
00120          RETURN                                                   DTSCU371
00121      END-EXEC.                                                    DTSCU371
00122                                                                   DTSCU371
00123                                                                   DTSCU371
00124      GOBACK.                                                      DTSCU371
00125      EJECT                                                        DTSCU371
00126  P1000-PROCESS.                                                   DTSCU371
00127      PERFORM S823-DELETE THRU S823-EXIT.                          DTSCU371
00128                                                                   DTSCU371
00129      IF L823-FILE-CLOSED-88                                       DTSCU371
00130          SET L371-FILE-CLOSED TO TRUE                             DTSCU371
00131          MOVE L823-MSG-AREA TO L371-MSG-AREA                      DTSCU371
00132          GO TO P1000-EXIT.                                        DTSCU371
00133                                                                   DTSCU371
00134                                                                   DTSCU371
00135      SET L372-UPDATE TO TRUE.                                     DTSCU371
00136                                                                   DTSCU371
00137      MOVE L371-BATCH-NO TO L372-BATCH-NO.                         DTSCU371
00138                                                                   DTSCU371
00139      MOVE -1 TO L372-CHNG-ATC-FILE-TRAN-CNT.                      DTSCU371
00140                                                                   DTSCU371
00141      IF ASKL-RPT-88                                               DTSCU371
00142          COMPUTE L372-CHNG-ATC-FILE-REMIT-AMT                     DTSCU371
00143                    = ARPT-REMIT-AMT * -1                          DTSCU371
00144      ELSE                                                         DTSCU371
00145      IF ASKL-ATX-88                                               DTSCU371
00146          COMPUTE L372-CHNG-ATC-FILE-REMIT-AMT                     DTSCU371
00147                    = AATX-REMIT-AMT * -1                          DTSCU371
00148      ELSE                                                         DTSCU371
00149      IF ASKL-PAY-88                                               DTSCU371
00150          COMPUTE L372-CHNG-ATC-FILE-REMIT-AMT                     DTSCU371
00151                    = APAY-REMIT-AMT * -1                          DTSCU371
00152      ELSE                                                         DTSCU371
00153          MOVE +0 TO L372-CHNG-ATC-FILE-REMIT-AMT.                 DTSCU371
00154                                                                   DTSCU371
00155      MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO.                      DTSCU371
00156                                                                   DTSCU371
00157      SET L372-CHNG-INCR-LAST-USED-N-88 TO TRUE.                   DTSCU371
00158                                                                   DTSCU371
00159      PERFORM S372-HDR-UPDATE THRU S372-EXIT.                      DTSCU371
00160                                                                   DTSCU371
00161      IF L372-REC-NOT-FOUND                                        DTSCU371
00162          MOVE EMSG-NO-AHDR-RECORD TO L371-MSG-AREA                DTSCU371
00163          SET L371-AHDR-NOT-FOUND TO TRUE                          DTSCU371
00164      ELSE                                                         DTSCU371
00165      IF L372-FILE-CLOSED                                          DTSCU371
00166          SET L371-FILE-CLOSED TO TRUE                             DTSCU371
00167          MOVE L372-MSG-AREA TO L371-MSG-AREA                      DTSCU371
00168      ELSE                                                         DTSCU371
00169          NEXT SENTENCE.                                           DTSCU371
00170                                                                   DTSCU371
00171  P1000-EXIT.                                                      DTSCU371
00172      EXIT.                                                        DTSCU371
00173      EJECT                                                        DTSCU371
00174  S372-HDR-UPDATE.                                                 DTSCU371
00175      EXEC CICS                                                    DTSCU371
00176          LINK                                                     DTSCU371
00177              PROGRAM('DTSCU372')                                  DTSCU371
00178              COMMAREA(L372-COMM-AREA)                             DTSCU371
00179      END-EXEC.                                                    DTSCU371
00180  S372-EXIT.                                                       DTSCU371
00181      EXIT.                                                        DTSCU371
00182      SKIP3                                                        DTSCU371
00183  S823-READ.                                                       DTSCU371
00184      SET L823-READ-88 TO TRUE.                                    DTSCU371
00185      GO TO S823-IO.                                               DTSCU371
00186                                                                   DTSCU371
00187 *S823-START-BROWSE.                                               DTSCU371
00188 *****SET L823-START-BROWSE-88 TO TRUE.                            DTSCU371
00189 *****GO TO S823-IO.                                               DTSCU371
00190                                                                   DTSCU371
00191 *S823-READ-NEXT.                                                  DTSCU371
00192 *****SET L823-READ-NEXT-88 TO TRUE.                               DTSCU371
00193 *****GO TO S823-IO.                                               DTSCU371
00194                                                                   DTSCU371
00195 *S823-READ-PREV.                                                  DTSCU371
00196 *****SET L823-READ-PREV-88 TO TRUE.                               DTSCU371
00197 *****GO TO S823-IO.                                               DTSCU371
00198                                                                   DTSCU371
00199 *S823-END-BROWSE.                                                 DTSCU371
00200 *****SET L823-END-BROWSE-88 TO TRUE.                              DTSCU371
00201 *****GO TO S823-IO.                                               DTSCU371
00202                                                                   DTSCU371
00203 *S823-REWRITE.                                                    DTSCU371
00204 *****SET L823-REWRITE-88 TO TRUE.                                 DTSCU371
00205 *****GO TO S823-IO.                                               DTSCU371
00206                                                                   DTSCU371
00207  S823-WRITE.                                                      DTSCU371
00208      SET L823-WRITE-88 TO TRUE.                                   DTSCU371
00209      GO TO S823-IO.                                               DTSCU371
00210                                                                   DTSCU371
00211  S823-DELETE.                                                     DTSCU371
00212      SET L823-DELETE-88 TO TRUE.                                  DTSCU371
00213      GO TO S823-IO.                                               DTSCU371
00214                                                                   DTSCU371
00215  S823-IO.                                                         DTSCU371
00216      EXEC CICS                                                    DTSCU371
00217          LINK                                                     DTSCU371
00218              PROGRAM('DTSCU823')                                  DTSCU371
00219              COMMAREA(L823-COMM-AREA)                             DTSCU371
00220      END-EXEC.                                                    DTSCU371
00221  S823-EXIT.                                                       DTSCU371
00222      EXIT.                                                        DTSCU371
00223      SKIP3                                                        DTSCU371
00224  S899-ABEND.                                                      DTSCU371
00225      EXEC CICS                                                    DTSCU371
00226          ABEND                                                    DTSCU371
00227              ABCODE (WRK-ABEND-CD)                                DTSCU371
00228      END-EXEC.                                                    DTSCU371
00229  S899-EXIT.                                                       DTSCU371
00230      EXIT.                                                        DTSCU371
