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