00001 IDENTIFICATION DIVISION. 03/18/99 00002 PROGRAM-ID. DTSBE410. DTSBE410 00003 AUTHOR. TRICOASTAL CONSULTING LTD LV010 00004 MODIFIED BY TRW S&ITG. CL**2 00005 DATE-WRITTEN. AUGUST 1994. DTSBE410 00006 DATE-COMPILED. DTSBE410 00007 SKIP3 DTSBE410 00008 ***** DTSBE410 00009 * DTSBE410 00010 * CALLING SEQUENCE: DTSBE410 CREATES DTSIR410 RECORDS. CL**8 00011 * DTSBD800 CALLS DTSBR410 CL**8 00012 * WHICH PRODUCES THE EXTRACT. CL**8 00013 * CL**8 00014 * FUNCTION: OPEN APPEALS LIST EXTRACT. DTSBE410 00015 * DTSBE410 00016 * DTSBE410 00017 * MODIFICATION LOG: DTSBE410 00018 * DTSBE410 00019 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE410 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE410 00021 * WORK ORDER: PROGRAMMER: XXX DTSBE410 00022 * DTSBE410 00023 * DTSBE410 00024 * DESCRIPTION: DTSBE410 00025 * DTSBE410 00026 * DTSBE410 00027 * INITIATION: DTSBE410 00028 * DTSBE410 00029 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE410 00030 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE410 00031 * DTSBE410 00032 * NO PARAMETERS ARE INPUT. DTSBE410 00033 * DTSBE410 00034 * DTSBE410 00035 * PROCESSING: DTSBE410 00036 * DTSBE410 00037 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (410R1). DTSBE410 00038 * DTSBE410 00039 * DTSBE410 00040 * TERMINATION: DTSBE410 00041 * DTSBE410 00042 * NO PROCESSING. DTSBE410 00043 * DTSBE410 00044 * DTSBE410 00045 * RECORDS READ: DTSBE410 00046 * DTSBE410 00047 * MASTER: DTSBE410 00048 * DTSBE410 00049 * MAPL DTSBE410 00050 * DTSBE410 00051 * DTSBE410 00052 * ALTERNATE INDEX: DTSBE410 00053 * DTSBE410 00054 * NONE. DTSBE410 00055 * DTSBE410 00056 * DTSBE410 00057 * REFERENCE: DTSBE410 00058 * DTSBE410 00059 * NONE. DTSBE410 00060 * DTSBE410 00061 * DTSBE410 00062 * RECORDS UPDATED: DTSBE410 00063 * DTSBE410 00064 * NONE. DTSBE410 00065 * DTSBE410 00066 * DTSBE410 00067 * REPORT RECORDS WRITTEN: DTSBE410 00068 * DTSBE410 00069 * R410 OPEN APPEALS LIST. DTSBE410 00070 * DTSBE410 00071 * DTSBE410 00072 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE410 00073 * DTSBE410 00074 * NONE. DTSBE410 00075 * DTSBE410 00076 * DTSBE410 00077 * MODULES CALLED: DTSBE410 00078 * DTSBE410 00079 * DTSBU001 DATE CONVERSION/EDIT. CL**2 00080 * DTSBU910 MASTER FILE I/O. CL**2 00081 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. CL**2 00082 * DTSBE410 00083 * DTSBE410 00084 * VERMONT REFERENCE: DTSBE410 00085 * DTSBE410 00086 * NONE. DTSBE410 00087 * DTSBE410 00088 ***** DTSBE410 00089 SKIP3 DTSBE410 00090 ENVIRONMENT DIVISION. DTSBE410 00091 SKIP3 DTSBE410 00092 DATA DIVISION. DTSBE410 00093 EJECT DTSBE410 00094 WORKING-STORAGE SECTION. DTSBE410 000945 77 PAN-VALET PICTURE X(24) VALUE '010DTSBE410 03/18/99'. DTSBE410 00095 SKIP3 DTSBE410 00096 01 WRK-AREA. DTSBE410 00097 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +410.DTSBE410 00098 DTSBE410 00099 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE410'. CL**2 00100 SKIP3 DTSBE410 00101 05 ABEND-MSG PIC X(60). DTSBE410 00102 EJECT DTSBE410 00103 01 L001-LINK-AREA. DTSBE410 00104 ++INCLUDE DTSIL001 CL**2 00105 EJECT DTSBE410 00106 01 L910-LINK-AREA. DTSBE410 00107 ++INCLUDE DTSIL910 CL**2 00108 SKIP3 DTSBE410 00109 01 MSKL-REC. DTSBE410 00110 ++INCLUDE DTSIMSKL CL**2 00111 SKIP3 DTSBE410 00112 01 MAPL-REC. DTSBE410 00113 ++INCLUDE DTSIMAPL CL**2 00114 EJECT DTSBE410 00115 01 R410-REC. DTSBE410 00116 ++INCLUDE DTSIR410 CL**2 00117 EJECT DTSBE410 00118 01 MMAX-LITS. DTSBE410 00119 ++INCLUDE DTSIMMAX CL**2 00120 EJECT DTSBE410 00121 LINKAGE SECTION. DTSBE410 00122 SKIP3 DTSBE410 00123 01 LECM-LINK-AREA. DTSBE410 00124 ++INCLUDE DTSILECM CL**2 00125 EJECT DTSBE410 00126 01 MPRF-LINK-REC. DTSBE410 00127 ++INCLUDE DTSIMPRF CL**2 00128 EJECT DTSBE410 00129 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE410 00130 MPRF-LINK-REC. DTSBE410 00131 SKIP2 DTSBE410 00132 IF LECM-PROCESS-88 DTSBE410 00133 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE410 00134 ELSE DTSBE410 00135 IF LECM-INITIALIZE-88 DTSBE410 00136 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE410 00137 ELSE DTSBE410 00138 IF LECM-TERMINATE-88 DTSBE410 00139 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE410 00140 ELSE DTSBE410 00141 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE410 00142 TO ABEND-MSG DTSBE410 00143 PERFORM S999-ABEND THRU S999-EXIT. DTSBE410 00144 SKIP2 DTSBE410 00145 GOBACK. DTSBE410 00146 EJECT DTSBE410 00147 I0000-INITIALIZE. DTSBE410 00148 SKIP2 DTSBE410 00149 MOVE LENGTH OF R410-REC TO R410-LENGTH. CL*10 00150 MOVE '410' TO R410-REC-TYPE. CL**7 00151 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE410 00152 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE410 00153 DTSBE410 00154 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE410 00155 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE410 00156 SKIP2 DTSBE410 00157 I0000-EXIT. DTSBE410 00158 EXIT. DTSBE410 00159 EJECT DTSBE410 00160 ************************************************************** DTSBE410 00161 * THIS MODULE PROCESSES THE APPEAL RECORDS. DTSBE410 00162 ************************************************************** DTSBE410 00163 DTSBE410 00164 P0000-PROCESS. DTSBE410 00165 DTSBE410 00166 IF MPRF-NO-MAPL-88 DTSBE410 00167 GO TO P0000-EXIT. DTSBE410 00168 DTSBE410 00169 MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSBE410 00170 MOVE MPRF-EMP-NO TO MAPL-EMP-NO. DTSBE410 00171 SET MAPL-APL-88 TO TRUE. DTSBE410 00172 MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSBE410 00173 DTSBE410 00174 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE410 00175 PERFORM P1000-SCAN-MAPL THRU P1000-EXIT DTSBE410 00176 UNTIL L910-NO-REC-88. DTSBE410 00177 SKIP2 DTSBE410 00178 P0000-EXIT. DTSBE410 00179 EXIT. DTSBE410 00180 SKIP3 DTSBE410 00181 ************************************************************** DTSBE410 00182 * THIS MODULE CAUSES THE APPEAL RECORDS TO BE READ. DTSBE410 00183 ************************************************************** DTSBE410 00184 DTSBE410 00185 P1000-SCAN-MAPL. DTSBE410 00186 DTSBE410 00187 MOVE MSKL-REC TO MAPL-REC. DTSBE410 00188 DTSBE410 00189 IF MAPL-STATUS-OPEN-88 DTSBE410 00190 PERFORM P1100-OPEN-MAPL THRU P1100-EXIT. DTSBE410 00191 DTSBE410 00192 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE410 00193 DTSBE410 00194 P1000-EXIT. DTSBE410 00195 EXIT. DTSBE410 00196 EJECT DTSBE410 00197 ************************************************************** DTSBE410 00198 * THIS MODULES SETS UP AND CAUSES THE R410 EXTRACT DTSBE410 00199 * RECORDS TO BE WRITTEN. DTSBE410 00200 ************************************************************** DTSBE410 00201 DTSBE410 00202 P1100-OPEN-MAPL. DTSBE410 00203 SET R410-APPEAL-LEVEL-UNKOWN TO TRUE. DTSBE410 00204 DTSBE410 00205 MOVE +0 TO R410-FILE-DATE. DTSBE410 00206 DTSBE410 00207 PERFORM P1110-DETERMINE-LEVEL THRU P1110-EXIT DTSBE410 00208 VARYING MAPL-LVL-IDX FROM 1 BY 1 DTSBE410 00209 UNTIL MAPL-LVL-IDX GREATER THAN MMAX-APL-LVL-MAX. DTSBE410 00210 DTSBE410 00211 MOVE MAPL-EMP-NO TO R410-EMP-NO. DTSBE410 00212 DTSBE410 00213 MOVE MPRF-PRIMARY-NAME TO R410-PRIMARY-NAME. CL**3 00214 DTSBE410 00215 MOVE MAPL-TYPE TO R410-APPEAL-TYPE. DTSBE410 00216 DTSBE410 00217 MOVE MAPL-OPEN-DATE TO R410-OPEN-DATE. DTSBE410 00218 DTSBE410 00219 PERFORM S946-WRITE-R410 THRU S946-EXIT. DTSBE410 00220 P1100-EXIT. DTSBE410 00221 EXIT. DTSBE410 00222 EJECT DTSBE410 00223 ************************************************************** DTSBE410 00224 * THIS MODULE READS THE OCCURENCES OF THE APPEAL LEVELS IN DTSBE410 00225 * THE MAPL RECORD TO DETERMINE THE LEVEL OF THE APPEAL. DTSBE410 00226 ************************************************************** DTSBE410 00227 DTSBE410 00228 P1110-DETERMINE-LEVEL. DTSBE410 00229 IF MAPL-FILE-DATE (MAPL-LVL-IDX) GREATER THAN ZERO DTSBE410 00230 SET R410-APPEAL-LEVEL-9 TO MAPL-LVL-IDX DTSBE410 00231 MOVE MAPL-FILE-DATE (MAPL-LVL-IDX) DTSBE410 00232 TO R410-FILE-DATE. DTSBE410 00233 P1110-EXIT. DTSBE410 00234 EXIT. DTSBE410 00235 EJECT DTSBE410 00236 T0000-TERMINATE. DTSBE410 00237 SKIP2 DTSBE410 00238 SKIP2 DTSBE410 00239 T0000-EXIT. DTSBE410 00240 EXIT. DTSBE410 00241 EJECT DTSBE410 00242 CL**6 00243 S001-DATE. DTSBE410 00244 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2 00245 S001-EXIT. DTSBE410 00246 EXIT. DTSBE410 00247 SKIP3 DTSBE410 00248 S910-READ. DTSBE410 00249 SET L910-READ-88 TO TRUE. DTSBE410 00250 GO TO S910-MSTR-IO. DTSBE410 00251 DTSBE410 00252 S910-START-BROWSE. DTSBE410 00253 SET L910-START-BROWSE-88 TO TRUE. DTSBE410 00254 GO TO S910-MSTR-IO. DTSBE410 00255 DTSBE410 00256 S910-READ-NEXT. DTSBE410 00257 SET L910-READ-NEXT-88 TO TRUE. DTSBE410 00258 GO TO S910-MSTR-IO. DTSBE410 00259 DTSBE410 00260 S910-MSTR-IO. DTSBE410 00261 CALL 'DTSBU910' USING L910-LINK-AREA CL**2 00262 MSKL-REC. DTSBE410 00263 S910-EXIT. DTSBE410 00264 EXIT. DTSBE410 00265 SKIP3 DTSBE410 00266 S946-WRITE-R410. DTSBE410 00267 CALL 'DTSBU946' USING R410-REC. CL**2 00268 GO TO S946-EXIT. DTSBE410 00269 DTSBE410 00270 S946-EXIT. DTSBE410 00271 EXIT. DTSBE410 00272 SKIP3 DTSBE410 00273 S999-ABEND. DTSBE410 00274 DISPLAY '*** DTSBE410 ABENDING. ' CL**2 00275 ABEND-MSG. DTSBE410 00276 DTSBE410 00277 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00278 S999-EXIT. DTSBE410 00279 EXIT. DTSBE410