932 lines
74 KiB
COBOL
932 lines
74 KiB
COBOL
00001 IDENTIFICATION DIVISION. 03/18/04
|
|
00002 PROGRAM-ID. EFTBD120. EFTBD120
|
|
00003 AUTHOR. NORTHROP GRUMMAN. LV147
|
|
00004 DATE-WRITTEN. JULY 2003. CL168
|
|
00005 DATE-COMPILED. CL146
|
|
00006 SKIP3 CL146
|
|
00007 ***** CL146
|
|
00008 * CL146
|
|
00009 * FUNCTION: 1. THIS PROGRAM PROCESSES STATUS UPDATE RECORDS CL198
|
|
00010 * FROM THE WEB REPORTING SYSTEM. THE EFTIFEST CL232
|
|
00011 * RECORD WHICH CONTAINS THE STATUS OF EACH FIELD CL232
|
|
00012 * TO BE CHANGED. CL*50
|
|
00013 * 2. IT MATCHES THE EMP-NO WITH THE MTAD MASTER TO CL198
|
|
00014 * PRODUCE A BUSINESS T002 STATUS CHANGE REC. ON CL199
|
|
00015 * THE FIELDS OF BUSINESS NAME, ADDRESS, TELEPHONE CL232
|
|
00016 * NUMBER, OR EMAIL ADDRESS. CL232
|
|
00017 * 3. THEN IT MATCHES THE EMP-NO WITH THE MOPO MASTER CL199
|
|
00018 * TO PRODUCE A CONTACT T002 STATUS CHANGE REC. ON CL199
|
|
00019 * THE FIELDS OF CONTACT NAME, SSN, TITLE, TELEPHONE CL232
|
|
00020 * NUMBER, OR FAX NUMBER. CL232
|
|
00021 * 4. IT ALSO PRODUCES PRINTED REPORTS FOR OTHER CL198
|
|
00022 * STATUS CHANGES. CL180
|
|
00023 * CL146
|
|
00024 * MODIFICATION LOG: CL146
|
|
00025 * CL146
|
|
00026 * 07/15/03 INITIAL DEVELOPMENT CL228
|
|
00027 * WORK ORDER: PROGRAMMER: RW1 CL**3
|
|
00028 * CL**3
|
|
00029 * 99/99/99 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00031 * WORK ORDER: PROGRAMMER: XXX CL**3
|
|
00032 * CL146
|
|
00033 * DESCRIPTION: CL146
|
|
00034 * CL146
|
|
00035 * INITIATION: CL146
|
|
00036 * NONE CL*91
|
|
00037 * CL146
|
|
00038 * PARAMETERS INPUT: CL*50
|
|
00039 * NONE CL*91
|
|
00040 * CL*50
|
|
00041 * PROCESSING: CL146
|
|
00042 * READ THE STATUS UPDATE FILE SEQUENTIALLY FROM GOVONE CL169
|
|
00043 * AND MATCHES THE FEST-EMP-NO WITH THE MPRF MASTER FILE, CL170
|
|
00044 * MTAD, AND MOPO FILES TO CREATE A T002 STATUS UPDATE CL*55
|
|
00045 * FILE FOR ACCOUNT UPDATING PROCESSES. CL*50
|
|
00046 * CL181
|
|
00047 * TERMINATION: CL146
|
|
00048 * OUTPUT STATISTICAL RECORDS COUNT. CL*50
|
|
00049 * CL146
|
|
00050 * RECORDS READ: CL206
|
|
00051 * MASTER: CL**3
|
|
00052 * MPRF, MTAD, AND MOPO MASTER FILES. CL*55
|
|
00053 * CL**3
|
|
00054 * ALTERNATE INDEX: CL146
|
|
00055 * YES. CL170
|
|
00056 * CL146
|
|
00057 * REFERENCE: CL146
|
|
00058 * NONE. CL146
|
|
00059 * CL146
|
|
00060 * REPORT RECORDS WRITTEN: CL146
|
|
00061 * STATUS REPORT. CL170
|
|
00062 * CL*50
|
|
00063 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: CL241
|
|
00064 * T002 CL170
|
|
00065 * CL146
|
|
00066 * MODULES CALLED: CL146
|
|
00067 * DTSBU001 DATE CONVERSION/EDIT. CL146
|
|
00068 * DTSBU004 QUARERLY SUMMARY REPORT REC. CL*47
|
|
00069 * DTSBU910 VSAM MASTER FILES I/O. CL*74
|
|
00070 * DTSBU927 VARIABLE LENGTH RECORD BTC OUTPUT. CL166
|
|
00071 * DTSBU941 VARIABLE LENGTH RECORD INPUT 1. CL166
|
|
00072 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. CL*35
|
|
00073 * DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2. CL*35
|
|
00074 * CL146
|
|
00075 * VERMONT REFERENCE: CL146
|
|
00076 * NONE. CL146
|
|
00077 * CL146
|
|
00078 ***** CL146
|
|
00079 SKIP3 CL*13
|
|
00080 ENVIRONMENT DIVISION. CL146
|
|
00081 CL211
|
|
00082 INPUT-OUTPUT SECTION. CL*58
|
|
00083 CL*58
|
|
00084 DATA DIVISION. CL*13
|
|
00085 CL*58
|
|
00086 WORKING-STORAGE SECTION. CL146
|
|
000865 77 PAN-VALET PICTURE X(24) VALUE '147EFTBD120 03/18/04'. CL146
|
|
00087 CL*40
|
|
00088 01 WRK-AREA. CL146
|
|
00089 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120. CL243
|
|
00090 05 WRK-MOD-NAME PIC X(08) VALUE 'EFTBD120'. CL243
|
|
00091 05 WRK-ABEND-MSG PIC X(60). CL*83
|
|
00092 05 WRK-TRACE-IND PIC X(01) VALUE SPACES. CL126
|
|
00093 CL*98
|
|
00094 05 DISP-DATE PIC X(10) VALUE SPACES. CL*92
|
|
00095 05 DISP-TIME PIC X(08) VALUE SPACES. CL*92
|
|
00096 05 DISP-ABSTIME PIC X(16) VALUE SPACES. CL132
|
|
00097 05 WRK-L076-NAME PIC X(32) VALUE SPACES. CL125
|
|
00098 CL132
|
|
00099 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. CL133
|
|
00100 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. CL132
|
|
00101 05 WRK-CURR-YR PIC 9(04) VALUE ZEROS. CL*92
|
|
00102 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL132
|
|
00103 05 WRK-MPRF-FEIN PIC S9(09) COMP-3 VALUE +0. CL102
|
|
00104 CL132
|
|
00105 05 WRK-MPRF-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL101
|
|
00106 05 WRK-ERROR-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*78
|
|
00107 05 WRK-STATUS-READ-CNT PIC S9(07) COMP-3 VALUE +0. CL234
|
|
00108 05 WRK-BTC-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL172
|
|
00109 05 WRK-R907-REC-CNT PIC S9(07) COMP-3 VALUE +0. CL172
|
|
00110 05 WRK-R120-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL*23
|
|
00111 05 WRK-T002-ADDR-CNT PIC S9(07) COMP-3 VALUE +0. CL240
|
|
00112 05 WRK-T002-CONTACT-CNT PIC S9(07) COMP-3 VALUE +0. CL240
|
|
00113 05 WRK-REPORT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. CL209
|
|
00114 CL112
|
|
00115 05 WRK-MPRF-IND PIC X(01). CL182
|
|
00116 88 WRK-MPRF-OK-88 VALUE '0'. CL182
|
|
00117 88 WRK-MPRF-NO-REC-88 VALUE '1'. CL235
|
|
00118 CL182
|
|
00119 05 WRK-ERROR-IND PIC X(01). CL*37
|
|
00120 88 WRK-ERROR-YES-88 VALUE 'Y'. CL182
|
|
00121 88 WRK-ERROR-NO-88 VALUE 'N'. CL182
|
|
00122 CL141
|
|
00123 05 WRK-MOPO-IND PIC X(01). CL141
|
|
00124 88 WRK-MOPO-FOUND-YES-88 VALUE 'Y'. CL182
|
|
00125 88 WRK-MOPO-FOUND-NO-88 VALUE 'N'. CL182
|
|
00126 CL176
|
|
00127 05 WRK-STATUS-CHNG-IND PIC X(01). CL240
|
|
00128 88 WRK-STATUS-CHNG-YES-88 VALUE 'Y'. CL240
|
|
00129 88 WRK-STATUS-CHNG-NO-88 VALUE 'N'. CL240
|
|
00130 CL241
|
|
00131 05 WRK-MTAD-T002-IND PIC X(01). CL*18
|
|
00132 88 WRK-MTAD-T002-YES-88 VALUE 'Y'. CL*18
|
|
00133 88 WRK-MTAD-T002-NO-88 VALUE 'N'. CL*18
|
|
00134 CL238
|
|
00135 05 WRK-MOPO-T002-IND PIC X(01). CL*18
|
|
00136 88 WRK-MOPO-T002-YES-88 VALUE 'Y'. CL*18
|
|
00137 88 WRK-MOPO-T002-NO-88 VALUE 'N'. CL*18
|
|
00138 CL*18
|
|
00139 05 WRK-CONT-T002-IND PIC X(01). CL118
|
|
00140 88 WRK-CONT-T002-YES-88 VALUE 'Y'. CL118
|
|
00141 88 WRK-CONT-T002-NO-88 VALUE 'N'. CL118
|
|
00142 CL118
|
|
00143 05 WRK-NAME-IN PIC X(40). CL238
|
|
00144 05 WRK-NAME-OUT PIC X(40). CL238
|
|
00145 05 START-SUB PIC S9(04) COMP. CL238
|
|
00146 05 SUB1 PIC S9(04) COMP. CL238
|
|
00147 05 SUB2 PIC S9(04) COMP. CL238
|
|
00148 CL*91
|
|
00149 01 ERROR-ADDRESS-AREA. CL*91
|
|
00150 05 FILLER PIC X(03). CL*95
|
|
00151 05 WRK-ERROR-ADDR PIC X(26). CL100
|
|
00152 05 WRK-ERROR-CITY PIC X(16). CL100
|
|
00153 05 WRK-ERROR-STATE PIC X(02). CL*91
|
|
00154 05 FILLER PIC X(01). CL*96
|
|
00155 05 WRK-ERROR-ZIP PIC X(10). CL*91
|
|
00156 CL*91
|
|
00157 01 ERROR-MESSAGE-AREA. CL236
|
|
00158 05 MSG1-CHG-ONLY. CL236
|
|
00159 10 MSG1-ID PIC X(03) VALUE '001'. CL236
|
|
00160 10 MSG1-TEXT. CL236
|
|
00161 15 FILLER PIC X(30) CL236
|
|
00162 VALUE 'TRANSACTION FAILED - CHARGING '. CL236
|
|
00163 15 FILLER PIC X(30) CL236
|
|
00164 VALUE 'ONLY EMPLOYER '. CL236
|
|
00165 CL236
|
|
00166 05 MSG2-INACTIVE. CL236
|
|
00167 10 MSG2-ID PIC X(03) VALUE '002'. CL236
|
|
00168 10 MSG2-TEXT. CL236
|
|
00169 15 FILLER PIC X(30) CL236
|
|
00170 VALUE 'STATUS CHANGE ACCEPTED FOR INA'. CL236
|
|
00171 15 FILLER PIC X(30) CL236
|
|
00172 VALUE 'CTIVE EMPLOYER '. CL236
|
|
00173 CL236
|
|
00174 05 MSG3-NOT-LIABLE. CL236
|
|
00175 10 MSG3-ID PIC X(03) VALUE '003'. CL236
|
|
00176 10 MSG3-TEXT. CL236
|
|
00177 15 FILLER PIC X(30) CL236
|
|
00178 VALUE 'STATUS CHANGE ACCEPTED FOR NON'. CL236
|
|
00179 15 FILLER PIC X(30) CL236
|
|
00180 VALUE '-LIABLE EMPLOYER '. CL236
|
|
00181 CL236
|
|
00182 05 MSG4-INVALID-ADDRESS. CL237
|
|
00183 10 MSG4-ID PIC X(03) VALUE '004'. CL237
|
|
00184 10 MSG4-TEXT. CL237
|
|
00185 15 FILLER PIC X(30) CL237
|
|
00186 VALUE 'TRANSACTION REJECTED - INVALID'. CL237
|
|
00187 15 FILLER PIC X(30) CL237
|
|
00188 VALUE ' ADDRESS '. CL237
|
|
00189 CL237
|
|
00190 05 MSG5-INCOMPLETE-NAMES. CL*71
|
|
00191 10 MSG5-ID PIC X(03) VALUE '005'. CL238
|
|
00192 10 MSG5-TEXT. CL238
|
|
00193 15 FILLER PIC X(30) CL238
|
|
00194 VALUE 'TRANSACTION REJECTED - NO TRAD'. CL*73
|
|
00195 15 FILLER PIC X(30) CL238
|
|
00196 VALUE 'E/ENTITY NAMES '. CL*73
|
|
00197 CL238
|
|
00198 05 MSG6-INCOMPLETE-CONTACT. CL*71
|
|
00199 10 MSG6-ID PIC X(03) VALUE '006'. CL*71
|
|
00200 10 MSG6-TEXT. CL*71
|
|
00201 15 FILLER PIC X(30) CL*71
|
|
00202 VALUE 'TRANSACTION REJECTED - CONTACT'. CL*71
|
|
00203 15 FILLER PIC X(30) CL*71
|
|
00204 VALUE ' INFORMATION NOT COMPLETE '. CL*71
|
|
00205 CL*71
|
|
00206 EJECT CL211
|
|
00207 01 FEST-REC. CL176
|
|
00208 ++INCLUDE EFTIFEST CL167
|
|
00209 SKIP3 CL*58
|
|
00210 01 T002-REC. CL167
|
|
00211 ++INCLUDE DTSIT002 CL167
|
|
00212 SKIP3 CL167
|
|
00213 01 R120-REC. CL*22
|
|
00214 ++INCLUDE EFTIR120 CL*22
|
|
00215 SKIP3 CL*22
|
|
00216 01 EFTE-REC. CL*22
|
|
00217 ++INCLUDE EFTERMSG CL*22
|
|
00218 SKIP3 CL*22
|
|
00219 01 L001-LINK-AREA. CL146
|
|
00220 ++INCLUDE DTSIL001 CL146
|
|
00221 EJECT CL146
|
|
00222 01 L004-LINK-AREA. CL*24
|
|
00223 ++INCLUDE DTSIL004 CL*24
|
|
00224 EJECT CL*24
|
|
00225 01 L005-COMM-AREA. CL*61
|
|
00226 ++INCLUDE DTSIL005 CL*61
|
|
00227 EJECT CL100
|
|
00228 01 L021-COMM-AREA. CL*17
|
|
00229 ++INCLUDE DTSIL021 CL*17
|
|
00230 EJECT CL*17
|
|
00231 01 L072-LINK-AREA. CL242
|
|
00232 ++INCLUDE DTSIL072 CL241
|
|
00233 EJECT CL241
|
|
00234 01 L076-LINK-AREA. CL125
|
|
00235 ++INCLUDE DTSIL076 CL125
|
|
00236 EJECT CL*15
|
|
00237 01 L910-LINK-AREA. CL*94
|
|
00238 ++INCLUDE DTSIL910 CL*94
|
|
00239 EJECT CL162
|
|
00240 01 MSKL-REC. CL234
|
|
00241 ++INCLUDE DTSIMSKL CL234
|
|
00242 EJECT CL234
|
|
00243 01 MPRF-REC. CL234
|
|
00244 ++INCLUDE DTSIMPRF CL234
|
|
00245 EJECT CL234
|
|
00246 01 MTAD-REC. CL234
|
|
00247 ++INCLUDE DTSIMTAD CL234
|
|
00248 EJECT CL234
|
|
00249 01 MOPO-REC. CL234
|
|
00250 ++INCLUDE DTSIMOPO CL234
|
|
00251 EJECT CL234
|
|
00252 01 L927-LINK-AREA. CL173
|
|
00253 ++INCLUDE DTSIL927 CL167
|
|
00254 EJECT CL167
|
|
00255 01 TSKL-REC. CL167
|
|
00256 ++INCLUDE DTSITSKL CL167
|
|
00257 EJECT CL167
|
|
00258 01 L941-LINK-AREA. CL162
|
|
00259 ++INCLUDE DTSIL941 CL162
|
|
00260 EJECT CL*94
|
|
00261 01 STATUS-REC. CL234
|
|
00262 ++INCLUDE DTSIRSK3 CL234
|
|
00263 SKIP3 CL234
|
|
00264 01 F907-REC. CL**8
|
|
00265 ++INCLUDE EFTIF907 CL**6
|
|
00266 EJECT CL226
|
|
00267 CL249
|
|
00268 LINKAGE SECTION. CL249
|
|
00269 01 EFT-REC-TYPE-LINK-AREA. CL249
|
|
00270 ++INCLUDE EFTIL100 CL249
|
|
00271 CL249
|
|
00272 01 RSKL-REC. CL249
|
|
00273 ++INCLUDE EFTIRSKL CL249
|
|
00274 CL249
|
|
00275 PROCEDURE DIVISION USING CL248
|
|
00276 EFT-REC-TYPE-LINK-AREA CL248
|
|
00277 RSKL-REC. CL248
|
|
00278 CL248
|
|
00279 MOVE RSKL-REC TO FEST-REC. CL248
|
|
00280 CL248
|
|
00281 IF EFT-L100-CMD-INIT-88 CL248
|
|
00282 PERFORM I0000-INITIALIZE THRU I0000-EXIT CL248
|
|
00283 ELSE CL248
|
|
00284 IF EFT-L100-CMD-PROCESS-88 CL248
|
|
00285 PERFORM P0000-PROCESS THRU P0000-EXIT CL248
|
|
00286 ELSE CL248
|
|
00287 IF EFT-L100-CMD-TERMINATE-88 CL251
|
|
00288 PERFORM T0000-TERMINATE THRU T0000-EXIT CL248
|
|
00289 ELSE CL248
|
|
00290 DISPLAY 'INVLAID CALL FROM BD100 ' CL248
|
|
00291 PERFORM S999-ABEND THRU S999-EXIT. CL248
|
|
00292 CL*62
|
|
00293 GOBACK. CL146
|
|
00294 EJECT CL146
|
|
00295 I0000-INITIALIZE. CL146
|
|
00296 CL*72
|
|
00297 SET WRK-MPRF-OK-88 TO TRUE. CL151
|
|
00298 CL*72
|
|
00299 PERFORM I1000-SYS-DATE THRU I1000-EXIT. CL*74
|
|
00300 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CL*74
|
|
00301 CL*63
|
|
00302 PERFORM I3000-INIT-T002 THRU I3000-EXIT. CL240
|
|
00303 CL240
|
|
00304 I0000-EXIT. CL146
|
|
00305 EXIT. CL146
|
|
00306 CL107
|
|
00307 I1000-SYS-DATE. CL*72
|
|
00308 SET L005-FROM-SYS TO TRUE. CL*72
|
|
00309 PERFORM S005-SYS-DATE THRU S005-EXIT. CL*72
|
|
00310 MOVE L005-DATE TO DISP-DATE WRK-CURR-DATE. CL132
|
|
00311 MOVE L005-TIME TO DISP-TIME WRK-CURR-TIME. CL132
|
|
00312 MOVE L005-ABSTIME TO DISP-ABSTIME WRK-ABSTIME. CL132
|
|
00313 CL132
|
|
00314 * DISPLAY ' '. CL245
|
|
00315 * DISPLAY 'L005-DATE ' DISP-DATE ' L005-TIME ' DISP-TIME CL245
|
|
00316 * ' L005-ABSTIME ' DISP-ABSTIME. CL247
|
|
00317 I1000-EXIT. CL*72
|
|
00318 EXIT. CL*72
|
|
00319 CL**1
|
|
00320 I2000-OPEN-FILES. CL*72
|
|
00321 CL172
|
|
00322 MOVE LENGTH OF T002-REC TO T002-LENGTH. CL172
|
|
00323 MOVE LENGTH OF F907-REC TO F907-LENGTH. CL**6
|
|
00324 MOVE LENGTH OF R120-REC TO R120-LENGTH. CL*25
|
|
00325 CL161
|
|
00326 I2000-EXIT. CL*72
|
|
00327 EXIT. CL*58
|
|
00328 CL*58
|
|
00329 I3000-INIT-T002. CL240
|
|
00330 CL240
|
|
00331 MOVE ZERO TO T002-EMP-NO CL240
|
|
00332 T002-SYS-DATE CL240
|
|
00333 T002-SYS-TIME. CL240
|
|
00334 CL240
|
|
00335 MOVE SPACES TO T002-ORIGIN CL240
|
|
00336 T002-DATA-AREA. CL240
|
|
00337 CL240
|
|
00338 I3000-EXIT. CL240
|
|
00339 EXIT. CL240
|
|
00340 CL240
|
|
00341 ************************************************************** CL146
|
|
00342 * READ THE EFT STATUS CHANGE FILE FROM GOVONE AND * CL175
|
|
00343 * MATCHES THE EMPLOYER NNUMBER WITH THE MPRF MASTER. * CL175
|
|
00344 ************************************************************** CL146
|
|
00345 CL146
|
|
00346 P0000-PROCESS. CL146
|
|
00347 DISPLAY ' FEST EMP NO...... ' FEST-EMP-NO CL127
|
|
00348 SET WRK-MOPO-FOUND-NO-88 TO TRUE. CL*90
|
|
00349 SET WRK-MTAD-T002-YES-88 TO TRUE. CL138
|
|
00350 SET WRK-MOPO-T002-YES-88 TO TRUE. CL*90
|
|
00351 SET WRK-CONT-T002-YES-88 TO TRUE. CL120
|
|
00352 SET WRK-STATUS-CHNG-NO-88 TO TRUE. CL*90
|
|
00353 ADD +1 TO WRK-STATUS-READ-CNT CL*90
|
|
00354 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90
|
|
00355 CL*18
|
|
00356 PERFORM P1100-READ-MPRF THRU P1100-EXIT CL*90
|
|
00357 CL*18
|
|
00358 IF WRK-MPRF-NO-REC-88 CL*90
|
|
00359 DISPLAY ' EMP REC NOT FOUND ' FEST-EMP-NO CL117
|
|
00360 GO TO P0000-EXIT. CL*90
|
|
00361 CL*18
|
|
00362 PERFORM P1200-CHECK-FEST-NAME THRU P1200-EXIT. CL122
|
|
00363 CL120
|
|
00364 IF WRK-MTAD-T002-YES-88 CL*90
|
|
00365 PERFORM P1300-CHECK-FEST-ADDRESS THRU P1300-EXIT CL135
|
|
00366 PERFORM P1600-CHECK-FEST-DATA THRU P1600-EXIT CL120
|
|
00367 PERFORM P1700-WRITE-MTAD-T002 THRU P1700-EXIT CL134
|
|
00368 ELSE CL120
|
|
00369 DISPLAY '***** NO MTAD T002 REC CREATED ' FEST-EMP-NO. CL134
|
|
00370 * CL120
|
|
00371 ***** WRITE T002 CONTACT REC. CL118
|
|
00372 * CL118
|
|
00373 PERFORM I3000-INIT-T002 THRU I3000-EXIT CL*90
|
|
00374 INITIALIZE MOPO-REC CL*90
|
|
00375 PERFORM P2000-MOPO THRU P2000-EXIT CL*90
|
|
00376 * CL128
|
|
00377 PERFORM P2100-CONT-NAME THRU P2100-EXIT CL128
|
|
00378 * CL118
|
|
00379 IF WRK-CONT-T002-YES-88 CL118
|
|
00380 DISPLAY ' T002 YES FOUND ' FEST-EMP-NO CL127
|
|
00381 PERFORM P2300-WRITE-CONT-T002 THRU P2300-EXIT. CL118
|
|
00382 * CL120
|
|
00383 ***** WRITE 120 REPORT REC. CL118
|
|
00384 * CL118
|
|
00385 PERFORM P3000-STATUS-SALES THRU P3000-EXIT CL*90
|
|
00386 PERFORM P3100-STATUS-PAID THRU P3100-EXIT CL*90
|
|
00387 PERFORM P3200-STATUS-DESC THRU P3200-EXIT CL*90
|
|
00388 PERFORM P3300-STATUS-FEIN THRU P3300-EXIT CL*90
|
|
00389 PERFORM P3400-STATUS-TRACE THRU P3400-EXIT CL*90
|
|
00390 CL*18
|
|
00391 IF WRK-STATUS-CHNG-YES-88 CL*21
|
|
00392 PERFORM P3500-WRITE-R120 THRU P3500-EXIT. CL*36
|
|
00393 CL*18
|
|
00394 P0000-EXIT. CL146
|
|
00395 EXIT. CL146
|
|
00396 CL135
|
|
00397 CL234
|
|
00398 P1100-READ-MPRF. CL235
|
|
00399 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL235
|
|
00400 MOVE FEST-EMP-NO TO MSKL-EMP-NO. CL235
|
|
00401 SET MSKL-PRF-88 TO TRUE. CL235
|
|
00402 PERFORM S910-READ THRU S910-EXIT. CL235
|
|
00403 IF L910-NO-REC-88 CL235
|
|
00404 SET WRK-MPRF-NO-REC-88 TO TRUE CL240
|
|
00405 DISPLAY 'NO MPRF RECORD FOUND ' FEST-EMP-NO CL235
|
|
00406 GO TO P1100-EXIT CL236
|
|
00407 ELSE CL235
|
|
00408 MOVE MSKL-REC TO MPRF-REC CL235
|
|
00409 SET WRK-MPRF-OK-88 TO TRUE CL235
|
|
00410 END-IF. CL235
|
|
00411 CL235
|
|
00412 EVALUATE TRUE CL236
|
|
00413 WHEN MPRF-CLASS-CHG-ONLY-88 CL236
|
|
00414 MOVE MSG1-ID TO F907-MSG-ID CL**6
|
|
00415 MOVE MSG1-TEXT TO F907-MSG-TEXT CL*11
|
|
00416 PERFORM S946-ERROR THRU S946-EXIT CL**6
|
|
00417 CL236
|
|
00418 WHEN MPRF-STATUS-INACT-88 CL236
|
|
00419 MOVE MSG2-ID TO F907-MSG-ID CL**6
|
|
00420 MOVE MSG2-TEXT TO F907-MSG-TEXT CL*11
|
|
00421 PERFORM S946-ERROR THRU S946-EXIT CL**6
|
|
00422 CL236
|
|
00423 WHEN MPRF-STATUS-UNK-88 CL236
|
|
00424 OR MPRF-STATUS-NEVERSUB-88 CL236
|
|
00425 MOVE MSG3-ID TO F907-MSG-ID CL**6
|
|
00426 MOVE MSG3-TEXT TO F907-MSG-TEXT CL*11
|
|
00427 PERFORM S946-ERROR THRU S946-EXIT CL**6
|
|
00428 CL236
|
|
00429 END-EVALUATE. CL236
|
|
00430 CL236
|
|
00431 P1100-EXIT. CL235
|
|
00432 EXIT. CL235
|
|
00433 CL235
|
|
00434 P1200-CHECK-FEST-NAME. CL122
|
|
00435 *BW1 CL*71
|
|
00436 MOVE SPACES TO T002-BSNS-ENTITY-NAME. CL122
|
|
00437 MOVE SPACES TO T002-BSNS-TRADE-NAME. CL122
|
|
00438 CL135
|
|
00439 IF (FEST-TRADE-NAME = SPACES OR LOW-VALUES) AND CL*71
|
|
00440 (FEST-ENTITY-NAME = SPACES OR LOW-VALUES) CL*71
|
|
00441 MOVE MSG5-ID TO F907-MSG-ID CL*71
|
|
00442 MOVE MSG5-TEXT TO F907-MSG-TEXT CL*71
|
|
00443 PERFORM S946-ERROR THRU S946-EXIT CL*71
|
|
00444 SET WRK-MTAD-T002-NO-88 TO TRUE CL135
|
|
00445 GO TO P1200-EXIT. CL*71
|
|
00446 *BW2 CL*71
|
|
00447 CL*71
|
|
00448 IF FEST-TRADE-NAME = SPACES OR LOW-VALUES CL244
|
|
00449 MOVE SPACES TO T002-BSNS-TRADE-NAME CL*55
|
|
00450 ELSE CL244
|
|
00451 MOVE FEST-TRADE-NAME TO WRK-NAME-IN CL236
|
|
00452 MOVE SPACES TO WRK-NAME-OUT CL236
|
|
00453 PERFORM P1210-UPDATE-NAME THRU P1210-EXIT CL241
|
|
00454 MOVE WRK-NAME-OUT TO T002-BSNS-TRADE-NAME CL120
|
|
00455 END-IF. CL236
|
|
00456 CL236
|
|
00457 P1200-EXIT. CL235
|
|
00458 EXIT. CL235
|
|
00459 CL235
|
|
00460 P1210-UPDATE-NAME. CL236
|
|
00461 MOVE +0 TO START-SUB CL236
|
|
00462 SUB2. CL236
|
|
00463 CL236
|
|
00464 IF WRK-NAME-IN (1:2) = 'A ' CL236
|
|
00465 IF WRK-NAME-IN (4:1) = ' ' CL236
|
|
00466 NEXT SENTENCE CL236
|
|
00467 ELSE CL236
|
|
00468 MOVE +3 TO START-SUB CL236
|
|
00469 END-IF CL236
|
|
00470 ELSE CL236
|
|
00471 IF WRK-NAME-IN (1:3) = 'AN ' CL236
|
|
00472 MOVE +4 TO START-SUB CL236
|
|
00473 ELSE CL236
|
|
00474 IF WRK-NAME-IN (1:4) = 'THE ' CL236
|
|
00475 MOVE +5 TO START-SUB CL236
|
|
00476 END-IF CL236
|
|
00477 END-IF CL236
|
|
00478 END-IF. CL236
|
|
00479 CL236
|
|
00480 IF START-SUB > +0 CL236
|
|
00481 PERFORM CL236
|
|
00482 VARYING SUB1 FROM START-SUB BY +1 CL236
|
|
00483 UNTIL SUB1 > +40 CL236
|
|
00484 ADD +1 TO SUB2 CL236
|
|
00485 MOVE WRK-NAME-IN (SUB1:1) TO WRK-NAME-OUT (SUB2:1) CL236
|
|
00486 END-PERFORM CL236
|
|
00487 ELSE CL236
|
|
00488 MOVE WRK-NAME-IN TO WRK-NAME-OUT CL236
|
|
00489 END-IF. CL236
|
|
00490 CL236
|
|
00491 P1210-EXIT. CL236
|
|
00492 EXIT. CL236
|
|
00493 CL236
|
|
00494 P1300-CHECK-FEST-ADDRESS. CL120
|
|
00495 CL120
|
|
00496 SET WRK-MTAD-T002-YES-88 TO TRUE CL120
|
|
00497 MOVE SPACES TO T002-BSNS-ATTN CL120
|
|
00498 MOVE SPACES TO T002-BSNS-DELV1 CL120
|
|
00499 MOVE SPACES TO T002-BSNS-DELV2 CL120
|
|
00500 MOVE SPACES TO T002-BSNS-CITY CL120
|
|
00501 MOVE SPACES TO T002-BSNS-ST CL120
|
|
00502 MOVE SPACES TO T002-BSNS-ZIP CL120
|
|
00503 MOVE SPACES TO T002-BSNS-ENTITY-NAME CL142
|
|
00504 CL**4
|
|
00505 IF FEST-ADDRESS-AREA = SPACES OR LOW-VALUES CL236
|
|
00506 SET WRK-MTAD-T002-NO-88 TO TRUE CL120
|
|
00507 MOVE MSG4-ID TO F907-MSG-ID CL*55
|
|
00508 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*55
|
|
00509 PERFORM S946-ERROR THRU S946-EXIT CL*55
|
|
00510 GO TO P1300-EXIT. CL238
|
|
00511 CL236
|
|
00512 MOVE SPACES TO L072-ADDRESS. CL237
|
|
00513 MOVE 'Y' TO L072-CASS-IND. CL110
|
|
00514 SET L072-MTAD-88 TO TRUE. CL236
|
|
00515 MOVE MPRF-PRIMARY-NAME TO L072-NAME. CL237
|
|
00516 MOVE FEST-ATTN-LINE TO L072-ATTN-LINE. CL237
|
|
00517 MOVE FEST-STREET-ADDRESS-1 TO L072-DELIV-LINE-1. CL236
|
|
00518 MOVE FEST-STREET-ADDRESS-2 TO L072-DELIV-LINE-2. CL236
|
|
00519 MOVE FEST-CITY TO L072-CITY. CL237
|
|
00520 MOVE FEST-STATE TO L072-ST. CL237
|
|
00521 MOVE FEST-ZIP TO L072-ZIP. CL237
|
|
00522 CL*27
|
|
00523 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. CL236
|
|
00524 CL120
|
|
00525 IF L072-ADDRESS-NOT-VALID-88 CL*46
|
|
00526 DISPLAY 'L072 ADDRESS INVALID ' L072-MSG-AREA CL120
|
|
00527 SET WRK-MTAD-T002-NO-88 TO TRUE CL*47
|
|
00528 MOVE MSG4-ID TO F907-MSG-ID CL*46
|
|
00529 MOVE MSG4-TEXT TO F907-MSG-TEXT CL*46
|
|
00530 MOVE FEST-STREET-ADDRESS-2 TO WRK-ERROR-ADDR CL*91
|
|
00531 MOVE FEST-CITY TO WRK-ERROR-CITY CL*91
|
|
00532 MOVE FEST-STATE TO WRK-ERROR-STATE CL*91
|
|
00533 MOVE FEST-ZIP TO WRK-ERROR-ZIP CL*91
|
|
00534 MOVE ERROR-ADDRESS-AREA TO F907-GOV1-REC-ERR CL*93
|
|
00535 PERFORM S946-ERROR THRU S946-EXIT CL*91
|
|
00536 GO TO P1300-EXIT. CL*46
|
|
00537 CL239
|
|
00538 MOVE L072-ATTN-LINE TO T002-BSNS-ATTN. CL121
|
|
00539 MOVE L072-DELIV-LINE-1 TO T002-BSNS-DELV1. CL121
|
|
00540 MOVE L072-DELIV-LINE-2 TO T002-BSNS-DELV2. CL121
|
|
00541 MOVE L072-CITY TO T002-BSNS-CITY. CL121
|
|
00542 MOVE L072-ST TO T002-BSNS-ST. CL121
|
|
00543 MOVE L072-ZIP TO T002-BSNS-ZIP. CL121
|
|
00544 CL115
|
|
00545 P1300-EXIT. CL120
|
|
00546 EXIT. CL120
|
|
00547 CL120
|
|
00548 P1600-CHECK-FEST-DATA. CL120
|
|
00549 CL120
|
|
00550 IF FEST-BUSINESS-PHONE > SPACES CL120
|
|
00551 MOVE FEST-BUSINESS-PHONE TO T002-BUSINESS-VOICE CL120
|
|
00552 *RW1 CL144
|
|
00553 * (THIS IS THE BUSINESS !!!) R120-CONTACT-PHONE CL145
|
|
00554 *RW2 CL144
|
|
00555 ELSE CL120
|
|
00556 MOVE SPACES TO T002-BUSINESS-VOICE. CL120
|
|
00557 CL*18
|
|
00558 IF FEST-FAX > SPACES CL120
|
|
00559 MOVE FEST-FAX TO T002-BUSINESS-FAX CL120
|
|
00560 ELSE CL120
|
|
00561 MOVE SPACES TO T002-BUSINESS-FAX. CL120
|
|
00562 CL*19
|
|
00563 IF FEST-EMAIL-ADDRESS > SPACES CL120
|
|
00564 MOVE FEST-EMAIL-ADDRESS TO T002-BUSINESS-EMAIL CL120
|
|
00565 ELSE CL120
|
|
00566 MOVE SPACES TO T002-BUSINESS-EMAIL. CL120
|
|
00567 CL*19
|
|
00568 P1600-EXIT. CL*19
|
|
00569 EXIT. CL*19
|
|
00570 CL*18
|
|
00571 P1700-WRITE-MTAD-T002. CL134
|
|
00572 CL137
|
|
00573 DISPLAY ' WRITING T002 STATUS REC ' T002-EMP-NO. CL137
|
|
00574 CL137
|
|
00575 IF WRK-MTAD-T002-NO-88 CL137
|
|
00576 GO TO P1700-EXIT. CL137
|
|
00577 CL137
|
|
00578 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL237
|
|
00579 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL237
|
|
00580 MOVE L005-DATE TO T002-SYS-DATE. CL237
|
|
00581 MOVE L005-TIME TO T002-SYS-TIME. CL237
|
|
00582 SET T002-UPD-MAIL-ADDR-88 TO TRUE. CL237
|
|
00583 CL237
|
|
00584 MOVE T002-REC TO TSKL-REC. CL239
|
|
00585 PERFORM S927B-WRITE THRU S927B-EXIT CL239
|
|
00586 ADD +1 TO WRK-T002-ADDR-CNT. CL240
|
|
00587 CL237
|
|
00588 P1700-EXIT. CL*18
|
|
00589 EXIT. CL237
|
|
00590 CL237
|
|
00591 ************************************************************** CL*37
|
|
00592 * USING THE MPRF EMP-NO TO FIND MOPO RECORD. * CL135
|
|
00593 ************************************************************** CL*37
|
|
00594 CL176
|
|
00595 P2000-MOPO. CL239
|
|
00596 CL*17
|
|
00597 MOVE LOW-VALUES TO MOPO-KEY-AREA. CL176
|
|
00598 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. CL176
|
|
00599 SET MOPO-OPO-88 TO TRUE. CL176
|
|
00600 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. CL176
|
|
00601 CL176
|
|
00602 PERFORM S910-START-BROWSE THRU S910-EXIT. CL176
|
|
00603 IF L910-NO-REC-88 CL176
|
|
00604 NEXT SENTENCE CL238
|
|
00605 ELSE CL176
|
|
00606 PERFORM CL176
|
|
00607 UNTIL L910-NO-REC-88 CL176
|
|
00608 OR WRK-MOPO-FOUND-YES-88 CL176
|
|
00609 MOVE MSKL-REC TO MOPO-REC CL*78
|
|
00610 IF MOPO-TYPE-STATUS-88 CL*75
|
|
00611 MOVE MOPO-REC TO MSKL-REC CL*79
|
|
00612 SET WRK-MOPO-FOUND-YES-88 TO TRUE CL192
|
|
00613 ELSE CL192
|
|
00614 PERFORM S910-READ-NEXT THRU S910-EXIT CL176
|
|
00615 END-IF CL176
|
|
00616 END-PERFORM CL176
|
|
00617 END-IF. CL176
|
|
00618 CL**1
|
|
00619 CL179
|
|
00620 P2000-EXIT. CL239
|
|
00621 EXIT. CL176
|
|
00622 CL135
|
|
00623 P2100-CONT-NAME. CL*20
|
|
00624 SET WRK-CONT-T002-YES-88 TO TRUE CL118
|
|
00625 MOVE FEST-CONTACT-FIRST-NAME TO L076-NAMEF CL125
|
|
00626 MOVE FEST-CONTACT-MI TO L076-NAMEI CL125
|
|
00627 MOVE FEST-CONTACT-LAST-NAME TO L076-NAMEL CL125
|
|
00628 CL*28
|
|
00629 PERFORM S076-NAME THRU S076-EXIT CL125
|
|
00630 CL*28
|
|
00631 IF L076-NAME-INVALID CL125
|
|
00632 MOVE '061' TO F907-MSG-ID CL139
|
|
00633 MOVE L076-NAME-GROUP TO F907-GOV1-DATA CL133
|
|
00634 MOVE EFT061 TO F907-MSG-TEXT CL139
|
|
00635 PERFORM S946-ERROR THRU S946-EXIT CL*20
|
|
00636 MOVE SPACES TO F907-GOV1-DATA CL*72
|
|
00637 MOVE SPACES TO T002-CONTACT-NAME CL*20
|
|
00638 *RW1 CL144
|
|
00639 MOVE SPACES TO R120-CONTACT-NAME CL144
|
|
00640 *RW2 CL144
|
|
00641 SET WRK-CONT-T002-NO-88 TO TRUE CL118
|
|
00642 DISPLAY ' INV CONT NAME NO T002 CREATED' FEST-EMP-NO CL118
|
|
00643 ELSE CL118
|
|
00644 DISPLAY ' L076 NAME STATUS CONT NAME ' L076-NAM CL126
|
|
00645 MOVE L076-NAM TO T002-CONTACT-NAME CL142
|
|
00646 R120-CONTACT-NAME. CL142
|
|
00647 CL*28
|
|
00648 P2100-EXIT. CL*20
|
|
00649 EXIT. CL*20
|
|
00650 CL*20
|
|
00651 CL*20
|
|
00652 P2300-WRITE-CONT-T002. CL*81
|
|
00653 CL118
|
|
00654 MOVE SPACES TO TSKL-REC. CL118
|
|
00655 CL118
|
|
00656 MOVE MPRF-EMP-NO TO T002-EMP-NO. CL*20
|
|
00657 MOVE 'AUTOSTATUS' TO T002-ORIGIN. CL*20
|
|
00658 MOVE L005-DATE TO T002-SYS-DATE. CL*20
|
|
00659 MOVE L005-TIME TO T002-SYS-TIME. CL*20
|
|
00660 MOVE ZEROS TO T002-CONTACT-SSN. CL118
|
|
00661 MOVE SPACES TO T002-CONTACT-TITLE. CL118
|
|
00662 MOVE SPACES TO T002-CONTACT-FAX. CL118
|
|
00663 MOVE SPACES TO T002-CONTACT-EMAIL. CL118
|
|
00664 MOVE FEST-CONTACT-AREA-CD TO T002-C-VOICE-AREA-CD. CL119
|
|
00665 MOVE FEST-CONTACT-PREFIX TO T002-C-VOICE-PREFIX. CL119
|
|
00666 MOVE FEST-CONTACT-SUFFIX TO T002-C-VOICE-SUFFIX. CL119
|
|
00667 MOVE FEST-CONTACT-EXT TO T002-C-VOICE-EXT. CL119
|
|
00668 CL*20
|
|
00669 IF WRK-MOPO-FOUND-YES-88 CL*20
|
|
00670 SET T002-UPD-CONTACT-88 TO TRUE CL*20
|
|
00671 ELSE CL*20
|
|
00672 SET T002-ADD-CONTACT-88 TO TRUE CL*20
|
|
00673 END-IF. CL*20
|
|
00674 CL*20
|
|
00675 SET T002-CONTACT-STATUS-88 TO TRUE. CL*76
|
|
00676 CL*20
|
|
00677 MOVE T002-REC TO TSKL-REC. CL*20
|
|
00678 PERFORM S927B-WRITE THRU S927B-EXIT. CL*20
|
|
00679 ADD +1 TO WRK-T002-CONTACT-CNT. CL*20
|
|
00680 CL*81
|
|
00681 CL118
|
|
00682 P2300-EXIT. CL*20
|
|
00683 EXIT. CL*20
|
|
00684 CL*20
|
|
00685 ************************************************************** CL207
|
|
00686 * IF FEST SALE DATE, LAST WAGES PAID DATE, OR STATUS CHANGE * CL209
|
|
00687 * DESCRIPTION FIELDS CONTAIN DATA, PRINT A STATUS CHANGE * CL207
|
|
00688 * REPORT RECORD. * CL207
|
|
00689 ************************************************************** CL207
|
|
00690 CL207
|
|
00691 P3000-STATUS-SALES. CL*21
|
|
00692 CL207
|
|
00693 IF FEST-SALE-DATE NUMERIC CL106
|
|
00694 IF FEST-SALE-DATE > ZEROS CL106
|
|
00695 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106
|
|
00696 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106
|
|
00697 ELSE CL106
|
|
00698 MOVE ZEROS TO R120-SALE-DATE CL106
|
|
00699 END-IF CL106
|
|
00700 ELSE CL106
|
|
00701 MOVE FEST-SALE-DATE TO R120-SALE-DATE CL106
|
|
00702 END-IF. CL106
|
|
00703 CL106
|
|
00704 P3000-EXIT. CL*21
|
|
00705 EXIT. CL*21
|
|
00706 CL*21
|
|
00707 P3100-STATUS-PAID. CL*21
|
|
00708 CL209
|
|
00709 IF FEST-LAST-WAGES-PAID-DATE NUMERIC CL106
|
|
00710 IF FEST-LAST-WAGES-PAID-DATE > ZEROS CL106
|
|
00711 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106
|
|
00712 R120-LAST-WAGES-PAID-DATE CL106
|
|
00713 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL106
|
|
00714 ELSE CL106
|
|
00715 MOVE ZEROS TO R120-LAST-WAGES-PAID-DATE CL106
|
|
00716 END-IF CL106
|
|
00717 ELSE CL106
|
|
00718 MOVE FEST-LAST-WAGES-PAID-DATE TO CL106
|
|
00719 R120-LAST-WAGES-PAID-DATE CL106
|
|
00720 END-IF. CL209
|
|
00721 CL209
|
|
00722 P3100-EXIT. CL*21
|
|
00723 EXIT. CL*21
|
|
00724 CL*21
|
|
00725 P3200-STATUS-DESC. CL*21
|
|
00726 IF FEST-STATUS-CHG-DESCRIPTION NOT = SPACES CL209
|
|
00727 MOVE FEST-STATUS-CHG-DESCRIPTION TO CL209
|
|
00728 R120-STATUS-CHNG-DESC CL*23
|
|
00729 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL241
|
|
00730 ELSE CL221
|
|
00731 MOVE SPACES TO R120-STATUS-CHNG-DESC CL*23
|
|
00732 END-IF. CL209
|
|
00733 CL209
|
|
00734 P3200-EXIT. CL*21
|
|
00735 EXIT. CL*21
|
|
00736 CL*36
|
|
00737 P3300-STATUS-FEIN. CL*36
|
|
00738 * IF FEST-FEIN > ZEROS CL101
|
|
00739 MOVE MPRF-FEIN TO WRK-MPRF-FEIN CL103
|
|
00740 IF FEST-FEIN NOT = WRK-MPRF-FEIN CL102
|
|
00741 MOVE FEST-FEIN TO R120-FEIN CL140
|
|
00742 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL140
|
|
00743 ELSE CL*36
|
|
00744 MOVE ZEROS TO R120-FEIN CL140
|
|
00745 END-IF. CL*36
|
|
00746 CL*36
|
|
00747 P3300-EXIT. CL*36
|
|
00748 EXIT. CL*36
|
|
00749 CL*36
|
|
00750 P3400-STATUS-TRACE. CL*36
|
|
00751 IF FEST-TRACE-NO > ZEROS CL*36
|
|
00752 MOVE FEST-TRACE-NO TO R120-TRACE-NO CL*36
|
|
00753 SET WRK-STATUS-CHNG-YES-88 TO TRUE CL*36
|
|
00754 ELSE CL*36
|
|
00755 MOVE ZEROS TO R120-TRACE-NO CL*36
|
|
00756 END-IF. CL*36
|
|
00757 CL*36
|
|
00758 P3400-EXIT. CL*36
|
|
00759 EXIT. CL*36
|
|
00760 CL*21
|
|
00761 P3500-WRITE-R120. CL*36
|
|
00762 MOVE '120' TO R120-REC-TYPE. CL105
|
|
00763 MOVE MPRF-EMP-NO TO R120-EMP-NO CL105
|
|
00764 *RW1 CL147
|
|
00765 IF MPRF-PRIMARY-IS-ENTITY-88 CL147
|
|
00766 IF FEST-ENTITY-NAME NOT = MPRF-PRIMARY-NAME CL147
|
|
00767 IF FEST-ENTITY-NAME <= SPACES CL147
|
|
00768 MOVE SPACES TO R120-ENTITY-NAME CL147
|
|
00769 ELSE CL147
|
|
00770 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147
|
|
00771 END-IF CL147
|
|
00772 ELSE CL147
|
|
00773 MOVE SPACES TO R120-ENTITY-NAME CL147
|
|
00774 END-IF CL147
|
|
00775 ELSE CL147
|
|
00776 IF FEST-ENTITY-NAME NOT = MPRF-ENTITY-NAME CL147
|
|
00777 IF FEST-ENTITY-NAME <= SPACES CL147
|
|
00778 MOVE SPACES TO R120-ENTITY-NAME CL147
|
|
00779 ELSE CL147
|
|
00780 MOVE FEST-ENTITY-NAME TO R120-ENTITY-NAME CL147
|
|
00781 END-IF CL147
|
|
00782 ELSE CL147
|
|
00783 MOVE SPACES TO R120-ENTITY-NAME CL147
|
|
00784 END-IF CL147
|
|
00785 END-IF. CL147
|
|
00786 CL147
|
|
00787 IF FEST-CONTACT-PHONE > SPACES CL144
|
|
00788 MOVE FEST-CONTACT-AREA-CD TO R120-VOICE-AREA-CD CL144
|
|
00789 MOVE FEST-CONTACT-PREFIX TO R120-VOICE-PREFIX CL144
|
|
00790 MOVE FEST-CONTACT-SUFFIX TO R120-VOICE-SUFFIX CL144
|
|
00791 MOVE FEST-CONTACT-EXT TO R120-VOICE-EXT CL144
|
|
00792 ELSE CL144
|
|
00793 MOVE SPACES TO R120-CONTACT-PHONE. CL144
|
|
00794 *RW2 CL144
|
|
00795 MOVE R120-REC TO RSKL-REC CL105
|
|
00796 PERFORM S946-RPT-O THRU S946-EXIT CL105
|
|
00797 ADD +1 TO WRK-R120-WRITE-CNT. CL105
|
|
00798 CL226
|
|
00799 P3500-EXIT. CL*36
|
|
00800 EXIT. CL207
|
|
00801 CL207
|
|
00802 T0000-TERMINATE. CL146
|
|
00803 CL212
|
|
00804 DISPLAY ' '. CL221
|
|
00805 DISPLAY ' '. CL221
|
|
00806 CL*71
|
|
00807 DISPLAY '*** EFTBD120 TERMINATION STATISTICS ***'. CL243
|
|
00808 CL*71
|
|
00809 DISPLAY ' '. CL237
|
|
00810 DISPLAY ' EFT-STATUS-(01) RECS PASSED FROM BD100 :' CL253
|
|
00811 WRK-STATUS-READ-CNT. CL242
|
|
00812 CL*98
|
|
00813 DISPLAY ' '. CL205
|
|
00814 CL195
|
|
00815 DISPLAY ' T002 MTAD - BUSINESS TRANSACTIONS WRITTEN :' CL*37
|
|
00816 WRK-T002-ADDR-CNT. CL240
|
|
00817 CL205
|
|
00818 DISPLAY ' T002 MOPO - CONTACT TRANSACTIONS WRITTEN :' CL*41
|
|
00819 WRK-T002-CONTACT-CNT. CL240
|
|
00820 CL205
|
|
00821 DISPLAY ' '. CL205
|
|
00822 CL210
|
|
00823 DISPLAY ' REPORT RECS TYPE(120) WRITTEN TO ERROR FILE :' CL*51
|
|
00824 WRK-R120-WRITE-CNT. CL*21
|
|
00825 CL*41
|
|
00826 DISPLAY ' EDIT ERRORS TYPE(907) WRITTEN TO ERROR FILE :' CL*41
|
|
00827 WRK-R907-REC-CNT. CL*41
|
|
00828 CL210
|
|
00829 DISPLAY ' '. CL210
|
|
00830 CL226
|
|
00831 T0000-EXIT. CL146
|
|
00832 EXIT. CL146
|
|
00833 CL*59
|
|
00834 S001-FROM-FED-8. CL108
|
|
00835 SET L001-FROM-FED-8 TO TRUE. CL108
|
|
00836 GO TO S001-DATE. CL108
|
|
00837 CL108
|
|
00838 S001-FROM-ABS-DAY. CL108
|
|
00839 SET L001-FROM-ABS-DAY TO TRUE. CL108
|
|
00840 GO TO S001-DATE. CL108
|
|
00841 CL108
|
|
00842 S001-FROM-CAL-6. CL108
|
|
00843 SET L001-FROM-CAL-6 TO TRUE. CL108
|
|
00844 GO TO S001-DATE. CL108
|
|
00845 CL108
|
|
00846 S001-DATE. CL108
|
|
00847 CALL 'DTSBU001' USING L001-LINK-AREA. CL108
|
|
00848 S001-EXIT. CL108
|
|
00849 EXIT. CL108
|
|
00850 CL*15
|
|
00851 S004-FROM-3. CL*24
|
|
00852 SET L004-FROM-3 TO TRUE. CL*24
|
|
00853 GO TO S004-YRQ. CL*24
|
|
00854 CL*24
|
|
00855 S004-YRQ. CL*24
|
|
00856 CALL 'DTSBU004' USING L004-LINK-AREA. CL*24
|
|
00857 CL*24
|
|
00858 S004-EXIT. CL*24
|
|
00859 EXIT. CL*24
|
|
00860 CL*24
|
|
00861 S005-SYS-DATE. CL*61
|
|
00862 CALL 'DTSBU005' USING L005-COMM-AREA. CL*61
|
|
00863 CL*61
|
|
00864 S005-EXIT. CL*61
|
|
00865 EXIT. CL*61
|
|
00866 CL*17
|
|
00867 S072-ADDRESS-EDIT. CL242
|
|
00868 CALL 'DTSBU072' USING L072-LINK-AREA. CL242
|
|
00869 CL242
|
|
00870 S072-EXIT. CL242
|
|
00871 EXIT. CL242
|
|
00872 CL*15
|
|
00873 S076-NAME. CL126
|
|
00874 CALL 'DTSBU076' USING L076-LINK-AREA. CL126
|
|
00875 CL*15
|
|
00876 S076-EXIT. CL126
|
|
00877 EXIT. CL*15
|
|
00878 CL*70
|
|
00879 S910-READ. CL*70
|
|
00880 SET L910-READ-88 TO TRUE. CL*70
|
|
00881 GO TO S910-MSTR-IO. CL*70
|
|
00882 CL*70
|
|
00883 S910-START-BROWSE. CL*70
|
|
00884 SET L910-START-BROWSE-88 TO TRUE. CL*70
|
|
00885 GO TO S910-MSTR-IO. CL*70
|
|
00886 CL*13
|
|
00887 S910-READ-NEXT. CL*70
|
|
00888 SET L910-READ-NEXT-88 TO TRUE. CL*70
|
|
00889 GO TO S910-MSTR-IO. CL*70
|
|
00890 CL*70
|
|
00891 S910-COUNT. CL*70
|
|
00892 SET L910-COUNT-88 TO TRUE. CL*70
|
|
00893 GO TO S910-MSTR-IO. CL*70
|
|
00894 CL*70
|
|
00895 S910-MSTR-IO. CL*70
|
|
00896 CALL 'DTSBU910' USING L910-LINK-AREA CL*70
|
|
00897 MSKL-REC. CL*70
|
|
00898 S910-EXIT. CL*70
|
|
00899 EXIT. CL*70
|
|
00900 CL*80
|
|
00901 S927B-WRITE. CL238
|
|
00902 SET L927-WRITE-88 TO TRUE. CL166
|
|
00903 CALL 'DTSBU927' USING L927-LINK-AREA CL238
|
|
00904 TSKL-REC. CL238
|
|
00905 CL238
|
|
00906 S927B-EXIT. CL238
|
|
00907 EXIT. CL238
|
|
00908 CL161
|
|
00909 S946-RPT-O. CL226
|
|
00910 CALL 'DTSBU946' USING RSKL-REC. CL252
|
|
00911 GO TO S946-EXIT. CL**6
|
|
00912 CL*42
|
|
00913 S946-ERROR. CL**6
|
|
00914 ADD +1 TO WRK-R907-REC-CNT. CL*43
|
|
00915 MOVE FEST-EMP-NO TO F907-EMP-NO. CL**6
|
|
00916 MOVE '34' TO F907-GOV1-RECID. CL*34
|
|
00917 MOVE 'EFTBD120 ' TO F907-MODULE-NAME. CL*42
|
|
00918 CALL 'DTSBU946' USING F907-REC. CL*42
|
|
00919 CL*42
|
|
00920 S946-EXIT. CL226
|
|
00921 EXIT. CL226
|
|
00922 CL226
|
|
00923 S999-ABEND. CL146
|
|
00924 DISPLAY '*** EFTBD120 ABENDING : ' CL243
|
|
00925 WRK-ABEND-MSG. CL*83
|
|
00926 CL146
|
|
00927 CALL 'DTSBU999' USING WRK-ABEND-CD. CL146
|
|
00928 S999-EXIT. CL146
|
|
00929 EXIT. CL146
|
|
00930 CL*42
|