593 lines
47 KiB
COBOL
593 lines
47 KiB
COBOL
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
|