259 lines
20 KiB
COBOL
259 lines
20 KiB
COBOL
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
|