DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
251
Batch/DTSBD385.cob
Normal file
251
Batch/DTSBD385.cob
Normal file
@ -0,0 +1,251 @@
|
||||
00001 IDENTIFICATION DIVISION. 03/26/09
|
||||
00002 PROGRAM-ID. DTSBD385. DTSBD385
|
||||
00003 AUTHOR. NORTHROP GRUMMAN. LV007
|
||||
00004 DATE-WRITTEN. AUGUST 2003. DTSBD385
|
||||
00005 DATE-COMPILED. DTSBD385
|
||||
00006 SKIP3 DTSBD385
|
||||
00007 ***** DTSBD385
|
||||
00008 * DTSBD385
|
||||
00009 * DTSBD385
|
||||
00010 * FUNCTION: ADD MNTE OR MEVL RECORDS FROM EXTERNAL DTSBD385
|
||||
00011 * BATCH PROCESSES DTSBD385
|
||||
00012 * DTSBD385
|
||||
00013 * DTSBD385
|
||||
00014 * DTSBD385
|
||||
00015 * DTSBD385
|
||||
00016 * MODIFICATION LOG: DTSBD385
|
||||
00017 * DTSBD385
|
||||
00018 * 01/17/2005 INITIAL DEVELOPMENT. DTSBD385
|
||||
00019 * WORK ORDER: PROGRAMMER: GD DTSBD385
|
||||
00020 * DTSBD385
|
||||
00021 * 05/07/2008 ADDED MEVL RECORD. DTSBD385
|
||||
00022 * WORK ORDER: REFUNDS PROGRAMMER: GD DTSBD385
|
||||
00023 * DTSBD385
|
||||
00024 * 03/25/2009 UPDATED CODE THAT REFERENCES ABSTIME FROM DTSBD385
|
||||
00025 * LBCM LINKAGE. THE PROGRAM WAS USING LBCM-ABSTIME DTSBD385
|
||||
00026 * INSTEAD OF LBCM-EMP-ABSTIME. STANDARD USAGE IN DTSBD385
|
||||
00027 * THE SYSTEM IS LBCM-EMP-ABSTIME. DTSBD385
|
||||
00028 * WORK ORDER: PROGRAMMER: GD DTSBD385
|
||||
00029 * DTSBD385
|
||||
00030 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD385
|
||||
00031 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD385
|
||||
00032 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD385
|
||||
00033 * DTSBD385
|
||||
00034 * DTSBD385
|
||||
00035 * DESCRIPTION: DTSBD385
|
||||
00036 * DTSBD385
|
||||
00037 * DTSBD385
|
||||
00038 * DTSBD385
|
||||
00039 * MASTER FILE RECORDS READ: DTSBD385
|
||||
00040 * DTSBD385
|
||||
00041 * MPRF DTSBD385
|
||||
00042 * DTSBD385
|
||||
00043 * DTSBD385
|
||||
00044 * MASTER FILE RECORDS UPDATED: DTSBD385
|
||||
00045 * DTSBD385
|
||||
00046 * MNTE DTSBD385
|
||||
00047 * MEVL DTSBD385
|
||||
00048 * DTSBD385
|
||||
00049 * DTSBD385
|
||||
00050 * REPORT RECORDS WRITTEN: DTSBD385
|
||||
00051 * DTSBD385
|
||||
00052 * R907 ERRORS REPORT DTSBD385
|
||||
00053 * DTSBD385
|
||||
00054 * DTSBD385
|
||||
00055 * MODULES CALLED: DTSBD385
|
||||
00056 * DTSBD385
|
||||
00057 * DTSBU111 LOOKUP ADDRESS. DTSBD385
|
||||
00058 * DTSBU112 FORMAT ADDRESS. DTSBD385
|
||||
00059 * DTSBU331 FORMAT AND WRITE MLOG OCCURRENCE. DTSBD385
|
||||
00060 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD385
|
||||
00061 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. DTSBD385
|
||||
00062 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD385
|
||||
00063 * DTSBD385
|
||||
00064 ***** DTSBD385
|
||||
00065 SKIP3 DTSBD385
|
||||
00066 ENVIRONMENT DIVISION. DTSBD385
|
||||
00067 SKIP3 DTSBD385
|
||||
00068 DATA DIVISION. DTSBD385
|
||||
00069 EJECT DTSBD385
|
||||
00070 WORKING-STORAGE SECTION. DTSBD385
|
||||
000705 77 PAN-VALET PICTURE X(24) VALUE '007DTSBD385 03/26/09'. DTSBD385
|
||||
00071 SKIP3 DTSBD385
|
||||
00072 01 WRK-AREA. DTSBD385
|
||||
00073 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +385.DTSBD385
|
||||
00074 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD385'.DTSBD385
|
||||
00075 05 WRK-ABEND-MSG PIC X(60). DTSBD385
|
||||
00076 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD385
|
||||
00077 88 FIRST-TIME-YES-88 VALUE 'Y'. DTSBD385
|
||||
00078 88 FIRST-TIME-NO-88 VALUE 'N'. DTSBD385
|
||||
00079 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD385
|
||||
00080 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. DTSBD385
|
||||
00081 DTSBD385
|
||||
00082 05 WRK-MNTE-LENGTH PIC S9(04) COMP. DTSBD385
|
||||
00083 05 WRK-MEVL-LENGTH PIC S9(04) COMP. DTSBD385
|
||||
00084 DTSBD385
|
||||
00085 05 WRK-WRITE-MNTE-CNT PIC S9(07) COMP-3 VALUE 0. DTSBD385
|
||||
00086 DTSBD385
|
||||
00087 01 MSG-TABLE. DTSBD385
|
||||
00088 05 MSG1-ADDRESS-MISSING. DTSBD385
|
||||
00089 10 MSG1-ID PIC X(11) VALUE 'DTSBD385909'. DTSBD385
|
||||
00090 10 MSG1-SHORT-TEXT PIC X(20) VALUE ' '. DTSBD385
|
||||
00091 10 MSG1-LONG-TEXT. DTSBD385
|
||||
00092 15 FILLER PIC X(30) DTSBD385
|
||||
00093 VALUE 'TRANSACTION FAILED - '. DTSBD385
|
||||
00094 15 FILLER PIC X(30) DTSBD385
|
||||
00095 VALUE ' '. DTSBD385
|
||||
00096 01 L005-LINK-AREA. DTSBD385
|
||||
00097 ++INCLUDE DTSIL005 DTSBD385
|
||||
00098 DTSBD385
|
||||
00099 01 L910-LINK-AREA. DTSBD385
|
||||
00100 ++INCLUDE DTSIL910 DTSBD385
|
||||
00101 EJECT DTSBD385
|
||||
00102 01 MSKL-REC. DTSBD385
|
||||
00103 ++INCLUDE DTSIMSKL DTSBD385
|
||||
00104 EJECT DTSBD385
|
||||
00105 01 MNTE-REC. DTSBD385
|
||||
00106 ++INCLUDE DTSIMNTE DTSBD385
|
||||
00107 01 MEVL-REC. DTSBD385
|
||||
00108 ++INCLUDE DTSIMEVL DTSBD385
|
||||
00109 EJECT DTSBD385
|
||||
00110 01 R907-REC. DTSBD385
|
||||
00111 ++INCLUDE DTSIR907 DTSBD385
|
||||
00112 EJECT DTSBD385
|
||||
00113 DTSBD385
|
||||
00114 LINKAGE SECTION. DTSBD385
|
||||
00115 SKIP3 DTSBD385
|
||||
00116 01 LBCM-LINK-AREA. DTSBD385
|
||||
00117 ++INCLUDE DTSILBCM DTSBD385
|
||||
00118 EJECT DTSBD385
|
||||
00119 01 MPRF-REC. DTSBD385
|
||||
00120 ++INCLUDE DTSIMPRF DTSBD385
|
||||
00121 EJECT DTSBD385
|
||||
00122 01 T003-REC. DTSBD385
|
||||
00123 ++INCLUDE DTSIT003 DTSBD385
|
||||
00124 EJECT DTSBD385
|
||||
00125 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD385
|
||||
00126 MPRF-REC DTSBD385
|
||||
00127 T003-REC. DTSBD385
|
||||
00128 DTSBD385
|
||||
00129 IF FIRST-TIME-YES-88 DTSBD385
|
||||
00130 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD385
|
||||
00131 END-IF. DTSBD385
|
||||
00132 DTSBD385
|
||||
00133 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD385
|
||||
00134 DTSBD385
|
||||
00135 GOBACK. DTSBD385
|
||||
00136 SKIP3 DTSBD385
|
||||
00137 I0000-INITIATE. DTSBD385
|
||||
00138 SET FIRST-TIME-NO-88 TO TRUE. DTSBD385
|
||||
00139 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD385
|
||||
00140 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBD385
|
||||
00141 DTSBD385
|
||||
00142 MOVE LENGTH OF MNTE-REC TO WRK-MNTE-LENGTH. DTSBD385
|
||||
00143 MOVE LENGTH OF MEVL-REC TO WRK-MEVL-LENGTH. DTSBD385
|
||||
00144 DTSBD385
|
||||
00145 I0000-EXIT. DTSBD385
|
||||
00146 EXIT. DTSBD385
|
||||
00147 DTSBD385
|
||||
00148 P0000-PROCESS. DTSBD385
|
||||
00149 DISPLAY 'BD385 P0000: ' T003-EMP-NO DTSBD385
|
||||
00150 ' ' T003-TRN-CD. DTSBD385
|
||||
00151 EVALUATE TRUE DTSBD385
|
||||
00152 WHEN T003-ADD-MNTE-88 DTSBD385
|
||||
00153 PERFORM P1000-MNTE THRU P1000-EXIT DTSBD385
|
||||
00154 DTSBD385
|
||||
00155 WHEN T003-ADD-MEVL-88 DTSBD385
|
||||
00156 PERFORM P2000-MEVL THRU P2000-EXIT DTSBD385
|
||||
00157 DTSBD385
|
||||
00158 END-EVALUATE. DTSBD385
|
||||
00159 DTSBD385
|
||||
00160 P0000-EXIT. DTSBD385
|
||||
00161 EXIT. DTSBD385
|
||||
00162 DTSBD385
|
||||
00163 P1000-MNTE. DTSBD385
|
||||
00164 MOVE T003-REC-AREA (1:WRK-MNTE-LENGTH) TO MNTE-REC. DTSBD385
|
||||
00165 DTSBD385
|
||||
00166 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD385
|
||||
00167 MOVE LBCM-EMP-ABSTIME TO MNTE-KEY-ESTB-ABSTIME DTSBD385
|
||||
00168 MNTE-DATA-ESTB-ABSTIME DTSBD385
|
||||
00169 MNTE-CHNG-ABSTIME. DTSBD385
|
||||
00170 DTSBD385
|
||||
00171 MOVE MNTE-REC TO MSKL-REC. DTSBD385
|
||||
00172 PERFORM S910-WRITE THRU S910-EXIT. DTSBD385
|
||||
00173 DTSBD385
|
||||
00174 P1000-EXIT. DTSBD385
|
||||
00175 EXIT. DTSBD385
|
||||
00176 DTSBD385
|
||||
00177 P2000-MEVL. DTSBD385
|
||||
00178 MOVE T003-REC-AREA (1:WRK-MEVL-LENGTH) TO MEVL-REC. DTSBD385
|
||||
00179 DTSBD385
|
||||
00180 DISPLAY 'BD385 P2000: ' MEVL-EMP-NO DTSBD385
|
||||
00181 ' ' MEVL-TEXT ' ' LBCM-EMP-ABSTIME. DTSBD385
|
||||
00182 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD385
|
||||
00183 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD385
|
||||
00184 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD385
|
||||
00185 MOVE L005-DATE TO MEVL-DATE DTSBD385
|
||||
00186 MEVL-ESTB-DATE DTSBD385
|
||||
00187 MEVL-CHNG-DATE. DTSBD385
|
||||
00188 MOVE L005-TIME TO MEVL-TIME. DTSBD385
|
||||
00189 DTSBD385
|
||||
00190 DISPLAY 'BD385 P2000 2: ' MEVL-TIME. DTSBD385
|
||||
00191 MOVE MEVL-REC TO MSKL-REC. DTSBD385
|
||||
00192 PERFORM S910-WRITE THRU S910-EXIT. DTSBD385
|
||||
00193 DTSBD385
|
||||
00194 P2000-EXIT. DTSBD385
|
||||
00195 EXIT. DTSBD385
|
||||
00196 DTSBD385
|
||||
00197 S005-FROM-ABSTIME. DTSBD385
|
||||
00198 SET L005-FROM-ABSTIME TO TRUE. DTSBD385
|
||||
00199 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD385
|
||||
00200 S005-EXIT. DTSBD385
|
||||
00201 EXIT. DTSBD385
|
||||
00202 DTSBD385
|
||||
00203 S910-READ. DTSBD385
|
||||
00204 SET L910-READ-88 TO TRUE. DTSBD385
|
||||
00205 GO TO S910-MSTR-IO. DTSBD385
|
||||
00206 DTSBD385
|
||||
00207 S910-START-BROWSE. DTSBD385
|
||||
00208 SET L910-START-BROWSE-88 TO TRUE. DTSBD385
|
||||
00209 GO TO S910-MSTR-IO. DTSBD385
|
||||
00210 DTSBD385
|
||||
00211 S910-READ-NEXT. DTSBD385
|
||||
00212 SET L910-READ-NEXT-88 TO TRUE. DTSBD385
|
||||
00213 GO TO S910-MSTR-IO. DTSBD385
|
||||
00214 DTSBD385
|
||||
00215 S910-COUNT. DTSBD385
|
||||
00216 SET L910-COUNT-88 TO TRUE. DTSBD385
|
||||
00217 GO TO S910-MSTR-IO. DTSBD385
|
||||
00218 DTSBD385
|
||||
00219 S910-WRITE. DTSBD385
|
||||
00220 SET L910-WRITE-88 TO TRUE. DTSBD385
|
||||
00221 GO TO S910-MSTR-IO. DTSBD385
|
||||
00222 DTSBD385
|
||||
00223 S910-REWRITE. DTSBD385
|
||||
00224 SET L910-REWRITE-88 TO TRUE. DTSBD385
|
||||
00225 GO TO S910-MSTR-IO. DTSBD385
|
||||
00226 DTSBD385
|
||||
00227 S910-DELETE. DTSBD385
|
||||
00228 SET L910-DELETE-88 TO TRUE. DTSBD385
|
||||
00229 GO TO S910-MSTR-IO. DTSBD385
|
||||
00230 DTSBD385
|
||||
00231 S910-MSTR-IO. DTSBD385
|
||||
00232 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD385
|
||||
00233 MSKL-REC. DTSBD385
|
||||
00234 S910-EXIT. DTSBD385
|
||||
00235 EXIT. DTSBD385
|
||||
00236 DTSBD385
|
||||
00237 S946-WRITE-R907. DTSBD385
|
||||
00238 CALL 'DTSBU946' USING R907-REC. DTSBD385
|
||||
00239 DTSBD385
|
||||
00240 S946-EXIT. DTSBD385
|
||||
00241 EXIT. DTSBD385
|
||||
00242 DTSBD385
|
||||
00243 S999-ABEND. DTSBD385
|
||||
00244 DISPLAY '*** DTSBD385 ABENDING : ' DTSBD385
|
||||
00245 WRK-ABEND-MSG. DTSBD385
|
||||
00246 DTSBD385
|
||||
00247 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD385
|
||||
00248 S999-EXIT. DTSBD385
|
||||
00249 EXIT. DTSBD385
|
||||
00250 DTSBD385
|
||||
Reference in New Issue
Block a user