3969 lines
310 KiB
COBOL
3969 lines
310 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/07/25
|
|
00002 PROGRAM-ID. DTSCS76. DTSCS76
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV001
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS76
|
|
00005 DATE-COMPILED. DTSCS76
|
|
00006 DTSCS76
|
|
00007 ***** DTSCS76
|
|
00008 * DTSCS76
|
|
00009 * FUNCTION: MISCELLANEOUS BATCH/ONLINE REQUEST DTSCS76
|
|
00010 * SCREEN PROCESSOR. DTSCS76
|
|
00011 * DTSCS76
|
|
00012 * DTSCS76
|
|
00013 * MODIFICATION LOG: DTSCS76
|
|
00014 * DTSCS76
|
|
00015 * 10/04/98 INITIAL DEVELOPMENT. COPIED FROM MACCS76. DTSCS76
|
|
00016 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS76
|
|
00017 * DTSCS76
|
|
00018 * 11/01/02 MODIFIED SCREEN TO ALLOW FOR EMPLOYER WAGE REQUEST.DTSCS76
|
|
00019 * IR751 RECORD IS GENERATED. THE USER SPECIFIES AN DTSCS76
|
|
00020 * SSN AND THE QUARTER(S) OF THE WAGE REQUEST. DTSCS76
|
|
00021 * THIS MODIFICATION EDITS THE WAGE REQUEST DTSCS76
|
|
00022 * SCREEN DATA AND WRITES THE DTSIR751 REPORT RECORD. DTSCS76
|
|
00023 * DTSBR751 PRINTS THE WAGE REQUEST. DTSCS76
|
|
00024 * DTSCS76
|
|
00025 * 09/04/05 MODIFIED SCREEN TO ALLOW FOR PRINTING STATEMENT OF DTSCS76
|
|
00026 * ACCOUNTS OVERNIGHT. THE USER SPECIFIES AN DTSCS76
|
|
00027 * THE QUARTER(S) OF THE ACCOUNT TO PRINT. DTSCS76
|
|
00028 * THIS MODIFICATION EDITS THE PRINT REQUEST DTSCS76
|
|
00029 * SCREEN DATA AND WRITES THE T011 TRANSACTION RECORDDTSCS76
|
|
00030 * DTSBD327 READS THE T011 AND BIULDS A IR414 RECORD. DTSCS76
|
|
00031 * DTSCS76
|
|
00032 * REFERENCE RFP: PROGRAMMER: ZL1 DTSCS76
|
|
00033 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS76
|
|
00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS76
|
|
00035 * REFERENCE RFP: #*** PROGRAMMER: XXX DTSCS76
|
|
00036 * DTSCS76
|
|
00037 * DTSCS76
|
|
00038 * DESCRIPTION: DTSCS76
|
|
00039 * DTSCS76
|
|
00040 * DTSCS76
|
|
00041 * CLEAR: DTSCS76
|
|
00042 * DTSCS76
|
|
00043 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS76
|
|
00044 * DTSCS76
|
|
00045 * DTSCS76
|
|
00046 * JUMP: DTSCS76
|
|
00047 * DTSCS76
|
|
00048 * NONE. DTSCS76
|
|
00049 * DTSCS76
|
|
00050 * DTSCS76
|
|
00051 * INQUIRY: DTSCS76
|
|
00052 * DTSCS76
|
|
00053 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS76
|
|
00054 * DTSCS76
|
|
00055 * JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS76
|
|
00056 * DTSCS76
|
|
00057 * ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS76
|
|
00058 * DTSCS76
|
|
00059 * STANDARD LCCM-EMP-NO. DTSCS76
|
|
00060 * DTSCS76
|
|
00061 * DTSCS76
|
|
00062 * UPDATE: DTSCS76
|
|
00063 * DTSCS76
|
|
00064 * ADD DTSCS76
|
|
00065 * DTSCS76
|
|
00066 * DOES NOT UPDATE THE MASTER FILE. RATHER, WRITES ONE DTSCS76
|
|
00067 * OR MORE RECORDS TO THE ON-LINE ACTIVITY FILE. DTSCS76
|
|
00068 * DTSCS76
|
|
00069 * OPERATION SHOULD BE SIMILAR TO 'ADD' FUNCTION ON DTSCS76
|
|
00070 * OTHER SCREENS (F09, CONFIRM OR CANCEL). DTSCS76
|
|
00071 * DTSCS76
|
|
00072 * ELECTRONIC FILER(MELF) REMOVED ZL1. DTSCS76
|
|
00073 * RECORDS READ: DTSCS76
|
|
00074 * DTSCS76
|
|
00075 * MASTER: DTSCS76
|
|
00076 * DTSCS76
|
|
00077 * MPRF DTSCS76
|
|
00078 * MSOL DTSCS76
|
|
00079 * MRTE DTSCS76
|
|
00080 * MQTR DTSCS76
|
|
00081 * MRPT DTSCS76
|
|
00082 * DTSCS76
|
|
00083 * DTSCS76
|
|
00084 * DTSCS76
|
|
00085 * ALTERNATE INDEX: DTSCS76
|
|
00086 * DTSCS76
|
|
00087 * NONE. DTSCS76
|
|
00088 * DTSCS76
|
|
00089 * DTSCS76
|
|
00090 * REFERENCE: DTSCS76
|
|
00091 * DTSCS76
|
|
00092 * NONE. DTSCS76
|
|
00093 * DTSCS76
|
|
00094 * DTSCS76
|
|
00095 * ACCOUNTING TRANSACTION COLLECTION: DTSCS76
|
|
00096 * DTSCS76
|
|
00097 * NONE. DTSCS76
|
|
00098 * DTSCS76
|
|
00099 * DTSCS76
|
|
00100 * RECORDS UPDATED: DTSCS76
|
|
00101 * DTSCS76
|
|
00102 * MASTER: DTSCS76
|
|
00103 * DTSCS76
|
|
00104 * NONE. DTSCS76
|
|
00105 * DTSCS76
|
|
00106 * DTSCS76
|
|
00107 * REFERENCE: DTSCS76
|
|
00108 * DTSCS76
|
|
00109 * NONE. DTSCS76
|
|
00110 * DTSCS76
|
|
00111 * DTSCS76
|
|
00112 * ACCOUNTING TRANSACTION COLLECTION: DTSCS76
|
|
00113 * DTSCS76
|
|
00114 * NONE. DTSCS76
|
|
00115 * DTSCS76
|
|
00116 * DTSCS76
|
|
00117 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS76
|
|
00118 * DTSCS76
|
|
00119 * IF MAP-LABEL-CNT NOT = 0 DTSCS76
|
|
00120 * DTSCS76
|
|
00121 * WRITE A MACIR901 RECORD (R901-ON-REQUEST-88). DTSCS76
|
|
00122 * DTSCS76
|
|
00123 * DTSCS76
|
|
00124 * IF MAP-ELF-LABEL-IND = 'Y' AND MAP-ELF-LABEL-CNT NOT = 0 DTSCS76
|
|
00125 * DTSCS76
|
|
00126 * WRITE A MACIR901 RECORD (R901-ON-REQUEST-88). DTSCS76
|
|
00127 * DTSCS76
|
|
00128 * NOTE: USERS MUST BE ABLE TO REQUEST MAILING LABELS AND DTSCS76
|
|
00129 * ELECTRONIC FILER (ELF) MAILING LABELS FOR A GIVEN DTSCS76
|
|
00130 * EMPLOYER. WRITE TWO MACIR901 RECORDS IN SUCH CASES. DTSCS76
|
|
00131 * DTSCS76
|
|
00132 * DTSCS76
|
|
00133 * IF MAP-START-RPT-YRQ NOT = SPACES OR LOW-VALUES DTSCS76
|
|
00134 * DTSCS76
|
|
00135 * WRITE A MACIT036 RECORD WITH T036-TRN-CD = '02' DTSCS76
|
|
00136 * AND T036-FORCE-PRINT-IND EQUAL TO MAP-FORCE-PRINT DTSCS76
|
|
00137 * -IND. THE T036-WAIVE-* FIELDS SHOULD BE ZEROS. DTSCS76
|
|
00138 * T036-ADDR-TYPE AND T036-ADDR-NO SHOULD BE TAKEN DTSCS76
|
|
00139 * FROM MAP-ADDR-TYPE AND MAP-ADDR-NO. DTSCS76
|
|
00140 * DTSCS76
|
|
00141 * THE EDITS IN HERE SHOULD BE SIMILAR TO VERMONT. DTSCS76
|
|
00142 * MAY USE IN INFAMOUS DTSCU381 TO VERIFY LIABILITY DTSCS76
|
|
00143 * AND THE EXISTENCE OF A RATE. IF MAP-FORCE-IND DTSCS76
|
|
00144 * IS EQUAL TO 'N', WILL NEED TO READ THE MQTR DTSCS76
|
|
00145 * RECORDS AND IF MQTR RECORD EXISTS AND MQTR-CURR DTSCS76
|
|
00146 * RCVD-88, DISPLAY E763. DTSCS76
|
|
00147 * DTSCS76
|
|
00148 * DTSCS76
|
|
00149 * IF MAP-5E-START-RPT-YRQ NOT = SPACES OR LOW-VALUES DTSCS76
|
|
00150 * DTSCS76
|
|
00151 * WRITE A MACIT036 RECORD WITH T036-TRN-CD = '02' DTSCS76
|
|
00152 * AND T036-FORCE-PRINT-IND EQUAL TO MAP-5E-FORCE-PRINT DTSCS76
|
|
00153 * -IND. THE T036-WAIVE-* FIELDS SHOULD BE ZEROS. DTSCS76
|
|
00154 * T036-ADDR-TYPE AND T036-ADDR-NO SHOULD BE TAKEN DTSCS76
|
|
00155 * FROM MAP-ADDR-TYPE AND MAP-ADDR-NO. DTSCS76
|
|
00156 * DTSCS76
|
|
00157 * USE THE SAME EDITS AS FOR THE REGULAR UI-5'S ABOVE. DTSCS76
|
|
00158 * VERIFY LIABILITY AND THE EXISTENCE OF A RATE. IF DTSCS76
|
|
00159 * MAP-5E-FORCE-IND IS EQUAL TO 'N', WILL NEED TO READ DTSCS76
|
|
00160 * THE MQTR RECORDS AND IF MQTR RECORD EXISTS AND MQTR- DTSCS76
|
|
00161 * CURR-RCVD-88, DISPLAY E769. DTSCS76
|
|
00162 * DTSCS76
|
|
00163 * NOTE: USERS MUST BE ABLE TO REQUEST BOTH UI-5(S) AND DTSCS76
|
|
00164 * UI-5E(S) AS LONG AS THE QUARTER RANGES DO NOT OVER- DTSCS76
|
|
00165 * LAP. WRITE TWO T036 RECORDS IN SUCH CASES, SETTING DTSCS76
|
|
00166 * T036-UI-5E-REQ APPROPRIATELY. DTSCS76
|
|
00167 * DTSCS76
|
|
00168 * DTSCS76
|
|
00169 * IF MAP-NOTICE-OF-COVERAGE-CNT NOT = 0 DTSCS76
|
|
00170 * DTSCS76
|
|
00171 * WRITE MAP-NOTICE-OF-COVERAGE-CNT MACIR111 RECORDS. DTSCS76
|
|
00172 * DTSCS76
|
|
00173 * DTSCS76
|
|
00174 * IF MAP-NOTICE-OF-SUBJECT-IND = 'Y' DTSCS76
|
|
00175 * DTSCS76
|
|
00176 * WRITE A MACIR112 RECORD FOR THE LAST MSOL RECORD DTSCS76
|
|
00177 * ASSOCIATED WITH THE EMPLOYER. SEE MACBD311 FOR DTSCS76
|
|
00178 * SAMPLE MACIR112 GENERATING CODE. DTSCS76
|
|
00179 * DTSCS76
|
|
00180 * DTSCS76
|
|
00181 * IF MAP-REQUEST-FOR-FEIN-IND = 'Y' DTSCS76
|
|
00182 * DTSCS76
|
|
00183 * WRITE A MACIR903 RECORD. DTSCS76
|
|
00184 * DTSCS76
|
|
00185 * DTSCS76
|
|
00186 * IF MAP-AR-AUDIT-TRAIL-IND = 'Y' DTSCS76
|
|
00187 * DTSCS76
|
|
00188 * SCAN MQTR RECORDS. FOR EACH MQTR RECORD: DTSCS76
|
|
00189 * DTSCS76
|
|
00190 * IF THE MQTR RECORD HAS ONE OR MORE DTSCS76
|
|
00191 * MQTR-BALANCE-AMT (N) OCCURRENCE GREATER THAN DTSCS76
|
|
00192 * ZERO DTSCS76
|
|
00193 * DTSCS76
|
|
00194 * SCAN THE MRPT RECORDS ASSOCIATED WITH THE DTSCS76
|
|
00195 * QUARTER (THOSE MRPT RECORDS WITH MRPT-YRQ DTSCS76
|
|
00196 * EQUAL TO MQTR-YRQ) AND FOR EACH SUCH MRPT DTSCS76
|
|
00197 * RECORD ENCOUNTERED WRITE AN R432 RECORD. DTSCS76
|
|
00198 * DTSCS76
|
|
00199 * DTSCS76
|
|
00200 * IF MAP-COMBINE-IND = 'Y' DTSCS76
|
|
00201 * DTSCS76
|
|
00202 * WRITE A DTSIR733 RECORD. DTSCS76
|
|
00203 * DTSCS76
|
|
00204 * DTSCS76
|
|
00205 * TEMPORARY STORAGE USAGE: DTSCS76
|
|
00206 * DTSCS76
|
|
00207 * NONE. DTSCS76
|
|
00208 * DTSCS76
|
|
00209 * DTSCS76
|
|
00210 * MODULES LINKED TO: DTSCS76
|
|
00211 * DTSCS76
|
|
00212 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS76
|
|
00213 * DTSCU013 COUNT FROM SCREEN (INTEGER) FORMAT/EDIT. DTSCS76
|
|
00214 * DTSCU016 QUARTER/YEAR FROM SCREEN FORMAT/EDIT. DTSCS76
|
|
00215 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS76
|
|
00216 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS76
|
|
00217 * DTSCU111 ADDRESS LOOKUP. DTSCS76
|
|
00218 * DTSCU112 FORMAT ADDRESS FOR MAILING. DTSCS76
|
|
00219 * DTSCU381 FIND LIABILITY AND RATE FOR A QUARTER. DTSCS76
|
|
00220 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS76
|
|
00221 * DTSCU825 ON-LINE ACTIVITY FILE OUTPUT. DTSCS76
|
|
00222 * DTSCS76
|
|
00223 ***** DTSCS76
|
|
00224 DTSCS76
|
|
00225 ENVIRONMENT DIVISION. DTSCS76
|
|
00226 DTSCS76
|
|
00227 DATA DIVISION. DTSCS76
|
|
00228 DTSCS76
|
|
00229 WORKING-STORAGE SECTION. DTSCS76
|
|
002295 77 PAN-VALET PICTURE X(24) VALUE '001DTSCS76 05/07/25'. DTSCS76
|
|
00230 77 PAN-VALET PICTURE X(24) VALUE '056DTSCS76 09/14/05'. DTSCS76
|
|
00231 DTSCS76
|
|
00232 01 SW-AREA. DTSCS76
|
|
00233 05 WRK-ABEND-CD PIC X(04) VALUE 'S76 '. DTSCS76
|
|
00234 DTSCS76
|
|
00235 05 WRK-SCR-ID. DTSCS76
|
|
00236 10 WRK-SCR-ID-N PIC 9(02) VALUE 76. DTSCS76
|
|
00237 DTSCS76
|
|
00238 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS76
|
|
00239 DTSCS76
|
|
00240 05 SCR-ACCESS-IND PIC X(01). DTSCS76
|
|
00241 88 SCR-ACCESS-INQ VALUE '1'. DTSCS76
|
|
00242 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS76
|
|
00243 DTSCS76
|
|
00244 05 CURSOR-SET-IND PIC X(01). DTSCS76
|
|
00245 88 CURSOR-SET-YES VALUE 'Y'. DTSCS76
|
|
00246 88 CURSOR-SET-NO VALUE 'N'. DTSCS76
|
|
00247 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS76
|
|
00248 DTSCS76
|
|
00249 05 REQ-IND PIC X(01). DTSCS76
|
|
00250 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS76
|
|
00251 88 REQ-ERROR VALUE 'O'. DTSCS76
|
|
00252 88 REQ-JUMP VALUE 'J'. DTSCS76
|
|
00253 88 REQ-UPDATE VALUE 'U'. DTSCS76
|
|
00254 88 REQ-INQUIRE VALUE 'I'. DTSCS76
|
|
00255 88 REQ-CLEAR VALUE 'C'. DTSCS76
|
|
00256 88 REQ-EDIT VALUE 'E'. DTSCS76
|
|
00257 DTSCS76
|
|
00258 05 RESP-IND PIC X(01). DTSCS76
|
|
00259 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS76
|
|
00260 88 RESP-SEND-MAP VALUE 'M'. DTSCS76
|
|
00261 88 RESP-JUMP VALUE 'J'. DTSCS76
|
|
00262 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS76
|
|
00263 DTSCS76
|
|
00264 05 WRK-MSG-AREA PIC X(64). DTSCS76
|
|
00265 DTSCS76
|
|
00266 05 WRK-ATB-AN PIC X(01). DTSCS76
|
|
00267 DTSCS76
|
|
00268 05 WRK-ATB-NUM PIC X(01). DTSCS76
|
|
00269 DTSCS76
|
|
00270 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS76
|
|
00271 DTSCS76
|
|
00272 *****05 WRK-5E-REQ-IND PIC X(01). DTSCS76
|
|
00273 *********88 WRK-5E-REQ-YES-88 VALUE 'Y'. DTSCS76
|
|
00274 *********88 WRK-5E-REQ-NO-88 VALUE 'N'. DTSCS76
|
|
00275 DTSCS76
|
|
00276 05 WRK-FROM-YRQ PIC S9(05) COMP-3. DTSCS76
|
|
00277 05 WRK-TO-YRQ PIC S9(05) COMP-3. DTSCS76
|
|
00278 DTSCS76
|
|
00279 05 WRK-STMT-FROM-YRQ PIC S9(05) COMP-3. DTSCS76
|
|
00280 05 WRK-STMT-TO-YRQ PIC S9(05) COMP-3. DTSCS76
|
|
00281 DTSCS76
|
|
00282 DTSCS76
|
|
00283 DTSCS76
|
|
00284 05 WRK-R751-IND PIC X(01). DTSCS76
|
|
00285 88 WRK-R751-YES-88 VALUE 'Y'. DTSCS76
|
|
00286 88 WRK-R751-NO-88 VALUE 'N'. DTSCS76
|
|
00287 DTSCS76
|
|
00288 05 WRK-WAIVE-EXT-DATE PIC S9(09) COMP-3. DTSCS76
|
|
00289 DTSCS76
|
|
00290 *****05 WRK-5E-WAIVE-EXT-DATE PIC S9(09) COMP-3. DTSCS76
|
|
00291 DTSCS76
|
|
00292 05 WRK-MPRF-IND PIC X(01). DTSCS76
|
|
00293 88 WRK-MPRF-NONE-88 VALUE ' '. DTSCS76
|
|
00294 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS76
|
|
00295 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS76
|
|
00296 DTSCS76
|
|
00297 05 WRK-ANN-LIABLE-IND PIC X(01). DTSCS76
|
|
00298 88 WRK-ANN-LIABLE-YES-88 VALUE 'Y'. DTSCS76
|
|
00299 88 WRK-ANN-LIABLE-NO-88 VALUE 'N'. DTSCS76
|
|
00300 DTSCS76
|
|
00301 05 WRK-ANN-FILER-IND PIC X(01). DTSCS76
|
|
00302 88 WRK-ANN-FILER-YES-88 VALUE 'Y'. DTSCS76
|
|
00303 88 WRK-ANN-FILER-NO-88 VALUE 'N'. DTSCS76
|
|
00304 DTSCS76
|
|
00305 *****05 WRK-MELF-IND PIC X(01). DTSCS76
|
|
00306 *********88 WRK-MELF-NONE-88 VALUE ' '. DTSCS76
|
|
00307 *********88 WRK-MELF-YES-88 VALUE 'Y'. DTSCS76
|
|
00308 *********88 WRK-MELF-NO-88 VALUE 'N'. DTSCS76
|
|
00309 DTSCS76
|
|
00310 05 WRK-MAILING-ADDRESS-AREA. DTSCS76
|
|
00311 10 WRK-MAILING-ADDRESS. DTSCS76
|
|
00312 15 FILLER OCCURS 5 PIC X(40). DTSCS76
|
|
00313 10 WRK-ZIP PIC X(10). DTSCS76
|
|
00314 *********10 WRK-DELIV-POINT PIC X(02). DTSCS76
|
|
00315 *********10 WRK-CHECK-DIGIT PIC X(01). DTSCS76
|
|
00316 10 WRK-ADVANCED-BARCODE PIC X(14). DTSCS76
|
|
00317 DTSCS76
|
|
00318 *****05 WRK-ELF-ADDRESS-AREA. DTSCS76
|
|
00319 *********10 WRK-ELF-ADDRESS. DTSCS76
|
|
00320 *************15 FILLER OCCURS 5 PIC X(40). DTSCS76
|
|
00321 *********10 WRK-ELF-ZIP PIC X(10). DTSCS76
|
|
00322 *********10 WRK-ELF-DELIV-POINT PIC X(02). DTSCS76
|
|
00323 *********10 WRK-ELF-CHECK-DIGIT PIC X(01). DTSCS76
|
|
00324 DTSCS76
|
|
00325 DTSCS76
|
|
00326 DTSCS76
|
|
00327 05 WRK-DISPLAY PIC 9(11). DTSCS76
|
|
00328 DTSCS76
|
|
00329 05 FILLER REDEFINES WRK-DISPLAY. DTSCS76
|
|
00330 10 FILLER PIC X(05). DTSCS76
|
|
00331 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS76
|
|
00332 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS76
|
|
00333 DTSCS76
|
|
00334 05 FILLER REDEFINES WRK-DISPLAY. DTSCS76
|
|
00335 10 FILLER PIC X(05). DTSCS76
|
|
00336 10 WRK-DISPLAY-YR PIC X(02). DTSCS76
|
|
00337 10 WRK-DISPLAY-MO PIC X(02). DTSCS76
|
|
00338 10 WRK-DISPLAY-DA PIC X(02). DTSCS76
|
|
00339 DTSCS76
|
|
00340 05 FILLER REDEFINES WRK-DISPLAY. DTSCS76
|
|
00341 10 FILLER PIC X(06). DTSCS76
|
|
00342 10 WRK-DISPLAY-YRQ PIC X(05). DTSCS76
|
|
00343 10 FILLER REDEFINES WRK-DISPLAY-YRQ. DTSCS76
|
|
00344 15 FILLER PIC XX. DTSCS76
|
|
00345 15 WRK-DISPLAY-YRQ-Y PIC 99. DTSCS76
|
|
00346 15 WRK-DISPLAY-YRQ-Q PIC 9. DTSCS76
|
|
00347 DTSCS76
|
|
00348 DTSCS76
|
|
00349 05 WRK-RATE-CTR PIC S9(04) COMP. DTSCS76
|
|
00350 DTSCS76
|
|
00351 *****05 WRK-OCC PIC S9(04) COMP. DTSCS76
|
|
00352 DTSCS76
|
|
00353 05 BALANCE-DUE-IND PIC X(01). DTSCS76
|
|
00354 EJECT DTSCS76
|
|
00355 01 MSG-LITERALS. DTSCS76
|
|
00356 05 MSG-E761-AREA. DTSCS76
|
|
00357 10 FILLER PIC X(04) VALUE 'E761'. DTSCS76
|
|
00358 10 FILLER PIC X(13) DTSCS76
|
|
00359 VALUE 'THE RATE FOR '. DTSCS76
|
|
00360 10 MSG-E761-SLASH-QTR PIC X(04). DTSCS76
|
|
00361 10 FILLER PIC X(15) DTSCS76
|
|
00362 VALUE ' IS NOT ON FILE'. DTSCS76
|
|
00363 DTSCS76
|
|
00364 05 MSG-E762-AREA. DTSCS76
|
|
00365 10 FILLER PIC X(04) VALUE 'E762'. DTSCS76
|
|
00366 10 FILLER PIC X(30) DTSCS76
|
|
00367 VALUE 'NO BALANCE DUE '. DTSCS76
|
|
00368 10 FILLER PIC X(30) DTSCS76
|
|
00369 VALUE ' '. DTSCS76
|
|
00370 DTSCS76
|
|
00371 05 MSG-E763-AREA. DTSCS76
|
|
00372 10 FILLER PIC X(04) VALUE 'E763'. DTSCS76
|
|
00373 10 FILLER PIC X(30) DTSCS76
|
|
00374 VALUE 'EMPLOYER REPORT IS ON FILE. FO'. DTSCS76
|
|
00375 10 FILLER PIC X(30) DTSCS76
|
|
00376 VALUE 'RCE PRINT? '. DTSCS76
|
|
00377 DTSCS76
|
|
00378 05 MSG-E764-AREA. DTSCS76
|
|
00379 10 FILLER PIC X(04) VALUE 'E764'. DTSCS76
|
|
00380 10 FILLER PIC X(30) DTSCS76
|
|
00381 VALUE 'NOTHING TO DO '. DTSCS76
|
|
00382 10 FILLER PIC X(30) DTSCS76
|
|
00383 VALUE ' '. DTSCS76
|
|
00384 DTSCS76
|
|
00385 05 MSG-E765-AREA. DTSCS76
|
|
00386 10 FILLER PIC X(04) VALUE 'E765'. DTSCS76
|
|
00387 10 FILLER PIC X(30) DTSCS76
|
|
00388 VALUE 'EMPLOYER IS NOT SUBJECT '. DTSCS76
|
|
00389 10 FILLER PIC X(30) DTSCS76
|
|
00390 VALUE ' '. DTSCS76
|
|
00391 DTSCS76
|
|
00392 05 MSG-E766-AREA. DTSCS76
|
|
00393 10 FILLER PIC X(04) VALUE 'E766'. DTSCS76
|
|
00394 10 FILLER PIC X(26) DTSCS76
|
|
00395 VALUE 'EMPLOYER IS NOT LIABLE IN '. DTSCS76
|
|
00396 10 MSG-E766-SLASH-QTR PIC X(04). DTSCS76
|
|
00397 DTSCS76
|
|
00398 *****05 MSG-E767-AREA. DTSCS76
|
|
00399 *********10 FILLER PIC X(04) VALUE 'E767'. DTSCS76
|
|
00400 *********10 FILLER PIC X(30) DTSCS76
|
|
00401 ***************VALUE 'EMPLOYER IS NOT ACTIVE '. DTSCS76
|
|
00402 *********10 FILLER PIC X(30) DTSCS76
|
|
00403 ***************VALUE ' '. DTSCS76
|
|
00404 DTSCS76
|
|
00405 05 MSG-E768-AREA. DTSCS76
|
|
00406 10 FILLER PIC X(04) VALUE 'E768'. DTSCS76
|
|
00407 10 FILLER PIC X(30) DTSCS76
|
|
00408 VALUE 'EMPLOYER IS CHARGING ONLY '. DTSCS76
|
|
00409 10 FILLER PIC X(30) DTSCS76
|
|
00410 VALUE ' '. DTSCS76
|
|
00411 DTSCS76
|
|
00412 *****05 MSG-E769-AREA. DTSCS76
|
|
00413 *********10 FILLER PIC X(04) VALUE 'E769'. DTSCS76
|
|
00414 *********10 FILLER PIC X(30) DTSCS76
|
|
00415 ***************VALUE 'REPORT EXISTS. FORCE PRINT? C'. DTSCS76
|
|
00416 *********10 FILLER PIC X(30) DTSCS76
|
|
00417 ***************VALUE 'ONSIDER UI-5 OR UI-5G. '. DTSCS76
|
|
00418 DTSCS76
|
|
00419 *****05 MSG-E76A-AREA. DTSCS76
|
|
00420 *********10 FILLER PIC X(04) VALUE 'E76A'. DTSCS76
|
|
00421 *********10 FILLER PIC X(30) DTSCS76
|
|
00422 ***************VALUE 'EMPLOYER IS NOT AN ELECTRONIC '. DTSCS76
|
|
00423 *********10 FILLER PIC X(30) DTSCS76
|
|
00424 ***************VALUE 'FILER. '. DTSCS76
|
|
00425 DTSCS76
|
|
00426 *****05 MSG-E76B-AREA. DTSCS76
|
|
00427 *********10 FILLER PIC X(04) VALUE 'E76B'. DTSCS76
|
|
00428 *********10 FILLER PIC X(30) DTSCS76
|
|
00429 ***************VALUE 'EMPLOYER IS NOT AN ELECTRONIC '. DTSCS76
|
|
00430 *********10 FILLER PIC X(30) DTSCS76
|
|
00431 ***************VALUE 'FILER FOR TAX REPORTS. '. DTSCS76
|
|
00432 DTSCS76
|
|
00433 *****05 MSG-E76C-AREA. DTSCS76
|
|
00434 *********10 FILLER PIC X(04) VALUE 'E76C'. DTSCS76
|
|
00435 *********10 FILLER PIC X(30) DTSCS76
|
|
00436 ***************VALUE 'ELF? MUST = Y FOR NUMBER OF LA'. DTSCS76
|
|
00437 *********10 FILLER PIC X(30) DTSCS76
|
|
00438 ***************VALUE 'BELS TO BE ENTERED. '. DTSCS76
|
|
00439 DTSCS76
|
|
00440 *****05 MSG-E76D-AREA. DTSCS76
|
|
00441 *********10 FILLER PIC X(04) VALUE 'E76D'. DTSCS76
|
|
00442 *********10 FILLER PIC X(30) DTSCS76
|
|
00443 ***************VALUE 'UI-5E QUARTER RANGE OVERLAPS U'. DTSCS76
|
|
00444 *********10 FILLER PIC X(30) DTSCS76
|
|
00445 ***************VALUE 'I-5 QUARTER RANGE. '. DTSCS76
|
|
00446 DTSCS76
|
|
00447 *****05 MSG-E76E-AREA. DTSCS76
|
|
00448 *********10 FILLER PIC X(04) VALUE 'E76E'. DTSCS76
|
|
00449 *********10 FILLER PIC X(30) DTSCS76
|
|
00450 ***************VALUE 'ELF ADDRESS NOT DELIVERABLE. '. DTSCS76
|
|
00451 *********10 FILLER PIC X(30) DTSCS76
|
|
00452 ***************VALUE ' '. DTSCS76
|
|
00453 DTSCS76
|
|
00454 05 MSG-E76F-AREA. DTSCS76
|
|
00455 10 FILLER PIC X(04) VALUE 'E76F'. DTSCS76
|
|
00456 10 FILLER PIC X(30) DTSCS76
|
|
00457 VALUE 'ANNUAL UC30H REQUESTED. QUARTE'. DTSCS76
|
|
00458 10 FILLER PIC X(30) DTSCS76
|
|
00459 VALUE 'R RANGE MUST BE 1 THROUGH 4. '. DTSCS76
|
|
00460 DTSCS76
|
|
00461 05 MSG-E76G-AREA. DTSCS76
|
|
00462 10 FILLER PIC X(04) VALUE 'E76F'. DTSCS76
|
|
00463 10 FILLER PIC X(30) DTSCS76
|
|
00464 VALUE 'SSN NOT IN CLAIMANT FILE; RE-E'. DTSCS76
|
|
00465 10 FILLER PIC X(30) DTSCS76
|
|
00466 VALUE 'NTER. '. DTSCS76
|
|
00467 DTSCS76
|
|
00468 05 MSG-E76H-AREA. DTSCS76
|
|
00469 10 FILLER PIC X(04) VALUE 'E76H'. DTSCS76
|
|
00470 10 FILLER PIC X(30) DTSCS76
|
|
00471 VALUE 'MASS MAILING HAS NOT OCCURED F'. DTSCS76
|
|
00472 10 FILLER PIC X(30) DTSCS76
|
|
00473 VALUE 'OR QUARTER. FORCE PRINT? '. DTSCS76
|
|
00474 DTSCS76
|
|
00475 EJECT DTSCS76
|
|
00476 01 L001-COMM-AREA. DTSCS76
|
|
00477 ++INCLUDE DTSIL001 DTSCS76
|
|
00478 EJECT DTSCS76
|
|
00479 01 L004-COMM-AREA. DTSCS76
|
|
00480 ++INCLUDE DTSIL004 DTSCS76
|
|
00481 EJECT DTSCS76
|
|
00482 01 L006-COMM-AREA. DTSCS76
|
|
00483 ++INCLUDE DTSIL006 DTSCS76
|
|
00484 EJECT DTSCS76
|
|
00485 01 L013-COMM-AREA. DTSCS76
|
|
00486 ++INCLUDE DTSIL013 DTSCS76
|
|
00487 EJECT DTSCS76
|
|
00488 01 L015-COMM-AREA. DTSCS76
|
|
00489 ++INCLUDE DTSIL015 DTSCS76
|
|
00490 EJECT DTSCS76
|
|
00491 01 L016-COMM-AREA. DTSCS76
|
|
00492 ++INCLUDE DTSIL016 DTSCS76
|
|
00493 EJECT DTSCS76
|
|
00494 01 L018-COMM-AREA. DTSCS76
|
|
00495 ++INCLUDE DTSIL018 DTSCS76
|
|
00496 EJECT DTSCS76
|
|
00497 01 L020-COMM-AREA. DTSCS76
|
|
00498 ++INCLUDE DTSIL020 DTSCS76
|
|
00499 EJECT DTSCS76
|
|
00500 01 L081-COMM-AREA. DTSCS76
|
|
00501 ++INCLUDE DTSIL081 DTSCS76
|
|
00502 EJECT DTSCS76
|
|
00503 01 L082-COMM-AREA. DTSCS76
|
|
00504 ++INCLUDE DTSIL082 DTSCS76
|
|
00505 EJECT DTSCS76
|
|
00506 01 L111-COMM-AREA. DTSCS76
|
|
00507 ++INCLUDE DTSIL111 DTSCS76
|
|
00508 EJECT DTSCS76
|
|
00509 01 L112-COMM-AREA. DTSCS76
|
|
00510 ++INCLUDE DTSIL112 DTSCS76
|
|
00511 EJECT DTSCS76
|
|
00512 01 L381-COMM-AREA. DTSCS76
|
|
00513 ++INCLUDE DTSIL381 DTSCS76
|
|
00514 EJECT DTSCS76
|
|
00515 01 L410-COMM-AREA. DTSCS76
|
|
00516 ++INCLUDE DTSIL410 DTSCS76
|
|
00517 EJECT DTSCS76
|
|
00518 01 L415-COMM-AREA. DTSCS76
|
|
00519 ++INCLUDE DTSIL415 DTSCS76
|
|
00520 EJECT DTSCS76
|
|
00521 01 L805-COMM-AREA. DTSCS76
|
|
00522 ++INCLUDE DTSIL805 DTSCS76
|
|
00523 EJECT DTSCS76
|
|
00524 01 L810-COMM-AREA. DTSCS76
|
|
00525 05 L810-CONTROL-BLOCK. DTSCS76
|
|
00526 ++INCLUDE DTSIL810 DTSCS76
|
|
00527 EJECT DTSCS76
|
|
00528 05 MSKL-REC. DTSCS76
|
|
00529 ++INCLUDE DTSIMSKL DTSCS76
|
|
00530 EJECT DTSCS76
|
|
00531 01 MPRF-REC. DTSCS76
|
|
00532 ++INCLUDE DTSIMPRF DTSCS76
|
|
00533 EJECT DTSCS76
|
|
00534 01 MRTE-REC. DTSCS76
|
|
00535 ++INCLUDE DTSIMRTE DTSCS76
|
|
00536 EJECT DTSCS76
|
|
00537 01 MSOL-REC. DTSCS76
|
|
00538 ++INCLUDE DTSIMSOL DTSCS76
|
|
00539 EJECT DTSCS76
|
|
00540 01 MQTR-REC. DTSCS76
|
|
00541 ++INCLUDE DTSIMQTR DTSCS76
|
|
00542 EJECT DTSCS76
|
|
00543 01 MRPT-REC. DTSCS76
|
|
00544 ++INCLUDE DTSIMRPT DTSCS76
|
|
00545 EJECT DTSCS76
|
|
00546 01 MOPO-REC. DTSCS76
|
|
00547 ++INCLUDE DTSIMOPO DTSCS76
|
|
00548 EJECT DTSCS76
|
|
00549 01 MTAA-REC. DTSCS76
|
|
00550 ++INCLUDE DTSIMTAA DTSCS76
|
|
00551 EJECT DTSCS76
|
|
00552 *01 MELF-REC. DTSCS76
|
|
00553 ***INCLUDE DTSIMELF DTSCS76
|
|
00554 EJECT DTSCS76
|
|
00555 01 L851-COMM-AREA. DTSCS76
|
|
00556 ++INCLUDE DTSIL851 DTSCS76
|
|
00557 DTSCS76
|
|
00558 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS76
|
|
00559 ++INCLUDE DTSIS76 DTSCS76
|
|
00560 EJECT DTSCS76
|
|
00561 01 L825-COMM-AREA. DTSCS76
|
|
00562 05 L825-CONTROL-BLOCK. DTSCS76
|
|
00563 ++INCLUDE DTSIL825 DTSCS76
|
|
00564 DTSCS76
|
|
00565 05 RSKL-REC. DTSCS76
|
|
00566 ++INCLUDE DTSIRSK1 DTSCS76
|
|
00567 EJECT DTSCS76
|
|
00568 *01 R111-REC. DTSCS76
|
|
00569 ***INCLUDE DTSIR111 DTSCS76
|
|
00570 EJECT DTSCS76
|
|
00571 01 R112-REC. DTSCS76
|
|
00572 ++INCLUDE DTSIR112 DTSCS76
|
|
00573 EJECT DTSCS76
|
|
00574 01 R432-REC. DTSCS76
|
|
00575 ++INCLUDE DTSIR432 DTSCS76
|
|
00576 EJECT DTSCS76
|
|
00577 01 R733-REC. DTSCS76
|
|
00578 ++INCLUDE DTSIR733 DTSCS76
|
|
00579 EJECT DTSCS76
|
|
00580 01 R751-REC. DTSCS76
|
|
00581 ++INCLUDE DTSIR751 DTSCS76
|
|
00582 EJECT DTSCS76
|
|
00583 01 R901-REC. DTSCS76
|
|
00584 ++INCLUDE DTSIR901 DTSCS76
|
|
00585 EJECT DTSCS76
|
|
00586 01 R903-REC. DTSCS76
|
|
00587 ++INCLUDE DTSIR903 DTSCS76
|
|
00588 EJECT DTSCS76
|
|
00589 01 T011-REC. DTSCS76
|
|
00590 ++INCLUDE DTSIT011 DTSCS76
|
|
00591 EJECT DTSCS76
|
|
00592 01 T031-REC. DTSCS76
|
|
00593 ++INCLUDE DTSIT031 DTSCS76
|
|
00594 EJECT DTSCS76
|
|
00595 01 T036-REC. DTSCS76
|
|
00596 ++INCLUDE DTSIT036 DTSCS76
|
|
00597 EJECT DTSCS76
|
|
00598 01 CATB-LITERALS. DTSCS76
|
|
00599 ++INCLUDE DTSICATB DTSCS76
|
|
00600 DTSCS76
|
|
00601 DTSCS76
|
|
00602 DTSCS76
|
|
00603 01 CFKD-LITERALS. DTSCS76
|
|
00604 ++INCLUDE DTSICFKD DTSCS76
|
|
00605 DTSCS76
|
|
00606 DTSCS76
|
|
00607 DTSCS76
|
|
00608 01 CECD-LITERALS. DTSCS76
|
|
00609 ++INCLUDE DTSICECD DTSCS76
|
|
00610 DTSCS76
|
|
00611 DTSCS76
|
|
00612 DTSCS76
|
|
00613 01 CPCD-LITERALS. DTSCS76
|
|
00614 ++INCLUDE DTSICPCD DTSCS76
|
|
00615 EJECT DTSCS76
|
|
00616 LINKAGE SECTION. DTSCS76
|
|
00617 DTSCS76
|
|
00618 01 DFHCOMMAREA. DTSCS76
|
|
00619 ++INCLUDE DTSILCCM DTSCS76
|
|
00620 EJECT DTSCS76
|
|
00621 PROCEDURE DIVISION. DTSCS76
|
|
00622 DTSCS76
|
|
00623 MOVE +0 TO WRK-EMP-NO. DTSCS76
|
|
00624 DTSCS76
|
|
00625 SET WRK-MPRF-NONE-88 TO TRUE. DTSCS76
|
|
00626 *** SET WRK-R751-NO-88 TO TRUE. DTSCS76
|
|
00627 DTSCS76
|
|
00628 MOVE LOW-VALUES TO MAP-AREA. DTSCS76
|
|
00629 DTSCS76
|
|
00630 SET CURSOR-SET-NO TO TRUE. DTSCS76
|
|
00631 DTSCS76
|
|
00632 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS76
|
|
00633 TO SCR-ACCESS-IND. DTSCS76
|
|
00634 DTSCS76
|
|
00635 DTSCS76
|
|
00636 MOVE SPACE TO REQ-IND. DTSCS76
|
|
00637 DTSCS76
|
|
00638 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS76
|
|
00639 DTSCS76
|
|
00640 DTSCS76
|
|
00641 *----------------------------------------------------- DTSCS76
|
|
00642 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS76
|
|
00643 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS76
|
|
00644 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS76
|
|
00645 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS76
|
|
00646 * DTSCS76
|
|
00647 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS76
|
|
00648 * PROCESSED. DTSCS76
|
|
00649 * DTSCS76
|
|
00650 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS76
|
|
00651 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS76
|
|
00652 * WORK STATION OPERATOR. DTSCS76
|
|
00653 *----------------------------------------------------- DTSCS76
|
|
00654 DTSCS76
|
|
00655 MOVE SPACE TO RESP-IND. DTSCS76
|
|
00656 DTSCS76
|
|
00657 IF REQ-ERROR DTSCS76
|
|
00658 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS76
|
|
00659 ELSE DTSCS76
|
|
00660 IF REQ-JUMP DTSCS76
|
|
00661 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS76
|
|
00662 ELSE DTSCS76
|
|
00663 IF REQ-CLEAR DTSCS76
|
|
00664 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS76
|
|
00665 ELSE DTSCS76
|
|
00666 IF REQ-CURSOR-TO-GOTO DTSCS76
|
|
00667 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS76
|
|
00668 ELSE DTSCS76
|
|
00669 IF REQ-INQUIRE DTSCS76
|
|
00670 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS76
|
|
00671 ELSE DTSCS76
|
|
00672 IF REQ-EDIT DTSCS76
|
|
00673 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS76
|
|
00674 ELSE DTSCS76
|
|
00675 IF REQ-UPDATE DTSCS76
|
|
00676 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS76
|
|
00677 ELSE DTSCS76
|
|
00678 GO TO S899-ABEND. DTSCS76
|
|
00679 DTSCS76
|
|
00680 DTSCS76
|
|
00681 *----------------------------------------------------- DTSCS76
|
|
00682 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS76
|
|
00683 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS76
|
|
00684 *----------------------------------------------------- DTSCS76
|
|
00685 DTSCS76
|
|
00686 IF RESP-SEND-MAP DTSCS76
|
|
00687 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS76
|
|
00688 SET LCCM-END-TASK-88 TO TRUE DTSCS76
|
|
00689 ELSE DTSCS76
|
|
00690 IF RESP-SEND-MSGONLY DTSCS76
|
|
00691 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS76
|
|
00692 SET LCCM-END-TASK-88 TO TRUE DTSCS76
|
|
00693 ELSE DTSCS76
|
|
00694 IF RESP-JUMP DTSCS76
|
|
00695 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
00696 ELSE DTSCS76
|
|
00697 IF RESP-CURSOR-TO-GOTO DTSCS76
|
|
00698 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS76
|
|
00699 SET LCCM-END-TASK-88 TO TRUE DTSCS76
|
|
00700 ELSE DTSCS76
|
|
00701 GO TO S899-ABEND. DTSCS76
|
|
00702 DTSCS76
|
|
00703 MAINLINE-EXIT. DTSCS76
|
|
00704 DTSCS76
|
|
00705 EXEC CICS DTSCS76
|
|
00706 RETURN DTSCS76
|
|
00707 END-EXEC. DTSCS76
|
|
00708 DTSCS76
|
|
00709 GOBACK. DTSCS76
|
|
00710 EJECT DTSCS76
|
|
00711 /*****************************************************************DTSCS76
|
|
00712 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS76
|
|
00713 ******************************************************************DTSCS76
|
|
00714 DTSCS76
|
|
00715 P1000-ANALYZE-REQUEST. DTSCS76
|
|
00716 DTSCS76
|
|
00717 DTSCS76
|
|
00718 *----------------------------------------------------- DTSCS76
|
|
00719 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS76
|
|
00720 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS76
|
|
00721 * REPLACED WITH ENTER) DTSCS76
|
|
00722 *----------------------------------------------------- DTSCS76
|
|
00723 DTSCS76
|
|
00724 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS76
|
|
00725 SET LCCM-ENTER-88 TO TRUE DTSCS76
|
|
00726 SET REQ-INQUIRE TO TRUE DTSCS76
|
|
00727 IF LCCM-EMP-NO > ZERO DTSCS76
|
|
00728 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS76
|
|
00729 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS76
|
|
00730 END-IF DTSCS76
|
|
00731 GO TO P1000-EXIT. DTSCS76
|
|
00732 DTSCS76
|
|
00733 DTSCS76
|
|
00734 *----------------------------------------------------- DTSCS76
|
|
00735 * RECEIVE THE MAP DTSCS76
|
|
00736 *----------------------------------------------------- DTSCS76
|
|
00737 DTSCS76
|
|
00738 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS76
|
|
00739 DTSCS76
|
|
00740 DTSCS76
|
|
00741 *----------------------------------------------------- DTSCS76
|
|
00742 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS76
|
|
00743 * WORK STATION DTSCS76
|
|
00744 *----------------------------------------------------- DTSCS76
|
|
00745 DTSCS76
|
|
00746 IF LCCM-CLEAR-88 DTSCS76
|
|
00747 SET REQ-CLEAR TO TRUE DTSCS76
|
|
00748 GO TO P1000-EXIT. DTSCS76
|
|
00749 DTSCS76
|
|
00750 DTSCS76
|
|
00751 *----------------------------------------------------- DTSCS76
|
|
00752 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS76
|
|
00753 *----------------------------------------------------- DTSCS76
|
|
00754 DTSCS76
|
|
00755 IF LCCM-SCR-UPDATE-LOCKED DTSCS76
|
|
00756 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS76
|
|
00757 GO TO P1000-EXIT. DTSCS76
|
|
00758 DTSCS76
|
|
00759 DTSCS76
|
|
00760 *----------------------------------------------------- DTSCS76
|
|
00761 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS76
|
|
00762 *----------------------------------------------------- DTSCS76
|
|
00763 DTSCS76
|
|
00764 IF LCCM-PA2-88 DTSCS76
|
|
00765 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS76
|
|
00766 GO TO P1000-EXIT. DTSCS76
|
|
00767 DTSCS76
|
|
00768 DTSCS76
|
|
00769 *----------------------------------------------------- DTSCS76
|
|
00770 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS76
|
|
00771 *----------------------------------------------------- DTSCS76
|
|
00772 DTSCS76
|
|
00773 IF LCCM-PA-88 DTSCS76
|
|
00774 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS76
|
|
00775 SET REQ-ERROR TO TRUE DTSCS76
|
|
00776 GO TO P1000-EXIT. DTSCS76
|
|
00777 DTSCS76
|
|
00778 DTSCS76
|
|
00779 *----------------------------------------------------- DTSCS76
|
|
00780 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS76
|
|
00781 * CLEAR SCREEN DTSCS76
|
|
00782 *----------------------------------------------------- DTSCS76
|
|
00783 DTSCS76
|
|
00784 IF LCCM-F12-88 DTSCS76
|
|
00785 MOVE LOW-VALUES TO MAP-AREA DTSCS76
|
|
00786 SET REQ-CLEAR TO TRUE DTSCS76
|
|
00787 GO TO P1000-EXIT. DTSCS76
|
|
00788 DTSCS76
|
|
00789 DTSCS76
|
|
00790 *----------------------------------------------------- DTSCS76
|
|
00791 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS76
|
|
00792 *----------------------------------------------------- DTSCS76
|
|
00793 DTSCS76
|
|
00794 IF LCCM-F03-88 DTSCS76
|
|
00795 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS76
|
|
00796 SET REQ-JUMP TO TRUE DTSCS76
|
|
00797 GO TO P1000-EXIT. DTSCS76
|
|
00798 DTSCS76
|
|
00799 DTSCS76
|
|
00800 *----------------------------------------------------- DTSCS76
|
|
00801 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS76
|
|
00802 *----------------------------------------------------- DTSCS76
|
|
00803 DTSCS76
|
|
00804 IF LCCM-F04-88 DTSCS76
|
|
00805 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS76
|
|
00806 SET REQ-JUMP TO TRUE DTSCS76
|
|
00807 GO TO P1000-EXIT. DTSCS76
|
|
00808 DTSCS76
|
|
00809 DTSCS76
|
|
00810 *----------------------------------------------------- DTSCS76
|
|
00811 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS76
|
|
00812 * CORRESPONDENCE SCREEN DTSCS76
|
|
00813 *----------------------------------------------------- DTSCS76
|
|
00814 DTSCS76
|
|
00815 IF LCCM-F14-88 DTSCS76
|
|
00816 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS76
|
|
00817 SET REQ-JUMP TO TRUE DTSCS76
|
|
00818 GO TO P1000-EXIT. DTSCS76
|
|
00819 DTSCS76
|
|
00820 DTSCS76
|
|
00821 *----------------------------------------------------- DTSCS76
|
|
00822 * IF JUMP KEY PRESSED, JUMP TO THE REQUESTED SCREEN DTSCS76
|
|
00823 *----------------------------------------------------- DTSCS76
|
|
00824 DTSCS76
|
|
00825 *****IF LCCM-F17-88 DTSCS76
|
|
00826 ********MOVE '11' TO LCCM-REQ-SCR-ID DTSCS76
|
|
00827 ********SET REQ-JUMP TO TRUE DTSCS76
|
|
00828 ********GO TO P1000-EXIT. DTSCS76
|
|
00829 DTSCS76
|
|
00830 *****IF LCCM-F18-88 DTSCS76
|
|
00831 ********MOVE '12' TO LCCM-REQ-SCR-ID DTSCS76
|
|
00832 ********SET REQ-JUMP TO TRUE DTSCS76
|
|
00833 ********GO TO P1000-EXIT. DTSCS76
|
|
00834 DTSCS76
|
|
00835 *****IF LCCM-F19-88 DTSCS76
|
|
00836 ********MOVE '31' TO LCCM-REQ-SCR-ID DTSCS76
|
|
00837 ********SET REQ-JUMP TO TRUE DTSCS76
|
|
00838 ********GO TO P1000-EXIT. DTSCS76
|
|
00839 DTSCS76
|
|
00840 *****IF LCCM-F20-88 DTSCS76
|
|
00841 ********MOVE '41' TO LCCM-REQ-SCR-ID DTSCS76
|
|
00842 ********SET REQ-JUMP TO TRUE DTSCS76
|
|
00843 ********GO TO P1000-EXIT. DTSCS76
|
|
00844 DTSCS76
|
|
00845 DTSCS76
|
|
00846 *----------------------------------------------------- DTSCS76
|
|
00847 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS76
|
|
00848 * REQUESTED SCREEN TYPE DTSCS76
|
|
00849 *----------------------------------------------------- DTSCS76
|
|
00850 DTSCS76
|
|
00851 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS76
|
|
00852 NEXT SENTENCE DTSCS76
|
|
00853 ELSE DTSCS76
|
|
00854 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS76
|
|
00855 SET REQ-JUMP TO TRUE DTSCS76
|
|
00856 GO TO P1000-EXIT. DTSCS76
|
|
00857 DTSCS76
|
|
00858 DTSCS76
|
|
00859 *----------------------------------------------------- DTSCS76
|
|
00860 * IF REQUEST TO UPDATE THE DATA (ADD) DTSCS76
|
|
00861 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS76
|
|
00862 *----------------------------------------------------- DTSCS76
|
|
00863 DTSCS76
|
|
00864 IF LCCM-F09-88 DTSCS76
|
|
00865 IF SCR-ACCESS-UPDATE DTSCS76
|
|
00866 SET REQ-EDIT TO TRUE DTSCS76
|
|
00867 GO TO P1000-EXIT DTSCS76
|
|
00868 ELSE DTSCS76
|
|
00869 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS76
|
|
00870 SET REQ-ERROR TO TRUE DTSCS76
|
|
00871 GO TO P1000-EXIT. DTSCS76
|
|
00872 DTSCS76
|
|
00873 DTSCS76
|
|
00874 *----------------------------------------------------- DTSCS76
|
|
00875 * IF INQUIRY KEY IS PRESSED (ENTER), INDICATE DTSCS76
|
|
00876 * INQUIRY REQUESTED. DTSCS76
|
|
00877 *----------------------------------------------------- DTSCS76
|
|
00878 DTSCS76
|
|
00879 IF LCCM-ENTER-88 DTSCS76
|
|
00880 SET REQ-INQUIRE TO TRUE DTSCS76
|
|
00881 GO TO P1000-EXIT. DTSCS76
|
|
00882 DTSCS76
|
|
00883 DTSCS76
|
|
00884 *----------------------------------------------------- DTSCS76
|
|
00885 * ANY OTHER KEY IS INVALID DTSCS76
|
|
00886 *----------------------------------------------------- DTSCS76
|
|
00887 DTSCS76
|
|
00888 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS76
|
|
00889 DTSCS76
|
|
00890 SET REQ-ERROR TO TRUE. DTSCS76
|
|
00891 P1000-EXIT. DTSCS76
|
|
00892 EXIT. DTSCS76
|
|
00893 DTSCS76
|
|
00894 DTSCS76
|
|
00895 DTSCS76
|
|
00896 ******************************************************************DTSCS76
|
|
00897 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS76
|
|
00898 ******************************************************************DTSCS76
|
|
00899 DTSCS76
|
|
00900 P1100-UPDATE-LOCKED. DTSCS76
|
|
00901 DTSCS76
|
|
00902 *----------------------------------------------------- DTSCS76
|
|
00903 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS76
|
|
00904 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F9 DTSCS76
|
|
00905 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS76
|
|
00906 *----------------------------------------------------- DTSCS76
|
|
00907 DTSCS76
|
|
00908 IF LCCM-ENTER-88 OR LCCM-F12-88 OR LCCM-F09-88 DTSCS76
|
|
00909 SET REQ-UPDATE TO TRUE DTSCS76
|
|
00910 IF LCCM-F09-88 DTSCS76
|
|
00911 SET LCCM-ENTER-88 TO TRUE DTSCS76
|
|
00912 END-IF DTSCS76
|
|
00913 ELSE DTSCS76
|
|
00914 SET REQ-ERROR TO TRUE DTSCS76
|
|
00915 IF LCCM-SCR-ADD-LOCKED DTSCS76
|
|
00916 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS76
|
|
00917 ELSE DTSCS76
|
|
00918 GO TO S899-ABEND. DTSCS76
|
|
00919 P1100-EXIT. DTSCS76
|
|
00920 EXIT. DTSCS76
|
|
00921 /*****************************************************************DTSCS76
|
|
00922 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS76
|
|
00923 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS76
|
|
00924 ******************************************************************DTSCS76
|
|
00925 DTSCS76
|
|
00926 P2000-REQUEST-ERROR. DTSCS76
|
|
00927 IF LCCM-MSG DTSCS76
|
|
00928 SET RESP-SEND-MSGONLY TO TRUE DTSCS76
|
|
00929 ELSE DTSCS76
|
|
00930 GO TO S899-ABEND. DTSCS76
|
|
00931 P2000-EXIT. DTSCS76
|
|
00932 EXIT. DTSCS76
|
|
00933 /*****************************************************************DTSCS76
|
|
00934 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS76
|
|
00935 ******************************************************************DTSCS76
|
|
00936 DTSCS76
|
|
00937 P3000-REQUEST-JUMP. DTSCS76
|
|
00938 DTSCS76
|
|
00939 *----------------------------------------------------- DTSCS76
|
|
00940 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS76
|
|
00941 * BY USER DTSCS76
|
|
00942 *----------------------------------------------------- DTSCS76
|
|
00943 DTSCS76
|
|
00944 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS76
|
|
00945 DTSCS76
|
|
00946 DTSCS76
|
|
00947 *----------------------------------------------------- DTSCS76
|
|
00948 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS76
|
|
00949 *----------------------------------------------------- DTSCS76
|
|
00950 DTSCS76
|
|
00951 IF LCCM-MSG DTSCS76
|
|
00952 SET RESP-SEND-MSGONLY TO TRUE DTSCS76
|
|
00953 SET CURSOR-SET-GOTO TO TRUE DTSCS76
|
|
00954 GO TO P3000-EXIT. DTSCS76
|
|
00955 DTSCS76
|
|
00956 DTSCS76
|
|
00957 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS76
|
|
00958 DTSCS76
|
|
00959 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS76
|
|
00960 DTSCS76
|
|
00961 IF L018-VALID DTSCS76
|
|
00962 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS76
|
|
00963 DTSCS76
|
|
00964 DTSCS76
|
|
00965 *----------------------------------------------------- DTSCS76
|
|
00966 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS76
|
|
00967 *----------------------------------------------------- DTSCS76
|
|
00968 DTSCS76
|
|
00969 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS76
|
|
00970 LCCM-SCR-HOLD-AREA. DTSCS76
|
|
00971 DTSCS76
|
|
00972 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS76
|
|
00973 DTSCS76
|
|
00974 SET RESP-JUMP TO TRUE. DTSCS76
|
|
00975 P3000-EXIT. DTSCS76
|
|
00976 EXIT. DTSCS76
|
|
00977 /*****************************************************************DTSCS76
|
|
00978 * CLEAR KEY WAS PRESSED *DTSCS76
|
|
00979 ******************************************************************DTSCS76
|
|
00980 DTSCS76
|
|
00981 P4000-REQUEST-CLEAR. DTSCS76
|
|
00982 SET LCCM-SCR-CLEAR TO TRUE. DTSCS76
|
|
00983 DTSCS76
|
|
00984 IF SCR-ACCESS-UPDATE DTSCS76
|
|
00985 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS76
|
|
00986 ELSE DTSCS76
|
|
00987 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS76
|
|
00988 DTSCS76
|
|
00989 DTSCS76
|
|
00990 *----------------------------------------------------- DTSCS76
|
|
00991 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS76
|
|
00992 * FIELDS FROM EARLIER REQUESTS DTSCS76
|
|
00993 *----------------------------------------------------- DTSCS76
|
|
00994 DTSCS76
|
|
00995 IF LCCM-EMP-NO > ZERO DTSCS76
|
|
00996 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS76
|
|
00997 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS76
|
|
00998 DTSCS76
|
|
00999 MOVE ZERO TO LCCM-EMP-NO. DTSCS76
|
|
01000 DTSCS76
|
|
01001 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS76
|
|
01002 DTSCS76
|
|
01003 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS76
|
|
01004 DTSCS76
|
|
01005 SET RESP-SEND-MAP TO TRUE. DTSCS76
|
|
01006 P4000-EXIT. DTSCS76
|
|
01007 EXIT. DTSCS76
|
|
01008 /*****************************************************************DTSCS76
|
|
01009 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS76
|
|
01010 ******************************************************************DTSCS76
|
|
01011 DTSCS76
|
|
01012 P5000-CURSOR-TO-GOTO. DTSCS76
|
|
01013 SET CURSOR-SET-GOTO TO TRUE. DTSCS76
|
|
01014 DTSCS76
|
|
01015 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS76
|
|
01016 P5000-EXIT. DTSCS76
|
|
01017 EXIT. DTSCS76
|
|
01018 /*****************************************************************DTSCS76
|
|
01019 * INQUIRY WAS REQUESTED *DTSCS76
|
|
01020 ******************************************************************DTSCS76
|
|
01021 DTSCS76
|
|
01022 P6000-REQUEST-INQUIRE. DTSCS76
|
|
01023 SET LCCM-SCR-CLEAR TO TRUE. DTSCS76
|
|
01024 DTSCS76
|
|
01025 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS76
|
|
01026 DTSCS76
|
|
01027 SET RESP-SEND-MAP TO TRUE. DTSCS76
|
|
01028 DTSCS76
|
|
01029 IF SCR-ACCESS-UPDATE DTSCS76
|
|
01030 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS76
|
|
01031 ELSE DTSCS76
|
|
01032 PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT. DTSCS76
|
|
01033 DTSCS76
|
|
01034 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS76
|
|
01035 DTSCS76
|
|
01036 IF LCCM-MSG DTSCS76
|
|
01037 GO TO P6000-EXIT. DTSCS76
|
|
01038 DTSCS76
|
|
01039 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS76
|
|
01040 DTSCS76
|
|
01041 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS76
|
|
01042 DTSCS76
|
|
01043 MOVE LCCM-RESP-OP-ID TO MAP-RESPONSIBLE-OP-ID. DTSCS76
|
|
01044 DTSCS76
|
|
01045 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS76
|
|
01046 P6000-EXIT. DTSCS76
|
|
01047 EXIT. DTSCS76
|
|
01048 /*****************************************************************DTSCS76
|
|
01049 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED. *DTSCS76
|
|
01050 ******************************************************************DTSCS76
|
|
01051 DTSCS76
|
|
01052 P7000-REQUEST-EDIT. DTSCS76
|
|
01053 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS76
|
|
01054 DTSCS76
|
|
01055 IF LCCM-F09-88 DTSCS76
|
|
01056 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS76
|
|
01057 ELSE DTSCS76
|
|
01058 GO TO S899-ABEND. DTSCS76
|
|
01059 DTSCS76
|
|
01060 DTSCS76
|
|
01061 *------------------------------------------------------ DTSCS76
|
|
01062 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS76
|
|
01063 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST DTSCS76
|
|
01064 * REMAIN IN 'CLEAR' STATUS. DTSCS76
|
|
01065 *------------------------------------------------------ DTSCS76
|
|
01066 DTSCS76
|
|
01067 IF LCCM-MSG DTSCS76
|
|
01068 NEXT SENTENCE DTSCS76
|
|
01069 ELSE DTSCS76
|
|
01070 PERFORM S8100-SET-LOCK-ATTRB THRU S8100-EXIT DTSCS76
|
|
01071 IF LCCM-F09-88 DTSCS76
|
|
01072 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS76
|
|
01073 MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID. DTSCS76
|
|
01074 DTSCS76
|
|
01075 SET RESP-SEND-MAP TO TRUE. DTSCS76
|
|
01076 DTSCS76
|
|
01077 IF MAP-CLAIMANT-NAME GREATER SPACES DTSCS76
|
|
01078 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CLAIMANT-NAME-A. DTSCS76
|
|
01079 P7000-EXIT. DTSCS76
|
|
01080 EXIT. DTSCS76
|
|
01081 /*****************************************************************DTSCS76
|
|
01082 * ADD FUNCTION WAS REQUESTED *DTSCS76
|
|
01083 ******************************************************************DTSCS76
|
|
01084 DTSCS76
|
|
01085 P7100-EDIT-ADD. DTSCS76
|
|
01086 *----------------------------------------------------- DTSCS76
|
|
01087 * ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE DTSCS76
|
|
01088 *----------------------------------------------------- DTSCS76
|
|
01089 DTSCS76
|
|
01090 *****IF NOT LCCM-SCR-CLEAR DTSCS76
|
|
01091 ********MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS76
|
|
01092 ********GO TO P7100-EXIT. DTSCS76
|
|
01093 DTSCS76
|
|
01094 DTSCS76
|
|
01095 *----------------------------------------------------- DTSCS76
|
|
01096 * MAP-EMP-NO IS REQUIRED DTSCS76
|
|
01097 *----------------------------------------------------- DTSCS76
|
|
01098 DTSCS76
|
|
01099 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS76
|
|
01100 DTSCS76
|
|
01101 IF LCCM-MSG DTSCS76
|
|
01102 GO TO P7100-EXIT. DTSCS76
|
|
01103 DTSCS76
|
|
01104 DTSCS76
|
|
01105 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS76
|
|
01106 P7100-EXIT. DTSCS76
|
|
01107 EXIT. DTSCS76
|
|
01108 /*****************************************************************DTSCS76
|
|
01109 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS76
|
|
01110 ******************************************************************DTSCS76
|
|
01111 DTSCS76
|
|
01112 P8000-REQUEST-UPDATE. DTSCS76
|
|
01113 IF LCCM-SCR-ADD-LOCKED DTSCS76
|
|
01114 PERFORM P8100-ADD THRU P8100-EXIT DTSCS76
|
|
01115 ELSE DTSCS76
|
|
01116 GO TO S899-ABEND. DTSCS76
|
|
01117 DTSCS76
|
|
01118 SET RESP-SEND-MAP TO TRUE. DTSCS76
|
|
01119 P8000-EXIT. DTSCS76
|
|
01120 EXIT. DTSCS76
|
|
01121 /*****************************************************************DTSCS76
|
|
01122 * *DTSCS76
|
|
01123 ******************************************************************DTSCS76
|
|
01124 DTSCS76
|
|
01125 P8100-ADD. DTSCS76
|
|
01126 SET LCCM-SCR-CLEAR TO TRUE. DTSCS76
|
|
01127 DTSCS76
|
|
01128 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT. DTSCS76
|
|
01129 DTSCS76
|
|
01130 IF LCCM-F12-88 DTSCS76
|
|
01131 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS76
|
|
01132 GO TO P8100-EXIT. DTSCS76
|
|
01133 DTSCS76
|
|
01134 DTSCS76
|
|
01135 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS76
|
|
01136 DTSCS76
|
|
01137 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS76
|
|
01138 DTSCS76
|
|
01139 *****PERFORM S1200-READ-MELF THRU S1200-EXIT. DTSCS76
|
|
01140 DTSCS76
|
|
01141 MOVE ALL '?' TO WRK-MAILING-ADDRESS-AREA. DTSCS76
|
|
01142 DTSCS76
|
|
01143 IF WRK-MPRF-YES-88 DTSCS76
|
|
01144 PERFORM P8110-FORMAT-ADDR THRU P8110-EXIT DTSCS76
|
|
01145 IF LCCM-MSG DTSCS76
|
|
01146 GO TO P8100-EXIT. DTSCS76
|
|
01147 DTSCS76
|
|
01148 DTSCS76
|
|
01149 MOVE MAP-MAILING-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
01150 DTSCS76
|
|
01151 PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76
|
|
01152 DTSCS76
|
|
01153 IF L013-CNT NOT = 0 DTSCS76
|
|
01154 PERFORM P8910-R901-RECORD THRU P8910-EXIT. DTSCS76
|
|
01155 DTSCS76
|
|
01156 DTSCS76
|
|
01157 *****MOVE ALL '?' TO WRK-ELF-ADDRESS-AREA. DTSCS76
|
|
01158 *****IF WRK-MELF-YES-88 DTSCS76
|
|
01159 *********PERFORM P8210-FORMAT-ELF-ADDR THRU P8210-EXIT DTSCS76
|
|
01160 *********IF LCCM-MSG DTSCS76
|
|
01161 *************GO TO P8100-EXIT. DTSCS76
|
|
01162 DTSCS76
|
|
01163 *****MOVE MAP-ELF-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
01164 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76
|
|
01165 DTSCS76
|
|
01166 *****IF L013-CNT NOT = 0 DTSCS76
|
|
01167 *********PERFORM P8915-ELF-R901-RECORD THRU P8915-EXIT DTSCS76
|
|
01168 *****END-IF. DTSCS76
|
|
01169 DTSCS76
|
|
01170 DTSCS76
|
|
01171 MOVE MAP-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
01172 DTSCS76
|
|
01173 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
01174 DTSCS76
|
|
01175 IF L016-NO-ENTRY DTSCS76
|
|
01176 NEXT SENTENCE DTSCS76
|
|
01177 ELSE DTSCS76
|
|
01178 PERFORM P8920-T036-RECORD THRU P8920-EXIT. DTSCS76
|
|
01179 DTSCS76
|
|
01180 DTSCS76
|
|
01181 *****MOVE MAP-5E-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
01182 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
01183 *****IF L016-NO-ENTRY DTSCS76
|
|
01184 *********NEXT SENTENCE DTSCS76
|
|
01185 *****ELSE DTSCS76
|
|
01186 *********PERFORM P8925-5E-T036-RECORD THRU P8925-EXIT DTSCS76
|
|
01187 *****END-IF. DTSCS76
|
|
01188 DTSCS76
|
|
01189 *****MOVE MAP-NOTICE-OF-COVERAGE-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
01190 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76
|
|
01191 *****IF L013-CNT > +0 DTSCS76
|
|
01192 ********PERFORM P8930-R111-RECORDS THRU P8930-EXIT DTSCS76
|
|
01193 ************L013-CNT TIMES. DTSCS76
|
|
01194 DTSCS76
|
|
01195 DTSCS76
|
|
01196 IF MAP-NOTICE-OF-SUBJECT-YES DTSCS76
|
|
01197 PERFORM P8940-R112-RECORD THRU P8940-EXIT. DTSCS76
|
|
01198 DTSCS76
|
|
01199 DTSCS76
|
|
01200 IF MAP-REQUEST-FOR-FEIN-YES DTSCS76
|
|
01201 PERFORM P8950-R903-RECORD THRU P8950-EXIT. DTSCS76
|
|
01202 DTSCS76
|
|
01203 DTSCS76
|
|
01204 IF MAP-AR-AUDIT-TRAIL-YES DTSCS76
|
|
01205 PERFORM P8960-R432-RECORD THRU P8960-EXIT. DTSCS76
|
|
01206 DTSCS76
|
|
01207 DTSCS76
|
|
01208 MOVE MAP-STMT-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
01209 DTSCS76
|
|
01210 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
01211 DTSCS76
|
|
01212 IF L016-NO-ENTRY DTSCS76
|
|
01213 NEXT SENTENCE DTSCS76
|
|
01214 ELSE DTSCS76
|
|
01215 PERFORM P8970-T011-RECORD THRU P8970-EXIT. DTSCS76
|
|
01216 DTSCS76
|
|
01217 IF MAP-SSN-1 GREATER SPACES DTSCS76
|
|
01218 *** MOVE +1 TO L013-CNT DTSCS76
|
|
01219 ** SET WRK-R751-YES-88 TO TRUE DTSCS76
|
|
01220 ** PERFORM P8910-R901-RECORD THRU P8910-EXIT DTSCS76
|
|
01221 *** SET WRK-R751-NO-88 TO TRUE DTSCS76
|
|
01222 PERFORM P8980-R751-RECORD THRU P8980-EXIT. DTSCS76
|
|
01223 DTSCS76
|
|
01224 DTSCS76
|
|
01225 IF LCCM-ENTER-88 DTSCS76
|
|
01226 MOVE LOW-VALUES TO MAP-AREA DTSCS76
|
|
01227 PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT DTSCS76
|
|
01228 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS76
|
|
01229 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS76
|
|
01230 ELSE DTSCS76
|
|
01231 MOVE LOW-VALUES TO MAP-EMP-NO-1 DTSCS76
|
|
01232 MAP-EMP-NO-2 DTSCS76
|
|
01233 MAP-PRIMARY-NAME. DTSCS76
|
|
01234 DTSCS76
|
|
01235 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS76
|
|
01236 P8100-EXIT. DTSCS76
|
|
01237 EXIT. DTSCS76
|
|
01238 DTSCS76
|
|
01239 DTSCS76
|
|
01240 DTSCS76
|
|
01241 P8110-FORMAT-ADDR. DTSCS76
|
|
01242 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS76
|
|
01243 DTSCS76
|
|
01244 IF MAP-ADDR-TAD-88 DTSCS76
|
|
01245 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS76
|
|
01246 ELSE DTSCS76
|
|
01247 IF MAP-ADDR-TAX-ALT-88 DTSCS76
|
|
01248 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS76
|
|
01249 ELSE DTSCS76
|
|
01250 IF MAP-ADDR-OPO-88 DTSCS76
|
|
01251 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS76
|
|
01252 ELSE DTSCS76
|
|
01253 GO TO P8110-EXIT. DTSCS76
|
|
01254 DTSCS76
|
|
01255 IF MAP-ADDR-TAX-88 DTSCS76
|
|
01256 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS76
|
|
01257 ELSE DTSCS76
|
|
01258 IF MAP-ADDR-PHY-88 DTSCS76
|
|
01259 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS76
|
|
01260 ELSE DTSCS76
|
|
01261 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA DTSCS76
|
|
01262 PERFORM S013-ADDR-NUM THRU S013-EXIT DTSCS76
|
|
01263 IF L013-VALID DTSCS76
|
|
01264 MOVE L013-CNT TO L111-ID-NO DTSCS76
|
|
01265 ELSE DTSCS76
|
|
01266 GO TO P8110-EXIT. DTSCS76
|
|
01267 DTSCS76
|
|
01268 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS76
|
|
01269 DTSCS76
|
|
01270 IF L111-ADDR-NOT-FOUND-88 DTSCS76
|
|
01271 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS76
|
|
01272 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76
|
|
01273 GO TO P8110-EXIT. DTSCS76
|
|
01274 DTSCS76
|
|
01275 DTSCS76
|
|
01276 MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE. DTSCS76
|
|
01277 DTSCS76
|
|
01278 SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS76
|
|
01279 DTSCS76
|
|
01280 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSCS76
|
|
01281 DTSCS76
|
|
01282 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSCS76
|
|
01283 DTSCS76
|
|
01284 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS76
|
|
01285 DTSCS76
|
|
01286 DTSCS76
|
|
01287 MOVE L112-MAILING-ADDRESS TO WRK-MAILING-ADDRESS. DTSCS76
|
|
01288 DTSCS76
|
|
01289 MOVE L112-ZIP TO WRK-ZIP. DTSCS76
|
|
01290 DTSCS76
|
|
01291 *****MOVE L112-DELIV-POINT TO WRK-DELIV-POINT. DTSCS76
|
|
01292 DTSCS76
|
|
01293 *****MOVE L112-CHECK-DIGIT TO WRK-CHECK-DIGIT. DTSCS76
|
|
01294 DTSCS76
|
|
01295 MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE. DTSCS76
|
|
01296 P8110-EXIT. DTSCS76
|
|
01297 EXIT. DTSCS76
|
|
01298 DTSCS76
|
|
01299 DTSCS76
|
|
01300 DTSCS76
|
|
01301 *P8210-FORMAT-ELF-ADDR. DTSCS76
|
|
01302 **** SET L112-TAD-ADDR-88 TO TRUE. DTSCS76
|
|
01303 *****SET L112-ANCHOR-LAST-88 TO TRUE. DTSCS76
|
|
01304 *****MOVE MPRF-BUSINESS-NAME TO L112-BUSINESS-NAME. DTSCS76
|
|
01305 *****MOVE MELF-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND. DTSCS76
|
|
01306 *****MOVE SPACES TO L112-NAME DTSCS76
|
|
01307 ********************L112-TITLE. DTSCS76
|
|
01308 *****MOVE MELF-ADDRESS TO L112-ADDRESS. DTSCS76
|
|
01309 DTSCS76
|
|
01310 *****PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DTSCS76
|
|
01311 DTSCS76
|
|
01312 *****MOVE L112-MAILING-ADDRESS TO WRK-ELF-ADDRESS. DTSCS76
|
|
01313 *****MOVE L112-ZIP TO WRK-ELF-ZIP. DTSCS76
|
|
01314 *****MOVE L112-DELIV-POINT TO WRK-ELF-DELIV-POINT. DTSCS76
|
|
01315 *****MOVE L112-CHECK-DIGIT TO WRK-ELF-CHECK-DIGIT. DTSCS76
|
|
01316 *P8210-EXIT. EXIT. DTSCS76
|
|
01317 DTSCS76
|
|
01318 DTSCS76
|
|
01319 DTSCS76
|
|
01320 ***** DTSCS76
|
|
01321 * MACIR901 LABEL REPORT RECORD. DTSCS76
|
|
01322 ***** DTSCS76
|
|
01323 DTSCS76
|
|
01324 P8910-R901-RECORD. DTSCS76
|
|
01325 SET R901-ON-REQUEST-88 TO TRUE. DTSCS76
|
|
01326 DTSCS76
|
|
01327 MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS76
|
|
01328 DTSCS76
|
|
01329 MOVE L013-CNT TO R901-LABEL-CNT. DTSCS76
|
|
01330 DTSCS76
|
|
01331 *****SET R901-MAILING-LABEL TO TRUE. DTSCS76
|
|
01332 DTSCS76
|
|
01333 *** IF WRK-R751-NO-88 DTSCS76
|
|
01334 MOVE MAP-RESPONSIBLE-OP-ID TO R901-GRP1-OP-ID DTSCS76
|
|
01335 ** ELSE DTSCS76
|
|
01336 *** MOVE 'RPT751R1' TO R901-GRP1-OP-ID. DTSCS76
|
|
01337 DTSCS76
|
|
01338 MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS76
|
|
01339 R901-EMP-NO. DTSCS76
|
|
01340 DTSCS76
|
|
01341 MOVE WRK-MAILING-ADDRESS TO R901-FMT-ADDR. DTSCS76
|
|
01342 DTSCS76
|
|
01343 MOVE WRK-ZIP TO R901-ZIP. DTSCS76
|
|
01344 DTSCS76
|
|
01345 *****MOVE WRK-DELIV-POINT TO R901-DELIV-POINT. DTSCS76
|
|
01346 DTSCS76
|
|
01347 *****MOVE WRK-CHECK-DIGIT TO R901-CHECK-DIGIT. DTSCS76
|
|
01348 DTSCS76
|
|
01349 MOVE WRK-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE. DTSCS76
|
|
01350 DTSCS76
|
|
01351 DTSCS76
|
|
01352 MOVE LENGTH OF R901-REC TO R901-LENGTH. DTSCS76
|
|
01353 DTSCS76
|
|
01354 MOVE R901-REC TO RSKL-REC. DTSCS76
|
|
01355 DTSCS76
|
|
01356 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01357 P8910-EXIT. DTSCS76
|
|
01358 EXIT. DTSCS76
|
|
01359 DTSCS76
|
|
01360 DTSCS76
|
|
01361 ***** DTSCS76
|
|
01362 * MACIR901 ELF LABEL REPORT RECORD. DTSCS76
|
|
01363 ***** DTSCS76
|
|
01364 DTSCS76
|
|
01365 *P8915-ELF-R901-RECORD. DTSCS76
|
|
01366 *****SET R901-ON-REQUEST-88 TO TRUE. DTSCS76
|
|
01367 DTSCS76
|
|
01368 *****MOVE LOW-VALUES TO R901-SORT-VAR-AREA. DTSCS76
|
|
01369 DTSCS76
|
|
01370 *****MOVE L013-CNT TO R901-LABEL-CNT. DTSCS76
|
|
01371 *****MOVE MAP-RESPONSIBLE-OP-ID TO R901-GRP1-OP-ID. DTSCS76
|
|
01372 DTSCS76
|
|
01373 *****SET R901-ELF-LABEL TO TRUE. DTSCS76
|
|
01374 DTSCS76
|
|
01375 *****MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO DTSCS76
|
|
01376 ****************************************R901-EMP-NO. DTSCS76
|
|
01377 DTSCS76
|
|
01378 *****MOVE WRK-ELF-ADDRESS TO R901-FMT-ADDR. DTSCS76
|
|
01379 *****MOVE WRK-ELF-ZIP TO R901-ZIP. DTSCS76
|
|
01380 *****MOVE WRK-ELF-DELIV-POINT TO R901-DELIV-POINT. DTSCS76
|
|
01381 *****MOVE WRK-ELF-CHECK-DIGIT TO R901-CHECK-DIGIT. DTSCS76
|
|
01382 DTSCS76
|
|
01383 *****MOVE R901-REC TO RSKL-REC. DTSCS76
|
|
01384 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01385 *P8915-EXIT. DTSCS76
|
|
01386 *****EXIT. DTSCS76
|
|
01387 DTSCS76
|
|
01388 DTSCS76
|
|
01389 DTSCS76
|
|
01390 ***** DTSCS76
|
|
01391 * CREATE UC-30 TRANSACTION RECORD. DTSCS76
|
|
01392 ***** DTSCS76
|
|
01393 DTSCS76
|
|
01394 P8920-T036-RECORD. DTSCS76
|
|
01395 MOVE WRK-EMP-NO TO T036-EMP-NO. DTSCS76
|
|
01396 DTSCS76
|
|
01397 MOVE LCCM-OP-ID TO T036-OP-ID. DTSCS76
|
|
01398 DTSCS76
|
|
01399 MOVE WRK-SCR-ID TO T036-SCR-ID. DTSCS76
|
|
01400 DTSCS76
|
|
01401 MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE. DTSCS76
|
|
01402 DTSCS76
|
|
01403 MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME. DTSCS76
|
|
01404 DTSCS76
|
|
01405 SET T036-REQUEST TO TRUE. DTSCS76
|
|
01406 DTSCS76
|
|
01407 MOVE MAP-RESPONSIBLE-OP-ID TO T036-RESP-OP-ID. DTSCS76
|
|
01408 DTSCS76
|
|
01409 MOVE MAP-FORCE-PRINT TO T036-FORCE-PRINT-IND. DTSCS76
|
|
01410 DTSCS76
|
|
01411 MOVE L016-YRQ TO T036-START-YRQ. DTSCS76
|
|
01412 DTSCS76
|
|
01413 MOVE MAP-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
01414 DTSCS76
|
|
01415 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
01416 DTSCS76
|
|
01417 IF L016-VALID DTSCS76
|
|
01418 MOVE L016-YRQ TO T036-END-YRQ DTSCS76
|
|
01419 ELSE DTSCS76
|
|
01420 MOVE T036-START-YRQ TO T036-END-YRQ. DTSCS76
|
|
01421 DTSCS76
|
|
01422 MOVE +0 TO T036-WAIVER-START-YRQ DTSCS76
|
|
01423 T036-WAIVER-END-YRQ DTSCS76
|
|
01424 T036-WAIVER-EXT-DATE. DTSCS76
|
|
01425 DTSCS76
|
|
01426 MOVE MAP-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76
|
|
01427 DTSCS76
|
|
01428 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76
|
|
01429 DTSCS76
|
|
01430 IF L015-VALID DTSCS76
|
|
01431 MOVE WRK-EMP-NO TO T031-EMP-NO DTSCS76
|
|
01432 MOVE LCCM-OP-ID TO T031-ORIGIN DTSCS76
|
|
01433 MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE DTSCS76
|
|
01434 MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME DTSCS76
|
|
01435 SET T031-AUTO-PROCESS TO TRUE DTSCS76
|
|
01436 MOVE T036-START-YRQ TO T031-START-YRQ DTSCS76
|
|
01437 MOVE T036-END-YRQ TO T031-END-YRQ DTSCS76
|
|
01438 MOVE T031-START-YRQ TO T031-WAIVER-START-YRQ DTSCS76
|
|
01439 MOVE T031-END-YRQ TO T031-WAIVER-END-YRQ DTSCS76
|
|
01440 MOVE L015-DATE TO T031-WAIVER-EXT-DATE DTSCS76
|
|
01441 SET T031-TRANSFER-NO-88 TO TRUE DTSCS76
|
|
01442 MOVE +0 TO T031-TRANSFER-TO-EMP-NO DTSCS76
|
|
01443 MOVE LENGTH OF T031-REC TO T031-LENGTH DTSCS76
|
|
01444 MOVE T031-REC TO RSKL-REC DTSCS76
|
|
01445 PERFORM S825-WRITE THRU S825-EXIT DTSCS76
|
|
01446 MOVE T036-START-YRQ TO T036-WAIVER-START-YRQ DTSCS76
|
|
01447 MOVE T036-END-YRQ TO T036-WAIVER-END-YRQ DTSCS76
|
|
01448 MOVE L015-DATE TO T036-WAIVER-EXT-DATE. DTSCS76
|
|
01449 DTSCS76
|
|
01450 DTSCS76
|
|
01451 MOVE MAP-ADDR-TYPE TO T036-ADDR-TYPE. DTSCS76
|
|
01452 DTSCS76
|
|
01453 *****MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
01454 DTSCS76
|
|
01455 *****PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS76
|
|
01456 DTSCS76
|
|
01457 *****MOVE L013-CNT TO T036-ADDR-NO. DTSCS76
|
|
01458 DTSCS76
|
|
01459 *****SET T036-5E-REQ-NO-88 TO TRUE. DTSCS76
|
|
01460 DTSCS76
|
|
01461 MOVE +0 TO T036-ADDR-ESTB-ABSTIME. DTSCS76
|
|
01462 DTSCS76
|
|
01463 IF MAP-ADDR-OPO-88 OR MAP-ADDR-TAX-ALT-88 DTSCS76
|
|
01464 NEXT SENTENCE DTSCS76
|
|
01465 ELSE DTSCS76
|
|
01466 MOVE LENGTH OF T036-REC TO T036-LENGTH DTSCS76
|
|
01467 MOVE T036-REC TO RSKL-REC DTSCS76
|
|
01468 PERFORM S825-WRITE THRU S825-EXIT DTSCS76
|
|
01469 GO TO P8920-EXIT. DTSCS76
|
|
01470 DTSCS76
|
|
01471 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
01472 DTSCS76
|
|
01473 PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS76
|
|
01474 DTSCS76
|
|
01475 IF L013-VALID DTSCS76
|
|
01476 NEXT SENTENCE DTSCS76
|
|
01477 ELSE DTSCS76
|
|
01478 GO TO P8920-EXIT. DTSCS76
|
|
01479 DTSCS76
|
|
01480 IF MAP-ADDR-OPO-88 DTSCS76
|
|
01481 PERFORM P8921-OPO-ESTB-ABSTIME THRU P8921-EXIT DTSCS76
|
|
01482 ELSE DTSCS76
|
|
01483 PERFORM P8922-TAA-ESTB-ABSTIME THRU P8922-EXIT. DTSCS76
|
|
01484 DTSCS76
|
|
01485 DTSCS76
|
|
01486 MOVE LENGTH OF T036-REC TO T036-LENGTH. DTSCS76
|
|
01487 DTSCS76
|
|
01488 MOVE T036-REC TO RSKL-REC. DTSCS76
|
|
01489 DTSCS76
|
|
01490 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01491 P8920-EXIT. DTSCS76
|
|
01492 EXIT. DTSCS76
|
|
01493 DTSCS76
|
|
01494 DTSCS76
|
|
01495 DTSCS76
|
|
01496 P8921-OPO-ESTB-ABSTIME. DTSCS76
|
|
01497 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSCS76
|
|
01498 DTSCS76
|
|
01499 MOVE WRK-EMP-NO TO MOPO-EMP-NO. DTSCS76
|
|
01500 DTSCS76
|
|
01501 SET MOPO-OPO-88 TO TRUE. DTSCS76
|
|
01502 DTSCS76
|
|
01503 MOVE L013-CNT TO MOPO-ID-NO. DTSCS76
|
|
01504 DTSCS76
|
|
01505 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
01506 DTSCS76
|
|
01507 PERFORM S810-READ THRU S810-EXIT. DTSCS76
|
|
01508 DTSCS76
|
|
01509 IF L810-OK-88 DTSCS76
|
|
01510 MOVE MSKL-REC TO MOPO-REC DTSCS76
|
|
01511 MOVE MOPO-ESTB-ABSTIME TO T036-ADDR-ESTB-ABSTIME. DTSCS76
|
|
01512 P8921-EXIT. DTSCS76
|
|
01513 EXIT. DTSCS76
|
|
01514 DTSCS76
|
|
01515 DTSCS76
|
|
01516 DTSCS76
|
|
01517 P8922-TAA-ESTB-ABSTIME. DTSCS76
|
|
01518 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSCS76
|
|
01519 DTSCS76
|
|
01520 MOVE WRK-EMP-NO TO MTAA-EMP-NO. DTSCS76
|
|
01521 DTSCS76
|
|
01522 SET MTAA-TAA-88 TO TRUE. DTSCS76
|
|
01523 DTSCS76
|
|
01524 MOVE L013-CNT TO MTAA-ID-NO. DTSCS76
|
|
01525 DTSCS76
|
|
01526 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
01527 DTSCS76
|
|
01528 PERFORM S810-READ THRU S810-EXIT. DTSCS76
|
|
01529 DTSCS76
|
|
01530 IF L810-OK-88 DTSCS76
|
|
01531 MOVE MSKL-REC TO MTAA-REC DTSCS76
|
|
01532 MOVE MTAA-ESTB-ABSTIME TO T036-ADDR-ESTB-ABSTIME. DTSCS76
|
|
01533 P8922-EXIT. DTSCS76
|
|
01534 EXIT. DTSCS76
|
|
01535 DTSCS76
|
|
01536 DTSCS76
|
|
01537 DTSCS76
|
|
01538 ***** DTSCS76
|
|
01539 * CREATE UI-5E TRANSACTION RECORD. DTSCS76
|
|
01540 ***** DTSCS76
|
|
01541 DTSCS76
|
|
01542 *P8925-5E-T036-RECORD. DTSCS76
|
|
01543 *****MOVE WRK-EMP-NO TO T036-EMP-NO. DTSCS76
|
|
01544 *****MOVE LCCM-OP-ID TO T036-OP-ID. DTSCS76
|
|
01545 *****MOVE WRK-SCR-ID TO T036-SCR-ID. DTSCS76
|
|
01546 *****MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE. DTSCS76
|
|
01547 *****MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME. DTSCS76
|
|
01548 DTSCS76
|
|
01549 *****SET T036-REQUEST TO TRUE. DTSCS76
|
|
01550 DTSCS76
|
|
01551 *****MOVE MAP-RESPONSIBLE-OP-ID TO T036-RESP-OP-ID. DTSCS76
|
|
01552 *****MOVE MAP-5E-FORCE-PRINT TO T036-FORCE-PRINT-IND DTSCS76
|
|
01553 DTSCS76
|
|
01554 *****MOVE L016-YRQ TO T036-START-YRQ. DTSCS76
|
|
01555 DTSCS76
|
|
01556 *****MOVE MAP-5E-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
01557 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
01558 DTSCS76
|
|
01559 *****IF L016-VALID DTSCS76
|
|
01560 ********MOVE L016-YRQ TO T036-END-YRQ DTSCS76
|
|
01561 *****ELSE DTSCS76
|
|
01562 ********MOVE T036-START-YRQ TO T036-END-YRQ DTSCS76
|
|
01563 *****END-IF. DTSCS76
|
|
01564 DTSCS76
|
|
01565 *****MOVE +0 TO T036-WAIVE-START-YRQ DTSCS76
|
|
01566 ****************************************T036-WAIVE-END-YRQ DTSCS76
|
|
01567 ****************************************T036-WAIVE-EXT-DATE. DTSCS76
|
|
01568 DTSCS76
|
|
01569 *****MOVE MAP-5E-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76
|
|
01570 *****PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76
|
|
01571 *****IF L015-VALID DTSCS76
|
|
01572 *********MOVE WRK-EMP-NO TO T031-EMP-NO DTSCS76
|
|
01573 *********MOVE LCCM-OP-ID TO T031-ORIGIN DTSCS76
|
|
01574 *********MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE DTSCS76
|
|
01575 *********MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME DTSCS76
|
|
01576 *********SET T031-AUTO-PROCESS TO TRUE DTSCS76
|
|
01577 *********MOVE T036-START-YRQ TO T031-START-YRQ DTSCS76
|
|
01578 *********MOVE T036-END-YRQ TO T031-END-YRQ DTSCS76
|
|
01579 *********MOVE T031-START-YRQ TO T031-WAIVE-START-YRQ DTSCS76
|
|
01580 *********MOVE T031-END-YRQ TO T031-WAIVE-END-YRQ DTSCS76
|
|
01581 *********MOVE L015-DATE TO T031-WAIVE-EXT-DATE DTSCS76
|
|
01582 *********SET T031-TRANSFER-NO-88 TO TRUE DTSCS76
|
|
01583 *********MOVE +0 TO T031-TRANSFER-TO-EMP-NO DTSCS76
|
|
01584 *********MOVE T031-REC TO RSKL-REC DTSCS76
|
|
01585 *********PERFORM S825-WRITE THRU S825-EXIT DTSCS76
|
|
01586 *********MOVE T036-START-YRQ TO T036-WAIVE-START-YRQ DTSCS76
|
|
01587 *********MOVE T036-END-YRQ TO T036-WAIVE-END-YRQ DTSCS76
|
|
01588 *********MOVE L015-DATE TO T036-WAIVE-EXT-DATE. DTSCS76
|
|
01589 DTSCS76
|
|
01590 *****MOVE MAP-ADDR-TYPE TO T036-ADDR-TYPE. DTSCS76
|
|
01591 DTSCS76
|
|
01592 *****MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
01593 DTSCS76
|
|
01594 *****PERFORM S013-ADDR-NUM THRU S013-EXIT. DTSCS76
|
|
01595 DTSCS76
|
|
01596 *****MOVE L013-CNT TO T036-ADDR-NO. DTSCS76
|
|
01597 DTSCS76
|
|
01598 *****SET T036-5E-REQ-YES-88 TO TRUE. DTSCS76
|
|
01599 DTSCS76
|
|
01600 *****MOVE T036-REC TO RSKL-REC. DTSCS76
|
|
01601 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01602 *P8925-EXIT. DTSCS76
|
|
01603 *****EXIT. DTSCS76
|
|
01604 DTSCS76
|
|
01605 DTSCS76
|
|
01606 DTSCS76
|
|
01607 ***** DTSCS76
|
|
01608 * MACIR111 EMPLOYER REGISTRATION NOTIFICATION OF DTSCS76
|
|
01609 * COVERAGE REPORT RECORD. DTSCS76
|
|
01610 ***** DTSCS76
|
|
01611 DTSCS76
|
|
01612 *P8930-R111-RECORDS. DTSCS76
|
|
01613 *****MOVE MAP-RESPONSIBLE-OP-ID TO R111-OP-ID. DTSCS76
|
|
01614 *****MOVE WRK-EMP-NO TO R111-EMP-NO. DTSCS76
|
|
01615 DTSCS76
|
|
01616 *****MOVE WRK-MAILING-ADDRESS TO R111-FMT-ADDR. DTSCS76
|
|
01617 *****MOVE WRK-ZIP TO R111-ZIP. DTSCS76
|
|
01618 *****MOVE WRK-DELIV-POINT TO R111-DELIV-POINT. DTSCS76
|
|
01619 *****MOVE WRK-CHECK-DIGIT TO R111-CHECK-DIGIT. DTSCS76
|
|
01620 DTSCS76
|
|
01621 *****MOVE R111-REC TO RSKL-REC. DTSCS76
|
|
01622 *****PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01623 *P8930-EXIT. DTSCS76
|
|
01624 *****EXIT. DTSCS76
|
|
01625 DTSCS76
|
|
01626 DTSCS76
|
|
01627 DTSCS76
|
|
01628 ***** DTSCS76
|
|
01629 * MACIR112 EMPLOYER REGISTRATION NOTICE OF SUBJECTIVITY DTSCS76
|
|
01630 * (UI-47) REPORT RECORD. DTSCS76
|
|
01631 ***** DTSCS76
|
|
01632 DTSCS76
|
|
01633 P8940-R112-RECORD. DTSCS76
|
|
01634 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSCS76
|
|
01635 DTSCS76
|
|
01636 MOVE WRK-EMP-NO TO MSOL-EMP-NO. DTSCS76
|
|
01637 DTSCS76
|
|
01638 SET MSOL-SOL-88 TO TRUE. DTSCS76
|
|
01639 DTSCS76
|
|
01640 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
01641 DTSCS76
|
|
01642 PERFORM S810-COUNT THRU S810-EXIT. DTSCS76
|
|
01643 DTSCS76
|
|
01644 IF L810-RECORD-CNT = 0 DTSCS76
|
|
01645 GO TO P8940-EXIT. DTSCS76
|
|
01646 DTSCS76
|
|
01647 DTSCS76
|
|
01648 PERFORM S810-READ THRU S810-EXIT. DTSCS76
|
|
01649 DTSCS76
|
|
01650 MOVE MSKL-REC TO MSOL-REC. DTSCS76
|
|
01651 DTSCS76
|
|
01652 DTSCS76
|
|
01653 INITIALIZE R112-DATA-AREA. DTSCS76
|
|
01654 DTSCS76
|
|
01655 DTSCS76
|
|
01656 MOVE MAP-RESPONSIBLE-OP-ID TO R112-OP-ID. DTSCS76
|
|
01657 DTSCS76
|
|
01658 MOVE WRK-EMP-NO TO R112-EMP-NO. DTSCS76
|
|
01659 DTSCS76
|
|
01660 MOVE LCCM-CURR-RUN-DATE TO R112-RUN-DATE. DTSCS76
|
|
01661 DTSCS76
|
|
01662 MOVE WRK-MAILING-ADDRESS TO R112-FMT-ADDR. DTSCS76
|
|
01663 DTSCS76
|
|
01664 MOVE WRK-ZIP TO R112-ZIP. DTSCS76
|
|
01665 DTSCS76
|
|
01666 *****MOVE WRK-DELIV-POINT TO R112-DELIV-POINT. DTSCS76
|
|
01667 DTSCS76
|
|
01668 *****MOVE WRK-CHECK-DIGIT TO R112-CHECK-DIGIT. DTSCS76
|
|
01669 DTSCS76
|
|
01670 MOVE WRK-ADVANCED-BARCODE TO R112-ADVANCED-BARCODE. DTSCS76
|
|
01671 DTSCS76
|
|
01672 MOVE MSOL-FIRST-LIAB-YRQ TO R112-FIRST-LIAB-YRQ. DTSCS76
|
|
01673 DTSCS76
|
|
01674 MOVE MSOL-LAST-LIAB-YRQ TO R112-LAST-LIAB-YRQ. DTSCS76
|
|
01675 DTSCS76
|
|
01676 MOVE MPRF-EMP-CLASS TO R112-EMP-CLASS. DTSCS76
|
|
01677 DTSCS76
|
|
01678 *****MOVE MPRF-SIC-DIVISION TO R112-SIC-DIVISION. DTSCS76
|
|
01679 DTSCS76
|
|
01680 IF MPRF-CLASS-RATED-88 DTSCS76
|
|
01681 MOVE LCCM-LAST-RATE-END-YRQ TO R112-LAST-RATE-END-YRQ. DTSCS76
|
|
01682 DTSCS76
|
|
01683 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS76
|
|
01684 DTSCS76
|
|
01685 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS76
|
|
01686 DTSCS76
|
|
01687 SET MSKL-RTE-88 TO TRUE. DTSCS76
|
|
01688 DTSCS76
|
|
01689 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76
|
|
01690 DTSCS76
|
|
01691 MOVE +0 TO WRK-RATE-CTR. DTSCS76
|
|
01692 DTSCS76
|
|
01693 PERFORM P8941-RATE-AREA THRU P8941-EXIT DTSCS76
|
|
01694 UNTIL L810-NO-REC-88. DTSCS76
|
|
01695 DTSCS76
|
|
01696 MOVE WRK-RATE-CTR TO R112-RATE-CNT. DTSCS76
|
|
01697 DTSCS76
|
|
01698 MOVE LENGTH OF R112-REC TO R112-LENGTH. DTSCS76
|
|
01699 DTSCS76
|
|
01700 MOVE R112-REC TO RSKL-REC. DTSCS76
|
|
01701 DTSCS76
|
|
01702 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01703 P8940-EXIT. DTSCS76
|
|
01704 EXIT. DTSCS76
|
|
01705 DTSCS76
|
|
01706 DTSCS76
|
|
01707 DTSCS76
|
|
01708 P8941-RATE-AREA. DTSCS76
|
|
01709 ADD +1 TO WRK-RATE-CTR. DTSCS76
|
|
01710 DTSCS76
|
|
01711 IF WRK-RATE-CTR > +6 DTSCS76
|
|
01712 MOVE R112-RATE-AREA (2) TO R112-RATE-AREA (1) DTSCS76
|
|
01713 MOVE R112-RATE-AREA (3) TO R112-RATE-AREA (2) DTSCS76
|
|
01714 MOVE R112-RATE-AREA (4) TO R112-RATE-AREA (3) DTSCS76
|
|
01715 MOVE R112-RATE-AREA (5) TO R112-RATE-AREA (4) DTSCS76
|
|
01716 MOVE R112-RATE-AREA (6) TO R112-RATE-AREA (5) DTSCS76
|
|
01717 MOVE +6 TO WRK-RATE-CTR. DTSCS76
|
|
01718 DTSCS76
|
|
01719 DTSCS76
|
|
01720 MOVE MSKL-REC TO MRTE-REC. DTSCS76
|
|
01721 DTSCS76
|
|
01722 DTSCS76
|
|
01723 MOVE MRTE-EFF-YRQ TO R112-RATE-EFF-YRQ (WRK-RATE-CTR). DTSCS76
|
|
01724 DTSCS76
|
|
01725 MOVE MRTE-END-YRQ TO R112-RATE-END-YRQ (WRK-RATE-CTR). DTSCS76
|
|
01726 DTSCS76
|
|
01727 *****MOVE MRTE-UI-RATE-TYPE TO R112-UI-RATE-TYPE (WRK-RATE-CTR). DTSCS76
|
|
01728 DTSCS76
|
|
01729 MOVE MRTE-UI-RATE TO R112-UI-RATE (WRK-RATE-CTR). DTSCS76
|
|
01730 DTSCS76
|
|
01731 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS76
|
|
01732 P8941-EXIT. DTSCS76
|
|
01733 EXIT. DTSCS76
|
|
01734 DTSCS76
|
|
01735 DTSCS76
|
|
01736 DTSCS76
|
|
01737 ***** DTSCS76
|
|
01738 * MACIR903 REQUEST FOR FEDERAL ID (UI-15) REPORT RECORDS. DTSCS76
|
|
01739 ***** DTSCS76
|
|
01740 DTSCS76
|
|
01741 P8950-R903-RECORD. DTSCS76
|
|
01742 MOVE MAP-RESPONSIBLE-OP-ID TO R903-OP-ID. DTSCS76
|
|
01743 DTSCS76
|
|
01744 MOVE WRK-EMP-NO TO R903-EMP-NO. DTSCS76
|
|
01745 DTSCS76
|
|
01746 MOVE LCCM-CURR-MAIL-DATE TO R903-MAIL-DATE. DTSCS76
|
|
01747 DTSCS76
|
|
01748 MOVE WRK-MAILING-ADDRESS TO R903-FMT-ADDR. DTSCS76
|
|
01749 DTSCS76
|
|
01750 MOVE WRK-ZIP TO R903-ZIP. DTSCS76
|
|
01751 DTSCS76
|
|
01752 *****MOVE WRK-DELIV-POINT TO R903-DELIV-POINT. DTSCS76
|
|
01753 DTSCS76
|
|
01754 *****MOVE WRK-CHECK-DIGIT TO R903-CHECK-DIGIT. DTSCS76
|
|
01755 DTSCS76
|
|
01756 MOVE WRK-ADVANCED-BARCODE TO R903-ADVANCED-BARCODE. DTSCS76
|
|
01757 DTSCS76
|
|
01758 MOVE LENGTH OF R903-REC TO R903-LENGTH. DTSCS76
|
|
01759 DTSCS76
|
|
01760 MOVE R903-REC TO RSKL-REC. DTSCS76
|
|
01761 DTSCS76
|
|
01762 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01763 P8950-EXIT. DTSCS76
|
|
01764 EXIT. DTSCS76
|
|
01765 DTSCS76
|
|
01766 DTSCS76
|
|
01767 DTSCS76
|
|
01768 P8960-R432-RECORD. DTSCS76
|
|
01769 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS76
|
|
01770 DTSCS76
|
|
01771 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS76
|
|
01772 DTSCS76
|
|
01773 SET MQTR-QTR-88 TO TRUE. DTSCS76
|
|
01774 DTSCS76
|
|
01775 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
01776 DTSCS76
|
|
01777 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76
|
|
01778 DTSCS76
|
|
01779 PERFORM P8961-PROCESS-EACH-MQTR THRU P8961-EXIT DTSCS76
|
|
01780 UNTIL L810-NO-REC-88. DTSCS76
|
|
01781 P8960-EXIT. DTSCS76
|
|
01782 EXIT. DTSCS76
|
|
01783 DTSCS76
|
|
01784 DTSCS76
|
|
01785 DTSCS76
|
|
01786 P8961-PROCESS-EACH-MQTR. DTSCS76
|
|
01787 MOVE MSKL-REC TO MQTR-REC. DTSCS76
|
|
01788 DTSCS76
|
|
01789 MOVE 'N' TO BALANCE-DUE-IND. DTSCS76
|
|
01790 DTSCS76
|
|
01791 PERFORM DTSCS76
|
|
01792 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS76
|
|
01793 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS76
|
|
01794 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 DTSCS76
|
|
01795 MOVE 'Y' TO BALANCE-DUE-IND DTSCS76
|
|
01796 END-IF DTSCS76
|
|
01797 END-PERFORM. DTSCS76
|
|
01798 DTSCS76
|
|
01799 IF BALANCE-DUE-IND = 'N' DTSCS76
|
|
01800 NEXT SENTENCE DTSCS76
|
|
01801 ELSE DTSCS76
|
|
01802 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76
|
|
01803 PERFORM P8965-READ-MRPT THRU P8965-EXIT DTSCS76
|
|
01804 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSCS76
|
|
01805 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS76
|
|
01806 IF L810-NO-REC-88 DTSCS76
|
|
01807 GO TO P8961-EXIT. DTSCS76
|
|
01808 DTSCS76
|
|
01809 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS76
|
|
01810 P8961-EXIT. DTSCS76
|
|
01811 EXIT. DTSCS76
|
|
01812 DTSCS76
|
|
01813 DTSCS76
|
|
01814 DTSCS76
|
|
01815 P8965-READ-MRPT. DTSCS76
|
|
01816 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSCS76
|
|
01817 DTSCS76
|
|
01818 MOVE MQTR-EMP-NO TO MRPT-EMP-NO. DTSCS76
|
|
01819 DTSCS76
|
|
01820 SET MRPT-RPT-88 TO TRUE. DTSCS76
|
|
01821 DTSCS76
|
|
01822 MOVE MQTR-YRQ TO MRPT-YRQ. DTSCS76
|
|
01823 DTSCS76
|
|
01824 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
01825 DTSCS76
|
|
01826 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76
|
|
01827 DTSCS76
|
|
01828 PERFORM DTSCS76
|
|
01829 UNTIL L810-NO-REC-88 DTSCS76
|
|
01830 MOVE MSKL-REC TO MRPT-REC DTSCS76
|
|
01831 IF MRPT-YRQ NOT = MQTR-YRQ DTSCS76
|
|
01832 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76
|
|
01833 SET L810-NO-REC-88 TO TRUE DTSCS76
|
|
01834 ELSE DTSCS76
|
|
01835 PERFORM P8966-R432 THRU P8966-EXIT DTSCS76
|
|
01836 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS76
|
|
01837 END-IF DTSCS76
|
|
01838 END-PERFORM. DTSCS76
|
|
01839 P8965-EXIT. DTSCS76
|
|
01840 EXIT. DTSCS76
|
|
01841 DTSCS76
|
|
01842 DTSCS76
|
|
01843 DTSCS76
|
|
01844 ***** DTSCS76
|
|
01845 * MACIR432 ACCOUNTS RECEIVABLE AUDIT TRAIL REPORT RECORD. DTSCS76
|
|
01846 ***** DTSCS76
|
|
01847 DTSCS76
|
|
01848 P8966-R432. DTSCS76
|
|
01849 MOVE MRPT-BATCH-NO TO R432-BATCH-NO. DTSCS76
|
|
01850 DTSCS76
|
|
01851 MOVE MRPT-ITEM-NO TO R432-ITEM-NO. DTSCS76
|
|
01852 DTSCS76
|
|
01853 MOVE MRPT-EMP-NO TO R432-EMP-NO. DTSCS76
|
|
01854 DTSCS76
|
|
01855 MOVE MRPT-YRQ TO R432-YRQ. DTSCS76
|
|
01856 DTSCS76
|
|
01857 MOVE MRPT-RPT-TYPE TO R432-RPT-TYPE. DTSCS76
|
|
01858 DTSCS76
|
|
01859 MOVE LENGTH OF R432-REC TO R432-LENGTH. DTSCS76
|
|
01860 DTSCS76
|
|
01861 MOVE R432-REC TO RSKL-REC. DTSCS76
|
|
01862 DTSCS76
|
|
01863 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01864 P8966-EXIT. DTSCS76
|
|
01865 EXIT. DTSCS76
|
|
01866 DTSCS76
|
|
01867 DTSCS76
|
|
01868 P8970-T011-RECORD. DTSCS76
|
|
01869 MOVE WRK-EMP-NO TO T011-EMP-NO. DTSCS76
|
|
01870 DTSCS76
|
|
01871 MOVE LCCM-OP-ID TO T011-OP-ID DTSCS76
|
|
01872 T011-RESP-OP-ID. DTSCS76
|
|
01873 DTSCS76
|
|
01874 MOVE WRK-SCR-ID TO T011-SCR-ID. DTSCS76
|
|
01875 DTSCS76
|
|
01876 MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE. DTSCS76
|
|
01877 DTSCS76
|
|
01878 MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME. DTSCS76
|
|
01879 DTSCS76
|
|
01880 SET T011-STMT-OF-ACCT TO TRUE. DTSCS76
|
|
01881 DTSCS76
|
|
01882 MOVE L016-YRQ TO T011-START-YRQ. DTSCS76
|
|
01883 DTSCS76
|
|
01884 MOVE MAP-STMT-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
01885 DTSCS76
|
|
01886 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
01887 DTSCS76
|
|
01888 IF L016-VALID DTSCS76
|
|
01889 MOVE L016-YRQ TO T011-END-YRQ DTSCS76
|
|
01890 ELSE DTSCS76
|
|
01891 MOVE T011-START-YRQ TO T011-END-YRQ. DTSCS76
|
|
01892 DTSCS76
|
|
01893 MOVE LENGTH OF T011-REC TO T011-LENGTH DTSCS76
|
|
01894 MOVE +0 TO T011-ESTB-ABSTIME. DTSCS76
|
|
01895 MOVE LCCM-TASK-START-ABSTIME TO T011-ESTB-ABSTIME. DTSCS76
|
|
01896 MOVE T011-REC TO RSKL-REC DTSCS76
|
|
01897 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01898 DTSCS76
|
|
01899 DTSCS76
|
|
01900 P8970-EXIT. DTSCS76
|
|
01901 EXIT. DTSCS76
|
|
01902 DTSCS76
|
|
01903 DTSCS76
|
|
01904 DTSCS76
|
|
01905 P8980-R751-RECORD. DTSCS76
|
|
01906 MOVE WRK-EMP-NO TO R751-EMP-NO. DTSCS76
|
|
01907 MOVE MPRF-PRIMARY-NAME TO R751-EMP-PRIMARY-NAME. DTSCS76
|
|
01908 DTSCS76
|
|
01909 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS76
|
|
01910 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS76
|
|
01911 MOVE L020-SSN TO R751-SSN. DTSCS76
|
|
01912 DTSCS76
|
|
01913 MOVE MAP-CLAIMANT-NAME TO R751-CLAIMANT-NAME. DTSCS76
|
|
01914 DTSCS76
|
|
01915 MOVE LCCM-CURR-MAIL-DATE TO R751-MAIL-DATE. DTSCS76
|
|
01916 DTSCS76
|
|
01917 MOVE LENGTH OF R751-REC TO R751-LENGTH. DTSCS76
|
|
01918 DTSCS76
|
|
01919 IF MAP-WR-YRQ1-YR GREATER SPACES DTSCS76
|
|
01920 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
01921 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
01922 MOVE L016-YRQ TO R751-YRQ DTSCS76
|
|
01923 MOVE R751-REC TO RSKL-REC DTSCS76
|
|
01924 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01925 DTSCS76
|
|
01926 IF MAP-WR-YRQ2-YR GREATER SPACES DTSCS76
|
|
01927 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
01928 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
01929 MOVE L016-YRQ TO R751-YRQ DTSCS76
|
|
01930 MOVE R751-REC TO RSKL-REC DTSCS76
|
|
01931 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01932 DTSCS76
|
|
01933 IF MAP-WR-YRQ3-YR GREATER SPACES DTSCS76
|
|
01934 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
01935 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
01936 MOVE L016-YRQ TO R751-YRQ DTSCS76
|
|
01937 MOVE R751-REC TO RSKL-REC DTSCS76
|
|
01938 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01939 DTSCS76
|
|
01940 IF MAP-WR-YRQ4-YR GREATER SPACES DTSCS76
|
|
01941 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
01942 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
01943 MOVE L016-YRQ TO R751-YRQ DTSCS76
|
|
01944 MOVE R751-REC TO RSKL-REC DTSCS76
|
|
01945 PERFORM S825-WRITE THRU S825-EXIT. DTSCS76
|
|
01946 DTSCS76
|
|
01947 P8980-EXIT. DTSCS76
|
|
01948 EXIT. DTSCS76
|
|
01949 /*****************************************************************DTSCS76
|
|
01950 * LINKS TO UTILITY MODULES DTSCS76
|
|
01951 ******************************************************************DTSCS76
|
|
01952 DTSCS76
|
|
01953 S001-FROM-FED-8. DTSCS76
|
|
01954 SET L001-FROM-FED-8 TO TRUE. DTSCS76
|
|
01955 GO TO S001-LINK. DTSCS76
|
|
01956 DTSCS76
|
|
01957 S001-FROM-ABS-DAY. DTSCS76
|
|
01958 SET L001-FROM-ABS-DAY TO TRUE. DTSCS76
|
|
01959 GO TO S001-LINK. DTSCS76
|
|
01960 DTSCS76
|
|
01961 S001-LINK. DTSCS76
|
|
01962 EXEC CICS LINK DTSCS76
|
|
01963 PROGRAM ('DTSCU001') DTSCS76
|
|
01964 COMMAREA (L001-COMM-AREA) DTSCS76
|
|
01965 END-EXEC. DTSCS76
|
|
01966 S001-EXIT. DTSCS76
|
|
01967 EXIT. DTSCS76
|
|
01968 DTSCS76
|
|
01969 DTSCS76
|
|
01970 DTSCS76
|
|
01971 S004-FROM-5. DTSCS76
|
|
01972 SET L004-FROM-5 TO TRUE. DTSCS76
|
|
01973 GO TO S004-LINK. DTSCS76
|
|
01974 DTSCS76
|
|
01975 S004-FROM-DATE. DTSCS76
|
|
01976 SET L004-FROM-DATE TO TRUE. DTSCS76
|
|
01977 GO TO S004-LINK. DTSCS76
|
|
01978 DTSCS76
|
|
01979 S004-FROM-ABS. DTSCS76
|
|
01980 SET L004-FROM-ABS TO TRUE. DTSCS76
|
|
01981 GO TO S004-LINK. DTSCS76
|
|
01982 DTSCS76
|
|
01983 S004-LINK. DTSCS76
|
|
01984 EXEC CICS LINK DTSCS76
|
|
01985 PROGRAM ('DTSCU004') DTSCS76
|
|
01986 COMMAREA (L004-COMM-AREA) DTSCS76
|
|
01987 END-EXEC. DTSCS76
|
|
01988 S004-EXIT. DTSCS76
|
|
01989 EXIT. DTSCS76
|
|
01990 DTSCS76
|
|
01991 DTSCS76
|
|
01992 DTSCS76
|
|
01993 S006-LINK. DTSCS76
|
|
01994 EXEC CICS LINK DTSCS76
|
|
01995 PROGRAM ('DTSCU006') DTSCS76
|
|
01996 COMMAREA (L006-COMM-AREA) DTSCS76
|
|
01997 END-EXEC. DTSCS76
|
|
01998 S006-EXIT. DTSCS76
|
|
01999 EXIT. DTSCS76
|
|
02000 DTSCS76
|
|
02001 DTSCS76
|
|
02002 DTSCS76
|
|
02003 S013-ADDR-NUM. DTSCS76
|
|
02004 MOVE +1 TO L013-MIN-CNT. DTSCS76
|
|
02005 MOVE +999 TO L013-MAX-CNT. DTSCS76
|
|
02006 GO TO S013-COUNT-FROM-SCREEN. DTSCS76
|
|
02007 DTSCS76
|
|
02008 S013-COPY-CNT. DTSCS76
|
|
02009 MOVE +1 TO L013-MIN-CNT. DTSCS76
|
|
02010 MOVE +99 TO L013-MAX-CNT. DTSCS76
|
|
02011 GO TO S013-COUNT-FROM-SCREEN. DTSCS76
|
|
02012 DTSCS76
|
|
02013 S013-COUNT-FROM-SCREEN. DTSCS76
|
|
02014 EXEC CICS LINK DTSCS76
|
|
02015 PROGRAM('DTSCU013') DTSCS76
|
|
02016 COMMAREA(L013-COMM-AREA) DTSCS76
|
|
02017 END-EXEC. DTSCS76
|
|
02018 S013-EXIT. DTSCS76
|
|
02019 EXIT. DTSCS76
|
|
02020 DTSCS76
|
|
02021 DTSCS76
|
|
02022 DTSCS76
|
|
02023 S015-DATE-FROM-SCREEN. DTSCS76
|
|
02024 EXEC CICS LINK DTSCS76
|
|
02025 PROGRAM('DTSCU015') DTSCS76
|
|
02026 COMMAREA(L015-COMM-AREA) DTSCS76
|
|
02027 END-EXEC. DTSCS76
|
|
02028 S015-EXIT. DTSCS76
|
|
02029 EXIT. DTSCS76
|
|
02030 DTSCS76
|
|
02031 DTSCS76
|
|
02032 DTSCS76
|
|
02033 S016-YRQ-FROM-SCREEN. DTSCS76
|
|
02034 EXEC CICS LINK DTSCS76
|
|
02035 PROGRAM('DTSCU016') DTSCS76
|
|
02036 COMMAREA(L016-COMM-AREA) DTSCS76
|
|
02037 END-EXEC. DTSCS76
|
|
02038 S016-EXIT. DTSCS76
|
|
02039 EXIT. DTSCS76
|
|
02040 DTSCS76
|
|
02041 DTSCS76
|
|
02042 DTSCS76
|
|
02043 S018-EMP-NO-FROM-SCREEN. DTSCS76
|
|
02044 EXEC CICS LINK DTSCS76
|
|
02045 PROGRAM('DTSCU018') DTSCS76
|
|
02046 COMMAREA(L018-COMM-AREA) DTSCS76
|
|
02047 END-EXEC. DTSCS76
|
|
02048 S018-EXIT. DTSCS76
|
|
02049 EXIT. DTSCS76
|
|
02050 DTSCS76
|
|
02051 DTSCS76
|
|
02052 S020-SCREEN-SSN. DTSCS76
|
|
02053 EXEC CICS LINK DTSCS76
|
|
02054 PROGRAM ('DTSCU020') DTSCS76
|
|
02055 COMMAREA (L020-COMM-AREA) DTSCS76
|
|
02056 END-EXEC. DTSCS76
|
|
02057 S020-EXIT. DTSCS76
|
|
02058 EXIT. DTSCS76
|
|
02059 DTSCS76
|
|
02060 DTSCS76
|
|
02061 S081-CLAIMANT-NAME-LOOKUP. DTSCS76
|
|
02062 EXEC CICS LINK DTSCS76
|
|
02063 PROGRAM('DTSCU081') DTSCS76
|
|
02064 COMMAREA(L081-COMM-AREA) DTSCS76
|
|
02065 END-EXEC. DTSCS76
|
|
02066 DTSCS76
|
|
02067 IF L081-FILE-CLOSED DTSCS76
|
|
02068 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02069 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76
|
|
02070 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
02071 GO TO MAINLINE-EXIT. DTSCS76
|
|
02072 S081-EXIT. DTSCS76
|
|
02073 EXIT. DTSCS76
|
|
02074 SKIP3 DTSCS76
|
|
02075 DTSCS76
|
|
02076 S082-OP-ID-LOOKUP. DTSCS76
|
|
02077 EXEC CICS LINK DTSCS76
|
|
02078 PROGRAM('DTSCU082') DTSCS76
|
|
02079 COMMAREA(L082-COMM-AREA) DTSCS76
|
|
02080 END-EXEC. DTSCS76
|
|
02081 DTSCS76
|
|
02082 IF L082-FILE-CLOSED DTSCS76
|
|
02083 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02084 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76
|
|
02085 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
02086 GO TO MAINLINE-EXIT. DTSCS76
|
|
02087 S082-EXIT. DTSCS76
|
|
02088 EXIT. DTSCS76
|
|
02089 DTSCS76
|
|
02090 DTSCS76
|
|
02091 DTSCS76
|
|
02092 S111-ADDR-LOOKUP. DTSCS76
|
|
02093 EXEC CICS LINK DTSCS76
|
|
02094 PROGRAM('DTSCU111') DTSCS76
|
|
02095 COMMAREA(L111-COMM-AREA) DTSCS76
|
|
02096 END-EXEC. DTSCS76
|
|
02097 DTSCS76
|
|
02098 IF L111-FILE-CLOSED-88 DTSCS76
|
|
02099 MOVE L111-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02100 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76
|
|
02101 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
02102 GO TO MAINLINE-EXIT. DTSCS76
|
|
02103 S111-EXIT. DTSCS76
|
|
02104 EXIT. DTSCS76
|
|
02105 DTSCS76
|
|
02106 DTSCS76
|
|
02107 DTSCS76
|
|
02108 S112-ADDR-FORMAT. DTSCS76
|
|
02109 EXEC CICS LINK DTSCS76
|
|
02110 PROGRAM('DTSCU112') DTSCS76
|
|
02111 COMMAREA(L112-COMM-AREA) DTSCS76
|
|
02112 END-EXEC. DTSCS76
|
|
02113 S112-EXIT. DTSCS76
|
|
02114 EXIT. DTSCS76
|
|
02115 DTSCS76
|
|
02116 DTSCS76
|
|
02117 DTSCS76
|
|
02118 S381-DETERM-LIABILITY. DTSCS76
|
|
02119 EXEC CICS LINK DTSCS76
|
|
02120 PROGRAM ('DTSCU381') DTSCS76
|
|
02121 COMMAREA (L381-COMM-AREA) DTSCS76
|
|
02122 END-EXEC. DTSCS76
|
|
02123 DTSCS76
|
|
02124 IF L381-FILE-CLOSED-88 DTSCS76
|
|
02125 MOVE L381-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02126 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76
|
|
02127 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
02128 GO TO MAINLINE-EXIT. DTSCS76
|
|
02129 DTSCS76
|
|
02130 S381-EXIT. DTSCS76
|
|
02131 EXIT. DTSCS76
|
|
02132 DTSCS76
|
|
02133 S410-FILING-SCHEDULE. DTSCS76
|
|
02134 DTSCS76
|
|
02135 EXEC CICS LINK DTSCS76
|
|
02136 PROGRAM('DTSCU410') DTSCS76
|
|
02137 COMMAREA(L410-COMM-AREA) DTSCS76
|
|
02138 END-EXEC. DTSCS76
|
|
02139 DTSCS76
|
|
02140 S410-EXIT. DTSCS76
|
|
02141 EXIT. DTSCS76
|
|
02142 DTSCS76
|
|
02143 S415-HOUSEHOLD-DATES. DTSCS76
|
|
02144 DTSCS76
|
|
02145 EXEC CICS LINK DTSCS76
|
|
02146 PROGRAM('DTSCU415') DTSCS76
|
|
02147 COMMAREA(L415-COMM-AREA) DTSCS76
|
|
02148 END-EXEC. DTSCS76
|
|
02149 DTSCS76
|
|
02150 S415-EXIT. DTSCS76
|
|
02151 EXIT. DTSCS76
|
|
02152 DTSCS76
|
|
02153 S803-REQ-SCR-ID-EDIT. DTSCS76
|
|
02154 EXEC CICS LINK DTSCS76
|
|
02155 PROGRAM ('DTSCU803') DTSCS76
|
|
02156 COMMAREA (DFHCOMMAREA) DTSCS76
|
|
02157 END-EXEC. DTSCS76
|
|
02158 S803-EXIT. DTSCS76
|
|
02159 EXIT. DTSCS76
|
|
02160 DTSCS76
|
|
02161 DTSCS76
|
|
02162 DTSCS76
|
|
02163 S804-INVALID-KEY. DTSCS76
|
|
02164 EXEC CICS LINK DTSCS76
|
|
02165 PROGRAM ('DTSCU804') DTSCS76
|
|
02166 COMMAREA (DFHCOMMAREA) DTSCS76
|
|
02167 END-EXEC. DTSCS76
|
|
02168 S804-EXIT. DTSCS76
|
|
02169 EXIT. DTSCS76
|
|
02170 DTSCS76
|
|
02171 DTSCS76
|
|
02172 DTSCS76
|
|
02173 S805-MSG-AREA. DTSCS76
|
|
02174 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS76
|
|
02175 DTSCS76
|
|
02176 EXEC CICS LINK DTSCS76
|
|
02177 PROGRAM ('DTSCU805') DTSCS76
|
|
02178 COMMAREA (L805-COMM-AREA) DTSCS76
|
|
02179 END-EXEC. DTSCS76
|
|
02180 DTSCS76
|
|
02181 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS76
|
|
02182 S805-EXIT. DTSCS76
|
|
02183 EXIT. DTSCS76
|
|
02184 DTSCS76
|
|
02185 DTSCS76
|
|
02186 DTSCS76
|
|
02187 S810-READ. DTSCS76
|
|
02188 SET L810-READ-88 TO TRUE. DTSCS76
|
|
02189 GO TO S810-IO. DTSCS76
|
|
02190 DTSCS76
|
|
02191 S810-START-BROWSE. DTSCS76
|
|
02192 SET L810-START-BROWSE-88 TO TRUE. DTSCS76
|
|
02193 GO TO S810-IO. DTSCS76
|
|
02194 DTSCS76
|
|
02195 S810-READ-NEXT. DTSCS76
|
|
02196 SET L810-READ-NEXT-88 TO TRUE. DTSCS76
|
|
02197 GO TO S810-IO. DTSCS76
|
|
02198 DTSCS76
|
|
02199 S810-READ-PREV. DTSCS76
|
|
02200 SET L810-READ-PREV-88 TO TRUE. DTSCS76
|
|
02201 GO TO S810-IO. DTSCS76
|
|
02202 DTSCS76
|
|
02203 S810-END-BROWSE. DTSCS76
|
|
02204 SET L810-END-BROWSE-88 TO TRUE. DTSCS76
|
|
02205 GO TO S810-IO. DTSCS76
|
|
02206 DTSCS76
|
|
02207 S810-COUNT. DTSCS76
|
|
02208 SET L810-COUNT-88 TO TRUE. DTSCS76
|
|
02209 GO TO S810-IO. DTSCS76
|
|
02210 DTSCS76
|
|
02211 *S810-REWRITE. DTSCS76
|
|
02212 *****SET L810-REWRITE-88 TO TRUE. DTSCS76
|
|
02213 *****GO TO S810-IO. DTSCS76
|
|
02214 ***** DTSCS76
|
|
02215 *S810-WRITE. DTSCS76
|
|
02216 *****SET L810-WRITE-88 TO TRUE. DTSCS76
|
|
02217 *****GO TO S810-IO. DTSCS76
|
|
02218 ***** DTSCS76
|
|
02219 *S810-DELETE. DTSCS76
|
|
02220 *****SET L810-DELETE-88 TO TRUE. DTSCS76
|
|
02221 *****GO TO S810-IO. DTSCS76
|
|
02222 DTSCS76
|
|
02223 S810-IO. DTSCS76
|
|
02224 DTSCS76
|
|
02225 EXEC CICS LINK DTSCS76
|
|
02226 PROGRAM ('DTSCU810') DTSCS76
|
|
02227 COMMAREA (L810-COMM-AREA) DTSCS76
|
|
02228 END-EXEC. DTSCS76
|
|
02229 DTSCS76
|
|
02230 IF L810-FILE-CLOSED-88 DTSCS76
|
|
02231 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02232 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76
|
|
02233 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
02234 GO TO MAINLINE-EXIT. DTSCS76
|
|
02235 DTSCS76
|
|
02236 S810-EXIT. DTSCS76
|
|
02237 EXIT. DTSCS76
|
|
02238 DTSCS76
|
|
02239 DTSCS76
|
|
02240 DTSCS76
|
|
02241 S825-WRITE. DTSCS76
|
|
02242 SET L825-WRITE-88 TO TRUE. DTSCS76
|
|
02243 GO TO S825-O. DTSCS76
|
|
02244 DTSCS76
|
|
02245 S825-O. DTSCS76
|
|
02246 DTSCS76
|
|
02247 EXEC CICS LINK DTSCS76
|
|
02248 PROGRAM ('DTSCU825') DTSCS76
|
|
02249 COMMAREA (L825-COMM-AREA) DTSCS76
|
|
02250 END-EXEC. DTSCS76
|
|
02251 DTSCS76
|
|
02252 IF L825-FILE-CLOSED-88 DTSCS76
|
|
02253 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02254 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS76
|
|
02255 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS76
|
|
02256 GO TO MAINLINE-EXIT. DTSCS76
|
|
02257 S825-EXIT. DTSCS76
|
|
02258 EXIT. DTSCS76
|
|
02259 DTSCS76
|
|
02260 DTSCS76
|
|
02261 DTSCS76
|
|
02262 S851-SCREEN-PROCESSING. DTSCS76
|
|
02263 EXEC CICS LINK DTSCS76
|
|
02264 PROGRAM ('DTSCU851') DTSCS76
|
|
02265 COMMAREA (L851-COMM-AREA) DTSCS76
|
|
02266 END-EXEC. DTSCS76
|
|
02267 S851-EXIT. DTSCS76
|
|
02268 EXIT. DTSCS76
|
|
02269 DTSCS76
|
|
02270 DTSCS76
|
|
02271 DTSCS76
|
|
02272 S899-ABEND. DTSCS76
|
|
02273 EXEC CICS ABEND DTSCS76
|
|
02274 ABCODE(WRK-ABEND-CD) DTSCS76
|
|
02275 END-EXEC. DTSCS76
|
|
02276 S899-EXIT. DTSCS76
|
|
02277 EXIT. DTSCS76
|
|
02278 /*****************************************************************DTSCS76
|
|
02279 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS76
|
|
02280 ******************************************************************DTSCS76
|
|
02281 DTSCS76
|
|
02282 S1000-SCREEN-EDITS. DTSCS76
|
|
02283 *****SET WRK-5E-REQ-NO-88 TO TRUE. DTSCS76
|
|
02284 DTSCS76
|
|
02285 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS76
|
|
02286 DTSCS76
|
|
02287 IF LCCM-MSG DTSCS76
|
|
02288 GO TO S1000-EXIT. DTSCS76
|
|
02289 DTSCS76
|
|
02290 DTSCS76
|
|
02291 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS76
|
|
02292 DTSCS76
|
|
02293 DTSCS76
|
|
02294 PERFORM S1300-MAILING-LABELS THRU S1300-EXIT. DTSCS76
|
|
02295 DTSCS76
|
|
02296 *****PERFORM S1350-ELF-IND THRU S1350-EXIT. DTSCS76
|
|
02297 DTSCS76
|
|
02298 *****PERFORM S1375-ELF-LABELS THRU S1375-EXIT. DTSCS76
|
|
02299 DTSCS76
|
|
02300 PERFORM S1400-FROM-TO-YRQ THRU S1400-EXIT. DTSCS76
|
|
02301 DTSCS76
|
|
02302 PERFORM S1500-FORCE-PRINT THRU S1500-EXIT. DTSCS76
|
|
02303 DTSCS76
|
|
02304 PERFORM S1550-WAIVE-EXT-DATE THRU S1550-EXIT. DTSCS76
|
|
02305 DTSCS76
|
|
02306 *****PERFORM S1600-OL-FROM-TO-YRQ THRU S1600-EXIT. DTSCS76
|
|
02307 DTSCS76
|
|
02308 *****PERFORM S1700-OL-FORCE-PRINT THRU S1700-EXIT. DTSCS76
|
|
02309 DTSCS76
|
|
02310 *****PERFORM S1750-OL-PRINTER-ID THRU S1750-EXIT. DTSCS76
|
|
02311 DTSCS76
|
|
02312 *****PERFORM S1800-NOTICE-OF-COVERAGE THRU S1800-EXIT. DTSCS76
|
|
02313 DTSCS76
|
|
02314 PERFORM S1900-NOTICE-OF-SUBJECT THRU S1900-EXIT. DTSCS76
|
|
02315 DTSCS76
|
|
02316 PERFORM S2000-REQUEST-FOR-FEIN THRU S2000-EXIT. DTSCS76
|
|
02317 DTSCS76
|
|
02318 PERFORM S2100-ADDR-TYPE THRU S2100-EXIT. DTSCS76
|
|
02319 DTSCS76
|
|
02320 PERFORM S2200-ADDR-NBR THRU S2200-EXIT. DTSCS76
|
|
02321 DTSCS76
|
|
02322 PERFORM S2300-AR-AUDIT-TRAIL THRU S2300-EXIT. DTSCS76
|
|
02323 DTSCS76
|
|
02324 PERFORM S2400-STMT-FROM-TO-YRQ THRU S2400-EXIT. DTSCS76
|
|
02325 DTSCS76
|
|
02326 PERFORM S2500-RESPONSIBLE-OP-ID THRU S2500-EXIT. DTSCS76
|
|
02327 DTSCS76
|
|
02328 PERFORM S2600-WAGE-REQUEST THRU S2600-EXIT. DTSCS76
|
|
02329 DTSCS76
|
|
02330 IF LCCM-MSG DTSCS76
|
|
02331 GO TO S1000-EXIT. DTSCS76
|
|
02332 DTSCS76
|
|
02333 DTSCS76
|
|
02334 IF WRK-FROM-YRQ > +0 DTSCS76
|
|
02335 PERFORM S3000-RPTS-EDITS THRU S3000-EXIT. DTSCS76
|
|
02336 DTSCS76
|
|
02337 IF LCCM-MSG DTSCS76
|
|
02338 GO TO S1000-EXIT. DTSCS76
|
|
02339 DTSCS76
|
|
02340 DTSCS76
|
|
02341 IF WRK-WAIVE-EXT-DATE > +0 DTSCS76
|
|
02342 PERFORM S4000-WAIVE-EDITS THRU S4000-EXIT. DTSCS76
|
|
02343 DTSCS76
|
|
02344 IF LCCM-MSG DTSCS76
|
|
02345 GO TO S1000-EXIT. DTSCS76
|
|
02346 DTSCS76
|
|
02347 DTSCS76
|
|
02348 *****IF WRK-OL-FROM-YRQ > +0 DTSCS76
|
|
02349 *********SET WRK-OL-REQ-YES-88 TO TRUE DTSCS76
|
|
02350 *********PERFORM S3000-RPTS-EDITS THRU S3000-EXIT. DTSCS76
|
|
02351 DTSCS76
|
|
02352 *****IF LCCM-MSG DTSCS76
|
|
02353 *********GO TO S1000-EXIT. DTSCS76
|
|
02354 DTSCS76
|
|
02355 *****IF WRK-5E-WAIVE-EXT-DATE > +0 DTSCS76
|
|
02356 *********PERFORM S4500-5E-WAIVE-EDITS THRU S4500-EXIT. DTSCS76
|
|
02357 DTSCS76
|
|
02358 *****IF LCCM-MSG DTSCS76
|
|
02359 *********GO TO S1000-EXIT. DTSCS76
|
|
02360 DTSCS76
|
|
02361 DTSCS76
|
|
02362 IF MAP-MAILING-LABELS = SPACES DTSCS76
|
|
02363 ********AND MAP-ELF-IND-NO DTSCS76
|
|
02364 ********AND MAP-ELF-LABELS = SPACES DTSCS76
|
|
02365 AND WRK-FROM-YRQ = 0 DTSCS76
|
|
02366 AND WRK-TO-YRQ = 0 DTSCS76
|
|
02367 ********AND WRK-OL-FROM-YRQ = 0 DTSCS76
|
|
02368 ********AND WRK-OL-TO-YRQ = 0 DTSCS76
|
|
02369 ********AND MAP-NOTICE-OF-COVERAGE = SPACES DTSCS76
|
|
02370 AND MAP-NOTICE-OF-SUBJECT-NO DTSCS76
|
|
02371 AND MAP-REQUEST-FOR-FEIN-NO DTSCS76
|
|
02372 AND MAP-AR-AUDIT-TRAIL-NO DTSCS76
|
|
02373 AND WRK-STMT-FROM-YRQ = 0 DTSCS76
|
|
02374 AND WRK-STMT-TO-YRQ = 0 DTSCS76
|
|
02375 AND MAP-SSN-1 NOT GREATER SPACES DTSCS76
|
|
02376 MOVE MSG-E764-AREA TO LCCM-MSG-AREA. DTSCS76
|
|
02377 DTSCS76
|
|
02378 S1000-EXIT. DTSCS76
|
|
02379 EXIT. DTSCS76
|
|
02380 EJECT DTSCS76
|
|
02381 S1100-EDIT-KEY. DTSCS76
|
|
02382 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS76
|
|
02383 S1100-EXIT. DTSCS76
|
|
02384 EXIT. DTSCS76
|
|
02385 /*****************************************************************DTSCS76
|
|
02386 * DTSCS76
|
|
02387 ******************************************************************DTSCS76
|
|
02388 S1101-EMP-NO. DTSCS76
|
|
02389 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS76
|
|
02390 DTSCS76
|
|
02391 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS76
|
|
02392 DTSCS76
|
|
02393 IF L018-NO-ENTRY DTSCS76
|
|
02394 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76
|
|
02395 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS76
|
|
02396 GO TO S1101-EXIT. DTSCS76
|
|
02397 DTSCS76
|
|
02398 IF L018-NOT-VALID DTSCS76
|
|
02399 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02400 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS76
|
|
02401 GO TO S1101-EXIT. DTSCS76
|
|
02402 DTSCS76
|
|
02403 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS76
|
|
02404 S1101-EXIT. DTSCS76
|
|
02405 EXIT. DTSCS76
|
|
02406 DTSCS76
|
|
02407 DTSCS76
|
|
02408 DTSCS76
|
|
02409 S1110-READ-MPRF. DTSCS76
|
|
02410 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS76
|
|
02411 DTSCS76
|
|
02412 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS76
|
|
02413 DTSCS76
|
|
02414 SET MPRF-PRF-88 TO TRUE. DTSCS76
|
|
02415 DTSCS76
|
|
02416 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
02417 DTSCS76
|
|
02418 PERFORM S810-READ THRU S810-EXIT. DTSCS76
|
|
02419 DTSCS76
|
|
02420 IF L810-NO-REC-88 DTSCS76
|
|
02421 SET WRK-MPRF-NO-88 TO TRUE DTSCS76
|
|
02422 ELSE DTSCS76
|
|
02423 MOVE MSKL-REC TO MPRF-REC DTSCS76
|
|
02424 SET WRK-MPRF-YES-88 TO TRUE. DTSCS76
|
|
02425 S1110-EXIT. DTSCS76
|
|
02426 EXIT. DTSCS76
|
|
02427 DTSCS76
|
|
02428 DTSCS76
|
|
02429 DTSCS76
|
|
02430 S1199-ERROR. DTSCS76
|
|
02431 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS76
|
|
02432 MAP-EMP-NO-2-A. DTSCS76
|
|
02433 DTSCS76
|
|
02434 IF LCCM-NO-MSG DTSCS76
|
|
02435 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02436 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS76
|
|
02437 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02438 S1199-EXIT. DTSCS76
|
|
02439 EXIT. DTSCS76
|
|
02440 /*****************************************************************DTSCS76
|
|
02441 * DTSCS76
|
|
02442 ******************************************************************DTSCS76
|
|
02443 *S1200-READ-MELF. DTSCS76
|
|
02444 *****MOVE LOW-VALUES TO MELF-KEY-AREA. DTSCS76
|
|
02445 *****MOVE WRK-EMP-NO TO MELF-EMP-NO. DTSCS76
|
|
02446 *****SET MELF-ELF-88 TO TRUE. DTSCS76
|
|
02447 *****MOVE MELF-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
02448 DTSCS76
|
|
02449 *****PERFORM S810-READ THRU S810-EXIT. DTSCS76
|
|
02450 *****IF L810-NO-REC-88 DTSCS76
|
|
02451 *********SET WRK-MELF-NO-88 TO TRUE DTSCS76
|
|
02452 *****ELSE DTSCS76
|
|
02453 *********SET WRK-MELF-YES-88 TO TRUE DTSCS76
|
|
02454 *********MOVE MSKL-REC TO MELF-REC. DTSCS76
|
|
02455 *S1200-EXIT. EXIT. DTSCS76
|
|
02456 /*****************************************************************DTSCS76
|
|
02457 * DTSCS76
|
|
02458 ******************************************************************DTSCS76
|
|
02459 S1300-MAILING-LABELS. DTSCS76
|
|
02460 MOVE MAP-MAILING-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
02461 DTSCS76
|
|
02462 PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76
|
|
02463 DTSCS76
|
|
02464 IF L013-VALID DTSCS76
|
|
02465 IF WRK-MPRF-NO-88 DTSCS76
|
|
02466 AND L013-CNT > 0 DTSCS76
|
|
02467 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02468 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS76
|
|
02469 ELSE DTSCS76
|
|
02470 MOVE L013-CNT TO MAP-MAILING-LABELS-N DTSCS76
|
|
02471 ELSE DTSCS76
|
|
02472 IF L013-NO-ENTRY DTSCS76
|
|
02473 MOVE SPACES TO MAP-MAILING-LABELS DTSCS76
|
|
02474 ELSE DTSCS76
|
|
02475 IF L013-INVALID-NEGATIVE DTSCS76
|
|
02476 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76
|
|
02477 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS76
|
|
02478 ELSE DTSCS76
|
|
02479 IF L013-EXCEEDS-MIN-MAX DTSCS76
|
|
02480 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76
|
|
02481 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS76
|
|
02482 ELSE DTSCS76
|
|
02483 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02484 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS76
|
|
02485 S1300-EXIT. DTSCS76
|
|
02486 EXIT. DTSCS76
|
|
02487 DTSCS76
|
|
02488 DTSCS76
|
|
02489 DTSCS76
|
|
02490 S1301-ERROR. DTSCS76
|
|
02491 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAILING-LABELS-A. DTSCS76
|
|
02492 DTSCS76
|
|
02493 IF LCCM-NO-MSG DTSCS76
|
|
02494 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02495 MOVE CATB-CURSOR TO MAP-MAILING-LABELS-L DTSCS76
|
|
02496 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02497 S1301-EXIT. DTSCS76
|
|
02498 EXIT. DTSCS76
|
|
02499 /*****************************************************************DTSCS76
|
|
02500 * DTSCS76
|
|
02501 ******************************************************************DTSCS76
|
|
02502 *S1350-ELF-IND. DTSCS76
|
|
02503 *****IF MAP-ELF-IND = LOW-VALUES OR SPACES DTSCS76
|
|
02504 *********MOVE 'N' TO MAP-ELF-IND DTSCS76
|
|
02505 *****ELSE DTSCS76
|
|
02506 *********IF NOT MAP-ELF-IND-VALID DTSCS76
|
|
02507 ************MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02508 ************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76
|
|
02509 *********ELSE DTSCS76
|
|
02510 ************IF MAP-ELF-IND-YES DTSCS76
|
|
02511 ***************IF WRK-MPRF-NO-88 DTSCS76
|
|
02512 ******************MOVE EMSG-FIELD-NOT-ALLOWED STMT WRK-MSG-AREA DTSCS76
|
|
02513 ******************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76
|
|
02514 ***************ELSE DTSCS76
|
|
02515 ******************IF WRK-MELF-NO-88 DTSCS76
|
|
02516 *********************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76
|
|
02517 *********************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76
|
|
02518 ******************ELSE DTSCS76
|
|
02519 *********************IF MELF-MAIL-NOT-DELIV-88 DTSCS76
|
|
02520 *********************MOVE MSG-E76E-AREA TO WRK-MSG-AREA DTSCS76
|
|
02521 *********************PERFORM S1351-ERROR THRU S1351-EXIT. DTSCS76
|
|
02522 *S1350-EXIT. EXIT. DTSCS76
|
|
02523 DTSCS76
|
|
02524 *S1351-ERROR. DTSCS76
|
|
02525 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-IND-A. DTSCS76
|
|
02526 *****IF LCCM-NO-MSG DTSCS76
|
|
02527 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02528 ********MOVE CATB-CURSOR TO MAP-ELF-IND-L DTSCS76
|
|
02529 ********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02530 *S1351-EXIT. EXIT. DTSCS76
|
|
02531 DTSCS76
|
|
02532 *S1375-ELF-LABELS. DTSCS76
|
|
02533 *****MOVE MAP-ELF-LABELS-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
02534 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76
|
|
02535 DTSCS76
|
|
02536 *****IF L013-VALID DTSCS76
|
|
02537 *********IF L013-CNT > 0 DTSCS76
|
|
02538 ************IF WRK-MPRF-NO-88 DTSCS76
|
|
02539 ***************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02540 ***************PERFORM S1376-ERROR THRU S1376-EXIT DTSCS76
|
|
02541 ************ELSE DTSCS76
|
|
02542 ***************IF NOT MAP-ELF-IND-YES DTSCS76
|
|
02543 ******************MOVE MSG-E76C-AREA TO WRK-MSG-AREA DTSCS76
|
|
02544 ******************PERFORM S1351-ERROR THRU S1351-EXIT DTSCS76
|
|
02545 ***************ELSE DTSCS76
|
|
02546 ******************MOVE L013-CNT TO MAP-ELF-LABELS-N DTSCS76
|
|
02547 *********ELSE DTSCS76
|
|
02548 ************MOVE L013-CNT TO MAP-ELF-LABELS-N DTSCS76
|
|
02549 *****ELSE DTSCS76
|
|
02550 *****IF L013-NO-ENTRY DTSCS76
|
|
02551 ********MOVE SPACES TO MAP-ELF-LABELS DTSCS76
|
|
02552 *****ELSE DTSCS76
|
|
02553 *****IF L013-INVALID-NEGATIVE DTSCS76
|
|
02554 ********MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76
|
|
02555 ********PERFORM S1376-ERROR THRU S1376-EXIT DTSCS76
|
|
02556 *****ELSE DTSCS76
|
|
02557 *****IF L013-EXCEEDS-MIN-MAX DTSCS76
|
|
02558 *********MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76
|
|
02559 *********PERFORM S1376-ERROR THRU S1376-EXIT DTSCS76
|
|
02560 *****ELSE DTSCS76
|
|
02561 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02562 *********PERFORM S1376-ERROR THRU S1376-EXIT. DTSCS76
|
|
02563 *S1375-EXIT. EXIT. DTSCS76
|
|
02564 DTSCS76
|
|
02565 *S1376-ERROR. DTSCS76
|
|
02566 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ELF-LABELS-A. DTSCS76
|
|
02567 *****IF LCCM-NO-MSG DTSCS76
|
|
02568 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02569 ********MOVE CATB-CURSOR TO MAP-ELF-LABELS-L DTSCS76
|
|
02570 ********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02571 *S1376-EXIT. EXIT. DTSCS76
|
|
02572 /*****************************************************************DTSCS76
|
|
02573 * DTSCS76
|
|
02574 ******************************************************************DTSCS76
|
|
02575 S1400-FROM-TO-YRQ. DTSCS76
|
|
02576 MOVE +0 TO WRK-FROM-YRQ DTSCS76
|
|
02577 WRK-TO-YRQ. DTSCS76
|
|
02578 DTSCS76
|
|
02579 DTSCS76
|
|
02580 MOVE MAP-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
02581 DTSCS76
|
|
02582 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
02583 DTSCS76
|
|
02584 IF L016-NO-ENTRY DTSCS76
|
|
02585 NEXT SENTENCE DTSCS76
|
|
02586 ELSE DTSCS76
|
|
02587 IF L016-NOT-VALID DTSCS76
|
|
02588 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02589 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
02590 ELSE DTSCS76
|
|
02591 IF WRK-MPRF-NO-88 DTSCS76
|
|
02592 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02593 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
02594 ELSE DTSCS76
|
|
02595 MOVE L016-YRQ TO WRK-FROM-YRQ. DTSCS76
|
|
02596 DTSCS76
|
|
02597 DTSCS76
|
|
02598 MOVE MAP-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
02599 DTSCS76
|
|
02600 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
02601 DTSCS76
|
|
02602 IF L016-NO-ENTRY DTSCS76
|
|
02603 MOVE WRK-FROM-YRQ TO WRK-TO-YRQ DTSCS76
|
|
02604 ELSE DTSCS76
|
|
02605 IF L016-NOT-VALID DTSCS76
|
|
02606 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02607 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76
|
|
02608 GO TO S1400-EXIT DTSCS76
|
|
02609 ELSE DTSCS76
|
|
02610 IF WRK-MPRF-NO-88 DTSCS76
|
|
02611 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02612 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76
|
|
02613 GO TO S1400-EXIT DTSCS76
|
|
02614 ELSE DTSCS76
|
|
02615 MOVE L016-YRQ TO WRK-TO-YRQ. DTSCS76
|
|
02616 DTSCS76
|
|
02617 DTSCS76
|
|
02618 IF WRK-TO-YRQ < WRK-FROM-YRQ DTSCS76
|
|
02619 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
02620 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
02621 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76
|
|
02622 GO TO S1400-EXIT. DTSCS76
|
|
02623 DTSCS76
|
|
02624 DTSCS76
|
|
02625 IF WRK-FROM-YRQ = +0 DTSCS76
|
|
02626 IF WRK-TO-YRQ > +0 DTSCS76
|
|
02627 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
02628 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
02629 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76
|
|
02630 GO TO S1400-EXIT. DTSCS76
|
|
02631 S1400-EXIT. DTSCS76
|
|
02632 EXIT. DTSCS76
|
|
02633 DTSCS76
|
|
02634 DTSCS76
|
|
02635 DTSCS76
|
|
02636 S1401-ERROR. DTSCS76
|
|
02637 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FROM-YRQ-YR-A. DTSCS76
|
|
02638 DTSCS76
|
|
02639 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FROM-YRQ-Q-A. DTSCS76
|
|
02640 DTSCS76
|
|
02641 IF LCCM-NO-MSG DTSCS76
|
|
02642 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02643 MOVE CATB-CURSOR TO MAP-FROM-YRQ-YR-L DTSCS76
|
|
02644 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02645 S1401-EXIT. DTSCS76
|
|
02646 EXIT. DTSCS76
|
|
02647 DTSCS76
|
|
02648 S1402-ERROR. DTSCS76
|
|
02649 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TO-YRQ-YR-A. DTSCS76
|
|
02650 DTSCS76
|
|
02651 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TO-YRQ-Q-A. DTSCS76
|
|
02652 DTSCS76
|
|
02653 IF LCCM-NO-MSG DTSCS76
|
|
02654 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02655 MOVE CATB-CURSOR TO MAP-TO-YRQ-YR-L DTSCS76
|
|
02656 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02657 S1402-EXIT. DTSCS76
|
|
02658 EXIT. DTSCS76
|
|
02659 /*****************************************************************DTSCS76
|
|
02660 * DTSCS76
|
|
02661 ******************************************************************DTSCS76
|
|
02662 S1500-FORCE-PRINT. DTSCS76
|
|
02663 IF MAP-FORCE-PRINT = LOW-VALUES OR SPACES DTSCS76
|
|
02664 MOVE 'N' TO MAP-FORCE-PRINT DTSCS76
|
|
02665 ELSE DTSCS76
|
|
02666 IF NOT MAP-FORCE-PRINT-VALID DTSCS76
|
|
02667 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02668 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS76
|
|
02669 ELSE DTSCS76
|
|
02670 IF WRK-MPRF-NO-88 DTSCS76
|
|
02671 AND MAP-FORCE-PRINT-YES DTSCS76
|
|
02672 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02673 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS76
|
|
02674 S1500-EXIT. DTSCS76
|
|
02675 EXIT. DTSCS76
|
|
02676 DTSCS76
|
|
02677 DTSCS76
|
|
02678 DTSCS76
|
|
02679 S1501-ERROR. DTSCS76
|
|
02680 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FORCE-PRINT-A. DTSCS76
|
|
02681 DTSCS76
|
|
02682 IF LCCM-NO-MSG DTSCS76
|
|
02683 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02684 MOVE CATB-CURSOR TO MAP-FORCE-PRINT-L DTSCS76
|
|
02685 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02686 S1501-EXIT. DTSCS76
|
|
02687 EXIT. DTSCS76
|
|
02688 /*****************************************************************DTSCS76
|
|
02689 * DTSCS76
|
|
02690 ******************************************************************DTSCS76
|
|
02691 S1550-WAIVE-EXT-DATE. DTSCS76
|
|
02692 MOVE +0 TO WRK-WAIVE-EXT-DATE. DTSCS76
|
|
02693 DTSCS76
|
|
02694 DTSCS76
|
|
02695 MOVE MAP-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76
|
|
02696 DTSCS76
|
|
02697 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76
|
|
02698 DTSCS76
|
|
02699 IF L015-NO-ENTRY DTSCS76
|
|
02700 NEXT SENTENCE DTSCS76
|
|
02701 ELSE DTSCS76
|
|
02702 IF L015-NOT-VALID DTSCS76
|
|
02703 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02704 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76
|
|
02705 ELSE DTSCS76
|
|
02706 IF WRK-MPRF-NO-88 DTSCS76
|
|
02707 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02708 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76
|
|
02709 ELSE DTSCS76
|
|
02710 MOVE L015-DATE TO WRK-WAIVE-EXT-DATE. DTSCS76
|
|
02711 S1550-EXIT. DTSCS76
|
|
02712 EXIT. DTSCS76
|
|
02713 DTSCS76
|
|
02714 DTSCS76
|
|
02715 DTSCS76
|
|
02716 S1551-ERROR. DTSCS76
|
|
02717 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS76
|
|
02718 TO MAP-WAIVE-EXT-MO-A DTSCS76
|
|
02719 MAP-WAIVE-EXT-DA-A DTSCS76
|
|
02720 MAP-WAIVE-EXT-YR-A. DTSCS76
|
|
02721 DTSCS76
|
|
02722 IF LCCM-NO-MSG DTSCS76
|
|
02723 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02724 MOVE CATB-CURSOR TO MAP-WAIVE-EXT-MO-L DTSCS76
|
|
02725 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02726 S1551-EXIT. DTSCS76
|
|
02727 EXIT. DTSCS76
|
|
02728 /*****************************************************************DTSCS76
|
|
02729 * DTSCS76
|
|
02730 ******************************************************************DTSCS76
|
|
02731 *S1600-OL-FROM-TO-YRQ. DTSCS76
|
|
02732 *****MOVE +0 TO WRK-OL-FROM-YRQ DTSCS76
|
|
02733 ****************WRK-OL-TO-YRQ. DTSCS76
|
|
02734 DTSCS76
|
|
02735 *****MOVE MAP-OL-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
02736 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
02737 *****IF L016-NO-ENTRY DTSCS76
|
|
02738 ********NEXT SENTENCE DTSCS76
|
|
02739 *****ELSE DTSCS76
|
|
02740 *****IF L016-NOT-VALID DTSCS76
|
|
02741 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02742 ********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02743 *****ELSE DTSCS76
|
|
02744 ********IF WRK-MPRF-NO-88 DTSCS76
|
|
02745 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02746 ***********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02747 ********ELSE DTSCS76
|
|
02748 ************IF WRK-MELF-NO-88 DTSCS76
|
|
02749 ***************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76
|
|
02750 ***************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02751 ************ELSE DTSCS76
|
|
02752 ***************IF MELF-TAX-RPT-NO-88 DTSCS76
|
|
02753 ******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76
|
|
02754 ******************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02755 ***************ELSE DTSCS76
|
|
02756 ******************MOVE L016-YRQ TO WRK-OL-FROM-YRQ. DTSCS76
|
|
02757 DTSCS76
|
|
02758 *****MOVE MAP-OL-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
02759 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
02760 *****IF L016-NO-ENTRY DTSCS76
|
|
02761 ********MOVE WRK-OL-FROM-YRQ TO WRK-OL-TO-YRQ DTSCS76
|
|
02762 *****ELSE DTSCS76
|
|
02763 *****IF L016-NOT-VALID DTSCS76
|
|
02764 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02765 ********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
02766 ********GO TO S1600-EXIT DTSCS76
|
|
02767 *****ELSE DTSCS76
|
|
02768 ********IF WRK-MPRF-NO-88 DTSCS76
|
|
02769 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02770 ***********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
02771 ***********GO TO S1600-EXIT DTSCS76
|
|
02772 ********ELSE DTSCS76
|
|
02773 ************IF WRK-MELF-NO-88 DTSCS76
|
|
02774 ***************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76
|
|
02775 ***************PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
02776 ***************GO TO S1600-EXIT DTSCS76
|
|
02777 ************ELSE DTSCS76
|
|
02778 ***************IF MELF-TAX-RPT-NO-88 DTSCS76
|
|
02779 ******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76
|
|
02780 ******************PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
02781 ******************GO TO S1600-EXIT DTSCS76
|
|
02782 ***************ELSE DTSCS76
|
|
02783 ******************MOVE L016-YRQ TO WRK-OL-TO-YRQ. DTSCS76
|
|
02784 DTSCS76
|
|
02785 *****IF WRK-OL-TO-YRQ < WRK-OL-FROM-YRQ DTSCS76
|
|
02786 ********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
02787 ********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02788 ********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
02789 ********GO TO S1600-EXIT. DTSCS76
|
|
02790 DTSCS76
|
|
02791 *****IF WRK-5E-FROM-YRQ = +0 DTSCS76
|
|
02792 *********IF WRK-5E-TO-YRQ > +0 DTSCS76
|
|
02793 *************MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
02794 *************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02795 *************PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
02796 *************GO TO S1600-EXIT. DTSCS76
|
|
02797 DTSCS76
|
|
02798 *****IF (WRK-FROM-YRQ = +0) AND (WRK-TO-YRQ = +0) DTSCS76
|
|
02799 *********GO TO S1600-EXIT DTSCS76
|
|
02800 *****ELSE DTSCS76
|
|
02801 *********IF (WRK-TO-YRQ < WRK-5E-FROM-YRQ) DTSCS76
|
|
02802 ************************OR DTSCS76
|
|
02803 ************(WRK-5E-TO-YRQ < WRK-FROM-YRQ) DTSCS76
|
|
02804 *************GO TO S1600-EXIT DTSCS76
|
|
02805 *********ELSE DTSCS76
|
|
02806 *************MOVE MSG-E76D-AREA TO WRK-MSG-AREA DTSCS76
|
|
02807 *************PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
02808 *************PERFORM S1602-ERROR THRU S1602-EXIT. DTSCS76
|
|
02809 *S1600-EXIT. EXIT. DTSCS76
|
|
02810 DTSCS76
|
|
02811 *S1601-ERROR. DTSCS76
|
|
02812 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-FROM-YRQ-YR-A. DTSCS76
|
|
02813 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-FROM-YRQ-Q-A. DTSCS76
|
|
02814 *****IF LCCM-NO-MSG DTSCS76
|
|
02815 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02816 ********MOVE CATB-CURSOR TO MAP-5E-FROM-YRQ-YR-L DTSCS76
|
|
02817 ********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02818 *S1601-EXIT. EXIT. DTSCS76
|
|
02819 DTSCS76
|
|
02820 *S1602-ERROR. DTSCS76
|
|
02821 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-TO-YRQ-YR-A. DTSCS76
|
|
02822 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-TO-YRQ-Q-A. DTSCS76
|
|
02823 *****IF LCCM-NO-MSG DTSCS76
|
|
02824 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02825 ********MOVE CATB-CURSOR TO MAP-5E-TO-YRQ-YR-L DTSCS76
|
|
02826 ********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02827 *S1602-EXIT. EXIT. DTSCS76
|
|
02828 /*****************************************************************DTSCS76
|
|
02829 * DTSCS76
|
|
02830 ******************************************************************DTSCS76
|
|
02831 *S1700-5E-FORCE-PRINT. DTSCS76
|
|
02832 *****IF MAP-5E-FORCE-PRINT = LOW-VALUES OR SPACES DTSCS76
|
|
02833 ********MOVE 'N' TO MAP-5E-FORCE-PRINT DTSCS76
|
|
02834 *****ELSE DTSCS76
|
|
02835 *****IF NOT MAP-5E-FORCE-PRINT-VALID DTSCS76
|
|
02836 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02837 ********PERFORM S1701-ERROR THRU S1701-EXIT DTSCS76
|
|
02838 *****ELSE DTSCS76
|
|
02839 ********IF MAP-5E-FORCE-PRINT-YES DTSCS76
|
|
02840 ***********IF WRK-MPRF-NO-88 DTSCS76
|
|
02841 **************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02842 **************PERFORM S1701-ERROR THRU S1701-EXIT DTSCS76
|
|
02843 ***********ELSE DTSCS76
|
|
02844 **************IF WRK-MELF-NO-88 DTSCS76
|
|
02845 *****************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76
|
|
02846 *****************PERFORM S1701-ERROR THRU S1701-EXIT DTSCS76
|
|
02847 **************ELSE DTSCS76
|
|
02848 *****************IF MELF-TAX-RPT-NO-88 DTSCS76
|
|
02849 ******************* MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76
|
|
02850 ********************PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS76
|
|
02851 *S1700-EXIT. EXIT. DTSCS76
|
|
02852 DTSCS76
|
|
02853 *S1701-ERROR. DTSCS76
|
|
02854 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-5E-FORCE-PRINT-A. DTSCS76
|
|
02855 *****IF LCCM-NO-MSG DTSCS76
|
|
02856 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02857 ********MOVE CATB-CURSOR TO MAP-5E-FORCE-PRINT-L DTSCS76
|
|
02858 ********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02859 *S1701-EXIT. EXIT. DTSCS76
|
|
02860 /*****************************************************************DTSCS76
|
|
02861 * DTSCS76
|
|
02862 ******************************************************************DTSCS76
|
|
02863 *S1750-5E-WAIVE-EXT-DATE. DTSCS76
|
|
02864 *****MOVE +0 TO WRK-5E-WAIVE-EXT-DATE. DTSCS76
|
|
02865 DTSCS76
|
|
02866 *****MOVE MAP-5E-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA. DTSCS76
|
|
02867 *****PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS76
|
|
02868 *****IF L015-NO-ENTRY DTSCS76
|
|
02869 *********NEXT SENTENCE DTSCS76
|
|
02870 *****ELSE DTSCS76
|
|
02871 *****IF L015-NOT-VALID DTSCS76
|
|
02872 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02873 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
02874 *****ELSE DTSCS76
|
|
02875 *********IF WRK-MPRF-NO-88 DTSCS76
|
|
02876 *************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02877 *************PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
02878 *********ELSE DTSCS76
|
|
02879 *************IF WRK-MELF-NO-88 DTSCS76
|
|
02880 ****************MOVE MSG-E76A-AREA TO WRK-MSG-AREA DTSCS76
|
|
02881 ****************PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
02882 *************ELSE DTSCS76
|
|
02883 ****************IF MELF-TAX-RPT-NO-88 DTSCS76
|
|
02884 *******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA DTSCS76
|
|
02885 *******************PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
02886 ****************ELSE DTSCS76
|
|
02887 *******************MOVE L015-DATE TO WRK-5E-WAIVE-EXT-DATE. DTSCS76
|
|
02888 *S1750-EXIT. DTSCS76
|
|
02889 *****EXIT. DTSCS76
|
|
02890 DTSCS76
|
|
02891 *S1751-ERROR. DTSCS76
|
|
02892 *****MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS76
|
|
02893 *******TO MAP-5E-WAIVE-EXT-MO-A DTSCS76
|
|
02894 **********MAP-5E-WAIVE-EXT-DA-A DTSCS76
|
|
02895 **********MAP-5E-WAIVE-EXT-YR-A. DTSCS76
|
|
02896 DTSCS76
|
|
02897 *****IF LCCM-NO-MSG DTSCS76
|
|
02898 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02899 *********MOVE CATB-CURSOR TO MAP-5E-WAIVE-EXT-MO-L DTSCS76
|
|
02900 *********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02901 *S1751-EXIT. DTSCS76
|
|
02902 *****EXIT. DTSCS76
|
|
02903 /*****************************************************************DTSCS76
|
|
02904 * DTSCS76
|
|
02905 ******************************************************************DTSCS76
|
|
02906 *S1800-NOTICE-OF-COVERAGE. DTSCS76
|
|
02907 *****MOVE MAP-NOTICE-OF-COVERAGE-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
02908 *****PERFORM S013-COPY-CNT THRU S013-EXIT. DTSCS76
|
|
02909 DTSCS76
|
|
02910 *****IF L013-VALID DTSCS76
|
|
02911 ********IF WRK-MPRF-NO-88 DTSCS76
|
|
02912 ********AND L013-CNT > 0 DTSCS76
|
|
02913 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02914 ***********PERFORM S1801-ERROR THRU S1801-EXIT DTSCS76
|
|
02915 ********ELSE DTSCS76
|
|
02916 ***********MOVE L013-CNT TO MAP-NOTICE-OF-COVERAGE-N DTSCS76
|
|
02917 ***********PERFORM S1810-ACTIVE-EDIT THRU S1810-EXIT DTSCS76
|
|
02918 *****ELSE DTSCS76
|
|
02919 *****IF L013-NO-ENTRY DTSCS76
|
|
02920 ********MOVE SPACES TO MAP-NOTICE-OF-COVERAGE DTSCS76
|
|
02921 *****ELSE DTSCS76
|
|
02922 *****IF L013-INVALID-NEGATIVE DTSCS76
|
|
02923 ********MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76
|
|
02924 ********PERFORM S1801-ERROR THRU S1801-EXIT DTSCS76
|
|
02925 *****ELSE DTSCS76
|
|
02926 *****IF L013-EXCEEDS-MIN-MAX DTSCS76
|
|
02927 *********MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76
|
|
02928 *********PERFORM S1801-ERROR THRU S1801-EXIT DTSCS76
|
|
02929 *****ELSE DTSCS76
|
|
02930 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02931 *********PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS76
|
|
02932 *S1800-EXIT. EXIT. DTSCS76
|
|
02933 DTSCS76
|
|
02934 *S1801-ERROR. DTSCS76
|
|
02935 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-NOTICE-OF-COVERAGE-A. DTSCS76
|
|
02936 *****IF LCCM-NO-MSG DTSCS76
|
|
02937 ********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02938 ********MOVE CATB-CURSOR TO MAP-NOTICE-OF-COVERAGE-L DTSCS76
|
|
02939 ********SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02940 *S1801-EXIT. EXIT. DTSCS76
|
|
02941 DTSCS76
|
|
02942 *S1810-ACTIVE-EDIT. DTSCS76
|
|
02943 *****IF (WRK-MPRF-NO-88) DTSCS76
|
|
02944 *************OR DTSCS76
|
|
02945 ********(L013-CNT = +0) DTSCS76
|
|
02946 *********GO TO S1810-EXIT. DTSCS76
|
|
02947 DTSCS76
|
|
02948 *****IF MPRF-STATUS-ACT-88 DTSCS76
|
|
02949 *********NEXT SENTENCE DTSCS76
|
|
02950 *****ELSE DTSCS76
|
|
02951 *********MOVE MSG-E767-AREA TO WRK-MSG-AREA DTSCS76
|
|
02952 *********PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS76
|
|
02953 *S1810-EXIT. DTSCS76
|
|
02954 *****EXIT. DTSCS76
|
|
02955 /*****************************************************************DTSCS76
|
|
02956 * DTSCS76
|
|
02957 ******************************************************************DTSCS76
|
|
02958 S1900-NOTICE-OF-SUBJECT. DTSCS76
|
|
02959 IF MAP-NOTICE-OF-SUBJECT = LOW-VALUES OR SPACES DTSCS76
|
|
02960 MOVE 'N' TO MAP-NOTICE-OF-SUBJECT DTSCS76
|
|
02961 ELSE DTSCS76
|
|
02962 IF NOT MAP-NOTICE-OF-SUBJECT-VALID DTSCS76
|
|
02963 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
02964 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS76
|
|
02965 ELSE DTSCS76
|
|
02966 IF WRK-MPRF-NO-88 DTSCS76
|
|
02967 AND MAP-NOTICE-OF-SUBJECT-YES DTSCS76
|
|
02968 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
02969 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS76
|
|
02970 ELSE DTSCS76
|
|
02971 PERFORM S1910-SUBJECT-EDIT THRU S1910-EXIT. DTSCS76
|
|
02972 S1900-EXIT. DTSCS76
|
|
02973 EXIT. DTSCS76
|
|
02974 DTSCS76
|
|
02975 DTSCS76
|
|
02976 DTSCS76
|
|
02977 S1901-ERROR. DTSCS76
|
|
02978 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS76
|
|
02979 TO MAP-NOTICE-OF-SUBJECT-A. DTSCS76
|
|
02980 DTSCS76
|
|
02981 IF LCCM-NO-MSG DTSCS76
|
|
02982 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
02983 MOVE CATB-CURSOR TO MAP-NOTICE-OF-SUBJECT-L DTSCS76
|
|
02984 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
02985 S1901-EXIT. DTSCS76
|
|
02986 EXIT. DTSCS76
|
|
02987 DTSCS76
|
|
02988 DTSCS76
|
|
02989 S1910-SUBJECT-EDIT. DTSCS76
|
|
02990 IF (WRK-MPRF-NO-88) DTSCS76
|
|
02991 OR DTSCS76
|
|
02992 (MAP-NOTICE-OF-SUBJECT-NO) DTSCS76
|
|
02993 GO TO S1910-EXIT. DTSCS76
|
|
02994 DTSCS76
|
|
02995 IF MPRF-STATUS-SUB-88 DTSCS76
|
|
02996 NEXT SENTENCE DTSCS76
|
|
02997 ELSE DTSCS76
|
|
02998 MOVE MSG-E765-AREA TO WRK-MSG-AREA DTSCS76
|
|
02999 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS76
|
|
03000 S1910-EXIT. DTSCS76
|
|
03001 EXIT. DTSCS76
|
|
03002 /*****************************************************************DTSCS76
|
|
03003 * DTSCS76
|
|
03004 ******************************************************************DTSCS76
|
|
03005 S2000-REQUEST-FOR-FEIN. DTSCS76
|
|
03006 IF MAP-REQUEST-FOR-FEIN = LOW-VALUES OR SPACES DTSCS76
|
|
03007 MOVE 'N' TO MAP-REQUEST-FOR-FEIN DTSCS76
|
|
03008 ELSE DTSCS76
|
|
03009 IF NOT MAP-REQUEST-FOR-FEIN-VALID DTSCS76
|
|
03010 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03011 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS76
|
|
03012 ELSE DTSCS76
|
|
03013 IF WRK-MPRF-NO-88 DTSCS76
|
|
03014 IF MAP-REQUEST-FOR-FEIN-YES DTSCS76
|
|
03015 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
03016 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS76
|
|
03017 ELSE DTSCS76
|
|
03018 NEXT SENTENCE DTSCS76
|
|
03019 ELSE DTSCS76
|
|
03020 IF MAP-REQUEST-FOR-FEIN-YES DTSCS76
|
|
03021 IF MPRF-CLASS-CHG-ONLY-88 DTSCS76
|
|
03022 MOVE MSG-E768-AREA TO WRK-MSG-AREA DTSCS76
|
|
03023 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS76
|
|
03024 S2000-EXIT. DTSCS76
|
|
03025 EXIT. DTSCS76
|
|
03026 DTSCS76
|
|
03027 DTSCS76
|
|
03028 DTSCS76
|
|
03029 S2001-ERROR. DTSCS76
|
|
03030 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REQUEST-FOR-FEIN-A. DTSCS76
|
|
03031 DTSCS76
|
|
03032 IF LCCM-NO-MSG DTSCS76
|
|
03033 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03034 MOVE CATB-CURSOR TO MAP-REQUEST-FOR-FEIN-L DTSCS76
|
|
03035 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03036 S2001-EXIT. DTSCS76
|
|
03037 EXIT. DTSCS76
|
|
03038 /*****************************************************************DTSCS76
|
|
03039 * DTSCS76
|
|
03040 ******************************************************************DTSCS76
|
|
03041 S2100-ADDR-TYPE. DTSCS76
|
|
03042 IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES DTSCS76
|
|
03043 SET MAP-ADDR-TAX-88 TO TRUE DTSCS76
|
|
03044 ELSE DTSCS76
|
|
03045 IF MAP-ADDR-VALID-88 DTSCS76
|
|
03046 NEXT SENTENCE DTSCS76
|
|
03047 ELSE DTSCS76
|
|
03048 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03049 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS76
|
|
03050 S2100-EXIT. DTSCS76
|
|
03051 EXIT. DTSCS76
|
|
03052 DTSCS76
|
|
03053 DTSCS76
|
|
03054 DTSCS76
|
|
03055 S2101-ERROR. DTSCS76
|
|
03056 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A DTSCS76
|
|
03057 DTSCS76
|
|
03058 IF LCCM-NO-MSG DTSCS76
|
|
03059 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03060 MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L DTSCS76
|
|
03061 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03062 S2101-EXIT. DTSCS76
|
|
03063 EXIT. DTSCS76
|
|
03064 /*****************************************************************DTSCS76
|
|
03065 * DTSCS76
|
|
03066 ******************************************************************DTSCS76
|
|
03067 S2200-ADDR-NBR. DTSCS76
|
|
03068 INSPECT MAP-ADDR-ID-NO DTSCS76
|
|
03069 CONVERTING LOW-VALUES TO SPACES. DTSCS76
|
|
03070 DTSCS76
|
|
03071 DTSCS76
|
|
03072 IF MAP-ADDR-ID-NO = SPACES DTSCS76
|
|
03073 IF MAP-ADDR-TAD-88 DTSCS76
|
|
03074 IF WRK-MPRF-NO-88 DTSCS76
|
|
03075 GO TO S2200-EXIT DTSCS76
|
|
03076 ELSE DTSCS76
|
|
03077 PERFORM S2210-ADDR-LOOKUP THRU S2210-EXIT DTSCS76
|
|
03078 GO TO S2200-EXIT DTSCS76
|
|
03079 ELSE DTSCS76
|
|
03080 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76
|
|
03081 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76
|
|
03082 GO TO S2200-EXIT. DTSCS76
|
|
03083 DTSCS76
|
|
03084 DTSCS76
|
|
03085 IF MAP-ADDR-TAD-88 DTSCS76
|
|
03086 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
03087 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76
|
|
03088 GO TO S2200-EXIT. DTSCS76
|
|
03089 DTSCS76
|
|
03090 DTSCS76
|
|
03091 MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA. DTSCS76
|
|
03092 DTSCS76
|
|
03093 MOVE +1 TO L013-MIN-CNT DTSCS76
|
|
03094 DTSCS76
|
|
03095 MOVE +999 TO L013-MAX-CNT. DTSCS76
|
|
03096 DTSCS76
|
|
03097 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCS76
|
|
03098 DTSCS76
|
|
03099 IF L013-VALID DTSCS76
|
|
03100 MOVE L013-CNT TO MAP-ADDR-ID-NO-N DTSCS76
|
|
03101 IF MAP-ADDR-TAA-OPO-88 DTSCS76
|
|
03102 PERFORM S2220-ADDR-TAA-OPO THRU S2220-EXIT DTSCS76
|
|
03103 ELSE DTSCS76
|
|
03104 NEXT SENTENCE DTSCS76
|
|
03105 ELSE DTSCS76
|
|
03106 IF L013-NO-ENTRY DTSCS76
|
|
03107 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76
|
|
03108 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76
|
|
03109 ELSE DTSCS76
|
|
03110 IF L013-INVALID-NEGATIVE DTSCS76
|
|
03111 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS76
|
|
03112 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76
|
|
03113 ELSE DTSCS76
|
|
03114 IF L013-EXCEEDS-MIN-MAX DTSCS76
|
|
03115 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS76
|
|
03116 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS76
|
|
03117 ELSE DTSCS76
|
|
03118 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03119 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS76
|
|
03120 S2200-EXIT. DTSCS76
|
|
03121 EXIT. DTSCS76
|
|
03122 DTSCS76
|
|
03123 DTSCS76
|
|
03124 DTSCS76
|
|
03125 S2201-ERROR. DTSCS76
|
|
03126 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A. DTSCS76
|
|
03127 DTSCS76
|
|
03128 IF LCCM-NO-MSG DTSCS76
|
|
03129 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03130 MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L DTSCS76
|
|
03131 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03132 S2201-EXIT. DTSCS76
|
|
03133 EXIT. DTSCS76
|
|
03134 DTSCS76
|
|
03135 DTSCS76
|
|
03136 DTSCS76
|
|
03137 S2210-ADDR-LOOKUP. DTSCS76
|
|
03138 IF WRK-MPRF-NO-88 DTSCS76
|
|
03139 GO TO S2210-EXIT. DTSCS76
|
|
03140 DTSCS76
|
|
03141 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS76
|
|
03142 DTSCS76
|
|
03143 IF MAP-ADDR-TAX-88 DTSCS76
|
|
03144 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS76
|
|
03145 SET L111-ID-NO-TAD-MAIL-88 TO TRUE DTSCS76
|
|
03146 ELSE DTSCS76
|
|
03147 IF MAP-ADDR-PHY-88 DTSCS76
|
|
03148 SET L111-LOOKUP-TAD-88 TO TRUE DTSCS76
|
|
03149 SET L111-ID-NO-TAD-PHYS-88 TO TRUE DTSCS76
|
|
03150 ELSE DTSCS76
|
|
03151 GO TO S899-ABEND. DTSCS76
|
|
03152 DTSCS76
|
|
03153 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS76
|
|
03154 DTSCS76
|
|
03155 IF L111-ADDR-NOT-FOUND-88 DTSCS76
|
|
03156 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS76
|
|
03157 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS76
|
|
03158 S2210-EXIT. DTSCS76
|
|
03159 EXIT. DTSCS76
|
|
03160 DTSCS76
|
|
03161 DTSCS76
|
|
03162 DTSCS76
|
|
03163 S2220-ADDR-TAA-OPO. DTSCS76
|
|
03164 IF WRK-MPRF-NO-88 DTSCS76
|
|
03165 GO TO S2210-EXIT. DTSCS76
|
|
03166 DTSCS76
|
|
03167 MOVE WRK-EMP-NO TO L111-EMP-NO. DTSCS76
|
|
03168 DTSCS76
|
|
03169 IF MAP-ADDR-TAX-ALT-88 DTSCS76
|
|
03170 SET L111-LOOKUP-TAA-88 TO TRUE DTSCS76
|
|
03171 ELSE DTSCS76
|
|
03172 IF MAP-ADDR-OPO-88 DTSCS76
|
|
03173 SET L111-LOOKUP-OPO-88 TO TRUE DTSCS76
|
|
03174 ELSE DTSCS76
|
|
03175 GO TO S899-ABEND. DTSCS76
|
|
03176 DTSCS76
|
|
03177 IF L013-CNT = +0 DTSCS76
|
|
03178 MOVE 1 TO L111-ID-NO DTSCS76
|
|
03179 ELSE DTSCS76
|
|
03180 MOVE L013-CNT TO L111-ID-NO. DTSCS76
|
|
03181 DTSCS76
|
|
03182 PERFORM S111-ADDR-LOOKUP THRU S111-EXIT. DTSCS76
|
|
03183 DTSCS76
|
|
03184 IF L111-ADDR-NOT-FOUND-88 DTSCS76
|
|
03185 MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA DTSCS76
|
|
03186 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS76
|
|
03187 S2220-EXIT. DTSCS76
|
|
03188 EXIT. DTSCS76
|
|
03189 /*****************************************************************DTSCS76
|
|
03190 * DTSCS76
|
|
03191 ******************************************************************DTSCS76
|
|
03192 S2300-AR-AUDIT-TRAIL. DTSCS76
|
|
03193 IF MAP-AR-AUDIT-TRAIL = LOW-VALUES OR SPACES DTSCS76
|
|
03194 MOVE 'N' TO MAP-AR-AUDIT-TRAIL DTSCS76
|
|
03195 ELSE DTSCS76
|
|
03196 IF NOT MAP-AR-AUDIT-TRAIL-VALID DTSCS76
|
|
03197 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03198 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS76
|
|
03199 ELSE DTSCS76
|
|
03200 IF WRK-MPRF-NO-88 DTSCS76
|
|
03201 AND MAP-AR-AUDIT-TRAIL-YES DTSCS76
|
|
03202 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
03203 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS76
|
|
03204 ELSE DTSCS76
|
|
03205 IF MAP-AR-AUDIT-TRAIL-YES DTSCS76
|
|
03206 AND MPRF-TOT-BALANCE-AMT NOT > +0 DTSCS76
|
|
03207 MOVE MSG-E762-AREA TO WRK-MSG-AREA DTSCS76
|
|
03208 PERFORM S2301-ERROR THRU S2301-EXIT. DTSCS76
|
|
03209 S2300-EXIT. DTSCS76
|
|
03210 EXIT. DTSCS76
|
|
03211 DTSCS76
|
|
03212 DTSCS76
|
|
03213 DTSCS76
|
|
03214 S2301-ERROR. DTSCS76
|
|
03215 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AR-AUDIT-TRAIL-A. DTSCS76
|
|
03216 DTSCS76
|
|
03217 IF LCCM-NO-MSG DTSCS76
|
|
03218 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03219 MOVE CATB-CURSOR TO MAP-AR-AUDIT-TRAIL-L DTSCS76
|
|
03220 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03221 S2301-EXIT. DTSCS76
|
|
03222 EXIT. DTSCS76
|
|
03223 /*****************************************************************DTSCS76
|
|
03224 * DTSCS76
|
|
03225 ******************************************************************DTSCS76
|
|
03226 /*****************************************************************DTSCS76
|
|
03227 * DTSCS76
|
|
03228 ******************************************************************DTSCS76
|
|
03229 S2400-STMT-FROM-TO-YRQ. DTSCS76
|
|
03230 MOVE +0 TO WRK-STMT-FROM-YRQ DTSCS76
|
|
03231 WRK-STMT-TO-YRQ. DTSCS76
|
|
03232 DTSCS76
|
|
03233 DTSCS76
|
|
03234 MOVE MAP-STMT-FROM-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
03235 DTSCS76
|
|
03236 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
03237 DTSCS76
|
|
03238 IF L016-NO-ENTRY DTSCS76
|
|
03239 NEXT SENTENCE DTSCS76
|
|
03240 ELSE DTSCS76
|
|
03241 IF L016-NOT-VALID DTSCS76
|
|
03242 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03243 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76
|
|
03244 ELSE DTSCS76
|
|
03245 IF WRK-MPRF-NO-88 DTSCS76
|
|
03246 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
03247 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76
|
|
03248 ELSE DTSCS76
|
|
03249 MOVE L016-YRQ TO WRK-STMT-FROM-YRQ. DTSCS76
|
|
03250 DTSCS76
|
|
03251 DTSCS76
|
|
03252 MOVE MAP-STMT-TO-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS76
|
|
03253 DTSCS76
|
|
03254 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS76
|
|
03255 DTSCS76
|
|
03256 IF L016-NO-ENTRY DTSCS76
|
|
03257 MOVE WRK-STMT-FROM-YRQ TO WRK-STMT-TO-YRQ DTSCS76
|
|
03258 ELSE DTSCS76
|
|
03259 IF L016-NOT-VALID DTSCS76
|
|
03260 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03261 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76
|
|
03262 GO TO S2400-EXIT DTSCS76
|
|
03263 ELSE DTSCS76
|
|
03264 IF WRK-MPRF-NO-88 DTSCS76
|
|
03265 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS76
|
|
03266 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76
|
|
03267 GO TO S2400-EXIT DTSCS76
|
|
03268 ELSE DTSCS76
|
|
03269 MOVE L016-YRQ TO WRK-STMT-TO-YRQ. DTSCS76
|
|
03270 DTSCS76
|
|
03271 DTSCS76
|
|
03272 IF WRK-STMT-TO-YRQ > +0 DTSCS76
|
|
03273 IF WRK-STMT-FROM-YRQ > WRK-STMT-TO-YRQ DTSCS76
|
|
03274 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03275 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76
|
|
03276 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76
|
|
03277 GO TO S2400-EXIT. DTSCS76
|
|
03278 DTSCS76
|
|
03279 DTSCS76
|
|
03280 IF WRK-STMT-FROM-YRQ = +0 DTSCS76
|
|
03281 IF WRK-STMT-TO-YRQ > +0 DTSCS76
|
|
03282 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03283 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS76
|
|
03284 PERFORM S2402-ERROR THRU S2402-EXIT DTSCS76
|
|
03285 GO TO S2400-EXIT. DTSCS76
|
|
03286 S2400-EXIT. DTSCS76
|
|
03287 EXIT. DTSCS76
|
|
03288 DTSCS76
|
|
03289 DTSCS76
|
|
03290 DTSCS76
|
|
03291 S2401-ERROR. DTSCS76
|
|
03292 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-FROM-YRQ-YR-A. DTSCS76
|
|
03293 DTSCS76
|
|
03294 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-FROM-YRQ-Q-A. DTSCS76
|
|
03295 DTSCS76
|
|
03296 IF LCCM-NO-MSG DTSCS76
|
|
03297 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03298 MOVE CATB-CURSOR TO MAP-STMT-FROM-YRQ-YR-L DTSCS76
|
|
03299 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03300 S2401-EXIT. DTSCS76
|
|
03301 EXIT. DTSCS76
|
|
03302 DTSCS76
|
|
03303 S2402-ERROR. DTSCS76
|
|
03304 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-TO-YRQ-YR-A. DTSCS76
|
|
03305 DTSCS76
|
|
03306 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-TO-YRQ-Q-A. DTSCS76
|
|
03307 DTSCS76
|
|
03308 IF LCCM-NO-MSG DTSCS76
|
|
03309 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03310 MOVE CATB-CURSOR TO MAP-STMT-TO-YRQ-YR-L DTSCS76
|
|
03311 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03312 S2402-EXIT. DTSCS76
|
|
03313 EXIT. DTSCS76
|
|
03314 /*****************************************************************DTSCS76
|
|
03315 * DTSCS76
|
|
03316 ******************************************************************DTSCS76
|
|
03317 S2500-RESPONSIBLE-OP-ID. DTSCS76
|
|
03318 IF MAP-RESPONSIBLE-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS76
|
|
03319 MOVE LCCM-RESP-OP-ID TO MAP-RESPONSIBLE-OP-ID. DTSCS76
|
|
03320 DTSCS76
|
|
03321 IF MAP-RESPONSIBLE-OP-ID = LCCM-OP-ID DTSCS76
|
|
03322 MOVE MAP-RESPONSIBLE-OP-ID TO LCCM-RESP-OP-ID DTSCS76
|
|
03323 GO TO S2500-EXIT. DTSCS76
|
|
03324 DTSCS76
|
|
03325 MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID. DTSCS76
|
|
03326 DTSCS76
|
|
03327 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS76
|
|
03328 DTSCS76
|
|
03329 IF (L082-VALID-OP) DTSCS76
|
|
03330 AND DTSCS76
|
|
03331 (L082-EXTERNAL-88) DTSCS76
|
|
03332 MOVE MAP-RESPONSIBLE-OP-ID TO LCCM-RESP-OP-ID DTSCS76
|
|
03333 ELSE DTSCS76
|
|
03334 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03335 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS76
|
|
03336 S2500-EXIT. DTSCS76
|
|
03337 EXIT. DTSCS76
|
|
03338 DTSCS76
|
|
03339 DTSCS76
|
|
03340 DTSCS76
|
|
03341 S2501-ERROR. DTSCS76
|
|
03342 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESPONSIBLE-OP-ID-A. DTSCS76
|
|
03343 DTSCS76
|
|
03344 IF LCCM-NO-MSG DTSCS76
|
|
03345 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03346 MOVE CATB-CURSOR TO MAP-RESPONSIBLE-OP-ID-L DTSCS76
|
|
03347 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03348 S2501-EXIT. DTSCS76
|
|
03349 EXIT. DTSCS76
|
|
03350 S2600-WAGE-REQUEST. DTSCS76
|
|
03351 MOVE MAP-SSN-AREA TO L020-S-SSN-AREA. DTSCS76
|
|
03352 PERFORM S020-SCREEN-SSN THRU S020-EXIT. DTSCS76
|
|
03353 IF L020-NO-ENTRY DTSCS76
|
|
03354 GO TO S2600-EXIT DTSCS76
|
|
03355 ELSE DTSCS76
|
|
03356 IF L020-NOT-VALID DTSCS76
|
|
03357 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03358 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS76
|
|
03359 GO TO S2600-EXIT. DTSCS76
|
|
03360 DTSCS76
|
|
03361 MOVE L020-SSN TO L081-CLAIMANT-SSN. DTSCS76
|
|
03362 PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT. DTSCS76
|
|
03363 IF L081-NAME-FOUND DTSCS76
|
|
03364 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME DTSCS76
|
|
03365 ELSE DTSCS76
|
|
03366 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS76
|
|
03367 MOVE MSG-E76G-AREA TO WRK-MSG-AREA DTSCS76
|
|
03368 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS76
|
|
03369 GO TO S2600-EXIT. DTSCS76
|
|
03370 DTSCS76
|
|
03371 MOVE LCCM-CURR-RUN-DATE TO L004-DATE. DTSCS76
|
|
03372 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSCS76
|
|
03373 ADD +4 TO L004-ABS-QTR. DTSCS76
|
|
03374 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS76
|
|
03375 DTSCS76
|
|
03376 MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
03377 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
03378 IF L016-NO-ENTRY DTSCS76
|
|
03379 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS76
|
|
03380 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS76
|
|
03381 GO TO S2600-EXIT DTSCS76
|
|
03382 ELSE DTSCS76
|
|
03383 IF L016-NOT-VALID DTSCS76
|
|
03384 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03385 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS76
|
|
03386 GO TO S2600-EXIT. DTSCS76
|
|
03387 DTSCS76
|
|
03388 IF L016-YRQ > L004-QTR-5-9 DTSCS76
|
|
03389 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03390 PERFORM S2602-ERROR THRU S2602-EXIT DTSCS76
|
|
03391 GO TO S2600-EXIT. DTSCS76
|
|
03392 DTSCS76
|
|
03393 MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
03394 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
03395 IF L016-NO-ENTRY DTSCS76
|
|
03396 NEXT SENTENCE DTSCS76
|
|
03397 ELSE DTSCS76
|
|
03398 IF L016-NOT-VALID DTSCS76
|
|
03399 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03400 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS76
|
|
03401 GO TO S2600-EXIT. DTSCS76
|
|
03402 DTSCS76
|
|
03403 IF L016-YRQ > L004-QTR-5-9 DTSCS76
|
|
03404 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03405 PERFORM S2603-ERROR THRU S2603-EXIT DTSCS76
|
|
03406 GO TO S2600-EXIT. DTSCS76
|
|
03407 DTSCS76
|
|
03408 MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
03409 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
03410 IF L016-NO-ENTRY DTSCS76
|
|
03411 NEXT SENTENCE DTSCS76
|
|
03412 ELSE DTSCS76
|
|
03413 IF L016-NOT-VALID DTSCS76
|
|
03414 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03415 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS76
|
|
03416 GO TO S2600-EXIT. DTSCS76
|
|
03417 DTSCS76
|
|
03418 IF L016-YRQ > L004-QTR-5-9 DTSCS76
|
|
03419 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03420 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS76
|
|
03421 GO TO S2600-EXIT. DTSCS76
|
|
03422 DTSCS76
|
|
03423 MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA DTSCS76
|
|
03424 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT DTSCS76
|
|
03425 IF L016-NO-ENTRY DTSCS76
|
|
03426 NEXT SENTENCE DTSCS76
|
|
03427 ELSE DTSCS76
|
|
03428 IF L016-NOT-VALID DTSCS76
|
|
03429 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03430 PERFORM S2605-ERROR THRU S2605-EXIT DTSCS76
|
|
03431 GO TO S2600-EXIT. DTSCS76
|
|
03432 DTSCS76
|
|
03433 IF L016-YRQ > L004-QTR-5-9 DTSCS76
|
|
03434 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03435 PERFORM S2604-ERROR THRU S2604-EXIT DTSCS76
|
|
03436 GO TO S2600-EXIT. DTSCS76
|
|
03437 DTSCS76
|
|
03438 S2600-EXIT. EXIT. DTSCS76
|
|
03439 DTSCS76
|
|
03440 S2601-ERROR. DTSCS76
|
|
03441 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A DTSCS76
|
|
03442 MAP-SSN-2-A DTSCS76
|
|
03443 MAP-SSN-3-A. DTSCS76
|
|
03444 IF LCCM-NO-MSG DTSCS76
|
|
03445 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03446 MOVE CATB-CURSOR TO MAP-SSN-1-L DTSCS76
|
|
03447 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03448 S2601-EXIT. EXIT. DTSCS76
|
|
03449 DTSCS76
|
|
03450 S2602-ERROR. DTSCS76
|
|
03451 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ1-YR-A DTSCS76
|
|
03452 MAP-WR-YRQ1-Q-A. DTSCS76
|
|
03453 IF LCCM-NO-MSG DTSCS76
|
|
03454 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03455 MOVE CATB-CURSOR TO MAP-WR-YRQ1-YR-L DTSCS76
|
|
03456 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03457 S2602-EXIT. DTSCS76
|
|
03458 EXIT. DTSCS76
|
|
03459 S2603-ERROR. DTSCS76
|
|
03460 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ2-YR-A DTSCS76
|
|
03461 MAP-WR-YRQ2-Q-A. DTSCS76
|
|
03462 IF LCCM-NO-MSG DTSCS76
|
|
03463 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03464 MOVE CATB-CURSOR TO MAP-WR-YRQ2-YR-L DTSCS76
|
|
03465 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03466 S2603-EXIT. DTSCS76
|
|
03467 EXIT. DTSCS76
|
|
03468 S2604-ERROR. DTSCS76
|
|
03469 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ3-YR-A DTSCS76
|
|
03470 MAP-WR-YRQ3-Q-A. DTSCS76
|
|
03471 IF LCCM-NO-MSG DTSCS76
|
|
03472 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03473 MOVE CATB-CURSOR TO MAP-WR-YRQ3-YR-L DTSCS76
|
|
03474 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03475 S2604-EXIT. DTSCS76
|
|
03476 EXIT. DTSCS76
|
|
03477 S2605-ERROR. DTSCS76
|
|
03478 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ4-YR-A DTSCS76
|
|
03479 MAP-WR-YRQ4-Q-A. DTSCS76
|
|
03480 IF LCCM-NO-MSG DTSCS76
|
|
03481 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS76
|
|
03482 MOVE CATB-CURSOR TO MAP-WR-YRQ4-YR-L DTSCS76
|
|
03483 SET CURSOR-SET-YES TO TRUE. DTSCS76
|
|
03484 S2605-EXIT. DTSCS76
|
|
03485 EXIT. DTSCS76
|
|
03486 EJECT DTSCS76
|
|
03487 S3000-RPTS-EDITS. DTSCS76
|
|
03488 IF WRK-MPRF-NO-88 DTSCS76
|
|
03489 GO TO S3000-EXIT. DTSCS76
|
|
03490 DTSCS76
|
|
03491 IF MPRF-STATUS-SUB-88 DTSCS76
|
|
03492 NEXT SENTENCE DTSCS76
|
|
03493 ELSE DTSCS76
|
|
03494 MOVE MSG-E765-AREA TO WRK-MSG-AREA DTSCS76
|
|
03495 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS76
|
|
03496 DTSCS76
|
|
03497 MOVE WRK-FROM-YRQ TO L004-QTR-5-9. DTSCS76
|
|
03498 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS76
|
|
03499 DTSCS76
|
|
03500 SET WRK-ANN-LIABLE-NO-88 TO TRUE. DTSCS76
|
|
03501 SET WRK-ANN-FILER-NO-88 TO TRUE. DTSCS76
|
|
03502 DTSCS76
|
|
03503 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS76
|
|
03504 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSCS76
|
|
03505 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS76
|
|
03506 MOVE WRK-FROM-YRQ TO L410-YRQ DTSCS76
|
|
03507 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS76
|
|
03508 IF L410-ANN-SCHED-88 DTSCS76
|
|
03509 SET WRK-ANN-FILER-YES-88 TO TRUE. DTSCS76
|
|
03510 DTSCS76
|
|
03511 PERFORM S3100-CHECK-LIAB-AND-RATE THRU S3100-EXIT DTSCS76
|
|
03512 UNTIL (LCCM-MSG) DTSCS76
|
|
03513 OR DTSCS76
|
|
03514 (L004-QTR-5-9 > WRK-TO-YRQ) DTSCS76
|
|
03515 OR DTSCS76
|
|
03516 (L004-INVALID-QTR). DTSCS76
|
|
03517 DTSCS76
|
|
03518 IF WRK-ANN-FILER-YES-88 DTSCS76
|
|
03519 IF WRK-ANN-LIABLE-NO-88 DTSCS76
|
|
03520 MOVE WRK-FROM-YRQ TO L004-QTR-5-9 DTSCS76
|
|
03521 PERFORM S004-FROM-5 THRU S004-EXIT DTSCS76
|
|
03522 MOVE L004-SLASH-QTR TO MSG-E766-SLASH-QTR DTSCS76
|
|
03523 MOVE MSG-E766-AREA TO WRK-MSG-AREA DTSCS76
|
|
03524 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS76
|
|
03525 DTSCS76
|
|
03526 IF LCCM-MSG DTSCS76
|
|
03527 GO TO S3000-EXIT. DTSCS76
|
|
03528 DTSCS76
|
|
03529 IF MAP-FORCE-PRINT-YES DTSCS76
|
|
03530 GO TO S3000-EXIT. DTSCS76
|
|
03531 DTSCS76
|
|
03532 DTSCS76
|
|
03533 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS76
|
|
03534 DTSCS76
|
|
03535 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS76
|
|
03536 DTSCS76
|
|
03537 SET MQTR-QTR-88 TO TRUE. DTSCS76
|
|
03538 DTSCS76
|
|
03539 MOVE WRK-FROM-YRQ TO MQTR-YRQ. DTSCS76
|
|
03540 DTSCS76
|
|
03541 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS76
|
|
03542 DTSCS76
|
|
03543 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS76
|
|
03544 DTSCS76
|
|
03545 PERFORM S3200-CHECK-FOR-RPT THRU S3200-EXIT DTSCS76
|
|
03546 UNTIL L810-NO-REC-88. DTSCS76
|
|
03547 DTSCS76
|
|
03548 IF WRK-ANN-FILER-YES-88 DTSCS76
|
|
03549 PERFORM S3300-ANNUAL-REPORT THRU S3300-EXIT DTSCS76
|
|
03550 IF LCCM-MSG DTSCS76
|
|
03551 GO TO S3000-EXIT. DTSCS76
|
|
03552 DTSCS76
|
|
03553 PERFORM S3400-MASS-MAILING THRU S3400-EXIT. DTSCS76
|
|
03554 DTSCS76
|
|
03555 S3000-EXIT. DTSCS76
|
|
03556 EXIT. DTSCS76
|
|
03557 DTSCS76
|
|
03558 DTSCS76
|
|
03559 DTSCS76
|
|
03560 S3100-CHECK-LIAB-AND-RATE. DTSCS76
|
|
03561 MOVE WRK-EMP-NO TO L381-EMP-NO. DTSCS76
|
|
03562 DTSCS76
|
|
03563 MOVE L004-QTR-5-9 TO L381-YRQ. DTSCS76
|
|
03564 DTSCS76
|
|
03565 MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS. DTSCS76
|
|
03566 DTSCS76
|
|
03567 PERFORM S381-DETERM-LIABILITY THRU S381-EXIT. DTSCS76
|
|
03568 DTSCS76
|
|
03569 IF WRK-ANN-FILER-YES-88 DTSCS76
|
|
03570 IF L381-LIABLE-88 DTSCS76
|
|
03571 SET WRK-ANN-LIABLE-YES-88 TO TRUE DTSCS76
|
|
03572 END-IF DTSCS76
|
|
03573 ELSE DTSCS76
|
|
03574 IF L381-NOT-LIABLE-88 DTSCS76
|
|
03575 MOVE L004-SLASH-QTR TO MSG-E766-SLASH-QTR DTSCS76
|
|
03576 MOVE MSG-E766-AREA TO WRK-MSG-AREA DTSCS76
|
|
03577 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
03578 GO TO S3100-EXIT. DTSCS76
|
|
03579 DTSCS76
|
|
03580 IF L381-CLASS-SELF-INS-88 DTSCS76
|
|
03581 NEXT SENTENCE DTSCS76
|
|
03582 ELSE DTSCS76
|
|
03583 IF L381-UI-RATE-NOT-FOUND-88 DTSCS76
|
|
03584 MOVE L004-SLASH-QTR TO MSG-E761-SLASH-QTR DTSCS76
|
|
03585 MOVE MSG-E761-AREA TO WRK-MSG-AREA DTSCS76
|
|
03586 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
03587 GO TO S3100-EXIT. DTSCS76
|
|
03588 DTSCS76
|
|
03589 ADD +1 TO L004-ABS-QTR. DTSCS76
|
|
03590 DTSCS76
|
|
03591 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS76
|
|
03592 S3100-EXIT. DTSCS76
|
|
03593 EXIT. DTSCS76
|
|
03594 DTSCS76
|
|
03595 DTSCS76
|
|
03596 DTSCS76
|
|
03597 S3200-CHECK-FOR-RPT. DTSCS76
|
|
03598 MOVE MSKL-REC TO MQTR-REC. DTSCS76
|
|
03599 DTSCS76
|
|
03600 IF MQTR-YRQ > WRK-TO-YRQ DTSCS76
|
|
03601 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76
|
|
03602 SET L810-NO-REC-88 TO TRUE DTSCS76
|
|
03603 GO TO S3200-EXIT. DTSCS76
|
|
03604 DTSCS76
|
|
03605 IF MQTR-CURR-RCVD-88 DTSCS76
|
|
03606 MOVE MSG-E763-AREA TO WRK-MSG-AREA DTSCS76
|
|
03607 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS76
|
|
03608 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS76
|
|
03609 SET L810-NO-REC-88 TO TRUE DTSCS76
|
|
03610 GO TO S3200-EXIT. DTSCS76
|
|
03611 DTSCS76
|
|
03612 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS76
|
|
03613 S3200-EXIT. DTSCS76
|
|
03614 EXIT. DTSCS76
|
|
03615 EJECT DTSCS76
|
|
03616 S3300-ANNUAL-REPORT. DTSCS76
|
|
03617 DTSCS76
|
|
03618 MOVE WRK-FROM-YRQ TO L004-QTR-5-9. DTSCS76
|
|
03619 IF L004-QTR-5-Q = 1 DTSCS76
|
|
03620 NEXT SENTENCE DTSCS76
|
|
03621 ELSE DTSCS76
|
|
03622 MOVE MSG-E76F-AREA TO WRK-MSG-AREA DTSCS76
|
|
03623 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS76
|
|
03624 DTSCS76
|
|
03625 MOVE WRK-TO-YRQ TO L004-QTR-5-9. DTSCS76
|
|
03626 IF L004-QTR-5-Q = 4 DTSCS76
|
|
03627 NEXT SENTENCE DTSCS76
|
|
03628 ELSE DTSCS76
|
|
03629 MOVE MSG-E76F-AREA TO WRK-MSG-AREA DTSCS76
|
|
03630 PERFORM S1402-ERROR THRU S1402-EXIT. DTSCS76
|
|
03631 S3300-EXIT. DTSCS76
|
|
03632 EXIT. DTSCS76
|
|
03633 DTSCS76
|
|
03634 S3400-MASS-MAILING. DTSCS76
|
|
03635 IF WRK-ANN-FILER-YES-88 DTSCS76
|
|
03636 MOVE WRK-FROM-YRQ TO L004-QTR-5-9 DTSCS76
|
|
03637 MOVE L004-QTR-5-YR TO L415-YR DTSCS76
|
|
03638 SET L415-MODE-INPUT-YEAR-88 TO TRUE DTSCS76
|
|
03639 PERFORM S415-HOUSEHOLD-DATES THRU S415-EXIT DTSCS76
|
|
03640 IF L415-NOT-FOUND-88 DTSCS76
|
|
03641 MOVE MSG-E76H-AREA TO WRK-MSG-AREA DTSCS76
|
|
03642 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
03643 END-IF DTSCS76
|
|
03644 ELSE DTSCS76
|
|
03645 IF WRK-FROM-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ DTSCS76
|
|
03646 MOVE MSG-E76H-AREA TO WRK-MSG-AREA DTSCS76
|
|
03647 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
03648 END-IF DTSCS76
|
|
03649 END-IF. DTSCS76
|
|
03650 DTSCS76
|
|
03651 S3400-EXIT. DTSCS76
|
|
03652 EXIT. DTSCS76
|
|
03653 EJECT DTSCS76
|
|
03654 S4000-WAIVE-EDITS. DTSCS76
|
|
03655 IF WRK-FROM-YRQ = +0 DTSCS76
|
|
03656 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03657 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS76
|
|
03658 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76
|
|
03659 GO TO S4000-EXIT. DTSCS76
|
|
03660 DTSCS76
|
|
03661 DTSCS76
|
|
03662 IF WRK-TO-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ DTSCS76
|
|
03663 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03664 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76
|
|
03665 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76
|
|
03666 GO TO S4000-EXIT. DTSCS76
|
|
03667 DTSCS76
|
|
03668 DTSCS76
|
|
03669 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS76
|
|
03670 DTSCS76
|
|
03671 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS76
|
|
03672 DTSCS76
|
|
03673 ADD +45 TO L001-JUL-ABS-DAY. DTSCS76
|
|
03674 DTSCS76
|
|
03675 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSCS76
|
|
03676 DTSCS76
|
|
03677 IF (WRK-WAIVE-EXT-DATE < LCCM-CURR-MAIL-DATE) DTSCS76
|
|
03678 OR DTSCS76
|
|
03679 (WRK-WAIVE-EXT-DATE > L001-FED-8-DATE-9) DTSCS76
|
|
03680 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03681 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76
|
|
03682 GO TO S4000-EXIT. DTSCS76
|
|
03683 DTSCS76
|
|
03684 DTSCS76
|
|
03685 MOVE WRK-TO-YRQ TO L004-QTR-5-9. DTSCS76
|
|
03686 DTSCS76
|
|
03687 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS76
|
|
03688 DTSCS76
|
|
03689 IF L004-QTR-DEFAULT-DUE-DATE NOT < WRK-WAIVE-EXT-DATE DTSCS76
|
|
03690 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03691 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS76
|
|
03692 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS76
|
|
03693 GO TO S4000-EXIT. DTSCS76
|
|
03694 S4000-EXIT. DTSCS76
|
|
03695 EXIT. DTSCS76
|
|
03696 EJECT DTSCS76
|
|
03697 *S4500-5E-WAIVE-EDITS. DTSCS76
|
|
03698 *****IF WRK-5E-FROM-YRQ = +0 DTSCS76
|
|
03699 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03700 *********PERFORM S1601-ERROR THRU S1601-EXIT DTSCS76
|
|
03701 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
03702 *********GO TO S4500-EXIT. DTSCS76
|
|
03703 DTSCS76
|
|
03704 *****IF WRK-5E-TO-YRQ > LCCM-LAST-UI5-MASS-MAIL-YRQ DTSCS76
|
|
03705 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03706 *********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
03707 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
03708 *********GO TO S4500-EXIT. DTSCS76
|
|
03709 DTSCS76
|
|
03710 *****MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS76
|
|
03711 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS76
|
|
03712 *****ADD +45 TO L001-JUL-ABS-DAY. DTSCS76
|
|
03713 *****PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSCS76
|
|
03714 DTSCS76
|
|
03715 *****IF (WRK-5E-WAIVE-EXT-DATE < LCCM-CURR-MAIL-DATE) DTSCS76
|
|
03716 *************OR DTSCS76
|
|
03717 ********(WRK-5E-WAIVE-EXT-DATE > L001-FED-8-DATE-9) DTSCS76
|
|
03718 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS76
|
|
03719 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
03720 *********GO TO S4500-EXIT. DTSCS76
|
|
03721 DTSCS76
|
|
03722 *****MOVE WRK-5E-TO-YRQ TO L004-QTR-5-9. DTSCS76
|
|
03723 *****PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS76
|
|
03724 DTSCS76
|
|
03725 *****IF L004-QTR-DEFAULT-DUE-DATE NOT < WRK-5E-WAIVE-EXT-DATE DTSCS76
|
|
03726 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS76
|
|
03727 *********PERFORM S1602-ERROR THRU S1602-EXIT DTSCS76
|
|
03728 *********PERFORM S1751-ERROR THRU S1751-EXIT DTSCS76
|
|
03729 *********GO TO S4500-EXIT. DTSCS76
|
|
03730 *S4500-EXIT. DTSCS76
|
|
03731 *****EXIT. DTSCS76
|
|
03732 /*****************************************************************DTSCS76
|
|
03733 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS76
|
|
03734 ******************************************************************DTSCS76
|
|
03735 S8100-SET-LOCK-ATTRB. DTSCS76
|
|
03736 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS76
|
|
03737 WRK-ATB-NUM. DTSCS76
|
|
03738 DTSCS76
|
|
03739 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS76
|
|
03740 DTSCS76
|
|
03741 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS76
|
|
03742 MAP-EMP-NO-2-A DTSCS76
|
|
03743 MAP-GOTO-A. DTSCS76
|
|
03744 S8100-EXIT. DTSCS76
|
|
03745 EXIT. DTSCS76
|
|
03746 DTSCS76
|
|
03747 DTSCS76
|
|
03748 DTSCS76
|
|
03749 ******************************************************************DTSCS76
|
|
03750 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS76
|
|
03751 ******************************************************************DTSCS76
|
|
03752 S8200-SET-UPDATE-ATTRB. DTSCS76
|
|
03753 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS76
|
|
03754 DTSCS76
|
|
03755 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS76
|
|
03756 DTSCS76
|
|
03757 DTSCS76
|
|
03758 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS76
|
|
03759 S8200-EXIT. DTSCS76
|
|
03760 EXIT. DTSCS76
|
|
03761 DTSCS76
|
|
03762 DTSCS76
|
|
03763 DTSCS76
|
|
03764 ******************************************************************DTSCS76
|
|
03765 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS76
|
|
03766 ******************************************************************DTSCS76
|
|
03767 S8300-SET-INQ-ATTRB. DTSCS76
|
|
03768 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS76
|
|
03769 WRK-ATB-NUM. DTSCS76
|
|
03770 DTSCS76
|
|
03771 DTSCS76
|
|
03772 PERFORM S8900-SET-ATTRB THRU S8900-EXIT. DTSCS76
|
|
03773 S8300-EXIT. DTSCS76
|
|
03774 EXIT. DTSCS76
|
|
03775 DTSCS76
|
|
03776 DTSCS76
|
|
03777 DTSCS76
|
|
03778 S8900-SET-ATTRB. DTSCS76
|
|
03779 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS76
|
|
03780 MAP-EMP-NO-2-A. DTSCS76
|
|
03781 DTSCS76
|
|
03782 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A. DTSCS76
|
|
03783 DTSCS76
|
|
03784 MOVE WRK-ATB-NUM TO MAP-MAILING-LABELS-A DTSCS76
|
|
03785 *************************MAP-ELF-LABELS-A DTSCS76
|
|
03786 MAP-FROM-YRQ-YR-A DTSCS76
|
|
03787 MAP-FROM-YRQ-Q-A DTSCS76
|
|
03788 MAP-TO-YRQ-YR-A DTSCS76
|
|
03789 MAP-TO-YRQ-Q-A DTSCS76
|
|
03790 MAP-WAIVE-EXT-MO-A DTSCS76
|
|
03791 MAP-WAIVE-EXT-DA-A DTSCS76
|
|
03792 MAP-WAIVE-EXT-YR-A DTSCS76
|
|
03793 MAP-STMT-FROM-YRQ-YR-A DTSCS76
|
|
03794 MAP-STMT-FROM-YRQ-Q-A DTSCS76
|
|
03795 MAP-STMT-TO-YRQ-YR-A DTSCS76
|
|
03796 MAP-STMT-TO-YRQ-Q-A DTSCS76
|
|
03797 *************************MAP-5E-WAIVE-EXT-MO-A DTSCS76
|
|
03798 *************************MAP-5E-WAIVE-EXT-DA-A DTSCS76
|
|
03799 *************************MAP-5E-WAIVE-EXT-YR-A DTSCS76
|
|
03800 MAP-SSN-1-A DTSCS76
|
|
03801 MAP-SSN-2-A DTSCS76
|
|
03802 MAP-SSN-3-A DTSCS76
|
|
03803 MAP-WR-YRQ1-YR-A DTSCS76
|
|
03804 MAP-WR-YRQ1-Q-A DTSCS76
|
|
03805 MAP-WR-YRQ2-YR-A DTSCS76
|
|
03806 MAP-WR-YRQ2-Q-A DTSCS76
|
|
03807 MAP-WR-YRQ3-YR-A DTSCS76
|
|
03808 MAP-WR-YRQ3-Q-A DTSCS76
|
|
03809 MAP-WR-YRQ4-YR-A DTSCS76
|
|
03810 MAP-WR-YRQ4-Q-A DTSCS76
|
|
03811 MAP-ADDR-ID-NO-A. DTSCS76
|
|
03812 *************************MAP-NOTICE-OF-COVERAGE-A. DTSCS76
|
|
03813 DTSCS76
|
|
03814 *****MOVE WRK-ATB-AN TO MAP-ELF-IND-A DTSCS76
|
|
03815 ************************MAP-5E-FORCE-PRINT-A. DTSCS76
|
|
03816 DTSCS76
|
|
03817 MOVE WRK-ATB-AN TO MAP-FORCE-PRINT-A DTSCS76
|
|
03818 MAP-NOTICE-OF-SUBJECT-A DTSCS76
|
|
03819 MAP-REQUEST-FOR-FEIN-A DTSCS76
|
|
03820 MAP-ADDR-TYPE-A DTSCS76
|
|
03821 MAP-AR-AUDIT-TRAIL-A DTSCS76
|
|
03822 MAP-RESPONSIBLE-OP-ID-A. DTSCS76
|
|
03823 DTSCS76
|
|
03824 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS76
|
|
03825 S8900-EXIT. DTSCS76
|
|
03826 EXIT. DTSCS76
|
|
03827 /*****************************************************************DTSCS76
|
|
03828 * MAP ROUTINES *DTSCS76
|
|
03829 ******************************************************************DTSCS76
|
|
03830 S9100-RECEIVE. DTSCS76
|
|
03831 SET L851-RECEIVE-88 TO TRUE. DTSCS76
|
|
03832 DTSCS76
|
|
03833 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS76
|
|
03834 DTSCS76
|
|
03835 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS76
|
|
03836 DTSCS76
|
|
03837 MOVE L851-AID TO LCCM-AID. DTSCS76
|
|
03838 DTSCS76
|
|
03839 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS76
|
|
03840 S9100-EXIT. DTSCS76
|
|
03841 EXIT. DTSCS76
|
|
03842 DTSCS76
|
|
03843 DTSCS76
|
|
03844 DTSCS76
|
|
03845 S9200-SEND-DATAONLY. DTSCS76
|
|
03846 MOVE LOW-VALUES TO MAP-AREA. DTSCS76
|
|
03847 DTSCS76
|
|
03848 IF LCCM-NO-MSG DTSCS76
|
|
03849 NEXT SENTENCE DTSCS76
|
|
03850 ELSE DTSCS76
|
|
03851 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS76
|
|
03852 DTSCS76
|
|
03853 IF CURSOR-SET-GOTO DTSCS76
|
|
03854 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS76
|
|
03855 ELSE DTSCS76
|
|
03856 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS76
|
|
03857 DTSCS76
|
|
03858 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS76
|
|
03859 DTSCS76
|
|
03860 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS76
|
|
03861 DTSCS76
|
|
03862 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS76
|
|
03863 S9200-EXIT. DTSCS76
|
|
03864 EXIT. DTSCS76
|
|
03865 DTSCS76
|
|
03866 DTSCS76
|
|
03867 DTSCS76
|
|
03868 S9300-SEND-MAP. DTSCS76
|
|
03869 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS76
|
|
03870 DTSCS76
|
|
03871 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS76
|
|
03872 DTSCS76
|
|
03873 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS76
|
|
03874 DTSCS76
|
|
03875 IF SCR-ACCESS-UPDATE DTSCS76
|
|
03876 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS76
|
|
03877 ELSE DTSCS76
|
|
03878 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS76
|
|
03879 DTSCS76
|
|
03880 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS76
|
|
03881 DTSCS76
|
|
03882 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS76
|
|
03883 DTSCS76
|
|
03884 IF CURSOR-SET-NO DTSCS76
|
|
03885 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS76
|
|
03886 DTSCS76
|
|
03887 SET L851-SEND-88 TO TRUE. DTSCS76
|
|
03888 DTSCS76
|
|
03889 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS76
|
|
03890 DTSCS76
|
|
03891 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS76
|
|
03892 S9300-EXIT. DTSCS76
|
|
03893 EXIT. DTSCS76
|
|
03894 DTSCS76
|
|
03895 DTSCS76
|
|
03896 DTSCS76
|
|
03897 S9310-UPDATE-FKEYS. DTSCS76
|
|
03898 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS76
|
|
03899 DTSCS76
|
|
03900 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS76
|
|
03901 DTSCS76
|
|
03902 IF LCCM-SCR-CLEAR DTSCS76
|
|
03903 NEXT SENTENCE DTSCS76
|
|
03904 ELSE DTSCS76
|
|
03905 IF LCCM-SCR-INQUIRE DTSCS76
|
|
03906 NEXT SENTENCE DTSCS76
|
|
03907 ELSE DTSCS76
|
|
03908 IF LCCM-SCR-UPDATE-LOCKED DTSCS76
|
|
03909 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS76
|
|
03910 ELSE DTSCS76
|
|
03911 NEXT SENTENCE. DTSCS76
|
|
03912 S9310-EXIT. DTSCS76
|
|
03913 EXIT. DTSCS76
|
|
03914 DTSCS76
|
|
03915 DTSCS76
|
|
03916 DTSCS76
|
|
03917 S9320-INQUIRY-FKEYS. DTSCS76
|
|
03918 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS76
|
|
03919 DTSCS76
|
|
03920 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS76
|
|
03921 S9320-EXIT. DTSCS76
|
|
03922 EXIT. DTSCS76
|
|
03923 DTSCS76
|
|
03924 DTSCS76
|
|
03925 DTSCS76
|
|
03926 *S9321-JUMP-KEYS. DTSCS76
|
|
03927 *****MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS76
|
|
03928 *****MOVE CFKD-REG-SEARCH TO MAP-KEY-SEARCH. DTSCS76
|
|
03929 *****MOVE CFKD-COLL-INQ TO MAP-KEY-COLL-INQ. DTSCS76
|
|
03930 *****MOVE CFKD-QTR-INQ TO MAP-KEY-QTR-INQ. DTSCS76
|
|
03931 *S9321-EXIT. DTSCS76
|
|
03932 *****EXIT. DTSCS76
|
|
03933 DTSCS76
|
|
03934 DTSCS76
|
|
03935 DTSCS76
|
|
03936 S9330-DSCR-FIELDS. DTSCS76
|
|
03937 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS76
|
|
03938 DTSCS76
|
|
03939 IF WRK-MPRF-YES-88 DTSCS76
|
|
03940 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS76
|
|
03941 ELSE DTSCS76
|
|
03942 IF WRK-MPRF-NO-88 DTSCS76
|
|
03943 MOVE 'MAY BE ARCHIVED' TO MAP-PRIMARY-NAME. DTSCS76
|
|
03944 DTSCS76
|
|
03945 IF MAP-RESPONSIBLE-OP-ID = LOW-VALUES OR SPACES DTSCS76
|
|
03946 MOVE LOW-VALUES TO MAP-RESPONSIBLE-OP-ID-DSCR DTSCS76
|
|
03947 ELSE DTSCS76
|
|
03948 IF MAP-RESPONSIBLE-OP-ID = LCCM-OP-ID DTSCS76
|
|
03949 MOVE LCCM-OP-NAME TO MAP-RESPONSIBLE-OP-ID-DSCR DTSCS76
|
|
03950 ELSE DTSCS76
|
|
03951 MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID DTSCS76
|
|
03952 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS76
|
|
03953 MOVE L082-NAME TO MAP-RESPONSIBLE-OP-ID-DSCR. DTSCS76
|
|
03954 S9330-EXIT. DTSCS76
|
|
03955 EXIT. DTSCS76
|
|
03956 DTSCS76
|
|
03957 DTSCS76
|
|
03958 DTSCS76
|
|
03959 S9900-PREPARE-SEND. DTSCS76
|
|
03960 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS76
|
|
03961 LCCM-SCR-ID. DTSCS76
|
|
03962 DTSCS76
|
|
03963 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS76
|
|
03964 DTSCS76
|
|
03965 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS76
|
|
03966 S9900-EXIT. DTSCS76
|
|
03967 EXIT. DTSCS76
|