1208 lines
94 KiB
COBOL
1208 lines
94 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/19/99
|
|
00002 PROGRAM-ID. DTSCS78. DTSCS78
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
|
|
00004 DATE-WRITTEN. MAY 1994. DTSCS78
|
|
00005 DATE-COMPILED. DTSCS78
|
|
00006 SKIP3 DTSCS78
|
|
00007 ***** DTSCS78
|
|
00008 * DTSCS78
|
|
00009 * FUNCTION: CORRESPONDENCE QUEUE INQUIRY/UPDATE DTSCS78
|
|
00010 * SCREEN PROCESSOR. DTSCS78
|
|
00011 * DTSCS78
|
|
00012 * DTSCS78
|
|
00013 * MODIFICATION LOG: DTSCS78
|
|
00014 * CL**2
|
|
00015 * 10/05/98 INITIAL DEVELOPMENT. COPIED FROM MACCS78 CL**2
|
|
00016 * WORK ORDER: PROGRAMMER: ZL1 CL**2
|
|
00017 * DTSCS78
|
|
00018 * 08/19/1999 IN DC, F23 IS DELETE KEY - NOT F11. CL**5
|
|
00019 * REFERENCE: CODE REVIEW PROGRAMMER: EHH CL**5
|
|
00020 * CL**5
|
|
00021 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5
|
|
00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5
|
|
00023 * REFERENCE: XXXXXXXXXXXXXXXXXX PROGRAMMER: XXX CL**5
|
|
00024 * DTSCS78
|
|
00025 * DTSCS78
|
|
00026 * DESCRIPTION: DTSCS78
|
|
00027 * DTSCS78
|
|
00028 * CLEAR: DTSCS78
|
|
00029 * DTSCS78
|
|
00030 * FIELD DISPLAYED: NONE. DTSCS78
|
|
00031 * DTSCS78
|
|
00032 * DTSCS78
|
|
00033 * JUMP: DTSCS78
|
|
00034 * DTSCS78
|
|
00035 * NONE. DTSCS78
|
|
00036 * DTSCS78
|
|
00037 * DTSCS78
|
|
00038 * INQUIRY: DTSCS78
|
|
00039 * DTSCS78
|
|
00040 * CONTROL FIELD(S): MAP-QUEUE-ID. DTSCS78
|
|
00041 * DTSCS78
|
|
00042 * JUMP IN: DISPLAY RECORD FROM THE CORRESPONDENCE QUEUE DTSCS78
|
|
00043 * INDICATED BY LCCM-RESP-OP-ID. DTSCS78
|
|
00044 * DTSCS78
|
|
00045 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS78
|
|
00046 * DTSCS78
|
|
00047 * DISPLAY SEQUENCE: ASCENDING ON VCOR-ESTB-ABSTIME. DTSCS78
|
|
00048 * DTSCS78
|
|
00049 * PAGE INITIALLY DISPLAYED: FIRST. DTSCS78
|
|
00050 * DTSCS78
|
|
00051 * DTSCS78
|
|
00052 * JUMP OUT: STANDARD LCCM-RESP-OP-ID MAINTENANCE. DTSCS78
|
|
00053 * DTSCS78
|
|
00054 * DTSCS78
|
|
00055 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS78
|
|
00056 * DTSCS78
|
|
00057 * DTSCS78
|
|
00058 * UPDATE: DTSCS78
|
|
00059 * DTSCS78
|
|
00060 * DEL DTSCS78
|
|
00061 * DTSCS78
|
|
00062 * DELETE VERIFICATION FUNCTION IS DISABLED. DTSCS78
|
|
00063 * DTSCS78
|
|
00064 * FOLLOWING A SUCCESSFUL DELETE, DISPLAY THE NEXT DTSCS78
|
|
00065 * CORRESPONDENCE QUEUE RECORD (THE NEXT CORRESPONDENCE DTSCS78
|
|
00066 * QUEUE RECORD WITH VCOR-QUEUE-ID EQUAL TO MAP-QUEUE-ID). DTSCS78
|
|
00067 * DTSCS78
|
|
00068 * DTSCS78
|
|
00069 * RECORDS READ: DTSCS78
|
|
00070 * DTSCS78
|
|
00071 * MASTER: DTSCS78
|
|
00072 * DTSCS78
|
|
00073 * NONE. DTSCS78
|
|
00074 * DTSCS78
|
|
00075 * DTSCS78
|
|
00076 * ALTERNATE INDEX: DTSCS78
|
|
00077 * DTSCS78
|
|
00078 * NONE. DTSCS78
|
|
00079 * DTSCS78
|
|
00080 * DTSCS78
|
|
00081 * REFERENCE: DTSCS78
|
|
00082 * DTSCS78
|
|
00083 * NONE. DTSCS78
|
|
00084 * DTSCS78
|
|
00085 * DTSCS78
|
|
00086 * ACCOUNTING TRANSACTION COLLECTION: DTSCS78
|
|
00087 * DTSCS78
|
|
00088 * NONE. DTSCS78
|
|
00089 * DTSCS78
|
|
00090 * DTSCS78
|
|
00091 * VSAM KSDS WORK: DTSCS78
|
|
00092 * DTSCS78
|
|
00093 * VCOR DTSCS78
|
|
00094 * DTSCS78
|
|
00095 * DTSCS78
|
|
00096 * RECORDS UPDATED: DTSCS78
|
|
00097 * DTSCS78
|
|
00098 * MASTER: DTSCS78
|
|
00099 * DTSCS78
|
|
00100 * NONE. DTSCS78
|
|
00101 * DTSCS78
|
|
00102 * DTSCS78
|
|
00103 * REFERENCE: DTSCS78
|
|
00104 * DTSCS78
|
|
00105 * NONE. DTSCS78
|
|
00106 * DTSCS78
|
|
00107 * DTSCS78
|
|
00108 * ACCOUNTING TRANSACTION COLLECTION: DTSCS78
|
|
00109 * DTSCS78
|
|
00110 * NONE. DTSCS78
|
|
00111 * DTSCS78
|
|
00112 * DTSCS78
|
|
00113 * VSAM KSDS WORK: DTSCS78
|
|
00114 * DTSCS78
|
|
00115 * VCOR DTSCS78
|
|
00116 * DTSCS78
|
|
00117 * DTSCS78
|
|
00118 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS78
|
|
00119 * DTSCS78
|
|
00120 * NONE. DTSCS78
|
|
00121 * DTSCS78
|
|
00122 * DTSCS78
|
|
00123 * TEMPORARY STORAGE USAGE: DTSCS78
|
|
00124 * DTSCS78
|
|
00125 * NONE DTSCS78
|
|
00126 * DTSCS78
|
|
00127 * DTSCS78
|
|
00128 * MODULES LINKED TO: DTSCS78
|
|
00129 * DTSCS78
|
|
00130 * DTSCU082 OPERATOR ID EDIT/LOOKUP. CL**2
|
|
00131 * DTSCU827 VSAM KSDS WORK FILE INPUT/OUTPUT. CL**2
|
|
00132 * DTSCS78
|
|
00133 * DTSCS78
|
|
00134 * VERMONT REFERENCE: DTSCS78
|
|
00135 * DTSCS78
|
|
00136 * NONE. DTSCS78
|
|
00137 * DTSCS78
|
|
00138 ***** DTSCS78
|
|
00139 SKIP3 DTSCS78
|
|
00140 ENVIRONMENT DIVISION. DTSCS78
|
|
00141 SKIP3 DTSCS78
|
|
00142 DATA DIVISION. DTSCS78
|
|
00143 SKIP3 DTSCS78
|
|
00144 WORKING-STORAGE SECTION. DTSCS78
|
|
001445 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS78 08/19/99'. DTSCS78
|
|
00145 SKIP3 DTSCS78
|
|
00146 01 WRK-AREA. DTSCS78
|
|
00147 05 WRK-ABEND-CD PIC X(04) VALUE 'S78 '. DTSCS78
|
|
00148 SKIP1 DTSCS78
|
|
00149 05 WRK-SCR-ID. DTSCS78
|
|
00150 10 WRK-SCR-ID-N PIC 9(02) VALUE 78. DTSCS78
|
|
00151 SKIP1 DTSCS78
|
|
00152 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS78
|
|
00153 SKIP1 DTSCS78
|
|
00154 05 WRK-LINE-MAX PIC S9(04) COMP VALUE +20. DTSCS78
|
|
00155 SKIP1 DTSCS78
|
|
00156 05 WRK-LINE-LENGTH PIC S9(04) COMP VALUE +79. DTSCS78
|
|
00157 SKIP3 DTSCS78
|
|
00158 05 SCR-ACCESS-IND PIC X(01). DTSCS78
|
|
00159 88 SCR-ACCESS-INQ VALUE '1'. DTSCS78
|
|
00160 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS78
|
|
00161 SKIP1 DTSCS78
|
|
00162 05 CURSOR-SET-IND PIC X(01). DTSCS78
|
|
00163 88 CURSOR-SET-YES VALUE 'Y'. DTSCS78
|
|
00164 88 CURSOR-SET-NO VALUE 'N'. DTSCS78
|
|
00165 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS78
|
|
00166 SKIP1 DTSCS78
|
|
00167 05 REQ-IND PIC X(01). DTSCS78
|
|
00168 88 REQ-ERROR VALUE 'O'. DTSCS78
|
|
00169 88 REQ-JUMP VALUE 'J'. DTSCS78
|
|
00170 88 REQ-INQUIRE VALUE 'I'. DTSCS78
|
|
00171 88 REQ-CLEAR VALUE 'C'. DTSCS78
|
|
00172 88 REQ-EDIT VALUE 'E'. DTSCS78
|
|
00173 *********88 REQ-UPDATE VALUE 'U'. DTSCS78
|
|
00174 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS78
|
|
00175 SKIP1 DTSCS78
|
|
00176 05 RESP-IND PIC X(01). DTSCS78
|
|
00177 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS78
|
|
00178 88 RESP-SEND-MAP VALUE 'M'. DTSCS78
|
|
00179 88 RESP-JUMP VALUE 'J'. DTSCS78
|
|
00180 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS78
|
|
00181 SKIP1 DTSCS78
|
|
00182 05 WRK-MSG-AREA PIC X(64). DTSCS78
|
|
00183 SKIP1 DTSCS78
|
|
00184 05 WRK-ATB-AN PIC X(01). DTSCS78
|
|
00185 05 WRK-ATB-NUM PIC X(01). DTSCS78
|
|
00186 SKIP1 DTSCS78
|
|
00187 05 WRK-QUEUE-ID PIC X(08). DTSCS78
|
|
00188 SKIP3 DTSCS78
|
|
00189 05 WRK-DISPLAY PIC 9(11). DTSCS78
|
|
00190 SKIP1 DTSCS78
|
|
00191 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78
|
|
00192 10 FILLER PIC X(05). DTSCS78
|
|
00193 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS78
|
|
00194 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS78
|
|
00195 SKIP1 DTSCS78
|
|
00196 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78
|
|
00197 10 FILLER PIC X(05). DTSCS78
|
|
00198 10 WRK-DISPLAY-YR PIC X(02). DTSCS78
|
|
00199 10 WRK-DISPLAY-MO PIC X(02). DTSCS78
|
|
00200 10 WRK-DISPLAY-DA PIC X(02). DTSCS78
|
|
00201 SKIP1 DTSCS78
|
|
00202 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78
|
|
00203 10 FILLER PIC X(08). DTSCS78
|
|
00204 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS78
|
|
00205 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS78
|
|
00206 SKIP1 DTSCS78
|
|
00207 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78
|
|
00208 10 FILLER PIC X(08). DTSCS78
|
|
00209 10 WRK-DISPLAY-ID-NO PIC X(03). DTSCS78
|
|
00210 SKIP3 DTSCS78
|
|
00211 05 INQUIRY-CONTROL-AREA. DTSCS78
|
|
00212 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS78
|
|
00213 10 WS-REC-NUM PIC S9(08) COMP. DTSCS78
|
|
00214 SKIP1 DTSCS78
|
|
00215 10 SCR-REC-KEY-AREA PIC X(32). DTSCS78
|
|
00216 SKIP1 DTSCS78
|
|
00217 10 WRK-REC-KEY-AREA PIC X(32). DTSCS78
|
|
00218 SKIP1 DTSCS78
|
|
00219 10 LAST-REC-KEY-AREA PIC X(32). DTSCS78
|
|
00220 SKIP1 DTSCS78
|
|
00221 10 WS-REC-FOUND-IND PIC X(01). DTSCS78
|
|
00222 SKIP3 DTSCS78
|
|
00223 05 COR-START PIC S9(04) COMP. DTSCS78
|
|
00224 05 LINE-SUB PIC S9(04) COMP. DTSCS78
|
|
00225 *****EJECT DTSCS78
|
|
00226 *01 MSG-LITERALS. DTSCS78
|
|
00227 *****05 MSG-E781-AREA. DTSCS78
|
|
00228 ***** 10 FILLER PIC X(04) VALUE 'E781'. DTSCS78
|
|
00229 ***** 10 FILLER PIC X(30) DTSCS78
|
|
00230 ***** VALUE ' '. DTSCS78
|
|
00231 ***** 10 FILLER PIC X(30) DTSCS78
|
|
00232 ***** VALUE ' '. DTSCS78
|
|
00233 EJECT DTSCS78
|
|
00234 01 L082-COMM-AREA. DTSCS78
|
|
00235 ++INCLUDE DTSIL082 CL**2
|
|
00236 EJECT DTSCS78
|
|
00237 01 L805-COMM-AREA. DTSCS78
|
|
00238 ++INCLUDE DTSIL805 CL**2
|
|
00239 EJECT DTSCS78
|
|
00240 01 L827-COMM-AREA. DTSCS78
|
|
00241 05 L827-CONTROL-BLOCK. DTSCS78
|
|
00242 ++INCLUDE DTSIL827 CL**2
|
|
00243 EJECT DTSCS78
|
|
00244 05 VSKL-REC. DTSCS78
|
|
00245 ++INCLUDE DTSIVSKL CL**2
|
|
00246 EJECT DTSCS78
|
|
00247 01 VCOR-REC. DTSCS78
|
|
00248 ++INCLUDE DTSIVCOR CL**2
|
|
00249 EJECT DTSCS78
|
|
00250 01 L851-COMM-AREA. DTSCS78
|
|
00251 ++INCLUDE DTSIL851 CL**2
|
|
00252 SKIP3 DTSCS78
|
|
00253 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS78
|
|
00254 ++INCLUDE DTSIS78 CL**2
|
|
00255 EJECT DTSCS78
|
|
00256 01 CATB-LITERALS. DTSCS78
|
|
00257 ++INCLUDE DTSICATB CL**2
|
|
00258 SKIP3 DTSCS78
|
|
00259 01 CFKD-LITERALS. DTSCS78
|
|
00260 ++INCLUDE DTSICFKD CL**2
|
|
00261 SKIP3 DTSCS78
|
|
00262 01 CECD-LITERALS. DTSCS78
|
|
00263 ++INCLUDE DTSICECD CL**2
|
|
00264 SKIP3 DTSCS78
|
|
00265 01 CPCD-LITERALS. DTSCS78
|
|
00266 ++INCLUDE DTSICPCD CL**2
|
|
00267 EJECT DTSCS78
|
|
00268 LINKAGE SECTION. DTSCS78
|
|
00269 SKIP3 DTSCS78
|
|
00270 01 DFHCOMMAREA. DTSCS78
|
|
00271 ++INCLUDE DTSILCCM CL**2
|
|
00272 EJECT DTSCS78
|
|
00273 ******************************************************************DTSCS78
|
|
00274 * *DTSCS78
|
|
00275 ******************************************************************DTSCS78
|
|
00276 SKIP1 DTSCS78
|
|
00277 PROCEDURE DIVISION. DTSCS78
|
|
00278 SKIP2 DTSCS78
|
|
00279 MOVE LOW-VALUES TO MAP-AREA. DTSCS78
|
|
00280 MOVE SPACES TO WRK-QUEUE-ID. DTSCS78
|
|
00281 SKIP1 DTSCS78
|
|
00282 SET CURSOR-SET-NO TO TRUE. DTSCS78
|
|
00283 SKIP1 DTSCS78
|
|
00284 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS78
|
|
00285 TO SCR-ACCESS-IND. DTSCS78
|
|
00286 SKIP3 DTSCS78
|
|
00287 MOVE SPACE TO REQ-IND. DTSCS78
|
|
00288 SKIP1 DTSCS78
|
|
00289 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS78
|
|
00290 SKIP1 DTSCS78
|
|
00291 *----------------------------------------------------- DTSCS78
|
|
00292 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS78
|
|
00293 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS78
|
|
00294 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS78
|
|
00295 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS78
|
|
00296 * DTSCS78
|
|
00297 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS78
|
|
00298 * PROCESSED. DTSCS78
|
|
00299 * DTSCS78
|
|
00300 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS78
|
|
00301 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS78
|
|
00302 * WORK STATION OPERATOR. DTSCS78
|
|
00303 *----------------------------------------------------- DTSCS78
|
|
00304 SKIP1 DTSCS78
|
|
00305 MOVE SPACE TO RESP-IND. DTSCS78
|
|
00306 SKIP1 DTSCS78
|
|
00307 IF REQ-ERROR DTSCS78
|
|
00308 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS78
|
|
00309 ELSE DTSCS78
|
|
00310 IF REQ-JUMP DTSCS78
|
|
00311 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS78
|
|
00312 ELSE DTSCS78
|
|
00313 IF REQ-CLEAR DTSCS78
|
|
00314 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS78
|
|
00315 ELSE DTSCS78
|
|
00316 IF REQ-CURSOR-TO-GOTO DTSCS78
|
|
00317 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS78
|
|
00318 ELSE DTSCS78
|
|
00319 IF REQ-INQUIRE DTSCS78
|
|
00320 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS78
|
|
00321 ELSE DTSCS78
|
|
00322 IF REQ-EDIT DTSCS78
|
|
00323 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS78
|
|
00324 ELSE DTSCS78
|
|
00325 *****IF REQ-UPDATE DTSCS78
|
|
00326 ***** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS78
|
|
00327 *****ELSE DTSCS78
|
|
00328 GO TO S899-ABEND. DTSCS78
|
|
00329 SKIP3 DTSCS78
|
|
00330 *----------------------------------------------------- DTSCS78
|
|
00331 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS78
|
|
00332 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS78
|
|
00333 *----------------------------------------------------- DTSCS78
|
|
00334 SKIP1 DTSCS78
|
|
00335 IF RESP-SEND-MAP DTSCS78
|
|
00336 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS78
|
|
00337 SET LCCM-END-TASK-88 TO TRUE DTSCS78
|
|
00338 ELSE DTSCS78
|
|
00339 IF RESP-SEND-MSGONLY DTSCS78
|
|
00340 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS78
|
|
00341 SET LCCM-END-TASK-88 TO TRUE DTSCS78
|
|
00342 ELSE DTSCS78
|
|
00343 IF RESP-JUMP DTSCS78
|
|
00344 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS78
|
|
00345 ELSE DTSCS78
|
|
00346 IF RESP-CURSOR-TO-GOTO DTSCS78
|
|
00347 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS78
|
|
00348 SET LCCM-END-TASK-88 TO TRUE DTSCS78
|
|
00349 ELSE DTSCS78
|
|
00350 GO TO S899-ABEND. DTSCS78
|
|
00351 SKIP3 DTSCS78
|
|
00352 MAINLINE-EXIT. DTSCS78
|
|
00353 SKIP1 DTSCS78
|
|
00354 EXEC CICS DTSCS78
|
|
00355 RETURN DTSCS78
|
|
00356 END-EXEC. DTSCS78
|
|
00357 SKIP2 DTSCS78
|
|
00358 GOBACK. DTSCS78
|
|
00359 EJECT DTSCS78
|
|
00360 /*****************************************************************DTSCS78
|
|
00361 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS78
|
|
00362 ******************************************************************DTSCS78
|
|
00363 P1000-ANALYZE-REQUEST. DTSCS78
|
|
00364 SKIP1 DTSCS78
|
|
00365 *----------------------------------------------------- DTSCS78
|
|
00366 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS78
|
|
00367 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS78
|
|
00368 * REPLACED WITH ENTER) DTSCS78
|
|
00369 *----------------------------------------------------- DTSCS78
|
|
00370 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS78
|
|
00371 SET LCCM-ENTER-88 TO TRUE DTSCS78
|
|
00372 SET REQ-INQUIRE TO TRUE DTSCS78
|
|
00373 MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID DTSCS78
|
|
00374 GO TO P1000-EXIT. DTSCS78
|
|
00375 SKIP3 DTSCS78
|
|
00376 *----------------------------------------------------- DTSCS78
|
|
00377 * MAP IS RECEIVED DTSCS78
|
|
00378 *----------------------------------------------------- DTSCS78
|
|
00379 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS78
|
|
00380 SKIP3 DTSCS78
|
|
00381 *----------------------------------------------------- DTSCS78
|
|
00382 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS78
|
|
00383 * WORK STATION DTSCS78
|
|
00384 *----------------------------------------------------- DTSCS78
|
|
00385 IF LCCM-CLEAR-88 DTSCS78
|
|
00386 SET REQ-CLEAR TO TRUE DTSCS78
|
|
00387 GO TO P1000-EXIT. DTSCS78
|
|
00388 SKIP3 DTSCS78
|
|
00389 *----------------------------------------------------- DTSCS78
|
|
00390 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS78
|
|
00391 *----------------------------------------------------- DTSCS78
|
|
00392 IF LCCM-PA2-88 DTSCS78
|
|
00393 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS78
|
|
00394 GO TO P1000-EXIT. DTSCS78
|
|
00395 SKIP3 DTSCS78
|
|
00396 *----------------------------------------------------- DTSCS78
|
|
00397 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS78
|
|
00398 *----------------------------------------------------- DTSCS78
|
|
00399 IF LCCM-PA-88 DTSCS78
|
|
00400 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS78
|
|
00401 SET REQ-ERROR TO TRUE DTSCS78
|
|
00402 GO TO P1000-EXIT. DTSCS78
|
|
00403 SKIP3 DTSCS78
|
|
00404 *----------------------------------------------------- CL**2
|
|
00405 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS CL**2
|
|
00406 * CLEAR SCREEN CL**2
|
|
00407 *----------------------------------------------------- CL**2
|
|
00408 IF LCCM-F12-88 CL**2
|
|
00409 MOVE LOW-VALUES TO MAP-AREA CL**2
|
|
00410 SET REQ-CLEAR TO TRUE CL**2
|
|
00411 GO TO P1000-EXIT. CL**2
|
|
00412 SKIP3 CL**2
|
|
00413 *----------------------------------------------------- DTSCS78
|
|
00414 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS78
|
|
00415 *----------------------------------------------------- DTSCS78
|
|
00416 IF LCCM-F03-88 DTSCS78
|
|
00417 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS78
|
|
00418 SET REQ-JUMP TO TRUE DTSCS78
|
|
00419 GO TO P1000-EXIT. DTSCS78
|
|
00420 SKIP3 DTSCS78
|
|
00421 *----------------------------------------------------- DTSCS78
|
|
00422 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS78
|
|
00423 *----------------------------------------------------- DTSCS78
|
|
00424 IF LCCM-F04-88 DTSCS78
|
|
00425 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS78
|
|
00426 SET REQ-JUMP TO TRUE DTSCS78
|
|
00427 GO TO P1000-EXIT. DTSCS78
|
|
00428 SKIP3 DTSCS78
|
|
00429 *----------------------------------------------------- DTSCS78
|
|
00430 * IF F14 IS PRESSED, THE HLAPI IS CONFUSED. DTSCS78
|
|
00431 * HUMOR IT BY PRETENDING THAT THE ENTER KEY WAS PRESSED. DTSCS78
|
|
00432 *----------------------------------------------------- DTSCS78
|
|
00433 IF LCCM-F14-88 CL**4
|
|
00434 SET LCCM-ENTER-88 TO TRUE CL**4
|
|
00435 SET REQ-INQUIRE TO TRUE CL**4
|
|
00436 GO TO P1000-EXIT. CL**4
|
|
00437 SKIP3 CL**4
|
|
00438 *----------------------------------------------------- DTSCS78
|
|
00439 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS78
|
|
00440 * REQUESTED SCREEN TYPE DTSCS78
|
|
00441 *----------------------------------------------------- DTSCS78
|
|
00442 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS78
|
|
00443 NEXT SENTENCE DTSCS78
|
|
00444 ELSE DTSCS78
|
|
00445 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS78
|
|
00446 SET REQ-JUMP TO TRUE DTSCS78
|
|
00447 GO TO P1000-EXIT. DTSCS78
|
|
00448 SKIP3 DTSCS78
|
|
00449 *----------------------------------------------------- DTSCS78
|
|
00450 * IF REQUEST TO UPDATE THE DATA (DEL) DTSCS78
|
|
00451 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS78
|
|
00452 *----------------------------------------------------- DTSCS78
|
|
00453 IF LCCM-F23-88 CL**5
|
|
00454 IF SCR-ACCESS-UPDATE DTSCS78
|
|
00455 SET REQ-EDIT TO TRUE DTSCS78
|
|
00456 GO TO P1000-EXIT DTSCS78
|
|
00457 ELSE DTSCS78
|
|
00458 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS78
|
|
00459 SET REQ-ERROR TO TRUE DTSCS78
|
|
00460 GO TO P1000-EXIT. DTSCS78
|
|
00461 SKIP3 DTSCS78
|
|
00462 *----------------------------------------------------- DTSCS78
|
|
00463 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS78
|
|
00464 * OR F8), INDICATE INQUIRY REQUEST DTSCS78
|
|
00465 *----------------------------------------------------- DTSCS78
|
|
00466 IF LCCM-INQUIRY-88 DTSCS78
|
|
00467 SET REQ-INQUIRE TO TRUE DTSCS78
|
|
00468 GO TO P1000-EXIT. DTSCS78
|
|
00469 SKIP3 DTSCS78
|
|
00470 *----------------------------------------------------- DTSCS78
|
|
00471 * ANY OTHER KEY IS INVALID DTSCS78
|
|
00472 *----------------------------------------------------- DTSCS78
|
|
00473 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS78
|
|
00474 SET REQ-ERROR TO TRUE. DTSCS78
|
|
00475 P1000-EXIT. DTSCS78
|
|
00476 EXIT. DTSCS78
|
|
00477 /*****************************************************************DTSCS78
|
|
00478 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS78
|
|
00479 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS78
|
|
00480 ******************************************************************DTSCS78
|
|
00481 SKIP1 DTSCS78
|
|
00482 P2000-REQUEST-ERROR. DTSCS78
|
|
00483 IF LCCM-MSG DTSCS78
|
|
00484 SET RESP-SEND-MSGONLY TO TRUE DTSCS78
|
|
00485 ELSE DTSCS78
|
|
00486 GO TO S899-ABEND. DTSCS78
|
|
00487 P2000-EXIT. DTSCS78
|
|
00488 EXIT. DTSCS78
|
|
00489 /*****************************************************************DTSCS78
|
|
00490 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS78
|
|
00491 ******************************************************************DTSCS78
|
|
00492 SKIP1 DTSCS78
|
|
00493 P3000-REQUEST-JUMP. DTSCS78
|
|
00494 *----------------------------------------------------- DTSCS78
|
|
00495 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS78
|
|
00496 * BY USER DTSCS78
|
|
00497 *----------------------------------------------------- DTSCS78
|
|
00498 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS78
|
|
00499 SKIP3 DTSCS78
|
|
00500 *----------------------------------------------------- DTSCS78
|
|
00501 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS78
|
|
00502 *----------------------------------------------------- DTSCS78
|
|
00503 IF LCCM-MSG DTSCS78
|
|
00504 SET RESP-SEND-MSGONLY TO TRUE DTSCS78
|
|
00505 SET CURSOR-SET-GOTO TO TRUE DTSCS78
|
|
00506 GO TO P3000-EXIT. DTSCS78
|
|
00507 SKIP3 DTSCS78
|
|
00508 *----------------------------------------------------- DTSCS78
|
|
00509 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS78
|
|
00510 *----------------------------------------------------- DTSCS78
|
|
00511 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS78
|
|
00512 LCCM-SCR-HOLD-AREA. DTSCS78
|
|
00513 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS78
|
|
00514 SET RESP-JUMP TO TRUE. DTSCS78
|
|
00515 P3000-EXIT. DTSCS78
|
|
00516 EXIT. DTSCS78
|
|
00517 /*****************************************************************DTSCS78
|
|
00518 * CLEAR KEY WAS PRESSED *DTSCS78
|
|
00519 ******************************************************************DTSCS78
|
|
00520 SKIP1 DTSCS78
|
|
00521 P4000-REQUEST-CLEAR. DTSCS78
|
|
00522 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS78
|
|
00523 SKIP3 DTSCS78
|
|
00524 *----------------------------------------------------- DTSCS78
|
|
00525 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS78
|
|
00526 * FIELDS FROM EARLIER REQUESTS DTSCS78
|
|
00527 *----------------------------------------------------- DTSCS78
|
|
00528 SKIP1 DTSCS78
|
|
00529 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS78
|
|
00530 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS78
|
|
00531 SET LCCM-SCR-CLEAR TO TRUE. DTSCS78
|
|
00532 SET RESP-SEND-MAP TO TRUE. DTSCS78
|
|
00533 P4000-EXIT. DTSCS78
|
|
00534 EXIT. DTSCS78
|
|
00535 /*****************************************************************DTSCS78
|
|
00536 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS78
|
|
00537 ******************************************************************DTSCS78
|
|
00538 SKIP1 DTSCS78
|
|
00539 P5000-CURSOR-TO-GOTO. DTSCS78
|
|
00540 SET CURSOR-SET-GOTO TO TRUE. DTSCS78
|
|
00541 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS78
|
|
00542 P5000-EXIT. DTSCS78
|
|
00543 EXIT. DTSCS78
|
|
00544 /*****************************************************************DTSCS78
|
|
00545 * INQUIRY WAS REQUESTED *DTSCS78
|
|
00546 ******************************************************************DTSCS78
|
|
00547 SKIP1 DTSCS78
|
|
00548 P6000-REQUEST-INQUIRE. DTSCS78
|
|
00549 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID. DTSCS78
|
|
00550 MOVE LOW-VALUES TO MAP-AREA. DTSCS78
|
|
00551 MOVE L082-OP-ID TO MAP-QUEUE-OP-ID. DTSCS78
|
|
00552 SKIP1 DTSCS78
|
|
00553 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS78
|
|
00554 SKIP1 DTSCS78
|
|
00555 SET LCCM-SCR-CLEAR TO TRUE. DTSCS78
|
|
00556 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS78
|
|
00557 SKIP1 DTSCS78
|
|
00558 SET RESP-SEND-MAP TO TRUE. DTSCS78
|
|
00559 SKIP1 DTSCS78
|
|
00560 MOVE LCCM-SCR-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS78
|
|
00561 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS78
|
|
00562 SKIP1 DTSCS78
|
|
00563 INSPECT MAP-QUEUE-OP-ID DTSCS78
|
|
00564 CONVERTING LOW-VALUES TO SPACES. DTSCS78
|
|
00565 IF MAP-QUEUE-OP-ID = SPACES DTSCS78
|
|
00566 MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID. DTSCS78
|
|
00567 SKIP1 DTSCS78
|
|
00568 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS78
|
|
00569 IF LCCM-MSG DTSCS78
|
|
00570 GO TO P6000-EXIT. DTSCS78
|
|
00571 SKIP1 DTSCS78
|
|
00572 MOVE LOW-VALUES TO VCOR-KEY-AREA. DTSCS78
|
|
00573 SET VCOR-COR-88 TO TRUE. DTSCS78
|
|
00574 MOVE WRK-QUEUE-ID TO VCOR-QUEUE-ID. DTSCS78
|
|
00575 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78
|
|
00576 PERFORM S827-START-BROWSE THRU S827-EXIT. DTSCS78
|
|
00577 SKIP1 DTSCS78
|
|
00578 MOVE +0 TO LAST-REC-NUM. DTSCS78
|
|
00579 PERFORM P6010-SCAN-VCOR THRU P6010-EXIT DTSCS78
|
|
00580 UNTIL L827-NO-REC-88. DTSCS78
|
|
00581 IF LAST-REC-NUM = +0 DTSCS78
|
|
00582 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00583 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00584 GO TO P6000-EXIT. DTSCS78
|
|
00585 SKIP1 DTSCS78
|
|
00586 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS78
|
|
00587 IF LCCM-MSG DTSCS78
|
|
00588 GO TO P6000-EXIT. DTSCS78
|
|
00589 SKIP1 DTSCS78
|
|
00590 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS78
|
|
00591 SKIP1 DTSCS78
|
|
00592 MOVE VCOR-KEY-AREA TO LCCM-SCR-HOLD-AREA. DTSCS78
|
|
00593 SKIP1 DTSCS78
|
|
00594 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS78
|
|
00595 P6000-EXIT. DTSCS78
|
|
00596 EXIT. DTSCS78
|
|
00597 SKIP3 DTSCS78
|
|
00598 P6010-SCAN-VCOR. DTSCS78
|
|
00599 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00600 IF WRK-QUEUE-ID = VCOR-QUEUE-ID DTSCS78
|
|
00601 NEXT SENTENCE DTSCS78
|
|
00602 ELSE DTSCS78
|
|
00603 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78
|
|
00604 SET L827-NO-REC-88 TO TRUE DTSCS78
|
|
00605 GO TO P6010-EXIT. DTSCS78
|
|
00606 SKIP1 DTSCS78
|
|
00607 ADD +1 TO LAST-REC-NUM. DTSCS78
|
|
00608 MOVE VCOR-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS78
|
|
00609 SKIP1 DTSCS78
|
|
00610 PERFORM S827-READ-NEXT THRU S827-EXIT. DTSCS78
|
|
00611 P6010-EXIT. DTSCS78
|
|
00612 EXIT. DTSCS78
|
|
00613 EJECT DTSCS78
|
|
00614 P6100-LOCATE-REC. DTSCS78
|
|
00615 *------------------------------------------------------------ DTSCS78
|
|
00616 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS78
|
|
00617 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS78
|
|
00618 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS78
|
|
00619 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS78
|
|
00620 * FIRST VCOR RECORD WITH VCOR-QUEUE-ID EQUAL TO DTSCS78
|
|
00621 * MAP-QUEUE-OP-ID. DTSCS78
|
|
00622 *------------------------------------------------------------ DTSCS78
|
|
00623 SKIP1 DTSCS78
|
|
00624 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS78
|
|
00625 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78
|
|
00626 GO TO P6100-EXIT. DTSCS78
|
|
00627 SKIP1 DTSCS78
|
|
00628 MOVE SCR-REC-KEY-AREA TO VCOR-KEY-AREA. DTSCS78
|
|
00629 SKIP1 DTSCS78
|
|
00630 IF WRK-QUEUE-ID = VCOR-QUEUE-ID DTSCS78
|
|
00631 NEXT SENTENCE DTSCS78
|
|
00632 ELSE DTSCS78
|
|
00633 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78
|
|
00634 GO TO P6100-EXIT. DTSCS78
|
|
00635 SKIP3 DTSCS78
|
|
00636 IF LCCM-F05-88 DTSCS78
|
|
00637 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78
|
|
00638 GO TO P6100-EXIT. DTSCS78
|
|
00639 SKIP1 DTSCS78
|
|
00640 IF LCCM-F06-88 DTSCS78
|
|
00641 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS78
|
|
00642 GO TO P6100-EXIT. DTSCS78
|
|
00643 SKIP3 DTSCS78
|
|
00644 MOVE LOW-VALUES TO VCOR-KEY-AREA. DTSCS78
|
|
00645 SET VCOR-COR-88 TO TRUE. DTSCS78
|
|
00646 MOVE WRK-QUEUE-ID TO VCOR-QUEUE-ID. DTSCS78
|
|
00647 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78
|
|
00648 PERFORM S827-START-BROWSE THRU S827-EXIT. DTSCS78
|
|
00649 IF L827-NO-REC-88 DTSCS78
|
|
00650 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00651 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00652 GO TO P6100-EXIT. DTSCS78
|
|
00653 SKIP1 DTSCS78
|
|
00654 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00655 SKIP1 DTSCS78
|
|
00656 IF VCOR-QUEUE-ID = WRK-QUEUE-ID DTSCS78
|
|
00657 NEXT SENTENCE DTSCS78
|
|
00658 ELSE DTSCS78
|
|
00659 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78
|
|
00660 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00661 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00662 GO TO P6100-EXIT. DTSCS78
|
|
00663 SKIP1 DTSCS78
|
|
00664 MOVE +0 TO WS-REC-NUM. DTSCS78
|
|
00665 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS78
|
|
00666 PERFORM P6190-BROWSE-VCOR THRU P6190-EXIT DTSCS78
|
|
00667 UNTIL (L827-NO-REC-88) DTSCS78
|
|
00668 OR DTSCS78
|
|
00669 (WS-REC-FOUND-IND = 'Y'). DTSCS78
|
|
00670 SKIP1 DTSCS78
|
|
00671 IF L827-NO-REC-88 DTSCS78
|
|
00672 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78
|
|
00673 GO TO P6100-EXIT. DTSCS78
|
|
00674 SKIP3 DTSCS78
|
|
00675 IF LCCM-ENTER-88 DTSCS78
|
|
00676 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78
|
|
00677 GO TO P6100-EXIT. DTSCS78
|
|
00678 SKIP1 DTSCS78
|
|
00679 IF LCCM-F07-88 DTSCS78
|
|
00680 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS78
|
|
00681 GO TO P6100-EXIT. DTSCS78
|
|
00682 SKIP1 DTSCS78
|
|
00683 IF LCCM-F08-88 DTSCS78
|
|
00684 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS78
|
|
00685 GO TO P6100-EXIT. DTSCS78
|
|
00686 SKIP3 DTSCS78
|
|
00687 GO TO S899-ABEND. DTSCS78
|
|
00688 P6100-EXIT. DTSCS78
|
|
00689 EXIT. DTSCS78
|
|
00690 SKIP3 DTSCS78
|
|
00691 P6110-FIRST-REC. DTSCS78
|
|
00692 MOVE LOW-VALUES TO VCOR-KEY-AREA. DTSCS78
|
|
00693 SET VCOR-COR-88 TO TRUE. DTSCS78
|
|
00694 MOVE WRK-QUEUE-ID TO VCOR-QUEUE-ID. DTSCS78
|
|
00695 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78
|
|
00696 PERFORM S827-START-BROWSE THRU S827-EXIT. DTSCS78
|
|
00697 IF L827-NO-REC-88 DTSCS78
|
|
00698 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00699 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00700 GO TO P6110-EXIT. DTSCS78
|
|
00701 SKIP1 DTSCS78
|
|
00702 PERFORM S827-END-BROWSE THRU S827-EXIT. DTSCS78
|
|
00703 SKIP1 DTSCS78
|
|
00704 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00705 SKIP1 DTSCS78
|
|
00706 IF WRK-QUEUE-ID = VCOR-QUEUE-ID DTSCS78
|
|
00707 NEXT SENTENCE DTSCS78
|
|
00708 ELSE DTSCS78
|
|
00709 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00710 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00711 GO TO P6110-EXIT. DTSCS78
|
|
00712 SKIP1 DTSCS78
|
|
00713 MOVE +1 TO WS-REC-NUM. DTSCS78
|
|
00714 P6110-EXIT. DTSCS78
|
|
00715 EXIT. DTSCS78
|
|
00716 SKIP3 DTSCS78
|
|
00717 P6120-PREV-REC. DTSCS78
|
|
00718 PERFORM S827-READ-PREV THRU S827-EXIT. DTSCS78
|
|
00719 IF L827-NO-REC-88 DTSCS78
|
|
00720 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00721 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00722 GO TO P6120-EXIT. DTSCS78
|
|
00723 SKIP1 DTSCS78
|
|
00724 PERFORM S827-READ-PREV THRU S827-EXIT. DTSCS78
|
|
00725 IF L827-NO-REC-88 DTSCS78
|
|
00726 GO TO P6120-EXIT. DTSCS78
|
|
00727 SKIP1 DTSCS78
|
|
00728 PERFORM S827-END-BROWSE THRU S827-EXIT. DTSCS78
|
|
00729 SKIP1 DTSCS78
|
|
00730 IF WRK-QUEUE-ID = VSKL-KEY-AREA (3:8) DTSCS78
|
|
00731 NEXT SENTENCE DTSCS78
|
|
00732 ELSE DTSCS78
|
|
00733 GO TO P6120-EXIT. DTSCS78
|
|
00734 SKIP1 DTSCS78
|
|
00735 SUBTRACT 1 FROM WS-REC-NUM. DTSCS78
|
|
00736 SKIP1 DTSCS78
|
|
00737 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00738 P6120-EXIT. DTSCS78
|
|
00739 EXIT. DTSCS78
|
|
00740 SKIP3 DTSCS78
|
|
00741 P6130-NEXT-REC. DTSCS78
|
|
00742 IF VCOR-KEY-AREA > SCR-REC-KEY-AREA DTSCS78
|
|
00743 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78
|
|
00744 GO TO P6130-EXIT. DTSCS78
|
|
00745 SKIP1 DTSCS78
|
|
00746 PERFORM S827-READ-NEXT THRU S827-EXIT. DTSCS78
|
|
00747 SKIP1 DTSCS78
|
|
00748 IF L827-NO-REC-88 DTSCS78
|
|
00749 GO TO P6130-EXIT. DTSCS78
|
|
00750 SKIP1 DTSCS78
|
|
00751 PERFORM S827-END-BROWSE THRU S827-EXIT. DTSCS78
|
|
00752 SKIP1 DTSCS78
|
|
00753 IF WRK-QUEUE-ID = VSKL-KEY-AREA (3:8) DTSCS78
|
|
00754 NEXT SENTENCE DTSCS78
|
|
00755 ELSE DTSCS78
|
|
00756 GO TO P6130-EXIT. DTSCS78
|
|
00757 SKIP1 DTSCS78
|
|
00758 ADD +1 TO WS-REC-NUM. DTSCS78
|
|
00759 SKIP1 DTSCS78
|
|
00760 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00761 P6130-EXIT. DTSCS78
|
|
00762 EXIT. DTSCS78
|
|
00763 SKIP3 DTSCS78
|
|
00764 P6140-LAST-REC. DTSCS78
|
|
00765 MOVE LAST-REC-KEY-AREA TO VSKL-KEY-AREA. DTSCS78
|
|
00766 PERFORM S827-READ THRU S827-EXIT. DTSCS78
|
|
00767 IF L827-NO-REC-88 DTSCS78
|
|
00768 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78
|
|
00769 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00770 GO TO P6140-EXIT. DTSCS78
|
|
00771 SKIP1 DTSCS78
|
|
00772 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00773 SKIP1 DTSCS78
|
|
00774 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS78
|
|
00775 P6140-EXIT. DTSCS78
|
|
00776 EXIT. DTSCS78
|
|
00777 SKIP3 DTSCS78
|
|
00778 P6190-BROWSE-VCOR. DTSCS78
|
|
00779 MOVE VSKL-REC TO VCOR-REC. DTSCS78
|
|
00780 SKIP1 DTSCS78
|
|
00781 IF VCOR-QUEUE-ID = WRK-QUEUE-ID DTSCS78
|
|
00782 NEXT SENTENCE DTSCS78
|
|
00783 ELSE DTSCS78
|
|
00784 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78
|
|
00785 SET L827-NO-REC-88 TO TRUE DTSCS78
|
|
00786 GO TO P6190-EXIT. DTSCS78
|
|
00787 SKIP1 DTSCS78
|
|
00788 ADD +1 TO WS-REC-NUM. DTSCS78
|
|
00789 SKIP1 DTSCS78
|
|
00790 IF VCOR-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS78
|
|
00791 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS78
|
|
00792 ELSE DTSCS78
|
|
00793 PERFORM S827-READ-NEXT THRU S827-EXIT. DTSCS78
|
|
00794 P6190-EXIT. DTSCS78
|
|
00795 EXIT. DTSCS78
|
|
00796 /*****************************************************************DTSCS78
|
|
00797 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS78
|
|
00798 ******************************************************************DTSCS78
|
|
00799 SKIP1 DTSCS78
|
|
00800 P6900-CONSTRUCT-SCREEN. DTSCS78
|
|
00801 PERFORM P6910-FROM-VCOR THRU P6910-EXIT. DTSCS78
|
|
00802 SKIP1 DTSCS78
|
|
00803 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS78
|
|
00804 P6900-EXIT. DTSCS78
|
|
00805 EXIT. DTSCS78
|
|
00806 SKIP3 DTSCS78
|
|
00807 P6910-FROM-VCOR. DTSCS78
|
|
00808 PERFORM P6911-DATA THRU P6911-EXIT DTSCS78
|
|
00809 VARYING LINE-SUB FROM 1 BY 1 DTSCS78
|
|
00810 UNTIL LINE-SUB > WRK-LINE-MAX. DTSCS78
|
|
00811 P6910-EXIT. DTSCS78
|
|
00812 EXIT. DTSCS78
|
|
00813 SKIP3 DTSCS78
|
|
00814 P6911-DATA. DTSCS78
|
|
00815 COMPUTE COR-START DTSCS78
|
|
00816 = ((LINE-SUB - 1) * WRK-LINE-LENGTH) + 1. DTSCS78
|
|
00817 SKIP1 DTSCS78
|
|
00818 MOVE VCOR-DATA (COR-START:WRK-LINE-LENGTH) DTSCS78
|
|
00819 TO MAP-DATA (LINE-SUB). DTSCS78
|
|
00820 P6911-EXIT. DTSCS78
|
|
00821 EXIT. DTSCS78
|
|
00822 SKIP3 DTSCS78
|
|
00823 P6990-PAGE-NUMBER. DTSCS78
|
|
00824 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS78
|
|
00825 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS78
|
|
00826 SKIP1 DTSCS78
|
|
00827 IF WS-REC-NUM = +1 DTSCS78
|
|
00828 IF LAST-REC-NUM = +1 DTSCS78
|
|
00829 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS78
|
|
00830 ELSE DTSCS78
|
|
00831 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS78
|
|
00832 ELSE DTSCS78
|
|
00833 IF WS-REC-NUM = LAST-REC-NUM DTSCS78
|
|
00834 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS78
|
|
00835 P6990-EXIT. DTSCS78
|
|
00836 EXIT. DTSCS78
|
|
00837 /*****************************************************************DTSCS78
|
|
00838 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED. *DTSCS78
|
|
00839 ******************************************************************DTSCS78
|
|
00840 SKIP1 DTSCS78
|
|
00841 P7000-REQUEST-EDIT. DTSCS78
|
|
00842 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS78
|
|
00843 SKIP1 DTSCS78
|
|
00844 IF LCCM-F23-88 CL**5
|
|
00845 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS78
|
|
00846 ELSE DTSCS78
|
|
00847 GO TO S899-ABEND. DTSCS78
|
|
00848 SKIP3 DTSCS78
|
|
00849 SET RESP-SEND-MAP TO TRUE. DTSCS78
|
|
00850 P7000-EXIT. DTSCS78
|
|
00851 EXIT. DTSCS78
|
|
00852 /*****************************************************************DTSCS78
|
|
00853 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS78
|
|
00854 ******************************************************************DTSCS78
|
|
00855 SKIP1 DTSCS78
|
|
00856 P7300-EDIT-DEL. DTSCS78
|
|
00857 *----------------------------------------------------- DTSCS78
|
|
00858 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS78
|
|
00859 * INQUIRED DTSCS78
|
|
00860 *----------------------------------------------------- DTSCS78
|
|
00861 IF NOT LCCM-SCR-INQUIRE DTSCS78
|
|
00862 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS78
|
|
00863 GO TO P7300-EXIT. DTSCS78
|
|
00864 SKIP3 DTSCS78
|
|
00865 *----------------------------------------------------- DTSCS78
|
|
00866 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS78
|
|
00867 *----------------------------------------------------- DTSCS78
|
|
00868 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS78
|
|
00869 IF LCCM-MSG DTSCS78
|
|
00870 GO TO P7300-EXIT. DTSCS78
|
|
00871 SKIP1 DTSCS78
|
|
00872 MOVE LCCM-SCR-HOLD-AREA TO VCOR-KEY-AREA. DTSCS78
|
|
00873 IF VCOR-QUEUE-ID = WRK-QUEUE-ID DTSCS78
|
|
00874 NEXT SENTENCE DTSCS78
|
|
00875 ELSE DTSCS78
|
|
00876 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS78
|
|
00877 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
00878 GO TO P7300-EXIT. DTSCS78
|
|
00879 SKIP1 DTSCS78
|
|
00880 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78
|
|
00881 PERFORM S827-READ THRU S827-EXIT. DTSCS78
|
|
00882 IF L827-OK-88 DTSCS78
|
|
00883 PERFORM S827-DELETE THRU S827-EXIT. DTSCS78
|
|
00884 SKIP1 DTSCS78
|
|
00885 SET LCCM-F08-88 TO TRUE. DTSCS78
|
|
00886 SKIP1 DTSCS78
|
|
00887 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS78
|
|
00888 P7300-EXIT. DTSCS78
|
|
00889 EXIT. DTSCS78
|
|
00890 /*****************************************************************DTSCS78
|
|
00891 * LINKS TO UTILITY MODULES DTSCS78
|
|
00892 ******************************************************************DTSCS78
|
|
00893 SKIP1 DTSCS78
|
|
00894 S082-OP-ID-LOOKUP. DTSCS78
|
|
00895 EXEC CICS LINK DTSCS78
|
|
00896 PROGRAM('DTSCU082') CL**2
|
|
00897 COMMAREA(L082-COMM-AREA) DTSCS78
|
|
00898 END-EXEC. DTSCS78
|
|
00899 SKIP1 DTSCS78
|
|
00900 IF L082-FILE-CLOSED DTSCS78
|
|
00901 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS78
|
|
00902 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS78
|
|
00903 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS78
|
|
00904 GO TO MAINLINE-EXIT. DTSCS78
|
|
00905 S082-EXIT. DTSCS78
|
|
00906 EXIT. DTSCS78
|
|
00907 SKIP3 DTSCS78
|
|
00908 S803-REQ-SCR-ID-EDIT. DTSCS78
|
|
00909 EXEC CICS LINK DTSCS78
|
|
00910 PROGRAM('DTSCU803') CL**2
|
|
00911 COMMAREA(DFHCOMMAREA) DTSCS78
|
|
00912 END-EXEC. DTSCS78
|
|
00913 S803-EXIT. DTSCS78
|
|
00914 EXIT. DTSCS78
|
|
00915 SKIP3 DTSCS78
|
|
00916 S804-INVALID-KEY. DTSCS78
|
|
00917 EXEC CICS LINK DTSCS78
|
|
00918 PROGRAM('DTSCU804') CL**2
|
|
00919 COMMAREA(DFHCOMMAREA) DTSCS78
|
|
00920 END-EXEC. DTSCS78
|
|
00921 S804-EXIT. DTSCS78
|
|
00922 EXIT. DTSCS78
|
|
00923 SKIP3 DTSCS78
|
|
00924 S805-MSG-AREA. DTSCS78
|
|
00925 MOVE LCCM-MSG-AREA TO L805-MSG-AREA. DTSCS78
|
|
00926 SKIP1 DTSCS78
|
|
00927 EXEC CICS LINK DTSCS78
|
|
00928 PROGRAM('DTSCU805') CL**2
|
|
00929 COMMAREA(L805-COMM-AREA) DTSCS78
|
|
00930 END-EXEC. DTSCS78
|
|
00931 SKIP1 DTSCS78
|
|
00932 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS78
|
|
00933 S805-EXIT. DTSCS78
|
|
00934 EXIT. DTSCS78
|
|
00935 EJECT DTSCS78
|
|
00936 S827-READ. DTSCS78
|
|
00937 SET L827-READ-88 TO TRUE. DTSCS78
|
|
00938 GO TO S827-IO. DTSCS78
|
|
00939 SKIP1 DTSCS78
|
|
00940 S827-START-BROWSE. DTSCS78
|
|
00941 SET L827-START-BROWSE-88 TO TRUE. DTSCS78
|
|
00942 GO TO S827-IO. DTSCS78
|
|
00943 SKIP1 DTSCS78
|
|
00944 S827-READ-NEXT. DTSCS78
|
|
00945 SET L827-READ-NEXT-88 TO TRUE. DTSCS78
|
|
00946 GO TO S827-IO. DTSCS78
|
|
00947 SKIP1 DTSCS78
|
|
00948 S827-READ-PREV. DTSCS78
|
|
00949 SET L827-READ-PREV-88 TO TRUE. DTSCS78
|
|
00950 GO TO S827-IO. DTSCS78
|
|
00951 SKIP1 DTSCS78
|
|
00952 S827-END-BROWSE. DTSCS78
|
|
00953 SET L827-END-BROWSE-88 TO TRUE. DTSCS78
|
|
00954 GO TO S827-IO. DTSCS78
|
|
00955 SKIP1 DTSCS78
|
|
00956 S827-REWRITE. DTSCS78
|
|
00957 SET L827-REWRITE-88 TO TRUE. DTSCS78
|
|
00958 GO TO S827-IO. DTSCS78
|
|
00959 SKIP1 DTSCS78
|
|
00960 S827-WRITE. DTSCS78
|
|
00961 SET L827-WRITE-88 TO TRUE. DTSCS78
|
|
00962 GO TO S827-IO. DTSCS78
|
|
00963 SKIP1 DTSCS78
|
|
00964 S827-DELETE. DTSCS78
|
|
00965 SET L827-DELETE-88 TO TRUE. DTSCS78
|
|
00966 GO TO S827-IO. DTSCS78
|
|
00967 SKIP1 DTSCS78
|
|
00968 S827-IO. DTSCS78
|
|
00969 SKIP1 DTSCS78
|
|
00970 EXEC CICS LINK DTSCS78
|
|
00971 PROGRAM ('DTSCU827') CL**2
|
|
00972 COMMAREA (L827-COMM-AREA) DTSCS78
|
|
00973 END-EXEC. DTSCS78
|
|
00974 SKIP1 DTSCS78
|
|
00975 IF L827-FILE-CLOSED-88 DTSCS78
|
|
00976 MOVE L827-MSG-AREA TO LCCM-MSG-AREA DTSCS78
|
|
00977 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS78
|
|
00978 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS78
|
|
00979 GO TO MAINLINE-EXIT. DTSCS78
|
|
00980 S827-EXIT. DTSCS78
|
|
00981 EXIT. DTSCS78
|
|
00982 EJECT DTSCS78
|
|
00983 S851-SCREEN-PROCESSING. DTSCS78
|
|
00984 EXEC CICS LINK DTSCS78
|
|
00985 PROGRAM ('DTSCU851') CL**3
|
|
00986 COMMAREA (L851-COMM-AREA) DTSCS78
|
|
00987 END-EXEC. DTSCS78
|
|
00988 S851-EXIT. DTSCS78
|
|
00989 EXIT. DTSCS78
|
|
00990 SKIP3 DTSCS78
|
|
00991 S899-ABEND. DTSCS78
|
|
00992 EXEC CICS ABEND DTSCS78
|
|
00993 ABCODE(WRK-ABEND-CD) DTSCS78
|
|
00994 END-EXEC. DTSCS78
|
|
00995 S899-EXIT. DTSCS78
|
|
00996 EXIT. DTSCS78
|
|
00997 EJECT DTSCS78
|
|
00998 S1100-EDIT-KEY. DTSCS78
|
|
00999 PERFORM S1110-QUEUE-ID THRU S1110-EXIT. DTSCS78
|
|
01000 S1100-EXIT. EXIT. DTSCS78
|
|
01001 /*****************************************************************DTSCS78
|
|
01002 * DTSCS78
|
|
01003 ******************************************************************DTSCS78
|
|
01004 S1110-QUEUE-ID. DTSCS78
|
|
01005 INSPECT MAP-QUEUE-OP-ID DTSCS78
|
|
01006 CONVERTING LOW-VALUES TO SPACES. DTSCS78
|
|
01007 SKIP1 DTSCS78
|
|
01008 IF MAP-QUEUE-OP-ID = SPACES DTSCS78
|
|
01009 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS78
|
|
01010 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78
|
|
01011 GO TO S1110-EXIT. DTSCS78
|
|
01012 SKIP1 DTSCS78
|
|
01013 IF MAP-QUEUE-OP-ID = LCCM-CORR-QUEUE-OP-ID DTSCS78
|
|
01014 MOVE MAP-QUEUE-OP-ID TO WRK-QUEUE-ID DTSCS78
|
|
01015 GO TO S1110-EXIT. DTSCS78
|
|
01016 SKIP1 DTSCS78
|
|
01017 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID. DTSCS78
|
|
01018 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS78
|
|
01019 IF L082-VALID-OP DTSCS78
|
|
01020 MOVE MAP-QUEUE-OP-ID TO WRK-QUEUE-ID DTSCS78
|
|
01021 LCCM-CORR-QUEUE-OP-ID DTSCS78
|
|
01022 ELSE DTSCS78
|
|
01023 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS78
|
|
01024 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS78
|
|
01025 S1110-EXIT. EXIT. DTSCS78
|
|
01026 SKIP3 DTSCS78
|
|
01027 S1199-ERROR. DTSCS78
|
|
01028 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-QUEUE-OP-ID-A. DTSCS78
|
|
01029 IF LCCM-NO-MSG DTSCS78
|
|
01030 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS78
|
|
01031 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L DTSCS78
|
|
01032 SET CURSOR-SET-YES TO TRUE. DTSCS78
|
|
01033 S1199-EXIT. EXIT. DTSCS78
|
|
01034 /*****************************************************************DTSCS78
|
|
01035 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS78
|
|
01036 ******************************************************************DTSCS78
|
|
01037 *S5100-SET-LOCK-ATTRB. DTSCS78
|
|
01038 *****MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS78
|
|
01039 ***** WRK-ATB-NUM. DTSCS78
|
|
01040 *****SKIP1 DTSCS78
|
|
01041 *****PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS78
|
|
01042 *****SKIP1 DTSCS78
|
|
01043 *****MOVE CATB-ASKIP-BRT-MDTON TO MAP-QUEUE-OP-ID-A DTSCS78
|
|
01044 ***** MAP-GOTO-A. DTSCS78
|
|
01045 *S5100-EXIT. DTSCS78
|
|
01046 *****EXIT. DTSCS78
|
|
01047 *****SKIP3 DTSCS78
|
|
01048 ******************************************************************DTSCS78
|
|
01049 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS78
|
|
01050 ******************************************************************DTSCS78
|
|
01051 *S5200-SET-UPDATE-ATTRB. DTSCS78
|
|
01052 *****MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS78
|
|
01053 *****MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS78
|
|
01054 *****SKIP1 DTSCS78
|
|
01055 *****PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS78
|
|
01056 *S5200-EXIT. DTSCS78
|
|
01057 *****EXIT. DTSCS78
|
|
01058 *****SKIP3 DTSCS78
|
|
01059 ******************************************************************DTSCS78
|
|
01060 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS78
|
|
01061 ******************************************************************DTSCS78
|
|
01062 S5300-SET-INQ-ATTRB. DTSCS78
|
|
01063 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS78
|
|
01064 WRK-ATB-NUM. DTSCS78
|
|
01065 SKIP1 DTSCS78
|
|
01066 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS78
|
|
01067 S5300-EXIT. DTSCS78
|
|
01068 EXIT. DTSCS78
|
|
01069 SKIP3 DTSCS78
|
|
01070 S5900-SET-ATTRB. DTSCS78
|
|
01071 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CURR-PAGE-A DTSCS78
|
|
01072 MAP-LAST-PAGE-A. DTSCS78
|
|
01073 SKIP1 DTSCS78
|
|
01074 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-QUEUE-OP-ID-A. DTSCS78
|
|
01075 SKIP1 DTSCS78
|
|
01076 PERFORM S5910-DATA THRU S5910-EXIT DTSCS78
|
|
01077 VARYING MAP-DATA-IDX FROM 1 BY 1 DTSCS78
|
|
01078 UNTIL MAP-DATA-IDX > WRK-LINE-MAX. DTSCS78
|
|
01079 SKIP1 DTSCS78
|
|
01080 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS78
|
|
01081 S5900-EXIT. DTSCS78
|
|
01082 EXIT. DTSCS78
|
|
01083 SKIP3 DTSCS78
|
|
01084 S5910-DATA. DTSCS78
|
|
01085 MOVE CATB-ASKIP-BRT-MDTON TO MAP-DATA-A (MAP-DATA-IDX). DTSCS78
|
|
01086 S5910-EXIT. DTSCS78
|
|
01087 EXIT. DTSCS78
|
|
01088 /*****************************************************************DTSCS78
|
|
01089 * MAP ROUTINES *DTSCS78
|
|
01090 ******************************************************************DTSCS78
|
|
01091 S9100-RECEIVE. DTSCS78
|
|
01092 SET L851-RECEIVE-88 TO TRUE. DTSCS78
|
|
01093 SKIP1 DTSCS78
|
|
01094 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS78
|
|
01095 SKIP1 DTSCS78
|
|
01096 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS78
|
|
01097 SKIP1 DTSCS78
|
|
01098 MOVE L851-AID TO LCCM-AID. DTSCS78
|
|
01099 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS78
|
|
01100 S9100-EXIT. DTSCS78
|
|
01101 EXIT. DTSCS78
|
|
01102 SKIP3 DTSCS78
|
|
01103 S9200-SEND-DATAONLY. DTSCS78
|
|
01104 MOVE LOW-VALUES TO MAP-AREA. DTSCS78
|
|
01105 SKIP1 DTSCS78
|
|
01106 IF LCCM-NO-MSG DTSCS78
|
|
01107 NEXT SENTENCE DTSCS78
|
|
01108 ELSE DTSCS78
|
|
01109 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS78
|
|
01110 SKIP1 DTSCS78
|
|
01111 IF CURSOR-SET-GOTO DTSCS78
|
|
01112 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS78
|
|
01113 ELSE DTSCS78
|
|
01114 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L. DTSCS78
|
|
01115 SKIP1 DTSCS78
|
|
01116 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS78
|
|
01117 SKIP1 DTSCS78
|
|
01118 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS78
|
|
01119 SKIP1 DTSCS78
|
|
01120 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS78
|
|
01121 S9200-EXIT. DTSCS78
|
|
01122 EXIT. DTSCS78
|
|
01123 SKIP3 DTSCS78
|
|
01124 S9300-SEND-MAP. DTSCS78
|
|
01125 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS78
|
|
01126 MOVE SPACES TO MAP-SYS-TIME. DTSCS78
|
|
01127 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS78
|
|
01128 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS78
|
|
01129 SKIP1 DTSCS78
|
|
01130 IF SCR-ACCESS-UPDATE DTSCS78
|
|
01131 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS78
|
|
01132 ELSE DTSCS78
|
|
01133 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS78
|
|
01134 SKIP1 DTSCS78
|
|
01135 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS78
|
|
01136 SKIP1 DTSCS78
|
|
01137 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS78
|
|
01138 SKIP1 DTSCS78
|
|
01139 IF CURSOR-SET-NO DTSCS78
|
|
01140 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L. DTSCS78
|
|
01141 SKIP1 DTSCS78
|
|
01142 SET L851-SEND-88 TO TRUE. DTSCS78
|
|
01143 SKIP1 DTSCS78
|
|
01144 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS78
|
|
01145 SKIP1 DTSCS78
|
|
01146 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS78
|
|
01147 S9300-EXIT. DTSCS78
|
|
01148 EXIT. DTSCS78
|
|
01149 SKIP3 DTSCS78
|
|
01150 S9310-UPDATE-FKEYS. DTSCS78
|
|
01151 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS78
|
|
01152 SKIP1 DTSCS78
|
|
01153 MOVE 'F23=DELETE AND DISPLAY NEXT' TO MAP-KEY-DEL. CL**5
|
|
01154 SKIP1 DTSCS78
|
|
01155 IF LCCM-SCR-CLEAR DTSCS78
|
|
01156 MOVE LOW-VALUES TO MAP-KEY-DEL DTSCS78
|
|
01157 ELSE DTSCS78
|
|
01158 IF LCCM-SCR-INQUIRE DTSCS78
|
|
01159 NEXT SENTENCE DTSCS78
|
|
01160 *****ELSE DTSCS78
|
|
01161 *****IF LCCM-SCR-UPDATE-LOCKED DTSCS78
|
|
01162 ***** MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS78
|
|
01163 ***** MAP-KEY-LAST DTSCS78
|
|
01164 ***** MAP-KEY-BACK DTSCS78
|
|
01165 ***** MAP-KEY-FWRD DTSCS78
|
|
01166 ***** MAP-KEY-DEL DTSCS78
|
|
01167 ELSE DTSCS78
|
|
01168 NEXT SENTENCE. DTSCS78
|
|
01169 S9310-EXIT. DTSCS78
|
|
01170 EXIT. DTSCS78
|
|
01171 SKIP3 DTSCS78
|
|
01172 S9320-INQUIRY-FKEYS. DTSCS78
|
|
01173 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS78
|
|
01174 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS78
|
|
01175 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS78
|
|
01176 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS78
|
|
01177 SKIP1 DTSCS78
|
|
01178 MOVE LOW-VALUES TO MAP-KEY-DEL. DTSCS78
|
|
01179 SKIP1 DTSCS78
|
|
01180 PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS78
|
|
01181 S9320-EXIT. DTSCS78
|
|
01182 EXIT. DTSCS78
|
|
01183 SKIP3 DTSCS78
|
|
01184 S9321-JUMP-KEYS. DTSCS78
|
|
01185 S9321-EXIT. DTSCS78
|
|
01186 EXIT. DTSCS78
|
|
01187 SKIP3 DTSCS78
|
|
01188 S9330-DSCR-FIELDS. DTSCS78
|
|
01189 IF MAP-QUEUE-OP-ID = LOW-VALUES OR SPACES DTSCS78
|
|
01190 MOVE LOW-VALUES TO MAP-QUEUE-OP-ID-DESC DTSCS78
|
|
01191 ELSE DTSCS78
|
|
01192 IF MAP-QUEUE-OP-ID = LCCM-OP-ID DTSCS78
|
|
01193 MOVE LCCM-OP-NAME TO MAP-QUEUE-OP-ID-DESC DTSCS78
|
|
01194 ELSE DTSCS78
|
|
01195 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID DTSCS78
|
|
01196 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS78
|
|
01197 MOVE L082-NAME TO MAP-QUEUE-OP-ID-DESC. DTSCS78
|
|
01198 S9330-EXIT. EXIT. DTSCS78
|
|
01199 SKIP3 DTSCS78
|
|
01200 S9900-PREPARE-SEND. DTSCS78
|
|
01201 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS78
|
|
01202 LCCM-SCR-ID. DTSCS78
|
|
01203 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS78
|
|
01204 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS78
|
|
01205 S9900-EXIT. DTSCS78
|
|
01206 EXIT. DTSCS78
|