232 lines
18 KiB
COBOL
232 lines
18 KiB
COBOL
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
|