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