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