DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
188
Batch/DESBD110.cob
Normal file
188
Batch/DESBD110.cob
Normal file
@ -0,0 +1,188 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/28/02
|
||||
00002 PROGRAM-ID. DESBD110. DESBD110
|
||||
00003 AUTHOR. TRW. LV003
|
||||
00004 DATE-WRITTEN. MARCH 2001. DESBD110
|
||||
00005 DATE-COMPILED. DESBD110
|
||||
00006 SKIP3 DESBD110
|
||||
00007 ***** DESBD110
|
||||
00008 * DESBD110
|
||||
00009 * FUNCTION: SCAN OLA FILE TO FIND LOG NUMBERS OF ITEMS DESBD110
|
||||
00010 * SELECTED FOR UPDATE. CALL DESBD111 TO PROCESS DESBD110
|
||||
00011 * ELECTRONIC MEDIA RECORDS, AND DESBD112 TO DESBD110
|
||||
00012 * PROCESS W4 TRANSACTIONS. DESBD110
|
||||
00013 * ELECTRONIC MEDIA TRACKING SYSTEM DESBD110
|
||||
00014 * DESBD110
|
||||
00015 * DESBD110
|
||||
00016 ***** DESBD110
|
||||
00017 SKIP3 DESBD110
|
||||
00018 ENVIRONMENT DIVISION. DESBD110
|
||||
00019 DATA DIVISION. DESBD110
|
||||
00020 DESBD110
|
||||
00021 WORKING-STORAGE SECTION. DESBD110
|
||||
000215 77 PAN-VALET PICTURE X(24) VALUE '003DESBD110 08/28/02'. DESBD110
|
||||
00022 SKIP3 DESBD110
|
||||
00023 01 WRK-AREA. DESBD110
|
||||
00024 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +110. DESBD110
|
||||
00025 DESBD110
|
||||
00026 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD110'. DESBD110
|
||||
00027 DESBD110
|
||||
00028 05 LOG-SUB PIC S9(04) VALUE +0. DESBD110
|
||||
00029 DESBD110
|
||||
00030 05 WRK-TRG-CNT PIC 9(05) COMP-3 VALUE 0. DESBD110
|
||||
00031 05 WRK-CNT-DISP PIC Z(04)9. DESBD110
|
||||
00032 DESBD110
|
||||
00033 05 WRK-ERROR-IND PIC X(01). DESBD110
|
||||
00034 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD110
|
||||
00035 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD110
|
||||
00036 DESBD110
|
||||
00037 05 WRK-OLA-FOUND-IND PIC X(01). DESBD110
|
||||
00038 88 WRK-OLA-FOUND-YES-88 VALUE 'Y'. DESBD110
|
||||
00039 88 WRK-OLA-FOUND-NO-88 VALUE 'N'. DESBD110
|
||||
00040 DESBD110
|
||||
00041 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DESBD110
|
||||
00042 DESBD110
|
||||
00043 01 LOG-TABLE-AREA. DESBD110
|
||||
00044 ++INCLUDE DESIL110 DESBD110
|
||||
00045 DESBD110
|
||||
00046 01 RSK3-REC. DESBD110
|
||||
00047 ++INCLUDE DTSIRSK3 DESBD110
|
||||
00048 EJECT DESBD110
|
||||
00049 01 T061-REC. DESBD110
|
||||
00050 ++INCLUDE DTSIT061 DESBD110
|
||||
00051 EJECT DESBD110
|
||||
00052 01 L924-LINK-AREA. DESBD110
|
||||
00053 ++INCLUDE DTSIL924 DESBD110
|
||||
00054 EJECT DESBD110
|
||||
00055 DESBD110
|
||||
00056 PROCEDURE DIVISION. DESBD110
|
||||
00057 DESBD110
|
||||
00058 DESBD110-MAIN. DESBD110
|
||||
00059 PERFORM I0000-INITIATE THRU I0000-EXIT. DESBD110
|
||||
00060 IF WRK-ERROR-YES-88 DESBD110
|
||||
00061 GO TO DESBD110-MAIN-EXIT. DESBD110
|
||||
00062 DESBD110
|
||||
00063 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD110
|
||||
00064 DESBD110
|
||||
00065 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD110
|
||||
00066 DESBD110
|
||||
00067 DESBD110-MAIN-EXIT. DESBD110
|
||||
00068 GOBACK. DESBD110
|
||||
00069 EJECT DESBD110
|
||||
00070 I0000-INITIATE. DESBD110
|
||||
00071 SET WRK-ERROR-NO-88 TO TRUE. DESBD110
|
||||
00072 SET WRK-OLA-FOUND-NO-88 TO TRUE. DESBD110
|
||||
00073 DESBD110
|
||||
00074 MOVE +0 TO L110-LOG-CNT. DESBD110
|
||||
00075 MOVE +500 TO L110-LOG-MAX. DESBD110
|
||||
00076 DESBD110
|
||||
00077 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD110
|
||||
00078 IF WRK-ERROR-YES-88 DESBD110
|
||||
00079 GO TO I0000-EXIT. DESBD110
|
||||
00080 DESBD110
|
||||
00081 PERFORM I2000-TABLE-OLA THRU I2000-EXIT. DESBD110
|
||||
00082 DESBD110
|
||||
00083 I0000-EXIT. DESBD110
|
||||
00084 EXIT. DESBD110
|
||||
00085 DESBD110
|
||||
00086 I1000-OPEN-FILES. DESBD110
|
||||
00087 MOVE WRK-TRACE-IND TO L924-TRACE-IND. DESBD110
|
||||
00088 DESBD110
|
||||
00089 MOVE WRK-MOD-NAME TO L924-MOD-NAME. DESBD110
|
||||
00090 DESBD110
|
||||
00091 SET L924-OPEN-READ-88 TO TRUE. DESBD110
|
||||
00092 DESBD110
|
||||
00093 PERFORM S924-OLA-I THRU S924-EXIT. DESBD110
|
||||
00094 DESBD110
|
||||
00095 I1000-EXIT. DESBD110
|
||||
00096 EXIT. DESBD110
|
||||
00097 DESBD110
|
||||
00098 I2000-TABLE-OLA. DESBD110
|
||||
00099 SET L924-READ-NEXT-88 TO TRUE. DESBD110
|
||||
00100 DESBD110
|
||||
00101 PERFORM S924-OLA-I THRU S924-EXIT. DESBD110
|
||||
00102 DESBD110
|
||||
00103 IF L924-OK-88 DESBD110
|
||||
00104 SET WRK-OLA-FOUND-YES-88 TO TRUE DESBD110
|
||||
00105 PERFORM I2100-SCAN-OLA THRU I2100-EXIT DESBD110
|
||||
00106 UNTIL L924-NO-REC-88 DESBD110
|
||||
00107 ELSE DESBD110
|
||||
00108 DISPLAY 'NO OLA REC' DESBD110
|
||||
00109 END-IF. DESBD110
|
||||
00110 DESBD110
|
||||
00111 I2000-EXIT. DESBD110
|
||||
00112 EXIT. DESBD110
|
||||
00113 DESBD110
|
||||
00114 I2100-SCAN-OLA. DESBD110
|
||||
00115 ADD +1 TO WRK-TRG-CNT. DESBD110
|
||||
00116 DESBD110
|
||||
00117 IF RSK3-REC-TYPE = '061' DESBD110
|
||||
00118 PERFORM S947-O THRU S947-EXIT DESBD110
|
||||
00119 MOVE RSK3-REC TO T061-REC DESBD110
|
||||
00120 IF LOG-SUB < L110-LOG-MAX DESBD110
|
||||
00121 ADD +1 TO LOG-SUB DESBD110
|
||||
00122 MOVE LOG-SUB TO L110-LOG-CNT DESBD110
|
||||
00123 MOVE T061-LOG-NO TO L110-LOG-NO (LOG-SUB). DESBD110
|
||||
00124 DESBD110
|
||||
00125 PERFORM S924-OLA-I THRU S924-EXIT. DESBD110
|
||||
00126 DESBD110
|
||||
00127 I2100-EXIT. DESBD110
|
||||
00128 EXIT. DESBD110
|
||||
00129 DESBD110
|
||||
00130 EJECT DESBD110
|
||||
00131 P0000-PROCESS. DESBD110
|
||||
00132 PERFORM P1000-CALL-DESBD111 THRU P1000-EXIT. DESBD110
|
||||
00133 DESBD110
|
||||
00134 PERFORM P2000-CALL-DESBD112 THRU P2000-EXIT. DESBD110
|
||||
00135 DESBD110
|
||||
00136 P0000-EXIT. DESBD110
|
||||
00137 EXIT. DESBD110
|
||||
00138 EJECT DESBD110
|
||||
00139 DESBD110
|
||||
00140 P1000-CALL-DESBD111. DESBD110
|
||||
00141 CALL 'DESBD111' USING LOG-TABLE-AREA. DESBD110
|
||||
00142 DESBD110
|
||||
00143 P1000-EXIT. DESBD110
|
||||
00144 EXIT. DESBD110
|
||||
00145 DESBD110
|
||||
00146 P2000-CALL-DESBD112. DESBD110
|
||||
00147 CALL 'DESBD112' USING LOG-TABLE-AREA. DESBD110
|
||||
00148 DESBD110
|
||||
00149 P2000-EXIT. DESBD110
|
||||
00150 EXIT. DESBD110
|
||||
00151 DESBD110
|
||||
00152 T0000-TERMINATE. DESBD110
|
||||
00153 DESBD110
|
||||
00154 DISPLAY ' '. DESBD110
|
||||
00155 DESBD110
|
||||
00156 DISPLAY '*** DESBD110 TERMINATION STATISTICS ***'. DESBD110
|
||||
00157 DESBD110
|
||||
00158 DISPLAY ' '. DESBD110
|
||||
00159 DESBD110
|
||||
00160 MOVE WRK-TRG-CNT TO WRK-CNT-DISP. DESBD110
|
||||
00161 DISPLAY ' TRIGGER RECORDS READ: ' DESBD110
|
||||
00162 WRK-CNT-DISP. DESBD110
|
||||
00163 DESBD110
|
||||
00164 MOVE L110-LOG-CNT TO WRK-CNT-DISP. DESBD110
|
||||
00165 DISPLAY ' TRIGGER RECORDS SELECTED: ' DESBD110
|
||||
00166 WRK-CNT-DISP. DESBD110
|
||||
00167 DESBD110
|
||||
00168 DISPLAY SPACE. DESBD110
|
||||
00169 DESBD110
|
||||
00170 SET L924-CLOSE-88 TO TRUE. DESBD110
|
||||
00171 PERFORM S924-OLA-I THRU S924-EXIT. DESBD110
|
||||
00172 DESBD110
|
||||
00173 T0000-EXIT. DESBD110
|
||||
00174 EXIT. DESBD110
|
||||
00175 DESBD110
|
||||
00176 S924-OLA-I. DESBD110
|
||||
00177 CALL 'DTSBU924' USING L924-LINK-AREA DESBD110
|
||||
00178 RSK3-REC. DESBD110
|
||||
00179 DESBD110
|
||||
00180 S924-EXIT. DESBD110
|
||||
00181 EXIT. DESBD110
|
||||
00182 DESBD110
|
||||
00183 S947-O. DESBD110
|
||||
00184 CALL 'DTSBU947' USING RSK3-REC. DESBD110
|
||||
00185 DESBD110
|
||||
00186 S947-EXIT. DESBD110
|
||||
00187 EXIT. DESBD110
|
||||
Reference in New Issue
Block a user