DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
258
CICS/DTSCU372.cob
Normal file
258
CICS/DTSCU372.cob
Normal file
@ -0,0 +1,258 @@
|
||||
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
|
||||
Reference in New Issue
Block a user