484 lines
38 KiB
COBOL
484 lines
38 KiB
COBOL
00001 IDENTIFICATION DIVISION. 04/05/04
|
|
00002 PROGRAM-ID. DTSCU880. DTSCU880
|
|
00003 AUTHOR. TRW. LV003
|
|
00004 DATE-WRITTEN. DECEMBER 2001. DTSCU880
|
|
00005 DATE-COMPILED. DTSCU880
|
|
00006 SKIP3 DTSCU880
|
|
00007 ***** DTSCU880
|
|
00008 * DTSCU880
|
|
00009 * FUNCTION: WAGE TRANSACTION FILE INPUT/OUTPUT. DTSCU880
|
|
00010 * DTSCU880
|
|
00011 * DTSCU880
|
|
00012 * MODIFICATION LOG: DTSCU880
|
|
00013 * DTSCU880
|
|
00014 * 12/28/2001 INITIAL DEVELOPMENT. DTSCU880
|
|
00015 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSCU880
|
|
00016 * DTSCU880
|
|
00017 * 10/06/2003 RECOMPILED FOR NEW VERSION OF WGH RECORD. DTSCU880
|
|
00018 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSCU880
|
|
00019 * DTSCU880
|
|
00020 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU880
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU880
|
|
00022 * WORK ORDER: PROGRAMMER: XXX DTSCU880
|
|
00023 * DTSCU880
|
|
00024 * DTSCU880
|
|
00025 * DESCRIPTION: DTSCU880
|
|
00026 * DTSCU880
|
|
00027 * DTSCU880 PERFORMS ALL REQUIRED WAGE TRANSACTION DTSCU880
|
|
00028 * FILE INPUT/OUTPUT. DTSCU880'S COMMAREA CONSISTS OF DTSCU880
|
|
00029 * DTSIL880, FOLLOWED BY DTSIWSKL. SEE DFHCOMMAREA DTSCU880
|
|
00030 * OF THIS MODULE FOR AN EXAMPLE. DTSCU880
|
|
00031 * DTSCU880
|
|
00032 * DTSCU880
|
|
00033 * GENERAL SPECIFICATIONS: DTSCU880
|
|
00034 * DTSCU880
|
|
00035 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSCU880
|
|
00036 * MODULE. DTSCU880
|
|
00037 * DTSCU880
|
|
00038 * IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN DTSCU880
|
|
00039 * NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED, DTSCU880
|
|
00040 * THEN ABEND THE MODULE (TOLERATE INVREQ FROM A DTSCU880
|
|
00041 * ENDBR). DTSCU880
|
|
00042 * DTSCU880
|
|
00043 * SPECIFY WIO-REC AS THE INTO OR FROM AREA OF THE CICS DTSCU880
|
|
00044 * FILE COMMAND. DTSCU880
|
|
00045 * DTSCU880
|
|
00046 * SPECIFY WSKL-KEY OF WIO-REC AS THE RIDFLD OF THE CICS DTSCU880
|
|
00047 * FILE COMMANDS. DTSCU880
|
|
00048 * DTSCU880
|
|
00049 * WHEN MOVING DATA FROM DFHCOMMAREA RECORDS TO WIO-REC DTSCU880
|
|
00050 * (PRIOR TO A WRITE OR REWRITE), REFER TO W001-REC, DTSCU880
|
|
00051 * (NOT WCOMM-REC). DTSCU880
|
|
00052 * DTSCU880
|
|
00053 * WHEN MOVING DATA FROM WIO-REC TO DFHCOMMAREA (AFTER DTSCU880
|
|
00054 * A SUCCESSFUL READ, READ UPDATE, STARTBR, READNEXT, DTSCU880
|
|
00055 * OR READPREV) REFER TO W001-REC (NOT WCOMM-REC). DTSCU880
|
|
00056 * DTSCU880
|
|
00057 * DTSCU880
|
|
00058 * COMMAND SPECIFIC SPECIFICATIONS: DTSCU880
|
|
00059 * DTSCU880
|
|
00060 * READ DTSCU880
|
|
00061 * DTSCU880
|
|
00062 * STARTBR DTSCU880
|
|
00063 * DTSCU880
|
|
00064 * PERFORM A STARTBR. IF THE STARTBR IS DTSCU880
|
|
00065 * SUCCESSFUL, THEN PERFORM A READNEXT. IF THE DTSCU880
|
|
00066 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU880
|
|
00067 * L880-NO-REC-88. DTSCU880
|
|
00068 * DTSCU880
|
|
00069 * IF THE READNEXT RETURNS A L880-NO-REC-88, THEN DTSCU880
|
|
00070 * ISSUE AN ENDBR. DTSCU880
|
|
00071 * DTSCU880
|
|
00072 * READNEXT DTSCU880
|
|
00073 * PRIOR TO THE READNEXT, MOVE WSKL-KEY-AREA OF DTSCU880
|
|
00074 * WCOMM-REC TO WSKL-KEY-AREA OF WIO-REC. IF THE DTSCU880
|
|
00075 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU880
|
|
00076 * L880-NO-REC-88. DTSCU880
|
|
00077 * DTSCU880
|
|
00078 * IF THE READNEXT RETURN A L880-NO-REC-88, THEN DTSCU880
|
|
00079 * ISSUE AN ENDBR. DTSCU880
|
|
00080 * DTSCU880
|
|
00081 * READPREV DTSCU880
|
|
00082 * PRIOR TO THE READPREV, MOVE WSKL-KEY-AREA OF DTSCU880
|
|
00083 * WCOMM-REC TO WSKL-KEY-AREA OF WIO-REC. IF THE DTSCU880
|
|
00084 * READPREV YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU880
|
|
00085 * L880-NO-REC-88. DTSCU880
|
|
00086 * DTSCU880
|
|
00087 * IF THE READPREV RETURN A L880-NO-REC-88, THEN DTSCU880
|
|
00088 * ISSUE AN ENDBR. DTSCU880
|
|
00089 * DTSCU880
|
|
00090 * ENDBR DTSCU880
|
|
00091 * TOLERATE THE INVREQ CONDITION. DTSCU880
|
|
00092 * DTSCU880
|
|
00093 * WRITE DTSCU880
|
|
00094 * DTSCU880
|
|
00095 * REWRITE DTSCU880
|
|
00096 * DTSCU880
|
|
00097 * DELETE DTSCU880
|
|
00098 * READ (UPDATE) THE RECORD TO BE DELETED. IF RECORD NOT DTSCU880
|
|
00099 * FOUND, ABEND THE MODULE. DTSCU880
|
|
00100 * DTSCU880
|
|
00101 * DELETE. DTSCU880
|
|
00102 * DTSCU880
|
|
00103 ***** DTSCU880
|
|
00104 SKIP3 DTSCU880
|
|
00105 ENVIRONMENT DIVISION. DTSCU880
|
|
00106 SKIP3 DTSCU880
|
|
00107 DATA DIVISION. DTSCU880
|
|
00108 SKIP3 DTSCU880
|
|
00109 WORKING-STORAGE SECTION. DTSCU880
|
|
001095 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU880 04/05/04'. DTSCU880
|
|
00110 SKIP3 DTSCU880
|
|
00111 01 WRK-AREA. DTSCU880
|
|
00112 05 WRK-ABEND-CD PIC X(04) VALUE 'U880'. DTSCU880
|
|
00113 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU880
|
|
00114 DTSCU880
|
|
00115 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFWTC '.DTSCU880
|
|
00116 DTSCU880
|
|
00117 05 EMSG-NOT-AVAILABLE. DTSCU880
|
|
00118 10 FILLER PIC X(04) VALUE 'E091'. DTSCU880
|
|
00119 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU880
|
|
00120 10 EMSG-FILE-NAME PIC X(08). DTSCU880
|
|
00121 10 FILLER PIC X(33) DTSCU880
|
|
00122 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU880
|
|
00123 SKIP3 DTSCU880
|
|
00124 *****05 WRK-CICS-APPLID PIC X(08). DTSCU880
|
|
00125 DTSCU880
|
|
00126 05 WRK-FILE-NAME PIC X(08). DTSCU880
|
|
00127 DTSCU880
|
|
00128 05 WRK-REC-LENGTH PIC S9(04) COMP DTSCU880
|
|
00129 VALUE +128. DTSCU880
|
|
00130 EJECT DTSCU880
|
|
00131 01 WIO-REC. DTSCU880
|
|
00132 ++INCLUDE DTSIWSKL DTSCU880
|
|
00133 EJECT DTSCU880
|
|
00134 LINKAGE SECTION. DTSCU880
|
|
00135 SKIP3 DTSCU880
|
|
00136 01 DFHCOMMAREA. DTSCU880
|
|
00137 05 L880-CONTROL-BLOCK. DTSCU880
|
|
00138 ++INCLUDE DTSIL880 DTSCU880
|
|
00139 SKIP3 DTSCU880
|
|
00140 05 WCOMM-REC. DTSCU880
|
|
00141 ++INCLUDE DTSIWSKL DTSCU880
|
|
00142 SKIP3 DTSCU880
|
|
00143 PROCEDURE DIVISION. DTSCU880
|
|
00144 DTSCU880
|
|
00145 *****EXEC CICS DTSCU880
|
|
00146 ***** ASSIGN DTSCU880
|
|
00147 ***** APPLID (WRK-CICS-APPLID) DTSCU880
|
|
00148 *****END-EXEC. DTSCU880
|
|
00149 ***** DTSCU880
|
|
00150 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU880
|
|
00151 ***** EXEC CICS DTSCU880
|
|
00152 ***** ASSIGN DTSCU880
|
|
00153 ***** USERID (WRK-CICS-OP-ID) DTSCU880
|
|
00154 ***** END-EXEC DTSCU880
|
|
00155 ***** DTSCU880
|
|
00156 ***** IF WRK-TCL-OP-ID-88 DTSCU880
|
|
00157 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU880
|
|
00158 ***** ELSE DTSCU880
|
|
00159 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU880
|
|
00160 *****ELSE DTSCU880
|
|
00161 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU880
|
|
00162 DTSCU880
|
|
00163 DTSCU880
|
|
00164 MOVE SPACES TO L880-MSG-AREA. DTSCU880
|
|
00165 DTSCU880
|
|
00166 SET L880-OK-88 TO TRUE. DTSCU880
|
|
00167 DTSCU880
|
|
00168 IF L880-READ-NEXT-88 DTSCU880
|
|
00169 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU880
|
|
00170 ELSE DTSCU880
|
|
00171 IF L880-READ-88 DTSCU880
|
|
00172 PERFORM P1100-READ THRU P1100-EXIT DTSCU880
|
|
00173 ELSE DTSCU880
|
|
00174 IF L880-START-BROWSE-88 DTSCU880
|
|
00175 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU880
|
|
00176 ELSE DTSCU880
|
|
00177 IF L880-END-BROWSE-88 DTSCU880
|
|
00178 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU880
|
|
00179 ELSE DTSCU880
|
|
00180 IF L880-READ-PREV-88 DTSCU880
|
|
00181 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU880
|
|
00182 ELSE DTSCU880
|
|
00183 IF L880-WRITE-88 DTSCU880
|
|
00184 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU880
|
|
00185 ELSE DTSCU880
|
|
00186 IF L880-REWRITE-88 DTSCU880
|
|
00187 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU880
|
|
00188 ELSE DTSCU880
|
|
00189 IF L880-DELETE-88 DTSCU880
|
|
00190 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU880
|
|
00191 ELSE DTSCU880
|
|
00192 GO TO S899-ABEND. DTSCU880
|
|
00193 DTSCU880
|
|
00194 DTSCU880
|
|
00195 EXEC CICS DTSCU880
|
|
00196 RETURN DTSCU880
|
|
00197 END-EXEC. DTSCU880
|
|
00198 DTSCU880
|
|
00199 DTSCU880
|
|
00200 GOBACK. DTSCU880
|
|
00201 EJECT DTSCU880
|
|
00202 P1100-READ. DTSCU880
|
|
00203 MOVE LOW-VALUE TO WIO-REC. DTSCU880
|
|
00204 DTSCU880
|
|
00205 MOVE WSKL-KEY-AREA OF WCOMM-REC TO WSKL-KEY-AREA OF WIO-REC. DTSCU880
|
|
00206 DTSCU880
|
|
00207 DTSCU880
|
|
00208 EXEC CICS DTSCU880
|
|
00209 READ DTSCU880
|
|
00210 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00211 INTO (WIO-REC) DTSCU880
|
|
00212 LENGTH (WRK-REC-LENGTH) DTSCU880
|
|
00213 RIDFLD (WSKL-KEY-AREA OF WIO-REC) DTSCU880
|
|
00214 RESP (WRK-RESP-CD) DTSCU880
|
|
00215 END-EXEC. DTSCU880
|
|
00216 DTSCU880
|
|
00217 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU880
|
|
00218 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00219 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00220 GO TO P1100-EXIT. DTSCU880
|
|
00221 DTSCU880
|
|
00222 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU880
|
|
00223 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU880
|
|
00224 GO TO P1100-EXIT. DTSCU880
|
|
00225 DTSCU880
|
|
00226 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00227 MOVE WIO-REC TO WCOMM-REC DTSCU880
|
|
00228 ELSE DTSCU880
|
|
00229 GO TO S899-ABEND. DTSCU880
|
|
00230 P1100-EXIT. DTSCU880
|
|
00231 EXIT. DTSCU880
|
|
00232 EJECT DTSCU880
|
|
00233 P2100-START-BROWSE. DTSCU880
|
|
00234 MOVE LOW-VALUE TO WIO-REC. DTSCU880
|
|
00235 DTSCU880
|
|
00236 MOVE WSKL-KEY-AREA OF WCOMM-REC TO WSKL-KEY-AREA OF WIO-REC. DTSCU880
|
|
00237 DTSCU880
|
|
00238 EXEC CICS DTSCU880
|
|
00239 STARTBR DTSCU880
|
|
00240 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00241 RIDFLD (WSKL-KEY-AREA OF WIO-REC) DTSCU880
|
|
00242 RESP (WRK-RESP-CD) DTSCU880
|
|
00243 END-EXEC. DTSCU880
|
|
00244 DTSCU880
|
|
00245 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU880
|
|
00246 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00247 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00248 GO TO P2100-EXIT. DTSCU880
|
|
00249 DTSCU880
|
|
00250 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU880
|
|
00251 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU880
|
|
00252 GO TO P2100-EXIT. DTSCU880
|
|
00253 DTSCU880
|
|
00254 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00255 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU880
|
|
00256 ELSE DTSCU880
|
|
00257 GO TO S899-ABEND. DTSCU880
|
|
00258 P2100-EXIT. DTSCU880
|
|
00259 EXIT. DTSCU880
|
|
00260 EJECT DTSCU880
|
|
00261 P2200-READ-NEXT. DTSCU880
|
|
00262 IF L880-READ-NEXT-88 DTSCU880
|
|
00263 MOVE LOW-VALUE TO WIO-REC DTSCU880
|
|
00264 MOVE WSKL-KEY-AREA OF WCOMM-REC DTSCU880
|
|
00265 TO WSKL-KEY-AREA OF WIO-REC. DTSCU880
|
|
00266 DTSCU880
|
|
00267 EXEC CICS DTSCU880
|
|
00268 READNEXT DTSCU880
|
|
00269 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00270 INTO (WIO-REC) DTSCU880
|
|
00271 LENGTH (WRK-REC-LENGTH) DTSCU880
|
|
00272 RIDFLD (WSKL-KEY-AREA OF WIO-REC) DTSCU880
|
|
00273 RESP (WRK-RESP-CD) DTSCU880
|
|
00274 END-EXEC. DTSCU880
|
|
00275 DTSCU880
|
|
00276 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU880
|
|
00277 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00278 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00279 GO TO P2200-EXIT. DTSCU880
|
|
00280 DTSCU880
|
|
00281 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU880
|
|
00282 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU880
|
|
00283 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU880
|
|
00284 GO TO P2200-EXIT. DTSCU880
|
|
00285 DTSCU880
|
|
00286 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00287 NEXT SENTENCE DTSCU880
|
|
00288 ELSE DTSCU880
|
|
00289 GO TO S899-ABEND. DTSCU880
|
|
00290 DTSCU880
|
|
00291 MOVE WIO-REC TO WCOMM-REC. DTSCU880
|
|
00292 P2200-EXIT. DTSCU880
|
|
00293 EXIT. DTSCU880
|
|
00294 EJECT DTSCU880
|
|
00295 P2300-READ-PREV. DTSCU880
|
|
00296 MOVE LOW-VALUE TO WIO-REC. DTSCU880
|
|
00297 DTSCU880
|
|
00298 MOVE WSKL-KEY-AREA OF WCOMM-REC DTSCU880
|
|
00299 TO WSKL-KEY-AREA OF WIO-REC. DTSCU880
|
|
00300 DTSCU880
|
|
00301 EXEC CICS DTSCU880
|
|
00302 READPREV DTSCU880
|
|
00303 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00304 INTO (WIO-REC) DTSCU880
|
|
00305 LENGTH (WRK-REC-LENGTH) DTSCU880
|
|
00306 RIDFLD (WSKL-KEY-AREA OF WIO-REC) DTSCU880
|
|
00307 RESP (WRK-RESP-CD) DTSCU880
|
|
00308 END-EXEC. DTSCU880
|
|
00309 DTSCU880
|
|
00310 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU880
|
|
00311 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00312 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00313 GO TO P2300-EXIT. DTSCU880
|
|
00314 DTSCU880
|
|
00315 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU880
|
|
00316 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU880
|
|
00317 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU880
|
|
00318 GO TO P2300-EXIT. DTSCU880
|
|
00319 DTSCU880
|
|
00320 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00321 NEXT SENTENCE DTSCU880
|
|
00322 ELSE DTSCU880
|
|
00323 GO TO S899-ABEND. DTSCU880
|
|
00324 DTSCU880
|
|
00325 MOVE WIO-REC TO WCOMM-REC. DTSCU880
|
|
00326 P2300-EXIT. DTSCU880
|
|
00327 EXIT. DTSCU880
|
|
00328 EJECT DTSCU880
|
|
00329 P2400-END-BROWSE. DTSCU880
|
|
00330 DTSCU880
|
|
00331 EXEC CICS DTSCU880
|
|
00332 ENDBR DTSCU880
|
|
00333 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00334 RESP (WRK-RESP-CD) DTSCU880
|
|
00335 END-EXEC. DTSCU880
|
|
00336 DTSCU880
|
|
00337 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU880
|
|
00338 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00339 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00340 GO TO P2400-EXIT. DTSCU880
|
|
00341 DTSCU880
|
|
00342 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU880
|
|
00343 NEXT SENTENCE DTSCU880
|
|
00344 ELSE DTSCU880
|
|
00345 GO TO S899-ABEND. DTSCU880
|
|
00346 P2400-EXIT. DTSCU880
|
|
00347 EXIT. DTSCU880
|
|
00348 EJECT DTSCU880
|
|
00349 P3100-WRITE. DTSCU880
|
|
00350 MOVE WCOMM-REC TO WIO-REC. DTSCU880
|
|
00351 DTSCU880
|
|
00352 EXEC CICS DTSCU880
|
|
00353 WRITE DTSCU880
|
|
00354 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00355 FROM (WIO-REC) DTSCU880
|
|
00356 LENGTH (WRK-REC-LENGTH) DTSCU880
|
|
00357 RIDFLD (WSKL-KEY-AREA OF WIO-REC) DTSCU880
|
|
00358 RESP (WRK-RESP-CD) DTSCU880
|
|
00359 END-EXEC. DTSCU880
|
|
00360 DTSCU880
|
|
00361 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU880
|
|
00362 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00363 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00364 GO TO P3100-EXIT. DTSCU880
|
|
00365 DTSCU880
|
|
00366 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00367 NEXT SENTENCE DTSCU880
|
|
00368 ELSE DTSCU880
|
|
00369 GO TO S899-ABEND. DTSCU880
|
|
00370 P3100-EXIT. DTSCU880
|
|
00371 EXIT. DTSCU880
|
|
00372 EJECT DTSCU880
|
|
00373 P3200-REWRITE. DTSCU880
|
|
00374 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU880
|
|
00375 DTSCU880
|
|
00376 IF L880-NO-REC-88 DTSCU880
|
|
00377 GO TO S899-ABEND DTSCU880
|
|
00378 ELSE DTSCU880
|
|
00379 IF L880-FILE-CLOSED-88 DTSCU880
|
|
00380 GO TO P3200-EXIT. DTSCU880
|
|
00381 DTSCU880
|
|
00382 MOVE WCOMM-REC TO WIO-REC. DTSCU880
|
|
00383 DTSCU880
|
|
00384 EXEC CICS DTSCU880
|
|
00385 REWRITE DTSCU880
|
|
00386 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00387 FROM (WIO-REC) DTSCU880
|
|
00388 LENGTH (WRK-REC-LENGTH) DTSCU880
|
|
00389 RESP (WRK-RESP-CD) DTSCU880
|
|
00390 END-EXEC. DTSCU880
|
|
00391 DTSCU880
|
|
00392 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU880
|
|
00393 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00394 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00395 GO TO P3200-EXIT. DTSCU880
|
|
00396 DTSCU880
|
|
00397 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00398 NEXT SENTENCE DTSCU880
|
|
00399 ELSE DTSCU880
|
|
00400 GO TO S899-ABEND. DTSCU880
|
|
00401 P3200-EXIT. DTSCU880
|
|
00402 EXIT. DTSCU880
|
|
00403 EJECT DTSCU880
|
|
00404 P3300-DELETE. DTSCU880
|
|
00405 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU880
|
|
00406 DTSCU880
|
|
00407 IF L880-NO-REC-88 DTSCU880
|
|
00408 GO TO S899-ABEND DTSCU880
|
|
00409 ELSE DTSCU880
|
|
00410 IF L880-FILE-CLOSED-88 DTSCU880
|
|
00411 GO TO P3300-EXIT. DTSCU880
|
|
00412 DTSCU880
|
|
00413 EXEC CICS DTSCU880
|
|
00414 DELETE DTSCU880
|
|
00415 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00416 RESP (WRK-RESP-CD) DTSCU880
|
|
00417 END-EXEC. DTSCU880
|
|
00418 DTSCU880
|
|
00419 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU880
|
|
00420 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00421 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00422 GO TO P3300-EXIT. DTSCU880
|
|
00423 DTSCU880
|
|
00424 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00425 NEXT SENTENCE DTSCU880
|
|
00426 ELSE DTSCU880
|
|
00427 GO TO S899-ABEND. DTSCU880
|
|
00428 P3300-EXIT. DTSCU880
|
|
00429 EXIT. DTSCU880
|
|
00430 EJECT DTSCU880
|
|
00431 S1100-NOT-AVAILABLE. DTSCU880
|
|
00432 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU880
|
|
00433 DTSCU880
|
|
00434 MOVE EMSG-NOT-AVAILABLE TO L880-MSG-AREA. DTSCU880
|
|
00435 DTSCU880
|
|
00436 SET L880-FILE-CLOSED-88 TO TRUE. DTSCU880
|
|
00437 S1100-EXIT. DTSCU880
|
|
00438 EXIT. DTSCU880
|
|
00439 SKIP3 DTSCU880
|
|
00440 S1200-NOT-FOUND. DTSCU880
|
|
00441 SET L880-NO-REC-88 TO TRUE. DTSCU880
|
|
00442 S1200-EXIT. DTSCU880
|
|
00443 EXIT. DTSCU880
|
|
00444 EJECT DTSCU880
|
|
00445 S3100-READ-UPDATE. DTSCU880
|
|
00446 MOVE LOW-VALUE TO WIO-REC. DTSCU880
|
|
00447 DTSCU880
|
|
00448 MOVE WSKL-KEY-AREA OF WCOMM-REC TO WSKL-KEY-AREA OF WIO-REC. DTSCU880
|
|
00449 DTSCU880
|
|
00450 EXEC CICS DTSCU880
|
|
00451 READ DTSCU880
|
|
00452 DATASET (WRK-FILE-NAME) DTSCU880
|
|
00453 INTO (WIO-REC) DTSCU880
|
|
00454 LENGTH (WRK-REC-LENGTH) DTSCU880
|
|
00455 RIDFLD (WSKL-KEY-AREA OF WIO-REC) DTSCU880
|
|
00456 UPDATE DTSCU880
|
|
00457 RESP (WRK-RESP-CD) DTSCU880
|
|
00458 END-EXEC. DTSCU880
|
|
00459 DTSCU880
|
|
00460 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU880
|
|
00461 OR DFHRESP (SYSIDERR) DTSCU880
|
|
00462 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU880
|
|
00463 GO TO S3100-EXIT. DTSCU880
|
|
00464 DTSCU880
|
|
00465 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU880
|
|
00466 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU880
|
|
00467 GO TO S3100-EXIT. DTSCU880
|
|
00468 DTSCU880
|
|
00469 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU880
|
|
00470 NEXT SENTENCE DTSCU880
|
|
00471 ELSE DTSCU880
|
|
00472 GO TO S899-ABEND. DTSCU880
|
|
00473 S3100-EXIT. DTSCU880
|
|
00474 EXIT. DTSCU880
|
|
00475 EJECT DTSCU880
|
|
00476 S899-ABEND. DTSCU880
|
|
00477 EXEC CICS DTSCU880
|
|
00478 ABEND DTSCU880
|
|
00479 ABCODE (WRK-ABEND-CD) DTSCU880
|
|
00480 END-EXEC. DTSCU880
|
|
00481 S899-EXIT. DTSCU880
|
|
00482 EXIT. DTSCU880
|