MP Batchs, copybooks, jcls, Procs
This commit is contained in:
266
Batch/DTSBX801.cob
Normal file
266
Batch/DTSBX801.cob
Normal file
@ -0,0 +1,266 @@
|
||||
00001 IDENTIFICATION DIVISION. 06/17/13
|
||||
00002 PROGRAM-ID. DTSBX801. DTSBX801
|
||||
00003 AUTHOR. NGC. LV022
|
||||
00004 DATE-WRITTEN. JANUARY 2008. CL**6
|
||||
00005 DATE-COMPILED. DTSBX801
|
||||
00006 SKIP3 DTSBX801
|
||||
00007 ***** DTSBX801
|
||||
00008 * DTSBX801
|
||||
00009 * FUNCTION: BUILD PREDECESSOR/SUCCESSOR FILE FOR SDDS CL*15
|
||||
00010 * DTSBX801
|
||||
00011 ***** DTSBX801
|
||||
00012 SKIP3 DTSBX801
|
||||
00013 ENVIRONMENT DIVISION. DTSBX801
|
||||
00014 SKIP2 DTSBX801
|
||||
00015 INPUT-OUTPUT SECTION. DTSBX801
|
||||
00016 DTSBX801
|
||||
00017 FILE-CONTROL. DTSBX801
|
||||
00018 SELECT PRED-FILE ASSIGN TO DTSFPRED CL*15
|
||||
00019 FILE STATUS IS PRED-STATUS. CL*15
|
||||
00020 DTSBX801
|
||||
00021 DATA DIVISION. DTSBX801
|
||||
00022 DTSBX801
|
||||
00023 FILE SECTION. DTSBX801
|
||||
00024 FD PRED-FILE CL*15
|
||||
00025 RECORDING MODE IS F DTSBX801
|
||||
00026 BLOCK CONTAINS 0 RECORDS DTSBX801
|
||||
00027 LABEL RECORDS ARE OMITTED. DTSBX801
|
||||
00028 DTSBX801
|
||||
00029 01 PRED-FILE-REC PIC X(22). CL*15
|
||||
00030 DTSBX801
|
||||
00031 DTSBX801
|
||||
00032 WORKING-STORAGE SECTION. DTSBX801
|
||||
000325 77 PAN-VALET PICTURE X(24) VALUE '022DTSBX801 06/17/13'. DTSBX801
|
||||
00033 SKIP3 DTSBX801
|
||||
00034 01 WRK-AREA. DTSBX801
|
||||
00035 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +801. CL**6
|
||||
00036 DTSBX801
|
||||
00037 05 W-PRED-CNT PIC S9(07) COMP-3 VALUE +0. CL*15
|
||||
00038 DTSBX801
|
||||
00039 05 W-ERROR-IND PIC X(01). CL**6
|
||||
00040 88 W-ERROR-YES-88 VALUE 'Y'. CL**6
|
||||
00041 88 W-ERROR-NO-88 VALUE 'N'. CL**6
|
||||
00042 DTSBX801
|
||||
00043 05 W-SUCCESSOR-IND PIC X(01). CL**6
|
||||
00044 88 W-SUCCESSOR-NO-88 VALUE '0'. CL**6
|
||||
00045 88 W-SUCCESSOR-YES-88 VALUE '1'. CL**6
|
||||
00046 88 W-PARTIAL-XFER-88 VALUE '2'. CL**8
|
||||
00047 CL**6
|
||||
00048 05 PRED-STATUS PIC X(02). CL*15
|
||||
00049 88 PRED-STATUS-OK-88 VALUE '00'. CL*15
|
||||
00050 88 PRED-STATUS-EOF-88 VALUE '10'. CL*15
|
||||
00051 DTSBX801
|
||||
00052 05 W-PRED-RECORD. CL*16
|
||||
00053 10 W-STATE-CODE PIC X(02) VALUE '11'. CL*18
|
||||
00054 10 W-PRED-UI-ACCT. CL*18
|
||||
00055 15 FILLER PIC X(04) VALUE '0000'. CL*18
|
||||
00056 15 W-PRED-ACCT-NO PIC 9(06). CL*18
|
||||
00057 10 W-SUCC-UI-ACCT. CL*18
|
||||
00058 15 FILLER PIC X(04) VALUE '0000'. CL*18
|
||||
00059 15 W-SUCC-ACCT-NO PIC 9(06). CL*18
|
||||
00060 CL*16
|
||||
00061 01 L910-LINK-AREA. CL*19
|
||||
00062 ++INCLUDE DTSIL910 CL*19
|
||||
00063 CL*16
|
||||
00064 01 MSKL-REC. CL*19
|
||||
00065 ++INCLUDE DTSIMSKL CL*19
|
||||
00066 CL*16
|
||||
00067 01 MPRF-REC. CL*19
|
||||
00068 ++INCLUDE DTSIMPRF CL*19
|
||||
00069 DTSBX801
|
||||
00070 01 L921-LINK-AREA. CL*19
|
||||
00071 ++INCLUDE DTSIL921 CL*19
|
||||
00072 CL*19
|
||||
00073 01 ISKL-REC. CL*19
|
||||
00074 ++INCLUDE DTSIISKL CL*19
|
||||
00075 CL*19
|
||||
00076 01 IPES-REC. CL*19
|
||||
00077 ++INCLUDE DTSIIPES CL*19
|
||||
00078 CL*19
|
||||
00079 PROCEDURE DIVISION. CL*15
|
||||
00080 CL*12
|
||||
00081 DTSBX801-MAIN. CL**6
|
||||
00082 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX801
|
||||
00083 IF W-ERROR-YES-88 CL**6
|
||||
00084 GO TO DTSBX801-MAIN-EXIT. CL**6
|
||||
00085 DTSBX801
|
||||
00086 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX801
|
||||
00087 DTSBX801
|
||||
00088 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX801
|
||||
00089 DTSBX801
|
||||
00090 DTSBX801-MAIN-EXIT. CL**6
|
||||
00091 GOBACK. DTSBX801
|
||||
00092 EJECT DTSBX801
|
||||
00093 I0000-INITIATE. DTSBX801
|
||||
00094 DTSBX801
|
||||
00095 SET W-ERROR-NO-88 TO TRUE. CL**6
|
||||
00096 DTSBX801
|
||||
00097 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBX801
|
||||
00098 IF W-ERROR-YES-88 CL**6
|
||||
00099 GO TO I0000-EXIT. DTSBX801
|
||||
00100 DTSBX801
|
||||
00101 I0000-EXIT. DTSBX801
|
||||
00102 EXIT. DTSBX801
|
||||
00103 I1000-OPEN-FILES. DTSBX801
|
||||
00104 OPEN OUTPUT PRED-FILE. CL*16
|
||||
00105 IF NOT PRED-STATUS-OK-88 CL*15
|
||||
00106 DISPLAY 'CANNOT OPEN PREDECESSOR FILE ' PRED-STATUS CL*16
|
||||
00107 SET W-ERROR-YES-88 TO TRUE CL**6
|
||||
00108 GO TO I1000-EXIT DTSBX801
|
||||
00109 END-IF. DTSBX801
|
||||
00110 DTSBX801
|
||||
00111 PERFORM S910A-OPEN-READ THRU S910A-EXIT. CL*22
|
||||
00112 PERFORM S921A-OPEN-READ THRU S921A-EXIT. CL*22
|
||||
00113 CL*16
|
||||
00114 I1000-EXIT. DTSBX801
|
||||
00115 EXIT. DTSBX801
|
||||
00116 DTSBX801
|
||||
00117 P0000-PROCESS. DTSBX801
|
||||
00118 MOVE LOW-VALUES TO IPES-KEY-AREA. CL*16
|
||||
00119 SET IPES-PES-88 TO TRUE. CL*16
|
||||
00120 MOVE IPES-KEY-AREA TO ISKL-KEY-AREA. CL*16
|
||||
00121 PERFORM S921B-START-BROWSE THRU S921B-EXIT. CL*16
|
||||
00122 CL*16
|
||||
00123 PERFORM UNTIL L921-NO-REC-88 CL*16
|
||||
00124 MOVE ISKL-REC TO IPES-REC CL*16
|
||||
00125 IF IPES-EXP-TRNSF-YES-88 CL*16
|
||||
00126 PERFORM P1000-BUILD-OUTPUT THRU P1000-EXIT CL*16
|
||||
00127 END-IF CL*16
|
||||
00128 PERFORM S921D-READ-NEXT THRU S921D-EXIT CL*16
|
||||
00129 END-PERFORM. CL*16
|
||||
00130 CL*16
|
||||
00131 P0000-EXIT. DTSBX801
|
||||
00132 EXIT. DTSBX801
|
||||
00133 DTSBX801
|
||||
00134 DTSBX801
|
||||
00135 P1000-BUILD-OUTPUT. CL*16
|
||||
00136 SET W-ERROR-NO-88 TO TRUE. CL*20
|
||||
00137 CL*20
|
||||
00138 PERFORM P1100-CHECK-MPRF THRU P1100-EXIT. CL*20
|
||||
00139 IF W-ERROR-NO-88 CL*20
|
||||
00140 PERFORM P1200-WRITE THRU P1200-EXIT CL*20
|
||||
00141 END-IF. CL*20
|
||||
00142 P1000-EXIT. DTSBX801
|
||||
00143 EXIT. DTSBX801
|
||||
00144 DTSBX801
|
||||
00145 P1100-CHECK-MPRF. CL*20
|
||||
00146 PERFORM P1110-PREDECESSOR THRU P1110-EXIT. CL*20
|
||||
00147 IF W-ERROR-NO-88 CL*20
|
||||
00148 PERFORM P1120-SUCCESSOR THRU P1120-EXIT CL*20
|
||||
00149 END-IF. CL*20
|
||||
00150 CL*20
|
||||
00151 P1100-EXIT. CL*20
|
||||
00152 EXIT. CL*20
|
||||
00153 CL*20
|
||||
00154 P1110-PREDECESSOR. CL*20
|
||||
00155 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*20
|
||||
00156 MOVE IPES-PRED-EMP-NO TO MSKL-EMP-NO. CL*20
|
||||
00157 SET MSKL-PRF-88 TO TRUE. CL*20
|
||||
00158 PERFORM S910B-READ THRU S910B-EXIT. CL*21
|
||||
00159 IF L910-NO-REC-88 CL*20
|
||||
00160 SET W-ERROR-YES-88 TO TRUE CL*20
|
||||
00161 END-IF. CL*20
|
||||
00162 CL*20
|
||||
00163 P1110-EXIT. CL*20
|
||||
00164 EXIT. CL*20
|
||||
00165 CL*20
|
||||
00166 P1120-SUCCESSOR. CL*21
|
||||
00167 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*20
|
||||
00168 MOVE IPES-SUC-EMP-NO TO MSKL-EMP-NO. CL*20
|
||||
00169 SET MSKL-PRF-88 TO TRUE. CL*20
|
||||
00170 PERFORM S910B-READ THRU S910B-EXIT. CL*21
|
||||
00171 IF L910-NO-REC-88 CL*20
|
||||
00172 SET W-ERROR-YES-88 TO TRUE CL*20
|
||||
00173 END-IF. CL*20
|
||||
00174 CL*20
|
||||
00175 P1120-EXIT. CL*20
|
||||
00176 EXIT. CL*20
|
||||
00177 CL*20
|
||||
00178 P1200-WRITE. CL*20
|
||||
00179 MOVE IPES-PRED-EMP-NO TO W-PRED-ACCT-NO. CL*20
|
||||
00180 MOVE IPES-SUC-EMP-NO TO W-SUCC-ACCT-NO. CL*20
|
||||
00181 CL*20
|
||||
00182 WRITE PRED-FILE-REC FROM W-PRED-RECORD. CL*20
|
||||
00183 IF PRED-STATUS-OK-88 CL*20
|
||||
00184 ADD +1 TO W-PRED-CNT CL*20
|
||||
00185 ELSE CL*20
|
||||
00186 DISPLAY 'CANNOT WRITE PRED RECORD ' PRED-STATUS CL*20
|
||||
00187 END-IF. CL*20
|
||||
00188 CL*20
|
||||
00189 P1200-EXIT. CL*20
|
||||
00190 EXIT. CL*20
|
||||
00191 CL*20
|
||||
00192 T0000-TERMINATE. DTSBX801
|
||||
00193 DTSBX801
|
||||
00194 DISPLAY ' '. DTSBX801
|
||||
00195 DTSBX801
|
||||
00196 DISPLAY '*** DTSBX801 TERMINATION STATISTICS ***'. CL**7
|
||||
00197 DTSBX801
|
||||
00198 DISPLAY ' '. DTSBX801
|
||||
00199 DTSBX801
|
||||
00200 DISPLAY 'RECORDS WRITTEN : ' CL*16
|
||||
00201 W-PRED-CNT. CL*16
|
||||
00202 DTSBX801
|
||||
00203 DTSBX801
|
||||
00204 CLOSE PRED-FILE. CL*16
|
||||
00205 PERFORM S910C-CLOSE THRU S910C-EXIT. CL*22
|
||||
00206 PERFORM S921C-CLOSE THRU S921C-EXIT. CL*22
|
||||
00207 DTSBX801
|
||||
00208 T0000-EXIT. DTSBX801
|
||||
00209 EXIT. DTSBX801
|
||||
00210 CL*19
|
||||
00211 S910A-OPEN-READ. CL*19
|
||||
00212 SET L910-OPEN-READ-88 TO TRUE. CL*19
|
||||
00213 CALL 'DTSBU910' USING L910-LINK-AREA CL*19
|
||||
00214 MSKL-REC. CL*19
|
||||
00215 S910A-EXIT. CL*19
|
||||
00216 EXIT. CL*19
|
||||
00217 CL*19
|
||||
00218 S910B-READ. CL*19
|
||||
00219 SET L910-READ-88 TO TRUE. CL*19
|
||||
00220 CALL 'DTSBU910' USING L910-LINK-AREA CL*19
|
||||
00221 MSKL-REC. CL*19
|
||||
00222 S910B-EXIT. CL*19
|
||||
00223 EXIT. CL*19
|
||||
00224 CL*19
|
||||
00225 S910C-CLOSE. CL*19
|
||||
00226 SET L910-CLOSE-88 TO TRUE. CL*19
|
||||
00227 CALL 'DTSBU910' USING L910-LINK-AREA CL*19
|
||||
00228 MSKL-REC. CL*19
|
||||
00229 S910C-EXIT. CL*19
|
||||
00230 EXIT. CL*19
|
||||
00231 CL*19
|
||||
00232 CL*16
|
||||
00233 S921A-OPEN-READ. CL*16
|
||||
00234 SET L921-OPEN-READ-88 TO TRUE. CL*16
|
||||
00235 CALL 'DTSBU921' USING L921-LINK-AREA CL*16
|
||||
00236 ISKL-REC. CL*16
|
||||
00237 S921A-EXIT. CL*16
|
||||
00238 EXIT. CL*16
|
||||
00239 CL*16
|
||||
00240 S921B-START-BROWSE. CL*16
|
||||
00241 SET L921-START-BROWSE-88 TO TRUE. CL*16
|
||||
00242 CALL 'DTSBU921' USING L921-LINK-AREA CL*16
|
||||
00243 ISKL-REC. CL*16
|
||||
00244 S921B-EXIT. CL*16
|
||||
00245 EXIT. CL*16
|
||||
00246 CL*16
|
||||
00247 S921C-CLOSE. CL*16
|
||||
00248 SET L921-CLOSE-88 TO TRUE. CL*16
|
||||
00249 CALL 'DTSBU921' USING L921-LINK-AREA CL*16
|
||||
00250 ISKL-REC. CL*16
|
||||
00251 S921C-EXIT. CL*16
|
||||
00252 EXIT. CL*16
|
||||
00253 CL*16
|
||||
00254 S921D-READ-NEXT. CL*16
|
||||
00255 SET L921-READ-NEXT-88 TO TRUE. CL*16
|
||||
00256 CALL 'DTSBU921' USING L921-LINK-AREA CL*16
|
||||
00257 ISKL-REC. CL*16
|
||||
00258 S921D-EXIT. CL*16
|
||||
00259 EXIT. CL*16
|
||||
00260 DTSBX801
|
||||
00261 S999-ABEND. DTSBX801
|
||||
00262 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX801
|
||||
00263 S999-EXIT. DTSBX801
|
||||
00264 EXIT. DTSBX801
|
||||
00265 DTSBX801
|
||||
Reference in New Issue
Block a user