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