DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
149
Batch/DESBD199.cob
Normal file
149
Batch/DESBD199.cob
Normal file
@ -0,0 +1,149 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/28/02
|
||||
00002 PROGRAM-ID. DESBD199. DESBD199
|
||||
00003 AUTHOR. TRW. LV001
|
||||
00004 DATE-WRITTEN. MARCH 2001. DESBD199
|
||||
00005 DATE-COMPILED. DESBD199
|
||||
00006 SKIP3 DESBD199
|
||||
00007 ***** DESBD199
|
||||
00008 * DESBD199
|
||||
00009 * FUNCTION: SAVE TAPE TRACKING OLA RECORDS. DESBD199
|
||||
00010 * ELECTRONIC MEDIA TRACKING SYSTEM DESBD199
|
||||
00011 * DESBD199
|
||||
00012 * DESBD199
|
||||
00013 ***** DESBD199
|
||||
00014 SKIP3 DESBD199
|
||||
00015 ENVIRONMENT DIVISION. DESBD199
|
||||
00016 DATA DIVISION. DESBD199
|
||||
00017 DESBD199
|
||||
00018 WORKING-STORAGE SECTION. DESBD199
|
||||
000185 77 PAN-VALET PICTURE X(24) VALUE '001DESBD199 08/28/02'. DESBD199
|
||||
00019 SKIP3 DESBD199
|
||||
00020 01 WRK-AREA. DESBD199
|
||||
00021 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +199. DESBD199
|
||||
00022 DESBD199
|
||||
00023 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD199'. DESBD199
|
||||
00024 DESBD199
|
||||
00025 05 WRK-OLA-IN-CNT PIC 9(05) COMP-3 VALUE 0. DESBD199
|
||||
00026 05 WRK-OLA-OUT-CNT PIC 9(05) COMP-3 VALUE 0. DESBD199
|
||||
00027 05 WRK-CNT-DISP PIC Z(04)9. DESBD199
|
||||
00028 DESBD199
|
||||
00029 05 WRK-ERROR-IND PIC X(01). DESBD199
|
||||
00030 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD199
|
||||
00031 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD199
|
||||
00032 DESBD199
|
||||
00033 05 WRK-OLA-FOUND-IND PIC X(01). DESBD199
|
||||
00034 88 WRK-OLA-FOUND-YES-88 VALUE 'Y'. DESBD199
|
||||
00035 88 WRK-OLA-FOUND-NO-88 VALUE 'N'. DESBD199
|
||||
00036 DESBD199
|
||||
00037 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DESBD199
|
||||
00038 DESBD199
|
||||
00039 01 RSK3-REC. DESBD199
|
||||
00040 ++INCLUDE DTSIRSK3 DESBD199
|
||||
00041 EJECT DESBD199
|
||||
00042 01 T061-REC. DESBD199
|
||||
00043 ++INCLUDE DTSIT061 DESBD199
|
||||
00044 EJECT DESBD199
|
||||
00045 01 L924-LINK-AREA. DESBD199
|
||||
00046 ++INCLUDE DTSIL924 DESBD199
|
||||
00047 EJECT DESBD199
|
||||
00048 DESBD199
|
||||
00049 PROCEDURE DIVISION. DESBD199
|
||||
00050 DESBD199
|
||||
00051 DESBD199-MAIN. DESBD199
|
||||
00052 PERFORM I0000-INITIATE THRU I0000-EXIT. DESBD199
|
||||
00053 IF WRK-ERROR-YES-88 DESBD199
|
||||
00054 GO TO DESBD199-MAIN-EXIT. DESBD199
|
||||
00055 DESBD199
|
||||
00056 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD199
|
||||
00057 DESBD199
|
||||
00058 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD199
|
||||
00059 DESBD199
|
||||
00060 DESBD199-MAIN-EXIT. DESBD199
|
||||
00061 GOBACK. DESBD199
|
||||
00062 EJECT DESBD199
|
||||
00063 I0000-INITIATE. DESBD199
|
||||
00064 SET WRK-ERROR-NO-88 TO TRUE. DESBD199
|
||||
00065 SET WRK-OLA-FOUND-NO-88 TO TRUE. DESBD199
|
||||
00066 DESBD199
|
||||
00067 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD199
|
||||
00068 IF WRK-ERROR-YES-88 DESBD199
|
||||
00069 GO TO I0000-EXIT. DESBD199
|
||||
00070 DESBD199
|
||||
00071 I0000-EXIT. DESBD199
|
||||
00072 EXIT. DESBD199
|
||||
00073 DESBD199
|
||||
00074 I1000-OPEN-FILES. DESBD199
|
||||
00075 MOVE WRK-TRACE-IND TO L924-TRACE-IND. DESBD199
|
||||
00076 DESBD199
|
||||
00077 MOVE WRK-MOD-NAME TO L924-MOD-NAME. DESBD199
|
||||
00078 DESBD199
|
||||
00079 SET L924-OPEN-READ-88 TO TRUE. DESBD199
|
||||
00080 DESBD199
|
||||
00081 PERFORM S924-OLA-I THRU S924-EXIT. DESBD199
|
||||
00082 DESBD199
|
||||
00083 I1000-EXIT. DESBD199
|
||||
00084 EXIT. DESBD199
|
||||
00085 DESBD199
|
||||
00086 EJECT DESBD199
|
||||
00087 P0000-PROCESS. DESBD199
|
||||
00088 SET L924-READ-NEXT-88 TO TRUE. DESBD199
|
||||
00089 DESBD199
|
||||
00090 PERFORM S924-OLA-I THRU S924-EXIT. DESBD199
|
||||
00091 DESBD199
|
||||
00092 IF L924-OK-88 DESBD199
|
||||
00093 SET WRK-OLA-FOUND-YES-88 TO TRUE DESBD199
|
||||
00094 PERFORM P1000-SCAN-OLA THRU P1000-EXIT DESBD199
|
||||
00095 UNTIL L924-NO-REC-88 DESBD199
|
||||
00096 ELSE DESBD199
|
||||
00097 DISPLAY 'NO OLA REC' DESBD199
|
||||
00098 END-IF. DESBD199
|
||||
00099 DESBD199
|
||||
00100 P0000-EXIT. DESBD199
|
||||
00101 EXIT. DESBD199
|
||||
00102 EJECT DESBD199
|
||||
00103 DESBD199
|
||||
00104 P1000-SCAN-OLA. DESBD199
|
||||
00105 ADD +1 TO WRK-OLA-IN-CNT. DESBD199
|
||||
00106 DESBD199
|
||||
00107 IF RSK3-REC-TYPE = '060' OR '061' DESBD199
|
||||
00108 ADD +1 TO WRK-OLA-OUT-CNT DESBD199
|
||||
00109 PERFORM S947-O THRU S947-EXIT. DESBD199
|
||||
00110 DESBD199
|
||||
00111 PERFORM S924-OLA-I THRU S924-EXIT. DESBD199
|
||||
00112 DESBD199
|
||||
00113 P1000-EXIT. DESBD199
|
||||
00114 EXIT. DESBD199
|
||||
00115 DESBD199
|
||||
00116 T0000-TERMINATE. DESBD199
|
||||
00117 DESBD199
|
||||
00118 DISPLAY ' '. DESBD199
|
||||
00119 DESBD199
|
||||
00120 DISPLAY '*** DESBD199 TERMINATION STATISTICS ***'. DESBD199
|
||||
00121 DESBD199
|
||||
00122 DISPLAY ' '. DESBD199
|
||||
00123 DESBD199
|
||||
00124 MOVE WRK-OLA-IN-CNT TO WRK-CNT-DISP. DESBD199
|
||||
00125 DISPLAY ' TRIGGER RECORDS READ: ' DESBD199
|
||||
00126 WRK-CNT-DISP. DESBD199
|
||||
00127 DESBD199
|
||||
00128 MOVE WRK-OLA-OUT-CNT TO WRK-CNT-DISP. DESBD199
|
||||
00129 DISPLAY ' TRIGGER RECORDS SELECTED: ' DESBD199
|
||||
00130 WRK-CNT-DISP. DESBD199
|
||||
00131 DESBD199
|
||||
00132 DISPLAY SPACE. DESBD199
|
||||
00133 DESBD199
|
||||
00134 T0000-EXIT. DESBD199
|
||||
00135 EXIT. DESBD199
|
||||
00136 DESBD199
|
||||
00137 S924-OLA-I. DESBD199
|
||||
00138 CALL 'DTSBU924' USING L924-LINK-AREA DESBD199
|
||||
00139 RSK3-REC. DESBD199
|
||||
00140 DESBD199
|
||||
00141 S924-EXIT. DESBD199
|
||||
00142 EXIT. DESBD199
|
||||
00143 DESBD199
|
||||
00144 S947-O. DESBD199
|
||||
00145 CALL 'DTSBU947' USING RSK3-REC. DESBD199
|
||||
00146 DESBD199
|
||||
00147 S947-EXIT. DESBD199
|
||||
00148 EXIT. DESBD199
|
||||
Reference in New Issue
Block a user