252 lines
20 KiB
COBOL
252 lines
20 KiB
COBOL
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
|