giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
d3af779d95a270d99a0af8dc4a85856c5a290c9e
DUTAS/CICS/DTSCS63.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2771 lines
216 KiB
COBOL
Raw Blame History

00001 IDENTIFICATION DIVISION. 02/07/12
00002 PROGRAM-ID. DTSCS63. DTSCS63
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV019
00004 DATE-WRITTEN. MAY 1994. DTSCS63
00005 DATE-COMPILED. DTSCS63
00006 SKIP3 DTSCS63
00007 ***** DTSCS63
00008 * DTSCS63
00009 * FUNCTION: AUDIT RESULTS INQUIRY/UPDATE DTSCS63
00010 * SCREEN PROCESSOR. DTSCS63
00011 * DTSCS63
00012 * DTSCS63
00013 * MODIFICATION LOG: DTSCS63
00014 * DTSCS63
00015 * 11/16/98 INITIAL DEVELOPMENT. COPIED FROM MACCS63 DTSCS63
00016 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS63
00017 * DTSCS63
00018 * 02/23/2000 ADDED *-INDCON-TO-EMPL-CNT PROCESSING. DTSCS63
00019 * REFERENCE: UIPL 03-99 PROGRAMMER: EHH DTSCS63
00020 * DTSCS63
00021 * 05/31/2000 MODIFIED TO ASKIP # OF QTRS AUDITED. DTSCS63
00022 * REFERENCE: E001 PROGRAMMER: ZL1 DTSCS63
00023 * DTSCS63
00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS63
00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS63
00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS63
00027 * DTSCS63
00028 * DTSCS63
00029 * DESCRIPTION: DTSCS63
00030 * DTSCS63
00031 * DTSCS63
00032 * CLEAR: DTSCS63
00033 * DTSCS63
00034 * FIELD DISPLAYED: MAP-ASSIGN-NO (FROM LCCM-ASSIGN-NO). DTSCS63
00035 * DTSCS63
00036 * DTSCS63
00037 * JUMP: DTSCS63
00038 * DTSCS63
00039 * F17 REGISTRATION INQUIRY (11). DTSCS63
00040 * F21 FIELD ASSIGNMENT INQUIRY/UPDATE (62). DTSCS63
00041 * F22 QUARTERLY AUDIT RESULTS INQUIRY/UPDATE (64). DTSCS63
00042 * DTSCS63
00043 * DTSCS63
00044 * INQUIRY: DTSCS63
00045 * DTSCS63
00046 * CONTROL FIELD: MAP-ASSIGN-NO. DTSCS63
00047 * DTSCS63
00048 * JUMP IN: DISPLAY MFAS RECORD AND (IF EXISTS) MAUR RECORD DTSCS63
00049 * AND MAUY RECORDS ASSOCIATED WITH LCCM-ASSIGN-NO. DTSCS63
00050 * DTSCS63
00051 * ENTER: DISPLAY MFAS RECORD AND (IF EXISTS) MAUR RECORD DTSCS63
00052 * AND MAUY RECORDS ASSOCIATED WITH MAP-ASSIGN-NO. DTSCS63
00053 * DTSCS63
00054 * JUMP OUT: NO SPECIAL PROCESSING. DTSCS63
00055 * DTSCS63
00056 * NOTE. IF MFAS-NON-AUDIT-88, THEN RATHER THEN DISPLAYING DTSCS63
00057 * THE MFAS RECORD, DISPLAY AN ERROR MESSAGE. DTSCS63
00058 * DTSCS63
00059 * DTSCS63
00060 * LCCM DATA ELEMENT MAINTENANCE: DTSCS63
00061 * DTSCS63
00062 * STANDARD LCCM-ASSIGN-NO MAINTENANCE. DTSCS63
00063 * DTSCS63
00064 * MAINTAIN LCCM-EMP-NO IN SYNC WITH LCCM-ASSIGN-NO. DTSCS63
00065 * DTSCS63
00066 * DTSCS63
00067 * UPDATE: DTSCS63
00068 * DTSCS63
00069 * ADD DTSCS63
00070 * MOD DTSCS63
00071 * DEL DTSCS63
00072 * DTSCS63
00073 * DTSCS63
00074 * RECORDS READ: DTSCS63
00075 * DTSCS63
00076 * MASTER: DTSCS63
00077 * DTSCS63
00078 * MPRF DTSCS63
00079 * MFAS DTSCS63
00080 * MAUR DTSCS63
00081 * MAUY DTSCS63
00082 * DTSCS63
00083 * DTSCS63
00084 * ALTERNATE INDEX: DTSCS63
00085 * DTSCS63
00086 * IFAN DTSCS63
00087 * DTSCS63
00088 * DTSCS63
00089 * REFERENCE: DTSCS63
00090 * DTSCS63
00091 * NONE. DTSCS63
00092 * DTSCS63
00093 * DTSCS63
00094 * ACCOUNTING TRANSACTION COLLECTION: DTSCS63
00095 * DTSCS63
00096 * NONE. DTSCS63
00097 * DTSCS63
00098 * DTSCS63
00099 * RECORDS UPDATED: DTSCS63
00100 * DTSCS63
00101 * MASTER: DTSCS63
00102 * DTSCS63
00103 * MPRF (REWRITE) DTSCS63
00104 * MFAS (REWRITE) DTSCS63
00105 * MAUR (WRITE, REWRITE, DELETE) DTSCS63
00106 * DTSCS63
00107 * DTSCS63
00108 * REFERENCE: DTSCS63
00109 * DTSCS63
00110 * NONE. DTSCS63
00111 * DTSCS63
00112 * DTSCS63
00113 * ACCOUNTING TRANSACTION COLLECTION: DTSCS63
00114 * DTSCS63
00115 * NONE. DTSCS63
00116 * DTSCS63
00117 * DTSCS63
00118 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS63
00119 * DTSCS63
00120 * NONE. DTSCS63
00121 * DTSCS63
00122 * DTSCS63
00123 * TEMPORARY STORAGE USAGE: DTSCS63
00124 * DTSCS63
00125 * NONE. DTSCS63
00126 * DTSCS63
00127 * DTSCS63
00128 * MODULES LINKED TO: DTSCS63
00129 * DTSCS63
00130 * DTSCU001 DATE EDIT/CONVERSION. DTSCS63
00131 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS63
00132 * DTSCU011 MONEY AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS63
00133 * DTSCU013 COUNT FROM SCREEN (INTEGER) FORMAT/EDIT. DTSCS63
00134 * DTSCU014 COUNT FROM SCREEN (TENTHS) FORMAT/EDIT. DTSCS63
00135 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS63
00136 * DTSCU022 FIELD ASSIGNMENT NUMBER FROM SCREEN FORMAT/EDIT. DTSCS63
00137 * DTSCU024 YEAR QUARTER RANGE FROM SCREEN FORMAT/EDIT. DTSCS63
00138 * DTSCU036 FIELD SUPPORT CODES EDIT/DESCRIPTION. DTSCS63
00139 * DTSCU038 R&A CODES EDIT/DESCRIPTION. DTSCS63
00140 * DTSCU063 FIELD ASSIGNMENT TYPE EDIT/DESCRIPTION. DTSCS63
00141 * DTSCU221 PRF-UPDATE FIELDS MAINTENANCE. DTSCS63
00142 * DTSCU331 MODIFICATION LOG UPDATE. DTSCS63
00143 * DTSCU810 MASTER FILE I/O DRIVER. DTSCS63
00144 * DTSCU821 ALTERNATE INDEX FILE I/O. DTSCS63
00145 * DTSCS63
00146 * DTSCS63
00147 * NOTES TO JEFF: DTSCS63
00148 * DTSCS63
00149 * . IN VERMONT WE HAD ONLY ONE AUDIT RESULTS SCREEN (53). DTSCS63
00150 * IN MONTANA, THEY WANTED TO CAPTURE AUDIT RESULTS AT DTSCS63
00151 * A QUARTER LEVEL (IN VERMONT WE CAPTURED THE AUDIT DTSCS63
00152 * RESULTS AT A CALENDAR YEAR LEVEL). THUS, IN MONTANA DTSCS63
00153 * WE HAVE TWO AUDIT RESULTS SCREENS (63 FOR ENTRY OF DTSCS63
00154 * AUDIT LEVEL RESULTS AND DISPLAY OF CALENDAR YEAR DTSCS63
00155 * SUMMARY AUDIT RESULTS; 64 FOR DISPLAY AND ENTRY OF DTSCS63
00156 * QUARTER LEVEL AUDIT RESULTS). DTSCS63
00157 * DTSCS63
00158 * . SCREENS 63 AND 64 ARE RELEVANT IF AND ONLY IF DTSCS63
00159 * THE ASSIGNMENT IS AN "AUDIT" ASSIGNMENT. DTSCS63
00160 * DTSCS63
00161 * . IN VERMONT, COMPLETION DATE IS INPUT ON SCREEN 53. IN DTSCS63
00162 * MONTANA, COMPLETION DATE IS INPUT ON SCREEN 62 (AND DTSCS63
00163 * IS DISPLAY ONLY ON THIS SCREEN). DTSCS63
00164 * DTSCS63
00165 ***** DTSCS63
00166 DTSCS63
00167 ENVIRONMENT DIVISION. DTSCS63
00168 DTSCS63
00169 DATA DIVISION. DTSCS63
00170 DTSCS63
00171 WORKING-STORAGE SECTION. DTSCS63
001715 77 PAN-VALET PICTURE X(24) VALUE '019DTSCS63 02/07/12'. DTSCS63
00172 DTSCS63
00173 01 WRK-AREA. DTSCS63
00174 05 WRK-ABEND-CD PIC X(04) VALUE 'S63 '. DTSCS63
00175 DTSCS63
00176 05 WRK-SCR-ID. DTSCS63
00177 10 WRK-SCR-ID-N PIC 9(02) VALUE 63. DTSCS63
00178 DTSCS63
00179 05 WRK-F03-SCR-ID PIC X(02) VALUE '60'. DTSCS63
00180 DTSCS63
00181 05 SCR-ACCESS-IND PIC X(01). DTSCS63
00182 88 SCR-ACCESS-INQ VALUE '1'. DTSCS63
00183 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS63
00184 DTSCS63
00185 05 CURSOR-SET-IND PIC X(01). DTSCS63
00186 88 CURSOR-SET-YES VALUE 'Y'. DTSCS63
00187 88 CURSOR-SET-NO VALUE 'N'. DTSCS63
00188 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS63
00189 DTSCS63
00190 05 REQ-IND PIC X(01). DTSCS63
00191 88 REQ-ERROR VALUE 'O'. DTSCS63
00192 88 REQ-JUMP VALUE 'J'. DTSCS63
00193 88 REQ-INQUIRE VALUE 'I'. DTSCS63
00194 88 REQ-CLEAR VALUE 'C'. DTSCS63
00195 88 REQ-EDIT VALUE 'E'. DTSCS63
00196 88 REQ-UPDATE VALUE 'U'. DTSCS63
00197 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS63
00198 DTSCS63
00199 05 RESP-IND PIC X(01). DTSCS63
00200 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS63
00201 88 RESP-SEND-MAP VALUE 'M'. DTSCS63
00202 88 RESP-JUMP VALUE 'J'. DTSCS63
00203 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS63
00204 DTSCS63
00205 05 WRK-MSG-AREA PIC X(64). DTSCS63
00206 DTSCS63
00207 05 WRK-ATB-AN PIC X(01). DTSCS63
00208 05 WRK-ATB-NUM PIC X(01). DTSCS63
00209 DTSCS63
00210 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS63
00211 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSCS63
00212 DTSCS63
00213 05 WRK-MPRF-IND PIC X(01). DTSCS63
00214 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS63
00215 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS63
00216 DTSCS63
00217 05 WRK-MFAS-IND PIC X(01). DTSCS63
00218 88 WRK-MFAS-YES-88 VALUE 'Y'. DTSCS63
00219 88 WRK-MFAS-NO-88 VALUE 'N'. DTSCS63
00220 DTSCS63
00221 05 WRK-DISPLAY PIC 9(11). DTSCS63
00222 DTSCS63
00223 05 FILLER REDEFINES WRK-DISPLAY. DTSCS63
00224 10 FILLER PIC X(04). DTSCS63
00225 10 WRK-DISPLAY-ASSIGN-NO-1 PIC X(02). DTSCS63
00226 10 WRK-DISPLAY-ASSIGN-NO-2 PIC X(05). DTSCS63
00227 DTSCS63
00228 05 FILLER REDEFINES WRK-DISPLAY. DTSCS63
00229 10 FILLER PIC X(05). DTSCS63
00230 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS63
00231 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS63
00232 DTSCS63
00233 05 FILLER REDEFINES WRK-DISPLAY. DTSCS63
00234 10 FILLER PIC X(08). DTSCS63
00235 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS63
00236 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS63
00237 DTSCS63
00238 05 FILLER REDEFINES WRK-DISPLAY. DTSCS63
00239 10 FILLER PIC 9(05). DTSCS63
00240 10 WRK-DISPLAY-YR PIC 9(02). DTSCS63
00241 10 WRK-DISPLAY-MO PIC 9(02). DTSCS63
00242 10 WRK-DISPLAY-DA PIC 9(02). DTSCS63
00243 10 WRK-DISPLAY-CAL-YR REDEFINES WRK-DISPLAY-DA DTSCS63
00244 PIC 9(02). DTSCS63
00245 DTSCS63
00246 05 WRK-CTR PIC S9(04) COMP. DTSCS63
00247 DTSCS63
00248 05 WRK-OCC PIC S9(04) COMP. DTSCS63
00249 DTSCS63
00250 05 WRK-MONEY-COLLECT-AMT PIC S9(11)V9(02) COMP-3. DTSCS63
00251 DTSCS63
00252 05 WRK-MONEY-DUE-AMT PIC S9(11)V9(02) COMP-3. DTSCS63
00253 DTSCS63
00254 05 WRK-ACCUM-AREA. DTSCS63
00255 10 WRK-YR-GROSS-PAYROLL PIC S9(11)V9(02) COMP-3. DTSCS63
00256 10 WRK-YR-UNDER-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSCS63
00257 10 WRK-YR-UNDER-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSCS63
00258 10 WRK-YR-UNDER-CONTRIB PIC S9(11)V9(02) COMP-3. DTSCS63
00259 10 WRK-YR-OVER-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSCS63
00260 10 WRK-YR-OVER-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSCS63
00261 10 WRK-YR-OVER-CONTRIB PIC S9(11)V9(02) COMP-3. DTSCS63
00262 DTSCS63
00263 05 WRK-L331-REC-OCC-ID PIC X(20). DTSCS63
00264 05 FILLER REDEFINES WRK-L331-REC-OCC-ID. DTSCS63
00265 10 WRK-L331-ASSIGN-NO PIC 9(09). DTSCS63
00266 10 FILLER PIC X(11). DTSCS63
00267 DTSCS63
00268 * SCREEN SPECIFIC ERROR MESSAGES DTSCS63
00269 DTSCS63
00270 01 MSG-LITERALS. DTSCS63
00271 DTSCS63
00272 05 MSG-E631-AREA. DTSCS63
00273 10 FILLER PIC X(04) VALUE 'E631'. DTSCS63
00274 10 MSG-EMP-NO-IN-ERR PIC 999B999. DTSCS63
00275 10 MSG-E631-MSG PIC X(50) VALUE DTSCS63
00276 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCS63
00277 DTSCS63
00278 05 MSG-E632-AREA. DTSCS63
00279 10 FILLER PIC X(04) VALUE 'E632'. DTSCS63
00280 10 FILLER PIC X(30) DTSCS63
00281 VALUE 'FIRST YRQ GREATER THAN LAST YR'. DTSCS63
00282 10 FILLER PIC X(30) DTSCS63
00283 VALUE 'Q OR INVALID SPAN. '. DTSCS63
00284 DTSCS63
00285 05 MSG-E633-AREA. DTSCS63
00286 10 FILLER PIC X(04) VALUE 'E633'. DTSCS63
00287 10 FILLER PIC X(30) DTSCS63
00288 VALUE 'ADD MUST BE PRECEDED BY AN INQ'. DTSCS63
00289 10 FILLER PIC X(30) DTSCS63
00290 VALUE 'UIRY. '. DTSCS63
00291 DTSCS63
00292 05 MSG-E634-AREA. DTSCS63
00293 10 FILLER PIC X(04) VALUE 'E634'. DTSCS63
00294 10 FILLER PIC X(30) DTSCS63
00295 VALUE 'ASSIGN NO MAY NOT BE CHANGED D'. DTSCS63
00296 10 FILLER PIC X(30) DTSCS63
00297 VALUE 'URING ADD '. DTSCS63
00298 DTSCS63
00299 05 MSG-E635-AREA. DTSCS63
00300 10 FILLER PIC X(04) VALUE 'E635'. DTSCS63
00301 10 FILLER PIC X(30) DTSCS63
00302 VALUE 'ONLY COMPLETED OR PROCESSED AU'. DTSCS63
00303 10 FILLER PIC X(30) DTSCS63
00304 VALUE 'DIT ASSIGNMENTS ALLOWED '. DTSCS63
00305 DTSCS63
00306 05 MSG-E636-AREA. DTSCS63
00307 10 FILLER PIC X(04) VALUE 'E636'. DTSCS63
00308 10 FILLER PIC X(30) DTSCS63
00309 VALUE 'AUDIT RESULTS EXIST FOR QUARTE'. DTSCS63
00310 10 FILLER PIC X(30) DTSCS63
00311 VALUE 'RS OUTSIDE SPAN INDICATED '. DTSCS63
00312 DTSCS63
00313 05 MSG-E637-AREA. DTSCS63
00314 10 FILLER PIC X(04) VALUE 'E637'. DTSCS63
00315 10 FILLER PIC X(30) DTSCS63
00316 VALUE 'NON AUDIT ASSIGNMENT '. DTSCS63
00317 10 FILLER PIC X(30) DTSCS63
00318 VALUE ' '. DTSCS63
00319 DTSCS63
00320 05 MSG-E638-AREA. DTSCS63
00321 10 FILLER PIC X(04) VALUE 'E638'. DTSCS63
00322 10 FILLER PIC X(30) DTSCS63
00323 VALUE 'PROCESSED DATE MUST BE <= CURR'. DTSCS63
00324 10 FILLER PIC X(30) DTSCS63
00325 VALUE 'ENT RUN DATE '. DTSCS63
00326 DTSCS63
00327 05 MSG-E639-AREA. DTSCS63
00328 10 FILLER PIC X(04) VALUE 'E639'. DTSCS63
00329 10 FILLER PIC X(30) DTSCS63
00330 VALUE 'PROCESSED DATE MUST BE >= COMP'. DTSCS63
00331 10 FILLER PIC X(30) DTSCS63
00332 VALUE 'LETED DATE '. DTSCS63
00333 EJECT DTSCS63
00334 01 L001-COMM-AREA. DTSCS63
00335 ++INCLUDE DTSIL001 DTSCS63
00336 EJECT DTSCS63
00337 01 L004-COMM-AREA. DTSCS63
00338 ++INCLUDE DTSIL004 DTSCS63
00339 EJECT DTSCS63
00340 01 L011-COMM-AREA. DTSCS63
00341 ++INCLUDE DTSIL011 DTSCS63
00342 EJECT DTSCS63
00343 01 L013-COMM-AREA. DTSCS63
00344 ++INCLUDE DTSIL013 DTSCS63
00345 EJECT DTSCS63
00346 01 L014-COMM-AREA. DTSCS63
00347 ++INCLUDE DTSIL014 DTSCS63
00348 EJECT DTSCS63
00349 01 L015-COMM-AREA. DTSCS63
00350 ++INCLUDE DTSIL015 DTSCS63
00351 EJECT DTSCS63
00352 01 L022-COMM-AREA. DTSCS63
00353 ++INCLUDE DTSIL022 DTSCS63
00354 EJECT DTSCS63
00355 01 L024-COMM-AREA. DTSCS63
00356 ++INCLUDE DTSIL024 DTSCS63
00357 EJECT DTSCS63
00358 01 L036-COMM-AREA. DTSCS63
00359 ++INCLUDE DTSIL036 DTSCS63
00360 EJECT DTSCS63
00361 01 L038-COMM-AREA. DTSCS63
00362 ++INCLUDE DTSIL038 DTSCS63
00363 EJECT DTSCS63
00364 01 L063-COMM-AREA. DTSCS63
00365 ++INCLUDE DTSIL063 DTSCS63
00366 EJECT DTSCS63
00367 01 L221-COMM-AREA. DTSCS63
00368 ++INCLUDE DTSIL221 DTSCS63
00369 EJECT DTSCS63
00370 01 L331-COMM-AREA. DTSCS63
00371 ++INCLUDE DTSIL331 DTSCS63
00372 EJECT DTSCS63
00373 01 L805-COMM-AREA. DTSCS63
00374 ++INCLUDE DTSIL805 DTSCS63
00375 EJECT DTSCS63
00376 01 L810-COMM-AREA. DTSCS63
00377 05 L810-CONTROL-BLOCK. DTSCS63
00378 ++INCLUDE DTSIL810 DTSCS63
00379 EJECT DTSCS63
00380 05 MSKL-REC. DTSCS63
00381 ++INCLUDE DTSIMSKL DTSCS63
00382 EJECT DTSCS63
00383 * DTSCS63
00384 01 MPRF-REC. DTSCS63
00385 ++INCLUDE DTSIMPRF DTSCS63
00386 EJECT DTSCS63
00387 01 MFAS-REC. DTSCS63
00388 ++INCLUDE DTSIMFAS DTSCS63
00389 EJECT DTSCS63
00390 01 MAUR-REC. DTSCS63
00391 ++INCLUDE DTSIMAUR DTSCS63
00392 EJECT DTSCS63
00393 01 MAUY-REC. DTSCS63
00394 ++INCLUDE DTSIMAUY DTSCS63
00395 EJECT DTSCS63
00396 01 L851-COMM-AREA. DTSCS63
00397 ++INCLUDE DTSIL851 DTSCS63
00398 DTSCS63
00399 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS63
00400 ++INCLUDE DTSIS63 DTSCS63
00401 EJECT DTSCS63
00402 01 L821-COMM-AREA. DTSCS63
00403 05 L821-CONTROL-BLOCK. DTSCS63
00404 ++INCLUDE DTSIL821 DTSCS63
00405 DTSCS63
00406 05 ISKL-REC. DTSCS63
00407 ++INCLUDE DTSIISKL DTSCS63
00408 05 FILLER REDEFINES ISKL-REC. DTSCS63
00409 ++INCLUDE DTSIIFAN DTSCS63
00410 EJECT DTSCS63
00411 01 CATB-LITERALS. DTSCS63
00412 ++INCLUDE DTSICATB DTSCS63
00413 DTSCS63
00414 01 CFKD-LITERALS. DTSCS63
00415 ++INCLUDE DTSICFKD DTSCS63
00416 DTSCS63
00417 01 CECD-LITERALS. DTSCS63
00418 ++INCLUDE DTSICECD DTSCS63
00419 DTSCS63
00420 01 CPCD-LITERALS. DTSCS63
00421 ++INCLUDE DTSICPCD DTSCS63
00422 DTSCS63
00423 01 MMAX-LITERALS. DTSCS63
00424 ++INCLUDE DTSIMMAX DTSCS63
00425 EJECT DTSCS63
00426 LINKAGE SECTION. DTSCS63
00427 DTSCS63
00428 01 DFHCOMMAREA. DTSCS63
00429 ++INCLUDE DTSILCCM DTSCS63
00430 EJECT DTSCS63
00431 ******************************************************************DTSCS63
00432 * *DTSCS63
00433 ******************************************************************DTSCS63
00434 DTSCS63
00435 PROCEDURE DIVISION. DTSCS63
00436 DTSCS63
00437 MOVE +0 TO WRK-EMP-NO. DTSCS63
00438 SET WRK-MPRF-NO-88 TO TRUE. DTSCS63
00439 DTSCS63
00440 SET WRK-MFAS-NO-88 TO TRUE. DTSCS63
00441 DTSCS63
00442 MOVE LOW-VALUES TO MAP-AREA. DTSCS63
00443 DTSCS63
00444 SET CURSOR-SET-NO TO TRUE. DTSCS63
00445 DTSCS63
00446 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS63
00447 TO SCR-ACCESS-IND. DTSCS63
00448 DTSCS63
00449 MOVE SPACE TO REQ-IND. DTSCS63
00450 DTSCS63
00451 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS63
00452 DTSCS63
00453 *----------------------------------------------------- DTSCS63
00454 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS63
00455 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS63
00456 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS63
00457 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS63
00458 * DTSCS63
00459 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS63
00460 * PROCESSED. DTSCS63
00461 * DTSCS63
00462 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS63
00463 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS63
00464 * WORK STATION OPERATOR. DTSCS63
00465 *----------------------------------------------------- DTSCS63
00466 DTSCS63
00467 MOVE SPACE TO RESP-IND. DTSCS63
00468 DTSCS63
00469 IF REQ-ERROR DTSCS63
00470 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS63
00471 ELSE DTSCS63
00472 IF REQ-JUMP DTSCS63
00473 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS63
00474 ELSE DTSCS63
00475 IF REQ-CLEAR DTSCS63
00476 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS63
00477 ELSE DTSCS63
00478 IF REQ-CURSOR-TO-GOTO DTSCS63
00479 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS63
00480 ELSE DTSCS63
00481 IF REQ-INQUIRE DTSCS63
00482 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS63
00483 ELSE DTSCS63
00484 IF REQ-EDIT DTSCS63
00485 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS63
00486 ELSE DTSCS63
00487 IF REQ-UPDATE DTSCS63
00488 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS63
00489 ELSE DTSCS63
00490 GO TO S899-ABEND. DTSCS63
00491 DTSCS63
00492 *----------------------------------------------------- DTSCS63
00493 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS63
00494 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS63
00495 *----------------------------------------------------- DTSCS63
00496 DTSCS63
00497 IF RESP-SEND-MAP DTSCS63
00498 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS63
00499 SET LCCM-END-TASK-88 TO TRUE DTSCS63
00500 ELSE DTSCS63
00501 IF RESP-SEND-MSGONLY DTSCS63
00502 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS63
00503 SET LCCM-END-TASK-88 TO TRUE DTSCS63
00504 ELSE DTSCS63
00505 IF RESP-JUMP DTSCS63
00506 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS63
00507 ELSE DTSCS63
00508 IF RESP-CURSOR-TO-GOTO DTSCS63
00509 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS63
00510 SET LCCM-END-TASK-88 TO TRUE DTSCS63
00511 ELSE DTSCS63
00512 GO TO S899-ABEND. DTSCS63
00513 DTSCS63
00514 MAINLINE-EXIT. DTSCS63
00515 DTSCS63
00516 EXEC CICS DTSCS63
00517 RETURN DTSCS63
00518 END-EXEC. DTSCS63
00519 DTSCS63
00520 GOBACK. DTSCS63
00521 EJECT DTSCS63
00522 /*****************************************************************DTSCS63
00523 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS63
00524 ******************************************************************DTSCS63
00525 P1000-ANALYZE-REQUEST. DTSCS63
00526 DTSCS63
00527 *----------------------------------------------------- DTSCS63
00528 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS63
00529 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS63
00530 * REPLACED WITH ENTER) DTSCS63
00531 *----------------------------------------------------- DTSCS63
00532 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS63
00533 SET LCCM-ENTER-88 TO TRUE DTSCS63
00534 IF LCCM-ASSIGN-NO > ZERO DTSCS63
00535 SET REQ-INQUIRE TO TRUE DTSCS63
00536 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS63
00537 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS63
00538 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2 DTSCS63
00539 ELSE DTSCS63
00540 SET REQ-INQUIRE TO TRUE DTSCS63
00541 END-IF DTSCS63
00542 GO TO P1000-EXIT. DTSCS63
00543 DTSCS63
00544 *----------------------------------------------------- DTSCS63
00545 * MAP IS RECEIVED DTSCS63
00546 *----------------------------------------------------- DTSCS63
00547 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS63
00548 DTSCS63
00549 *----------------------------------------------------- DTSCS63
00550 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS63
00551 * WORK STATION DTSCS63
00552 *----------------------------------------------------- DTSCS63
00553 IF LCCM-CLEAR-88 DTSCS63
00554 SET REQ-CLEAR TO TRUE DTSCS63
00555 GO TO P1000-EXIT. DTSCS63
00556 DTSCS63
00557 *----------------------------------------------------- DTSCS63
00558 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS63
00559 *----------------------------------------------------- DTSCS63
00560 IF LCCM-SCR-UPDATE-LOCKED DTSCS63
00561 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS63
00562 GO TO P1000-EXIT. DTSCS63
00563 DTSCS63
00564 *----------------------------------------------------- DTSCS63
00565 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS63
00566 *----------------------------------------------------- DTSCS63
00567 IF LCCM-PA2-88 DTSCS63
00568 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS63
00569 GO TO P1000-EXIT. DTSCS63
00570 DTSCS63
00571 *----------------------------------------------------- DTSCS63
00572 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS63
00573 *----------------------------------------------------- DTSCS63
00574 IF LCCM-PA-88 DTSCS63
00575 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS63
00576 SET REQ-ERROR TO TRUE DTSCS63
00577 GO TO P1000-EXIT. DTSCS63
00578 DTSCS63
00579 *----------------------------------------------------- DTSCS63
00580 * IF F12 KEY IS PRESS AND UPDATE NOT IN PROGRESS THEN DTSCS63
00581 * CLEAR SCREEN DTSCS63
00582 *----------------------------------------------------- DTSCS63
00583 IF LCCM-F12-88 DTSCS63
00584 MOVE LOW-VALUES TO MAP-AREA DTSCS63
00585 SET REQ-CLEAR TO TRUE DTSCS63
00586 GO TO P1000-EXIT. DTSCS63
00587 DTSCS63
00588 *----------------------------------------------------- DTSCS63
00589 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS63
00590 *----------------------------------------------------- DTSCS63
00591 IF LCCM-F03-88 DTSCS63
00592 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS63
00593 SET REQ-JUMP TO TRUE DTSCS63
00594 GO TO P1000-EXIT. DTSCS63
00595 DTSCS63
00596 *----------------------------------------------------- DTSCS63
00597 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS63
00598 *----------------------------------------------------- DTSCS63
00599 IF LCCM-F04-88 DTSCS63
00600 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS63
00601 SET REQ-JUMP TO TRUE DTSCS63
00602 GO TO P1000-EXIT. DTSCS63
00603 DTSCS63
00604 *--------------------------------------------------------- DTSCS63
00605 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS63
00606 * CORRESPONDENCE SCREEN. DTSCS63
00607 *--------------------------------------------------------- DTSCS63
00608 DTSCS63
00609 IF LCCM-F14-88 DTSCS63
00610 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS63
00611 SET REQ-JUMP TO TRUE DTSCS63
00612 GO TO P1000-EXIT. DTSCS63
00613 DTSCS63
00614 *----------------------------------------------------- DTSCS63
00615 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS63
00616 * REQUESTED SCREEN TYPE DTSCS63
00617 *----------------------------------------------------- DTSCS63
00618 * IF LCCM-F17-88 DTSCS63
00619 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS63
00620 * SET REQ-JUMP TO TRUE DTSCS63
00621 * GO TO P1000-EXIT. DTSCS63
00622 * DTSCS63
00623 * IF LCCM-F21-88 DTSCS63
00624 * MOVE '62' TO LCCM-REQ-SCR-ID DTSCS63
00625 * SET REQ-JUMP TO TRUE DTSCS63
00626 * GO TO P1000-EXIT. DTSCS63
00627 * DTSCS63
00628 * IF LCCM-F22-88 DTSCS63
00629 * MOVE '64' TO LCCM-REQ-SCR-ID DTSCS63
00630 * SET REQ-JUMP TO TRUE DTSCS63
00631 * GO TO P1000-EXIT. DTSCS63
00632 * DTSCS63
00633 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS63
00634 NEXT SENTENCE DTSCS63
00635 ELSE DTSCS63
00636 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS63
00637 SET REQ-JUMP TO TRUE DTSCS63
00638 GO TO P1000-EXIT. DTSCS63
00639 DTSCS63
00640 *----------------------------------------------------- DTSCS63
00641 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS63
00642 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS63
00643 *----------------------------------------------------- DTSCS63
00644 IF LCCM-F09-88 DTSCS63
00645 OR LCCM-F10-88 DTSCS63
00646 OR LCCM-F23-88 DTSCS63
00647 IF SCR-ACCESS-UPDATE DTSCS63
00648 SET REQ-EDIT TO TRUE DTSCS63
00649 GO TO P1000-EXIT DTSCS63
00650 ELSE DTSCS63
00651 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS63
00652 SET REQ-ERROR TO TRUE DTSCS63
00653 GO TO P1000-EXIT. DTSCS63
00654 DTSCS63
00655 *----------------------------------------------------- DTSCS63
00656 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS63
00657 * OR F8), INDICATE INQUIRY REQUEST DTSCS63
00658 *----------------------------------------------------- DTSCS63
00659 IF LCCM-ENTER-88 DTSCS63
00660 SET REQ-INQUIRE TO TRUE DTSCS63
00661 GO TO P1000-EXIT. DTSCS63
00662 DTSCS63
00663 *----------------------------------------------------- DTSCS63
00664 * ANY OTHER KEY IS INVALID DTSCS63
00665 *----------------------------------------------------- DTSCS63
00666 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS63
00667 SET REQ-ERROR TO TRUE. DTSCS63
00668 P1000-EXIT. DTSCS63
00669 EXIT. DTSCS63
00670 DTSCS63
00671 ******************************************************************DTSCS63
00672 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS63
00673 ******************************************************************DTSCS63
00674 DTSCS63
00675 P1100-UPDATE-LOCKED. DTSCS63
00676 *----------------------------------------------------- DTSCS63
00677 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS63
00678 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS63
00679 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS63
00680 *----------------------------------------------------- DTSCS63
00681 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS63
00682 SET REQ-UPDATE TO TRUE DTSCS63
00683 ELSE DTSCS63
00684 SET REQ-ERROR TO TRUE DTSCS63
00685 IF LCCM-SCR-ADD-LOCKED DTSCS63
00686 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS63
00687 ELSE DTSCS63
00688 IF LCCM-SCR-MOD-LOCKED DTSCS63
00689 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS63
00690 ELSE DTSCS63
00691 IF LCCM-SCR-DEL-LOCKED DTSCS63
00692 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS63
00693 ELSE DTSCS63
00694 GO TO S899-ABEND. DTSCS63
00695 P1100-EXIT. DTSCS63
00696 EXIT. DTSCS63
00697 /*****************************************************************DTSCS63
00698 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS63
00699 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS63
00700 ******************************************************************DTSCS63
00701 DTSCS63
00702 P2000-REQUEST-ERROR. DTSCS63
00703 IF LCCM-MSG DTSCS63
00704 SET RESP-SEND-MSGONLY TO TRUE DTSCS63
00705 ELSE DTSCS63
00706 GO TO S899-ABEND DTSCS63
00707 END-IF. DTSCS63
00708 P2000-EXIT. DTSCS63
00709 EXIT. DTSCS63
00710 /*****************************************************************DTSCS63
00711 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS63
00712 ******************************************************************DTSCS63
00713 DTSCS63
00714 P3000-REQUEST-JUMP. DTSCS63
00715 *----------------------------------------------------- DTSCS63
00716 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS63
00717 * BY USER DTSCS63
00718 *----------------------------------------------------- DTSCS63
00719 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS63
00720 DTSCS63
00721 *----------------------------------------------------- DTSCS63
00722 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS63
00723 *----------------------------------------------------- DTSCS63
00724 IF LCCM-MSG DTSCS63
00725 SET RESP-SEND-MSGONLY TO TRUE DTSCS63
00726 SET CURSOR-SET-GOTO TO TRUE DTSCS63
00727 GO TO P3000-EXIT. DTSCS63
00728 SKIP3 DTSCS63
00729 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS63
00730 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS63
00731 IF L022-VALID DTSCS63
00732 MOVE L022-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS63
00733 DTSCS63
00734 *----------------------------------------------------- DTSCS63
00735 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS63
00736 *----------------------------------------------------- DTSCS63
00737 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS63
00738 LCCM-SCR-HOLD-AREA. DTSCS63
00739 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS63
00740 SET RESP-JUMP TO TRUE. DTSCS63
00741 P3000-EXIT. DTSCS63
00742 EXIT. DTSCS63
00743 /*****************************************************************DTSCS63
00744 * CLEAR KEY WAS PRESSED *DTSCS63
00745 ******************************************************************DTSCS63
00746 DTSCS63
00747 P4000-REQUEST-CLEAR. DTSCS63
00748 DTSCS63
00749 *----------------------------------------------------- DTSCS63
00750 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS63
00751 * FIELDS FROM EARLIER REQUESTS DTSCS63
00752 *----------------------------------------------------- DTSCS63
00753 IF LCCM-ASSIGN-NO > ZERO DTSCS63
00754 MOVE LCCM-ASSIGN-NO TO WRK-DISPLAY DTSCS63
00755 MOVE WRK-DISPLAY-ASSIGN-NO-1 TO MAP-ASSIGN-NO-1 DTSCS63
00756 MOVE WRK-DISPLAY-ASSIGN-NO-2 TO MAP-ASSIGN-NO-2. DTSCS63
00757 DTSCS63
00758 MOVE ZERO TO LCCM-ASSIGN-NO DTSCS63
00759 DTSCS63
00760 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS63
00761 DTSCS63
00762 SET LCCM-SCR-CLEAR TO TRUE. DTSCS63
00763 DTSCS63
00764 *****IF SCR-ACCESS-UPDATE DTSCS63
00765 ***** PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS63
00766 *****ELSE DTSCS63
00767 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS63
00768 DTSCS63
00769 SET RESP-SEND-MAP TO TRUE. DTSCS63
00770 P4000-EXIT. DTSCS63
00771 EXIT. DTSCS63
00772 /*****************************************************************DTSCS63
00773 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS63
00774 ******************************************************************DTSCS63
00775 DTSCS63
00776 P5000-CURSOR-TO-GOTO. DTSCS63
00777 SET CURSOR-SET-GOTO TO TRUE. DTSCS63
00778 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS63
00779 P5000-EXIT. DTSCS63
00780 EXIT. DTSCS63
00781 /*****************************************************************DTSCS63
00782 * INQUIRY WAS REQUESTED *DTSCS63
00783 ******************************************************************DTSCS63
00784 DTSCS63
00785 P6000-REQUEST-INQUIRE. DTSCS63
00786 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS63
00787 MOVE LOW-VALUES TO MAP-AREA. DTSCS63
00788 MOVE L022-S-ASSIGN-NO-AREA TO MAP-ASSIGN-NO-AREA. DTSCS63
00789 DTSCS63
00790 SET LCCM-SCR-CLEAR TO TRUE. DTSCS63
00791 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS63
00792 DTSCS63
00793 SET RESP-SEND-MAP TO TRUE. DTSCS63
00794 DTSCS63
00795 *****IF SCR-ACCESS-UPDATE DTSCS63
00796 ***** PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS63
00797 *****ELSE DTSCS63
00798 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS63
00799 DTSCS63
00800 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
00801 IF LCCM-MSG DTSCS63
00802 GO TO P6000-EXIT. DTSCS63
00803 DTSCS63
00804 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
00805 IF LCCM-MSG DTSCS63
00806 GO TO P6000-EXIT. DTSCS63
00807 DTSCS63
00808 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS63
00809 DTSCS63
00810 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS63
00811 DTSCS63
00812 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
00813 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS63
00814 DTSCS63
00815 * FOLLOWING DONE EARLIER DTSCS63
00816 * PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS63
00817 * IF LCCM-MSG DTSCS63
00818 * GO TO P6000-EXIT. DTSCS63
00819 * DTSCS63
00820 DTSCS63
00821 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS63
00822 DTSCS63
00823 *****IF SCR-ACCESS-UPDATE DTSCS63
00824 ***** PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS63
00825 *****END-IF. DTSCS63
00826 DTSCS63
00827 * FOLLOWING MOVED TO P6900 AND P6910 IT IS BASED ON OTHER FACTORS DTSCS63
00828 **** SET LCCM-SCR-INQUIRE TO TRUE. DTSCS63
00829 P6000-EXIT. DTSCS63
00830 EXIT. DTSCS63
00831 EJECT DTSCS63
00832 /*****************************************************************DTSCS63
00833 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS63
00834 ******************************************************************DTSCS63
00835 DTSCS63
00836 P6900-CONSTRUCT-SCREEN. DTSCS63
00837 *** SET LCCM-SCR-CLEAR TO TRUE. DTSCS63
00838 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS63
00839 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS63
00840 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS63
00841 DTSCS63
00842 MOVE MFAS-ASSIGN-TYPE TO MAP-ASSIGN-TYPE. DTSCS63
00843 DTSCS63
00844 IF MFAS-NON-AUDIT-88 DTSCS63
00845 MOVE MSG-E637-AREA TO WRK-MSG-AREA DTSCS63
00846 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
00847 GO TO P6900-EXIT. DTSCS63
00848 DTSCS63
00849 IF MFAS-STATUS-COMPLETE-88 DTSCS63
00850 OR MFAS-STATUS-PROCESSED-88 DTSCS63
00851 CONTINUE DTSCS63
00852 ELSE DTSCS63
00853 MOVE MSG-E635-AREA TO WRK-MSG-AREA DTSCS63
00854 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
00855 GO TO P6900-EXIT DTSCS63
00856 END-IF. DTSCS63
00857 DTSCS63
00858 PERFORM P6910-FROM-MFAS THRU P6910-EXIT. DTSCS63
00859 DTSCS63
00860 PERFORM P6920-FROM-MAUR THRU P6920-EXIT. DTSCS63
00861 DTSCS63
00862 PERFORM P6930-FROM-MAUY THRU P6930-EXIT. DTSCS63
00863 DTSCS63
00864 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS63
00865 DTSCS63
00866 IF SCR-ACCESS-UPDATE DTSCS63
00867 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS63
00868 DTSCS63
00869 P6900-EXIT. DTSCS63
00870 EXIT. DTSCS63
00871 DTSCS63
00872 P6910-FROM-MFAS. DTSCS63
00873 IF MFAS-PROCESSED-DATE > +0 DTSCS63
00874 MOVE MFAS-PROCESSED-DATE TO WRK-DISPLAY DTSCS63
00875 MOVE WRK-DISPLAY-MO TO MAP-PROCESSED-DATE-MO DTSCS63
00876 MOVE WRK-DISPLAY-DA TO MAP-PROCESSED-DATE-DA DTSCS63
00877 MOVE WRK-DISPLAY-YR TO MAP-PROCESSED-DATE-YR DTSCS63
00878 END-IF. DTSCS63
00879 DTSCS63
00880 IF MFAS-COMPLETED-DATE > +0 DTSCS63
00881 MOVE MFAS-COMPLETED-DATE TO L001-FED-8-DATE-9 DTSCS63
00882 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS63
00883 MOVE L001-SLASH-DATE TO MAP-COMPLETED-DATE DTSCS63
00884 END-IF. DTSCS63
00885 P6910-EXIT. DTSCS63
00886 EXIT. DTSCS63
00887 DTSCS63
00888 /*****************************************************************DTSCS63
00889 * NOW SEE IF THERE IS ANY MAUR INFORMATION *DTSCS63
00890 ******************************************************************DTSCS63
00891 P6920-FROM-MAUR. DTSCS63
00892 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS63
00893 MOVE WRK-EMP-NO TO MAUR-EMP-NO. DTSCS63
00894 MOVE WRK-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
00895 SET MAUR-AUR-88 TO TRUE. DTSCS63
00896 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
00897 PERFORM S810-READ THRU S810-EXIT. DTSCS63
00898 IF L810-NO-REC-88 DTSCS63
00899 GO TO P6920-EXIT DTSCS63
00900 END-IF. DTSCS63
00901 DTSCS63
00902 MOVE MSKL-REC TO MAUR-REC. DTSCS63
00903 DTSCS63
00904 MOVE MAUR-FIRST-YRQ TO WRK-DISPLAY. DTSCS63
00905 MOVE WRK-DISPLAY-QTR-YR TO MAP-FIRST-YR. DTSCS63
00906 MOVE WRK-DISPLAY-QTR-Q TO MAP-FIRST-Q. DTSCS63
00907 DTSCS63
00908 MOVE MAUR-LAST-YRQ TO WRK-DISPLAY. DTSCS63
00909 MOVE WRK-DISPLAY-QTR-YR TO MAP-LAST-YR. DTSCS63
00910 MOVE WRK-DISPLAY-QTR-Q TO MAP-LAST-Q. DTSCS63
00911 DTSCS63
00912 MOVE MAUR-QTRS-AUDITED-CNT TO MAP-QTRS-AUDITED-CNT-N. DTSCS63
00913 MOVE MAUR-AUDIT-HRS TO MAP-AUDIT-HRS-N. DTSCS63
00914 MOVE MAUR-EMP-SIZE-IND TO MAP-EMP-SIZE-IND. DTSCS63
00915 DTSCS63
00916 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS63
00917 UNTIL WRK-OCC > MAUR-ERROR-CNT DTSCS63
00918 MOVE MAUR-ERROR-TYPE(WRK-OCC) TO MAP-ERROR-TYPE(WRK-OCC) DTSCS63
00919 END-PERFORM. DTSCS63
00920 DTSCS63
00921 MOVE MAUR-MONEY-DUE-AMT TO MAP-MONEY-DUE-AMT-N. DTSCS63
00922 MOVE MAUR-MONEY-COLLECT-AMT TO MAP-MONEY-COLLECT-AMT-N. DTSCS63
00923 MOVE MAUR-MONEY-REASON-CD TO MAP-MONEY-REASON-CD. DTSCS63
00924 MOVE MAUR-PEN-WAIVE-IND TO MAP-PEN-WAIVER-IND. DTSCS63
00925 MOVE MAUR-INT-WAIVE-IND TO MAP-INT-WAIVER-IND. DTSCS63
00926 MOVE MAUR-NEW-EMPLOYEE-CNT TO MAP-NEW-EMPLOYEE-CNT-N. DTSCS63
00927 MOVE MAUR-INDCON-TO-EMPL-CNT TO MAP-INDCON-TO-EMPL-CNT-N. DTSCS63
00928 DTSCS63
00929 MOVE MAUR-ESTB-DATE TO L001-FED-8-DATE-9. DTSCS63
00930 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS63
00931 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS63
00932 DTSCS63
00933 MOVE MAUR-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS63
00934 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS63
00935 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS63
00936 P6920-EXIT. DTSCS63
00937 EXIT. DTSCS63
00938 DTSCS63
00939 /*****************************************************************DTSCS63
00940 * NOW SEE IF THERE IS ANY MAUY INFORMATION *DTSCS63
00941 ******************************************************************DTSCS63
00942 P6930-FROM-MAUY. DTSCS63
00943 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS63
00944 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS63
00945 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS63
00946 SET MAUY-AUY-88 TO TRUE. DTSCS63
00947 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
00948 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS63
00949 DTSCS63
00950 MOVE +0 TO WRK-CTR. DTSCS63
00951 PERFORM P6931-SUMMARY THRU P6931-EXIT DTSCS63
00952 UNTIL L810-NO-REC-88. DTSCS63
00953 P6930-EXIT. DTSCS63
00954 EXIT. DTSCS63
00955 /*****************************************************************DTSCS63
00956 * DTSCS63
00957 ******************************************************************DTSCS63
00958 DTSCS63
00959 P6931-SUMMARY. DTSCS63
00960 MOVE MSKL-REC TO MAUY-REC. DTSCS63
00961 DTSCS63
00962 IF WRK-ASSIGN-NO = MAUY-ASSIGN-NO DTSCS63
00963 NEXT SENTENCE DTSCS63
00964 ELSE DTSCS63
00965 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS63
00966 SET L810-NO-REC-88 TO TRUE DTSCS63
00967 GO TO P6931-EXIT. DTSCS63
00968 DTSCS63
00969 ADD +1 TO WRK-CTR. DTSCS63
00970 DTSCS63
00971 IF WRK-CTR > +6 DTSCS63
00972 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS63
00973 SET L810-NO-REC-88 TO TRUE DTSCS63
00974 GO TO P6931-EXIT. DTSCS63
00975 DTSCS63
00976 MOVE +0 TO WRK-YR-GROSS-PAYROLL DTSCS63
00977 WRK-YR-UNDER-TOT-WAGE DTSCS63
00978 WRK-YR-UNDER-TAX-WAGE DTSCS63
00979 WRK-YR-UNDER-CONTRIB DTSCS63
00980 WRK-YR-OVER-TOT-WAGE DTSCS63
00981 WRK-YR-OVER-TAX-WAGE DTSCS63
00982 WRK-YR-OVER-CONTRIB. DTSCS63
00983 DTSCS63
00984 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS63
00985 UNTIL WRK-OCC > 4 DTSCS63
00986 ADD MAUY-QTR-GROSS-PAYROLL (WRK-OCC) DTSCS63
00987 TO WRK-YR-GROSS-PAYROLL DTSCS63
00988 ADD MAUY-QTR-UNDER-TOT-WAGE (WRK-OCC) DTSCS63
00989 TO WRK-YR-UNDER-TOT-WAGE DTSCS63
00990 ADD MAUY-QTR-UNDER-TAX-WAGE (WRK-OCC) DTSCS63
00991 TO WRK-YR-UNDER-TAX-WAGE DTSCS63
00992 ADD MAUY-QTR-UNDER-CONTRIB (WRK-OCC) DTSCS63
00993 TO WRK-YR-UNDER-CONTRIB DTSCS63
00994 ADD MAUY-QTR-OVER-TOT-WAGE (WRK-OCC) DTSCS63
00995 TO WRK-YR-OVER-TOT-WAGE DTSCS63
00996 ADD MAUY-QTR-OVER-TAX-WAGE (WRK-OCC) DTSCS63
00997 TO WRK-YR-OVER-TAX-WAGE DTSCS63
00998 ADD MAUY-QTR-OVER-CONTRIB (WRK-OCC) DTSCS63
00999 TO WRK-YR-OVER-CONTRIB DTSCS63
01000 END-PERFORM. DTSCS63
01001 DTSCS63
01002 MOVE MAUY-CALENDAR-YEAR TO WRK-DISPLAY. DTSCS63
01003 MOVE WRK-DISPLAY-CAL-YR TO MAP-YR(WRK-CTR). DTSCS63
01004 MOVE WRK-YR-GROSS-PAYROLL DTSCS63
01005 TO MAP-YR-GROSS-PAYROLL-N (WRK-CTR). DTSCS63
01006 MOVE WRK-YR-UNDER-TOT-WAGE DTSCS63
01007 TO MAP-YR-UNDER-TOT-WAGE-N (WRK-CTR). DTSCS63
01008 MOVE WRK-YR-UNDER-TAX-WAGE DTSCS63
01009 TO MAP-YR-UNDER-TAX-WAGE-N (WRK-CTR). DTSCS63
01010 MOVE WRK-YR-UNDER-CONTRIB DTSCS63
01011 TO MAP-YR-UNDER-CONTRIB-N (WRK-CTR). DTSCS63
01012 MOVE WRK-YR-OVER-TOT-WAGE DTSCS63
01013 TO MAP-YR-OVER-TOT-WAGE-N (WRK-CTR). DTSCS63
01014 MOVE WRK-YR-OVER-TAX-WAGE DTSCS63
01015 TO MAP-YR-OVER-TAX-WAGE-N (WRK-CTR). DTSCS63
01016 MOVE WRK-YR-OVER-CONTRIB DTSCS63
01017 TO MAP-YR-OVER-CONTRIB-N (WRK-CTR). DTSCS63
01018 DTSCS63
01019 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS63
01020 P6931-EXIT. DTSCS63
01021 EXIT. DTSCS63
01022 DTSCS63
01023 /*****************************************************************DTSCS63
01024 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS63
01025 ******************************************************************DTSCS63
01026 DTSCS63
01027 P7000-REQUEST-EDIT. DTSCS63
01028 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS63
01029 DTSCS63
01030 IF LCCM-F09-88 DTSCS63
01031 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS63
01032 ELSE DTSCS63
01033 IF LCCM-F10-88 DTSCS63
01034 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS63
01035 ELSE DTSCS63
01036 IF LCCM-F23-88 DTSCS63
01037 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS63
01038 ELSE DTSCS63
01039 GO TO S899-ABEND. DTSCS63
01040 DTSCS63
01041 *------------------------------------------------------ DTSCS63
01042 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS63
01043 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS63
01044 * REMAIN IN 'INQUIRE' STATUS. DTSCS63
01045 *------------------------------------------------------ DTSCS63
01046 DTSCS63
01047 IF LCCM-MSG DTSCS63
01048 NEXT SENTENCE DTSCS63
01049 ELSE DTSCS63
01050 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS63
01051 IF LCCM-F09-88 DTSCS63
01052 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS63
01053 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS63
01054 ELSE DTSCS63
01055 IF LCCM-F10-88 DTSCS63
01056 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS63
01057 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS63
01058 ELSE DTSCS63
01059 IF LCCM-F23-88 DTSCS63
01060 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS63
01061 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS63
01062 DTSCS63
01063 SET RESP-SEND-MAP TO TRUE. DTSCS63
01064 P7000-EXIT. DTSCS63
01065 EXIT. DTSCS63
01066 /*****************************************************************DTSCS63
01067 * ADD FUNCTION WAS REQUESTED *DTSCS63
01068 ******************************************************************DTSCS63
01069 DTSCS63
01070 P7100-EDIT-ADD. DTSCS63
01071 *----------------------------------------------------- DTSCS63
01072 * ADDITION REQUIRES THAT THE SCREEN WAS CLEARED FIRST DTSCS63
01073 *----------------------------------------------------- DTSCS63
01074 *****IF NOT LCCM-SCR-CLEAR DTSCS63
01075 IF NOT LCCM-SCR-INQUIRE DTSCS63
01076 ******* MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS63
01077 MOVE MSG-E633-AREA TO LCCM-MSG-AREA DTSCS63
01078 GO TO P7100-EXIT. DTSCS63
01079 DTSCS63
01080 *----------------------------------------------------- DTSCS63
01081 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE ADD DTSCS63
01082 *----------------------------------------------------- DTSCS63
01083 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
01084 IF LCCM-MSG DTSCS63
01085 GO TO P7100-EXIT. DTSCS63
01086 DTSCS63
01087 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS63
01088 ******** MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS63
01089 MOVE MSG-E634-AREA TO WRK-MSG-AREA DTSCS63
01090 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
01091 GO TO P7100-EXIT. DTSCS63
01092 DTSCS63
01093 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
01094 IF LCCM-MSG DTSCS63
01095 GO TO P7100-EXIT. DTSCS63
01096 DTSCS63
01097 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS63
01098 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS63
01099 DTSCS63
01100 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
01101 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS63
01102 DTSCS63
01103 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS63
01104 MOVE WRK-EMP-NO TO MAUR-EMP-NO. DTSCS63
01105 SET MAUR-AUR-88 TO TRUE. DTSCS63
01106 MOVE WRK-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
01107 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
01108 PERFORM S810-READ THRU S810-EXIT. DTSCS63
01109 IF L810-OK-88 DTSCS63
01110 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS63
01111 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
01112 GO TO P7100-EXIT. DTSCS63
01113 DTSCS63
01114 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS63
01115 DTSCS63
01116 P7100-EXIT. DTSCS63
01117 EXIT. DTSCS63
01118 /*****************************************************************DTSCS63
01119 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS63
01120 ******************************************************************DTSCS63
01121 DTSCS63
01122 P7200-EDIT-MOD. DTSCS63
01123 *----------------------------------------------------- DTSCS63
01124 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS63
01125 * INQUIRED DTSCS63
01126 *----------------------------------------------------- DTSCS63
01127 IF NOT LCCM-SCR-INQUIRE DTSCS63
01128 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS63
01129 GO TO P7200-EXIT. DTSCS63
01130 DTSCS63
01131 *----------------------------------------------------- DTSCS63
01132 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE MOD DTSCS63
01133 *----------------------------------------------------- DTSCS63
01134 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
01135 IF LCCM-MSG DTSCS63
01136 GO TO P7200-EXIT. DTSCS63
01137 DTSCS63
01138 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS63
01139 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS63
01140 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
01141 GO TO P7200-EXIT. DTSCS63
01142 DTSCS63
01143 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
01144 IF LCCM-MSG DTSCS63
01145 GO TO P7200-EXIT. DTSCS63
01146 DTSCS63
01147 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS63
01148 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS63
01149 DTSCS63
01150 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
01151 DTSCS63
01152 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS63
01153 DTSCS63
01154 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS63
01155 MOVE WRK-EMP-NO TO MAUR-EMP-NO. DTSCS63
01156 SET MAUR-AUR-88 TO TRUE. DTSCS63
01157 MOVE WRK-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
01158 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
01159 PERFORM S810-READ THRU S810-EXIT. DTSCS63
01160 IF L810-NO-REC-88 DTSCS63
01161 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS63
01162 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
01163 GO TO P7200-EXIT. DTSCS63
01164 DTSCS63
01165 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS63
01166 DTSCS63
01167 P7200-EXIT. DTSCS63
01168 EXIT. DTSCS63
01169 /*****************************************************************DTSCS63
01170 * DELETE FUNCTION WAS REQUESTED *DTSCS63
01171 ******************************************************************DTSCS63
01172 DTSCS63
01173 P7300-EDIT-DEL. DTSCS63
01174 *----------------------------------------------------- DTSCS63
01175 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS63
01176 * INQUIRED DTSCS63
01177 *----------------------------------------------------- DTSCS63
01178 IF NOT LCCM-SCR-INQUIRE DTSCS63
01179 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS63
01180 GO TO P7300-EXIT. DTSCS63
01181 DTSCS63
01182 *----------------------------------------------------- DTSCS63
01183 * MAP-ASSIGN-NO MAY NOT BE CHANGED DURING THE DEL DTSCS63
01184 *----------------------------------------------------- DTSCS63
01185 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
01186 IF LCCM-MSG DTSCS63
01187 GO TO P7300-EXIT. DTSCS63
01188 DTSCS63
01189 IF LCCM-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS63
01190 MOVE EMSG-NO-ASSIGN-NO-CHANGE TO WRK-MSG-AREA DTSCS63
01191 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
01192 GO TO P7300-EXIT. DTSCS63
01193 DTSCS63
01194 DTSCS63
01195 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
01196 IF LCCM-MSG DTSCS63
01197 GO TO P7300-EXIT. DTSCS63
01198 DTSCS63
01199 MOVE WRK-ASSIGN-NO TO LCCM-ASSIGN-NO. DTSCS63
01200 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS63
01201 DTSCS63
01202 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
01203 DTSCS63
01204 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS63
01205 DTSCS63
01206 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS63
01207 MOVE WRK-EMP-NO TO MAUR-EMP-NO. DTSCS63
01208 SET MAUR-AUR-88 TO TRUE. DTSCS63
01209 MOVE WRK-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
01210 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
01211 PERFORM S810-READ THRU S810-EXIT. DTSCS63
01212 IF L810-NO-REC-88 DTSCS63
01213 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS63
01214 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
01215 GO TO P7300-EXIT. DTSCS63
01216 DTSCS63
01217 DTSCS63
01218 P7300-EXIT. DTSCS63
01219 EXIT. DTSCS63
01220 /*****************************************************************DTSCS63
01221 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS63
01222 ******************************************************************DTSCS63
01223 DTSCS63
01224 P8000-REQUEST-UPDATE. DTSCS63
01225 DTSCS63
01226 IF LCCM-SCR-ADD-LOCKED DTSCS63
01227 PERFORM P8100-ADD THRU P8100-EXIT DTSCS63
01228 ELSE DTSCS63
01229 IF LCCM-SCR-MOD-LOCKED DTSCS63
01230 PERFORM P8200-MOD THRU P8200-EXIT DTSCS63
01231 ELSE DTSCS63
01232 IF LCCM-SCR-DEL-LOCKED DTSCS63
01233 PERFORM P8300-DEL THRU P8300-EXIT DTSCS63
01234 ELSE DTSCS63
01235 GO TO S899-ABEND. DTSCS63
01236 DTSCS63
01237 SET RESP-SEND-MAP TO TRUE. DTSCS63
01238 P8000-EXIT. DTSCS63
01239 EXIT. DTSCS63
01240 /*****************************************************************DTSCS63
01241 * *DTSCS63
01242 ******************************************************************DTSCS63
01243 DTSCS63
01244 P8100-ADD. DTSCS63
01245 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS63
01246 DTSCS63
01247 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS63
01248 DTSCS63
01249 IF LCCM-F12-88 DTSCS63
01250 SET WRK-MFAS-YES-88 TO TRUE DTSCS63
01251 SET MFAS-STATUS-COMPLETE-88 TO TRUE DTSCS63
01252 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS63
01253 GO TO P8100-EXIT. DTSCS63
01254 DTSCS63
01255 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
01256 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
01257 DTSCS63
01258 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS63
01259 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS63
01260 IF LCCM-MSG DTSCS63
01261 GO TO P8100-EXIT. DTSCS63
01262 DTSCS63
01263 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
01264 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS63
01265 DTSCS63
01266 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS63
01267 DTSCS63
01268 PERFORM P8110-CONSTRUCT-MFAS THRU P8110-EXIT. DTSCS63
01269 PERFORM P8120-CONSTRUCT-MAUR THRU P8120-EXIT. DTSCS63
01270 DTSCS63
01271 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS63
01272 DTSCS63
01273 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS63
01274 DTSCS63
01275 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS63
01276 DTSCS63
01277 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS63
01278 P8100-EXIT. DTSCS63
01279 EXIT. DTSCS63
01280 DTSCS63
01281 /*****************************************************************DTSCS63
01282 * *DTSCS63
01283 ******************************************************************DTSCS63
01284 P8110-CONSTRUCT-MFAS. DTSCS63
01285 MOVE MAP-PROCESSED-DATE-AREA TO L015-S-DATE-AREA. DTSCS63
01286 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS63
01287 DTSCS63
01288 MOVE 'MFAS-PROCESSED-DATE' TO L331-FIELD-NAME. DTSCS63
01289 MOVE SPACES TO L331-FROM-VALUE. DTSCS63
01290 MOVE L015-DATE TO L001-FED-8-DATE-9. DTSCS63
01291 SET L001-FROM-FED-8 TO TRUE. DTSCS63
01292 PERFORM S001-DATE THRU S001-EXIT. DTSCS63
01293 MOVE L001-SLASH-DATE TO L331-TO-VALUE. DTSCS63
01294 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS63
01295 DTSCS63
01296 MOVE L015-DATE TO MFAS-PROCESSED-DATE. DTSCS63
01297 DTSCS63
01298 MOVE 'MFAS-STATUS-CD' TO L331-FIELD-NAME. DTSCS63
01299 MOVE MFAS-STATUS-CD TO L331-FROM-VALUE. DTSCS63
01300 SET MFAS-STATUS-PROCESSED-88 TO TRUE. DTSCS63
01301 MOVE MFAS-STATUS-CD TO L331-TO-VALUE. DTSCS63
01302 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS63
01303 DTSCS63
01304 MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE. DTSCS63
01305 DTSCS63
01306 MOVE MFAS-REC TO MSKL-REC. DTSCS63
01307 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS63
01308 DTSCS63
01309 P8110-EXIT. DTSCS63
01310 EXIT. DTSCS63
01311 /*****************************************************************DTSCS63
01312 * DTSCS63
01313 ******************************************************************DTSCS63
01314 DTSCS63
01315 P8120-CONSTRUCT-MAUR. DTSCS63
01316 MOVE LOW-VALUES TO MAUR-REC. DTSCS63
01317 MOVE MFAS-EMP-NO TO MAUR-EMP-NO. DTSCS63
01318 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
01319 SET MAUR-AUR-88 TO TRUE. DTSCS63
01320 DTSCS63
01321 MOVE +0 TO MAUR-PURGE-DATE. DTSCS63
01322 MOVE LCCM-CURR-RUN-DATE TO MAUR-ESTB-DATE. DTSCS63
01323 MOVE LCCM-CURR-RUN-DATE TO MAUR-CHNG-DATE. DTSCS63
01324 SET MAUR-NOT-CONVERTED-88 TO TRUE. DTSCS63
01325 DTSCS63
01326 MOVE MAP-FIRST-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS63
01327 MOVE MAP-LAST-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS63
01328 PERFORM S024-YRQ-RANGE-FROM-SCREEN THRU S024-EXIT. DTSCS63
01329 MOVE L024-START-YRQ TO MAUR-FIRST-YRQ. DTSCS63
01330 MOVE L024-END-YRQ TO MAUR-LAST-YRQ. DTSCS63
01331 DTSCS63
01332 MOVE MAP-QTRS-AUDITED-CNT-AREA TO L013-S-CNT-AREA. DTSCS63
01333 MOVE +0 TO L013-MIN-CNT. DTSCS63
01334 MOVE +99 TO L013-MAX-CNT. DTSCS63
01335 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
01336 MOVE L013-CNT TO MAUR-QTRS-AUDITED-CNT. DTSCS63
01337 DTSCS63
01338 MOVE MAP-EMP-SIZE-IND TO MAUR-EMP-SIZE-IND DTSCS63
01339 DTSCS63
01340 MOVE +0 TO MAUR-ERROR-CNT. DTSCS63
01341 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS63
01342 UNTIL WRK-OCC > MMAX-AUR-ERROR-MAX DTSCS63
01343 IF MAP-ERROR-TYPE (WRK-OCC) = SPACES OR LOW-VALUES DTSCS63
01344 CONTINUE DTSCS63
01345 ELSE DTSCS63
01346 ADD +1 TO MAUR-ERROR-CNT DTSCS63
01347 MOVE MAP-ERROR-TYPE (WRK-OCC) DTSCS63
01348 TO MAUR-ERROR-TYPE (MAUR-ERROR-CNT) DTSCS63
01349 END-IF DTSCS63
01350 END-PERFORM. DTSCS63
01351 DTSCS63
01352 MOVE MAP-MONEY-DUE-AMT-AREA TO L011-S-AMT-AREA. DTSCS63
01353 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS63
01354 MOVE L011-AMT TO MAUR-MONEY-DUE-AMT. DTSCS63
01355 DTSCS63
01356 MOVE MAP-MONEY-COLLECT-AMT-AREA TO L011-S-AMT-AREA. DTSCS63
01357 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS63
01358 MOVE L011-AMT TO MAUR-MONEY-COLLECT-AMT. DTSCS63
01359 DTSCS63
01360 MOVE MAP-MONEY-REASON-CD TO MAUR-MONEY-REASON-CD. DTSCS63
01361 MOVE MAP-PEN-WAIVER-IND TO MAUR-PEN-WAIVE-IND. DTSCS63
01362 MOVE MAP-INT-WAIVER-IND TO MAUR-INT-WAIVE-IND. DTSCS63
01363 DTSCS63
01364 MOVE MAP-AUDIT-HRS-AREA TO L014-S-CNT-AREA. DTSCS63
01365 PERFORM S014-COUNT-TENTHS-SCREEN THRU S014-EXIT. DTSCS63
01366 MOVE L014-CNT TO MAUR-AUDIT-HRS. DTSCS63
01367 DTSCS63
01368 MOVE MAP-NEW-EMPLOYEE-CNT-AREA TO L013-S-CNT-AREA DTSCS63
01369 MOVE +0 TO L013-MIN-CNT. DTSCS63
01370 MOVE +99999 TO L013-MAX-CNT. DTSCS63
01371 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
01372 MOVE L013-CNT TO MAUR-NEW-EMPLOYEE-CNT. DTSCS63
01373 DTSCS63
01374 MOVE MAP-INDCON-TO-EMPL-CNT-AREA TO L013-S-CNT-AREA DTSCS63
01375 MOVE +0 TO L013-MIN-CNT. DTSCS63
01376 MOVE +99999 TO L013-MAX-CNT. DTSCS63
01377 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
01378 MOVE L013-CNT TO MAUR-INDCON-TO-EMPL-CNT. DTSCS63
01379 DTSCS63
01380 MOVE MAUR-REC TO MSKL-REC. DTSCS63
01381 PERFORM S810-WRITE THRU S810-EXIT. DTSCS63
01382 P8120-EXIT. DTSCS63
01383 EXIT. DTSCS63
01384 /*****************************************************************DTSCS63
01385 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS63
01386 ******************************************************************DTSCS63
01387 DTSCS63
01388 P8200-MOD. DTSCS63
01389 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS63
01390 DTSCS63
01391 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS63
01392 DTSCS63
01393 IF LCCM-F12-88 DTSCS63
01394 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS63
01395 GO TO P8200-EXIT. DTSCS63
01396 DTSCS63
01397 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
01398 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
01399 DTSCS63
01400 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS63
01401 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS63
01402 IF LCCM-MSG DTSCS63
01403 GO TO P8200-EXIT. DTSCS63
01404 DTSCS63
01405 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
01406 PERFORM S1130-READ-MPRF THRU S1130-EXIT. DTSCS63
01407 DTSCS63
01408 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS63
01409 DTSCS63
01410 PERFORM P8210-CONSTRUCT-MFAS THRU P8210-EXIT. DTSCS63
01411 PERFORM P8220-CONSTRUCT-MAUR THRU P8220-EXIT. DTSCS63
01412 DTSCS63
01413 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS63
01414 DTSCS63
01415 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS63
01416 DTSCS63
01417 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS63
01418 P8200-EXIT. DTSCS63
01419 EXIT. DTSCS63
01420 EJECT DTSCS63
01421 DTSCS63
01422 /*****************************************************************DTSCS63
01423 * DTSCS63
01424 ******************************************************************DTSCS63
01425 DTSCS63
01426 P8210-CONSTRUCT-MFAS. DTSCS63
01427 DTSCS63
01428 MOVE MAP-PROCESSED-DATE-AREA TO L015-S-DATE-AREA. DTSCS63
01429 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS63
01430 IF L015-DATE = MFAS-PROCESSED-DATE DTSCS63
01431 GO TO P8210-EXIT DTSCS63
01432 END-IF. DTSCS63
01433 DTSCS63
01434 MOVE 'MFAS-PROCESSED-DATE' TO L331-FIELD-NAME. DTSCS63
01435 MOVE MFAS-PROCESSED-DATE TO L001-FED-8-DATE-9. DTSCS63
01436 SET L001-FROM-FED-8 TO TRUE. DTSCS63
01437 PERFORM S001-DATE THRU S001-EXIT. DTSCS63
01438 MOVE L001-SLASH-DATE TO L331-FROM-VALUE. DTSCS63
01439 DTSCS63
01440 MOVE L015-DATE TO L001-FED-8-DATE-9. DTSCS63
01441 SET L001-FROM-FED-8 TO TRUE. DTSCS63
01442 PERFORM S001-DATE THRU S001-EXIT. DTSCS63
01443 MOVE L001-SLASH-DATE TO L331-TO-VALUE. DTSCS63
01444 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS63
01445 DTSCS63
01446 MOVE L015-DATE TO MFAS-PROCESSED-DATE DTSCS63
01447 DTSCS63
01448 MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE. DTSCS63
01449 DTSCS63
01450 MOVE MFAS-REC TO MSKL-REC. DTSCS63
01451 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS63
01452 P8210-EXIT. DTSCS63
01453 EXIT. DTSCS63
01454 /*****************************************************************DTSCS63
01455 * DTSCS63
01456 ******************************************************************DTSCS63
01457 DTSCS63
01458 P8220-CONSTRUCT-MAUR. DTSCS63
01459 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS63
01460 MOVE MFAS-EMP-NO TO MAUR-EMP-NO. DTSCS63
01461 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
01462 SET MAUR-AUR-88 TO TRUE. DTSCS63
01463 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
01464 PERFORM S810-READ THRU S810-EXIT. DTSCS63
01465 IF L810-NO-REC-88 DTSCS63
01466 GO TO S899-ABEND DTSCS63
01467 END-IF. DTSCS63
01468 DTSCS63
01469 MOVE MSKL-REC TO MAUR-REC. DTSCS63
01470 MOVE LCCM-CURR-RUN-DATE TO MAUR-CHNG-DATE. DTSCS63
01471 DTSCS63
01472 MOVE MAP-FIRST-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS63
01473 MOVE MAP-LAST-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS63
01474 PERFORM S024-YRQ-RANGE-FROM-SCREEN THRU S024-EXIT. DTSCS63
01475 MOVE L024-START-YRQ TO MAUR-FIRST-YRQ. DTSCS63
01476 MOVE L024-END-YRQ TO MAUR-LAST-YRQ. DTSCS63
01477 DTSCS63
01478 MOVE MAP-QTRS-AUDITED-CNT-AREA TO L013-S-CNT-AREA. DTSCS63
01479 MOVE +0 TO L013-MIN-CNT. DTSCS63
01480 MOVE +99 TO L013-MAX-CNT DTSCS63
01481 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
01482 MOVE L013-CNT TO MAUR-QTRS-AUDITED-CNT. DTSCS63
01483 DTSCS63
01484 MOVE MAP-EMP-SIZE-IND TO MAUR-EMP-SIZE-IND DTSCS63
01485 DTSCS63
01486 MOVE +0 TO MAUR-ERROR-CNT. DTSCS63
01487 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS63
01488 UNTIL WRK-OCC > 5 DTSCS63
01489 IF MAP-ERROR-TYPE(WRK-OCC) = SPACES OR LOW-VALUES DTSCS63
01490 CONTINUE DTSCS63
01491 ELSE DTSCS63
01492 ADD +1 TO MAUR-ERROR-CNT DTSCS63
01493 MOVE MAP-ERROR-TYPE (WRK-OCC) DTSCS63
01494 TO MAUR-ERROR-TYPE (MAUR-ERROR-CNT) DTSCS63
01495 END-IF DTSCS63
01496 END-PERFORM. DTSCS63
01497 DTSCS63
01498 MOVE MAP-MONEY-DUE-AMT-AREA TO L011-S-AMT-AREA. DTSCS63
01499 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS63
01500 MOVE L011-AMT TO MAUR-MONEY-DUE-AMT. DTSCS63
01501 DTSCS63
01502 MOVE MAP-MONEY-COLLECT-AMT-AREA TO L011-S-AMT-AREA. DTSCS63
01503 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS63
01504 MOVE L011-AMT TO MAUR-MONEY-COLLECT-AMT. DTSCS63
01505 DTSCS63
01506 MOVE MAP-MONEY-REASON-CD TO MAUR-MONEY-REASON-CD. DTSCS63
01507 MOVE MAP-PEN-WAIVER-IND TO MAUR-PEN-WAIVE-IND. DTSCS63
01508 MOVE MAP-INT-WAIVER-IND TO MAUR-INT-WAIVE-IND. DTSCS63
01509 DTSCS63
01510 MOVE MAP-AUDIT-HRS-AREA TO L014-S-CNT-AREA. DTSCS63
01511 PERFORM S014-COUNT-TENTHS-SCREEN THRU S014-EXIT. DTSCS63
01512 MOVE L014-CNT TO MAUR-AUDIT-HRS. DTSCS63
01513 DTSCS63
01514 MOVE MAP-NEW-EMPLOYEE-CNT-AREA TO L013-S-CNT-AREA. DTSCS63
01515 MOVE +0 TO L013-MIN-CNT. DTSCS63
01516 MOVE +99999 TO L013-MAX-CNT. DTSCS63
01517 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
01518 MOVE L013-CNT TO MAUR-NEW-EMPLOYEE-CNT. DTSCS63
01519 DTSCS63
01520 MOVE MAP-INDCON-TO-EMPL-CNT-AREA TO L013-S-CNT-AREA. DTSCS63
01521 MOVE +0 TO L013-MIN-CNT. DTSCS63
01522 MOVE +99999 TO L013-MAX-CNT. DTSCS63
01523 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
01524 MOVE L013-CNT TO MAUR-INDCON-TO-EMPL-CNT.DTSCS63
01525 DTSCS63
01526 MOVE MAUR-REC TO MSKL-REC. DTSCS63
01527 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS63
01528 DTSCS63
01529 MOVE MAUR-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS63
01530 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS63
01531 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS63
01532 P8220-EXIT. DTSCS63
01533 EXIT. DTSCS63
01534 /*****************************************************************DTSCS63
01535 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS63
01536 ******************************************************************DTSCS63
01537 DTSCS63
01538 P8300-DEL. DTSCS63
01539 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS63
01540 DTSCS63
01541 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS63
01542 DTSCS63
01543 IF LCCM-F12-88 DTSCS63
01544 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS63
01545 GO TO P8300-EXIT. DTSCS63
01546 DTSCS63
01547 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS63
01548 PERFORM S1120-READ-IFAN THRU S1120-EXIT. DTSCS63
01549 DTSCS63
01550 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS63
01551 PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT. DTSCS63
01552 IF LCCM-MSG DTSCS63
01553 GO TO P8300-EXIT. DTSCS63
01554 DTSCS63
01555 PERFORM S1110-READ-MFAS THRU S1110-EXIT. DTSCS63
01556 DTSCS63
01557 PERFORM S810-READ THRU S810-EXIT. DTSCS63
01558 IF L810-NO-REC-88 DTSCS63
01559 GO TO S899-ABEND. DTSCS63
01560 DTSCS63
01561 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS63
01562 DTSCS63
01563 PERFORM P8310-DECONSTRUCT-MFAS THRU P8310-EXIT DTSCS63
01564 PERFORM P8320-DESTRUCT-MAUR THRU P8320-EXIT DTSCS63
01565 PERFORM P8330-DESTRUCT-MAUY THRU P8330-EXIT DTSCS63
01566 DTSCS63
01567 *****PERFORM S810-DELETE THRU S810-EXIT. DTSCS63
01568 DTSCS63
01569 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS63
01570 DTSCS63
01571 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS63
01572 DTSCS63
01573 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS63
01574 DTSCS63
01575 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS63
01576 P8300-EXIT. DTSCS63
01577 EXIT. DTSCS63
01578 EJECT DTSCS63
01579 DTSCS63
01580 P8310-DECONSTRUCT-MFAS. DTSCS63
01581 MOVE 'MFAS-PROCESSED-DATE' TO L331-FIELD-NAME. DTSCS63
01582 MOVE MFAS-PROCESSED-DATE TO L001-FED-8-DATE-9. DTSCS63
01583 SET L001-FROM-FED-8 TO TRUE. DTSCS63
01584 PERFORM S001-DATE THRU S001-EXIT. DTSCS63
01585 MOVE L001-SLASH-DATE TO L331-FROM-VALUE. DTSCS63
01586 DTSCS63
01587 MOVE SPACES TO L331-TO-VALUE. DTSCS63
01588 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS63
01589 DTSCS63
01590 MOVE +0 TO MFAS-PROCESSED-DATE. DTSCS63
01591 DTSCS63
01592 MOVE 'MFAS-STATUS-CD' TO L331-FIELD-NAME. DTSCS63
01593 MOVE MFAS-STATUS-CD TO L331-FROM-VALUE. DTSCS63
01594 DTSCS63
01595 SET MFAS-STATUS-COMPLETE-88 TO TRUE. DTSCS63
01596 MOVE MFAS-STATUS-CD TO L331-TO-VALUE. DTSCS63
01597 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS63
01598 DTSCS63
01599 MOVE LCCM-CURR-RUN-DATE TO MFAS-CHNG-DATE. DTSCS63
01600 DTSCS63
01601 MOVE MFAS-REC TO MSKL-REC. DTSCS63
01602 DTSCS63
01603 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS63
01604 P8310-EXIT. DTSCS63
01605 EXIT. DTSCS63
01606 EJECT DTSCS63
01607 DTSCS63
01608 P8320-DESTRUCT-MAUR. DTSCS63
01609 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSCS63
01610 MOVE MFAS-EMP-NO TO MAUR-EMP-NO. DTSCS63
01611 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSCS63
01612 SET MAUR-AUR-88 TO TRUE. DTSCS63
01613 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
01614 PERFORM S810-READ THRU S810-EXIT. DTSCS63
01615 IF L810-NO-REC-88 DTSCS63
01616 GO TO P8320-EXIT DTSCS63
01617 END-IF. DTSCS63
01618 PERFORM S810-DELETE THRU S810-EXIT. DTSCS63
01619 P8320-EXIT. DTSCS63
01620 EXIT. DTSCS63
01621 EJECT DTSCS63
01622 DTSCS63
01623 P8330-DESTRUCT-MAUY. DTSCS63
01624 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS63
01625 MOVE MFAS-EMP-NO TO MAUY-EMP-NO. DTSCS63
01626 SET MAUY-AUY-88 TO TRUE. DTSCS63
01627 MOVE MFAS-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS63
01628 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
01629 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS63
01630 PERFORM P8331-MAUY-DELETE THRU P8331-EXIT DTSCS63
01631 UNTIL L810-NO-REC-88. DTSCS63
01632 P8330-EXIT. DTSCS63
01633 EXIT. DTSCS63
01634 DTSCS63
01635 P8331-MAUY-DELETE. DTSCS63
01636 MOVE MSKL-REC TO MAUY-REC. DTSCS63
01637 DTSCS63
01638 IF MAUY-ASSIGN-NO = MFAS-ASSIGN-NO DTSCS63
01639 NEXT SENTENCE DTSCS63
01640 ELSE DTSCS63
01641 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS63
01642 SET L810-NO-REC-88 TO TRUE DTSCS63
01643 GO TO P8331-EXIT. DTSCS63
01644 DTSCS63
01645 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS63
01646 PERFORM S810-DELETE THRU S810-EXIT. DTSCS63
01647 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS63
01648 P8331-EXIT. DTSCS63
01649 EXIT. DTSCS63
01650 /*****************************************************************DTSCS63
01651 * *DTSCS63
01652 ******************************************************************DTSCS63
01653 P8810-LOCK-EMPLOYER. DTSCS63
01654 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS63
01655 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS63
01656 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS63
01657 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS63
01658 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS63
01659 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS63
01660 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS63
01661 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS63
01662 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS63
01663 DTSCS63
01664 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS63
01665 P8810-EXIT. DTSCS63
01666 EXIT. DTSCS63
01667 DTSCS63
01668 P8900-INITIALIZE-L331. DTSCS63
01669 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS63
01670 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS63
01671 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS63
01672 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS63
01673 DTSCS63
01674 MOVE SPACES TO WRK-L331-REC-OCC-ID. DTSCS63
01675 MOVE MFAS-ASSIGN-NO TO WRK-L331-ASSIGN-NO. DTSCS63
01676 MOVE WRK-L331-REC-OCC-ID TO L331-REC-OCC-ID. DTSCS63
01677 DTSCS63
01678 P8900-EXIT. DTSCS63
01679 EXIT. DTSCS63
01680 DTSCS63
01681 /*****************************************************************DTSCS63
01682 * LINKS TO UTILITY MODULES DTSCS63
01683 ******************************************************************DTSCS63
01684 DTSCS63
01685 S001-FROM-FED-8. DTSCS63
01686 SET L001-FROM-FED-8 TO TRUE. DTSCS63
01687 GO TO S001-DATE. DTSCS63
01688 DTSCS63
01689 S001-FROM-ABS-DATE. DTSCS63
01690 SET L001-FROM-ABS-DAY TO TRUE. DTSCS63
01691 GO TO S001-DATE. DTSCS63
01692 DTSCS63
01693 S001-DATE. DTSCS63
01694 EXEC CICS LINK DTSCS63
01695 PROGRAM('DTSCU001') DTSCS63
01696 COMMAREA(L001-COMM-AREA) DTSCS63
01697 END-EXEC. DTSCS63
01698 S001-EXIT. DTSCS63
01699 EXIT. DTSCS63
01700 DTSCS63
01701 S004-FROM-5. DTSCS63
01702 SET L004-FROM-5 TO TRUE. DTSCS63
01703 GO TO S004-YRQ. DTSCS63
01704 DTSCS63
01705 S004-FROM-ABS. DTSCS63
01706 SET L004-FROM-ABS TO TRUE. DTSCS63
01707 GO TO S004-YRQ. DTSCS63
01708 DTSCS63
01709 S004-FROM-DATE. DTSCS63
01710 SET L004-FROM-DATE TO TRUE. DTSCS63
01711 GO TO S004-YRQ. DTSCS63
01712 DTSCS63
01713 S004-YRQ. DTSCS63
01714 EXEC CICS LINK DTSCS63
01715 PROGRAM('DTSCU004') DTSCS63
01716 COMMAREA(L004-COMM-AREA) DTSCS63
01717 END-EXEC. DTSCS63
01718 S004-EXIT. DTSCS63
01719 EXIT. DTSCS63
01720 DTSCS63
01721 S011-MONEY-FROM-SCREEN. DTSCS63
01722 MOVE +99999999.99 TO L011-MAX-AMT. DTSCS63
01723 MOVE +0 TO L011-MIN-AMT. DTSCS63
01724 EXEC CICS LINK DTSCS63
01725 PROGRAM('DTSCU011') DTSCS63
01726 COMMAREA(L011-COMM-AREA) DTSCS63
01727 END-EXEC. DTSCS63
01728 S011-EXIT. DTSCS63
01729 EXIT. DTSCS63
01730 DTSCS63
01731 S013-COUNT-FROM-SCREEN. DTSCS63
01732 EXEC CICS LINK DTSCS63
01733 PROGRAM('DTSCU013') DTSCS63
01734 COMMAREA(L013-COMM-AREA) DTSCS63
01735 END-EXEC. DTSCS63
01736 S013-EXIT. DTSCS63
01737 EXIT. DTSCS63
01738 DTSCS63
01739 S014-COUNT-TENTHS-SCREEN. DTSCS63
01740 MOVE +999.9 TO L014-MAX-CNT. DTSCS63
01741 MOVE +0.1 TO L014-MIN-CNT. DTSCS63
01742 DTSCS63
01743 EXEC CICS LINK DTSCS63
01744 PROGRAM('DTSCU014') DTSCS63
01745 COMMAREA(L014-COMM-AREA) DTSCS63
01746 END-EXEC. DTSCS63
01747 S014-EXIT. DTSCS63
01748 EXIT. DTSCS63
01749 DTSCS63
01750 S015-DATE-FROM-SCREEN. DTSCS63
01751 EXEC CICS LINK DTSCS63
01752 PROGRAM('DTSCU015') DTSCS63
01753 COMMAREA(L015-COMM-AREA) DTSCS63
01754 END-EXEC. DTSCS63
01755 S015-EXIT. DTSCS63
01756 EXIT. DTSCS63
01757 DTSCS63
01758 S022-ASSIGN-NO-FROM-SCREEN. DTSCS63
01759 EXEC CICS LINK DTSCS63
01760 PROGRAM('DTSCU022') DTSCS63
01761 COMMAREA(L022-COMM-AREA) DTSCS63
01762 END-EXEC. DTSCS63
01763 S022-EXIT. DTSCS63
01764 EXIT. DTSCS63
01765 DTSCS63
01766 S024-YRQ-RANGE-FROM-SCREEN. DTSCS63
01767 EXEC CICS LINK DTSCS63
01768 PROGRAM('DTSCU024') DTSCS63
01769 COMMAREA(L024-COMM-AREA) DTSCS63
01770 END-EXEC. DTSCS63
01771 S024-EXIT. DTSCS63
01772 EXIT. DTSCS63
01773 DTSCS63
01774 S036-EDIT-CODES. DTSCS63
01775 EXEC CICS LINK DTSCS63
01776 PROGRAM('DTSCU036') DTSCS63
01777 COMMAREA(L036-COMM-AREA) DTSCS63
01778 END-EXEC. DTSCS63
01779 S036-EXIT. DTSCS63
01780 EXIT. DTSCS63
01781 DTSCS63
01782 S038-RA-CODES-EDIT. DTSCS63
01783 EXEC CICS LINK DTSCS63
01784 PROGRAM('DTSCU038') DTSCS63
01785 COMMAREA(L038-COMM-AREA) DTSCS63
01786 END-EXEC. DTSCS63
01787 S038-EXIT. DTSCS63
01788 EXIT. DTSCS63
01789 DTSCS63
01790 S063-FIELD-ASSIGNMENT-EDIT. DTSCS63
01791 EXEC CICS LINK DTSCS63
01792 PROGRAM('DTSCU063') DTSCS63
01793 COMMAREA(L063-COMM-AREA) DTSCS63
01794 END-EXEC. DTSCS63
01795 DTSCS63
01796 IF L063-FILE-CLOSED DTSCS63
01797 MOVE L063-MSG-AREA TO LCCM-MSG-AREA DTSCS63
01798 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS63
01799 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS63
01800 GO TO MAINLINE-EXIT. DTSCS63
01801 DTSCS63
01802 S063-EXIT. DTSCS63
01803 EXIT. DTSCS63
01804 DTSCS63
01805 S221-EMP-LOCK. DTSCS63
01806 SET L221-START-UPDATE TO TRUE. DTSCS63
01807 GO TO S221-EMP-LOCK-UNLOCK. DTSCS63
01808 DTSCS63
01809 S221-EMP-UNLOCK. DTSCS63
01810 SET L221-END-UPDATE TO TRUE. DTSCS63
01811 GO TO S221-EMP-LOCK-UNLOCK. DTSCS63
01812 DTSCS63
01813 S221-EMP-LOCK-UNLOCK. DTSCS63
01814 EXEC CICS LINK DTSCS63
01815 PROGRAM('DTSCU221') DTSCS63
01816 COMMAREA(L221-COMM-AREA) DTSCS63
01817 END-EXEC. DTSCS63
01818 DTSCS63
01819 IF L221-FILE-CLOSED DTSCS63
01820 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS63
01821 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS63
01822 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS63
01823 GO TO MAINLINE-EXIT. DTSCS63
01824 DTSCS63
01825 IF L221-NOT-OK DTSCS63
01826 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS63
01827 S221-EXIT. DTSCS63
01828 EXIT. DTSCS63
01829 DTSCS63
01830 S331-WRITE-MLOG. DTSCS63
01831 EXEC CICS LINK DTSCS63
01832 PROGRAM('DTSCU331') DTSCS63
01833 COMMAREA(L331-COMM-AREA) DTSCS63
01834 END-EXEC. DTSCS63
01835 DTSCS63
01836 IF L331-FILE-CLOSED DTSCS63
01837 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS63
01838 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS63
01839 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS63
01840 GO TO MAINLINE-EXIT. DTSCS63
01841 DTSCS63
01842 S331-EXIT. DTSCS63
01843 EXIT. DTSCS63
01844 DTSCS63
01845 S803-REQ-SCR-ID-EDIT. DTSCS63
01846 EXEC CICS LINK DTSCS63
01847 PROGRAM ('DTSCU803') DTSCS63
01848 COMMAREA (DFHCOMMAREA) DTSCS63
01849 END-EXEC. DTSCS63
01850 S803-EXIT. DTSCS63
01851 EXIT. DTSCS63
01852 DTSCS63
01853 S804-INVALID-KEY. DTSCS63
01854 EXEC CICS LINK DTSCS63
01855 PROGRAM ('DTSCU804') DTSCS63
01856 COMMAREA (DFHCOMMAREA) DTSCS63
01857 END-EXEC. DTSCS63
01858 S804-EXIT. DTSCS63
01859 EXIT. DTSCS63
01860 DTSCS63
01861 S805-MSG-AREA. DTSCS63
01862 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS63
01863 DTSCS63
01864 EXEC CICS LINK DTSCS63
01865 PROGRAM ('DTSCU805') DTSCS63
01866 COMMAREA (L805-COMM-AREA) DTSCS63
01867 END-EXEC. DTSCS63
01868 DTSCS63
01869 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS63
01870 S805-EXIT. DTSCS63
01871 EXIT. DTSCS63
01872 EJECT DTSCS63
01873 S810-READ. DTSCS63
01874 SET L810-READ-88 TO TRUE. DTSCS63
01875 GO TO S810-IO. DTSCS63
01876 DTSCS63
01877 S810-START-BROWSE. DTSCS63
01878 SET L810-START-BROWSE-88 TO TRUE. DTSCS63
01879 GO TO S810-IO. DTSCS63
01880 DTSCS63
01881 S810-READ-NEXT. DTSCS63
01882 SET L810-READ-NEXT-88 TO TRUE. DTSCS63
01883 GO TO S810-IO. DTSCS63
01884 DTSCS63
01885 S810-READ-PREV. DTSCS63
01886 SET L810-READ-PREV-88 TO TRUE. DTSCS63
01887 GO TO S810-IO. DTSCS63
01888 DTSCS63
01889 S810-END-BROWSE. DTSCS63
01890 SET L810-END-BROWSE-88 TO TRUE. DTSCS63
01891 GO TO S810-IO. DTSCS63
01892 DTSCS63
01893 S810-COUNT. DTSCS63
01894 SET L810-COUNT-88 TO TRUE. DTSCS63
01895 GO TO S810-IO. DTSCS63
01896 DTSCS63
01897 S810-REWRITE. DTSCS63
01898 SET L810-REWRITE-88 TO TRUE. DTSCS63
01899 GO TO S810-IO. DTSCS63
01900 DTSCS63
01901 S810-WRITE. DTSCS63
01902 SET L810-WRITE-88 TO TRUE. DTSCS63
01903 GO TO S810-IO. DTSCS63
01904 DTSCS63
01905 S810-DELETE. DTSCS63
01906 SET L810-DELETE-88 TO TRUE. DTSCS63
01907 GO TO S810-IO. DTSCS63
01908 DTSCS63
01909 S810-IO. DTSCS63
01910 DTSCS63
01911 EXEC CICS LINK DTSCS63
01912 PROGRAM ('DTSCU810') DTSCS63
01913 COMMAREA (L810-COMM-AREA) DTSCS63
01914 END-EXEC. DTSCS63
01915 DTSCS63
01916 IF L810-FILE-CLOSED-88 DTSCS63
01917 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS63
01918 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS63
01919 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS63
01920 GO TO MAINLINE-EXIT. DTSCS63
01921 S810-EXIT. DTSCS63
01922 EXIT. DTSCS63
01923 EJECT DTSCS63
01924 S821-START-BROWSE. DTSCS63
01925 SET L821-START-BROWSE-88 TO TRUE. DTSCS63
01926 GO TO S821-MASTER-IO. DTSCS63
01927 S821-END-BROWSE. DTSCS63
01928 SET L821-END-BROWSE-88 TO TRUE. DTSCS63
01929 GO TO S821-MASTER-IO. DTSCS63
01930 S821-READ-PREV. DTSCS63
01931 SET L821-READ-PREV-88 TO TRUE. DTSCS63
01932 GO TO S821-MASTER-IO. DTSCS63
01933 S821-READ-NEXT. DTSCS63
01934 SET L821-READ-NEXT-88 TO TRUE. DTSCS63
01935 GO TO S821-MASTER-IO. DTSCS63
01936 S821-MASTER-IO. DTSCS63
01937 EXEC CICS LINK DTSCS63
01938 PROGRAM ('DTSCU821') DTSCS63
01939 COMMAREA (L821-COMM-AREA) DTSCS63
01940 END-EXEC. DTSCS63
01941 IF L821-FILE-CLOSED-88 DTSCS63
01942 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS63
01943 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS63
01944 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS63
01945 GO TO MAINLINE-EXIT DTSCS63
01946 END-IF. DTSCS63
01947 S821-EXIT. EXIT. DTSCS63
01948 EJECT DTSCS63
01949 S851-SCREEN-PROCESSING. DTSCS63
01950 EXEC CICS LINK DTSCS63
01951 PROGRAM ('DTSCU851') DTSCS63
01952 COMMAREA (L851-COMM-AREA) DTSCS63
01953 END-EXEC. DTSCS63
01954 S851-EXIT. DTSCS63
01955 EXIT. DTSCS63
01956 DTSCS63
01957 S899-ABEND. DTSCS63
01958 EXEC CICS ABEND DTSCS63
01959 ABCODE(WRK-ABEND-CD) DTSCS63
01960 END-EXEC. DTSCS63
01961 S899-EXIT. DTSCS63
01962 EXIT. DTSCS63
01963 /*****************************************************************DTSCS63
01964 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS63
01965 ******************************************************************DTSCS63
01966 DTSCS63
01967 S1000-SCREEN-EDITS. DTSCS63
01968 PERFORM S1200-PROCESSED-DATE THRU S1200-EXIT. DTSCS63
01969 PERFORM S1300-QTR-RANGE THRU S1300-EXIT. DTSCS63
01970 PERFORM S1400-QTRS-AUDITED-CNT THRU S1400-EXIT. DTSCS63
01971 PERFORM S1500-AUDIT-HRS THRU S1500-EXIT. DTSCS63
01972 PERFORM S1600-EMP-SIZE-IND THRU S1600-EXIT. DTSCS63
01973 PERFORM S1700-ERROR-TYPE THRU S1700-EXIT DTSCS63
01974 VARYING WRK-OCC FROM 1 BY 1 DTSCS63
01975 UNTIL WRK-OCC > MMAX-AUR-ERROR-MAX. DTSCS63
01976 PERFORM S1800-MONEY-DUE-AMT THRU S1800-EXIT. DTSCS63
01977 PERFORM S1900-MONEY-COLLECT-AMT THRU S1900-EXIT. DTSCS63
01978 PERFORM S2000-MONEY-REASON-CD THRU S2000-EXIT. DTSCS63
01979 PERFORM S2100-PEN-WAIVER-IND THRU S2100-EXIT. DTSCS63
01980 PERFORM S2200-INT-WAIVER-IND THRU S2200-EXIT. DTSCS63
01981 PERFORM S2300-NEW-EMPLOYEE-CNT THRU S2300-EXIT. DTSCS63
01982 PERFORM S2400-INDCON-TO-EMPL-CNT THRU S2400-EXIT. DTSCS63
01983 DTSCS63
01984 IF LCCM-NO-MSG DTSCS63
01985 PERFORM S3000-MISC-EDITS THRU S3000-EXIT DTSCS63
01986 END-IF. DTSCS63
01987 DTSCS63
01988 S1000-EXIT. EXIT. DTSCS63
01989 EJECT DTSCS63
01990 /*****************************************************************DTSCS63
01991 * DTSCS63
01992 ******************************************************************DTSCS63
01993 S1100-EDIT-KEY. DTSCS63
01994 PERFORM S1101-ASSIGN-NO THRU S1101-EXIT. DTSCS63
01995 S1100-EXIT. EXIT. DTSCS63
01996 /*****************************************************************DTSCS63
01997 * DTSCS63
01998 ******************************************************************DTSCS63
01999 S1101-ASSIGN-NO. DTSCS63
02000 MOVE MAP-ASSIGN-NO-AREA TO L022-S-ASSIGN-NO-AREA. DTSCS63
02001 PERFORM S022-ASSIGN-NO-FROM-SCREEN THRU S022-EXIT. DTSCS63
02002 DTSCS63
02003 IF L022-NO-ENTRY DTSCS63
02004 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS63
02005 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
02006 GO TO S1101-EXIT. DTSCS63
02007 DTSCS63
02008 IF L022-NOT-VALID DTSCS63
02009 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02010 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
02011 GO TO S1101-EXIT. DTSCS63
02012 DTSCS63
02013 MOVE L022-ASSIGN-NO TO WRK-ASSIGN-NO. DTSCS63
02014 S1101-EXIT. EXIT. DTSCS63
02015 DTSCS63
02016 /*****************************************************************DTSCS63
02017 * DTSCS63
02018 ******************************************************************DTSCS63
02019 S1110-READ-MFAS. DTSCS63
02020 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSCS63
02021 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSCS63
02022 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSCS63
02023 SET MFAS-FAS-88 TO TRUE. DTSCS63
02024 DTSCS63
02025 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
02026 DTSCS63
02027 PERFORM S810-READ THRU S810-EXIT. DTSCS63
02028 DTSCS63
02029 IF L810-NO-REC-88 DTSCS63
02030 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS63
02031 MOVE MSG-E631-AREA TO LCCM-MSG-AREA DTSCS63
02032 MOVE 'SF' TO LCCM-REQ-SCR-ID DTSCS63
02033 GO TO MAINLINE-EXIT DTSCS63
02034 ELSE DTSCS63
02035 MOVE MSKL-REC TO MFAS-REC DTSCS63
02036 SET WRK-MFAS-YES-88 TO TRUE DTSCS63
02037 END-IF. DTSCS63
02038 DTSCS63
02039 S1110-EXIT. DTSCS63
02040 EXIT. DTSCS63
02041 /*****************************************************************DTSCS63
02042 * DTSCS63
02043 ******************************************************************DTSCS63
02044 S1120-READ-IFAN. DTSCS63
02045 MOVE LOW-VALUES TO IFAN-KEY-AREA. DTSCS63
02046 SET IFAN-FAN-88 TO TRUE. DTSCS63
02047 MOVE WRK-ASSIGN-NO TO IFAN-ASSIGN-NO. DTSCS63
02048 DTSCS63
02049 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS63
02050 DTSCS63
02051 IF L821-OK-88 DTSCS63
02052 IF IFAN-ASSIGN-NO NOT = WRK-ASSIGN-NO DTSCS63
02053 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS63
02054 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
02055 ELSE DTSCS63
02056 MOVE IFAN-EMP-NO TO WRK-EMP-NO DTSCS63
02057 END-IF DTSCS63
02058 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS63
02059 ELSE DTSCS63
02060 MOVE EMSG-NO-ASSIGNMENT TO WRK-MSG-AREA DTSCS63
02061 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS63
02062 END-IF. DTSCS63
02063 DTSCS63
02064 S1120-EXIT. DTSCS63
02065 EXIT. DTSCS63
02066 DTSCS63
02067 /*****************************************************************DTSCS63
02068 * DTSCS63
02069 ******************************************************************DTSCS63
02070 S1130-READ-MPRF. DTSCS63
02071 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS63
02072 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS63
02073 SET MPRF-PRF-88 TO TRUE. DTSCS63
02074 DTSCS63
02075 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
02076 DTSCS63
02077 PERFORM S810-READ THRU S810-EXIT. DTSCS63
02078 DTSCS63
02079 IF L810-NO-REC-88 DTSCS63
02080 MOVE WRK-EMP-NO TO MSG-EMP-NO-IN-ERR DTSCS63
02081 MOVE MSG-E631-AREA TO LCCM-MSG-AREA DTSCS63
02082 MOVE 'SF' TO LCCM-REQ-SCR-ID DTSCS63
02083 GO TO MAINLINE-EXIT DTSCS63
02084 ELSE DTSCS63
02085 MOVE MSKL-REC TO MPRF-REC DTSCS63
02086 SET WRK-MPRF-YES-88 TO TRUE DTSCS63
02087 END-IF. DTSCS63
02088 DTSCS63
02089 S1130-EXIT. DTSCS63
02090 EXIT. DTSCS63
02091 DTSCS63
02092 S1199-ERROR. DTSCS63
02093 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS63
02094 MAP-ASSIGN-NO-2-A. DTSCS63
02095 IF LCCM-NO-MSG DTSCS63
02096 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02097 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L DTSCS63
02098 SET CURSOR-SET-YES TO TRUE. DTSCS63
02099 S1199-EXIT. EXIT. DTSCS63
02100 DTSCS63
02101 /*****************************************************************DTSCS63
02102 * DTSCS63
02103 ******************************************************************DTSCS63
02104 S1200-PROCESSED-DATE. DTSCS63
02105 DTSCS63
02106 MOVE MAP-PROCESSED-DATE-AREA TO L015-S-DATE-AREA. DTSCS63
02107 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS63
02108 DTSCS63
02109 IF L015-NO-ENTRY DTSCS63
02110 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS63
02111 L015-DATE DTSCS63
02112 MOVE WRK-DISPLAY-MO TO MAP-PROCESSED-DATE-MO DTSCS63
02113 MOVE WRK-DISPLAY-DA TO MAP-PROCESSED-DATE-DA DTSCS63
02114 MOVE WRK-DISPLAY-YR TO MAP-PROCESSED-DATE-YR DTSCS63
02115 ELSE DTSCS63
02116 IF L015-NOT-VALID DTSCS63
02117 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02118 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS63
02119 GO TO S1200-EXIT. DTSCS63
02120 DTSCS63
02121 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS63
02122 MOVE MSG-E638-AREA TO WRK-MSG-AREA DTSCS63
02123 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS63
02124 GO TO S1200-EXIT. DTSCS63
02125 DTSCS63
02126 IF L015-DATE < MFAS-COMPLETED-DATE DTSCS63
02127 MOVE MSG-E639-AREA TO WRK-MSG-AREA DTSCS63
02128 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS63
02129 GO TO S1200-EXIT. DTSCS63
02130 S1200-EXIT. DTSCS63
02131 EXIT. DTSCS63
02132 DTSCS63
02133 S1201-ERROR. DTSCS63
02134 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PROCESSED-DATE-MO-A DTSCS63
02135 MAP-PROCESSED-DATE-DA-A DTSCS63
02136 MAP-PROCESSED-DATE-YR-A. DTSCS63
02137 IF LCCM-NO-MSG DTSCS63
02138 SET CURSOR-SET-YES TO TRUE DTSCS63
02139 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02140 MOVE CATB-CURSOR TO MAP-PROCESSED-DATE-MO-L. DTSCS63
02141 S1201-EXIT. DTSCS63
02142 EXIT. DTSCS63
02143 /*****************************************************************DTSCS63
02144 * DTSCS63
02145 ******************************************************************DTSCS63
02146 S1300-QTR-RANGE. DTSCS63
02147 DTSCS63
02148 MOVE MAP-FIRST-YRQ-AREA TO L024-S-START-YRQ-AREA. DTSCS63
02149 MOVE MAP-LAST-YRQ-AREA TO L024-S-END-YRQ-AREA. DTSCS63
02150 PERFORM S024-YRQ-RANGE-FROM-SCREEN THRU S024-EXIT. DTSCS63
02151 DTSCS63
02152 IF L024-START-NO-ENTRY DTSCS63
02153 MOVE MFAS-START-YRQ TO WRK-DISPLAY DTSCS63
02154 MOVE WRK-DISPLAY-QTR-YR TO MAP-FIRST-YR DTSCS63
02155 MOVE WRK-DISPLAY-QTR-Q TO MAP-FIRST-Q. DTSCS63
02156 IF L024-END-NO-ENTRY DTSCS63
02157 MOVE MFAS-END-YRQ TO WRK-DISPLAY DTSCS63
02158 MOVE WRK-DISPLAY-QTR-YR TO MAP-LAST-YR DTSCS63
02159 MOVE WRK-DISPLAY-QTR-Q TO MAP-LAST-Q. DTSCS63
02160 DTSCS63
02161 IF L024-START-NO-ENTRY DTSCS63
02162 OR L024-END-NO-ENTRY DTSCS63
02163 MOVE MAP-FIRST-YRQ-AREA TO L024-S-START-YRQ-AREA DTSCS63
02164 MOVE MAP-LAST-YRQ-AREA TO L024-S-END-YRQ-AREA DTSCS63
02165 PERFORM S024-YRQ-RANGE-FROM-SCREEN THRU S024-EXIT. DTSCS63
02166 DTSCS63
02167 DTSCS63
02168 IF L024-START-NOT-VALID DTSCS63
02169 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02170 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS63
02171 END-IF. DTSCS63
02172 DTSCS63
02173 IF L024-END-NOT-VALID DTSCS63
02174 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02175 PERFORM S1302-ERROR THRU S1302-EXIT DTSCS63
02176 END-IF. DTSCS63
02177 DTSCS63
02178 IF L024-SPAN-INVALID DTSCS63
02179 OR L024-END-BEFORE-START DTSCS63
02180 OR L024-QTRS-SPANNED > 20 DTSCS63
02181 MOVE MSG-E632-AREA TO WRK-MSG-AREA DTSCS63
02182 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS63
02183 PERFORM S1302-ERROR THRU S1302-EXIT DTSCS63
02184 GO TO S1300-EXIT. DTSCS63
02185 DTSCS63
02186 IF L024-START-NOT-VALID OR L024-END-NOT-VALID DTSCS63
02187 NEXT SENTENCE DTSCS63
02188 ELSE DTSCS63
02189 PERFORM S1310-CHECK-MAUY THRU S1310-EXIT. DTSCS63
02190 S1300-EXIT. DTSCS63
02191 EXIT. DTSCS63
02192 DTSCS63
02193 S1301-ERROR. DTSCS63
02194 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FIRST-YR-A DTSCS63
02195 MAP-FIRST-Q-A. DTSCS63
02196 IF LCCM-NO-MSG DTSCS63
02197 SET CURSOR-SET-YES TO TRUE DTSCS63
02198 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02199 MOVE CATB-CURSOR TO MAP-FIRST-YR-L. DTSCS63
02200 S1301-EXIT. DTSCS63
02201 EXIT. DTSCS63
02202 DTSCS63
02203 S1302-ERROR. DTSCS63
02204 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LAST-YR-A DTSCS63
02205 MAP-LAST-Q-A. DTSCS63
02206 IF LCCM-NO-MSG DTSCS63
02207 SET CURSOR-SET-YES TO TRUE DTSCS63
02208 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02209 MOVE CATB-CURSOR TO MAP-LAST-YR-L. DTSCS63
02210 S1302-EXIT. DTSCS63
02211 EXIT. DTSCS63
02212 DTSCS63
02213 S1310-CHECK-MAUY. DTSCS63
02214 MOVE LOW-VALUES TO MAUY-KEY-AREA. DTSCS63
02215 MOVE WRK-EMP-NO TO MAUY-EMP-NO. DTSCS63
02216 SET MAUY-AUY-88 TO TRUE. DTSCS63
02217 MOVE WRK-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSCS63
02218 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSCS63
02219 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS63
02220 PERFORM S1311-SCAN-MAUY THRU S1311-EXIT DTSCS63
02221 UNTIL L810-NO-REC-88. DTSCS63
02222 S1310-EXIT. DTSCS63
02223 EXIT. DTSCS63
02224 DTSCS63
02225 S1311-SCAN-MAUY. DTSCS63
02226 MOVE MSKL-REC TO MAUY-REC. DTSCS63
02227 IF WRK-ASSIGN-NO = MAUY-ASSIGN-NO DTSCS63
02228 NEXT SENTENCE DTSCS63
02229 ELSE DTSCS63
02230 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS63
02231 SET L810-NO-REC-88 TO TRUE DTSCS63
02232 GO TO S1311-EXIT. DTSCS63
02233 DTSCS63
02234 PERFORM S1311A-QTR-LOOP THRU S1311A-EXIT DTSCS63
02235 VARYING MAUY-QTR-IDX FROM 1 BY 1 DTSCS63
02236 UNTIL MAUY-QTR-IDX > MMAX-AUY-QTR-MAX. DTSCS63
02237 DTSCS63
02238 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS63
02239 S1311-EXIT. DTSCS63
02240 EXIT. DTSCS63
02241 DTSCS63
02242 S1311A-QTR-LOOP. DTSCS63
02243 IF MAUY-QTR-NOT-AUDITED-88 (MAUY-QTR-IDX) DTSCS63
02244 GO TO S1311A-EXIT. DTSCS63
02245 DTSCS63
02246 MOVE MAUY-CALENDAR-YEAR TO L004-QTR-5-YR. DTSCS63
02247 SET L004-QTR-5-Q TO MAUY-QTR-IDX. DTSCS63
02248 IF (L004-QTR-5-9 < L024-START-YRQ) DTSCS63
02249 OR DTSCS63
02250 (L004-QTR-5-9 > L024-END-YRQ) DTSCS63
02251 MOVE MSG-E636-AREA TO WRK-MSG-AREA DTSCS63
02252 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS63
02253 PERFORM S1302-ERROR THRU S1302-EXIT. DTSCS63
02254 S1311A-EXIT. DTSCS63
02255 EXIT. DTSCS63
02256 /*****************************************************************DTSCS63
02257 * DTSCS63
02258 ******************************************************************DTSCS63
02259 S1400-QTRS-AUDITED-CNT. DTSCS63
02260 MOVE MAP-QTRS-AUDITED-CNT-AREA TO L013-S-CNT-AREA. DTSCS63
02261 MOVE +1 TO L013-MIN-CNT. DTSCS63
02262 MOVE +20 TO L013-MAX-CNT. DTSCS63
02263 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
02264 DTSCS63
02265 IF L013-NO-ENTRY DTSCS63
02266 IF L024-END-VALID AND L024-START-VALID DTSCS63
02267 MOVE L024-QTRS-SPANNED TO MAP-QTRS-AUDITED-CNT-N DTSCS63
02268 END-IF DTSCS63
02269 ELSE DTSCS63
02270 IF L013-NOT-VALID DTSCS63
02271 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02272 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS63
02273 ELSE DTSCS63
02274 MOVE L013-CNT TO MAP-QTRS-AUDITED-CNT-N DTSCS63
02275 END-IF. DTSCS63
02276 S1400-EXIT. DTSCS63
02277 EXIT. DTSCS63
02278 S1401-ERROR. DTSCS63
02279 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-QTRS-AUDITED-CNT-A. DTSCS63
02280 IF LCCM-NO-MSG DTSCS63
02281 SET CURSOR-SET-YES TO TRUE DTSCS63
02282 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02283 MOVE CATB-CURSOR TO MAP-QTRS-AUDITED-CNT-L. DTSCS63
02284 S1401-EXIT. DTSCS63
02285 EXIT. DTSCS63
02286 /*****************************************************************DTSCS63
02287 * DTSCS63
02288 ******************************************************************DTSCS63
02289 S1500-AUDIT-HRS. DTSCS63
02290 MOVE MAP-AUDIT-HRS-AREA TO L014-S-CNT-AREA. DTSCS63
02291 PERFORM S014-COUNT-TENTHS-SCREEN THRU S014-EXIT. DTSCS63
02292 DTSCS63
02293 IF L014-NO-ENTRY DTSCS63
02294 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS63
02295 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS63
02296 ELSE DTSCS63
02297 IF L014-NOT-VALID DTSCS63
02298 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02299 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS63
02300 ELSE DTSCS63
02301 MOVE L014-CNT TO MAP-AUDIT-HRS-N. DTSCS63
02302 S1500-EXIT. DTSCS63
02303 EXIT. DTSCS63
02304 DTSCS63
02305 S1501-ERROR. DTSCS63
02306 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-HRS-A. DTSCS63
02307 IF LCCM-NO-MSG DTSCS63
02308 SET CURSOR-SET-YES TO TRUE DTSCS63
02309 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02310 MOVE CATB-CURSOR TO MAP-AUDIT-HRS-L. DTSCS63
02311 S1501-EXIT. DTSCS63
02312 EXIT. DTSCS63
02313 /*****************************************************************DTSCS63
02314 * DTSCS63
02315 ******************************************************************DTSCS63
02316 S1600-EMP-SIZE-IND. DTSCS63
02317 IF MAP-EMP-SIZE-IND = LOW-VALUES OR SPACES DTSCS63
02318 MOVE MFAS-EMP-SIZE-IND TO MAP-EMP-SIZE-IND DTSCS63
02319 ELSE DTSCS63
02320 IF NOT MAP-EMP-SIZE-VALID DTSCS63
02321 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02322 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS63
02323 END-IF. DTSCS63
02324 S1600-EXIT. DTSCS63
02325 EXIT. DTSCS63
02326 DTSCS63
02327 S1601-ERROR. DTSCS63
02328 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-SIZE-IND-A. DTSCS63
02329 IF LCCM-NO-MSG DTSCS63
02330 SET CURSOR-SET-YES TO TRUE DTSCS63
02331 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02332 MOVE CATB-CURSOR TO MAP-EMP-SIZE-IND-L. DTSCS63
02333 S1601-EXIT. DTSCS63
02334 EXIT. DTSCS63
02335 /*****************************************************************DTSCS63
02336 * DTSCS63
02337 ******************************************************************DTSCS63
02338 S1700-ERROR-TYPE. DTSCS63
02339 INSPECT MAP-ERROR-TYPE (WRK-OCC) DTSCS63
02340 CONVERTING LOW-VALUES TO SPACES. DTSCS63
02341 DTSCS63
02342 IF MAP-ERROR-TYPE (WRK-OCC) = SPACES DTSCS63
02343 NEXT SENTENCE DTSCS63
02344 ELSE DTSCS63
02345 MOVE MAP-ERROR-TYPE (WRK-OCC) TO L036-CD-2 DTSCS63
02346 SET L036-MAUR-ERROR-TYPE TO TRUE DTSCS63
02347 PERFORM S036-EDIT-CODES THRU S036-EXIT DTSCS63
02348 IF L036-NOT-VALID DTSCS63
02349 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02350 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS63
02351 END-IF. DTSCS63
02352 S1700-EXIT. DTSCS63
02353 EXIT. DTSCS63
02354 DTSCS63
02355 S1701-ERROR. DTSCS63
02356 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ERROR-TYPE-A(WRK-OCC). DTSCS63
02357 IF LCCM-NO-MSG DTSCS63
02358 SET CURSOR-SET-YES TO TRUE DTSCS63
02359 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02360 MOVE CATB-CURSOR TO MAP-ERROR-TYPE-L(WRK-OCC). DTSCS63
02361 S1701-EXIT. DTSCS63
02362 EXIT. DTSCS63
02363 /*****************************************************************DTSCS63
02364 * DTSCS63
02365 ******************************************************************DTSCS63
02366 S1800-MONEY-DUE-AMT. DTSCS63
02367 MOVE +0 TO WRK-MONEY-DUE-AMT DTSCS63
02368 MOVE MAP-MONEY-DUE-AMT-AREA TO L011-S-AMT-AREA. DTSCS63
02369 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS63
02370 DTSCS63
02371 IF L011-NO-ENTRY DTSCS63
02372 NEXT SENTENCE DTSCS63
02373 ELSE DTSCS63
02374 IF L011-NOT-VALID DTSCS63
02375 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02376 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS63
02377 ELSE DTSCS63
02378 MOVE L011-AMT TO MAP-MONEY-DUE-AMT-N DTSCS63
02379 WRK-MONEY-DUE-AMT DTSCS63
02380 END-IF. DTSCS63
02381 S1800-EXIT. DTSCS63
02382 EXIT. DTSCS63
02383 DTSCS63
02384 S1801-ERROR. DTSCS63
02385 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MONEY-DUE-AMT-A. DTSCS63
02386 IF LCCM-NO-MSG DTSCS63
02387 SET CURSOR-SET-YES TO TRUE DTSCS63
02388 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02389 MOVE CATB-CURSOR TO MAP-MONEY-DUE-AMT-L. DTSCS63
02390 S1801-EXIT. DTSCS63
02391 EXIT. DTSCS63
02392 /*****************************************************************DTSCS63
02393 * DTSCS63
02394 ******************************************************************DTSCS63
02395 S1900-MONEY-COLLECT-AMT. DTSCS63
02396 MOVE +0 TO WRK-MONEY-COLLECT-AMT. DTSCS63
02397 MOVE MAP-MONEY-COLLECT-AMT-AREA TO L011-S-AMT-AREA. DTSCS63
02398 PERFORM S011-MONEY-FROM-SCREEN THRU S011-EXIT. DTSCS63
02399 DTSCS63
02400 IF L011-NO-ENTRY DTSCS63
02401 NEXT SENTENCE DTSCS63
02402 ELSE DTSCS63
02403 IF L011-NOT-VALID DTSCS63
02404 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02405 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS63
02406 ELSE DTSCS63
02407 MOVE L011-AMT TO MAP-MONEY-COLLECT-AMT-N DTSCS63
02408 WRK-MONEY-COLLECT-AMT DTSCS63
02409 END-IF. DTSCS63
02410 S1900-EXIT. DTSCS63
02411 EXIT. DTSCS63
02412 DTSCS63
02413 S1901-ERROR. DTSCS63
02414 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MONEY-COLLECT-AMT-A. DTSCS63
02415 IF LCCM-NO-MSG DTSCS63
02416 SET CURSOR-SET-YES TO TRUE DTSCS63
02417 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02418 MOVE CATB-CURSOR TO MAP-MONEY-COLLECT-AMT-L. DTSCS63
02419 S1901-EXIT. DTSCS63
02420 EXIT. DTSCS63
02421 /*****************************************************************DTSCS63
02422 * DTSCS63
02423 ******************************************************************DTSCS63
02424 S2000-MONEY-REASON-CD. DTSCS63
02425 IF MAP-MONEY-REASON-CD = LOW-VALUES OR SPACES DTSCS63
02426 IF WRK-MONEY-DUE-AMT < WRK-MONEY-COLLECT-AMT DTSCS63
02427 MOVE '9' TO MAP-MONEY-REASON-CD DTSCS63
02428 ELSE DTSCS63
02429 IF WRK-MONEY-DUE-AMT = WRK-MONEY-COLLECT-AMT DTSCS63
02430 MOVE '0' TO MAP-MONEY-REASON-CD DTSCS63
02431 ELSE DTSCS63
02432 IF WRK-MONEY-DUE-AMT > WRK-MONEY-COLLECT-AMT DTSCS63
02433 MOVE '9' TO MAP-MONEY-REASON-CD DTSCS63
02434 ELSE DTSCS63
02435 NEXT SENTENCE DTSCS63
02436 ELSE DTSCS63
02437 MOVE MAP-MONEY-REASON-CD TO L036-CD-1 DTSCS63
02438 SET L036-MAUR-MONEY-REASON-CD TO TRUE DTSCS63
02439 PERFORM S036-EDIT-CODES THRU S036-EXIT DTSCS63
02440 IF L036-NOT-VALID DTSCS63
02441 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02442 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS63
02443 ELSE DTSCS63
02444 IF (WRK-MONEY-DUE-AMT NOT > WRK-MONEY-COLLECT-AMT) DTSCS63
02445 AND (MAP-MONEY-REASON-CD NOT = '0') DTSCS63
02446 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02447 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS63
02448 S2000-EXIT. DTSCS63
02449 EXIT. DTSCS63
02450 S2001-ERROR. DTSCS63
02451 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MONEY-REASON-CD-A. DTSCS63
02452 IF LCCM-NO-MSG DTSCS63
02453 SET CURSOR-SET-YES TO TRUE DTSCS63
02454 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02455 MOVE CATB-CURSOR TO MAP-MONEY-REASON-CD-L. DTSCS63
02456 S2001-EXIT. DTSCS63
02457 EXIT. DTSCS63
02458 /*****************************************************************DTSCS63
02459 * DTSCS63
02460 ******************************************************************DTSCS63
02461 S2100-PEN-WAIVER-IND. DTSCS63
02462 IF MAP-PEN-WAIVER-IND = LOW-VALUES OR SPACES DTSCS63
02463 MOVE 'N' TO MAP-PEN-WAIVER-IND DTSCS63
02464 ELSE DTSCS63
02465 IF NOT MAP-PEN-WAIVER-IND-VALID DTSCS63
02466 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02467 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS63
02468 END-IF. DTSCS63
02469 S2100-EXIT. DTSCS63
02470 EXIT. DTSCS63
02471 DTSCS63
02472 S2101-ERROR. DTSCS63
02473 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PEN-WAIVER-IND-A. DTSCS63
02474 IF LCCM-NO-MSG DTSCS63
02475 SET CURSOR-SET-YES TO TRUE DTSCS63
02476 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02477 MOVE CATB-CURSOR TO MAP-PEN-WAIVER-IND-L. DTSCS63
02478 S2101-EXIT. DTSCS63
02479 EXIT. DTSCS63
02480 /*****************************************************************DTSCS63
02481 * DTSCS63
02482 ******************************************************************DTSCS63
02483 S2200-INT-WAIVER-IND. DTSCS63
02484 IF MAP-INT-WAIVER-IND = LOW-VALUES OR SPACES DTSCS63
02485 MOVE 'N' TO MAP-INT-WAIVER-IND DTSCS63
02486 ELSE DTSCS63
02487 IF NOT MAP-INT-WAIVER-IND-VALID DTSCS63
02488 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02489 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS63
02490 END-IF. DTSCS63
02491 S2200-EXIT. DTSCS63
02492 EXIT. DTSCS63
02493 DTSCS63
02494 S2201-ERROR. DTSCS63
02495 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-INT-WAIVER-IND-A. DTSCS63
02496 IF LCCM-NO-MSG DTSCS63
02497 SET CURSOR-SET-YES TO TRUE DTSCS63
02498 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02499 MOVE CATB-CURSOR TO MAP-INT-WAIVER-IND-L. DTSCS63
02500 S2201-EXIT. DTSCS63
02501 EXIT. DTSCS63
02502 /*****************************************************************DTSCS63
02503 * DTSCS63
02504 ******************************************************************DTSCS63
02505 S2300-NEW-EMPLOYEE-CNT. DTSCS63
02506 MOVE MAP-NEW-EMPLOYEE-CNT-AREA TO L013-S-CNT-AREA DTSCS63
02507 MOVE +0 TO L013-MIN-CNT. DTSCS63
02508 MOVE +99999 TO L013-MAX-CNT. DTSCS63
02509 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
02510 DTSCS63
02511 IF L013-NO-ENTRY DTSCS63
02512 NEXT SENTENCE DTSCS63
02513 ELSE DTSCS63
02514 IF L013-NOT-VALID DTSCS63
02515 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02516 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS63
02517 ELSE DTSCS63
02518 MOVE L013-CNT TO MAP-NEW-EMPLOYEE-CNT-N DTSCS63
02519 END-IF. DTSCS63
02520 S2300-EXIT. DTSCS63
02521 EXIT. DTSCS63
02522 S2301-ERROR. DTSCS63
02523 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-NEW-EMPLOYEE-CNT-A. DTSCS63
02524 IF LCCM-NO-MSG DTSCS63
02525 SET CURSOR-SET-YES TO TRUE DTSCS63
02526 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02527 MOVE CATB-CURSOR TO MAP-NEW-EMPLOYEE-CNT-L. DTSCS63
02528 S2301-EXIT. DTSCS63
02529 EXIT. DTSCS63
02530 /*****************************************************************DTSCS63
02531 * DTSCS63
02532 ******************************************************************DTSCS63
02533 S2400-INDCON-TO-EMPL-CNT. DTSCS63
02534 MOVE MAP-INDCON-TO-EMPL-CNT-AREA TO L013-S-CNT-AREA DTSCS63
02535 MOVE +0 TO L013-MIN-CNT. DTSCS63
02536 MOVE +99999 TO L013-MAX-CNT. DTSCS63
02537 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS63
02538 DTSCS63
02539 IF L013-NO-ENTRY DTSCS63
02540 NEXT SENTENCE DTSCS63
02541 ELSE DTSCS63
02542 IF L013-NOT-VALID DTSCS63
02543 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS63
02544 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS63
02545 ELSE DTSCS63
02546 MOVE L013-CNT TO MAP-INDCON-TO-EMPL-CNT-N DTSCS63
02547 END-IF. DTSCS63
02548 S2400-EXIT. DTSCS63
02549 EXIT. DTSCS63
02550 S2401-ERROR. DTSCS63
02551 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-INDCON-TO-EMPL-CNT-A. DTSCS63
02552 IF LCCM-NO-MSG DTSCS63
02553 SET CURSOR-SET-YES TO TRUE DTSCS63
02554 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS63
02555 MOVE CATB-CURSOR TO MAP-INDCON-TO-EMPL-CNT-L.DTSCS63
02556 S2401-EXIT. DTSCS63
02557 EXIT. DTSCS63
02558 /*****************************************************************DTSCS63
02559 * DTSCS63
02560 ******************************************************************DTSCS63
02561 S3000-MISC-EDITS. DTSCS63
02562 S3000-EXIT. DTSCS63
02563 EXIT. DTSCS63
02564 /*****************************************************************DTSCS63
02565 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS63
02566 ******************************************************************DTSCS63
02567 S5100-SET-LOCK-ATTRB. DTSCS63
02568 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS63
02569 WRK-ATB-NUM. DTSCS63
02570 DTSCS63
02571 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS63
02572 DTSCS63
02573 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ASSIGN-NO-1-A DTSCS63
02574 MAP-ASSIGN-NO-2-A DTSCS63
02575 MAP-GOTO-A. DTSCS63
02576 S5100-EXIT. DTSCS63
02577 EXIT. DTSCS63
02578 DTSCS63
02579 ******************************************************************DTSCS63
02580 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS63
02581 ******************************************************************DTSCS63
02582 S5200-SET-UPDATE-ATTRB. DTSCS63
02583 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS63
02584 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS63
02585 DTSCS63
02586 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS63
02587 DTSCS63
02588 S5200-EXIT. DTSCS63
02589 EXIT. DTSCS63
02590 DTSCS63
02591 ******************************************************************DTSCS63
02592 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS63
02593 ******************************************************************DTSCS63
02594 S5300-SET-INQ-ATTRB. DTSCS63
02595 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS63
02596 WRK-ATB-NUM. DTSCS63
02597 DTSCS63
02598 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS63
02599 S5300-EXIT. DTSCS63
02600 EXIT. DTSCS63
02601 DTSCS63
02602 S5900-SET-ATTRB. DTSCS63
02603 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-ASSIGN-NO-1-A DTSCS63
02604 MAP-ASSIGN-NO-2-A. DTSCS63
02605 MOVE WRK-ATB-AN TO DTSCS63
02606 MAP-EMP-SIZE-IND-A DTSCS63
02607 MAP-MONEY-REASON-CD-A DTSCS63
02608 MAP-PEN-WAIVER-IND-A DTSCS63
02609 MAP-INT-WAIVER-IND-A DTSCS63
02610 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS63
02611 UNTIL WRK-OCC > MMAX-AUR-ERROR-MAX DTSCS63
02612 MOVE WRK-ATB-AN TO MAP-ERROR-TYPE-A(WRK-OCC) DTSCS63
02613 END-PERFORM DTSCS63
02614 MOVE WRK-ATB-NUM TO DTSCS63
02615 MAP-FIRST-YR-A DTSCS63
02616 MAP-FIRST-Q-A DTSCS63
02617 MAP-LAST-YR-A DTSCS63
02618 MAP-LAST-Q-A DTSCS63
02619 MAP-PROCESSED-DATE-MO-A DTSCS63
02620 MAP-PROCESSED-DATE-DA-A DTSCS63
02621 MAP-PROCESSED-DATE-YR-A DTSCS63
02622 MAP-AUDIT-HRS-A DTSCS63
02623 MAP-MONEY-DUE-AMT-A DTSCS63
02624 MAP-MONEY-COLLECT-AMT-A DTSCS63
02625 MAP-NEW-EMPLOYEE-CNT-A DTSCS63
02626 MAP-INDCON-TO-EMPL-CNT-A DTSCS63
02627 PERFORM VARYING WRK-OCC FROM 1 BY 1 DTSCS63
02628 UNTIL WRK-OCC > 6 DTSCS63
02629 MOVE CATB-ASKIP-BRT-MDTON TO DTSCS63
02630 MAP-YR-A (WRK-OCC) DTSCS63
02631 MAP-YR-GROSS-PAYROLL-A (WRK-OCC) DTSCS63
02632 MAP-YR-UNDER-TOT-WAGE-A (WRK-OCC) DTSCS63
02633 MAP-YR-UNDER-TAX-WAGE-A (WRK-OCC) DTSCS63
02634 MAP-YR-UNDER-CONTRIB-A (WRK-OCC) DTSCS63
02635 MAP-YR-OVER-TOT-WAGE-A (WRK-OCC) DTSCS63
02636 MAP-YR-OVER-TAX-WAGE-A (WRK-OCC) DTSCS63
02637 MAP-YR-OVER-CONTRIB-A (WRK-OCC) DTSCS63
02638 END-PERFORM. DTSCS63
02639 DTSCS63
02640 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS63
02641 MAP-EMP-NO-2-A DTSCS63
02642 MAP-PRIMARY-NAME-A DTSCS63
02643 MAP-QTRS-AUDITED-CNT-A DTSCS63
02644 MAP-ASSIGN-TYPE-A DTSCS63
02645 MAP-COMPLETED-DATE-A DTSCS63
02646 MAP-ESTB-DATE-A DTSCS63
02647 MAP-CHNG-DATE-A. DTSCS63
02648 DTSCS63
02649 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ASSIGN-TYPE-DESC-A DTSCS63
02650 DTSCS63
02651 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS63
02652 S5900-EXIT. DTSCS63
02653 EXIT. DTSCS63
02654 EJECT DTSCS63
02655 /*****************************************************************DTSCS63
02656 * MAP ROUTINES *DTSCS63
02657 ******************************************************************DTSCS63
02658 S9100-RECEIVE. DTSCS63
02659 SET L851-RECEIVE-88 TO TRUE. DTSCS63
02660 DTSCS63
02661 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS63
02662 DTSCS63
02663 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS63
02664 DTSCS63
02665 MOVE L851-AID TO LCCM-AID. DTSCS63
02666 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS63
02667 S9100-EXIT. DTSCS63
02668 EXIT. DTSCS63
02669 DTSCS63
02670 S9200-SEND-DATAONLY. DTSCS63
02671 MOVE LOW-VALUES TO MAP-AREA. DTSCS63
02672 DTSCS63
02673 IF LCCM-NO-MSG DTSCS63
02674 NEXT SENTENCE DTSCS63
02675 ELSE DTSCS63
02676 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS63
02677 DTSCS63
02678 IF CURSOR-SET-GOTO DTSCS63
02679 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS63
02680 ELSE DTSCS63
02681 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS63
02682 DTSCS63
02683 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS63
02684 DTSCS63
02685 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS63
02686 DTSCS63
02687 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS63
02688 S9200-EXIT. DTSCS63
02689 EXIT. DTSCS63
02690 DTSCS63
02691 S9300-SEND-MAP. DTSCS63
02692 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS63
02693 MOVE SPACES TO MAP-SYS-TIME. DTSCS63
02694 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS63
02695 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS63
02696 DTSCS63
02697 IF SCR-ACCESS-UPDATE DTSCS63
02698 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS63
02699 ELSE DTSCS63
02700 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS63
02701 DTSCS63
02702 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS63
02703 DTSCS63
02704 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS63
02705 DTSCS63
02706 IF CURSOR-SET-NO DTSCS63
02707 MOVE CATB-CURSOR TO MAP-ASSIGN-NO-1-L. DTSCS63
02708 DTSCS63
02709 SET L851-SEND-88 TO TRUE. DTSCS63
02710 DTSCS63
02711 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS63
02712 DTSCS63
02713 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS63
02714 S9300-EXIT. DTSCS63
02715 EXIT. DTSCS63
02716 DTSCS63
02717 S9310-UPDATE-FKEYS. DTSCS63
02718 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS63
02719 DTSCS63
02720 DTSCS63
02721 IF LCCM-SCR-INQUIRE DTSCS63
02722 AND WRK-MFAS-YES-88 DTSCS63
02723 AND MFAS-STATUS-COMPLETE-88 DTSCS63
02724 MOVE CFKD-ADD TO MAP-KEY-ADD DTSCS63
02725 ELSE DTSCS63
02726 IF LCCM-SCR-INQUIRE DTSCS63
02727 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS63
02728 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS63
02729 S9310-EXIT. DTSCS63
02730 EXIT. DTSCS63
02731 DTSCS63
02732 S9320-INQUIRY-FKEYS. DTSCS63
02733 DTSCS63
02734 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS63
02735 MAP-KEY-MOD DTSCS63
02736 MAP-KEY-DEL. DTSCS63
02737 DTSCS63
02738 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS63
02739 S9320-EXIT. DTSCS63
02740 EXIT. DTSCS63
02741 DTSCS63
02742 *S9321-JUMP-KEYS. DTSCS63
02743 * MOVE CFKD-REG-INQ TO MAP-KEY-REG. DTSCS63
02744 * MOVE CFKD-ASSIGN TO MAP-KEY-ASSIGN. DTSCS63
02745 * MOVE CFKD-QTR-RSLT-INQ TO MAP-KEY-QTR-RSLT-INQ. DTSCS63
02746 *S9321-EXIT. DTSCS63
02747 * EXIT. DTSCS63
02748 * DTSCS63
02749 S9330-DSCR-FIELDS. DTSCS63
02750 IF WRK-MPRF-YES-88 DTSCS63
02751 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS63
02752 ELSE DTSCS63
02753 MOVE LOW-VALUE TO MAP-PRIMARY-NAME. DTSCS63
02754 DTSCS63
02755 IF MAP-ASSIGN-TYPE = SPACES OR LOW-VALUES DTSCS63
02756 MOVE LOW-VALUES TO MAP-ASSIGN-TYPE-DESC DTSCS63
02757 ELSE DTSCS63
02758 MOVE MAP-ASSIGN-TYPE TO L063-TYPE DTSCS63
02759 PERFORM S063-FIELD-ASSIGNMENT-EDIT THRU S063-EXIT DTSCS63
02760 MOVE L063-DESCRIPTION TO MAP-ASSIGN-TYPE-DESC. DTSCS63
02761 S9330-EXIT. EXIT. DTSCS63
02762 DTSCS63
02763 S9900-PREPARE-SEND. DTSCS63
02764 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS63
02765 LCCM-SCR-ID. DTSCS63
02766 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS63
02767 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS63
02768 S9900-EXIT. DTSCS63
02769 EXIT. DTSCS63
Reference in New Issue View Git Blame Copy Permalink