DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
592
CICS/DTSCU823.cob
Normal file
592
CICS/DTSCU823.cob
Normal file
@ -0,0 +1,592 @@
|
||||
00001 IDENTIFICATION DIVISION. 11/16/11
|
||||
00002 PROGRAM-ID. DTSCU823. DTSCU823
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV010
|
||||
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU823
|
||||
00005 DATE-COMPILED. DTSCU823
|
||||
00006 SKIP3 DTSCU823
|
||||
00007 ***** DTSCU823
|
||||
00008 * DTSCU823
|
||||
00009 * FUNCTION: ACCOUNTING TRANSACTION FILE INPUT/OUTPUT. DTSCU823
|
||||
00010 * DTSCU823
|
||||
00011 * DTSCU823
|
||||
00012 * MODIFICATION LOG: DTSCU823
|
||||
00013 * DTSCU823
|
||||
00014 * 11/12/91 INITIAL DEVELOPMENT. DTSCU823
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DTSCU823
|
||||
00016 * DTSCU823
|
||||
00017 * 04/12/94 MODIFIED FOR MONTANA. DTSCU823
|
||||
00018 * WORK ORDER: PROGRAMMER: RHC DTSCU823
|
||||
00019 * DTSCU823
|
||||
00020 * 01/31/97 ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER DTSCU823
|
||||
00021 * BATCHES. ONLY USED BY DTSBD140 SO TO SAVE MONEY DTSCU823
|
||||
00022 * THIS PROGRAM WASN'T RECOMPILED. DTSCU823
|
||||
00023 * WORK ORDER: PROGRAMMER: MJA DTSCU823
|
||||
00024 * DTSCU823
|
||||
00025 * 12/27/2001 MODIFIED FOR ANNUAL REPORT ACCOUNTING TRANSACTIONDTSCU823
|
||||
00026 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSCU823
|
||||
00027 * DTSCU823
|
||||
00028 * 12/19/2005 RECOMPILED FOR NEW VERSION OF AHDR. DTSCU823
|
||||
00029 * WORK ORDER: PROGRAMMER: GD DTSCU823
|
||||
00030 * DTSCU823
|
||||
00031 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU823
|
||||
00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU823
|
||||
00033 * WORK ORDER: PROGRAMMER: XXX DTSCU823
|
||||
00034 * DTSCU823
|
||||
00035 * DTSCU823
|
||||
00036 * DESCRIPTION: DTSCU823
|
||||
00037 * DTSCU823
|
||||
00038 * DTSCU823 PERFORMS ALL REQUIRED ACCOUNTING TRANSACTION DTSCU823
|
||||
00039 * FILE INPUT/OUTPUT. DTSCU823'S COMMAREA CONSISTS OF DTSCU823
|
||||
00040 * DTSIL823, FOLLOWED BY DTSIASKL. SEE DFHCOMMAREA DTSCU823
|
||||
00041 * OF THIS MODULE FOR AN EXAMPLE. DTSCU823
|
||||
00042 * DTSCU823
|
||||
00043 * DTSCU823
|
||||
00044 * GENERAL SPECIFICATIONS: DTSCU823
|
||||
00045 * DTSCU823
|
||||
00046 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSCU823
|
||||
00047 * MODULE. DTSCU823
|
||||
00048 * DTSCU823
|
||||
00049 * IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN DTSCU823
|
||||
00050 * NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED, DTSCU823
|
||||
00051 * THEN ABEND THE MODULE (TOLERATE INVREQ FROM A DTSCU823
|
||||
00052 * ENDBR). DTSCU823
|
||||
00053 * DTSCU823
|
||||
00054 * SPECIFY AIO-REC AS THE INTO OR FROM AREA OF THE CICS DTSCU823
|
||||
00055 * FILE COMMAND. DTSCU823
|
||||
00056 * DTSCU823
|
||||
00057 * SPECIFY ASKL-KEY OF AIO-REC AS THE RIDFLD OF THE CICS DTSCU823
|
||||
00058 * FILE COMMANDS. DTSCU823
|
||||
00059 * DTSCU823
|
||||
00060 * WHEN MOVING DATA FROM DFHCOMMAREA RECORDS TO AIO-REC DTSCU823
|
||||
00061 * (PRIOR TO A WRITE OR REWRITE), REFER TO AHDR-REC, DTSCU823
|
||||
00062 * ARPT-REC, ETC (NOT ACOMM-REC). IF AN UNKNOWN REC-TYPE DTSCU823
|
||||
00063 * IS ENCOUNTERED, THEN ABEND THE MODULE. DTSCU823
|
||||
00064 * DTSCU823
|
||||
00065 * WHEN MOVING DATA FROM AIO-REC TO DFHCOMMAREA (AFTER DTSCU823
|
||||
00066 * A SUCCESSFUL READ, READ UPDATE, STARTBR, READNEXT, DTSCU823
|
||||
00067 * OR READPREV) REFER TO AHDR-REC, ARPT-REC, ETC (NOT DTSCU823
|
||||
00068 * ACOMM-REC). IF AN UNKNOWN REC-TYPE IS ENCOUNTERED, DTSCU823
|
||||
00069 * THEN ABEND THE MODULE. DTSCU823
|
||||
00070 * DTSCU823
|
||||
00071 * DTSCU823
|
||||
00072 * COMMAND SPECIFIC SPECIFICATIONS: DTSCU823
|
||||
00073 * DTSCU823
|
||||
00074 * READ DTSCU823
|
||||
00075 * DTSCU823
|
||||
00076 * STARTBR DTSCU823
|
||||
00077 * DTSCU823
|
||||
00078 * PERFORM A STARTBR. IF THE STARTBR IS DTSCU823
|
||||
00079 * SUCCESSFUL, THEN PERFORM A READNEXT. IF THE DTSCU823
|
||||
00080 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU823
|
||||
00081 * L823-NO-REC-88. DTSCU823
|
||||
00082 * DTSCU823
|
||||
00083 * IF THE READNEXT RETURNS A L823-NO-REC-88, THEN DTSCU823
|
||||
00084 * ISSUE AN ENDBR. DTSCU823
|
||||
00085 * DTSCU823
|
||||
00086 * READNEXT DTSCU823
|
||||
00087 * PRIOR TO THE READNEXT, MOVE ASKL-KEY-AREA OF DTSCU823
|
||||
00088 * ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. IF THE DTSCU823
|
||||
00089 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU823
|
||||
00090 * L823-NO-REC-88. DTSCU823
|
||||
00091 * DTSCU823
|
||||
00092 * IF THE READNEXT RETURN A L823-NO-REC-88, THEN DTSCU823
|
||||
00093 * ISSUE AN ENDBR. DTSCU823
|
||||
00094 * DTSCU823
|
||||
00095 * READPREV DTSCU823
|
||||
00096 * PRIOR TO THE READPREV, MOVE ASKL-KEY-AREA OF DTSCU823
|
||||
00097 * ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. IF THE DTSCU823
|
||||
00098 * READPREV YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU823
|
||||
00099 * L823-NO-REC-88. DTSCU823
|
||||
00100 * DTSCU823
|
||||
00101 * IF THE READPREV RETURN A L823-NO-REC-88, THEN DTSCU823
|
||||
00102 * ISSUE AN ENDBR. DTSCU823
|
||||
00103 * DTSCU823
|
||||
00104 * ENDBR DTSCU823
|
||||
00105 * TOLERATE THE INVREQ CONDITION. DTSCU823
|
||||
00106 * DTSCU823
|
||||
00107 * WRITE DTSCU823
|
||||
00108 * DTSCU823
|
||||
00109 * REWRITE DTSCU823
|
||||
00110 * DTSCU823
|
||||
00111 * DELETE DTSCU823
|
||||
00112 * READ (UPDATE) THE RECORD TO BE DELETED. IF RECORD NOT DTSCU823
|
||||
00113 * FOUND, ABEND THE MODULE. DTSCU823
|
||||
00114 * DTSCU823
|
||||
00115 * DELETE. DTSCU823
|
||||
00116 * DTSCU823
|
||||
00117 ***** DTSCU823
|
||||
00118 SKIP3 DTSCU823
|
||||
00119 ENVIRONMENT DIVISION. DTSCU823
|
||||
00120 SKIP3 DTSCU823
|
||||
00121 DATA DIVISION. DTSCU823
|
||||
00122 SKIP3 DTSCU823
|
||||
00123 WORKING-STORAGE SECTION. DTSCU823
|
||||
001235 77 PAN-VALET PICTURE X(24) VALUE '010DTSCU823 11/16/11'. DTSCU823
|
||||
00124 SKIP3 DTSCU823
|
||||
00125 01 WRK-AREA. DTSCU823
|
||||
00126 05 WRK-ABEND-CD PIC X(04) VALUE 'U823'. DTSCU823
|
||||
00127 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU823
|
||||
00128 DTSCU823
|
||||
00129 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFATC'. DTSCU823
|
||||
00130 DTSCU823
|
||||
00131 05 EMSG-NOT-AVAILABLE. DTSCU823
|
||||
00132 10 FILLER PIC X(04) VALUE 'E091'. DTSCU823
|
||||
00133 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU823
|
||||
00134 10 EMSG-FILE-NAME PIC X(08). DTSCU823
|
||||
00135 10 FILLER PIC X(33) DTSCU823
|
||||
00136 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU823
|
||||
00137 SKIP3 DTSCU823
|
||||
00138 *****05 WRK-CICS-APPLID PIC X(08). DTSCU823
|
||||
00139 DTSCU823
|
||||
00140 *****05 WRK-CICS-OP-ID PIC X(08). DTSCU823
|
||||
00141 *********88 WRK-TCL-OP-ID-88 VALUE 'CE0756' DTSCU823
|
||||
00142 *********************************************'CE3568' DTSCU823
|
||||
00143 *********************************************'C84986'. DTSCU823
|
||||
00144 DTSCU823
|
||||
00145 05 WRK-FILE-NAME PIC X(08). DTSCU823
|
||||
00146 DTSCU823
|
||||
00147 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU823
|
||||
00148 EJECT DTSCU823
|
||||
00149 01 ALEN-LITERALS. DTSCU823
|
||||
00150 ++INCLUDE DTSIALEN DTSCU823
|
||||
00151 EJECT DTSCU823
|
||||
00152 01 AIO-REC. DTSCU823
|
||||
00153 ++INCLUDE DTSIASKL DTSCU823
|
||||
00154 EJECT DTSCU823
|
||||
00155 LINKAGE SECTION. DTSCU823
|
||||
00156 SKIP3 DTSCU823
|
||||
00157 01 DFHCOMMAREA. DTSCU823
|
||||
00158 05 L823-CONTROL-BLOCK. DTSCU823
|
||||
00159 ++INCLUDE DTSIL823 DTSCU823
|
||||
00160 SKIP3 DTSCU823
|
||||
00161 05 ACOMM-REC. DTSCU823
|
||||
00162 ++INCLUDE DTSIASKL DTSCU823
|
||||
00163 SKIP3 DTSCU823
|
||||
00164 05 AHDR-REC REDEFINES ACOMM-REC. DTSCU823
|
||||
00165 ++INCLUDE DTSIAHDR DTSCU823
|
||||
00166 SKIP3 DTSCU823
|
||||
00167 05 ARPT-REC REDEFINES ACOMM-REC. DTSCU823
|
||||
00168 ++INCLUDE DTSIARPT DTSCU823
|
||||
00169 SKIP3 DTSCU823
|
||||
00170 05 APAY-REC REDEFINES ACOMM-REC. DTSCU823
|
||||
00171 ++INCLUDE DTSIAPAY DTSCU823
|
||||
00172 SKIP3 DTSCU823
|
||||
00173 05 AADJ-REC REDEFINES ACOMM-REC. DTSCU823
|
||||
00174 ++INCLUDE DTSIAADJ DTSCU823
|
||||
00175 EJECT DTSCU823
|
||||
00176 05 AATX-REC REDEFINES ACOMM-REC. DTSCU823
|
||||
00177 ++INCLUDE DTSIAATX DTSCU823
|
||||
00178 EJECT DTSCU823
|
||||
00179 PROCEDURE DIVISION. DTSCU823
|
||||
00180 DTSCU823
|
||||
00181 *****EXEC CICS DTSCU823
|
||||
00182 ***** ASSIGN DTSCU823
|
||||
00183 ***** APPLID (WRK-CICS-APPLID) DTSCU823
|
||||
00184 *****END-EXEC. DTSCU823
|
||||
00185 ***** DTSCU823
|
||||
00186 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU823
|
||||
00187 ***** EXEC CICS DTSCU823
|
||||
00188 ***** ASSIGN DTSCU823
|
||||
00189 ***** USERID (WRK-CICS-OP-ID) DTSCU823
|
||||
00190 ***** END-EXEC DTSCU823
|
||||
00191 ***** DTSCU823
|
||||
00192 ***** IF WRK-TCL-OP-ID-88 DTSCU823
|
||||
00193 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU823
|
||||
00194 ***** ELSE DTSCU823
|
||||
00195 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU823
|
||||
00196 *****ELSE DTSCU823
|
||||
00197 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU823
|
||||
00198 DTSCU823
|
||||
00199 DTSCU823
|
||||
00200 MOVE SPACES TO L823-MSG-AREA. DTSCU823
|
||||
00201 DTSCU823
|
||||
00202 SET L823-OK-88 TO TRUE. DTSCU823
|
||||
00203 DTSCU823
|
||||
00204 IF L823-READ-NEXT-88 DTSCU823
|
||||
00205 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU823
|
||||
00206 ELSE DTSCU823
|
||||
00207 IF L823-READ-88 DTSCU823
|
||||
00208 PERFORM P1100-READ THRU P1100-EXIT DTSCU823
|
||||
00209 ELSE DTSCU823
|
||||
00210 IF L823-START-BROWSE-88 DTSCU823
|
||||
00211 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU823
|
||||
00212 ELSE DTSCU823
|
||||
00213 IF L823-END-BROWSE-88 DTSCU823
|
||||
00214 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU823
|
||||
00215 ELSE DTSCU823
|
||||
00216 IF L823-READ-PREV-88 DTSCU823
|
||||
00217 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU823
|
||||
00218 ELSE DTSCU823
|
||||
00219 IF L823-WRITE-88 DTSCU823
|
||||
00220 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU823
|
||||
00221 ELSE DTSCU823
|
||||
00222 IF L823-REWRITE-88 DTSCU823
|
||||
00223 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU823
|
||||
00224 ELSE DTSCU823
|
||||
00225 IF L823-DELETE-88 DTSCU823
|
||||
00226 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU823
|
||||
00227 ELSE DTSCU823
|
||||
00228 GO TO S899-ABEND. DTSCU823
|
||||
00229 DTSCU823
|
||||
00230 DTSCU823
|
||||
00231 EXEC CICS DTSCU823
|
||||
00232 RETURN DTSCU823
|
||||
00233 END-EXEC. DTSCU823
|
||||
00234 DTSCU823
|
||||
00235 DTSCU823
|
||||
00236 GOBACK. DTSCU823
|
||||
00237 EJECT DTSCU823
|
||||
00238 P1100-READ. DTSCU823
|
||||
00239 MOVE LOW-VALUE TO AIO-REC. DTSCU823
|
||||
00240 DTSCU823
|
||||
00241 MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
|
||||
00242 DTSCU823
|
||||
00243 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823
|
||||
00244 DTSCU823
|
||||
00245 EXEC CICS DTSCU823
|
||||
00246 READ DTSCU823
|
||||
00247 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00248 INTO (AIO-REC) DTSCU823
|
||||
00249 LENGTH (WRK-REC-LENGTH) DTSCU823
|
||||
00250 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823
|
||||
00251 RESP (WRK-RESP-CD) DTSCU823
|
||||
00252 END-EXEC. DTSCU823
|
||||
00253 DTSCU823
|
||||
00254 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823
|
||||
00255 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00256 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00257 GO TO P1100-EXIT. DTSCU823
|
||||
00258 DTSCU823
|
||||
00259 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU823
|
||||
00260 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823
|
||||
00261 GO TO P1100-EXIT. DTSCU823
|
||||
00262 DTSCU823
|
||||
00263 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00264 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU823
|
||||
00265 ELSE DTSCU823
|
||||
00266 GO TO S899-ABEND. DTSCU823
|
||||
00267 P1100-EXIT. DTSCU823
|
||||
00268 EXIT. DTSCU823
|
||||
00269 EJECT DTSCU823
|
||||
00270 P2100-START-BROWSE. DTSCU823
|
||||
00271 MOVE LOW-VALUE TO AIO-REC. DTSCU823
|
||||
00272 DTSCU823
|
||||
00273 MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
|
||||
00274 DTSCU823
|
||||
00275 EXEC CICS DTSCU823
|
||||
00276 STARTBR DTSCU823
|
||||
00277 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00278 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823
|
||||
00279 RESP (WRK-RESP-CD) DTSCU823
|
||||
00280 END-EXEC. DTSCU823
|
||||
00281 DTSCU823
|
||||
00282 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823
|
||||
00283 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00284 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00285 GO TO P2100-EXIT. DTSCU823
|
||||
00286 DTSCU823
|
||||
00287 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU823
|
||||
00288 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823
|
||||
00289 GO TO P2100-EXIT. DTSCU823
|
||||
00290 DTSCU823
|
||||
00291 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00292 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU823
|
||||
00293 ELSE DTSCU823
|
||||
00294 GO TO S899-ABEND. DTSCU823
|
||||
00295 P2100-EXIT. DTSCU823
|
||||
00296 EXIT. DTSCU823
|
||||
00297 EJECT DTSCU823
|
||||
00298 P2200-READ-NEXT. DTSCU823
|
||||
00299 IF L823-READ-NEXT-88 DTSCU823
|
||||
00300 MOVE LOW-VALUE TO AIO-REC DTSCU823
|
||||
00301 MOVE ASKL-KEY-AREA OF ACOMM-REC DTSCU823
|
||||
00302 TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
|
||||
00303 DTSCU823
|
||||
00304 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823
|
||||
00305 DTSCU823
|
||||
00306 EXEC CICS DTSCU823
|
||||
00307 READNEXT DTSCU823
|
||||
00308 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00309 INTO (AIO-REC) DTSCU823
|
||||
00310 LENGTH (WRK-REC-LENGTH) DTSCU823
|
||||
00311 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823
|
||||
00312 RESP (WRK-RESP-CD) DTSCU823
|
||||
00313 END-EXEC. DTSCU823
|
||||
00314 DTSCU823
|
||||
00315 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823
|
||||
00316 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00317 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00318 GO TO P2200-EXIT. DTSCU823
|
||||
00319 DTSCU823
|
||||
00320 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU823
|
||||
00321 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823
|
||||
00322 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU823
|
||||
00323 GO TO P2200-EXIT. DTSCU823
|
||||
00324 DTSCU823
|
||||
00325 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00326 NEXT SENTENCE DTSCU823
|
||||
00327 ELSE DTSCU823
|
||||
00328 GO TO S899-ABEND. DTSCU823
|
||||
00329 DTSCU823
|
||||
00330 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT. DTSCU823
|
||||
00331 P2200-EXIT. DTSCU823
|
||||
00332 EXIT. DTSCU823
|
||||
00333 EJECT DTSCU823
|
||||
00334 P2300-READ-PREV. DTSCU823
|
||||
00335 MOVE LOW-VALUE TO AIO-REC. DTSCU823
|
||||
00336 DTSCU823
|
||||
00337 MOVE ASKL-KEY-AREA OF ACOMM-REC DTSCU823
|
||||
00338 TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
|
||||
00339 DTSCU823
|
||||
00340 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823
|
||||
00341 DTSCU823
|
||||
00342 EXEC CICS DTSCU823
|
||||
00343 READPREV DTSCU823
|
||||
00344 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00345 INTO (AIO-REC) DTSCU823
|
||||
00346 LENGTH (WRK-REC-LENGTH) DTSCU823
|
||||
00347 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823
|
||||
00348 RESP (WRK-RESP-CD) DTSCU823
|
||||
00349 END-EXEC. DTSCU823
|
||||
00350 DTSCU823
|
||||
00351 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823
|
||||
00352 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00353 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00354 GO TO P2300-EXIT. DTSCU823
|
||||
00355 DTSCU823
|
||||
00356 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU823
|
||||
00357 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823
|
||||
00358 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU823
|
||||
00359 GO TO P2300-EXIT. DTSCU823
|
||||
00360 DTSCU823
|
||||
00361 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00362 NEXT SENTENCE DTSCU823
|
||||
00363 ELSE DTSCU823
|
||||
00364 GO TO S899-ABEND. DTSCU823
|
||||
00365 DTSCU823
|
||||
00366 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT. DTSCU823
|
||||
00367 P2300-EXIT. DTSCU823
|
||||
00368 EXIT. DTSCU823
|
||||
00369 EJECT DTSCU823
|
||||
00370 P2400-END-BROWSE. DTSCU823
|
||||
00371 DTSCU823
|
||||
00372 EXEC CICS DTSCU823
|
||||
00373 ENDBR DTSCU823
|
||||
00374 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00375 RESP (WRK-RESP-CD) DTSCU823
|
||||
00376 END-EXEC. DTSCU823
|
||||
00377 DTSCU823
|
||||
00378 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823
|
||||
00379 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00380 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00381 GO TO P2400-EXIT. DTSCU823
|
||||
00382 DTSCU823
|
||||
00383 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU823
|
||||
00384 NEXT SENTENCE DTSCU823
|
||||
00385 ELSE DTSCU823
|
||||
00386 GO TO S899-ABEND. DTSCU823
|
||||
00387 P2400-EXIT. DTSCU823
|
||||
00388 EXIT. DTSCU823
|
||||
00389 EJECT DTSCU823
|
||||
00390 P3100-WRITE. DTSCU823
|
||||
00391 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU823
|
||||
00392 DTSCU823
|
||||
00393 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU823
|
||||
00394 DTSCU823
|
||||
00395 EXEC CICS DTSCU823
|
||||
00396 WRITE DTSCU823
|
||||
00397 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00398 FROM (AIO-REC) DTSCU823
|
||||
00399 LENGTH (WRK-REC-LENGTH) DTSCU823
|
||||
00400 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823
|
||||
00401 RESP (WRK-RESP-CD) DTSCU823
|
||||
00402 END-EXEC. DTSCU823
|
||||
00403 DTSCU823
|
||||
00404 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823
|
||||
00405 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00406 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00407 GO TO P3100-EXIT. DTSCU823
|
||||
00408 DTSCU823
|
||||
00409 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00410 NEXT SENTENCE DTSCU823
|
||||
00411 ELSE DTSCU823
|
||||
00412 GO TO S899-ABEND. DTSCU823
|
||||
00413 P3100-EXIT. DTSCU823
|
||||
00414 EXIT. DTSCU823
|
||||
00415 EJECT DTSCU823
|
||||
00416 P3200-REWRITE. DTSCU823
|
||||
00417 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU823
|
||||
00418 DTSCU823
|
||||
00419 IF L823-NO-REC-88 DTSCU823
|
||||
00420 GO TO S899-ABEND DTSCU823
|
||||
00421 ELSE DTSCU823
|
||||
00422 IF L823-FILE-CLOSED-88 DTSCU823
|
||||
00423 GO TO P3200-EXIT. DTSCU823
|
||||
00424 DTSCU823
|
||||
00425 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU823
|
||||
00426 DTSCU823
|
||||
00427 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU823
|
||||
00428 DTSCU823
|
||||
00429 EXEC CICS DTSCU823
|
||||
00430 REWRITE DTSCU823
|
||||
00431 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00432 FROM (AIO-REC) DTSCU823
|
||||
00433 LENGTH (WRK-REC-LENGTH) DTSCU823
|
||||
00434 RESP (WRK-RESP-CD) DTSCU823
|
||||
00435 END-EXEC. DTSCU823
|
||||
00436 DTSCU823
|
||||
00437 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823
|
||||
00438 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00439 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00440 GO TO P3200-EXIT. DTSCU823
|
||||
00441 DTSCU823
|
||||
00442 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00443 NEXT SENTENCE DTSCU823
|
||||
00444 ELSE DTSCU823
|
||||
00445 GO TO S899-ABEND. DTSCU823
|
||||
00446 P3200-EXIT. DTSCU823
|
||||
00447 EXIT. DTSCU823
|
||||
00448 EJECT DTSCU823
|
||||
00449 P3300-DELETE. DTSCU823
|
||||
00450 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU823
|
||||
00451 DTSCU823
|
||||
00452 IF L823-NO-REC-88 DTSCU823
|
||||
00453 GO TO S899-ABEND DTSCU823
|
||||
00454 ELSE DTSCU823
|
||||
00455 IF L823-FILE-CLOSED-88 DTSCU823
|
||||
00456 GO TO P3300-EXIT. DTSCU823
|
||||
00457 DTSCU823
|
||||
00458 EXEC CICS DTSCU823
|
||||
00459 DELETE DTSCU823
|
||||
00460 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00461 RESP (WRK-RESP-CD) DTSCU823
|
||||
00462 END-EXEC. DTSCU823
|
||||
00463 DTSCU823
|
||||
00464 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823
|
||||
00465 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00466 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00467 GO TO P3300-EXIT. DTSCU823
|
||||
00468 DTSCU823
|
||||
00469 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00470 NEXT SENTENCE DTSCU823
|
||||
00471 ELSE DTSCU823
|
||||
00472 GO TO S899-ABEND. DTSCU823
|
||||
00473 P3300-EXIT. DTSCU823
|
||||
00474 EXIT. DTSCU823
|
||||
00475 EJECT DTSCU823
|
||||
00476 S1100-NOT-AVAILABLE. DTSCU823
|
||||
00477 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU823
|
||||
00478 DTSCU823
|
||||
00479 MOVE EMSG-NOT-AVAILABLE TO L823-MSG-AREA. DTSCU823
|
||||
00480 DTSCU823
|
||||
00481 SET L823-FILE-CLOSED-88 TO TRUE. DTSCU823
|
||||
00482 S1100-EXIT. DTSCU823
|
||||
00483 EXIT. DTSCU823
|
||||
00484 SKIP3 DTSCU823
|
||||
00485 S1200-NOT-FOUND. DTSCU823
|
||||
00486 SET L823-NO-REC-88 TO TRUE. DTSCU823
|
||||
00487 S1200-EXIT. DTSCU823
|
||||
00488 EXIT. DTSCU823
|
||||
00489 EJECT DTSCU823
|
||||
00490 S2100-IO-TO-COMM. DTSCU823
|
||||
00491 IF ASKL-ADJ-88 OF AIO-REC DTSCU823
|
||||
00492 MOVE AIO-REC TO AADJ-REC DTSCU823
|
||||
00493 ELSE DTSCU823
|
||||
00494 IF ASKL-HDR-88 OF AIO-REC DTSCU823
|
||||
00495 MOVE AIO-REC TO AHDR-REC DTSCU823
|
||||
00496 ELSE DTSCU823
|
||||
00497 IF ASKL-PAY-88 OF AIO-REC DTSCU823
|
||||
00498 MOVE AIO-REC TO APAY-REC DTSCU823
|
||||
00499 ELSE DTSCU823
|
||||
00500 IF ASKL-RPT-88 OF AIO-REC DTSCU823
|
||||
00501 MOVE AIO-REC TO ARPT-REC DTSCU823
|
||||
00502 ELSE DTSCU823
|
||||
00503 IF ASKL-ATX-88 OF AIO-REC DTSCU823
|
||||
00504 MOVE AIO-REC TO AATX-REC DTSCU823
|
||||
00505 ELSE DTSCU823
|
||||
00506 GO TO S899-ABEND. DTSCU823
|
||||
00507 SKIP3 DTSCU823
|
||||
00508 S2100-EXIT. DTSCU823
|
||||
00509 EXIT. DTSCU823
|
||||
00510 EJECT DTSCU823
|
||||
00511 S2200-COMM-TO-IO. DTSCU823
|
||||
00512 IF ASKL-ADJ-88 OF ACOMM-REC DTSCU823
|
||||
00513 MOVE AADJ-REC TO AIO-REC DTSCU823
|
||||
00514 ELSE DTSCU823
|
||||
00515 IF ASKL-HDR-88 OF ACOMM-REC DTSCU823
|
||||
00516 MOVE AHDR-REC TO AIO-REC DTSCU823
|
||||
00517 ELSE DTSCU823
|
||||
00518 IF ASKL-PAY-88 OF ACOMM-REC DTSCU823
|
||||
00519 MOVE APAY-REC TO AIO-REC DTSCU823
|
||||
00520 ELSE DTSCU823
|
||||
00521 IF ASKL-RPT-88 OF ACOMM-REC DTSCU823
|
||||
00522 MOVE ARPT-REC TO AIO-REC DTSCU823
|
||||
00523 ELSE DTSCU823
|
||||
00524 IF ASKL-ATX-88 OF ACOMM-REC DTSCU823
|
||||
00525 MOVE AATX-REC TO AIO-REC DTSCU823
|
||||
00526 ELSE DTSCU823
|
||||
00527 GO TO S899-ABEND. DTSCU823
|
||||
00528 SKIP3 DTSCU823
|
||||
00529 S2200-EXIT. DTSCU823
|
||||
00530 EXIT. DTSCU823
|
||||
00531 EJECT DTSCU823
|
||||
00532 S2300-CALCULATE-LENGTH. DTSCU823
|
||||
00533 IF ASKL-ADJ-88 OF ACOMM-REC DTSCU823
|
||||
00534 MOVE ALEN-ADJ-LENGTH TO WRK-REC-LENGTH DTSCU823
|
||||
00535 ELSE DTSCU823
|
||||
00536 IF ASKL-HDR-88 OF ACOMM-REC DTSCU823
|
||||
00537 MOVE ALEN-HDR-LENGTH TO WRK-REC-LENGTH DTSCU823
|
||||
00538 ELSE DTSCU823
|
||||
00539 IF ASKL-PAY-88 OF ACOMM-REC DTSCU823
|
||||
00540 MOVE ALEN-PAY-LENGTH TO WRK-REC-LENGTH DTSCU823
|
||||
00541 ELSE DTSCU823
|
||||
00542 IF ASKL-RPT-88 OF ACOMM-REC DTSCU823
|
||||
00543 MOVE ALEN-RPT-LENGTH TO WRK-REC-LENGTH DTSCU823
|
||||
00544 ELSE DTSCU823
|
||||
00545 IF ASKL-ATX-88 OF ACOMM-REC DTSCU823
|
||||
00546 MOVE ALEN-ATX-LENGTH TO WRK-REC-LENGTH DTSCU823
|
||||
00547 ELSE DTSCU823
|
||||
00548 GO TO S899-ABEND. DTSCU823
|
||||
00549 S2300-EXIT. DTSCU823
|
||||
00550 EXIT. DTSCU823
|
||||
00551 EJECT DTSCU823
|
||||
00552 S3100-READ-UPDATE. DTSCU823
|
||||
00553 MOVE LOW-VALUE TO AIO-REC. DTSCU823
|
||||
00554 DTSCU823
|
||||
00555 MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823
|
||||
00556 DTSCU823
|
||||
00557 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823
|
||||
00558 DTSCU823
|
||||
00559 EXEC CICS DTSCU823
|
||||
00560 READ DTSCU823
|
||||
00561 DATASET (WRK-FILE-NAME) DTSCU823
|
||||
00562 INTO (AIO-REC) DTSCU823
|
||||
00563 LENGTH (WRK-REC-LENGTH) DTSCU823
|
||||
00564 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823
|
||||
00565 UPDATE DTSCU823
|
||||
00566 RESP (WRK-RESP-CD) DTSCU823
|
||||
00567 END-EXEC. DTSCU823
|
||||
00568 DTSCU823
|
||||
00569 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823
|
||||
00570 OR DFHRESP (SYSIDERR) DTSCU823
|
||||
00571 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823
|
||||
00572 GO TO S3100-EXIT. DTSCU823
|
||||
00573 DTSCU823
|
||||
00574 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU823
|
||||
00575 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823
|
||||
00576 GO TO S3100-EXIT. DTSCU823
|
||||
00577 DTSCU823
|
||||
00578 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823
|
||||
00579 NEXT SENTENCE DTSCU823
|
||||
00580 ELSE DTSCU823
|
||||
00581 GO TO S899-ABEND. DTSCU823
|
||||
00582 S3100-EXIT. DTSCU823
|
||||
00583 EXIT. DTSCU823
|
||||
00584 EJECT DTSCU823
|
||||
00585 S899-ABEND. DTSCU823
|
||||
00586 EXEC CICS DTSCU823
|
||||
00587 ABEND DTSCU823
|
||||
00588 ABCODE (WRK-ABEND-CD) DTSCU823
|
||||
00589 END-EXEC. DTSCU823
|
||||
00590 S899-EXIT. DTSCU823
|
||||
00591 EXIT. DTSCU823
|
||||
Reference in New Issue
Block a user