2771 lines
216 KiB
COBOL
2771 lines
216 KiB
COBOL
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
|