225 lines
18 KiB
COBOL
225 lines
18 KiB
COBOL
00001 IDENTIFICATION DIVISION. 06/13/05
|
|
00002 PROGRAM-ID. DTSBX461. DTSBX461
|
|
00003 AUTHOR. NORTHROP GRUMMAN CORP. LV001
|
|
00004 DATE-WRITTEN. JANUARY 2005. DTSBX461
|
|
00005 DATE-COMPILED. DTSBX461
|
|
00006 DTSBX461
|
|
00007 ***** DTSBX461
|
|
00008 * DTSBX461
|
|
00009 * FUNCTION: THIS PROGRAM EXTRACTS EMPLOYER DATA FROM OTR FILE DTSBX461
|
|
00010 * EXCLUDING RECORDS FOR PERSONAL PROPERTY TAX, AND DTSBX461
|
|
00011 * THOSE FOR WHICH THERE IS NO FEIN. DTSBX461
|
|
00012 ***** DTSBX461
|
|
00013 DTSBX461
|
|
00014 ***** DTSBX461
|
|
00015 * MODIFICATION HISTORY: DTSBX461
|
|
00016 * DTSBX461
|
|
00017 * 01-11-05 INITIAL DEVELOPMENT DTSBX461
|
|
00018 * REFERENCE RFP #RAP AUTHOR OF CHANGE - RW1 DTSBX461
|
|
00019 * DTSBX461
|
|
00020 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX461
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX461
|
|
00022 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBX461
|
|
00023 ***** DTSBX461
|
|
00024 DTSBX461
|
|
00025 ENVIRONMENT DIVISION. DTSBX461
|
|
00026 CONFIGURATION SECTION. DTSBX461
|
|
00027 DTSBX461
|
|
00028 INPUT-OUTPUT SECTION. DTSBX461
|
|
00029 DTSBX461
|
|
00030 FILE-CONTROL. DTSBX461
|
|
00031 SELECT OTR-FEIN-INFILE ASSIGN TO OTRINFLE DTSBX461
|
|
00032 FILE STATUS IS INFILE-STATUS. DTSBX461
|
|
00033 SELECT OTR-FEIN-OUTFILE ASSIGN TO OTROUTFL DTSBX461
|
|
00034 FILE STATUS IS OUTFILE-STATUS. DTSBX461
|
|
00035 DTSBX461
|
|
00036 DATA DIVISION. DTSBX461
|
|
00037 DTSBX461
|
|
00038 FILE SECTION. DTSBX461
|
|
00039 DTSBX461
|
|
00040 FD OTR-FEIN-INFILE DTSBX461
|
|
00041 LABEL RECORDS ARE STANDARD DTSBX461
|
|
00042 BLOCK CONTAINS 0 RECORDS DTSBX461
|
|
00043 RECORDING MODE IS F. DTSBX461
|
|
00044 01 OTR-IN-REC PIC X(687). DTSBX461
|
|
00045 DTSBX461
|
|
00046 FD OTR-FEIN-OUTFILE DTSBX461
|
|
00047 LABEL RECORDS ARE STANDARD DTSBX461
|
|
00048 BLOCK CONTAINS 0 RECORDS DTSBX461
|
|
00049 RECORDING MODE IS F. DTSBX461
|
|
00050 DTSBX461
|
|
00051 *01 FEIN-OUT-REC PIC X(274). DTSBX461
|
|
00052 01 FEIN-OUT-REC PIC X(290). DTSBX461
|
|
00053 DTSBX461
|
|
00054 WORKING-STORAGE SECTION. DTSBX461
|
|
000545 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX461 06/13/05'. DTSBX461
|
|
00055 DTSBX461
|
|
00056 01 WRK-AREA. DTSBX461
|
|
00057 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +461.DTSBX461
|
|
00058 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBX461
|
|
00059 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX461'.DTSBX461
|
|
00060 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBX461
|
|
00061 DTSBX461
|
|
00062 05 WRK-RECS-COUNTS. DTSBX461
|
|
00063 10 RECS-IN-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00064 10 RECS-PERS-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00065 10 RECS-NOT-EIN-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00066 10 RECS-IN-SELECT-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00067 10 RECS-FEIN-INVALID-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00068 10 RECS-FEIN-VALID-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00069 10 RECS-OUT-FEIN-CNT PIC 9(07) VALUE ZEROS. DTSBX461
|
|
00070 DTSBX461
|
|
00071 05 WRK-ERROR-IND PIC X(01) VALUE 'N'. DTSBX461
|
|
00072 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX461
|
|
00073 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX461
|
|
00074 DTSBX461
|
|
00075 05 INFILE-STATUS PIC X(02). DTSBX461
|
|
00076 88 INFILE-STATUS-OK-88 VALUE '00'. DTSBX461
|
|
00077 88 INFILE-STATUS-EOF-88 VALUE '10'. DTSBX461
|
|
00078 DTSBX461
|
|
00079 05 OUTFILE-STATUS PIC X(02). DTSBX461
|
|
00080 88 OUTFILE-STATUS-OK-88 VALUE '00'. DTSBX461
|
|
00081 DTSBX461
|
|
00082 05 WRK-FEIN-X PIC X(09). DTSBX461
|
|
00083 05 WRK-FEIN-9 REDEFINES WRK-FEIN-X DTSBX461
|
|
00084 PIC 9(09). DTSBX461
|
|
00085 DTSBX461
|
|
00086 01 OTR-IN-RECORD. DTSBX461
|
|
00087 ++INCLUDE DTSIXTRI DTSBX461
|
|
00088 DTSBX461
|
|
00089 01 FEIN-OUT-RECORD. DTSBX461
|
|
00090 ++INCLUDE DTSIXTRO DTSBX461
|
|
00091 DTSBX461
|
|
00092 PROCEDURE DIVISION. DTSBX461
|
|
00093 DTSBX461
|
|
00094 PERFORM I1000-INITIATE THRU I1000-EXIT. DTSBX461
|
|
00095 IF WRK-ERROR-NO-88 DTSBX461
|
|
00096 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBX461
|
|
00097 UNTIL INFILE-STATUS-EOF-88 DTSBX461
|
|
00098 OR WRK-ERROR-YES-88 DTSBX461
|
|
00099 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBX461
|
|
00100 END-IF. DTSBX461
|
|
00101 DTSBX461
|
|
00102 GOBACK. DTSBX461
|
|
00103 DTSBX461
|
|
00104 I1000-INITIATE. DTSBX461
|
|
00105 DTSBX461
|
|
00106 OPEN INPUT OTR-FEIN-INFILE. DTSBX461
|
|
00107 IF NOT INFILE-STATUS-OK-88 DTSBX461
|
|
00108 DISPLAY 'CANNOT OPEN INPUT FILE ' INFILE-STATUS DTSBX461
|
|
00109 SET WRK-ERROR-YES-88 TO TRUE DTSBX461
|
|
00110 GO TO I1000-EXIT DTSBX461
|
|
00111 END-IF. DTSBX461
|
|
00112 DTSBX461
|
|
00113 OPEN OUTPUT OTR-FEIN-OUTFILE. DTSBX461
|
|
00114 IF NOT OUTFILE-STATUS-OK-88 DTSBX461
|
|
00115 DISPLAY 'CANNOT OPEN OUTPUT FILE ' OUTFILE-STATUS DTSBX461
|
|
00116 SET WRK-ERROR-YES-88 TO TRUE DTSBX461
|
|
00117 END-IF. DTSBX461
|
|
00118 DTSBX461
|
|
00119 I1000-EXIT. DTSBX461
|
|
00120 EXIT. DTSBX461
|
|
00121 DTSBX461
|
|
00122 P1000-PROCESS. DTSBX461
|
|
00123 READ OTR-FEIN-INFILE INTO OTR-IN-RECORD. DTSBX461
|
|
00124 IF INFILE-STATUS-EOF-88 DTSBX461
|
|
00125 GO TO P1000-EXIT DTSBX461
|
|
00126 ELSE DTSBX461
|
|
00127 IF NOT INFILE-STATUS-OK-88 DTSBX461
|
|
00128 DISPLAY 'BAD READ ON INFILE ' INFILE-STATUS DTSBX461
|
|
00129 SET WRK-ERROR-YES-88 TO TRUE DTSBX461
|
|
00130 GO TO P1000-EXIT DTSBX461
|
|
00131 END-IF DTSBX461
|
|
00132 END-IF. DTSBX461
|
|
00133 DTSBX461
|
|
00134 ADD 1 TO RECS-IN-CNT. DTSBX461
|
|
00135 DTSBX461
|
|
00136 IF XTRI-TAX-TYPE (1:4) EQUAL 'PERS' DTSBX461
|
|
00137 ADD 1 TO RECS-PERS-CNT DTSBX461
|
|
00138 GO TO P1000-PROCESS. DTSBX461
|
|
00139 DTSBX461
|
|
00140 IF XTRI-FEIN-SSN-CD NOT EQUAL 'EIN ' DTSBX461
|
|
00141 ADD 1 TO RECS-NOT-EIN-CNT DTSBX461
|
|
00142 GO TO P1000-PROCESS DTSBX461
|
|
00143 ELSE DTSBX461
|
|
00144 ADD 1 TO RECS-IN-SELECT-CNT DTSBX461
|
|
00145 END-IF. DTSBX461
|
|
00146 DTSBX461
|
|
00147 MOVE XTRI-FEIN TO WRK-FEIN-X. DTSBX461
|
|
00148 DTSBX461
|
|
00149 IF (WRK-FEIN-9 NOT NUMERIC) DTSBX461
|
|
00150 OR DTSBX461
|
|
00151 (WRK-FEIN-9 = 0) DTSBX461
|
|
00152 ADD 1 TO RECS-FEIN-INVALID-CNT DTSBX461
|
|
00153 GO TO P1000-EXIT DTSBX461
|
|
00154 ELSE DTSBX461
|
|
00155 ADD 1 TO RECS-FEIN-VALID-CNT DTSBX461
|
|
00156 END-IF. DTSBX461
|
|
00157 DTSBX461
|
|
00158 MOVE XTRI-FEIN TO XTRO-FEIN. DTSBX461
|
|
00159 MOVE ZEROS TO XTRO-EMP-NO. DTSBX461
|
|
00160 SET XTRO-SOURCE-OTR-88 TO TRUE. DTSBX461
|
|
00161 MOVE XTRI-EMP-NAME TO XTRO-EMP-NAME. DTSBX461
|
|
00162 MOVE XTRI-STREET-1 TO XTRO-STREET-1. DTSBX461
|
|
00163 MOVE XTRI-CITY-1 TO XTRO-CITY-1. DTSBX461
|
|
00164 MOVE XTRI-STATE-1 TO XTRO-STATE-1. DTSBX461
|
|
00165 MOVE XTRI-ZIP-1 TO XTRO-ZIP-1. DTSBX461
|
|
00166 MOVE XTRI-PHONE TO XTRO-PHONE-1. DTSBX461
|
|
00167 MOVE SPACES TO XTRO-PHONE-2. DTSBX461
|
|
00168 DTSBX461
|
|
00169 IF (XTRI-STREET-1 = XTRI-STREET-2 DTSBX461
|
|
00170 AND XTRI-CITY-1 = XTRI-CITY-2) DTSBX461
|
|
00171 NEXT SENTENCE DTSBX461
|
|
00172 ELSE DTSBX461
|
|
00173 MOVE XTRI-STREET-2 TO XTRO-STREET-2 DTSBX461
|
|
00174 MOVE XTRI-CITY-2 TO XTRO-CITY-2 DTSBX461
|
|
00175 MOVE XTRI-STATE-2 TO XTRO-STATE-2 DTSBX461
|
|
00176 MOVE XTRI-ZIP-2 TO XTRO-ZIP-2 DTSBX461
|
|
00177 END-IF. DTSBX461
|
|
00178 DTSBX461
|
|
00179 WRITE FEIN-OUT-REC FROM FEIN-OUT-RECORD. DTSBX461
|
|
00180 IF NOT OUTFILE-STATUS-OK-88 DTSBX461
|
|
00181 DISPLAY 'BAD WRITE ON OUTFILE ' OUTFILE-STATUS DTSBX461
|
|
00182 SET WRK-ERROR-YES-88 TO TRUE DTSBX461
|
|
00183 GO TO P1000-EXIT DTSBX461
|
|
00184 ELSE DTSBX461
|
|
00185 ADD 1 TO RECS-OUT-FEIN-CNT DTSBX461
|
|
00186 END-IF. DTSBX461
|
|
00187 DTSBX461
|
|
00188 P1000-EXIT. DTSBX461
|
|
00189 EXIT. DTSBX461
|
|
00190 DTSBX461
|
|
00191 T1000-TERMINATE. DTSBX461
|
|
00192 DISPLAY ' '. DTSBX461
|
|
00193 DISPLAY ' ***********************************************'. DTSBX461
|
|
00194 DISPLAY ' DTSBX461 TERMINATION STATISTICS '. DTSBX461
|
|
00195 DISPLAY ' '. DTSBX461
|
|
00196 DISPLAY ' OTR TOTAL RECS READ = ' RECS-IN-CNT. DTSBX461
|
|
00197 DISPLAY ' '. DTSBX461
|
|
00198 DISPLAY ' OTR PERS PROP COUNT = ' RECS-PERS-CNT. DTSBX461
|
|
00199 DISPLAY ' OTR NOT EIN COUNT = ' RECS-NOT-EIN-CNT. DTSBX461
|
|
00200 DISPLAY ' OTR FEIN INVALID CNT = ' RECS-FEIN-INVALID-CNT. DTSBX461
|
|
00201 DISPLAY ' '. DTSBX461
|
|
00202 DISPLAY ' OTR FEIN VALID COUNT = ' RECS-FEIN-VALID-CNT. DTSBX461
|
|
00203 DISPLAY ' '. DTSBX461
|
|
00204 DISPLAY ' RECORDS WRITTEN CNT = ' RECS-OUT-FEIN-CNT. DTSBX461
|
|
00205 DISPLAY ' '. DTSBX461
|
|
00206 DISPLAY ' ***********************************************'. DTSBX461
|
|
00207 DISPLAY ' '. DTSBX461
|
|
00208 DTSBX461
|
|
00209 CLOSE OTR-FEIN-INFILE, OTR-FEIN-OUTFILE. DTSBX461
|
|
00210 DTSBX461
|
|
00211 T1000-EXIT. DTSBX461
|
|
00212 EXIT. DTSBX461
|
|
00213 DTSBX461
|
|
00214 S999-ABEND. DTSBX461
|
|
00215 SKIP1 DTSBX461
|
|
00216 DISPLAY '*** DTSBX461 ABENDING. ' DTSBX461
|
|
00217 WRK-ABEND-MSG. DTSBX461
|
|
00218 DTSBX461
|
|
00219 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX461
|
|
00220 SKIP2 DTSBX461
|
|
00221 S999-EXIT. DTSBX461
|
|
00222 EXIT. DTSBX461
|
|
00223 DTSBX461
|