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