267 lines
21 KiB
COBOL
267 lines
21 KiB
COBOL
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
|