2031 lines
159 KiB
COBOL
2031 lines
159 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/08/21
|
|
00002 PROGRAM-ID. DTSCS1D. DTSCS1D
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV060
|
|
00004 DATE-WRITTEN. JUNE 1994. DTSCS1D
|
|
00005 DATE-COMPILED. DTSCS1D
|
|
00006 SKIP3 DTSCS1D
|
|
00007 ***** DTSCS1D
|
|
00008 * DTSCS1D
|
|
00009 * FUNCTION: MISCELLANEOUS REGISTRATION INQUIRY/UPDATE DTSCS1D
|
|
00010 * SCREEN PROCESSOR. DTSCS1D
|
|
00011 * DTSCS1D
|
|
00012 * DTSCS1D
|
|
00013 * MODIFICATION LOG: DTSCS1D
|
|
00014 * DTSCS1D
|
|
00015 * 11/02/98 INITIAL DEVELOPMENT. COPIED FROM MACCS1D. DTSCS1D
|
|
00016 * WORK ORDER: PROGRAMMER: ZL1 DTSCS1D
|
|
00017 * DTSCS1D
|
|
00018 * 05/08/00 MODIFIED TO DISPLAY FISCAL AGENT DATA. DTSCS1D
|
|
00019 * WORK ORDER: PROGRAMMER: ZL1 DTSCS1D
|
|
00020 * DTSCS1D
|
|
00021 * 10/24/05 MODIFIED TO DISPLAY RETURN MAIL INDICATOR DTSCS1D
|
|
00022 * WORK ORDER: PROGRAMMER: ZL1 DTSCS1D
|
|
00023 * DTSCS1D
|
|
00024 * 02/01/06 ADDED EVENT LOG RECORD WHEN RETURN MAIL DTSCS1D
|
|
00025 * INDICATOR IS CHANGED. DTSCS1D
|
|
00026 * WORK ORDER: PROGRAMMER: GD DTSCS1D
|
|
00027 * DTSCS1D
|
|
00028 * 07/14/2009 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00029 * ELIGIBILITY CODES 21 (AB) AND 22 (DEPENDENCY DTSCS1D
|
|
00030 * ALLOWANCE) ADDED. DTSCS1D
|
|
00031 * REFERENCE: PROGRAMMER: GD DTSCS1D
|
|
00032 * DTSCS1D
|
|
00033 * 07/15/2009 ADDED POWER OF ATTORNEY RECEIVED DATE. DTSCS1D
|
|
00034 * THIS REPLACES THE OTR ACCT NBR (BTN) THAT WAS DTSCS1D
|
|
00035 * ORIGINALLY IN THE SAME PLACE ON THE SCREEN. DTSCS1D
|
|
00036 * REFERENCE: PROGRAMMER: GD DTSCS1D
|
|
00037 * DTSCS1D
|
|
00038 * 07/30/2009 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00039 * ELIGIBILITY CODE 23 (TRAINING EXTENSION) ADDED DTSCS1D
|
|
00040 * REFERENCE: PROGRAMMER: GD DTSCS1D
|
|
00041 * DTSCS1D
|
|
00042 * 11/17/2009 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00043 * ELIGIBILITY CODES 24 AND 25 (EUC 2008 TIERS DTSCS1D
|
|
00044 * 3 AND 4) DTSCS1D
|
|
00045 * REFERENCE: PROGRAMMER: GD DTSCS1D
|
|
00046 * DTSCS1D
|
|
00047 * 07/13/2011 MODIFIED TO SHOW YY IN POWER OF ATTORNEY DTSCS1D
|
|
00048 * FIELD. DTSCS1D
|
|
00049 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00050 * DTSCS1D
|
|
00051 * 09/26/2014 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00052 * ELIGIBILITY CODE 28 (UCPIA) DTSCS1D
|
|
00053 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00054 * DTSCS1D
|
|
00055 * 03/26/2015 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00056 * ELIGIBILITY CODE 29 (DUA) AND 30 GPA DTSCS1D
|
|
00057 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00058 * DTSCS1D
|
|
00059 * 09/15/2015 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00060 * ORGANIZATION CODES UNA FIT AND OTH DTSCS1D
|
|
00061 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00062 * DTSCS1D
|
|
00063 * 04/07/2020 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00064 * ELIGIBILITY CODE 32 (FPUC) AND 33 FRUR DTSCS1D
|
|
00065 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00066 * DTSCS1D
|
|
00067 * 04/24/2020 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00068 * ELIGIBILITY CODE 34 (PEUC) DTSCS1D
|
|
00069 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00070 * DTSCS1D
|
|
00071 * 05/08/2020 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00072 * ELIGIBILITY CODE 35 (REUR) DTSCS1D
|
|
00073 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00074 * DTSCS1D
|
|
00075 * 09/02/2020 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00076 * ELIGIBILITY CODE 36 (LWA) DTSCS1D
|
|
00077 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00078 * DTSCS1D
|
|
00079 * 12/05/2020 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00080 * ELIGIBILITY CODE 37 PUA SITMULUS DTSCS1D
|
|
00081 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00082 * DTSCS1D
|
|
00083 * 02/16/2021 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00084 * ELIGIBILITY CODE 38 MEUC DTSCS1D
|
|
00085 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00086 * DTSCS1D
|
|
00087 * 12/06/2021 RECOMPILED FOR NEW VERSION OF MPRF - DTSCS1D
|
|
00088 * ELIGIBILITY CODE 39 DUC DTSCS1D
|
|
00089 * REFERENCE: PROGRAMMER: ZL1 DTSCS1D
|
|
00090 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS1D
|
|
00091 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS1D
|
|
00092 * WORK ORDER: PROGRAMMER: XXX DTSCS1D
|
|
00093 * DTSCS1D
|
|
00094 * DTSCS1D
|
|
00095 * DESCRIPTION: DTSCS1D
|
|
00096 * DTSCS1D
|
|
00097 * DTSCS1D
|
|
00098 * CLEAR: DTSCS1D
|
|
00099 * DTSCS1D
|
|
00100 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS1D
|
|
00101 * DTSCS1D
|
|
00102 * DTSCS1D
|
|
00103 * JUMP: DTSCS1D
|
|
00104 * DTSCS1D
|
|
00105 * F17 REGISTRATION INQUIRY (11). DTSCS1D
|
|
00106 * DTSCS1D
|
|
00107 * DTSCS1D
|
|
00108 * INQUIRY: DTSCS1D
|
|
00109 * DTSCS1D
|
|
00110 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS1D
|
|
00111 * DTSCS1D
|
|
00112 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS1D
|
|
00113 * DTSCS1D
|
|
00114 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS1D
|
|
00115 * DTSCS1D
|
|
00116 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS1D
|
|
00117 * DTSCS1D
|
|
00118 * DTSCS1D
|
|
00119 * UPDATE: DTSCS1D
|
|
00120 * DTSCS1D
|
|
00121 * MOD. DTSCS1D
|
|
00122 * DTSCS1D
|
|
00123 * DTSCS1D
|
|
00124 * RECORDS READ: DTSCS1D
|
|
00125 * DTSCS1D
|
|
00126 * MASTER: DTSCS1D
|
|
00127 * DTSCS1D
|
|
00128 * MPRF. DTSCS1D
|
|
00129 * DTSCS1D
|
|
00130 * DTSCS1D
|
|
00131 * ALTERNATE INDEX: DTSCS1D
|
|
00132 * DTSCS1D
|
|
00133 * N/A. DTSCS1D
|
|
00134 * DTSCS1D
|
|
00135 * DTSCS1D
|
|
00136 * REFERENCE: DTSCS1D
|
|
00137 * DTSCS1D
|
|
00138 * N/A. DTSCS1D
|
|
00139 * DTSCS1D
|
|
00140 * DTSCS1D
|
|
00141 * ACCOUNTING TRANSACTION COLLECTION: DTSCS1D
|
|
00142 * DTSCS1D
|
|
00143 * N/A. DTSCS1D
|
|
00144 * DTSCS1D
|
|
00145 * DTSCS1D
|
|
00146 * RECORDS UPDATED: DTSCS1D
|
|
00147 * DTSCS1D
|
|
00148 * MASTER: DTSCS1D
|
|
00149 * DTSCS1D
|
|
00150 * MPRF (REWRITE). DTSCS1D
|
|
00151 * DTSCS1D
|
|
00152 * DTSCS1D
|
|
00153 * REFERENCE: DTSCS1D
|
|
00154 * DTSCS1D
|
|
00155 * N/A. DTSCS1D
|
|
00156 * DTSCS1D
|
|
00157 * DTSCS1D
|
|
00158 * ACCOUNTING TRANSACTION COLLECTION: DTSCS1D
|
|
00159 * DTSCS1D
|
|
00160 * N/A. DTSCS1D
|
|
00161 * DTSCS1D
|
|
00162 * DTSCS1D
|
|
00163 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS1D
|
|
00164 * DTSCS1D
|
|
00165 * N/A. DTSCS1D
|
|
00166 * DTSCS1D
|
|
00167 * DTSCS1D
|
|
00168 * TEMPORARY STORAGE USAGE: DTSCS1D
|
|
00169 * DTSCS1D
|
|
00170 * N/A. DTSCS1D
|
|
00171 * DTSCS1D
|
|
00172 * DTSCS1D
|
|
00173 * MODULES LINKED TO: DTSCS1D
|
|
00174 * DTSCS1D
|
|
00175 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS1D
|
|
00176 * DTSCU016 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS1D
|
|
00177 * DTSCU017 FEIN FROM SCREEN FORMAT/EDIT. DTSCS1D
|
|
00178 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS1D
|
|
00179 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS1D
|
|
00180 * DTSCU039 SIC CODE EDIT/DESCRIPTION. DTSCS1D
|
|
00181 * DTSCU074 DUPLICATE FEIN EDIT. DTSCS1D
|
|
00182 * DTSCU204 DETERMINE SIC DIVISION. DTSCS1D
|
|
00183 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS1D
|
|
00184 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORDS. DTSCS1D
|
|
00185 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS1D
|
|
00186 * DTSCS1D
|
|
00187 * DTSCS1D
|
|
00188 * MAINTENANCE NOTES: DTSCS1D
|
|
00189 * DTSCS1D
|
|
00190 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS1D
|
|
00191 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS1D
|
|
00192 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS1D
|
|
00193 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS1D
|
|
00194 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS1D), DTSCS1D
|
|
00195 * ALTER THE MAP (DTSM1D) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS1D
|
|
00196 * DTSCS1D
|
|
00197 * DTSCS1D
|
|
00198 * VERMONT REFERENCE: DTSCS1D
|
|
00199 * DTSCS1D
|
|
00200 * N/A. DTSCS1D
|
|
00201 * DTSCS1D
|
|
00202 ***** DTSCS1D
|
|
00203 SKIP3 DTSCS1D
|
|
00204 ENVIRONMENT DIVISION. DTSCS1D
|
|
00205 SKIP3 DTSCS1D
|
|
00206 DATA DIVISION. DTSCS1D
|
|
00207 SKIP3 DTSCS1D
|
|
00208 WORKING-STORAGE SECTION. DTSCS1D
|
|
002085 77 PAN-VALET PICTURE X(24) VALUE '060DTSCS1D 12/08/21'. DTSCS1D
|
|
00209 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1D 12/07/21'. DTSCS1D
|
|
00210 77 PAN-VALET PICTURE X(24) VALUE '058DTSCS1D 02/16/21'. DTSCS1D
|
|
00211 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1D 02/16/21'. DTSCS1D
|
|
00212 77 PAN-VALET PICTURE X(24) VALUE '056DTSCS1D 12/07/20'. DTSCS1D
|
|
00213 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1D 12/07/20'. DTSCS1D
|
|
00214 77 PAN-VALET PICTURE X(24) VALUE '054DTSCS1D 05/08/20'. DTSCS1D
|
|
00215 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1D 05/08/20'. DTSCS1D
|
|
00216 77 PAN-VALET PICTURE X(24) VALUE '052DTSCS1D 04/27/20'. DTSCS1D
|
|
00217 77 PAN-VALET PICTURE X(24) VALUE '004DTSCS1D 04/25/20'. DTSCS1D
|
|
00218 77 PAN-VALET PICTURE X(24) VALUE '050DTSCS1D 03/25/15'. DTSCS1D
|
|
00219 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1D 03/25/15'. DTSCS1D
|
|
00220 77 PAN-VALET PICTURE X(24) VALUE '048DTSCS1D 10/01/14'. DTSCS1D
|
|
00221 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1D 09/26/14'. DTSCS1D
|
|
00222 77 PAN-VALET PICTURE X(24) VALUE '046DTSCS1D 07/13/11'. DTSCS1D
|
|
00223 SKIP3 DTSCS1D
|
|
00224 01 WRK-AREA. DTSCS1D
|
|
00225 05 WRK-ABEND-CD PIC X(04) VALUE 'S1D '. DTSCS1D
|
|
00226 SKIP1 DTSCS1D
|
|
00227 05 WRK-SCR-ID PIC X(02) VALUE '1D'. DTSCS1D
|
|
00228 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS1D
|
|
00229 SKIP1 DTSCS1D
|
|
00230 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS1D
|
|
00231 SKIP1 DTSCS1D
|
|
00232 05 WRK-MSG-AREA PIC X(62). DTSCS1D
|
|
00233 SKIP1 DTSCS1D
|
|
00234 05 WRK-MPRF-IND PIC X(01). DTSCS1D
|
|
00235 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS1D
|
|
00236 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS1D
|
|
00237 SKIP1 DTSCS1D
|
|
00238 05 WRK-FISCAL-AGENT-NAME PIC X(40) VALUE SPACES. DTSCS1D
|
|
00239 05 WRK-DISPLAY PIC 9(09). DTSCS1D
|
|
00240 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1D
|
|
00241 10 WRK-DISPLAY-FEIN-1 PIC X(02). DTSCS1D
|
|
00242 10 WRK-DISPLAY-FEIN-2 PIC X(07). DTSCS1D
|
|
00243 DTSCS1D
|
|
00244 05 WRK-MSOL-CNT PIC S9(04) COMP. DTSCS1D
|
|
00245 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSCS1D
|
|
00246 05 WRK-UPD-MSOL-IND PIC X(01). DTSCS1D
|
|
00247 88 WRK-UPD-MSOL-YES-88 VALUE 'Y'. DTSCS1D
|
|
00248 88 WRK-UPD-MSOL-NO-88 VALUE 'N'. DTSCS1D
|
|
00249 05 WRK-LIAB-CD-DOMESTIC-IND PIC X(01). DTSCS1D
|
|
00250 88 WRK-LIAB-CD-DOMESTIC-YES-88 VALUE 'Y'. DTSCS1D
|
|
00251 88 WRK-LIAB-CD-DOMESTIC-NO-88 VALUE 'N'. DTSCS1D
|
|
00252 DTSCS1D
|
|
00253 05 WRK-PWR-ATTORNEY-YR. DTSCS1D
|
|
00254 15 WRK-PWR-ATTORNEY-CC PIC 99. DTSCS1D
|
|
00255 15 WRK-PWR-ATTORNEY-YY PIC 99. DTSCS1D
|
|
00256 EJECT DTSCS1D
|
|
00257 01 SCREEN-CONTROL. DTSCS1D
|
|
00258 05 SCR-ACCESS-IND PIC X(01). DTSCS1D
|
|
00259 88 SCR-ACCESS-INQ VALUE '1'. DTSCS1D
|
|
00260 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS1D
|
|
00261 SKIP1 DTSCS1D
|
|
00262 05 CURSOR-SET-IND PIC X(01). DTSCS1D
|
|
00263 88 CURSOR-SET-YES VALUE 'Y'. DTSCS1D
|
|
00264 88 CURSOR-SET-NO VALUE 'N'. DTSCS1D
|
|
00265 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS1D
|
|
00266 SKIP1 DTSCS1D
|
|
00267 05 REQ-IND PIC X(01). DTSCS1D
|
|
00268 88 REQ-ERROR VALUE 'O'. DTSCS1D
|
|
00269 88 REQ-JUMP VALUE 'J'. DTSCS1D
|
|
00270 88 REQ-INQUIRE VALUE 'I'. DTSCS1D
|
|
00271 88 REQ-CLEAR VALUE 'C'. DTSCS1D
|
|
00272 88 REQ-EDIT VALUE 'E'. DTSCS1D
|
|
00273 88 REQ-UPDATE VALUE 'U'. DTSCS1D
|
|
00274 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS1D
|
|
00275 SKIP1 DTSCS1D
|
|
00276 05 RESP-IND PIC X(01). DTSCS1D
|
|
00277 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS1D
|
|
00278 88 RESP-SEND-MAP VALUE 'M'. DTSCS1D
|
|
00279 88 RESP-JUMP VALUE 'J'. DTSCS1D
|
|
00280 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS1D
|
|
00281 SKIP1 DTSCS1D
|
|
00282 05 SCR-ATB-AN PIC X(01). DTSCS1D
|
|
00283 05 SCR-ATB-NUM PIC X(01). DTSCS1D
|
|
00284 DTSCS1D
|
|
00285 05 WRK-RET-MAIL-IND PIC X(01). DTSCS1D
|
|
00286 88 WRK-RET-MAIL-ON-88 VALUE '1'. DTSCS1D
|
|
00287 88 WRK-RET-MAIL-OFF-88 VALUE '2'. DTSCS1D
|
|
00288 88 WRK-RET-MAIL-NULL-88 VALUE '0'. DTSCS1D
|
|
00289 DTSCS1D
|
|
00290 01 MSG-LITERALS. DTSCS1D
|
|
00291 05 MSG-E1D1-AREA. DTSCS1D
|
|
00292 10 FILLER PIC X(04) VALUE 'E1D1'. DTSCS1D
|
|
00293 10 FILLER PIC X(30) DTSCS1D
|
|
00294 VALUE 'CHANGE NOT ALLOWED - LIABILITY'. DTSCS1D
|
|
00295 10 FILLER PIC X(30) DTSCS1D
|
|
00296 VALUE ' CODE NOT HOUSEHOLD '. DTSCS1D
|
|
00297 05 MSG-E1D2-AREA. DTSCS1D
|
|
00298 10 FILLER PIC X(04) VALUE 'E1D2'. DTSCS1D
|
|
00299 10 FILLER PIC X(30) DTSCS1D
|
|
00300 VALUE 'NOT ALLOWED: EMPLOYER NOT LIAB'. DTSCS1D
|
|
00301 10 FILLER PIC X(30) DTSCS1D
|
|
00302 VALUE 'LE '. DTSCS1D
|
|
00303 05 MSG-E1D3-AREA. DTSCS1D
|
|
00304 10 FILLER PIC X(04) VALUE 'E1D3'. DTSCS1D
|
|
00305 10 FILLER PIC X(30) DTSCS1D
|
|
00306 VALUE 'CHANGE FROM HOUSEHOLD NOT ALLO'. DTSCS1D
|
|
00307 10 FILLER PIC X(30) DTSCS1D
|
|
00308 VALUE 'WED. ESATBLISH NEW ACCOUNT '. DTSCS1D
|
|
00309 DTSCS1D
|
|
00310 DTSCS1D
|
|
00311 01 L001-COMM-AREA. DTSCS1D
|
|
00312 ++INCLUDE DTSIL001 DTSCS1D
|
|
00313 EJECT DTSCS1D
|
|
00314 01 L004-COMM-AREA. DTSCS1D
|
|
00315 ++INCLUDE DTSIL004 DTSCS1D
|
|
00316 EJECT DTSCS1D
|
|
00317 01 L015-COMM-AREA. DTSCS1D
|
|
00318 ++INCLUDE DTSIL015 DTSCS1D
|
|
00319 EJECT DTSCS1D
|
|
00320 01 L016-COMM-AREA. DTSCS1D
|
|
00321 ++INCLUDE DTSIL016 DTSCS1D
|
|
00322 EJECT DTSCS1D
|
|
00323 01 L017-COMM-AREA. DTSCS1D
|
|
00324 ++INCLUDE DTSIL017 DTSCS1D
|
|
00325 EJECT DTSCS1D
|
|
00326 01 L018-COMM-AREA. DTSCS1D
|
|
00327 ++INCLUDE DTSIL018 DTSCS1D
|
|
00328 EJECT DTSCS1D
|
|
00329 01 L027-COMM-AREA. DTSCS1D
|
|
00330 ++INCLUDE DTSIL027 DTSCS1D
|
|
00331 EJECT DTSCS1D
|
|
00332 01 L031-COMM-AREA. DTSCS1D
|
|
00333 ++INCLUDE DTSIL031 DTSCS1D
|
|
00334 EJECT DTSCS1D
|
|
00335 *01 L039-COMM-AREA. DTSCS1D
|
|
00336 ***INCLUDE DTSIL039 DTSCS1D
|
|
00337 EJECT DTSCS1D
|
|
00338 01 L074-COMM-AREA. DTSCS1D
|
|
00339 ++INCLUDE DTSIL074 DTSCS1D
|
|
00340 EJECT DTSCS1D
|
|
00341 01 L221-COMM-AREA. DTSCS1D
|
|
00342 ++INCLUDE DTSIL221 DTSCS1D
|
|
00343 EJECT DTSCS1D
|
|
00344 01 L331-COMM-AREA. DTSCS1D
|
|
00345 ++INCLUDE DTSIL331 DTSCS1D
|
|
00346 EJECT DTSCS1D
|
|
00347 01 L400-COMM-AREA. DTSCS1D
|
|
00348 ++INCLUDE DTSIL400 DTSCS1D
|
|
00349 EJECT DTSCS1D
|
|
00350 01 L805-COMM-AREA. DTSCS1D
|
|
00351 ++INCLUDE DTSIL805 DTSCS1D
|
|
00352 EJECT DTSCS1D
|
|
00353 01 L810-COMM-AREA. DTSCS1D
|
|
00354 05 L810-CONTROL-BLOCK. DTSCS1D
|
|
00355 ++INCLUDE DTSIL810 DTSCS1D
|
|
00356 EJECT DTSCS1D
|
|
00357 05 MSKL-REC. DTSCS1D
|
|
00358 ++INCLUDE DTSIMSKL DTSCS1D
|
|
00359 SKIP1 DTSCS1D
|
|
00360 EJECT DTSCS1D
|
|
00361 01 L831-COMM-AREA. DTSCS1D
|
|
00362 05 L831-CONTROL-BLOCK. DTSCS1D
|
|
00363 ++INCLUDE DTSIL831 DTSCS1D
|
|
00364 EJECT DTSCS1D
|
|
00365 05 FSKL-REC. DTSCS1D
|
|
00366 ++INCLUDE DTSIFSKL DTSCS1D
|
|
00367 SKIP1 DTSCS1D
|
|
00368 05 MFAE-REC. DTSCS1D
|
|
00369 ++INCLUDE DTSIMFAE DTSCS1D
|
|
00370 SKIP1 DTSCS1D
|
|
00371 05 FFIS-REC. DTSCS1D
|
|
00372 ++INCLUDE DTSIFFIS DTSCS1D
|
|
00373 SKIP1 DTSCS1D
|
|
00374 01 MPRF-REC. DTSCS1D
|
|
00375 ++INCLUDE DTSIMPRF DTSCS1D
|
|
00376 01 MSOL-REC. DTSCS1D
|
|
00377 SKIP1 DTSCS1D
|
|
00378 ++INCLUDE DTSIMSOL DTSCS1D
|
|
00379 01 MEVL-REC. DTSCS1D
|
|
00380 SKIP1 DTSCS1D
|
|
00381 ++INCLUDE DTSIMEVL DTSCS1D
|
|
00382 DTSCS1D
|
|
00383 01 L851-COMM-AREA. DTSCS1D
|
|
00384 SKIP1 DTSCS1D
|
|
00385 ++INCLUDE DTSIL851 DTSCS1D
|
|
00386 SKIP3 DTSCS1D
|
|
00387 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS1D
|
|
00388 ++INCLUDE DTSIS1D DTSCS1D
|
|
00389 EJECT DTSCS1D
|
|
00390 01 CATB-LITERALS. DTSCS1D
|
|
00391 ++INCLUDE DTSICATB DTSCS1D
|
|
00392 SKIP3 DTSCS1D
|
|
00393 01 CFKD-LITERALS. DTSCS1D
|
|
00394 ++INCLUDE DTSICFKD DTSCS1D
|
|
00395 EJECT DTSCS1D
|
|
00396 01 CECD-LITERALS. DTSCS1D
|
|
00397 ++INCLUDE DTSICECD DTSCS1D
|
|
00398 SKIP3 DTSCS1D
|
|
00399 01 CPCD-LITERALS. DTSCS1D
|
|
00400 ++INCLUDE DTSICPCD DTSCS1D
|
|
00401 EJECT DTSCS1D
|
|
00402 LINKAGE SECTION. DTSCS1D
|
|
00403 SKIP3 DTSCS1D
|
|
00404 01 DFHCOMMAREA. DTSCS1D
|
|
00405 ++INCLUDE DTSILCCM DTSCS1D
|
|
00406 EJECT DTSCS1D
|
|
00407 ******************************************************************DTSCS1D
|
|
00408 * *DTSCS1D
|
|
00409 ******************************************************************DTSCS1D
|
|
00410 SKIP1 DTSCS1D
|
|
00411 PROCEDURE DIVISION. DTSCS1D
|
|
00412 SKIP2 DTSCS1D
|
|
00413 MOVE +0 TO WRK-EMP-NO. DTSCS1D
|
|
00414 MOVE LOW-VALUES TO MAP-AREA. DTSCS1D
|
|
00415 SET CURSOR-SET-NO TO TRUE. DTSCS1D
|
|
00416 SET WRK-MPRF-NO-88 TO TRUE. DTSCS1D
|
|
00417 SKIP1 DTSCS1D
|
|
00418 SET SCR-ACCESS-INQ TO TRUE. DTSCS1D
|
|
00419 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS1D
|
|
00420 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCS1D
|
|
00421 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCS1D
|
|
00422 SKIP3 DTSCS1D
|
|
00423 MOVE SPACE TO REQ-IND. DTSCS1D
|
|
00424 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS1D
|
|
00425 SKIP1 DTSCS1D
|
|
00426 *----------------------------------------------------- DTSCS1D
|
|
00427 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS1D
|
|
00428 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS1D
|
|
00429 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS1D
|
|
00430 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS1D
|
|
00431 * DTSCS1D
|
|
00432 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS1D
|
|
00433 * PROCESSED. DTSCS1D
|
|
00434 * DTSCS1D
|
|
00435 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS1D
|
|
00436 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS1D
|
|
00437 * WORK STATION OPERATOR. DTSCS1D
|
|
00438 *----------------------------------------------------- DTSCS1D
|
|
00439 SKIP1 DTSCS1D
|
|
00440 MOVE SPACE TO RESP-IND. DTSCS1D
|
|
00441 SKIP1 DTSCS1D
|
|
00442 IF REQ-ERROR DTSCS1D
|
|
00443 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS1D
|
|
00444 ELSE DTSCS1D
|
|
00445 IF REQ-JUMP DTSCS1D
|
|
00446 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS1D
|
|
00447 ELSE DTSCS1D
|
|
00448 IF REQ-CLEAR DTSCS1D
|
|
00449 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS1D
|
|
00450 ELSE DTSCS1D
|
|
00451 IF REQ-CURSOR-TO-GOTO DTSCS1D
|
|
00452 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS1D
|
|
00453 ELSE DTSCS1D
|
|
00454 IF REQ-INQUIRE DTSCS1D
|
|
00455 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS1D
|
|
00456 ELSE DTSCS1D
|
|
00457 IF REQ-EDIT DTSCS1D
|
|
00458 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS1D
|
|
00459 ELSE DTSCS1D
|
|
00460 IF REQ-UPDATE DTSCS1D
|
|
00461 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS1D
|
|
00462 ELSE DTSCS1D
|
|
00463 GO TO S899-ABEND. DTSCS1D
|
|
00464 SKIP3 DTSCS1D
|
|
00465 *----------------------------------------------------- DTSCS1D
|
|
00466 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS1D
|
|
00467 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS1D
|
|
00468 *----------------------------------------------------- DTSCS1D
|
|
00469 SKIP1 DTSCS1D
|
|
00470 IF RESP-SEND-MAP DTSCS1D
|
|
00471 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS1D
|
|
00472 SET LCCM-END-TASK-88 TO TRUE DTSCS1D
|
|
00473 ELSE DTSCS1D
|
|
00474 IF RESP-SEND-MSGONLY DTSCS1D
|
|
00475 OR RESP-CURSOR-TO-GOTO DTSCS1D
|
|
00476 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS1D
|
|
00477 SET LCCM-END-TASK-88 TO TRUE DTSCS1D
|
|
00478 ELSE DTSCS1D
|
|
00479 IF RESP-JUMP DTSCS1D
|
|
00480 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
00481 ELSE DTSCS1D
|
|
00482 GO TO S899-ABEND. DTSCS1D
|
|
00483 SKIP3 DTSCS1D
|
|
00484 MAINLINE-EXIT. DTSCS1D
|
|
00485 SKIP1 DTSCS1D
|
|
00486 EXEC CICS DTSCS1D
|
|
00487 RETURN DTSCS1D
|
|
00488 END-EXEC. DTSCS1D
|
|
00489 SKIP2 DTSCS1D
|
|
00490 * GOBACK. DTSCS1D
|
|
00491 EJECT DTSCS1D
|
|
00492 P0100-ACCESS-SEARCH. DTSCS1D
|
|
00493 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCS1D
|
|
00494 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS1D
|
|
00495 TO SCR-ACCESS-IND. DTSCS1D
|
|
00496 P0100-EXIT. DTSCS1D
|
|
00497 EXIT. DTSCS1D
|
|
00498 /*****************************************************************DTSCS1D
|
|
00499 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS1D
|
|
00500 ******************************************************************DTSCS1D
|
|
00501 P1000-ANALYZE-REQUEST. DTSCS1D
|
|
00502 SKIP1 DTSCS1D
|
|
00503 *----------------------------------------------------- DTSCS1D
|
|
00504 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS1D
|
|
00505 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS1D
|
|
00506 * REPLACED WITH ENTER) DTSCS1D
|
|
00507 *----------------------------------------------------- DTSCS1D
|
|
00508 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS1D
|
|
00509 SET LCCM-ENTER-88 TO TRUE DTSCS1D
|
|
00510 SET REQ-INQUIRE TO TRUE DTSCS1D
|
|
00511 IF LCCM-EMP-NO > ZERO DTSCS1D
|
|
00512 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS1D
|
|
00513 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS1D
|
|
00514 END-IF DTSCS1D
|
|
00515 GO TO P1000-EXIT. DTSCS1D
|
|
00516 SKIP3 DTSCS1D
|
|
00517 *----------------------------------------------------- DTSCS1D
|
|
00518 * MAP IS RECEIVED DTSCS1D
|
|
00519 *----------------------------------------------------- DTSCS1D
|
|
00520 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS1D
|
|
00521 SKIP3 DTSCS1D
|
|
00522 *----------------------------------------------------- DTSCS1D
|
|
00523 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS1D
|
|
00524 * WORK STATION DTSCS1D
|
|
00525 *----------------------------------------------------- DTSCS1D
|
|
00526 IF LCCM-CLEAR-88 DTSCS1D
|
|
00527 SET REQ-CLEAR TO TRUE DTSCS1D
|
|
00528 GO TO P1000-EXIT. DTSCS1D
|
|
00529 SKIP3 DTSCS1D
|
|
00530 *----------------------------------------------------- DTSCS1D
|
|
00531 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS1D
|
|
00532 *----------------------------------------------------- DTSCS1D
|
|
00533 IF LCCM-SCR-UPDATE-LOCKED DTSCS1D
|
|
00534 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS1D
|
|
00535 GO TO P1000-EXIT. DTSCS1D
|
|
00536 SKIP3 DTSCS1D
|
|
00537 *----------------------------------------------------- DTSCS1D
|
|
00538 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS1D
|
|
00539 *----------------------------------------------------- DTSCS1D
|
|
00540 IF LCCM-PA2-88 DTSCS1D
|
|
00541 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS1D
|
|
00542 GO TO P1000-EXIT. DTSCS1D
|
|
00543 SKIP3 DTSCS1D
|
|
00544 *----------------------------------------------------- DTSCS1D
|
|
00545 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS1D
|
|
00546 *----------------------------------------------------- DTSCS1D
|
|
00547 IF LCCM-PA-88 DTSCS1D
|
|
00548 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS1D
|
|
00549 SET REQ-ERROR TO TRUE DTSCS1D
|
|
00550 GO TO P1000-EXIT. DTSCS1D
|
|
00551 SKIP3 DTSCS1D
|
|
00552 *----------------------------------------------------- DTSCS1D
|
|
00553 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS1D
|
|
00554 * CLEAR SCREEN DTSCS1D
|
|
00555 *----------------------------------------------------- DTSCS1D
|
|
00556 IF LCCM-F12-88 DTSCS1D
|
|
00557 MOVE LOW-VALUES TO MAP-AREA DTSCS1D
|
|
00558 SET REQ-CLEAR TO TRUE DTSCS1D
|
|
00559 GO TO P1000-EXIT. DTSCS1D
|
|
00560 SKIP3 DTSCS1D
|
|
00561 *----------------------------------------------------- DTSCS1D
|
|
00562 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS1D
|
|
00563 *----------------------------------------------------- DTSCS1D
|
|
00564 IF LCCM-F03-88 DTSCS1D
|
|
00565 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1D
|
|
00566 SET REQ-JUMP TO TRUE DTSCS1D
|
|
00567 GO TO P1000-EXIT. DTSCS1D
|
|
00568 SKIP3 DTSCS1D
|
|
00569 *----------------------------------------------------- DTSCS1D
|
|
00570 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS1D
|
|
00571 *----------------------------------------------------- DTSCS1D
|
|
00572 IF LCCM-F04-88 DTSCS1D
|
|
00573 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1D
|
|
00574 SET REQ-JUMP TO TRUE DTSCS1D
|
|
00575 GO TO P1000-EXIT. DTSCS1D
|
|
00576 SKIP3 DTSCS1D
|
|
00577 *----------------------------------------------------- DTSCS1D
|
|
00578 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS1D
|
|
00579 * CORRESPONDENCE SCREEN DTSCS1D
|
|
00580 *----------------------------------------------------- DTSCS1D
|
|
00581 IF LCCM-F14-88 DTSCS1D
|
|
00582 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1D
|
|
00583 SET REQ-JUMP TO TRUE DTSCS1D
|
|
00584 GO TO P1000-EXIT. DTSCS1D
|
|
00585 SKIP3 DTSCS1D
|
|
00586 *----------------------------------------------------- DTSCS1D
|
|
00587 * IF REGISTRATION INQUIRY SCREEN KEY PRESSED, DTSCS1D
|
|
00588 * THEN JUMP TO REGISTRATION INQUIRY SCREEN. DTSCS1D
|
|
00589 *----------------------------------------------------- DTSCS1D
|
|
00590 * IF LCCM-F17-88 DTSCS1D
|
|
00591 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS1D
|
|
00592 * SET REQ-JUMP TO TRUE DTSCS1D
|
|
00593 * GO TO P1000-EXIT. DTSCS1D
|
|
00594 * SKIP3 DTSCS1D
|
|
00595 *----------------------------------------------------- DTSCS1D
|
|
00596 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS1D
|
|
00597 * REQUESTED SCREEN TYPE DTSCS1D
|
|
00598 *----------------------------------------------------- DTSCS1D
|
|
00599 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS1D
|
|
00600 NEXT SENTENCE DTSCS1D
|
|
00601 ELSE DTSCS1D
|
|
00602 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS1D
|
|
00603 SET REQ-JUMP TO TRUE DTSCS1D
|
|
00604 GO TO P1000-EXIT. DTSCS1D
|
|
00605 SKIP3 DTSCS1D
|
|
00606 *----------------------------------------------------- DTSCS1D
|
|
00607 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS1D
|
|
00608 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS1D
|
|
00609 *----------------------------------------------------- DTSCS1D
|
|
00610 IF LCCM-F10-88 DTSCS1D
|
|
00611 IF SCR-ACCESS-UPDATE DTSCS1D
|
|
00612 SET REQ-EDIT TO TRUE DTSCS1D
|
|
00613 GO TO P1000-EXIT DTSCS1D
|
|
00614 ELSE DTSCS1D
|
|
00615 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS1D
|
|
00616 SET REQ-ERROR TO TRUE DTSCS1D
|
|
00617 GO TO P1000-EXIT. DTSCS1D
|
|
00618 SKIP3 DTSCS1D
|
|
00619 *----------------------------------------------------- DTSCS1D
|
|
00620 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS1D
|
|
00621 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS1D
|
|
00622 *----------------------------------------------------- DTSCS1D
|
|
00623 IF LCCM-ENTER-88 DTSCS1D
|
|
00624 SET REQ-INQUIRE TO TRUE DTSCS1D
|
|
00625 GO TO P1000-EXIT. DTSCS1D
|
|
00626 SKIP3 DTSCS1D
|
|
00627 *----------------------------------------------------- DTSCS1D
|
|
00628 * ANY OTHER KEY IS INVALID DTSCS1D
|
|
00629 *----------------------------------------------------- DTSCS1D
|
|
00630 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS1D
|
|
00631 SET REQ-ERROR TO TRUE. DTSCS1D
|
|
00632 P1000-EXIT. EXIT. DTSCS1D
|
|
00633 SKIP3 DTSCS1D
|
|
00634 ******************************************************************DTSCS1D
|
|
00635 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS1D
|
|
00636 ******************************************************************DTSCS1D
|
|
00637 SKIP1 DTSCS1D
|
|
00638 P1100-UPDATE-LOCKED. DTSCS1D
|
|
00639 *----------------------------------------------------- DTSCS1D
|
|
00640 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS1D
|
|
00641 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS1D
|
|
00642 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS1D
|
|
00643 *----------------------------------------------------- DTSCS1D
|
|
00644 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS1D
|
|
00645 SET REQ-UPDATE TO TRUE DTSCS1D
|
|
00646 ELSE DTSCS1D
|
|
00647 SET REQ-ERROR TO TRUE DTSCS1D
|
|
00648 IF LCCM-SCR-MOD-LOCKED DTSCS1D
|
|
00649 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS1D
|
|
00650 ELSE DTSCS1D
|
|
00651 GO TO S899-ABEND. DTSCS1D
|
|
00652 P1100-EXIT. EXIT. DTSCS1D
|
|
00653 /*****************************************************************DTSCS1D
|
|
00654 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS1D
|
|
00655 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS1D
|
|
00656 ******************************************************************DTSCS1D
|
|
00657 SKIP1 DTSCS1D
|
|
00658 P2000-REQUEST-ERROR. DTSCS1D
|
|
00659 IF LCCM-MSG DTSCS1D
|
|
00660 SET RESP-SEND-MSGONLY TO TRUE DTSCS1D
|
|
00661 ELSE DTSCS1D
|
|
00662 GO TO S899-ABEND. DTSCS1D
|
|
00663 P2000-EXIT. EXIT. DTSCS1D
|
|
00664 /*****************************************************************DTSCS1D
|
|
00665 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS1D
|
|
00666 ******************************************************************DTSCS1D
|
|
00667 SKIP1 DTSCS1D
|
|
00668 P3000-REQUEST-JUMP. DTSCS1D
|
|
00669 *----------------------------------------------------- DTSCS1D
|
|
00670 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS1D
|
|
00671 * BY USER DTSCS1D
|
|
00672 *----------------------------------------------------- DTSCS1D
|
|
00673 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS1D
|
|
00674 SKIP3 DTSCS1D
|
|
00675 *----------------------------------------------------- DTSCS1D
|
|
00676 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS1D
|
|
00677 *----------------------------------------------------- DTSCS1D
|
|
00678 IF LCCM-MSG DTSCS1D
|
|
00679 SET RESP-SEND-MSGONLY TO TRUE DTSCS1D
|
|
00680 SET CURSOR-SET-GOTO TO TRUE DTSCS1D
|
|
00681 GO TO P3000-EXIT. DTSCS1D
|
|
00682 SKIP3 DTSCS1D
|
|
00683 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1D
|
|
00684 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1D
|
|
00685 IF L018-VALID DTSCS1D
|
|
00686 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS1D
|
|
00687 SKIP3 DTSCS1D
|
|
00688 *----------------------------------------------------- DTSCS1D
|
|
00689 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS1D
|
|
00690 *----------------------------------------------------- DTSCS1D
|
|
00691 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS1D
|
|
00692 LCCM-SCR-HOLD-AREA. DTSCS1D
|
|
00693 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS1D
|
|
00694 SET RESP-JUMP TO TRUE. DTSCS1D
|
|
00695 P3000-EXIT. EXIT. DTSCS1D
|
|
00696 /*****************************************************************DTSCS1D
|
|
00697 * CLEAR KEY WAS PRESSED *DTSCS1D
|
|
00698 ******************************************************************DTSCS1D
|
|
00699 SKIP1 DTSCS1D
|
|
00700 P4000-REQUEST-CLEAR. DTSCS1D
|
|
00701 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS1D
|
|
00702 SKIP3 DTSCS1D
|
|
00703 *----------------------------------------------------- DTSCS1D
|
|
00704 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS1D
|
|
00705 * FIELDS FROM EARLIER REQUESTS DTSCS1D
|
|
00706 *----------------------------------------------------- DTSCS1D
|
|
00707 IF LCCM-EMP-NO > ZERO DTSCS1D
|
|
00708 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS1D
|
|
00709 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS1D
|
|
00710 MOVE ZERO TO LCCM-EMP-NO. DTSCS1D
|
|
00711 SKIP1 DTSCS1D
|
|
00712 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS1D
|
|
00713 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1D
|
|
00714 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1D
|
|
00715 SET RESP-SEND-MAP TO TRUE. DTSCS1D
|
|
00716 P4000-EXIT. EXIT. DTSCS1D
|
|
00717 /*****************************************************************DTSCS1D
|
|
00718 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS1D
|
|
00719 ******************************************************************DTSCS1D
|
|
00720 SKIP1 DTSCS1D
|
|
00721 P5000-CURSOR-TO-GOTO. DTSCS1D
|
|
00722 SET CURSOR-SET-GOTO TO TRUE. DTSCS1D
|
|
00723 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS1D
|
|
00724 P5000-EXIT. EXIT. DTSCS1D
|
|
00725 /*****************************************************************DTSCS1D
|
|
00726 * INQUIRY WAS REQUESTED *DTSCS1D
|
|
00727 ******************************************************************DTSCS1D
|
|
00728 SKIP1 DTSCS1D
|
|
00729 P6000-REQUEST-INQUIRE. DTSCS1D
|
|
00730 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1D
|
|
00731 MOVE LOW-VALUES TO MAP-AREA. DTSCS1D
|
|
00732 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS1D
|
|
00733 SKIP1 DTSCS1D
|
|
00734 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS1D
|
|
00735 SKIP1 DTSCS1D
|
|
00736 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1D
|
|
00737 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1D
|
|
00738 SKIP1 DTSCS1D
|
|
00739 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS1D
|
|
00740 SKIP1 DTSCS1D
|
|
00741 IF LCCM-NO-MSG DTSCS1D
|
|
00742 IF LCCM-ENTER-88 DTSCS1D
|
|
00743 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS1D
|
|
00744 ELSE DTSCS1D
|
|
00745 GO TO S899-ABEND. DTSCS1D
|
|
00746 SKIP1 DTSCS1D
|
|
00747 SET RESP-SEND-MAP TO TRUE. DTSCS1D
|
|
00748 P6000-EXIT. EXIT. DTSCS1D
|
|
00749 EJECT DTSCS1D
|
|
00750 P6100-NO-PAGE. DTSCS1D
|
|
00751 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS1D
|
|
00752 IF L810-NO-REC-88 DTSCS1D
|
|
00753 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS1D
|
|
00754 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS1D
|
|
00755 ELSE DTSCS1D
|
|
00756 MOVE MSKL-REC TO MPRF-REC DTSCS1D
|
|
00757 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS1D
|
|
00758 P6100-EXIT. EXIT. DTSCS1D
|
|
00759 /*****************************************************************DTSCS1D
|
|
00760 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS1D
|
|
00761 ******************************************************************DTSCS1D
|
|
00762 SKIP1 DTSCS1D
|
|
00763 P6900-CONSTRUCT-SCREEN. DTSCS1D
|
|
00764 IF SCR-ACCESS-UPDATE DTSCS1D
|
|
00765 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1D
|
|
00766 SKIP1 DTSCS1D
|
|
00767 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCS1D
|
|
00768 PERFORM P6920-FROM-MFAE THRU P6920-EXIT. DTSCS1D
|
|
00769 SKIP1 DTSCS1D
|
|
00770 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1D
|
|
00771 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS1D
|
|
00772 P6900-EXIT. EXIT. DTSCS1D
|
|
00773 SKIP3 DTSCS1D
|
|
00774 /*****************************************************************DTSCS1D
|
|
00775 * MOVE FIELDS FROM THE MPRF RECORD AND FORMAT ON SCREEN *DTSCS1D
|
|
00776 ******************************************************************DTSCS1D
|
|
00777 P6910-FROM-MPRF. DTSCS1D
|
|
00778 MOVE MPRF-UC30-MASS-MAIL-IND TO MAP-UC30-MASS-MAIL-IND. DTSCS1D
|
|
00779 MOVE MPRF-UC30-CREDIT-IND TO MAP-UC30-CREDIT-IND. DTSCS1D
|
|
00780 MOVE MPRF-RETURN-MAIL-IND TO MAP-RETURN-MAIL-IND. DTSCS1D
|
|
00781 MOVE MPRF-FEIN-HARASS-IND TO MAP-FEIN-HARASS-IND. DTSCS1D
|
|
00782 MOVE MPRF-CHRG-STMT-PRINT-IND DTSCS1D
|
|
00783 TO MAP-CHRG-STMT-PRINT-IND. DTSCS1D
|
|
00784 SKIP1 DTSCS1D
|
|
00785 MOVE MPRF-ORG-TYPE TO MAP-ORG-TYPE. DTSCS1D
|
|
00786 SKIP1 DTSCS1D
|
|
00787 IF MPRF-FEIN NOT = +0 DTSCS1D
|
|
00788 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS1D
|
|
00789 MOVE WRK-DISPLAY-FEIN-1 TO MAP-FEIN-1 DTSCS1D
|
|
00790 MOVE WRK-DISPLAY-FEIN-2 TO MAP-FEIN-2. DTSCS1D
|
|
00791 SKIP1 DTSCS1D
|
|
00792 MOVE MPRF-DC-CONTRACTOR-IND DTSCS1D
|
|
00793 TO MAP-DC-CONTRACTOR-IND. DTSCS1D
|
|
00794 SKIP1 DTSCS1D
|
|
00795 IF MPRF-PWR-OF-ATTORNEY-DT NUMERIC DTSCS1D
|
|
00796 IF MPRF-PWR-OF-ATTORNEY-DT NOT = ZERO DTSCS1D
|
|
00797 MOVE MPRF-PWR-OF-ATTORNEY-DT TO L001-FED-8-DATE-9 DTSCS1D
|
|
00798 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS1D
|
|
00799 IF L001-VALID-DATE DTSCS1D
|
|
00800 MOVE L001-FED-8-MO TO MAP-PWR-ATTORNEY-MO DTSCS1D
|
|
00801 MOVE L001-FED-8-DA TO MAP-PWR-ATTORNEY-DA DTSCS1D
|
|
00802 MOVE L001-FED-8-YR TO WRK-PWR-ATTORNEY-YR DTSCS1D
|
|
00803 MOVE WRK-PWR-ATTORNEY-YY TO MAP-PWR-ATTORNEY-YR DTSCS1D
|
|
00804 END-IF DTSCS1D
|
|
00805 END-IF DTSCS1D
|
|
00806 END-IF. DTSCS1D
|
|
00807 SKIP1 DTSCS1D
|
|
00808 MOVE MPRF-EFT-ENROLLED-IND DTSCS1D
|
|
00809 TO MAP-EFT-ENROLLED-IND. DTSCS1D
|
|
00810 SKIP1 DTSCS1D
|
|
00811 IF MPRF-ARCHIVED-AUDIT-YRQ NOT = +0 DTSCS1D
|
|
00812 MOVE MPRF-ARCHIVED-AUDIT-YRQ TO L004-QTR-5-9 DTSCS1D
|
|
00813 SET L004-FROM-5 TO TRUE DTSCS1D
|
|
00814 PERFORM S004-QUARTER THRU S004-EXIT DTSCS1D
|
|
00815 IF L004-VALID-QTR DTSCS1D
|
|
00816 MOVE L004-QTR-3-YR-X TO MAP-ARCHIVED-AUDIT-YR DTSCS1D
|
|
00817 MOVE L004-QTR-3-Q-X TO MAP-ARCHIVED-AUDIT-Q DTSCS1D
|
|
00818 ELSE DTSCS1D
|
|
00819 GO TO S899-ABEND. DTSCS1D
|
|
00820 P6910-EXIT. EXIT. DTSCS1D
|
|
00821 SKIP3 DTSCS1D
|
|
00822 /*****************************************************************DTSCS1D
|
|
00823 * MOVE FIELDS FROM THE MFAE RECORD AND FORMAT ON SCREEN *DTSCS1D
|
|
00824 ******************************************************************DTSCS1D
|
|
00825 P6920-FROM-MFAE. DTSCS1D
|
|
00826 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS1D
|
|
00827 MOVE MPRF-EMP-NO TO MFAE-EMP-NO. DTSCS1D
|
|
00828 SET MFAE-FAE-88 TO TRUE. DTSCS1D
|
|
00829 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS1D
|
|
00830 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1D
|
|
00831 IF L810-NO-REC-88 DTSCS1D
|
|
00832 GO TO P6920-EXIT DTSCS1D
|
|
00833 ELSE DTSCS1D
|
|
00834 PERFORM P6921-SCAN-MFAE THRU P6921-EXIT DTSCS1D
|
|
00835 UNTIL L810-NO-REC-88. DTSCS1D
|
|
00836 P6920-EXIT. EXIT. DTSCS1D
|
|
00837 SKIP3 DTSCS1D
|
|
00838 P6921-SCAN-MFAE. DTSCS1D
|
|
00839 MOVE MSKL-REC TO MFAE-REC. DTSCS1D
|
|
00840 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS1D
|
|
00841 MOVE MFAE-FISCAL-AGENT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS1D
|
|
00842 MOVE MFAE-SERVICE-TYPE TO FFIS-SERVICE-TYPE. DTSCS1D
|
|
00843 SET FFIS-FIS-88 TO TRUE. DTSCS1D
|
|
00844 MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS1D
|
|
00845 DTSCS1D
|
|
00846 PERFORM S831-READ THRU S831-EXIT. DTSCS1D
|
|
00847 DTSCS1D
|
|
00848 IF NOT L831-OK-88 DTSCS1D
|
|
00849 MOVE SPACES TO WRK-FISCAL-AGENT-NAME DTSCS1D
|
|
00850 ELSE DTSCS1D
|
|
00851 MOVE FSKL-REC TO FFIS-REC DTSCS1D
|
|
00852 MOVE FFIS-NAME TO WRK-FISCAL-AGENT-NAME DTSCS1D
|
|
00853 END-IF. DTSCS1D
|
|
00854 DTSCS1D
|
|
00855 IF FFIS-SERVICE-UC30-88 DTSCS1D
|
|
00856 MOVE FFIS-FISCAL-AGENT-CD TO MAP-FA-QTLY-RPT-CD DTSCS1D
|
|
00857 MOVE WRK-FISCAL-AGENT-NAME TO MAP-FA-QTLY-RPT-NAME DTSCS1D
|
|
00858 ELSE DTSCS1D
|
|
00859 IF FFIS-SERVICE-BEN-CHG-88 DTSCS1D
|
|
00860 MOVE FFIS-FISCAL-AGENT-CD TO MAP-FA-BENF-CHG-CD DTSCS1D
|
|
00861 MOVE WRK-FISCAL-AGENT-NAME TO MAP-FA-BENF-CHG-NAME DTSCS1D
|
|
00862 ELSE DTSCS1D
|
|
00863 IF FFIS-SERVICE-CORRESPOND-88 DTSCS1D
|
|
00864 MOVE FFIS-FISCAL-AGENT-CD TO MAP-FA-ADDR-REC-CD DTSCS1D
|
|
00865 MOVE WRK-FISCAL-AGENT-NAME TO MAP-FA-ADDR-REC-NAME DTSCS1D
|
|
00866 END-IF DTSCS1D
|
|
00867 END-IF DTSCS1D
|
|
00868 END-IF. DTSCS1D
|
|
00869 DTSCS1D
|
|
00870 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS1D
|
|
00871 DTSCS1D
|
|
00872 P6921-EXIT. EXIT. DTSCS1D
|
|
00873 SKIP3 DTSCS1D
|
|
00874 /*****************************************************************DTSCS1D
|
|
00875 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS1D
|
|
00876 ******************************************************************DTSCS1D
|
|
00877 SKIP1 DTSCS1D
|
|
00878 P7000-REQUEST-EDIT. DTSCS1D
|
|
00879 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1D
|
|
00880 SKIP1 DTSCS1D
|
|
00881 IF LCCM-F10-88 DTSCS1D
|
|
00882 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS1D
|
|
00883 ELSE DTSCS1D
|
|
00884 GO TO S899-ABEND. DTSCS1D
|
|
00885 SKIP3 DTSCS1D
|
|
00886 *------------------------------------------------------ DTSCS1D
|
|
00887 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS1D
|
|
00888 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS1D
|
|
00889 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS1D
|
|
00890 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS1D
|
|
00891 *------------------------------------------------------ DTSCS1D
|
|
00892 SKIP1 DTSCS1D
|
|
00893 IF LCCM-MSG DTSCS1D
|
|
00894 NEXT SENTENCE DTSCS1D
|
|
00895 ELSE DTSCS1D
|
|
00896 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS1D
|
|
00897 IF LCCM-F10-88 DTSCS1D
|
|
00898 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS1D
|
|
00899 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA. DTSCS1D
|
|
00900 SKIP1 DTSCS1D
|
|
00901 SET RESP-SEND-MAP TO TRUE. DTSCS1D
|
|
00902 P7000-EXIT. EXIT. DTSCS1D
|
|
00903 /*****************************************************************DTSCS1D
|
|
00904 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS1D
|
|
00905 ******************************************************************DTSCS1D
|
|
00906 SKIP1 DTSCS1D
|
|
00907 P7200-EDIT-MOD. DTSCS1D
|
|
00908 *----------------------------------------------------- DTSCS1D
|
|
00909 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS1D
|
|
00910 * INQUIRED DTSCS1D
|
|
00911 *----------------------------------------------------- DTSCS1D
|
|
00912 IF NOT LCCM-SCR-INQUIRE DTSCS1D
|
|
00913 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS1D
|
|
00914 GO TO P7200-EXIT. DTSCS1D
|
|
00915 SKIP3 DTSCS1D
|
|
00916 *----------------------------------------------------- DTSCS1D
|
|
00917 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS1D
|
|
00918 *----------------------------------------------------- DTSCS1D
|
|
00919 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS1D
|
|
00920 IF LCCM-MSG DTSCS1D
|
|
00921 GO TO P7200-EXIT. DTSCS1D
|
|
00922 SKIP1 DTSCS1D
|
|
00923 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS1D
|
|
00924 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS1D
|
|
00925 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS1D
|
|
00926 GO TO P7200-EXIT. DTSCS1D
|
|
00927 SKIP1 DTSCS1D
|
|
00928 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS1D
|
|
00929 IF L810-NO-REC-88 DTSCS1D
|
|
00930 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS1D
|
|
00931 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS1D
|
|
00932 ELSE DTSCS1D
|
|
00933 MOVE MSKL-REC TO MPRF-REC DTSCS1D
|
|
00934 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS1D
|
|
00935 P7200-EXIT. EXIT. DTSCS1D
|
|
00936 /*****************************************************************DTSCS1D
|
|
00937 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS1D
|
|
00938 ******************************************************************DTSCS1D
|
|
00939 SKIP1 DTSCS1D
|
|
00940 P8000-REQUEST-UPDATE. DTSCS1D
|
|
00941 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1D
|
|
00942 SKIP1 DTSCS1D
|
|
00943 IF LCCM-SCR-MOD-LOCKED DTSCS1D
|
|
00944 PERFORM P8200-MOD THRU P8200-EXIT DTSCS1D
|
|
00945 ELSE DTSCS1D
|
|
00946 GO TO S899-ABEND. DTSCS1D
|
|
00947 SKIP1 DTSCS1D
|
|
00948 SET RESP-SEND-MAP TO TRUE. DTSCS1D
|
|
00949 P8000-EXIT. EXIT. DTSCS1D
|
|
00950 /*****************************************************************DTSCS1D
|
|
00951 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS1D
|
|
00952 ******************************************************************DTSCS1D
|
|
00953 SKIP1 DTSCS1D
|
|
00954 P8200-MOD. DTSCS1D
|
|
00955 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1D
|
|
00956 SKIP1 DTSCS1D
|
|
00957 IF LCCM-F12-88 DTSCS1D
|
|
00958 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS1D
|
|
00959 GO TO P8200-EXIT. DTSCS1D
|
|
00960 SKIP1 DTSCS1D
|
|
00961 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS1D
|
|
00962 IF LCCM-MSG DTSCS1D
|
|
00963 GO TO P8200-EXIT. DTSCS1D
|
|
00964 SKIP1 DTSCS1D
|
|
00965 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS1D
|
|
00966 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1D
|
|
00967 IF LCCM-MSG DTSCS1D
|
|
00968 GO TO P8200-EXIT. DTSCS1D
|
|
00969 DTSCS1D
|
|
00970 PERFORM P8900-INITILIZE-L331 THRU P8900-EXIT. DTSCS1D
|
|
00971 SET WRK-UPD-MSOL-NO-88 TO TRUE. DTSCS1D
|
|
00972 SET WRK-RET-MAIL-NULL-88 TO TRUE. DTSCS1D
|
|
00973 PERFORM P8910-MPRF-UPDATE THRU P8910-EXIT. DTSCS1D
|
|
00974 IF WRK-UPD-MSOL-YES-88 DTSCS1D
|
|
00975 PERFORM P8920-UPD-MSOL THRU P8920-EXIT. DTSCS1D
|
|
00976 IF WRK-RET-MAIL-ON-88 DTSCS1D
|
|
00977 OR WRK-RET-MAIL-OFF-88 DTSCS1D
|
|
00978 PERFORM P8930-ADD-MEVL THRU P8930-EXIT. DTSCS1D
|
|
00979 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1D
|
|
00980 SKIP1 DTSCS1D
|
|
00981 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS1D
|
|
00982 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1D
|
|
00983 P8200-EXIT. EXIT. DTSCS1D
|
|
00984 SKIP3 DTSCS1D
|
|
00985 DTSCS1D
|
|
00986 ******************************************************************DTSCS1D
|
|
00987 * *DTSCS1D
|
|
00988 ******************************************************************DTSCS1D
|
|
00989 P8800-LOCK-EMPLOYER. DTSCS1D
|
|
00990 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS1D
|
|
00991 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS1D
|
|
00992 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS1D
|
|
00993 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS1D
|
|
00994 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS1D
|
|
00995 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS1D
|
|
00996 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS1D
|
|
00997 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS1D
|
|
00998 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS1D
|
|
00999 SKIP1 DTSCS1D
|
|
01000 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS1D
|
|
01001 P8800-EXIT. EXIT. DTSCS1D
|
|
01002 /*****************************************************************DTSCS1D
|
|
01003 * INITILIZE MODIFICATION LOG DATA AREA *DTSCS1D
|
|
01004 ******************************************************************DTSCS1D
|
|
01005 P8900-INITILIZE-L331. DTSCS1D
|
|
01006 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS1D
|
|
01007 DTSCS1D
|
|
01008 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS1D
|
|
01009 DTSCS1D
|
|
01010 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS1D
|
|
01011 DTSCS1D
|
|
01012 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS1D
|
|
01013 DTSCS1D
|
|
01014 P8900-EXIT. DTSCS1D
|
|
01015 EXIT. DTSCS1D
|
|
01016 /*****************************************************************DTSCS1D
|
|
01017 * MOVE ALL NON-KEY SCREEN FIELDS TO MPRF RECORD LAYOUT *DTSCS1D
|
|
01018 ******************************************************************DTSCS1D
|
|
01019 P8910-MPRF-UPDATE. DTSCS1D
|
|
01020 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS1D
|
|
01021 IF L810-NO-REC-88 DTSCS1D
|
|
01022 GO TO S899-ABEND. DTSCS1D
|
|
01023 SKIP1 DTSCS1D
|
|
01024 MOVE MSKL-REC TO MPRF-REC. DTSCS1D
|
|
01025 MOVE SPACES TO L331-REC-OCC-ID. DTSCS1D
|
|
01026 SKIP1 DTSCS1D
|
|
01027 IF MAP-UC30-MASS-MAIL-IND NOT = MPRF-UC30-MASS-MAIL-IND DTSCS1D
|
|
01028 MOVE 'MPRF-UC30-MASS-MAIL-IND' TO L331-FIELD-NAME DTSCS1D
|
|
01029 MOVE MPRF-UC30-MASS-MAIL-IND TO L331-FROM-VALUE DTSCS1D
|
|
01030 MOVE MAP-UC30-MASS-MAIL-IND TO L331-TO-VALUE DTSCS1D
|
|
01031 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01032 MOVE MAP-UC30-MASS-MAIL-IND TO MPRF-UC30-MASS-MAIL-IND DTSCS1D
|
|
01033 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01034 SKIP1 DTSCS1D
|
|
01035 IF MAP-RETURN-MAIL-IND NOT = MPRF-RETURN-MAIL-IND DTSCS1D
|
|
01036 IF MPRF-RETURN-MAIL-NO-88 DTSCS1D
|
|
01037 SET WRK-RET-MAIL-ON-88 TO TRUE DTSCS1D
|
|
01038 ELSE DTSCS1D
|
|
01039 SET WRK-RET-MAIL-OFF-88 TO TRUE DTSCS1D
|
|
01040 END-IF DTSCS1D
|
|
01041 MOVE 'MPRF-RETURN-MAIL-IND' TO L331-FIELD-NAME DTSCS1D
|
|
01042 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE DTSCS1D
|
|
01043 MOVE MAP-RETURN-MAIL-IND TO L331-TO-VALUE DTSCS1D
|
|
01044 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01045 MOVE MAP-RETURN-MAIL-IND TO MPRF-RETURN-MAIL-IND DTSCS1D
|
|
01046 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01047 SKIP1 DTSCS1D
|
|
01048 IF MAP-UC30-CREDIT-IND NOT = MPRF-UC30-CREDIT-IND DTSCS1D
|
|
01049 MOVE 'MPRF-UC30-CREDIT-IND' TO L331-FIELD-NAME DTSCS1D
|
|
01050 MOVE MPRF-UC30-CREDIT-IND TO L331-FROM-VALUE DTSCS1D
|
|
01051 MOVE MAP-UC30-CREDIT-IND TO L331-TO-VALUE DTSCS1D
|
|
01052 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01053 MOVE MAP-UC30-CREDIT-IND TO MPRF-UC30-CREDIT-IND DTSCS1D
|
|
01054 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01055 SKIP1 DTSCS1D
|
|
01056 IF MAP-FEIN-HARASS-IND NOT = MPRF-FEIN-HARASS-IND DTSCS1D
|
|
01057 MOVE MAP-FEIN-HARASS-IND TO MPRF-FEIN-HARASS-IND DTSCS1D
|
|
01058 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01059 SKIP1 DTSCS1D
|
|
01060 IF MAP-CHRG-STMT-PRINT-IND NOT = MPRF-CHRG-STMT-PRINT-IND DTSCS1D
|
|
01061 MOVE MAP-CHRG-STMT-PRINT-IND DTSCS1D
|
|
01062 TO MPRF-CHRG-STMT-PRINT-IND DTSCS1D
|
|
01063 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01064 SKIP1 DTSCS1D
|
|
01065 IF MAP-ORG-TYPE NOT = MPRF-ORG-TYPE DTSCS1D
|
|
01066 PERFORM P8911-HOUSEHOLD THRU P8911-EXIT DTSCS1D
|
|
01067 MOVE 'MPRF-ORG-TYPE' TO L331-FIELD-NAME DTSCS1D
|
|
01068 MOVE MPRF-ORG-TYPE TO L331-FROM-VALUE DTSCS1D
|
|
01069 MOVE MAP-ORG-TYPE TO L331-TO-VALUE DTSCS1D
|
|
01070 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01071 MOVE MAP-ORG-TYPE TO MPRF-ORG-TYPE DTSCS1D
|
|
01072 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01073 SKIP1 DTSCS1D
|
|
01074 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA. DTSCS1D
|
|
01075 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT. DTSCS1D
|
|
01076 IF L017-FEIN = MPRF-FEIN DTSCS1D
|
|
01077 NEXT SENTENCE DTSCS1D
|
|
01078 ELSE DTSCS1D
|
|
01079 MOVE 'MPRF-FEIN' TO L331-FIELD-NAME DTSCS1D
|
|
01080 MOVE SPACES TO L331-TO-VALUE DTSCS1D
|
|
01081 L331-FROM-VALUE DTSCS1D
|
|
01082 IF MPRF-FEIN NOT = +0 DTSCS1D
|
|
01083 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS1D
|
|
01084 STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE DTSCS1D
|
|
01085 ' ' DELIMITED BY SIZE DTSCS1D
|
|
01086 WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE DTSCS1D
|
|
01087 INTO L331-FROM-VALUE DTSCS1D
|
|
01088 END-IF DTSCS1D
|
|
01089 IF L017-FEIN NOT = +0 DTSCS1D
|
|
01090 MOVE L017-FEIN TO WRK-DISPLAY DTSCS1D
|
|
01091 STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE DTSCS1D
|
|
01092 ' ' DELIMITED BY SIZE DTSCS1D
|
|
01093 WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE DTSCS1D
|
|
01094 INTO L331-TO-VALUE DTSCS1D
|
|
01095 END-IF DTSCS1D
|
|
01096 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01097 MOVE L017-FEIN TO MPRF-FEIN DTSCS1D
|
|
01098 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01099 SKIP1 DTSCS1D
|
|
01100 IF MPRF-PWR-OF-ATTORNEY-DT NOT NUMERIC DTSCS1D
|
|
01101 MOVE ZERO TO MPRF-PWR-OF-ATTORNEY-DT DTSCS1D
|
|
01102 END-IF. DTSCS1D
|
|
01103 MOVE MAP-PWR-OF-ATTORNEY-AREA TO L015-S-DATE-AREA DTSCS1D
|
|
01104 IF L015-S-MO = '99' DTSCS1D
|
|
01105 PERFORM P8912-CLEAR-PWR-OF-ATTRNY THRU P8912-EXIT DTSCS1D
|
|
01106 ELSE DTSCS1D
|
|
01107 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS1D
|
|
01108 IF L015-VALID DTSCS1D
|
|
01109 IF L015-DATE NOT = MPRF-PWR-OF-ATTORNEY-DT DTSCS1D
|
|
01110 MOVE 'MPRF-PWR-OF-ATTORNEY-DT' TO L331-FIELD-NAME DTSCS1D
|
|
01111 MOVE MPRF-PWR-OF-ATTORNEY-DT TO L001-FED-8-DATE-9 DTSCS1D
|
|
01112 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS1D
|
|
01113 MOVE L001-SLASH-DATE TO L331-FROM-VALUE DTSCS1D
|
|
01114 MOVE L015-DATE TO L001-FED-8-DATE-9 DTSCS1D
|
|
01115 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS1D
|
|
01116 MOVE L001-SLASH-DATE TO L331-TO-VALUE DTSCS1D
|
|
01117 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01118 MOVE L015-DATE TO MPRF-PWR-OF-ATTORNEY-DT DTSCS1D
|
|
01119 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS1D
|
|
01120 END-IF DTSCS1D
|
|
01121 END-IF DTSCS1D
|
|
01122 END-IF. DTSCS1D
|
|
01123 SKIP1 DTSCS1D
|
|
01124 IF MAP-DC-CONTRACTOR-IND NOT = MPRF-DC-CONTRACTOR-IND DTSCS1D
|
|
01125 MOVE 'MPRF-DC-CONTRACTOR-IND' TO L331-FIELD-NAME DTSCS1D
|
|
01126 MOVE MPRF-DC-CONTRACTOR-IND TO L331-FROM-VALUE DTSCS1D
|
|
01127 MOVE MAP-DC-CONTRACTOR-IND TO L331-TO-VALUE DTSCS1D
|
|
01128 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS1D
|
|
01129 MOVE MAP-DC-CONTRACTOR-IND TO MPRF-DC-CONTRACTOR-IND DTSCS1D
|
|
01130 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01131 SKIP1 DTSCS1D
|
|
01132 MOVE MAP-ARCHIVED-AUDIT-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS1D
|
|
01133 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS1D
|
|
01134 IF L016-YRQ NOT = MPRF-ARCHIVED-AUDIT-YRQ DTSCS1D
|
|
01135 MOVE L016-YRQ TO MPRF-ARCHIVED-AUDIT-YRQ DTSCS1D
|
|
01136 MOVE L016-YRQ TO MPRF-ARCHIVED-AUDIT-YRQ. DTSCS1D
|
|
01137 SKIP1 DTSCS1D
|
|
01138 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1D
|
|
01139 MOVE MPRF-REC TO MSKL-REC. DTSCS1D
|
|
01140 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1D
|
|
01141 P8910-EXIT. EXIT. DTSCS1D
|
|
01142 DTSCS1D
|
|
01143 P8911-HOUSEHOLD. DTSCS1D
|
|
01144 IF MAP-ORG-TYPE = 'H ' DTSCS1D
|
|
01145 NEXT SENTENCE DTSCS1D
|
|
01146 ELSE DTSCS1D
|
|
01147 GO TO P8911-EXIT. DTSCS1D
|
|
01148 DTSCS1D
|
|
01149 PERFORM S1120-CHECK-MSOL THRU S1120-EXIT. DTSCS1D
|
|
01150 DTSCS1D
|
|
01151 IF WRK-MSOL-CNT = ZERO DTSCS1D
|
|
01152 OR WRK-START-YRQ = ZERO DTSCS1D
|
|
01153 **** OR WRK-LIAB-CD-DOMESTIC-NO-88 DTSCS1D
|
|
01154 MOVE MPRF-ORG-TYPE TO MAP-ORG-TYPE DTSCS1D
|
|
01155 GO TO P8911-EXIT. DTSCS1D
|
|
01156 DTSCS1D
|
|
01157 SET WRK-UPD-MSOL-YES-88 TO TRUE. DTSCS1D
|
|
01158 DTSCS1D
|
|
01159 SET L400-ORG-TYPE-CHANGE-88 TO TRUE. DTSCS1D
|
|
01160 MOVE WRK-EMP-NO TO L400-EMP-NO. DTSCS1D
|
|
01161 MOVE MSOL-FIRST-LIAB-YRQ TO L400-FIRST-LIAB-YRQ. DTSCS1D
|
|
01162 MOVE LCCM-CURR-RUN-DATE TO L400-CURR-RUN-DATE. DTSCS1D
|
|
01163 MOVE LCCM-OP-ID TO L400-OP-ID. DTSCS1D
|
|
01164 PERFORM S400-HOUSEHOLD THRU S400-EXIT. DTSCS1D
|
|
01165 DTSCS1D
|
|
01166 P8911-EXIT. EXIT. DTSCS1D
|
|
01167 DTSCS1D
|
|
01168 P8912-CLEAR-PWR-OF-ATTRNY. DTSCS1D
|
|
01169 MOVE 'MPRF-PWR-OF-ATTORNEY-DT' TO L331-FIELD-NAME. DTSCS1D
|
|
01170 MOVE MPRF-PWR-OF-ATTORNEY-DT TO L001-FED-8-DATE-9. DTSCS1D
|
|
01171 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS1D
|
|
01172 MOVE L001-SLASH-DATE TO L331-FROM-VALUE. DTSCS1D
|
|
01173 MOVE SPACES TO L331-TO-VALUE. DTSCS1D
|
|
01174 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS1D
|
|
01175 MOVE ZERO TO MPRF-PWR-OF-ATTORNEY-DT. DTSCS1D
|
|
01176 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1D
|
|
01177 DTSCS1D
|
|
01178 MOVE SPACES TO MAP-PWR-ATTORNEY-MO DTSCS1D
|
|
01179 MAP-PWR-ATTORNEY-DA DTSCS1D
|
|
01180 MAP-PWR-ATTORNEY-YR. DTSCS1D
|
|
01181 DTSCS1D
|
|
01182 P8912-EXIT. EXIT. DTSCS1D
|
|
01183 DTSCS1D
|
|
01184 P8920-UPD-MSOL. DTSCS1D
|
|
01185 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSCS1D
|
|
01186 MOVE WRK-EMP-NO TO MSOL-EMP-NO. DTSCS1D
|
|
01187 SET MSOL-SOL-88 TO TRUE. DTSCS1D
|
|
01188 MOVE ZEROS TO MSOL-LIAB-DATE. DTSCS1D
|
|
01189 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSCS1D
|
|
01190 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1D
|
|
01191 DTSCS1D
|
|
01192 PERFORM P8921-SCAN-MSOL THRU P8921-EXIT DTSCS1D
|
|
01193 UNTIL L810-NO-REC-88. DTSCS1D
|
|
01194 DTSCS1D
|
|
01195 P8920-EXIT. EXIT. DTSCS1D
|
|
01196 DTSCS1D
|
|
01197 P8921-SCAN-MSOL. DTSCS1D
|
|
01198 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS1D
|
|
01199 PERFORM S810-READ THRU S810-EXIT. DTSCS1D
|
|
01200 DTSCS1D
|
|
01201 MOVE MSKL-REC TO MSOL-REC DTSCS1D
|
|
01202 SET MSOL-LIAB-RATED-DOMESTIC-88 TO TRUE DTSCS1D
|
|
01203 MOVE MSOL-REC TO MSKL-REC DTSCS1D
|
|
01204 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1D
|
|
01205 DTSCS1D
|
|
01206 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1D
|
|
01207 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS1D
|
|
01208 DTSCS1D
|
|
01209 P8921-EXIT. EXIT. DTSCS1D
|
|
01210 DTSCS1D
|
|
01211 P8930-ADD-MEVL. DTSCS1D
|
|
01212 MOVE LOW-VALUES TO MEVL-REC. DTSCS1D
|
|
01213 DTSCS1D
|
|
01214 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS1D
|
|
01215 DTSCS1D
|
|
01216 SET MEVL-EVL-88 TO TRUE. DTSCS1D
|
|
01217 DTSCS1D
|
|
01218 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS1D
|
|
01219 DTSCS1D
|
|
01220 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS1D
|
|
01221 DTSCS1D
|
|
01222 MOVE +0 TO MEVL-PURGE-DATE. DTSCS1D
|
|
01223 DTSCS1D
|
|
01224 IF WRK-RET-MAIL-ON-88 DTSCS1D
|
|
01225 MOVE 'RETURN MAIL SET TO YES ' TO MEVL-TEXT DTSCS1D
|
|
01226 ELSE DTSCS1D
|
|
01227 MOVE 'RETURN MAIL SET TO NO ' TO MEVL-TEXT DTSCS1D
|
|
01228 END-IF. DTSCS1D
|
|
01229 DTSCS1D
|
|
01230 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS1D
|
|
01231 DTSCS1D
|
|
01232 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS1D
|
|
01233 DTSCS1D
|
|
01234 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS1D
|
|
01235 MEVL-CHNG-DATE. DTSCS1D
|
|
01236 DTSCS1D
|
|
01237 MOVE MEVL-REC TO MSKL-REC. DTSCS1D
|
|
01238 DTSCS1D
|
|
01239 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1D
|
|
01240 DTSCS1D
|
|
01241 P8930-EXIT. EXIT. DTSCS1D
|
|
01242 DTSCS1D
|
|
01243 /*****************************************************************DTSCS1D
|
|
01244 * LINKS TO UTILITY MODULES DTSCS1D
|
|
01245 ******************************************************************DTSCS1D
|
|
01246 SKIP1 DTSCS1D
|
|
01247 S001-FROM-FED-8. DTSCS1D
|
|
01248 SET L001-FROM-FED-8 TO TRUE. DTSCS1D
|
|
01249 GO TO S001-DATE. DTSCS1D
|
|
01250 DTSCS1D
|
|
01251 S001-DATE. DTSCS1D
|
|
01252 EXEC CICS LINK DTSCS1D
|
|
01253 PROGRAM('DTSCU001') DTSCS1D
|
|
01254 COMMAREA(L001-COMM-AREA) DTSCS1D
|
|
01255 END-EXEC. DTSCS1D
|
|
01256 S001-EXIT. DTSCS1D
|
|
01257 EXIT. DTSCS1D
|
|
01258 DTSCS1D
|
|
01259 S004-QUARTER. DTSCS1D
|
|
01260 EXEC CICS LINK DTSCS1D
|
|
01261 PROGRAM ('DTSCU004') DTSCS1D
|
|
01262 COMMAREA (L004-COMM-AREA) DTSCS1D
|
|
01263 END-EXEC. DTSCS1D
|
|
01264 S004-EXIT. DTSCS1D
|
|
01265 EXIT. DTSCS1D
|
|
01266 SKIP3 DTSCS1D
|
|
01267 S015-DATE-FROM-SCREEN. DTSCS1D
|
|
01268 EXEC CICS LINK DTSCS1D
|
|
01269 PROGRAM('DTSCU015') DTSCS1D
|
|
01270 COMMAREA(L015-COMM-AREA) DTSCS1D
|
|
01271 END-EXEC. DTSCS1D
|
|
01272 S015-EXIT. DTSCS1D
|
|
01273 EXIT. DTSCS1D
|
|
01274 DTSCS1D
|
|
01275 S016-YRQ-FROM-SCREEN. DTSCS1D
|
|
01276 EXEC CICS LINK DTSCS1D
|
|
01277 PROGRAM ('DTSCU016') DTSCS1D
|
|
01278 COMMAREA (L016-COMM-AREA) DTSCS1D
|
|
01279 END-EXEC. DTSCS1D
|
|
01280 S016-EXIT. DTSCS1D
|
|
01281 EXIT. DTSCS1D
|
|
01282 SKIP3 DTSCS1D
|
|
01283 S017-FEIN-FROM-SCREEN. DTSCS1D
|
|
01284 EXEC CICS LINK DTSCS1D
|
|
01285 PROGRAM ('DTSCU017') DTSCS1D
|
|
01286 COMMAREA (L017-COMM-AREA) DTSCS1D
|
|
01287 END-EXEC. DTSCS1D
|
|
01288 S017-EXIT. DTSCS1D
|
|
01289 EXIT. DTSCS1D
|
|
01290 SKIP3 DTSCS1D
|
|
01291 S018-EMP-NO-FROM-SCREEN. DTSCS1D
|
|
01292 EXEC CICS LINK DTSCS1D
|
|
01293 PROGRAM ('DTSCU018') DTSCS1D
|
|
01294 COMMAREA (L018-COMM-AREA) DTSCS1D
|
|
01295 END-EXEC. DTSCS1D
|
|
01296 S018-EXIT. DTSCS1D
|
|
01297 EXIT. DTSCS1D
|
|
01298 SKIP3 DTSCS1D
|
|
01299 *S027-BTN-FROM-SCREEN. DTSCS1D
|
|
01300 * EXEC CICS LINK DTSCS1D
|
|
01301 * PROGRAM ('DTSCU027') DTSCS1D
|
|
01302 * COMMAREA (L027-COMM-AREA) DTSCS1D
|
|
01303 * END-EXEC. DTSCS1D
|
|
01304 *S027-EXIT. DTSCS1D
|
|
01305 * EXIT. DTSCS1D
|
|
01306 SKIP3 DTSCS1D
|
|
01307 S031-REG-CODES. DTSCS1D
|
|
01308 EXEC CICS LINK DTSCS1D
|
|
01309 PROGRAM ('DTSCU031') DTSCS1D
|
|
01310 COMMAREA (L031-COMM-AREA) DTSCS1D
|
|
01311 END-EXEC. DTSCS1D
|
|
01312 S031-EXIT. DTSCS1D
|
|
01313 EXIT. DTSCS1D
|
|
01314 SKIP3 DTSCS1D
|
|
01315 *S039-SIC-OWN-CD. DTSCS1D
|
|
01316 *****EXEC CICS LINK DTSCS1D
|
|
01317 *********PROGRAM ('DTSCU039') DTSCS1D
|
|
01318 *********COMMAREA (L039-COMM-AREA) DTSCS1D
|
|
01319 *****END-EXEC. DTSCS1D
|
|
01320 DTSCS1D
|
|
01321 *****IF L039-SIC-FILE-CLOSED DTSCS1D
|
|
01322 *********MOVE L039-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01323 *********SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1D
|
|
01324 *********SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
01325 *********GO TO MAINLINE-EXIT. DTSCS1D
|
|
01326 *S039-EXIT. DTSCS1D
|
|
01327 *****EXIT. DTSCS1D
|
|
01328 SKIP3 DTSCS1D
|
|
01329 S074-DUP-FEIN-EDIT. DTSCS1D
|
|
01330 EXEC CICS LINK DTSCS1D
|
|
01331 PROGRAM ('DTSCU074') DTSCS1D
|
|
01332 COMMAREA (L074-COMM-AREA) DTSCS1D
|
|
01333 END-EXEC. DTSCS1D
|
|
01334 SKIP1 DTSCS1D
|
|
01335 IF L074-FILE-CLOSED-88 DTSCS1D
|
|
01336 MOVE L074-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01337 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1D
|
|
01338 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
01339 GO TO MAINLINE-EXIT. DTSCS1D
|
|
01340 S074-EXIT. DTSCS1D
|
|
01341 EXIT. DTSCS1D
|
|
01342 SKIP3 DTSCS1D
|
|
01343 S221-EMP-LOCK. DTSCS1D
|
|
01344 SET L221-START-UPDATE TO TRUE. DTSCS1D
|
|
01345 GO TO S221-EMP-LOCK-UNLOCK. DTSCS1D
|
|
01346 SKIP1 DTSCS1D
|
|
01347 S221-EMP-UNLOCK. DTSCS1D
|
|
01348 SET L221-END-UPDATE TO TRUE. DTSCS1D
|
|
01349 GO TO S221-EMP-LOCK-UNLOCK. DTSCS1D
|
|
01350 SKIP1 DTSCS1D
|
|
01351 S221-EMP-LOCK-UNLOCK. DTSCS1D
|
|
01352 EXEC CICS LINK DTSCS1D
|
|
01353 PROGRAM ('DTSCU221') DTSCS1D
|
|
01354 COMMAREA (L221-COMM-AREA) DTSCS1D
|
|
01355 END-EXEC. DTSCS1D
|
|
01356 SKIP1 DTSCS1D
|
|
01357 IF L221-FILE-CLOSED DTSCS1D
|
|
01358 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01359 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1D
|
|
01360 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
01361 GO TO MAINLINE-EXIT. DTSCS1D
|
|
01362 SKIP1 DTSCS1D
|
|
01363 IF L221-NOT-OK DTSCS1D
|
|
01364 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS1D
|
|
01365 S221-EXIT. DTSCS1D
|
|
01366 EXIT. DTSCS1D
|
|
01367 SKIP3 DTSCS1D
|
|
01368 S331-EMP-WRITE-MLOG. DTSCS1D
|
|
01369 EXEC CICS LINK DTSCS1D
|
|
01370 PROGRAM ('DTSCU331') DTSCS1D
|
|
01371 COMMAREA (L331-COMM-AREA) DTSCS1D
|
|
01372 END-EXEC. DTSCS1D
|
|
01373 SKIP1 DTSCS1D
|
|
01374 IF L331-FILE-CLOSED DTSCS1D
|
|
01375 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01376 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1D
|
|
01377 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
01378 GO TO MAINLINE-EXIT. DTSCS1D
|
|
01379 S331-EXIT. DTSCS1D
|
|
01380 EXIT. DTSCS1D
|
|
01381 SKIP3 DTSCS1D
|
|
01382 S400-HOUSEHOLD. DTSCS1D
|
|
01383 EXEC CICS LINK DTSCS1D
|
|
01384 PROGRAM ('DTSCU400') DTSCS1D
|
|
01385 COMMAREA (L400-COMM-AREA) DTSCS1D
|
|
01386 END-EXEC. DTSCS1D
|
|
01387 SKIP1 DTSCS1D
|
|
01388 S400-EXIT. DTSCS1D
|
|
01389 EXIT. DTSCS1D
|
|
01390 SKIP3 DTSCS1D
|
|
01391 S803-REQ-SCR-ID-EDIT. DTSCS1D
|
|
01392 EXEC CICS LINK DTSCS1D
|
|
01393 PROGRAM ('DTSCU803') DTSCS1D
|
|
01394 COMMAREA (DFHCOMMAREA) DTSCS1D
|
|
01395 END-EXEC. DTSCS1D
|
|
01396 S803-EXIT. DTSCS1D
|
|
01397 EXIT. DTSCS1D
|
|
01398 SKIP3 DTSCS1D
|
|
01399 S804-INVALID-KEY. DTSCS1D
|
|
01400 EXEC CICS LINK DTSCS1D
|
|
01401 PROGRAM ('DTSCU804') DTSCS1D
|
|
01402 COMMAREA (DFHCOMMAREA) DTSCS1D
|
|
01403 END-EXEC. DTSCS1D
|
|
01404 S804-EXIT. DTSCS1D
|
|
01405 EXIT. DTSCS1D
|
|
01406 SKIP3 DTSCS1D
|
|
01407 S805-MSG-AREA. DTSCS1D
|
|
01408 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS1D
|
|
01409 SKIP1 DTSCS1D
|
|
01410 EXEC CICS LINK DTSCS1D
|
|
01411 PROGRAM ('DTSCU805') DTSCS1D
|
|
01412 COMMAREA (L805-COMM-AREA) DTSCS1D
|
|
01413 END-EXEC. DTSCS1D
|
|
01414 SKIP1 DTSCS1D
|
|
01415 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS1D
|
|
01416 S805-EXIT. DTSCS1D
|
|
01417 EXIT. DTSCS1D
|
|
01418 EJECT DTSCS1D
|
|
01419 S810-READ. DTSCS1D
|
|
01420 SET L810-READ-88 TO TRUE. DTSCS1D
|
|
01421 GO TO S810-IO. DTSCS1D
|
|
01422 SKIP1 DTSCS1D
|
|
01423 S810-START-BROWSE. DTSCS1D
|
|
01424 SET L810-START-BROWSE-88 TO TRUE. DTSCS1D
|
|
01425 GO TO S810-IO. DTSCS1D
|
|
01426 SKIP1 DTSCS1D
|
|
01427 S810-READ-NEXT. DTSCS1D
|
|
01428 SET L810-READ-NEXT-88 TO TRUE. DTSCS1D
|
|
01429 GO TO S810-IO. DTSCS1D
|
|
01430 SKIP1 DTSCS1D
|
|
01431 S810-END-BROWSE. DTSCS1D
|
|
01432 SET L810-END-BROWSE-88 TO TRUE. DTSCS1D
|
|
01433 GO TO S810-IO. DTSCS1D
|
|
01434 SKIP1 DTSCS1D
|
|
01435 S810-REWRITE. DTSCS1D
|
|
01436 SET L810-REWRITE-88 TO TRUE. DTSCS1D
|
|
01437 GO TO S810-IO. DTSCS1D
|
|
01438 SKIP1 DTSCS1D
|
|
01439 S810-WRITE. DTSCS1D
|
|
01440 SET L810-WRITE-88 TO TRUE. DTSCS1D
|
|
01441 GO TO S810-IO. DTSCS1D
|
|
01442 SKIP1 DTSCS1D
|
|
01443 S810-IO. DTSCS1D
|
|
01444 SKIP1 DTSCS1D
|
|
01445 EXEC CICS LINK DTSCS1D
|
|
01446 PROGRAM ('DTSCU810') DTSCS1D
|
|
01447 COMMAREA (L810-COMM-AREA) DTSCS1D
|
|
01448 END-EXEC. DTSCS1D
|
|
01449 SKIP1 DTSCS1D
|
|
01450 IF L810-FILE-CLOSED-88 DTSCS1D
|
|
01451 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01452 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1D
|
|
01453 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
01454 GO TO MAINLINE-EXIT. DTSCS1D
|
|
01455 S810-EXIT. DTSCS1D
|
|
01456 EXIT. DTSCS1D
|
|
01457 EJECT DTSCS1D
|
|
01458 S831-READ. DTSCS1D
|
|
01459 SET L831-READ-88 TO TRUE. DTSCS1D
|
|
01460 SKIP1 DTSCS1D
|
|
01461 EXEC CICS LINK DTSCS1D
|
|
01462 PROGRAM ('DTSCU831') DTSCS1D
|
|
01463 COMMAREA (L831-COMM-AREA) DTSCS1D
|
|
01464 END-EXEC. DTSCS1D
|
|
01465 SKIP1 DTSCS1D
|
|
01466 IF L831-FILE-CLOSED-88 DTSCS1D
|
|
01467 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01468 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1D
|
|
01469 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1D
|
|
01470 GO TO MAINLINE-EXIT. DTSCS1D
|
|
01471 S831-EXIT. DTSCS1D
|
|
01472 EXIT. DTSCS1D
|
|
01473 EJECT DTSCS1D
|
|
01474 S851-SCREEN-PROCESSING. DTSCS1D
|
|
01475 EXEC CICS LINK DTSCS1D
|
|
01476 PROGRAM ('DTSCU851') DTSCS1D
|
|
01477 COMMAREA (L851-COMM-AREA) DTSCS1D
|
|
01478 END-EXEC. DTSCS1D
|
|
01479 S851-EXIT. DTSCS1D
|
|
01480 EXIT. DTSCS1D
|
|
01481 SKIP3 DTSCS1D
|
|
01482 S899-ABEND. DTSCS1D
|
|
01483 EXEC CICS ABEND DTSCS1D
|
|
01484 ABCODE(WRK-ABEND-CD) DTSCS1D
|
|
01485 END-EXEC. DTSCS1D
|
|
01486 *S899-EXIT. DTSCS1D
|
|
01487 * EXIT. DTSCS1D
|
|
01488 /*****************************************************************DTSCS1D
|
|
01489 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS1D
|
|
01490 ******************************************************************DTSCS1D
|
|
01491 SKIP1 DTSCS1D
|
|
01492 S1001-SCREEN-KEY-EDITS. DTSCS1D
|
|
01493 SKIP1 DTSCS1D
|
|
01494 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS1D
|
|
01495 SKIP1 DTSCS1D
|
|
01496 S1001-EXIT. EXIT. DTSCS1D
|
|
01497 SKIP3 DTSCS1D
|
|
01498 S1002-SCREEN-DATA-EDITS. DTSCS1D
|
|
01499 SKIP1 DTSCS1D
|
|
01500 PERFORM S1200-INDICATORS THRU S1200-EXIT. DTSCS1D
|
|
01501 PERFORM S1300-ORG-TYPE THRU S1300-EXIT. DTSCS1D
|
|
01502 PERFORM S1400-EDIT-PWR-OF-ATTORNEY THRU S1400-EXIT. DTSCS1D
|
|
01503 *** PERFORM S1400-EDIT-BTN THRU S1400-EXIT. DTSCS1D
|
|
01504 PERFORM S1500-FEIN THRU S1500-EXIT. DTSCS1D
|
|
01505 PERFORM S1600-AUDITED THRU S1600-EXIT. DTSCS1D
|
|
01506 DTSCS1D
|
|
01507 S1002-EXIT. EXIT. DTSCS1D
|
|
01508 /*****************************************************************DTSCS1D
|
|
01509 * EMP-NO IS THE ONLY KEY FIELD FOR MPRF *DTSCS1D
|
|
01510 ******************************************************************DTSCS1D
|
|
01511 S1100-EMP-NO. DTSCS1D
|
|
01512 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1D
|
|
01513 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1D
|
|
01514 SKIP1 DTSCS1D
|
|
01515 IF L018-NO-ENTRY DTSCS1D
|
|
01516 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1D
|
|
01517 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS1D
|
|
01518 ELSE DTSCS1D
|
|
01519 IF L018-NOT-VALID DTSCS1D
|
|
01520 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01521 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS1D
|
|
01522 ELSE DTSCS1D
|
|
01523 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS1D
|
|
01524 S1100-EXIT. EXIT. DTSCS1D
|
|
01525 SKIP3 DTSCS1D
|
|
01526 S1101-ERROR. DTSCS1D
|
|
01527 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS1D
|
|
01528 MAP-EMP-NO-2-A. DTSCS1D
|
|
01529 IF LCCM-NO-MSG DTSCS1D
|
|
01530 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01531 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS1D
|
|
01532 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01533 S1101-EXIT. EXIT. DTSCS1D
|
|
01534 /*****************************************************************DTSCS1D
|
|
01535 * SCAN MSOL RECORD IF ORG TYPE CHANGE FOR HOUSEHOLD EMPLOYER *DTSCS1D
|
|
01536 ******************************************************************DTSCS1D
|
|
01537 S1120-CHECK-MSOL. DTSCS1D
|
|
01538 MOVE ZERO TO WRK-MSOL-CNT DTSCS1D
|
|
01539 WRK-START-YRQ. DTSCS1D
|
|
01540 SET WRK-LIAB-CD-DOMESTIC-YES-88 TO TRUE. DTSCS1D
|
|
01541 DTSCS1D
|
|
01542 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSCS1D
|
|
01543 MOVE WRK-EMP-NO TO MSOL-EMP-NO. DTSCS1D
|
|
01544 SET MSOL-SOL-88 TO TRUE. DTSCS1D
|
|
01545 MOVE ZEROS TO MSOL-LIAB-DATE. DTSCS1D
|
|
01546 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSCS1D
|
|
01547 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1D
|
|
01548 DTSCS1D
|
|
01549 PERFORM S1121-SCAN-MSOL THRU S1121-EXIT DTSCS1D
|
|
01550 UNTIL L810-NO-REC-88. DTSCS1D
|
|
01551 DTSCS1D
|
|
01552 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS1D
|
|
01553 DTSCS1D
|
|
01554 S1120-EXIT. EXIT. DTSCS1D
|
|
01555 DTSCS1D
|
|
01556 S1121-SCAN-MSOL. DTSCS1D
|
|
01557 MOVE MSKL-REC TO MSOL-REC. DTSCS1D
|
|
01558 DTSCS1D
|
|
01559 IF MSOL-INACT-WITHDRAWN-88 DTSCS1D
|
|
01560 NEXT SENTENCE DTSCS1D
|
|
01561 ELSE DTSCS1D
|
|
01562 ADD +1 TO WRK-MSOL-CNT DTSCS1D
|
|
01563 IF MSOL-INACT-ACTIVE-88 DTSCS1D
|
|
01564 MOVE MSOL-FIRST-LIAB-YRQ TO WRK-START-YRQ DTSCS1D
|
|
01565 IF NOT MSOL-LIAB-RATED-DOMESTIC-88 DTSCS1D
|
|
01566 SET WRK-LIAB-CD-DOMESTIC-NO-88 TO TRUE. DTSCS1D
|
|
01567 DTSCS1D
|
|
01568 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS1D
|
|
01569 DTSCS1D
|
|
01570 S1121-EXIT. EXIT. DTSCS1D
|
|
01571 /*****************************************************************DTSCS1D
|
|
01572 * *DTSCS1D
|
|
01573 ******************************************************************DTSCS1D
|
|
01574 S1200-INDICATORS. DTSCS1D
|
|
01575 IF MAP-UC30-MASS-MAIL-IND = SPACE OR LOW-VALUE DTSCS1D
|
|
01576 SET MAP-UC30-MASS-MAIL-YES-88 TO TRUE DTSCS1D
|
|
01577 ELSE DTSCS1D
|
|
01578 IF NOT MAP-UC30-MASS-MAIL-VALID-88 DTSCS1D
|
|
01579 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01580 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS1D
|
|
01581 SKIP1 DTSCS1D
|
|
01582 IF MAP-UC30-CREDIT-IND = SPACE OR LOW-VALUE DTSCS1D
|
|
01583 SET MAP-UC30-CREDIT-YES-88 TO TRUE DTSCS1D
|
|
01584 ELSE DTSCS1D
|
|
01585 IF NOT MAP-UC30-CREDIT-VALID-88 DTSCS1D
|
|
01586 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01587 PERFORM S1202-ERROR THRU S1202-EXIT. DTSCS1D
|
|
01588 SKIP1 DTSCS1D
|
|
01589 IF MAP-RETURN-MAIL-IND = SPACE OR LOW-VALUE DTSCS1D
|
|
01590 SET MAP-RETURN-MAIL-NO-88 TO TRUE DTSCS1D
|
|
01591 ELSE DTSCS1D
|
|
01592 IF NOT MAP-RETURN-MAIL-VALID-88 DTSCS1D
|
|
01593 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01594 PERFORM S1209-ERROR THRU S1209-EXIT. DTSCS1D
|
|
01595 SKIP1 DTSCS1D
|
|
01596 IF MAP-FEIN-HARASS-IND = SPACE OR LOW-VALUE DTSCS1D
|
|
01597 SET MAP-FEIN-HARASS-YES-88 TO TRUE DTSCS1D
|
|
01598 ELSE DTSCS1D
|
|
01599 IF NOT MAP-FEIN-HARASS-VALID-88 DTSCS1D
|
|
01600 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01601 PERFORM S1206-ERROR THRU S1206-EXIT. DTSCS1D
|
|
01602 SKIP1 DTSCS1D
|
|
01603 IF MAP-CHRG-STMT-PRINT-IND = SPACE OR LOW-VALUE DTSCS1D
|
|
01604 SET MAP-CHRG-STMT-PRINT-YES-88 TO TRUE DTSCS1D
|
|
01605 ELSE DTSCS1D
|
|
01606 IF MAP-CHRG-STMT-PRINT-YES-88 DTSCS1D
|
|
01607 NEXT SENTENCE DTSCS1D
|
|
01608 ELSE DTSCS1D
|
|
01609 IF MAP-CHRG-STMT-PRINT-NO-88 DTSCS1D
|
|
01610 IF MPRF-CLASS-RATED-88 DTSCS1D
|
|
01611 AND MPRF-STATUS-INACT-88 DTSCS1D
|
|
01612 NEXT SENTENCE DTSCS1D
|
|
01613 ELSE DTSCS1D
|
|
01614 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1D
|
|
01615 PERFORM S1207-ERROR THRU S1207-EXIT DTSCS1D
|
|
01616 ELSE DTSCS1D
|
|
01617 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01618 PERFORM S1207-ERROR THRU S1207-EXIT. DTSCS1D
|
|
01619 SKIP1 DTSCS1D
|
|
01620 IF MAP-DC-CONTRACTOR-IND = SPACES OR LOW-VALUES DTSCS1D
|
|
01621 SET MAP-DC-CONTRACTOR-NO-88 TO TRUE DTSCS1D
|
|
01622 ELSE DTSCS1D
|
|
01623 IF NOT MAP-DC-CONTRACTOR-VALID-88 DTSCS1D
|
|
01624 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01625 PERFORM S1208-ERROR THRU S1208-EXIT. DTSCS1D
|
|
01626 SKIP1 DTSCS1D
|
|
01627 S1200-EXIT. EXIT. DTSCS1D
|
|
01628 SKIP3 DTSCS1D
|
|
01629 S1201-ERROR. DTSCS1D
|
|
01630 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UC30-MASS-MAIL-IND-A. DTSCS1D
|
|
01631 IF LCCM-NO-MSG DTSCS1D
|
|
01632 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01633 MOVE CATB-CURSOR TO MAP-UC30-MASS-MAIL-IND-L DTSCS1D
|
|
01634 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01635 S1201-EXIT. EXIT. DTSCS1D
|
|
01636 SKIP3 DTSCS1D
|
|
01637 S1202-ERROR. DTSCS1D
|
|
01638 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UC30-CREDIT-IND-A. DTSCS1D
|
|
01639 IF LCCM-NO-MSG DTSCS1D
|
|
01640 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01641 MOVE CATB-CURSOR TO MAP-UC30-CREDIT-IND-L DTSCS1D
|
|
01642 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01643 S1202-EXIT. EXIT. DTSCS1D
|
|
01644 SKIP3 DTSCS1D
|
|
01645 S1206-ERROR. DTSCS1D
|
|
01646 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FEIN-HARASS-IND-A. DTSCS1D
|
|
01647 IF LCCM-NO-MSG DTSCS1D
|
|
01648 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01649 MOVE CATB-CURSOR TO MAP-FEIN-HARASS-IND-L DTSCS1D
|
|
01650 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01651 S1206-EXIT. EXIT. DTSCS1D
|
|
01652 SKIP3 DTSCS1D
|
|
01653 S1207-ERROR. DTSCS1D
|
|
01654 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CHRG-STMT-PRINT-IND-A. DTSCS1D
|
|
01655 IF LCCM-NO-MSG DTSCS1D
|
|
01656 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01657 MOVE CATB-CURSOR TO MAP-CHRG-STMT-PRINT-IND-L DTSCS1D
|
|
01658 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01659 S1207-EXIT. EXIT. DTSCS1D
|
|
01660 S1208-ERROR. DTSCS1D
|
|
01661 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DC-CONTRACTOR-IND-A. DTSCS1D
|
|
01662 IF LCCM-NO-MSG DTSCS1D
|
|
01663 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01664 MOVE CATB-CURSOR TO MAP-DC-CONTRACTOR-IND-L DTSCS1D
|
|
01665 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01666 S1208-EXIT. EXIT. DTSCS1D
|
|
01667 S1209-ERROR. DTSCS1D
|
|
01668 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RETURN-MAIL-IND-A. DTSCS1D
|
|
01669 IF LCCM-NO-MSG DTSCS1D
|
|
01670 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01671 MOVE CATB-CURSOR TO MAP-RETURN-MAIL-IND-L DTSCS1D
|
|
01672 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01673 S1209-EXIT. EXIT. DTSCS1D
|
|
01674 SKIP3 DTSCS1D
|
|
01675 /*****************************************************************DTSCS1D
|
|
01676 * *DTSCS1D
|
|
01677 ******************************************************************DTSCS1D
|
|
01678 S1300-ORG-TYPE. DTSCS1D
|
|
01679 IF MAP-ORG-TYPE = SPACE OR LOW-VALUE DTSCS1D
|
|
01680 SET MAP-ORG-UNK-88 TO TRUE. DTSCS1D
|
|
01681 SKIP1 DTSCS1D
|
|
01682 IF MAP-ORG-UNK-88 DTSCS1D
|
|
01683 GO TO S1300-EXIT. DTSCS1D
|
|
01684 SKIP1 DTSCS1D
|
|
01685 IF MAP-ORG-WAS-UNK-88 DTSCS1D
|
|
01686 MOVE SPACES TO MAP-ORG-TYPE-EXT. DTSCS1D
|
|
01687 SKIP1 DTSCS1D
|
|
01688 MOVE MAP-ORG-TYPE TO L031-CD. DTSCS1D
|
|
01689 SET L031-MPRF-ORG-TYPE TO TRUE. DTSCS1D
|
|
01690 PERFORM S031-REG-CODES THRU S031-EXIT. DTSCS1D
|
|
01691 IF L031-NOT-VALID DTSCS1D
|
|
01692 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01693 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS1D
|
|
01694 ELSE DTSCS1D
|
|
01695 IF MAP-ORG-TYPE NOT = MPRF-ORG-TYPE DTSCS1D
|
|
01696 PERFORM S1310-HOUSEHOLD-EDITS THRU S1310-EXIT. DTSCS1D
|
|
01697 DTSCS1D
|
|
01698 S1300-EXIT. EXIT. DTSCS1D
|
|
01699 SKIP3 DTSCS1D
|
|
01700 S1301-ERROR. DTSCS1D
|
|
01701 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ORG-TYPE-A. DTSCS1D
|
|
01702 IF LCCM-NO-MSG DTSCS1D
|
|
01703 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01704 MOVE CATB-CURSOR TO MAP-ORG-TYPE-L DTSCS1D
|
|
01705 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01706 S1301-EXIT. EXIT. DTSCS1D
|
|
01707 DTSCS1D
|
|
01708 S1310-HOUSEHOLD-EDITS. DTSCS1D
|
|
01709 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS1D
|
|
01710 AND MAP-ORG-TYPE NOT = MPRF-ORG-TYPE DTSCS1D
|
|
01711 MOVE MSG-E1D3-AREA TO WRK-MSG-AREA DTSCS1D
|
|
01712 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS1D
|
|
01713 GO TO S1310-EXIT. DTSCS1D
|
|
01714 DTSCS1D
|
|
01715 IF MAP-ORG-TYPE = 'H ' DTSCS1D
|
|
01716 NEXT SENTENCE DTSCS1D
|
|
01717 ELSE DTSCS1D
|
|
01718 GO TO S1310-EXIT. DTSCS1D
|
|
01719 DTSCS1D
|
|
01720 PERFORM S1120-CHECK-MSOL THRU S1120-EXIT. DTSCS1D
|
|
01721 DTSCS1D
|
|
01722 IF WRK-MSOL-CNT = ZERO DTSCS1D
|
|
01723 OR WRK-START-YRQ = ZERO DTSCS1D
|
|
01724 MOVE MSG-E1D2-AREA TO WRK-MSG-AREA DTSCS1D
|
|
01725 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS1D
|
|
01726 ** ELSE DTSCS1D
|
|
01727 ** IF WRK-LIAB-CD-DOMESTIC-NO-88 DTSCS1D
|
|
01728 ** MOVE MSG-E1D1-AREA TO WRK-MSG-AREA DTSCS1D
|
|
01729 ** PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS1D
|
|
01730 DTSCS1D
|
|
01731 S1310-EXIT. EXIT. DTSCS1D
|
|
01732 DTSCS1D
|
|
01733 /*****************************************************************DTSCS1D
|
|
01734 * *DTSCS1D
|
|
01735 ******************************************************************DTSCS1D
|
|
01736 S1400-EDIT-PWR-OF-ATTORNEY. DTSCS1D
|
|
01737 MOVE MAP-PWR-OF-ATTORNEY-AREA TO L015-S-DATE-AREA. DTSCS1D
|
|
01738 ** IF USER ENTERS NINES, RESET MPRF-PWR-OF-ATTORNEY-DT DTSCS1D
|
|
01739 ** IN MPRF RECORD TO ZERO. DTSCS1D
|
|
01740 IF L015-S-MO = '99' DTSCS1D
|
|
01741 MOVE '99' TO L015-S-DA DTSCS1D
|
|
01742 L015-S-YR DTSCS1D
|
|
01743 GO TO S1400-EXIT DTSCS1D
|
|
01744 END-IF. DTSCS1D
|
|
01745 DTSCS1D
|
|
01746 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1D
|
|
01747 IF L015-NO-ENTRY DTSCS1D
|
|
01748 NEXT SENTENCE DTSCS1D
|
|
01749 ELSE DTSCS1D
|
|
01750 IF L015-NOT-VALID DTSCS1D
|
|
01751 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01752 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS1D
|
|
01753 S1400-EXIT. EXIT. DTSCS1D
|
|
01754 SKIP3 DTSCS1D
|
|
01755 S1401-ERROR. DTSCS1D
|
|
01756 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PWR-ATTORNEY-MO-A. DTSCS1D
|
|
01757 IF LCCM-NO-MSG DTSCS1D
|
|
01758 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01759 MOVE CATB-CURSOR TO MAP-PWR-ATTORNEY-MO-L DTSCS1D
|
|
01760 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01761 S1401-EXIT. EXIT. DTSCS1D
|
|
01762 SKIP3 DTSCS1D
|
|
01763 /*****************************************************************DTSCS1D
|
|
01764 * *DTSCS1D
|
|
01765 ******************************************************************DTSCS1D
|
|
01766 S1500-FEIN. DTSCS1D
|
|
01767 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA. DTSCS1D
|
|
01768 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT. DTSCS1D
|
|
01769 DTSCS1D
|
|
01770 IF L017-NO-ENTRY DTSCS1D
|
|
01771 GO TO S1500-EXIT. DTSCS1D
|
|
01772 SKIP1 DTSCS1D
|
|
01773 IF L017-NOT-VALID DTSCS1D
|
|
01774 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01775 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS1D
|
|
01776 GO TO S1500-EXIT. DTSCS1D
|
|
01777 SKIP1 DTSCS1D
|
|
01778 DTSCS1D
|
|
01779 DTSCS1D
|
|
01780 IF L017-FEIN NOT = MPRF-FEIN DTSCS1D
|
|
01781 AND MPRF-STATUS-ACT-88 DTSCS1D
|
|
01782 SET L074-ACTIVE-DUP-88 TO TRUE DTSCS1D
|
|
01783 MOVE WRK-EMP-NO TO L074-EMP-NO DTSCS1D
|
|
01784 MOVE L017-FEIN TO L074-FEIN DTSCS1D
|
|
01785 MOVE +0 TO L074-INACTIVE-EMP-NO DTSCS1D
|
|
01786 PERFORM S074-DUP-FEIN-EDIT THRU S074-EXIT DTSCS1D
|
|
01787 IF L074-DUP-NOT-OK-88 DTSCS1D
|
|
01788 MOVE EMSG-DUPLICATE-FEIN TO WRK-MSG-AREA DTSCS1D
|
|
01789 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS1D
|
|
01790 S1500-EXIT. EXIT. DTSCS1D
|
|
01791 SKIP3 DTSCS1D
|
|
01792 S1501-ERROR. DTSCS1D
|
|
01793 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FEIN-1-A DTSCS1D
|
|
01794 MAP-FEIN-2-A. DTSCS1D
|
|
01795 IF LCCM-NO-MSG DTSCS1D
|
|
01796 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01797 MOVE CATB-CURSOR TO MAP-FEIN-1-L DTSCS1D
|
|
01798 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01799 S1501-EXIT. EXIT. DTSCS1D
|
|
01800 /*****************************************************************DTSCS1D
|
|
01801 * *DTSCS1D
|
|
01802 ******************************************************************DTSCS1D
|
|
01803 S1600-AUDITED. DTSCS1D
|
|
01804 MOVE MAP-ARCHIVED-AUDIT-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS1D
|
|
01805 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS1D
|
|
01806 IF L016-NOT-VALID DTSCS1D
|
|
01807 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1D
|
|
01808 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS1D
|
|
01809 S1600-EXIT. EXIT. DTSCS1D
|
|
01810 SKIP3 DTSCS1D
|
|
01811 S1601-ERROR. DTSCS1D
|
|
01812 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ARCHIVED-AUDIT-YR-A DTSCS1D
|
|
01813 MAP-ARCHIVED-AUDIT-Q-A DTSCS1D
|
|
01814 IF LCCM-NO-MSG DTSCS1D
|
|
01815 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1D
|
|
01816 MOVE CATB-CURSOR TO MAP-ARCHIVED-AUDIT-YR-L DTSCS1D
|
|
01817 SET CURSOR-SET-YES TO TRUE. DTSCS1D
|
|
01818 S1601-EXIT. EXIT. DTSCS1D
|
|
01819 /*****************************************************************DTSCS1D
|
|
01820 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS1D
|
|
01821 ******************************************************************DTSCS1D
|
|
01822 S5100-SET-LOCK-ATTRB. DTSCS1D
|
|
01823 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS1D
|
|
01824 SCR-ATB-NUM. DTSCS1D
|
|
01825 SKIP1 DTSCS1D
|
|
01826 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1D
|
|
01827 SKIP1 DTSCS1D
|
|
01828 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS1D
|
|
01829 MAP-EMP-NO-2-A DTSCS1D
|
|
01830 MAP-GOTO-A. DTSCS1D
|
|
01831 S5100-EXIT. EXIT. DTSCS1D
|
|
01832 SKIP3 DTSCS1D
|
|
01833 ******************************************************************DTSCS1D
|
|
01834 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS1D
|
|
01835 ******************************************************************DTSCS1D
|
|
01836 S5200-SET-UPDATE-ATTRB. DTSCS1D
|
|
01837 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS1D
|
|
01838 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS1D
|
|
01839 SKIP1 DTSCS1D
|
|
01840 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1D
|
|
01841 S5200-EXIT. EXIT. DTSCS1D
|
|
01842 SKIP3 DTSCS1D
|
|
01843 ******************************************************************DTSCS1D
|
|
01844 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS1D
|
|
01845 ******************************************************************DTSCS1D
|
|
01846 S5300-SET-INQ-ATTRB. DTSCS1D
|
|
01847 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS1D
|
|
01848 SCR-ATB-NUM. DTSCS1D
|
|
01849 SKIP1 DTSCS1D
|
|
01850 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1D
|
|
01851 S5300-EXIT. EXIT. DTSCS1D
|
|
01852 /*****************************************************************DTSCS1D
|
|
01853 * DO IT *DTSCS1D
|
|
01854 ******************************************************************DTSCS1D
|
|
01855 S5900-SET-ATTRB. DTSCS1D
|
|
01856 SKIP1 DTSCS1D
|
|
01857 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS1D
|
|
01858 MAP-EMP-NO-2-A. DTSCS1D
|
|
01859 SKIP3 DTSCS1D
|
|
01860 MOVE SCR-ATB-AN TO MAP-UC30-MASS-MAIL-IND-A DTSCS1D
|
|
01861 MAP-UC30-CREDIT-IND-A DTSCS1D
|
|
01862 MAP-RETURN-MAIL-IND-A DTSCS1D
|
|
01863 MAP-FEIN-HARASS-IND-A DTSCS1D
|
|
01864 MAP-CHRG-STMT-PRINT-IND-A DTSCS1D
|
|
01865 MAP-ORG-TYPE-A DTSCS1D
|
|
01866 MAP-DC-CONTRACTOR-IND-A. DTSCS1D
|
|
01867 SKIP1 DTSCS1D
|
|
01868 MOVE SCR-ATB-NUM TO MAP-FEIN-1-A DTSCS1D
|
|
01869 MAP-FEIN-2-A DTSCS1D
|
|
01870 MAP-PWR-ATTORNEY-DA-A DTSCS1D
|
|
01871 MAP-PWR-ATTORNEY-MO-A DTSCS1D
|
|
01872 MAP-PWR-ATTORNEY-YR-A DTSCS1D
|
|
01873 MAP-ARCHIVED-AUDIT-YR-A DTSCS1D
|
|
01874 MAP-ARCHIVED-AUDIT-Q-A. DTSCS1D
|
|
01875 SKIP1 DTSCS1D
|
|
01876 MOVE CATB-ASKIP-BRT-MDTON TO MAP-LAST-ARCHIVED-YRQ-A DTSCS1D
|
|
01877 MAP-ELIGIBLE-CD-A. DTSCS1D
|
|
01878 SKIP1 DTSCS1D
|
|
01879 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A. DTSCS1D
|
|
01880 SKIP1 DTSCS1D
|
|
01881 MOVE CATB-ASKIP-NORM-MDTON TO MAP-FA-ADDR-REC-A DTSCS1D
|
|
01882 MAP-FA-ADDR-REC-NAME-A DTSCS1D
|
|
01883 MAP-FA-QTLY-RPT-A DTSCS1D
|
|
01884 MAP-FA-QTLY-RPT-NAME-A DTSCS1D
|
|
01885 MAP-FA-BENF-CHG-A DTSCS1D
|
|
01886 MAP-FA-BENF-CHG-NAME-A DTSCS1D
|
|
01887 MAP-ORG-DESC-A DTSCS1D
|
|
01888 MAP-ELIGIBLE-DESC-A DTSCS1D
|
|
01889 MAP-EFT-ENROLLED-A. DTSCS1D
|
|
01890 SKIP3 DTSCS1D
|
|
01891 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS1D
|
|
01892 SKIP1 DTSCS1D
|
|
01893 S5900-EXIT. EXIT. DTSCS1D
|
|
01894 /*****************************************************************DTSCS1D
|
|
01895 * FILE READ COMMON PREPARATION ROUTINES *DTSCS1D
|
|
01896 ******************************************************************DTSCS1D
|
|
01897 S8100-READ-MPRF. DTSCS1D
|
|
01898 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1D
|
|
01899 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1D
|
|
01900 SET MPRF-PRF-88 TO TRUE. DTSCS1D
|
|
01901 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1D
|
|
01902 PERFORM S810-READ THRU S810-EXIT. DTSCS1D
|
|
01903 IF L810-OK-88 DTSCS1D
|
|
01904 SET WRK-MPRF-YES-88 TO TRUE DTSCS1D
|
|
01905 ELSE DTSCS1D
|
|
01906 SET WRK-MPRF-NO-88 TO TRUE. DTSCS1D
|
|
01907 S8100-EXIT. EXIT. DTSCS1D
|
|
01908 /*****************************************************************DTSCS1D
|
|
01909 * MAP ROUTINES *DTSCS1D
|
|
01910 ******************************************************************DTSCS1D
|
|
01911 S9100-RECEIVE. DTSCS1D
|
|
01912 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS1D
|
|
01913 SET L851-RECEIVE-88 TO TRUE. DTSCS1D
|
|
01914 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1D
|
|
01915 SKIP1 DTSCS1D
|
|
01916 MOVE L851-AID TO LCCM-AID. DTSCS1D
|
|
01917 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS1D
|
|
01918 S9100-EXIT. EXIT. DTSCS1D
|
|
01919 SKIP3 DTSCS1D
|
|
01920 ******************************************************************DTSCS1D
|
|
01921 * *DTSCS1D
|
|
01922 ******************************************************************DTSCS1D
|
|
01923 S9200-SEND-DATAONLY. DTSCS1D
|
|
01924 MOVE LOW-VALUES TO MAP-AREA. DTSCS1D
|
|
01925 SKIP1 DTSCS1D
|
|
01926 IF LCCM-NO-MSG DTSCS1D
|
|
01927 NEXT SENTENCE DTSCS1D
|
|
01928 ELSE DTSCS1D
|
|
01929 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS1D
|
|
01930 SKIP1 DTSCS1D
|
|
01931 IF CURSOR-SET-GOTO DTSCS1D
|
|
01932 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS1D
|
|
01933 ELSE DTSCS1D
|
|
01934 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS1D
|
|
01935 SKIP1 DTSCS1D
|
|
01936 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS1D
|
|
01937 SKIP1 DTSCS1D
|
|
01938 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS1D
|
|
01939 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1D
|
|
01940 S9200-EXIT. EXIT. DTSCS1D
|
|
01941 SKIP3 DTSCS1D
|
|
01942 ******************************************************************DTSCS1D
|
|
01943 * *DTSCS1D
|
|
01944 ******************************************************************DTSCS1D
|
|
01945 S9300-SEND-MAP. DTSCS1D
|
|
01946 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS1D
|
|
01947 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS1D
|
|
01948 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS1D
|
|
01949 SKIP1 DTSCS1D
|
|
01950 IF SCR-ACCESS-UPDATE DTSCS1D
|
|
01951 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS1D
|
|
01952 ELSE DTSCS1D
|
|
01953 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS1D
|
|
01954 SKIP1 DTSCS1D
|
|
01955 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS1D
|
|
01956 SKIP1 DTSCS1D
|
|
01957 IF CURSOR-SET-NO DTSCS1D
|
|
01958 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS1D
|
|
01959 SKIP1 DTSCS1D
|
|
01960 PERFORM S9330-DISPLAY-FIELDS THRU S9330-EXIT. DTSCS1D
|
|
01961 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS1D
|
|
01962 SKIP1 DTSCS1D
|
|
01963 SET L851-SEND-88 TO TRUE. DTSCS1D
|
|
01964 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1D
|
|
01965 S9300-EXIT. EXIT. DTSCS1D
|
|
01966 SKIP3 DTSCS1D
|
|
01967 S9310-UPDATE-FKEYS. DTSCS1D
|
|
01968 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS1D
|
|
01969 * PERFORM S9390-JUMP-KEYS THRU S9390-EXIT. DTSCS1D
|
|
01970 SKIP1 DTSCS1D
|
|
01971 IF LCCM-SCR-CLEAR DTSCS1D
|
|
01972 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS1D
|
|
01973 ELSE DTSCS1D
|
|
01974 IF LCCM-SCR-UPDATE-LOCKED DTSCS1D
|
|
01975 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS1D
|
|
01976 S9310-EXIT. EXIT. DTSCS1D
|
|
01977 SKIP3 DTSCS1D
|
|
01978 S9320-INQUIRY-FKEYS. DTSCS1D
|
|
01979 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS1D
|
|
01980 * PERFORM S9390-JUMP-KEYS THRU S9390-EXIT. DTSCS1D
|
|
01981 S9320-EXIT. EXIT. DTSCS1D
|
|
01982 EJECT DTSCS1D
|
|
01983 S9330-DISPLAY-FIELDS. DTSCS1D
|
|
01984 IF MAP-ORG-TYPE = SPACE OR LOW-VALUE DTSCS1D
|
|
01985 MOVE LOW-VALUE TO MAP-ORG-DESC DTSCS1D
|
|
01986 ELSE DTSCS1D
|
|
01987 MOVE MAP-ORG-TYPE TO L031-CD DTSCS1D
|
|
01988 SET L031-MPRF-ORG-TYPE TO TRUE DTSCS1D
|
|
01989 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1D
|
|
01990 MOVE L031-SHORT-DSCR TO MAP-ORG-DESC. DTSCS1D
|
|
01991 SKIP1 DTSCS1D
|
|
01992 IF WRK-MPRF-YES-88 DTSCS1D
|
|
01993 PERFORM S9331-DISPLAY-FROM-MPRF THRU S9331-EXIT. DTSCS1D
|
|
01994 S9330-EXIT. EXIT. DTSCS1D
|
|
01995 SKIP3 DTSCS1D
|
|
01996 S9331-DISPLAY-FROM-MPRF. DTSCS1D
|
|
01997 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS1D
|
|
01998 SKIP1 DTSCS1D
|
|
01999 IF MPRF-LAST-ARCHIVED-YRQ = +0 DTSCS1D
|
|
02000 MOVE SPACE TO MAP-LAST-ARCHIVED-YRQ DTSCS1D
|
|
02001 ELSE DTSCS1D
|
|
02002 MOVE MPRF-LAST-ARCHIVED-YRQ TO L004-QTR-5-9 DTSCS1D
|
|
02003 SET L004-FROM-5 TO TRUE DTSCS1D
|
|
02004 PERFORM S004-QUARTER THRU S004-EXIT DTSCS1D
|
|
02005 IF L004-VALID-QTR DTSCS1D
|
|
02006 MOVE L004-SLASH-QTR TO MAP-LAST-ARCHIVED-YRQ DTSCS1D
|
|
02007 ELSE DTSCS1D
|
|
02008 GO TO S899-ABEND. DTSCS1D
|
|
02009 SKIP1 DTSCS1D
|
|
02010 MOVE MPRF-ELIGIBLE-CD TO MAP-ELIGIBLE-CD-N. DTSCS1D
|
|
02011 MOVE MAP-ELIGIBLE-CD TO L031-CD. DTSCS1D
|
|
02012 SET L031-MPRF-ELIGIBLE-CD TO TRUE. DTSCS1D
|
|
02013 PERFORM S031-REG-CODES THRU S031-EXIT. DTSCS1D
|
|
02014 MOVE L031-SHORT-DSCR TO MAP-ELIGIBLE-DESC. DTSCS1D
|
|
02015 S9331-EXIT. EXIT. DTSCS1D
|
|
02016 EJECT DTSCS1D
|
|
02017 *S9390-JUMP-KEYS. DTSCS1D
|
|
02018 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS1D
|
|
02019 *S9390-EXIT. EXIT. DTSCS1D
|
|
02020 SKIP3 DTSCS1D
|
|
02021 ******************************************************************DTSCS1D
|
|
02022 * *DTSCS1D
|
|
02023 ******************************************************************DTSCS1D
|
|
02024 S9900-PREPARE-SEND. DTSCS1D
|
|
02025 MOVE WRK-SCR-ID TO LCCM-SCR-ID DTSCS1D
|
|
02026 L851-SCR-ID. DTSCS1D
|
|
02027 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS1D
|
|
02028 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS1D
|
|
02029 S9900-EXIT. EXIT. DTSCS1D
|