00001 IDENTIFICATION DIVISION. 06/23/04 00002 PROGRAM-ID. DTSCU074. DTSCU074 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV004 00004 DATE-WRITTEN. APRIL 1994. DTSCU074 00005 DATE-COMPILED. DTSCU074 00006 SKIP3 DTSCU074 00007 ***** DTSCU074 00008 * DTSCU074 00009 * FUNCTION: EDIT FOR DUPLICATE FEIN. DTSCU074 00010 * DTSCU074 00011 * DTSCU074 00012 * MODIFICATION LOG: DTSCU074 00013 * DTSCU074 00014 * 04/05/94 INITIAL DEVELOPMENT. DTSCU074 00015 * WORK ORDER: PROGRAMMER: RHC DTSCU074 00016 * DTSCU074 00017 * 09/08/1998 REVIEWED AND MODIFIED FOR DC. DTSCU074 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCU074 00019 * DTSCU074 00020 * 06/23/2004 MODIFIED TO SET L074-DUP-STAT-UNK-88 TO TRUE DTSCU074 00021 * IF DUPLICATE FEIN FOUND ON ACCOUNT WITH STATUS DTSCU074 00022 * UNKNOWN (NO DETERMINATION). ACTIVE DETERMINATIONDTSCU074 00023 * SHOULD NOT BE ALLOWED IN THIS CASE. DTSCU074 00024 * REFERENCE: REQUEST FROM STATUS PROGRAMMER: GD DTSCU074 00025 * DTSCU074 00026 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU074 00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU074 00028 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU074 00029 * DTSCU074 00030 * DTSCU074 00031 * DESCRIPTION: DTSCU074 00032 * DTSCU074 00033 * DTSCU074 EDITS FOR A DUPLICATE FEIN. DTSCU074 00034 * DTSCU074 00035 * IF L074-FEIN = 0 OR 810302402 DTSCU074 00036 * RETURN L074-DUP-BUT-OK-88 DTSCU074 00037 * ELSE DTSCU074 00038 * IF L074-ANY-DUP-88 DTSCU074 00039 * BROWSE IEIN (LIMITED BY L074-FEIN) DTSCU074 00040 * IF IEIN RECORD FOUND WITH IEIN-EMP-NO NOT = L074-EMP-NO DTSCU074 00041 * RETURN L074-DUP-NOT-OK-88 DTSCU074 00042 * ELSE DTSCU074 00043 * RETURN L074-NO-DUP-88 DTSCU074 00044 * ELSE DTSCU074 00045 * IF L074-ACTIVE-DUP-88 DTSCU074 00046 * BROWSE IEIN (LIMITED BY L074-FEIN) DTSCU074 00047 * IF (IEIN RECORD FOUND WITH IEIN-EMP-NO NOT = L074-EMP-NODTSCU074 00048 * AND DTSCU074 00049 * (IEIN-EMP-NO IS AN ACTIVE EMPLOYER) DTSCU074 00050 * RETURN L074-DUP-NOT-OK-88 DTSCU074 00051 * ELSE DTSCU074 00052 * RETURN L074-NO-DUP-88 DTSCU074 00053 * ELSE DTSCU074 00054 * ABEND. DTSCU074 00055 * DTSCU074 00056 * IGNORE INCONSISTENCIES BETWEEN THE ALTERNATE INDEX FILE DTSCU074 00057 * AND THE MASTER FILE (IF IEIN-EMP-NO DOES NOT EXIST ON DTSCU074 00058 * THE MASTER FILE, THEN JUST KEEP GOING). DTSCU074 00059 * DTSCU074 00060 ***** DTSCU074 00061 SKIP3 DTSCU074 00062 ENVIRONMENT DIVISION. DTSCU074 00063 SKIP3 DTSCU074 00064 DATA DIVISION. DTSCU074 00065 SKIP3 DTSCU074 00066 WORKING-STORAGE SECTION. DTSCU074 000665 77 PAN-VALET PICTURE X(24) VALUE '004DTSCU074 06/23/04'. DTSCU074 00067 SKIP3 DTSCU074 00068 01 WRK-AREA. DTSCU074 00069 05 WRK-ABEND-CODE PIC X(04) VALUE 'U074'. DTSCU074 00070 DTSCU074 00071 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU074 00072 EJECT DTSCU074 00073 01 L821-COMM-AREA. DTSCU074 00074 05 L821-CONTROL-AREA. DTSCU074 00075 ++INCLUDE DTSIL821 DTSCU074 00076 SKIP3 DTSCU074 00077 05 ISKL-REC. DTSCU074 00078 ++INCLUDE DTSIISKL DTSCU074 00079 SKIP3 DTSCU074 00080 05 IEIN-REC REDEFINES ISKL-REC. DTSCU074 00081 ++INCLUDE DTSIIEIN DTSCU074 00082 EJECT DTSCU074 00083 01 L810-COMM-AREA. DTSCU074 00084 05 L810-CONTROL-AREA. DTSCU074 00085 ++INCLUDE DTSIL810 DTSCU074 00086 SKIP3 DTSCU074 00087 05 MSKL-REC. DTSCU074 00088 ++INCLUDE DTSIMSKL DTSCU074 00089 SKIP3 DTSCU074 00090 05 MPRF-REC REDEFINES MSKL-REC. DTSCU074 00091 ++INCLUDE DTSIMPRF DTSCU074 00092 EJECT DTSCU074 00093 LINKAGE SECTION. DTSCU074 00094 SKIP3 DTSCU074 00095 01 DFHCOMMAREA. DTSCU074 00096 ++INCLUDE DTSIL074 DTSCU074 00097 EJECT DTSCU074 00098 PROCEDURE DIVISION. DTSCU074 00099 SKIP2 DTSCU074 00100 IF L074-ANY-DUP-88 DTSCU074 00101 OR L074-ACTIVE-DUP-88 DTSCU074 00102 MOVE SPACE TO L074-MSG-AREA DTSCU074 00103 SET L074-NO-DUP-88 TO TRUE DTSCU074 00104 ELSE DTSCU074 00105 GO TO S899-ABEND. DTSCU074 00106 DTSCU074 00107 IF L074-FEIN = +0 DTSCU074 00108 SET L074-DUP-BUT-OK-88 TO TRUE DTSCU074 00109 ELSE DTSCU074 00110 MOVE LOW-VALUES TO IEIN-KEY-AREA DTSCU074 00111 SET IEIN-EIN-88 TO TRUE DTSCU074 00112 MOVE L074-FEIN TO IEIN-FEIN DTSCU074 00113 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCU074 00114 PERFORM P1000-PROCESS THRU P1000-EXIT DTSCU074 00115 UNTIL L074-FILE-CLOSED-88 DTSCU074 00116 OR DTSCU074 00117 L821-NO-REC-88 DTSCU074 00118 PERFORM S821-END-BROWSE THRU S821-EXIT. DTSCU074 00119 DTSCU074 00120 PROCEDURE-EXIT. DTSCU074 00121 DTSCU074 00122 DTSCU074 00123 EXEC CICS DTSCU074 00124 RETURN DTSCU074 00125 END-EXEC. DTSCU074 00126 DTSCU074 00127 DTSCU074 00128 DTSCU074 00129 GOBACK. DTSCU074 00130 EJECT DTSCU074 00131 P1000-PROCESS. DTSCU074 00132 IF IEIN-FEIN NOT = L074-FEIN DTSCU074 00133 SET L821-NO-REC-88 TO TRUE DTSCU074 00134 GO TO P1000-EXIT. DTSCU074 00135 DTSCU074 00136 IF IEIN-EMP-NO = L074-EMP-NO DTSCU074 00137 NEXT SENTENCE DTSCU074 00138 ELSE DTSCU074 00139 IF L074-ANY-DUP-88 DTSCU074 00140 SET L074-DUP-NOT-OK-88 TO TRUE DTSCU074 00141 ELSE DTSCU074 00142 IF IEIN-EMP-NO = L074-INACTIVE-EMP-NO DTSCU074 00143 IF L074-NO-DUP-88 DTSCU074 00144 SET L074-DUP-BUT-OK-88 TO TRUE DTSCU074 00145 ELSE DTSCU074 00146 NEXT SENTENCE DTSCU074 00147 ELSE DTSCU074 00148 PERFORM P1100-CHECK-MPRF THRU P1100-EXIT DTSCU074 00149 END-IF DTSCU074 00150 END-IF DTSCU074 00151 END-IF. DTSCU074 00152 DTSCU074 00153 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCU074 00154 DTSCU074 00155 P1000-EXIT. DTSCU074 00156 EXIT. DTSCU074 00157 DTSCU074 00158 P1100-CHECK-MPRF. DTSCU074 00159 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCU074 00160 MOVE IEIN-EMP-NO TO MPRF-EMP-NO DTSCU074 00161 SET MPRF-PRF-88 TO TRUE DTSCU074 00162 PERFORM S810-READ THRU S810-EXIT DTSCU074 00163 IF L810-OK-88 DTSCU074 00164 IF MPRF-STATUS-ACT-88 DTSCU074 00165 SET L074-DUP-NOT-OK-88 TO TRUE DTSCU074 00166 ELSE DTSCU074 00167 IF L074-DUP-NOT-OK-88 DTSCU074 00168 OR L074-DUP-STAT-UNK-88 DTSCU074 00169 NEXT SENTENCE DTSCU074 00170 ELSE DTSCU074 00171 IF MPRF-STATUS-UNK-88 DTSCU074 00172 SET L074-DUP-STAT-UNK-88 TO TRUE DTSCU074 00173 ELSE DTSCU074 00174 SET L074-DUP-BUT-OK-88 TO TRUE DTSCU074 00175 END-IF DTSCU074 00176 END-IF DTSCU074 00177 END-IF DTSCU074 00178 END-IF. DTSCU074 00179 DTSCU074 00180 P1100-EXIT. DTSCU074 00181 EXIT. DTSCU074 00182 DTSCU074 00183 S810-READ. DTSCU074 00184 SET L810-READ-88 TO TRUE. DTSCU074 00185 GO TO S810-MSTR-IO. DTSCU074 00186 DTSCU074 00187 S810-MSTR-IO. DTSCU074 00188 DTSCU074 00189 EXEC CICS DTSCU074 00190 LINK DTSCU074 00191 PROGRAM('DTSCU810') DTSCU074 00192 COMMAREA(L810-COMM-AREA) DTSCU074 00193 END-EXEC. DTSCU074 00194 DTSCU074 00195 IF L810-FILE-CLOSED-88 DTSCU074 00196 SET L074-FILE-CLOSED-88 TO TRUE DTSCU074 00197 MOVE L810-MSG-AREA TO L074-MSG-AREA. DTSCU074 00198 S810-EXIT. DTSCU074 00199 EXIT. DTSCU074 00200 SKIP3 DTSCU074 00201 S821-START-BROWSE. DTSCU074 00202 SET L821-START-BROWSE-88 TO TRUE. DTSCU074 00203 GO TO S821-AIX-IO. DTSCU074 00204 DTSCU074 00205 S821-READ-NEXT. DTSCU074 00206 SET L821-READ-NEXT-88 TO TRUE. DTSCU074 00207 GO TO S821-AIX-IO. DTSCU074 00208 DTSCU074 00209 S821-END-BROWSE. DTSCU074 00210 SET L821-END-BROWSE-88 TO TRUE. DTSCU074 00211 GO TO S821-AIX-IO. DTSCU074 00212 DTSCU074 00213 S821-AIX-IO. DTSCU074 00214 DTSCU074 00215 EXEC CICS DTSCU074 00216 LINK DTSCU074 00217 PROGRAM('DTSCU821') DTSCU074 00218 COMMAREA(L821-COMM-AREA) DTSCU074 00219 END-EXEC. DTSCU074 00220 DTSCU074 00221 IF L821-FILE-CLOSED-88 DTSCU074 00222 SET L074-FILE-CLOSED-88 TO TRUE DTSCU074 00223 MOVE L821-MSG-AREA TO L074-MSG-AREA. DTSCU074 00224 S821-EXIT. DTSCU074 00225 EXIT. DTSCU074 00226 SKIP3 DTSCU074 00227 S899-ABEND. DTSCU074 00228 DTSCU074 00229 EXEC CICS DTSCU074 00230 ABEND DTSCU074 00231 ABCODE (WRK-ABEND-CODE) DTSCU074 00232 END-EXEC. DTSCU074 00233 DTSCU074 00234 S899-EXIT. DTSCU074 00235 EXIT. DTSCU074