From 3d0b3b793e82314d271217c25ee6d43cfa490c4d Mon Sep 17 00:00:00 2001 From: faizana Date: Tue, 2 Sep 2025 04:11:55 -0400 Subject: [PATCH] Fixed the bug 85. --- CICS/DTSCS85.cob | 2765 ++++++++++++++++++++++---------------------- CICSFiles.txt | 2 +- CompileOptions.txt | 2 +- 3 files changed, 1365 insertions(+), 1404 deletions(-) diff --git a/CICS/DTSCS85.cob b/CICS/DTSCS85.cob index 1331e81..057a7e9 100644 --- a/CICS/DTSCS85.cob +++ b/CICS/DTSCS85.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 01/28/05 +00001 IDENTIFICATION DIVISION. 08/29/25 00002 PROGRAM-ID. DTSCS85. DTSCS85 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV020 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. SEPTEMBER 1998. DTSCS85 00005 DATE-COMPILED. DTSCS85 00006 SKIP3 DTSCS85 @@ -46,1460 +46,1421 @@ 00046 * 01/27/2005 ADDED CANADA (CD) AS A VALID US TERRITORY DTSCS85 00047 * WORK ORDER: DC MAINT PROGRAMMER: ZL1 DTSCS85 00048 * DTSCS85 -00049 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85 -00050 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85 -00051 * WORK ORDER: PROGRAMMER: XXX DTSCS85 -00052 * DTSCS85 -00053 * DTSCS85 -00054 * DESCRIPTION: DTSCS85 -00055 * DTSCS85 -00056 * CLEAR: DTSCS85 +00049 * CL**2 +00050 * 08/27/2025 REMOVED REFERENCES TO FINALIST TERRITORY CL**2 +00051 * WORK ORDER: DC MAINT PROGRAMMER: ZL1 CL**2 +00052 * CL**2 +00053 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85 +00054 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS85 +00055 * WORK ORDER: PROGRAMMER: XXX DTSCS85 +00056 * DTSCS85 00057 * DTSCS85 -00058 * DATA FIELDS DISPLAYED: NONE. DTSCS85 -00059 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS85 -00060 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 +00058 * DESCRIPTION: DTSCS85 +00059 * DTSCS85 +00060 * CLEAR: DTSCS85 00061 * DTSCS85 -00062 * DTSCS85 -00063 * INQUIRY: DTSCS85 -00064 * DTSCS85 -00065 * CONTROL FIELD(S): FLD-TERRITORY DTSCS85 +00062 * DATA FIELDS DISPLAYED: NONE. DTSCS85 +00063 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS85 +00064 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 +00065 * DTSCS85 00066 * DTSCS85 -00067 * JUMP IN: USE CLEAR LOGIC. DTSCS85 +00067 * INQUIRY: DTSCS85 00068 * DTSCS85 -00069 * ENTER: DISPLAY FFAZ RECORD ASSOCIATED WITH THE CONTROL DTSCS85 -00070 * FIELDS. DTSCS85 -00071 * DTSCS85 -00072 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS85 -00073 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS85 -00074 * EMP-NO). DTSCS85 +00069 * CONTROL FIELD(S): FLD-TERRITORY DTSCS85 +00070 * DTSCS85 +00071 * JUMP IN: USE CLEAR LOGIC. DTSCS85 +00072 * DTSCS85 +00073 * ENTER: DISPLAY FFAZ RECORD ASSOCIATED WITH THE CONTROL DTSCS85 +00074 * FIELDS. DTSCS85 00075 * DTSCS85 -00076 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS85 +00076 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS85 00077 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS85 00078 * EMP-NO). DTSCS85 00079 * DTSCS85 -00080 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS85 -00081 * DO NOT "WRAP" PAGING. DTSCS85 -00082 * DTSCS85 -00083 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS85 -00084 * FFAZ-KEY-AREA OF THE DISPLAYED FFAZ RECORD IN DTSCS85 -00085 * LCCM-SCR-KEY-AREA. DTSCS85 +00080 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS85 +00081 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS85 +00082 * EMP-NO). DTSCS85 +00083 * DTSCS85 +00084 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS85 +00085 * DO NOT "WRAP" PAGING. DTSCS85 00086 * DTSCS85 -00087 * DTSCS85 -00088 * UPDATE: DTSCS85 -00089 * DTSCS85 -00090 * ADD DTSCS85 -00091 * MOD DTSCS85 -00092 * DEL DTSCS85 +00087 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS85 +00088 * FFAZ-KEY-AREA OF THE DISPLAYED FFAZ RECORD IN DTSCS85 +00089 * LCCM-SCR-KEY-AREA. DTSCS85 +00090 * DTSCS85 +00091 * DTSCS85 +00092 * UPDATE: DTSCS85 00093 * DTSCS85 -00094 * DTSCS85 -00095 * RECORDS READ: DTSCS85 -00096 * DTSCS85 -00097 * MASTER: DTSCS85 +00094 * ADD DTSCS85 +00095 * MOD DTSCS85 +00096 * DEL DTSCS85 +00097 * DTSCS85 00098 * DTSCS85 -00099 * NONE. DTSCS85 +00099 * RECORDS READ: DTSCS85 00100 * DTSCS85 -00101 * DTSCS85 -00102 * ALTERNATE INDEX: DTSCS85 -00103 * DTSCS85 -00104 * NONE. DTSCS85 +00101 * MASTER: DTSCS85 +00102 * DTSCS85 +00103 * NONE. DTSCS85 +00104 * DTSCS85 00105 * DTSCS85 -00106 * DTSCS85 -00107 * REFERENCE: DTSCS85 -00108 * DTSCS85 -00109 * FFAZ. DTSCS85 +00106 * ALTERNATE INDEX: DTSCS85 +00107 * DTSCS85 +00108 * NONE. DTSCS85 +00109 * DTSCS85 00110 * DTSCS85 -00111 * DTSCS85 -00112 * ACCOUNTING TRANSACTION COLLECTION: DTSCS85 -00113 * DTSCS85 -00114 * NONE. DTSCS85 +00111 * REFERENCE: DTSCS85 +00112 * DTSCS85 +00113 * FFAZ. DTSCS85 +00114 * DTSCS85 00115 * DTSCS85 -00116 * DTSCS85 -00117 * RECORDS UPDATED: DTSCS85 -00118 * DTSCS85 -00119 * MASTER: DTSCS85 +00116 * ACCOUNTING TRANSACTION COLLECTION: DTSCS85 +00117 * DTSCS85 +00118 * NONE. DTSCS85 +00119 * DTSCS85 00120 * DTSCS85 -00121 * NONE. DTSCS85 +00121 * RECORDS UPDATED: DTSCS85 00122 * DTSCS85 -00123 * DTSCS85 -00124 * REFERENCE: DTSCS85 -00125 * DTSCS85 -00126 * FFAZ (ADD, MOD, DEL). DTSCS85 +00123 * MASTER: DTSCS85 +00124 * DTSCS85 +00125 * NONE. DTSCS85 +00126 * DTSCS85 00127 * DTSCS85 -00128 * DTSCS85 -00129 * ACCOUNTING TRANSACTION COLLECTION: DTSCS85 -00130 * DTSCS85 -00131 * NONE. DTSCS85 +00128 * REFERENCE: DTSCS85 +00129 * DTSCS85 +00130 * FFAZ (ADD, MOD, DEL). DTSCS85 +00131 * DTSCS85 00132 * DTSCS85 -00133 * DTSCS85 -00134 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS85 -00135 * DTSCS85 -00136 * NONE. DTSCS85 +00133 * ACCOUNTING TRANSACTION COLLECTION: DTSCS85 +00134 * DTSCS85 +00135 * NONE. DTSCS85 +00136 * DTSCS85 00137 * DTSCS85 -00138 * DTSCS85 -00139 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS85 -00140 * UTILITY MODULES) LINKED TO: DTSCS85 +00138 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS85 +00139 * DTSCS85 +00140 * NONE. DTSCS85 00141 * DTSCS85 -00142 * DTSCU001 DATE EDIT/CONVERSION. DTSCS85 -00143 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS85 -00144 * DTSCU831 REFERENCE FILE I/O. DTSCS85 +00142 * DTSCS85 +00143 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS85 +00144 * UTILITY MODULES) LINKED TO: DTSCS85 00145 * DTSCS85 -00146 * DTSCS85 -00147 * MAINTENANCE NOTES: DTSCS85 -00148 * DTSCS85 -00149 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS85 -00150 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS85 -00151 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS85 -00152 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS85 -00153 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS85), DTSCS85 -00154 * ALTER THE MAP (DTSM85) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS85 -00155 * DTSCS85 -00156 ***** DTSCS85 -00157 SKIP3 DTSCS85 -00158 ENVIRONMENT DIVISION. DTSCS85 -00159 SKIP3 DTSCS85 -00160 DATA DIVISION. DTSCS85 +00146 * DTSCU001 DATE EDIT/CONVERSION. DTSCS85 +00147 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS85 +00148 * DTSCU831 REFERENCE FILE I/O. DTSCS85 +00149 * DTSCS85 +00150 * DTSCS85 +00151 * MAINTENANCE NOTES: DTSCS85 +00152 * DTSCS85 +00153 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS85 +00154 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS85 +00155 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS85 +00156 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS85 +00157 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS85), DTSCS85 +00158 * ALTER THE MAP (DTSM85) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS85 +00159 * DTSCS85 +00160 ***** DTSCS85 00161 SKIP3 DTSCS85 -00162 WORKING-STORAGE SECTION. DTSCS85 -001625 77 PAN-VALET PICTURE X(24) VALUE '020DTSCS85 01/28/05'. DTSCS85 +00162 ENVIRONMENT DIVISION. DTSCS85 00163 SKIP3 DTSCS85 -00164 01 WRK-AREA. DTSCS85 -00165 05 WRK-ABEND-CD PIC X(04) VALUE 'S85 '. DTSCS85 -00166 SKIP1 DTSCS85 -00167 05 WRK-SCR-ID. DTSCS85 -00168 10 WRK-SCR-ID-9 PIC 9(02) VALUE 85. DTSCS85 -00169 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS85 -00170 SKIP1 DTSCS85 -00171 05 WRK-KEY-AREA. DTSCS85 -00172 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS85 -00173 10 WRK-FLD-TERRITORY PIC X(05). DTSCS85 -00174 10 FILLER PIC X(09). DTSCS85 +00164 DATA DIVISION. DTSCS85 +00165 SKIP3 DTSCS85 +00166 WORKING-STORAGE SECTION. DTSCS85 +001665 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS85 08/29/25'. DTSCS85 +00167 77 PAN-VALET PICTURE X(24) VALUE '020DTSCS85 01/28/05'. DTSCS85 +00168 SKIP3 DTSCS85 +00169 01 WRK-AREA. DTSCS85 +00170 05 WRK-ABEND-CD PIC X(04) VALUE 'S85 '. DTSCS85 +00171 SKIP1 DTSCS85 +00172 05 WRK-SCR-ID. DTSCS85 +00173 10 WRK-SCR-ID-9 PIC 9(02) VALUE 85. DTSCS85 +00174 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS85 00175 SKIP1 DTSCS85 -00176 05 WRK-MSG-AREA PIC X(64). DTSCS85 -00177 SKIP1 DTSCS85 -00178 05 WRK-HOLD-TERRITORY PIC X(05). DTSCS85 -00179 SKIP1 DTSCS85 +00176 05 WRK-KEY-AREA. DTSCS85 +00177 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS85 +00178 10 WRK-FLD-TERRITORY PIC X(05). DTSCS85 +00179 10 FILLER PIC X(09). DTSCS85 00180 SKIP1 DTSCS85 -00181 01 MSG-LITERALS. DTSCS85 -00182 05 MSG-E851-AREA. DTSCS85 -00183 10 FILLER PIC X(04) VALUE 'E851'. DTSCS85 -00184 10 FILLER PIC X(60) DTSCS85 -00185 VALUE 'EITHER ONE OR TEN ENTRIES REQUIRED'. DTSCS85 -00186 EJECT DTSCS85 -00187 01 SCREEN-CONTROL. DTSCS85 -00188 05 SCR-ACCESS-IND PIC X(01). DTSCS85 -00189 88 SCR-ACCESS-INQ VALUE '1'. DTSCS85 -00190 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS85 -00191 SKIP1 DTSCS85 -00192 05 CURSOR-SET-IND PIC X(01). DTSCS85 -00193 88 CURSOR-SET-YES VALUE 'Y'. DTSCS85 -00194 88 CURSOR-SET-NO VALUE 'N'. DTSCS85 -00195 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS85 +00181 05 WRK-MSG-AREA PIC X(64). DTSCS85 +00182 SKIP1 DTSCS85 +00183 05 WRK-HOLD-TERRITORY PIC X(05). DTSCS85 +00184 SKIP1 DTSCS85 +00185 SKIP1 DTSCS85 +00186 01 MSG-LITERALS. DTSCS85 +00187 05 MSG-E851-AREA. DTSCS85 +00188 10 FILLER PIC X(04) VALUE 'E851'. DTSCS85 +00189 10 FILLER PIC X(60) DTSCS85 +00190 VALUE 'EITHER ONE OR TEN ENTRIES REQUIRED'. DTSCS85 +00191 EJECT DTSCS85 +00192 01 SCREEN-CONTROL. DTSCS85 +00193 05 SCR-ACCESS-IND PIC X(01). DTSCS85 +00194 88 SCR-ACCESS-INQ VALUE '1'. DTSCS85 +00195 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS85 00196 SKIP1 DTSCS85 -00197 05 REQ-IND PIC X(01). DTSCS85 -00198 88 REQ-ERROR VALUE 'O'. DTSCS85 -00199 88 REQ-JUMP VALUE 'J'. DTSCS85 -00200 88 REQ-INQUIRE VALUE 'I'. DTSCS85 -00201 88 REQ-CLEAR VALUE 'C'. DTSCS85 -00202 88 REQ-EDIT VALUE 'E'. DTSCS85 -00203 88 REQ-UPDATE VALUE 'U'. DTSCS85 -00204 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS85 -00205 SKIP1 DTSCS85 -00206 05 RESP-IND PIC X(01). DTSCS85 -00207 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS85 -00208 88 RESP-SEND-MAP VALUE 'M'. DTSCS85 -00209 88 RESP-JUMP VALUE 'J'. DTSCS85 -00210 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS85 -00211 SKIP1 DTSCS85 -00212 05 SCR-NEW-KEY-IND PIC X(01). DTSCS85 -00213 SKIP1 DTSCS85 -00214 05 SCR-ATB-AN PIC X(01). DTSCS85 -00215 05 SCR-ATB-NUM PIC X(01). DTSCS85 -00216 EJECT DTSCS85 -00217 01 LPAM-DUMMY-COMMAREA PIC X(01). DTSCS85 -00218 DTSCS85 -00219 01 LPAM-FUNCTIONS. DTSCS85 -00220 05 LPAM-INIT-FUNCTION PIC X(08) VALUE 'INIT '. DTSCS85 -00221 05 LPAM-OPEN-FUNCTION PIC X(08) VALUE 'OPEN '. DTSCS85 -00222 05 LPAM-GETZIP-FUNCTION PIC X(08) VALUE 'GETZIP '. DTSCS85 -00223 05 LPAM-CLOSE-FUNCTION PIC X(08) VALUE 'CLOSE '. DTSCS85 -00224 05 LPAM-TERM-FUNCTION PIC X(08) VALUE 'TERM '. DTSCS85 -00225 DTSCS85 -00226 01 LPAM-ANCHOR-AREA PIC X(04). DTSCS85 -00227 DTSCS85 -00228 01 LPAM-RETURN-CODE PIC X(02). DTSCS85 -00229 DTSCS85 -00230 01 LPAM-ERROR-AREA. DTSCS85 -00231 05 LPAM-ERROR-MODULE PIC X(08). DTSCS85 -00232 05 FILLER PIC X(01). DTSCS85 -00233 05 LPAM-ERROR-FUNCTION PIC X(08). DTSCS85 -00234 05 FILLER PIC X(01). DTSCS85 -00235 05 ERROR-RETURN-CODES. DTSCS85 -00236 10 ERROR-RETURN-CODE OCCURS 17 TIMES DTSCS85 -00237 INDEXED BY ERROR-RETURN-IDX DTSCS85 -00238 PIC X(01). DTSCS85 -00239 05 FILLER PIC X(01). DTSCS85 -00240 05 ERROR-MESSAGE PIC X(44). DTSCS85 -00241 DTSCS85 -00242 01 LPAM-STREET-FILE-RCB PIC X(08). DTSCS85 -00243 DTSCS85 -00244 01 LPAM-NAMES. DTSCS85 -00245 05 LPAM-MODULE-NAME PIC X(08) VALUE 'LPAMC '. DTSCS85 -00246 05 LPAM-PROFILE-NAME PIC X(08) VALUE ' '. DTSCS85 -00247 05 LPAM-PRODUCT-NAME PIC X(08) VALUE 'BACCMETH'. DTSCS85 -00248 05 LPAM-STREET-FILE-NAME PIC X(08) VALUE 'CBDATA '. DTSCS85 -00249 05 LPAM-CITY-FILE-NAME PIC X(08) VALUE 'CBCTYST '. DTSCS85 -00250 DTSCS85 -00251 ++INCLUDE LPAM007C DTSCS85 -00252 SKIP3 DTSCS85 -00253 ++INCLUDE LPAM008C DTSCS85 -00254 EJECT DTSCS85 -00255 01 L001-COMM-AREA. DTSCS85 -00256 ++INCLUDE DTSIL001 DTSCS85 -00257 EJECT DTSCS85 -00258 01 L062-COMM-AREA. DTSCS85 -00259 ++INCLUDE DTSIL062 DTSCS85 -00260 EJECT DTSCS85 -00261 * ERROR MSG MODULE DTSCS85 -00262 01 L805-COMM-AREA. DTSCS85 -00263 ++INCLUDE DTSIL805 DTSCS85 -00264 EJECT DTSCS85 -00265 * STATE POSTAL CODES DTSCS85 -00266 01 STATE-POSTAL-CODES. DTSCS85 -00267 ++INCLUDE DTSIC072 DTSCS85 -00268 EJECT DTSCS85 -00269 * REFERENCE FILE I-O LINKAGE DTSCS85 -00270 01 L831-COMM-AREA. DTSCS85 -00271 05 L831-CONTROL-BLOCK. DTSCS85 -00272 ++INCLUDE DTSIL831 DTSCS85 +00197 05 CURSOR-SET-IND PIC X(01). DTSCS85 +00198 88 CURSOR-SET-YES VALUE 'Y'. DTSCS85 +00199 88 CURSOR-SET-NO VALUE 'N'. DTSCS85 +00200 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS85 +00201 SKIP1 DTSCS85 +00202 05 REQ-IND PIC X(01). DTSCS85 +00203 88 REQ-ERROR VALUE 'O'. DTSCS85 +00204 88 REQ-JUMP VALUE 'J'. DTSCS85 +00205 88 REQ-INQUIRE VALUE 'I'. DTSCS85 +00206 88 REQ-CLEAR VALUE 'C'. DTSCS85 +00207 88 REQ-EDIT VALUE 'E'. DTSCS85 +00208 88 REQ-UPDATE VALUE 'U'. DTSCS85 +00209 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS85 +00210 SKIP1 DTSCS85 +00211 05 RESP-IND PIC X(01). DTSCS85 +00212 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS85 +00213 88 RESP-SEND-MAP VALUE 'M'. DTSCS85 +00214 88 RESP-JUMP VALUE 'J'. DTSCS85 +00215 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS85 +00216 SKIP1 DTSCS85 +00217 05 SCR-NEW-KEY-IND PIC X(01). DTSCS85 +00218 SKIP1 DTSCS85 +00219 05 SCR-ATB-AN PIC X(01). DTSCS85 +00220 05 SCR-ATB-NUM PIC X(01). DTSCS85 +00221 EJECT DTSCS85 +00222 *01 LPAM-DUMMY-COMMAREA PIC X(01). CL**2 +00223 DTSCS85 +00224 *01 LPAM-FUNCTIONS. CL**2 +00225 * 05 LPAM-INIT-FUNCTION PIC X(08) VALUE 'INIT '. CL**2 +00226 * 05 LPAM-OPEN-FUNCTION PIC X(08) VALUE 'OPEN '. CL**2 +00227 * 05 LPAM-GETZIP-FUNCTION PIC X(08) VALUE 'GETZIP '. CL**2 +00228 * 05 LPAM-CLOSE-FUNCTION PIC X(08) VALUE 'CLOSE '. CL**2 +00229 * 05 LPAM-TERM-FUNCTION PIC X(08) VALUE 'TERM '. CL**2 +00230 DTSCS85 +00231 *01 LPAM-ANCHOR-AREA PIC X(04). CL**2 +00232 DTSCS85 +00233 *01 LPAM-RETURN-CODE PIC X(02). CL**2 +00234 DTSCS85 +00235 *01 LPAM-ERROR-AREA. CL**2 +00236 * 05 LPAM-ERROR-MODULE PIC X(08). CL**2 +00237 * 05 FILLER PIC X(01). CL**2 +00238 * 05 LPAM-ERROR-FUNCTION PIC X(08). CL**2 +00239 * 05 FILLER PIC X(01). CL**2 +00240 * 05 ERROR-RETURN-CODES. CL**2 +00241 * 10 ERROR-RETURN-CODE OCCURS 17 TIMES CL**2 +00242 * INDEXED BY ERROR-RETURN-IDX CL**2 +00243 * PIC X(01). CL**2 +00244 * 05 FILLER PIC X(01). CL**2 +00245 * 05 ERROR-MESSAGE PIC X(44). CL**2 +00246 DTSCS85 +00247 *01 LPAM-STREET-FILE-RCB PIC X(08). CL**2 +00248 DTSCS85 +00249 *01 LPAM-NAMES. CL**2 +00250 * 05 LPAM-MODULE-NAME PIC X(08) VALUE 'LPAMC '. CL**2 +00251 * 05 LPAM-PROFILE-NAME PIC X(08) VALUE ' '. CL**2 +00252 * 05 LPAM-PRODUCT-NAME PIC X(08) VALUE 'BACCMETH'. CL**2 +00253 * 05 LPAM-STREET-FILE-NAME PIC X(08) VALUE 'CBDATA '. CL**2 +00254 * 05 LPAM-CITY-FILE-NAME PIC X(08) VALUE 'CBCTYST '. CL**2 +00255 DTSCS85 +00256 *++INCLUDE LPAM007C CL**2 +00257 SKIP3 DTSCS85 +00258 *++INCLUDE LPAM008C CL**2 +00259 EJECT DTSCS85 +00260 01 L001-COMM-AREA. DTSCS85 +00261 ++INCLUDE DTSIL001 DTSCS85 +00262 EJECT DTSCS85 +00263 01 L062-COMM-AREA. DTSCS85 +00264 ++INCLUDE DTSIL062 DTSCS85 +00265 EJECT DTSCS85 +00266 * ERROR MSG MODULE DTSCS85 +00267 01 L805-COMM-AREA. DTSCS85 +00268 ++INCLUDE DTSIL805 DTSCS85 +00269 EJECT DTSCS85 +00270 * STATE POSTAL CODES DTSCS85 +00271 01 STATE-POSTAL-CODES. DTSCS85 +00272 ++INCLUDE DTSIC072 DTSCS85 00273 EJECT DTSCS85 -00274 * COMMON SKELETAL RECORD DTSCS85 -00275 05 FCOMM-REC. DTSCS85 -00276 ++INCLUDE DTSIFSKL DTSCS85 -00277 SKIP3 DTSCS85 -00278 * FIELD REP TERRITORY RECORD LAYOUT DTSCS85 -00279 05 FFAZ-REC REDEFINES FCOMM-REC. DTSCS85 -00280 ++INCLUDE DTSIFFAZ DTSCS85 -00281 EJECT DTSCS85 -00282 * MAP DEFINITION DTSCS85 -00283 01 L851-COMM-AREA. DTSCS85 -00284 ++INCLUDE DTSIL851 DTSCS85 -00285 SKIP3 DTSCS85 -00286 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS85 -00287 ++INCLUDE DTSIS85 DTSCS85 -00288 EJECT DTSCS85 -00289 * ATTRIBUTE LITERALS DTSCS85 -00290 01 CATB-LITERALS. DTSCS85 -00291 ++INCLUDE DTSICATB DTSCS85 -00292 SKIP3 DTSCS85 -00293 * FUNCTION KEY DESCRIPTION LITERALS DTSCS85 -00294 01 CFKD-LITERALS. DTSCS85 -00295 ++INCLUDE DTSICFKD DTSCS85 -00296 EJECT DTSCS85 -00297 * ERROR CODE MESSAGE LITERALS DTSCS85 -00298 01 CECD-LITERALS. DTSCS85 -00299 ++INCLUDE DTSICECD DTSCS85 -00300 SKIP3 DTSCS85 -00301 * PROMPT CODE MESSAGE LITERALS DTSCS85 -00302 01 CPCD-LITERALS. DTSCS85 -00303 ++INCLUDE DTSICPCD DTSCS85 -00304 EJECT DTSCS85 -00305 LINKAGE SECTION. DTSCS85 -00306 SKIP3 DTSCS85 -00307 01 DFHCOMMAREA. DTSCS85 -00308 ++INCLUDE DTSILCCM DTSCS85 -00309 SKIP3 DTSCS85 -00310 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS85 -00311 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS85 -00312 EJECT DTSCS85 -00313 ******************************************************************DTSCS85 -00314 * *DTSCS85 -00315 ******************************************************************DTSCS85 -00316 SKIP1 DTSCS85 -00317 PROCEDURE DIVISION. DTSCS85 -00318 SKIP2 DTSCS85 -00319 SET CURSOR-SET-NO TO TRUE. DTSCS85 -00320 SKIP1 DTSCS85 -00321 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 -00322 SKIP1 DTSCS85 -00323 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS85 -00324 TO SCR-ACCESS-IND. DTSCS85 -00325 SKIP3 DTSCS85 -00326 MOVE SPACE TO REQ-IND. DTSCS85 +00274 * REFERENCE FILE I-O LINKAGE DTSCS85 +00275 01 L831-COMM-AREA. DTSCS85 +00276 05 L831-CONTROL-BLOCK. DTSCS85 +00277 ++INCLUDE DTSIL831 DTSCS85 +00278 EJECT DTSCS85 +00279 * COMMON SKELETAL RECORD DTSCS85 +00280 05 FCOMM-REC. DTSCS85 +00281 ++INCLUDE DTSIFSKL DTSCS85 +00282 SKIP3 DTSCS85 +00283 * FIELD REP TERRITORY RECORD LAYOUT DTSCS85 +00284 05 FFAZ-REC REDEFINES FCOMM-REC. DTSCS85 +00285 ++INCLUDE DTSIFFAZ DTSCS85 +00286 EJECT DTSCS85 +00287 * MAP DEFINITION DTSCS85 +00288 01 L851-COMM-AREA. DTSCS85 +00289 ++INCLUDE DTSIL851 DTSCS85 +00290 SKIP3 DTSCS85 +00291 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS85 +00292 ++INCLUDE DTSIS85 DTSCS85 +00293 EJECT DTSCS85 +00294 * ATTRIBUTE LITERALS DTSCS85 +00295 01 CATB-LITERALS. DTSCS85 +00296 ++INCLUDE DTSICATB DTSCS85 +00297 SKIP3 DTSCS85 +00298 * FUNCTION KEY DESCRIPTION LITERALS DTSCS85 +00299 01 CFKD-LITERALS. DTSCS85 +00300 ++INCLUDE DTSICFKD DTSCS85 +00301 EJECT DTSCS85 +00302 * ERROR CODE MESSAGE LITERALS DTSCS85 +00303 01 CECD-LITERALS. DTSCS85 +00304 ++INCLUDE DTSICECD DTSCS85 +00305 SKIP3 DTSCS85 +00306 * PROMPT CODE MESSAGE LITERALS DTSCS85 +00307 01 CPCD-LITERALS. DTSCS85 +00308 ++INCLUDE DTSICPCD DTSCS85 +00309 EJECT DTSCS85 +00310 LINKAGE SECTION. DTSCS85 +00311 SKIP3 DTSCS85 +00312 01 DFHCOMMAREA. DTSCS85 +00313 ++INCLUDE DTSILCCM DTSCS85 +00314 SKIP3 DTSCS85 +00315 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS85 +00316 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS85 +00317 EJECT DTSCS85 +00318 ******************************************************************DTSCS85 +00319 * *DTSCS85 +00320 ******************************************************************DTSCS85 +00321 SKIP1 DTSCS85 +00322 PROCEDURE DIVISION. DTSCS85 +00323 SKIP2 DTSCS85 +00324 SET CURSOR-SET-NO TO TRUE. DTSCS85 +00325 SKIP1 DTSCS85 +00326 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 00327 SKIP1 DTSCS85 -00328 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS85 -00329 SKIP1 DTSCS85 -00330 *----------------------------------------------------- DTSCS85 -00331 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS85 -00332 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS85 -00333 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS85 -00334 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS85 -00335 * DTSCS85 -00336 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS85 -00337 * PROCESSED. DTSCS85 -00338 * DTSCS85 -00339 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS85 -00340 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS85 -00341 * WORK STATION OPERATOR. DTSCS85 -00342 *----------------------------------------------------- DTSCS85 -00343 SKIP1 DTSCS85 -00344 MOVE SPACE TO RESP-IND. DTSCS85 -00345 SKIP1 DTSCS85 -00346 IF REQ-ERROR DTSCS85 -00347 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS85 -00348 ELSE DTSCS85 -00349 IF REQ-JUMP DTSCS85 -00350 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS85 -00351 ELSE DTSCS85 -00352 IF REQ-CLEAR DTSCS85 -00353 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS85 -00354 ELSE DTSCS85 -00355 IF REQ-CURSOR-TO-GOTO DTSCS85 -00356 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS85 -00357 ELSE DTSCS85 -00358 IF REQ-INQUIRE DTSCS85 -00359 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS85 -00360 ELSE DTSCS85 -00361 IF REQ-EDIT DTSCS85 -00362 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS85 -00363 ELSE DTSCS85 -00364 IF REQ-UPDATE DTSCS85 -00365 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS85 -00366 ELSE DTSCS85 -00367 GO TO S899-ABEND. DTSCS85 -00368 SKIP3 DTSCS85 -00369 *----------------------------------------------------- DTSCS85 -00370 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS85 -00371 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS85 -00372 *----------------------------------------------------- DTSCS85 -00373 SKIP1 DTSCS85 -00374 IF RESP-SEND-MAP DTSCS85 -00375 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS85 -00376 SET LCCM-END-TASK-88 TO TRUE DTSCS85 -00377 ELSE DTSCS85 -00378 IF RESP-SEND-MSGONLY DTSCS85 -00379 OR RESP-CURSOR-TO-GOTO DTSCS85 -00380 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS85 +00328 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS85 +00329 TO SCR-ACCESS-IND. DTSCS85 +00330 SKIP3 DTSCS85 +00331 MOVE SPACE TO REQ-IND. DTSCS85 +00332 SKIP1 DTSCS85 +00333 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS85 +00334 SKIP1 DTSCS85 +00335 *----------------------------------------------------- DTSCS85 +00336 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS85 +00337 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS85 +00338 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS85 +00339 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS85 +00340 * DTSCS85 +00341 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS85 +00342 * PROCESSED. DTSCS85 +00343 * DTSCS85 +00344 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS85 +00345 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS85 +00346 * WORK STATION OPERATOR. DTSCS85 +00347 *----------------------------------------------------- DTSCS85 +00348 SKIP1 DTSCS85 +00349 MOVE SPACE TO RESP-IND. DTSCS85 +00350 SKIP1 DTSCS85 +00351 IF REQ-ERROR DTSCS85 +00352 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS85 +00353 ELSE DTSCS85 +00354 IF REQ-JUMP DTSCS85 +00355 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS85 +00356 ELSE DTSCS85 +00357 IF REQ-CLEAR DTSCS85 +00358 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS85 +00359 ELSE DTSCS85 +00360 IF REQ-CURSOR-TO-GOTO DTSCS85 +00361 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS85 +00362 ELSE DTSCS85 +00363 IF REQ-INQUIRE DTSCS85 +00364 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS85 +00365 ELSE DTSCS85 +00366 IF REQ-EDIT DTSCS85 +00367 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS85 +00368 ELSE DTSCS85 +00369 IF REQ-UPDATE DTSCS85 +00370 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS85 +00371 ELSE DTSCS85 +00372 GO TO S899-ABEND. DTSCS85 +00373 SKIP3 DTSCS85 +00374 *----------------------------------------------------- DTSCS85 +00375 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS85 +00376 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS85 +00377 *----------------------------------------------------- DTSCS85 +00378 SKIP1 DTSCS85 +00379 IF RESP-SEND-MAP DTSCS85 +00380 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS85 00381 SET LCCM-END-TASK-88 TO TRUE DTSCS85 00382 ELSE DTSCS85 -00383 IF RESP-JUMP DTSCS85 -00384 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 -00385 ELSE DTSCS85 -00386 GO TO S899-ABEND. DTSCS85 -00387 SKIP3 DTSCS85 -00388 MAINLINE-EXIT. DTSCS85 -00389 SKIP1 DTSCS85 -00390 EXEC CICS DTSCS85 -00391 RETURN DTSCS85 -00392 END-EXEC. DTSCS85 -00393 SKIP2 DTSCS85 -00394 * GOBACK. DTSCS85 -00395 /*****************************************************************DTSCS85 -00396 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS85 -00397 ******************************************************************DTSCS85 -00398 P1000-ANALYZE-REQUEST. DTSCS85 -00399 SKIP1 DTSCS85 -00400 *----------------------------------------------------- DTSCS85 -00401 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS85 -00402 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS85 -00403 * REPLACED WITH ENTER) DTSCS85 -00404 *----------------------------------------------------- DTSCS85 -00405 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS85 -00406 SET LCCM-ENTER-88 TO TRUE DTSCS85 -00407 SET REQ-CLEAR TO TRUE DTSCS85 -00408 GO TO P1000-EXIT. DTSCS85 -00409 SKIP3 DTSCS85 -00410 *----------------------------------------------------- DTSCS85 -00411 * MAP IS RECEIVED DTSCS85 -00412 *----------------------------------------------------- DTSCS85 -00413 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS85 +00383 IF RESP-SEND-MSGONLY DTSCS85 +00384 OR RESP-CURSOR-TO-GOTO DTSCS85 +00385 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS85 +00386 SET LCCM-END-TASK-88 TO TRUE DTSCS85 +00387 ELSE DTSCS85 +00388 IF RESP-JUMP DTSCS85 +00389 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 +00390 ELSE DTSCS85 +00391 GO TO S899-ABEND. DTSCS85 +00392 SKIP3 DTSCS85 +00393 MAINLINE-EXIT. DTSCS85 +00394 SKIP1 DTSCS85 +00395 EXEC CICS DTSCS85 +00396 RETURN DTSCS85 +00397 END-EXEC. DTSCS85 +00398 SKIP2 DTSCS85 +00399 * GOBACK. DTSCS85 +00400 /*****************************************************************DTSCS85 +00401 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS85 +00402 ******************************************************************DTSCS85 +00403 P1000-ANALYZE-REQUEST. DTSCS85 +00404 SKIP1 DTSCS85 +00405 *----------------------------------------------------- DTSCS85 +00406 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS85 +00407 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS85 +00408 * REPLACED WITH ENTER) DTSCS85 +00409 *----------------------------------------------------- DTSCS85 +00410 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS85 +00411 SET LCCM-ENTER-88 TO TRUE DTSCS85 +00412 SET REQ-CLEAR TO TRUE DTSCS85 +00413 GO TO P1000-EXIT. DTSCS85 00414 SKIP3 DTSCS85 00415 *----------------------------------------------------- DTSCS85 -00416 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS85 -00417 * WORK STATION DTSCS85 -00418 *----------------------------------------------------- DTSCS85 -00419 IF LCCM-CLEAR-88 DTSCS85 -00420 SET REQ-CLEAR TO TRUE DTSCS85 -00421 GO TO P1000-EXIT. DTSCS85 -00422 SKIP3 DTSCS85 +00416 * MAP IS RECEIVED DTSCS85 +00417 *----------------------------------------------------- DTSCS85 +00418 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS85 +00419 SKIP3 DTSCS85 +00420 *----------------------------------------------------- DTSCS85 +00421 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS85 +00422 * WORK STATION DTSCS85 00423 *----------------------------------------------------- DTSCS85 -00424 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS85 -00425 *----------------------------------------------------- DTSCS85 -00426 IF LCCM-SCR-UPDATE-LOCKED DTSCS85 -00427 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS85 -00428 GO TO P1000-EXIT. DTSCS85 -00429 SKIP3 DTSCS85 +00424 IF LCCM-CLEAR-88 DTSCS85 +00425 SET REQ-CLEAR TO TRUE DTSCS85 +00426 GO TO P1000-EXIT. DTSCS85 +00427 SKIP3 DTSCS85 +00428 *----------------------------------------------------- DTSCS85 +00429 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS85 00430 *----------------------------------------------------- DTSCS85 -00431 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS85 -00432 *----------------------------------------------------- DTSCS85 -00433 IF LCCM-PA2-88 DTSCS85 -00434 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS85 -00435 GO TO P1000-EXIT. DTSCS85 -00436 SKIP3 DTSCS85 +00431 IF LCCM-SCR-UPDATE-LOCKED DTSCS85 +00432 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS85 +00433 GO TO P1000-EXIT. DTSCS85 +00434 SKIP3 DTSCS85 +00435 *----------------------------------------------------- DTSCS85 +00436 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS85 00437 *----------------------------------------------------- DTSCS85 -00438 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS85 -00439 *----------------------------------------------------- DTSCS85 -00440 IF LCCM-PA-88 DTSCS85 -00441 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS85 -00442 SET REQ-ERROR TO TRUE DTSCS85 -00443 GO TO P1000-EXIT. DTSCS85 -00444 SKIP3 DTSCS85 -00445 *----------------------------------------------------- DTSCS85 -00446 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS85 -00447 * REQUEST TO CLEAR THE SCREEN. DTSCS85 -00448 *----------------------------------------------------- DTSCS85 -00449 IF LCCM-F12-88 DTSCS85 -00450 MOVE LOW-VALUES TO MAP-AREA DTSCS85 -00451 SET REQ-CLEAR TO TRUE DTSCS85 -00452 GO TO P1000-EXIT. DTSCS85 -00453 SKIP3 DTSCS85 -00454 *----------------------------------------------------- DTSCS85 -00455 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS85 -00456 *----------------------------------------------------- DTSCS85 -00457 IF LCCM-F03-88 DTSCS85 -00458 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 -00459 SET REQ-JUMP TO TRUE DTSCS85 -00460 GO TO P1000-EXIT. DTSCS85 -00461 SKIP3 DTSCS85 -00462 *----------------------------------------------------- DTSCS85 -00463 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS85 -00464 *----------------------------------------------------- DTSCS85 -00465 IF LCCM-F04-88 DTSCS85 -00466 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 -00467 SET REQ-JUMP TO TRUE DTSCS85 -00468 GO TO P1000-EXIT. DTSCS85 -00469 SKIP3 DTSCS85 -00470 *----------------------------------------------------- DTSCS85 -00471 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS85 -00472 * CORRESPONDENCE SCREEN DTSCS85 -00473 *----------------------------------------------------- DTSCS85 -00474 IF LCCM-F14-88 DTSCS85 -00475 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 -00476 SET REQ-JUMP TO TRUE DTSCS85 -00477 GO TO P1000-EXIT. DTSCS85 -00478 SKIP3 DTSCS85 -00479 *----------------------------------------------------- DTSCS85 -00480 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS85 -00481 * REQUESTED SCREEN TYPE DTSCS85 -00482 *----------------------------------------------------- DTSCS85 -00483 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS85 -00484 NEXT SENTENCE DTSCS85 -00485 ELSE DTSCS85 -00486 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS85 -00487 SET REQ-JUMP TO TRUE DTSCS85 -00488 GO TO P1000-EXIT. DTSCS85 -00489 SKIP3 DTSCS85 -00490 *----------------------------------------------------- DTSCS85 -00491 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS85 -00492 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS85 -00493 *----------------------------------------------------- DTSCS85 -00494 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS85 -00495 IF SCR-ACCESS-UPDATE DTSCS85 -00496 SET REQ-EDIT TO TRUE DTSCS85 -00497 GO TO P1000-EXIT DTSCS85 -00498 ELSE DTSCS85 -00499 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS85 -00500 SET REQ-ERROR TO TRUE DTSCS85 -00501 GO TO P1000-EXIT. DTSCS85 -00502 SKIP3 DTSCS85 -00503 *----------------------------------------------------- DTSCS85 -00504 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS85 -00505 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS85 -00506 *----------------------------------------------------- DTSCS85 -00507 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS85 -00508 SET REQ-INQUIRE TO TRUE DTSCS85 -00509 GO TO P1000-EXIT. DTSCS85 -00510 SKIP3 DTSCS85 +00438 IF LCCM-PA2-88 DTSCS85 +00439 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS85 +00440 GO TO P1000-EXIT. DTSCS85 +00441 SKIP3 DTSCS85 +00442 *----------------------------------------------------- DTSCS85 +00443 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS85 +00444 *----------------------------------------------------- DTSCS85 +00445 IF LCCM-PA-88 DTSCS85 +00446 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS85 +00447 SET REQ-ERROR TO TRUE DTSCS85 +00448 GO TO P1000-EXIT. DTSCS85 +00449 SKIP3 DTSCS85 +00450 *----------------------------------------------------- DTSCS85 +00451 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS85 +00452 * REQUEST TO CLEAR THE SCREEN. DTSCS85 +00453 *----------------------------------------------------- DTSCS85 +00454 IF LCCM-F12-88 DTSCS85 +00455 MOVE LOW-VALUES TO MAP-AREA DTSCS85 +00456 SET REQ-CLEAR TO TRUE DTSCS85 +00457 GO TO P1000-EXIT. DTSCS85 +00458 SKIP3 DTSCS85 +00459 *----------------------------------------------------- DTSCS85 +00460 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS85 +00461 *----------------------------------------------------- DTSCS85 +00462 IF LCCM-F03-88 DTSCS85 +00463 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 +00464 SET REQ-JUMP TO TRUE DTSCS85 +00465 GO TO P1000-EXIT. DTSCS85 +00466 SKIP3 DTSCS85 +00467 *----------------------------------------------------- DTSCS85 +00468 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS85 +00469 *----------------------------------------------------- DTSCS85 +00470 IF LCCM-F04-88 DTSCS85 +00471 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 +00472 SET REQ-JUMP TO TRUE DTSCS85 +00473 GO TO P1000-EXIT. DTSCS85 +00474 SKIP3 DTSCS85 +00475 *----------------------------------------------------- DTSCS85 +00476 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS85 +00477 * CORRESPONDENCE SCREEN DTSCS85 +00478 *----------------------------------------------------- DTSCS85 +00479 IF LCCM-F14-88 DTSCS85 +00480 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS85 +00481 SET REQ-JUMP TO TRUE DTSCS85 +00482 GO TO P1000-EXIT. DTSCS85 +00483 SKIP3 DTSCS85 +00484 *----------------------------------------------------- DTSCS85 +00485 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS85 +00486 * REQUESTED SCREEN TYPE DTSCS85 +00487 *----------------------------------------------------- DTSCS85 +00488 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS85 +00489 NEXT SENTENCE DTSCS85 +00490 ELSE DTSCS85 +00491 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS85 +00492 SET REQ-JUMP TO TRUE DTSCS85 +00493 GO TO P1000-EXIT. DTSCS85 +00494 SKIP3 DTSCS85 +00495 *----------------------------------------------------- DTSCS85 +00496 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS85 +00497 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS85 +00498 *----------------------------------------------------- DTSCS85 +00499 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS85 +00500 IF SCR-ACCESS-UPDATE DTSCS85 +00501 SET REQ-EDIT TO TRUE DTSCS85 +00502 GO TO P1000-EXIT DTSCS85 +00503 ELSE DTSCS85 +00504 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS85 +00505 SET REQ-ERROR TO TRUE DTSCS85 +00506 GO TO P1000-EXIT. DTSCS85 +00507 SKIP3 DTSCS85 +00508 *----------------------------------------------------- DTSCS85 +00509 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS85 +00510 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS85 00511 *----------------------------------------------------- DTSCS85 -00512 * ANY OTHER KEY IS INVALID DTSCS85 -00513 *----------------------------------------------------- DTSCS85 -00514 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS85 -00515 SET REQ-ERROR TO TRUE. DTSCS85 -00516 P1000-EXIT. DTSCS85 -00517 EXIT. DTSCS85 -00518 SKIP3 DTSCS85 -00519 ******************************************************************DTSCS85 -00520 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS85 -00521 ******************************************************************DTSCS85 -00522 SKIP1 DTSCS85 -00523 P1100-UPDATE-LOCKED. DTSCS85 -00524 *----------------------------------------------------- DTSCS85 -00525 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS85 -00526 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS85 -00527 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS85 -00528 *----------------------------------------------------- DTSCS85 -00529 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS85 -00530 SET REQ-UPDATE TO TRUE DTSCS85 -00531 ELSE DTSCS85 -00532 SET REQ-ERROR TO TRUE DTSCS85 -00533 IF LCCM-SCR-ADD-LOCKED DTSCS85 -00534 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS85 -00535 ELSE DTSCS85 -00536 IF LCCM-SCR-MOD-LOCKED DTSCS85 -00537 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS85 -00538 ELSE DTSCS85 -00539 IF LCCM-SCR-DEL-LOCKED DTSCS85 -00540 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS85 -00541 ELSE DTSCS85 -00542 GO TO S899-ABEND. DTSCS85 -00543 P1100-EXIT. DTSCS85 -00544 EXIT. DTSCS85 -00545 /*****************************************************************DTSCS85 -00546 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS85 -00547 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS85 -00548 ******************************************************************DTSCS85 -00549 SKIP1 DTSCS85 -00550 P2000-REQUEST-ERROR. DTSCS85 -00551 IF LCCM-MSG DTSCS85 -00552 SET RESP-SEND-MSGONLY TO TRUE DTSCS85 -00553 ELSE DTSCS85 -00554 GO TO S899-ABEND. DTSCS85 -00555 P2000-EXIT. DTSCS85 -00556 EXIT. DTSCS85 -00557 /*****************************************************************DTSCS85 -00558 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS85 -00559 ******************************************************************DTSCS85 -00560 SKIP1 DTSCS85 -00561 P3000-REQUEST-JUMP. DTSCS85 -00562 *----------------------------------------------------- DTSCS85 -00563 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS85 -00564 * BY USER DTSCS85 -00565 *----------------------------------------------------- DTSCS85 -00566 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS85 -00567 SKIP3 DTSCS85 -00568 *----------------------------------------------------- DTSCS85 -00569 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS85 +00512 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS85 +00513 SET REQ-INQUIRE TO TRUE DTSCS85 +00514 GO TO P1000-EXIT. DTSCS85 +00515 SKIP3 DTSCS85 +00516 *----------------------------------------------------- DTSCS85 +00517 * ANY OTHER KEY IS INVALID DTSCS85 +00518 *----------------------------------------------------- DTSCS85 +00519 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS85 +00520 SET REQ-ERROR TO TRUE. DTSCS85 +00521 P1000-EXIT. DTSCS85 +00522 EXIT. DTSCS85 +00523 SKIP3 DTSCS85 +00524 ******************************************************************DTSCS85 +00525 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS85 +00526 ******************************************************************DTSCS85 +00527 SKIP1 DTSCS85 +00528 P1100-UPDATE-LOCKED. DTSCS85 +00529 *----------------------------------------------------- DTSCS85 +00530 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS85 +00531 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS85 +00532 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS85 +00533 *----------------------------------------------------- DTSCS85 +00534 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS85 +00535 SET REQ-UPDATE TO TRUE DTSCS85 +00536 ELSE DTSCS85 +00537 SET REQ-ERROR TO TRUE DTSCS85 +00538 IF LCCM-SCR-ADD-LOCKED DTSCS85 +00539 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS85 +00540 ELSE DTSCS85 +00541 IF LCCM-SCR-MOD-LOCKED DTSCS85 +00542 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS85 +00543 ELSE DTSCS85 +00544 IF LCCM-SCR-DEL-LOCKED DTSCS85 +00545 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS85 +00546 ELSE DTSCS85 +00547 GO TO S899-ABEND. DTSCS85 +00548 P1100-EXIT. DTSCS85 +00549 EXIT. DTSCS85 +00550 /*****************************************************************DTSCS85 +00551 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS85 +00552 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS85 +00553 ******************************************************************DTSCS85 +00554 SKIP1 DTSCS85 +00555 P2000-REQUEST-ERROR. DTSCS85 +00556 IF LCCM-MSG DTSCS85 +00557 SET RESP-SEND-MSGONLY TO TRUE DTSCS85 +00558 ELSE DTSCS85 +00559 GO TO S899-ABEND. DTSCS85 +00560 P2000-EXIT. DTSCS85 +00561 EXIT. DTSCS85 +00562 /*****************************************************************DTSCS85 +00563 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS85 +00564 ******************************************************************DTSCS85 +00565 SKIP1 DTSCS85 +00566 P3000-REQUEST-JUMP. DTSCS85 +00567 *----------------------------------------------------- DTSCS85 +00568 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS85 +00569 * BY USER DTSCS85 00570 *----------------------------------------------------- DTSCS85 -00571 IF LCCM-MSG DTSCS85 -00572 SET RESP-SEND-MSGONLY TO TRUE DTSCS85 -00573 SET CURSOR-SET-GOTO TO TRUE DTSCS85 -00574 GO TO P3000-EXIT. DTSCS85 -00575 SKIP3 DTSCS85 -00576 *----------------------------------------------------- DTSCS85 -00577 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS85 -00578 *----------------------------------------------------- DTSCS85 -00579 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS85 -00580 LCCM-SCR-HOLD-AREA. DTSCS85 -00581 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS85 -00582 SET RESP-JUMP TO TRUE. DTSCS85 -00583 P3000-EXIT. DTSCS85 -00584 EXIT. DTSCS85 -00585 /*****************************************************************DTSCS85 -00586 * CLEAR KEY WAS PRESSED *DTSCS85 -00587 ******************************************************************DTSCS85 -00588 SKIP1 DTSCS85 -00589 P4000-REQUEST-CLEAR. DTSCS85 -00590 IF SCR-ACCESS-UPDATE DTSCS85 -00591 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS85 -00592 ELSE DTSCS85 -00593 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS85 -00594 SKIP3 DTSCS85 -00595 *----------------------------------------------------- DTSCS85 -00596 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS85 -00597 * FIELDS FROM EARLIER REQUESTS DTSCS85 -00598 *----------------------------------------------------- DTSCS85 -00599 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS85 -00600 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 -00601 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 -00602 SET RESP-SEND-MAP TO TRUE. DTSCS85 -00603 P4000-EXIT. DTSCS85 -00604 EXIT. DTSCS85 -00605 /*****************************************************************DTSCS85 -00606 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS85 -00607 ******************************************************************DTSCS85 -00608 SKIP1 DTSCS85 -00609 P5000-CURSOR-TO-GOTO. DTSCS85 -00610 SET CURSOR-SET-GOTO TO TRUE. DTSCS85 -00611 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS85 -00612 P5000-EXIT. DTSCS85 -00613 EXIT. DTSCS85 -00614 /*****************************************************************DTSCS85 -00615 * INQUIRY WAS REQUESTED *DTSCS85 -00616 ******************************************************************DTSCS85 -00617 SKIP1 DTSCS85 -00618 P6000-REQUEST-INQUIRE. DTSCS85 -00619 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS85 -00620 SET FFAZ-FAZ-88 TO TRUE. DTSCS85 -00621 SKIP1 DTSCS85 -00622 MOVE MAP-TERRITORY TO WRK-HOLD-TERRITORY. DTSCS85 -00623 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 -00624 MOVE WRK-HOLD-TERRITORY TO MAP-TERRITORY. DTSCS85 -00625 SKIP1 DTSCS85 -00626 INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE. DTSCS85 -00627 MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY. DTSCS85 -00628 SKIP1 DTSCS85 -00629 IF LCCM-SCR-INQUIRE DTSCS85 -00630 AND FFAZ-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS85 -00631 MOVE 'N' TO SCR-NEW-KEY-IND DTSCS85 -00632 ELSE DTSCS85 -00633 MOVE 'Y' TO SCR-NEW-KEY-IND. DTSCS85 -00634 SKIP1 DTSCS85 -00635 IF SCR-ACCESS-UPDATE DTSCS85 -00636 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS85 +00571 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS85 +00572 SKIP3 DTSCS85 +00573 *----------------------------------------------------- DTSCS85 +00574 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS85 +00575 *----------------------------------------------------- DTSCS85 +00576 IF LCCM-MSG DTSCS85 +00577 SET RESP-SEND-MSGONLY TO TRUE DTSCS85 +00578 SET CURSOR-SET-GOTO TO TRUE DTSCS85 +00579 GO TO P3000-EXIT. DTSCS85 +00580 SKIP3 DTSCS85 +00581 *----------------------------------------------------- DTSCS85 +00582 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS85 +00583 *----------------------------------------------------- DTSCS85 +00584 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS85 +00585 LCCM-SCR-HOLD-AREA. DTSCS85 +00586 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS85 +00587 SET RESP-JUMP TO TRUE. DTSCS85 +00588 P3000-EXIT. DTSCS85 +00589 EXIT. DTSCS85 +00590 /*****************************************************************DTSCS85 +00591 * CLEAR KEY WAS PRESSED *DTSCS85 +00592 ******************************************************************DTSCS85 +00593 SKIP1 DTSCS85 +00594 P4000-REQUEST-CLEAR. DTSCS85 +00595 IF SCR-ACCESS-UPDATE DTSCS85 +00596 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS85 +00597 ELSE DTSCS85 +00598 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS85 +00599 SKIP3 DTSCS85 +00600 *----------------------------------------------------- DTSCS85 +00601 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS85 +00602 * FIELDS FROM EARLIER REQUESTS DTSCS85 +00603 *----------------------------------------------------- DTSCS85 +00604 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS85 +00605 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 +00606 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 +00607 SET RESP-SEND-MAP TO TRUE. DTSCS85 +00608 P4000-EXIT. DTSCS85 +00609 EXIT. DTSCS85 +00610 /*****************************************************************DTSCS85 +00611 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS85 +00612 ******************************************************************DTSCS85 +00613 SKIP1 DTSCS85 +00614 P5000-CURSOR-TO-GOTO. DTSCS85 +00615 SET CURSOR-SET-GOTO TO TRUE. DTSCS85 +00616 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS85 +00617 P5000-EXIT. DTSCS85 +00618 EXIT. DTSCS85 +00619 /*****************************************************************DTSCS85 +00620 * INQUIRY WAS REQUESTED *DTSCS85 +00621 ******************************************************************DTSCS85 +00622 SKIP1 DTSCS85 +00623 P6000-REQUEST-INQUIRE. DTSCS85 +00624 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS85 +00625 SET FFAZ-FAZ-88 TO TRUE. DTSCS85 +00626 SKIP1 DTSCS85 +00627 MOVE MAP-TERRITORY TO WRK-HOLD-TERRITORY. DTSCS85 +00628 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 +00629 MOVE WRK-HOLD-TERRITORY TO MAP-TERRITORY. DTSCS85 +00630 SKIP1 DTSCS85 +00631 INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE. DTSCS85 +00632 MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY. DTSCS85 +00633 SKIP1 DTSCS85 +00634 IF LCCM-SCR-INQUIRE DTSCS85 +00635 AND FFAZ-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS85 +00636 MOVE 'N' TO SCR-NEW-KEY-IND DTSCS85 00637 ELSE DTSCS85 -00638 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS85 +00638 MOVE 'Y' TO SCR-NEW-KEY-IND. DTSCS85 00639 SKIP1 DTSCS85 -00640 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 -00641 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 -00642 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 -00643 SKIP1 DTSCS85 -00644 IF LCCM-MSG DTSCS85 -00645 NEXT SENTENCE DTSCS85 -00646 ELSE DTSCS85 -00647 IF LCCM-ENTER-88 DTSCS85 -00648 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS85 -00649 ELSE DTSCS85 -00650 IF LCCM-F07-88 DTSCS85 -00651 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS85 -00652 ELSE DTSCS85 -00653 IF LCCM-F08-88 DTSCS85 -00654 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS85 -00655 ELSE DTSCS85 -00656 GO TO S899-ABEND. DTSCS85 -00657 SKIP1 DTSCS85 -00658 SET RESP-SEND-MAP TO TRUE. DTSCS85 -00659 P6000-EXIT. DTSCS85 -00660 EXIT. DTSCS85 -00661 EJECT DTSCS85 -00662 P6100-NO-PAGE. DTSCS85 -00663 IF MAP-TERRITORY = SPACE DTSCS85 -00664 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS85 -00665 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00666 GO TO P6100-EXIT. DTSCS85 -00667 SKIP1 DTSCS85 -00668 PERFORM S831-READ THRU S831-EXIT. DTSCS85 -00669 IF L831-NO-REC-88 DTSCS85 -00670 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00671 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00672 GO TO P6100-EXIT. DTSCS85 -00673 SKIP1 DTSCS85 -00674 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 -00675 P6100-EXIT. DTSCS85 -00676 EXIT. DTSCS85 -00677 EJECT DTSCS85 -00678 P6200-PAGE-BACK. DTSCS85 -00679 MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA. DTSCS85 -00680 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS85 -00681 IF L831-NO-REC-88 DTSCS85 -00682 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00683 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00684 GO TO P6200-EXIT. DTSCS85 -00685 SKIP1 DTSCS85 -00686 IF (SCR-NEW-KEY-IND = 'Y') DTSCS85 -00687 AND DTSCS85 -00688 (WRK-KEY-AREA = FFAZ-KEY-AREA) DTSCS85 -00689 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 -00690 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 -00691 GO TO P6200-EXIT. DTSCS85 -00692 SKIP1 DTSCS85 -00693 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS85 -00694 IF L831-NO-REC-88 DTSCS85 -00695 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00696 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00697 GO TO P6200-EXIT. DTSCS85 -00698 SKIP1 DTSCS85 -00699 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS85 -00700 IF L831-NO-REC-88 DTSCS85 -00701 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 -00702 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS85 -00703 ELSE DTSCS85 -00704 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 -00705 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 -00706 P6200-EXIT. DTSCS85 -00707 EXIT. DTSCS85 -00708 EJECT DTSCS85 -00709 P6300-PAGE-NEXT. DTSCS85 -00710 MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA. DTSCS85 -00711 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS85 -00712 IF L831-NO-REC-88 DTSCS85 -00713 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00714 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00715 GO TO P6300-EXIT. DTSCS85 -00716 SKIP1 DTSCS85 -00717 IF (SCR-NEW-KEY-IND = 'N') DTSCS85 -00718 AND DTSCS85 -00719 (WRK-KEY-AREA = FFAZ-KEY-AREA) DTSCS85 -00720 NEXT SENTENCE DTSCS85 -00721 ELSE DTSCS85 -00722 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 -00723 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 -00724 GO TO P6300-EXIT. DTSCS85 -00725 SKIP1 DTSCS85 -00726 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS85 -00727 IF L831-NO-REC-88 DTSCS85 +00640 IF SCR-ACCESS-UPDATE DTSCS85 +00641 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS85 +00642 ELSE DTSCS85 +00643 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS85 +00644 SKIP1 DTSCS85 +00645 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 +00646 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 +00647 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 +00648 SKIP1 DTSCS85 +00649 IF LCCM-MSG DTSCS85 +00650 NEXT SENTENCE DTSCS85 +00651 ELSE DTSCS85 +00652 IF LCCM-ENTER-88 DTSCS85 +00653 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS85 +00654 ELSE DTSCS85 +00655 IF LCCM-F07-88 DTSCS85 +00656 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS85 +00657 ELSE DTSCS85 +00658 IF LCCM-F08-88 DTSCS85 +00659 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS85 +00660 ELSE DTSCS85 +00661 GO TO S899-ABEND. DTSCS85 +00662 SKIP1 DTSCS85 +00663 SET RESP-SEND-MAP TO TRUE. DTSCS85 +00664 P6000-EXIT. DTSCS85 +00665 EXIT. DTSCS85 +00666 EJECT DTSCS85 +00667 P6100-NO-PAGE. DTSCS85 +00668 IF MAP-TERRITORY = SPACE DTSCS85 +00669 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS85 +00670 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00671 GO TO P6100-EXIT. DTSCS85 +00672 SKIP1 DTSCS85 +00673 PERFORM S831-READ THRU S831-EXIT. DTSCS85 +00674 IF L831-NO-REC-88 DTSCS85 +00675 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00676 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00677 GO TO P6100-EXIT. DTSCS85 +00678 SKIP1 DTSCS85 +00679 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 +00680 P6100-EXIT. DTSCS85 +00681 EXIT. DTSCS85 +00682 EJECT DTSCS85 +00683 P6200-PAGE-BACK. DTSCS85 +00684 MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA. DTSCS85 +00685 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS85 +00686 IF L831-NO-REC-88 DTSCS85 +00687 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00688 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00689 GO TO P6200-EXIT. DTSCS85 +00690 SKIP1 DTSCS85 +00691 IF (SCR-NEW-KEY-IND = 'Y') DTSCS85 +00692 AND DTSCS85 +00693 (WRK-KEY-AREA = FFAZ-KEY-AREA) DTSCS85 +00694 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 +00695 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 +00696 GO TO P6200-EXIT. DTSCS85 +00697 SKIP1 DTSCS85 +00698 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS85 +00699 IF L831-NO-REC-88 DTSCS85 +00700 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00701 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00702 GO TO P6200-EXIT. DTSCS85 +00703 SKIP1 DTSCS85 +00704 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS85 +00705 IF L831-NO-REC-88 DTSCS85 +00706 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 +00707 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCS85 +00708 ELSE DTSCS85 +00709 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 +00710 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 +00711 P6200-EXIT. DTSCS85 +00712 EXIT. DTSCS85 +00713 EJECT DTSCS85 +00714 P6300-PAGE-NEXT. DTSCS85 +00715 MOVE FFAZ-KEY-AREA TO WRK-KEY-AREA. DTSCS85 +00716 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS85 +00717 IF L831-NO-REC-88 DTSCS85 +00718 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00719 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00720 GO TO P6300-EXIT. DTSCS85 +00721 SKIP1 DTSCS85 +00722 IF (SCR-NEW-KEY-IND = 'N') DTSCS85 +00723 AND DTSCS85 +00724 (WRK-KEY-AREA = FFAZ-KEY-AREA) DTSCS85 +00725 NEXT SENTENCE DTSCS85 +00726 ELSE DTSCS85 +00727 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 00728 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 -00729 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS85 -00730 ELSE DTSCS85 -00731 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 -00732 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 -00733 P6300-EXIT. DTSCS85 -00734 EXIT. DTSCS85 -00735 /*****************************************************************DTSCS85 -00736 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS85 -00737 ******************************************************************DTSCS85 -00738 SKIP1 DTSCS85 -00739 P6900-CONSTRUCT-SCREEN. DTSCS85 -00740 MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY. DTSCS85 -00741 SKIP1 DTSCS85 -00742 IF FFAZ-SINGLE-REP DTSCS85 -00743 MOVE FFAZ-FLD-REP-ID (1) TO MAP-REP-ID (1) DTSCS85 -00744 MOVE LOW-VALUE TO MAP-REP-ID (2) DTSCS85 -00745 MAP-REP-ID (3) DTSCS85 -00746 MAP-REP-ID (4) DTSCS85 -00747 MAP-REP-ID (5) DTSCS85 -00748 MAP-REP-ID (6) DTSCS85 -00749 MAP-REP-ID (7) DTSCS85 -00750 MAP-REP-ID (8) DTSCS85 -00751 MAP-REP-ID (9) DTSCS85 -00752 MAP-REP-ID (10) DTSCS85 -00753 ELSE DTSCS85 -00754 MOVE FFAZ-FLD-REP-ID (1) TO MAP-REP-ID (1) DTSCS85 -00755 MOVE FFAZ-FLD-REP-ID (2) TO MAP-REP-ID (2) DTSCS85 -00756 MOVE FFAZ-FLD-REP-ID (3) TO MAP-REP-ID (3) DTSCS85 -00757 MOVE FFAZ-FLD-REP-ID (4) TO MAP-REP-ID (4) DTSCS85 -00758 MOVE FFAZ-FLD-REP-ID (5) TO MAP-REP-ID (5) DTSCS85 -00759 MOVE FFAZ-FLD-REP-ID (6) TO MAP-REP-ID (6) DTSCS85 -00760 MOVE FFAZ-FLD-REP-ID (7) TO MAP-REP-ID (7) DTSCS85 -00761 MOVE FFAZ-FLD-REP-ID (8) TO MAP-REP-ID (8) DTSCS85 -00762 MOVE FFAZ-FLD-REP-ID (9) TO MAP-REP-ID (9) DTSCS85 -00763 MOVE FFAZ-FLD-REP-ID (10) TO MAP-REP-ID (10). DTSCS85 -00764 SKIP1 DTSCS85 -00765 IF FFAZ-ESTB-DATE NOT = +0 DTSCS85 -00766 MOVE FFAZ-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS85 -00767 SET L001-FROM-FED-8 TO TRUE DTSCS85 -00768 PERFORM S001-DATE THRU S001-EXIT DTSCS85 -00769 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS85 -00770 SKIP1 DTSCS85 -00771 IF FFAZ-CHNG-DATE NOT = +0 DTSCS85 -00772 MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS85 -00773 SET L001-FROM-FED-8 TO TRUE DTSCS85 -00774 PERFORM S001-DATE THRU S001-EXIT DTSCS85 -00775 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS85 -00776 SKIP1 DTSCS85 -00777 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 -00778 MOVE FFAZ-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS85 -00779 P6900-EXIT. DTSCS85 -00780 EXIT. DTSCS85 -00781 /*****************************************************************DTSCS85 -00782 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS85 -00783 ******************************************************************DTSCS85 -00784 SKIP1 DTSCS85 -00785 P7000-REQUEST-EDIT. DTSCS85 -00786 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 -00787 SKIP1 DTSCS85 -00788 IF LCCM-F09-88 DTSCS85 -00789 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS85 -00790 ELSE DTSCS85 -00791 IF LCCM-F10-88 DTSCS85 -00792 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS85 -00793 ELSE DTSCS85 -00794 IF LCCM-F23-88 DTSCS85 -00795 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS85 -00796 ELSE DTSCS85 -00797 GO TO S899-ABEND. DTSCS85 -00798 SKIP3 DTSCS85 -00799 *------------------------------------------------------ DTSCS85 -00800 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS85 -00801 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS85 -00802 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS85 -00803 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS85 +00729 GO TO P6300-EXIT. DTSCS85 +00730 SKIP1 DTSCS85 +00731 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS85 +00732 IF L831-NO-REC-88 DTSCS85 +00733 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS85 +00734 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCS85 +00735 ELSE DTSCS85 +00736 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS85 +00737 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS85 +00738 P6300-EXIT. DTSCS85 +00739 EXIT. DTSCS85 +00740 /*****************************************************************DTSCS85 +00741 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS85 +00742 ******************************************************************DTSCS85 +00743 SKIP1 DTSCS85 +00744 P6900-CONSTRUCT-SCREEN. DTSCS85 +00745 MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY. DTSCS85 +00746 SKIP1 DTSCS85 +00747 IF FFAZ-SINGLE-REP DTSCS85 +00748 MOVE FFAZ-FLD-REP-ID (1) TO MAP-REP-ID (1) DTSCS85 +00749 MOVE LOW-VALUE TO MAP-REP-ID (2) DTSCS85 +00750 MAP-REP-ID (3) DTSCS85 +00751 MAP-REP-ID (4) DTSCS85 +00752 MAP-REP-ID (5) DTSCS85 +00753 MAP-REP-ID (6) DTSCS85 +00754 MAP-REP-ID (7) DTSCS85 +00755 MAP-REP-ID (8) DTSCS85 +00756 MAP-REP-ID (9) DTSCS85 +00757 MAP-REP-ID (10) DTSCS85 +00758 ELSE DTSCS85 +00759 MOVE FFAZ-FLD-REP-ID (1) TO MAP-REP-ID (1) DTSCS85 +00760 MOVE FFAZ-FLD-REP-ID (2) TO MAP-REP-ID (2) DTSCS85 +00761 MOVE FFAZ-FLD-REP-ID (3) TO MAP-REP-ID (3) DTSCS85 +00762 MOVE FFAZ-FLD-REP-ID (4) TO MAP-REP-ID (4) DTSCS85 +00763 MOVE FFAZ-FLD-REP-ID (5) TO MAP-REP-ID (5) DTSCS85 +00764 MOVE FFAZ-FLD-REP-ID (6) TO MAP-REP-ID (6) DTSCS85 +00765 MOVE FFAZ-FLD-REP-ID (7) TO MAP-REP-ID (7) DTSCS85 +00766 MOVE FFAZ-FLD-REP-ID (8) TO MAP-REP-ID (8) DTSCS85 +00767 MOVE FFAZ-FLD-REP-ID (9) TO MAP-REP-ID (9) DTSCS85 +00768 MOVE FFAZ-FLD-REP-ID (10) TO MAP-REP-ID (10). DTSCS85 +00769 SKIP1 DTSCS85 +00770 IF FFAZ-ESTB-DATE NOT = +0 DTSCS85 +00771 MOVE FFAZ-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS85 +00772 SET L001-FROM-FED-8 TO TRUE DTSCS85 +00773 PERFORM S001-DATE THRU S001-EXIT DTSCS85 +00774 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS85 +00775 SKIP1 DTSCS85 +00776 IF FFAZ-CHNG-DATE NOT = +0 DTSCS85 +00777 MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS85 +00778 SET L001-FROM-FED-8 TO TRUE DTSCS85 +00779 PERFORM S001-DATE THRU S001-EXIT DTSCS85 +00780 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS85 +00781 SKIP1 DTSCS85 +00782 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 +00783 MOVE FFAZ-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS85 +00784 P6900-EXIT. DTSCS85 +00785 EXIT. DTSCS85 +00786 /*****************************************************************DTSCS85 +00787 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS85 +00788 ******************************************************************DTSCS85 +00789 SKIP1 DTSCS85 +00790 P7000-REQUEST-EDIT. DTSCS85 +00791 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 +00792 SKIP1 DTSCS85 +00793 IF LCCM-F09-88 DTSCS85 +00794 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS85 +00795 ELSE DTSCS85 +00796 IF LCCM-F10-88 DTSCS85 +00797 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS85 +00798 ELSE DTSCS85 +00799 IF LCCM-F23-88 DTSCS85 +00800 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS85 +00801 ELSE DTSCS85 +00802 GO TO S899-ABEND. DTSCS85 +00803 SKIP3 DTSCS85 00804 *------------------------------------------------------ DTSCS85 -00805 SKIP1 DTSCS85 -00806 IF LCCM-MSG DTSCS85 -00807 NEXT SENTENCE DTSCS85 -00808 ELSE DTSCS85 -00809 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS85 -00810 IF LCCM-F09-88 DTSCS85 -00811 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS85 -00812 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS85 -00813 ELSE DTSCS85 -00814 IF LCCM-F10-88 DTSCS85 -00815 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS85 -00816 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS85 -00817 ELSE DTSCS85 -00818 IF LCCM-F23-88 DTSCS85 -00819 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS85 -00820 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS85 -00821 SKIP1 DTSCS85 -00822 SET RESP-SEND-MAP TO TRUE. DTSCS85 -00823 P7000-EXIT. DTSCS85 -00824 EXIT. DTSCS85 -00825 /*****************************************************************DTSCS85 -00826 * ADD FUNCTION WAS REQUESTED *DTSCS85 -00827 ******************************************************************DTSCS85 -00828 SKIP1 DTSCS85 -00829 P7100-EDIT-ADD. DTSCS85 -00830 *------------------------------------------------------ DTSCS85 -00831 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS85 -00832 *------------------------------------------------------ DTSCS85 -00833 IF NOT LCCM-SCR-CLEAR DTSCS85 -00834 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS85 -00835 GO TO P7100-EXIT. DTSCS85 -00836 SKIP1 DTSCS85 -00837 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS85 -00838 SKIP1 DTSCS85 -00839 IF LCCM-NO-MSG DTSCS85 -00840 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 -00841 IF L831-OK-88 DTSCS85 -00842 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS85 -00843 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00844 ELSE DTSCS85 -00845 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS85 -00846 P7100-EXIT. DTSCS85 -00847 EXIT. DTSCS85 -00848 /*****************************************************************DTSCS85 -00849 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS85 -00850 ******************************************************************DTSCS85 -00851 SKIP1 DTSCS85 -00852 P7200-EDIT-MOD. DTSCS85 -00853 *----------------------------------------------------- DTSCS85 -00854 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS85 -00855 * INQUIRED DTSCS85 -00856 *----------------------------------------------------- DTSCS85 -00857 IF NOT LCCM-SCR-INQUIRE DTSCS85 -00858 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS85 -00859 GO TO P7200-EXIT. DTSCS85 -00860 SKIP3 DTSCS85 +00805 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS85 +00806 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS85 +00807 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS85 +00808 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS85 +00809 *------------------------------------------------------ DTSCS85 +00810 SKIP1 DTSCS85 +00811 IF LCCM-MSG DTSCS85 +00812 NEXT SENTENCE DTSCS85 +00813 ELSE DTSCS85 +00814 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS85 +00815 IF LCCM-F09-88 DTSCS85 +00816 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS85 +00817 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS85 +00818 ELSE DTSCS85 +00819 IF LCCM-F10-88 DTSCS85 +00820 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS85 +00821 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS85 +00822 ELSE DTSCS85 +00823 IF LCCM-F23-88 DTSCS85 +00824 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS85 +00825 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS85 +00826 SKIP1 DTSCS85 +00827 SET RESP-SEND-MAP TO TRUE. DTSCS85 +00828 P7000-EXIT. DTSCS85 +00829 EXIT. DTSCS85 +00830 /*****************************************************************DTSCS85 +00831 * ADD FUNCTION WAS REQUESTED *DTSCS85 +00832 ******************************************************************DTSCS85 +00833 SKIP1 DTSCS85 +00834 P7100-EDIT-ADD. DTSCS85 +00835 *------------------------------------------------------ DTSCS85 +00836 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS85 +00837 *------------------------------------------------------ DTSCS85 +00838 IF NOT LCCM-SCR-CLEAR DTSCS85 +00839 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS85 +00840 GO TO P7100-EXIT. DTSCS85 +00841 SKIP1 DTSCS85 +00842 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS85 +00843 SKIP1 DTSCS85 +00844 IF LCCM-NO-MSG DTSCS85 +00845 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 +00846 IF L831-OK-88 DTSCS85 +00847 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS85 +00848 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00849 ELSE DTSCS85 +00850 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS85 +00851 P7100-EXIT. DTSCS85 +00852 EXIT. DTSCS85 +00853 /*****************************************************************DTSCS85 +00854 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS85 +00855 ******************************************************************DTSCS85 +00856 SKIP1 DTSCS85 +00857 P7200-EDIT-MOD. DTSCS85 +00858 *----------------------------------------------------- DTSCS85 +00859 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS85 +00860 * INQUIRED DTSCS85 00861 *----------------------------------------------------- DTSCS85 -00862 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS85 -00863 *----------------------------------------------------- DTSCS85 -00864 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS85 -00865 IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY DTSCS85 -00866 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS85 -00867 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00868 GO TO P7200-EXIT. DTSCS85 -00869 SKIP1 DTSCS85 -00870 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS85 -00871 SKIP1 DTSCS85 -00872 IF LCCM-NO-MSG DTSCS85 -00873 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 -00874 IF L831-NO-REC-88 DTSCS85 -00875 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00876 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00877 ELSE DTSCS85 -00878 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS85 -00879 P7200-EXIT. DTSCS85 -00880 EXIT. DTSCS85 -00881 /*****************************************************************DTSCS85 -00882 * DELETE FUNCTION WAS REQUESTED *DTSCS85 -00883 ******************************************************************DTSCS85 -00884 SKIP1 DTSCS85 -00885 P7300-EDIT-DEL. DTSCS85 -00886 *----------------------------------------------------- DTSCS85 -00887 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS85 -00888 * INQUIRED DTSCS85 -00889 *----------------------------------------------------- DTSCS85 -00890 IF NOT LCCM-SCR-INQUIRE DTSCS85 -00891 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS85 -00892 GO TO P7300-EXIT. DTSCS85 -00893 SKIP3 DTSCS85 +00862 IF NOT LCCM-SCR-INQUIRE DTSCS85 +00863 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS85 +00864 GO TO P7200-EXIT. DTSCS85 +00865 SKIP3 DTSCS85 +00866 *----------------------------------------------------- DTSCS85 +00867 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS85 +00868 *----------------------------------------------------- DTSCS85 +00869 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS85 +00870 IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY DTSCS85 +00871 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS85 +00872 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00873 GO TO P7200-EXIT. DTSCS85 +00874 SKIP1 DTSCS85 +00875 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS85 +00876 SKIP1 DTSCS85 +00877 IF LCCM-NO-MSG DTSCS85 +00878 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 +00879 IF L831-NO-REC-88 DTSCS85 +00880 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00881 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00882 ELSE DTSCS85 +00883 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS85 +00884 P7200-EXIT. DTSCS85 +00885 EXIT. DTSCS85 +00886 /*****************************************************************DTSCS85 +00887 * DELETE FUNCTION WAS REQUESTED *DTSCS85 +00888 ******************************************************************DTSCS85 +00889 SKIP1 DTSCS85 +00890 P7300-EDIT-DEL. DTSCS85 +00891 *----------------------------------------------------- DTSCS85 +00892 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS85 +00893 * INQUIRED DTSCS85 00894 *----------------------------------------------------- DTSCS85 -00895 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS85 -00896 *----------------------------------------------------- DTSCS85 -00897 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS85 -00898 IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY DTSCS85 -00899 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS85 -00900 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00901 GO TO P7300-EXIT. DTSCS85 -00902 SKIP1 DTSCS85 -00903 IF LCCM-NO-MSG DTSCS85 -00904 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 -00905 IF L831-NO-REC-88 DTSCS85 -00906 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00907 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS85 -00908 P7300-EXIT. DTSCS85 -00909 EXIT. DTSCS85 -00910 /*****************************************************************DTSCS85 -00911 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS85 -00912 ******************************************************************DTSCS85 -00913 SKIP1 DTSCS85 -00914 P8000-REQUEST-UPDATE. DTSCS85 -00915 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 -00916 SKIP1 DTSCS85 -00917 IF LCCM-SCR-ADD-LOCKED DTSCS85 -00918 PERFORM P8100-ADD THRU P8100-EXIT DTSCS85 -00919 ELSE DTSCS85 -00920 IF LCCM-SCR-MOD-LOCKED DTSCS85 -00921 PERFORM P8200-MOD THRU P8200-EXIT DTSCS85 -00922 ELSE DTSCS85 -00923 IF LCCM-SCR-DEL-LOCKED DTSCS85 -00924 PERFORM P8300-DEL THRU P8300-EXIT DTSCS85 -00925 ELSE DTSCS85 -00926 GO TO S899-ABEND. DTSCS85 -00927 SKIP1 DTSCS85 -00928 SET RESP-SEND-MAP TO TRUE. DTSCS85 -00929 P8000-EXIT. DTSCS85 -00930 EXIT. DTSCS85 -00931 /*****************************************************************DTSCS85 -00932 * *DTSCS85 -00933 ******************************************************************DTSCS85 -00934 SKIP1 DTSCS85 -00935 P8100-ADD. DTSCS85 -00936 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 -00937 SKIP1 DTSCS85 -00938 IF LCCM-F12-88 DTSCS85 -00939 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS85 -00940 GO TO P8100-EXIT. DTSCS85 -00941 SKIP1 DTSCS85 -00942 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 -00943 IF L831-OK-88 DTSCS85 -00944 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS85 -00945 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00946 GO TO P8100-EXIT. DTSCS85 -00947 SKIP1 DTSCS85 -00948 MOVE LOW-VALUES TO FFAZ-DATA-AREA. DTSCS85 -00949 SKIP1 DTSCS85 -00950 PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT. DTSCS85 -00951 SKIP1 DTSCS85 -00952 MOVE LCCM-CURR-RUN-DATE TO FFAZ-ESTB-DATE. DTSCS85 -00953 MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE. DTSCS85 +00895 IF NOT LCCM-SCR-INQUIRE DTSCS85 +00896 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS85 +00897 GO TO P7300-EXIT. DTSCS85 +00898 SKIP3 DTSCS85 +00899 *----------------------------------------------------- DTSCS85 +00900 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS85 +00901 *----------------------------------------------------- DTSCS85 +00902 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS85 +00903 IF MAP-TERRITORY NOT = WRK-FLD-TERRITORY DTSCS85 +00904 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS85 +00905 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00906 GO TO P7300-EXIT. DTSCS85 +00907 SKIP1 DTSCS85 +00908 IF LCCM-NO-MSG DTSCS85 +00909 PERFORM S8010-READ-FFAZ THRU S8010-EXIT DTSCS85 +00910 IF L831-NO-REC-88 DTSCS85 +00911 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00912 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS85 +00913 P7300-EXIT. DTSCS85 +00914 EXIT. DTSCS85 +00915 /*****************************************************************DTSCS85 +00916 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS85 +00917 ******************************************************************DTSCS85 +00918 SKIP1 DTSCS85 +00919 P8000-REQUEST-UPDATE. DTSCS85 +00920 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 +00921 SKIP1 DTSCS85 +00922 IF LCCM-SCR-ADD-LOCKED DTSCS85 +00923 PERFORM P8100-ADD THRU P8100-EXIT DTSCS85 +00924 ELSE DTSCS85 +00925 IF LCCM-SCR-MOD-LOCKED DTSCS85 +00926 PERFORM P8200-MOD THRU P8200-EXIT DTSCS85 +00927 ELSE DTSCS85 +00928 IF LCCM-SCR-DEL-LOCKED DTSCS85 +00929 PERFORM P8300-DEL THRU P8300-EXIT DTSCS85 +00930 ELSE DTSCS85 +00931 GO TO S899-ABEND. DTSCS85 +00932 SKIP1 DTSCS85 +00933 SET RESP-SEND-MAP TO TRUE. DTSCS85 +00934 P8000-EXIT. DTSCS85 +00935 EXIT. DTSCS85 +00936 /*****************************************************************DTSCS85 +00937 * *DTSCS85 +00938 ******************************************************************DTSCS85 +00939 SKIP1 DTSCS85 +00940 P8100-ADD. DTSCS85 +00941 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 +00942 SKIP1 DTSCS85 +00943 IF LCCM-F12-88 DTSCS85 +00944 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS85 +00945 GO TO P8100-EXIT. DTSCS85 +00946 SKIP1 DTSCS85 +00947 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 +00948 IF L831-OK-88 DTSCS85 +00949 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS85 +00950 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00951 GO TO P8100-EXIT. DTSCS85 +00952 SKIP1 DTSCS85 +00953 MOVE LOW-VALUES TO FFAZ-DATA-AREA. DTSCS85 00954 SKIP1 DTSCS85 -00955 PERFORM S831-WRITE THRU S831-EXIT. DTSCS85 +00955 PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT. DTSCS85 00956 SKIP1 DTSCS85 -00957 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 -00958 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 -00959 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 -00960 P8100-EXIT. DTSCS85 -00961 EXIT. DTSCS85 -00962 /*****************************************************************DTSCS85 -00963 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS85 -00964 ******************************************************************DTSCS85 -00965 SKIP1 DTSCS85 -00966 P8200-MOD. DTSCS85 -00967 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 -00968 SKIP1 DTSCS85 -00969 IF LCCM-F12-88 DTSCS85 -00970 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS85 -00971 GO TO P8200-EXIT. DTSCS85 -00972 SKIP1 DTSCS85 -00973 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 -00974 IF L831-NO-REC-88 DTSCS85 -00975 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -00976 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -00977 GO TO P8200-EXIT. DTSCS85 -00978 SKIP1 DTSCS85 -00979 PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT. DTSCS85 -00980 SKIP1 DTSCS85 -00981 MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE. DTSCS85 -00982 SKIP1 DTSCS85 -00983 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS85 -00984 SKIP1 DTSCS85 -00985 MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS85 -00986 SET L001-FROM-FED-8 TO TRUE. DTSCS85 -00987 PERFORM S001-DATE THRU S001-EXIT. DTSCS85 -00988 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS85 +00957 MOVE LCCM-CURR-RUN-DATE TO FFAZ-ESTB-DATE. DTSCS85 +00958 MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE. DTSCS85 +00959 SKIP1 DTSCS85 +00960 PERFORM S831-WRITE THRU S831-EXIT. DTSCS85 +00961 SKIP1 DTSCS85 +00962 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 +00963 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 +00964 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 +00965 P8100-EXIT. DTSCS85 +00966 EXIT. DTSCS85 +00967 /*****************************************************************DTSCS85 +00968 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS85 +00969 ******************************************************************DTSCS85 +00970 SKIP1 DTSCS85 +00971 P8200-MOD. DTSCS85 +00972 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 +00973 SKIP1 DTSCS85 +00974 IF LCCM-F12-88 DTSCS85 +00975 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS85 +00976 GO TO P8200-EXIT. DTSCS85 +00977 SKIP1 DTSCS85 +00978 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 +00979 IF L831-NO-REC-88 DTSCS85 +00980 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +00981 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +00982 GO TO P8200-EXIT. DTSCS85 +00983 SKIP1 DTSCS85 +00984 PERFORM P8900-CONSTRUCT-FFAZ THRU P8900-EXIT. DTSCS85 +00985 SKIP1 DTSCS85 +00986 MOVE LCCM-CURR-RUN-DATE TO FFAZ-CHNG-DATE. DTSCS85 +00987 SKIP1 DTSCS85 +00988 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS85 00989 SKIP1 DTSCS85 -00990 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 -00991 P8200-EXIT. DTSCS85 -00992 EXIT. DTSCS85 -00993 /*****************************************************************DTSCS85 -00994 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS85 -00995 ******************************************************************DTSCS85 -00996 SKIP1 DTSCS85 -00997 P8300-DEL. DTSCS85 -00998 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 -00999 SKIP1 DTSCS85 -01000 IF LCCM-F12-88 DTSCS85 -01001 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS85 -01002 GO TO P8300-EXIT. DTSCS85 -01003 SKIP1 DTSCS85 -01004 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 -01005 IF NOT L831-OK-88 DTSCS85 -01006 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 -01007 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -01008 GO TO P8300-EXIT. DTSCS85 -01009 SKIP1 DTSCS85 -01010 PERFORM S831-DELETE THRU S831-EXIT. DTSCS85 -01011 SKIP1 DTSCS85 -01012 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 -01013 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 -01014 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 -01015 SKIP1 DTSCS85 -01016 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 -01017 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 -01018 SKIP1 DTSCS85 -01019 MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY. DTSCS85 +00990 MOVE FFAZ-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS85 +00991 SET L001-FROM-FED-8 TO TRUE. DTSCS85 +00992 PERFORM S001-DATE THRU S001-EXIT. DTSCS85 +00993 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS85 +00994 SKIP1 DTSCS85 +00995 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 +00996 P8200-EXIT. DTSCS85 +00997 EXIT. DTSCS85 +00998 /*****************************************************************DTSCS85 +00999 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS85 +01000 ******************************************************************DTSCS85 +01001 SKIP1 DTSCS85 +01002 P8300-DEL. DTSCS85 +01003 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS85 +01004 SKIP1 DTSCS85 +01005 IF LCCM-F12-88 DTSCS85 +01006 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS85 +01007 GO TO P8300-EXIT. DTSCS85 +01008 SKIP1 DTSCS85 +01009 PERFORM S8010-READ-FFAZ THRU S8010-EXIT. DTSCS85 +01010 IF NOT L831-OK-88 DTSCS85 +01011 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS85 +01012 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +01013 GO TO P8300-EXIT. DTSCS85 +01014 SKIP1 DTSCS85 +01015 PERFORM S831-DELETE THRU S831-EXIT. DTSCS85 +01016 SKIP1 DTSCS85 +01017 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS85 +01018 SET LCCM-SCR-CLEAR TO TRUE. DTSCS85 +01019 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS85 01020 SKIP1 DTSCS85 -01021 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 -01022 P8300-EXIT. DTSCS85 -01023 EXIT. DTSCS85 -01024 EJECT DTSCS85 -01025 P8900-CONSTRUCT-FFAZ. DTSCS85 -01026 SKIP1 DTSCS85 -01027 MOVE MAP-REP-ID (1) TO FFAZ-FLD-REP-ID (1). DTSCS85 -01028 SKIP1 DTSCS85 -01029 IF MAP-REP-ID (2) = LOW-VALUE DTSCS85 -01030 SET FFAZ-SINGLE-REP TO TRUE DTSCS85 -01031 MOVE LOW-VALUE TO FFAZ-FLD-REP-ID (2) DTSCS85 -01032 FFAZ-FLD-REP-ID (3) DTSCS85 -01033 FFAZ-FLD-REP-ID (4) DTSCS85 -01034 FFAZ-FLD-REP-ID (5) DTSCS85 -01035 FFAZ-FLD-REP-ID (6) DTSCS85 -01036 FFAZ-FLD-REP-ID (7) DTSCS85 -01037 FFAZ-FLD-REP-ID (8) DTSCS85 -01038 FFAZ-FLD-REP-ID (9) DTSCS85 -01039 FFAZ-FLD-REP-ID (10) DTSCS85 -01040 ELSE DTSCS85 -01041 SET FFAZ-MULTIPLE-REPS TO TRUE DTSCS85 -01042 MOVE MAP-REP-ID (2) TO FFAZ-FLD-REP-ID (2) DTSCS85 -01043 MOVE MAP-REP-ID (3) TO FFAZ-FLD-REP-ID (3) DTSCS85 -01044 MOVE MAP-REP-ID (4) TO FFAZ-FLD-REP-ID (4) DTSCS85 -01045 MOVE MAP-REP-ID (5) TO FFAZ-FLD-REP-ID (5) DTSCS85 -01046 MOVE MAP-REP-ID (6) TO FFAZ-FLD-REP-ID (6) DTSCS85 -01047 MOVE MAP-REP-ID (7) TO FFAZ-FLD-REP-ID (7) DTSCS85 -01048 MOVE MAP-REP-ID (8) TO FFAZ-FLD-REP-ID (8) DTSCS85 -01049 MOVE MAP-REP-ID (9) TO FFAZ-FLD-REP-ID (9) DTSCS85 -01050 MOVE MAP-REP-ID (10) TO FFAZ-FLD-REP-ID (10). DTSCS85 -01051 SKIP1 DTSCS85 -01052 P8900-EXIT. DTSCS85 -01053 EXIT. DTSCS85 -01054 /*****************************************************************DTSCS85 -01055 * LINKS TO UTILITY MODULES DTSCS85 -01056 ******************************************************************DTSCS85 -01057 SKIP1 DTSCS85 -01058 S001-DATE. DTSCS85 -01059 EXEC CICS LINK DTSCS85 -01060 PROGRAM ('DTSCU001') DTSCS85 -01061 COMMAREA (L001-COMM-AREA) DTSCS85 -01062 END-EXEC. DTSCS85 -01063 S001-EXIT. DTSCS85 -01064 EXIT. DTSCS85 -01065 SKIP3 DTSCS85 -01066 S062-READ-REP. DTSCS85 -01067 EXEC CICS LINK DTSCS85 -01068 PROGRAM ('DTSCU062') DTSCS85 -01069 COMMAREA (L062-COMM-AREA) DTSCS85 -01070 END-EXEC. DTSCS85 -01071 SKIP1 DTSCS85 -01072 IF L062-FILE-CLOSED DTSCS85 -01073 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS85 -01074 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS85 -01075 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 -01076 GO TO MAINLINE-EXIT. DTSCS85 -01077 S062-EXIT. DTSCS85 -01078 EXIT. DTSCS85 -01079 EJECT DTSCS85 -01080 S803-REQ-SCR-ID-EDIT. DTSCS85 -01081 EXEC CICS LINK DTSCS85 -01082 PROGRAM ('DTSCU803') DTSCS85 -01083 COMMAREA (DFHCOMMAREA) DTSCS85 -01084 END-EXEC. DTSCS85 -01085 S803-EXIT. DTSCS85 -01086 EXIT. DTSCS85 -01087 SKIP3 DTSCS85 -01088 S804-INVALID-KEY. DTSCS85 -01089 EXEC CICS LINK DTSCS85 -01090 PROGRAM ('DTSCU804') DTSCS85 -01091 COMMAREA (DFHCOMMAREA) DTSCS85 -01092 END-EXEC. DTSCS85 -01093 S804-EXIT. DTSCS85 -01094 EXIT. DTSCS85 -01095 SKIP3 DTSCS85 -01096 S805-MSG-AREA. DTSCS85 -01097 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS85 -01098 SKIP1 DTSCS85 -01099 EXEC CICS LINK DTSCS85 -01100 PROGRAM ('DTSCU805') DTSCS85 -01101 COMMAREA (L805-COMM-AREA) DTSCS85 -01102 END-EXEC. DTSCS85 +01021 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 +01022 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS85 +01023 SKIP1 DTSCS85 +01024 MOVE FFAZ-FLD-TERRITORY TO MAP-TERRITORY. DTSCS85 +01025 SKIP1 DTSCS85 +01026 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS85 +01027 P8300-EXIT. DTSCS85 +01028 EXIT. DTSCS85 +01029 EJECT DTSCS85 +01030 P8900-CONSTRUCT-FFAZ. DTSCS85 +01031 SKIP1 DTSCS85 +01032 MOVE MAP-REP-ID (1) TO FFAZ-FLD-REP-ID (1). DTSCS85 +01033 SKIP1 DTSCS85 +01034 IF MAP-REP-ID (2) = LOW-VALUE DTSCS85 +01035 SET FFAZ-SINGLE-REP TO TRUE DTSCS85 +01036 MOVE LOW-VALUE TO FFAZ-FLD-REP-ID (2) DTSCS85 +01037 FFAZ-FLD-REP-ID (3) DTSCS85 +01038 FFAZ-FLD-REP-ID (4) DTSCS85 +01039 FFAZ-FLD-REP-ID (5) DTSCS85 +01040 FFAZ-FLD-REP-ID (6) DTSCS85 +01041 FFAZ-FLD-REP-ID (7) DTSCS85 +01042 FFAZ-FLD-REP-ID (8) DTSCS85 +01043 FFAZ-FLD-REP-ID (9) DTSCS85 +01044 FFAZ-FLD-REP-ID (10) DTSCS85 +01045 ELSE DTSCS85 +01046 SET FFAZ-MULTIPLE-REPS TO TRUE DTSCS85 +01047 MOVE MAP-REP-ID (2) TO FFAZ-FLD-REP-ID (2) DTSCS85 +01048 MOVE MAP-REP-ID (3) TO FFAZ-FLD-REP-ID (3) DTSCS85 +01049 MOVE MAP-REP-ID (4) TO FFAZ-FLD-REP-ID (4) DTSCS85 +01050 MOVE MAP-REP-ID (5) TO FFAZ-FLD-REP-ID (5) DTSCS85 +01051 MOVE MAP-REP-ID (6) TO FFAZ-FLD-REP-ID (6) DTSCS85 +01052 MOVE MAP-REP-ID (7) TO FFAZ-FLD-REP-ID (7) DTSCS85 +01053 MOVE MAP-REP-ID (8) TO FFAZ-FLD-REP-ID (8) DTSCS85 +01054 MOVE MAP-REP-ID (9) TO FFAZ-FLD-REP-ID (9) DTSCS85 +01055 MOVE MAP-REP-ID (10) TO FFAZ-FLD-REP-ID (10). DTSCS85 +01056 SKIP1 DTSCS85 +01057 P8900-EXIT. DTSCS85 +01058 EXIT. DTSCS85 +01059 /*****************************************************************DTSCS85 +01060 * LINKS TO UTILITY MODULES DTSCS85 +01061 ******************************************************************DTSCS85 +01062 SKIP1 DTSCS85 +01063 S001-DATE. DTSCS85 +01064 EXEC CICS LINK DTSCS85 +01065 PROGRAM ('DTSCU001') DTSCS85 +01066 COMMAREA (L001-COMM-AREA) DTSCS85 +01067 END-EXEC. DTSCS85 +01068 S001-EXIT. DTSCS85 +01069 EXIT. DTSCS85 +01070 SKIP3 DTSCS85 +01071 S062-READ-REP. DTSCS85 +01072 EXEC CICS LINK DTSCS85 +01073 PROGRAM ('DTSCU062') DTSCS85 +01074 COMMAREA (L062-COMM-AREA) DTSCS85 +01075 END-EXEC. DTSCS85 +01076 SKIP1 DTSCS85 +01077 IF L062-FILE-CLOSED DTSCS85 +01078 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS85 +01079 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS85 +01080 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 +01081 GO TO MAINLINE-EXIT. DTSCS85 +01082 S062-EXIT. DTSCS85 +01083 EXIT. DTSCS85 +01084 EJECT DTSCS85 +01085 S803-REQ-SCR-ID-EDIT. DTSCS85 +01086 EXEC CICS LINK DTSCS85 +01087 PROGRAM ('DTSCU803') DTSCS85 +01088 COMMAREA (DFHCOMMAREA) DTSCS85 +01089 END-EXEC. DTSCS85 +01090 S803-EXIT. DTSCS85 +01091 EXIT. DTSCS85 +01092 SKIP3 DTSCS85 +01093 S804-INVALID-KEY. DTSCS85 +01094 EXEC CICS LINK DTSCS85 +01095 PROGRAM ('DTSCU804') DTSCS85 +01096 COMMAREA (DFHCOMMAREA) DTSCS85 +01097 END-EXEC. DTSCS85 +01098 S804-EXIT. DTSCS85 +01099 EXIT. DTSCS85 +01100 SKIP3 DTSCS85 +01101 S805-MSG-AREA. DTSCS85 +01102 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS85 01103 SKIP1 DTSCS85 -01104 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS85 -01105 S805-EXIT. DTSCS85 -01106 EXIT. DTSCS85 -01107 EJECT DTSCS85 -01108 S831-READ. DTSCS85 -01109 SET L831-READ-88 TO TRUE. DTSCS85 -01110 GO TO S831-IO. DTSCS85 -01111 SKIP1 DTSCS85 -01112 S831-START-BROWSE. DTSCS85 -01113 SET L831-START-BROWSE-88 TO TRUE. DTSCS85 -01114 GO TO S831-IO. DTSCS85 -01115 SKIP1 DTSCS85 -01116 S831-READ-NEXT. DTSCS85 -01117 SET L831-READ-NEXT-88 TO TRUE. DTSCS85 -01118 GO TO S831-IO. DTSCS85 -01119 SKIP1 DTSCS85 -01120 S831-READ-PREV. DTSCS85 -01121 SET L831-READ-PREV-88 TO TRUE. DTSCS85 -01122 GO TO S831-IO. DTSCS85 -01123 SKIP1 DTSCS85 -01124 S831-END-BROWSE. DTSCS85 -01125 SET L831-END-BROWSE-88 TO TRUE. DTSCS85 -01126 GO TO S831-IO. DTSCS85 -01127 SKIP1 DTSCS85 -01128 S831-REWRITE. DTSCS85 -01129 SET L831-REWRITE-88 TO TRUE. DTSCS85 -01130 GO TO S831-IO. DTSCS85 -01131 SKIP1 DTSCS85 -01132 S831-WRITE. DTSCS85 -01133 SET L831-WRITE-88 TO TRUE. DTSCS85 -01134 GO TO S831-IO. DTSCS85 -01135 SKIP1 DTSCS85 -01136 S831-DELETE. DTSCS85 -01137 SET L831-DELETE-88 TO TRUE. DTSCS85 -01138 GO TO S831-IO. DTSCS85 -01139 SKIP1 DTSCS85 -01140 S831-IO. DTSCS85 -01141 SKIP1 DTSCS85 -01142 EXEC CICS LINK DTSCS85 -01143 PROGRAM ('DTSCU831') DTSCS85 -01144 COMMAREA (L831-COMM-AREA) DTSCS85 -01145 END-EXEC. DTSCS85 +01104 EXEC CICS LINK DTSCS85 +01105 PROGRAM ('DTSCU805') DTSCS85 +01106 COMMAREA (L805-COMM-AREA) DTSCS85 +01107 END-EXEC. DTSCS85 +01108 SKIP1 DTSCS85 +01109 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS85 +01110 S805-EXIT. DTSCS85 +01111 EXIT. DTSCS85 +01112 EJECT DTSCS85 +01113 S831-READ. DTSCS85 +01114 SET L831-READ-88 TO TRUE. DTSCS85 +01115 GO TO S831-IO. DTSCS85 +01116 SKIP1 DTSCS85 +01117 S831-START-BROWSE. DTSCS85 +01118 SET L831-START-BROWSE-88 TO TRUE. DTSCS85 +01119 GO TO S831-IO. DTSCS85 +01120 SKIP1 DTSCS85 +01121 S831-READ-NEXT. DTSCS85 +01122 SET L831-READ-NEXT-88 TO TRUE. DTSCS85 +01123 GO TO S831-IO. DTSCS85 +01124 SKIP1 DTSCS85 +01125 S831-READ-PREV. DTSCS85 +01126 SET L831-READ-PREV-88 TO TRUE. DTSCS85 +01127 GO TO S831-IO. DTSCS85 +01128 SKIP1 DTSCS85 +01129 S831-END-BROWSE. DTSCS85 +01130 SET L831-END-BROWSE-88 TO TRUE. DTSCS85 +01131 GO TO S831-IO. DTSCS85 +01132 SKIP1 DTSCS85 +01133 S831-REWRITE. DTSCS85 +01134 SET L831-REWRITE-88 TO TRUE. DTSCS85 +01135 GO TO S831-IO. DTSCS85 +01136 SKIP1 DTSCS85 +01137 S831-WRITE. DTSCS85 +01138 SET L831-WRITE-88 TO TRUE. DTSCS85 +01139 GO TO S831-IO. DTSCS85 +01140 SKIP1 DTSCS85 +01141 S831-DELETE. DTSCS85 +01142 SET L831-DELETE-88 TO TRUE. DTSCS85 +01143 GO TO S831-IO. DTSCS85 +01144 SKIP1 DTSCS85 +01145 S831-IO. DTSCS85 01146 SKIP1 DTSCS85 -01147 IF L831-FILE-CLOSED-88 DTSCS85 -01148 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS85 -01149 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS85 -01150 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 -01151 GO TO MAINLINE-EXIT. DTSCS85 -01152 S831-EXIT. DTSCS85 -01153 EXIT. DTSCS85 -01154 SKIP3 DTSCS85 -01155 S851-SCREEN-PROCESSING. DTSCS85 -01156 EXEC CICS LINK DTSCS85 -01157 PROGRAM ('DTSCU851') DTSCS85 -01158 COMMAREA (L851-COMM-AREA) DTSCS85 -01159 END-EXEC. DTSCS85 -01160 S851-EXIT. DTSCS85 -01161 EXIT. DTSCS85 -01162 SKIP3 DTSCS85 -01163 S899-ABEND. DTSCS85 -01164 EXEC CICS ABEND DTSCS85 -01165 ABCODE(WRK-ABEND-CD) DTSCS85 -01166 END-EXEC. DTSCS85 -01167 *S899-EXIT. DTSCS85 -01168 * EXIT. DTSCS85 -01169 /*****************************************************************DTSCS85 -01170 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS85 -01171 ******************************************************************DTSCS85 -01172 SKIP1 DTSCS85 -01173 S1001-SCREEN-KEY-EDITS. DTSCS85 -01174 SKIP1 DTSCS85 -01175 PERFORM S1100-TERRITORY THRU S1100-EXIT. DTSCS85 -01176 SKIP1 DTSCS85 -01177 S1001-EXIT. DTSCS85 -01178 EXIT. DTSCS85 -01179 SKIP3 DTSCS85 -01180 S1002-SCREEN-DATA-EDITS. DTSCS85 +01147 EXEC CICS LINK DTSCS85 +01148 PROGRAM ('DTSCU831') DTSCS85 +01149 COMMAREA (L831-COMM-AREA) DTSCS85 +01150 END-EXEC. DTSCS85 +01151 SKIP1 DTSCS85 +01152 IF L831-FILE-CLOSED-88 DTSCS85 +01153 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS85 +01154 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS85 +01155 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS85 +01156 GO TO MAINLINE-EXIT. DTSCS85 +01157 S831-EXIT. DTSCS85 +01158 EXIT. DTSCS85 +01159 SKIP3 DTSCS85 +01160 S851-SCREEN-PROCESSING. DTSCS85 +01161 EXEC CICS LINK DTSCS85 +01162 PROGRAM ('DTSCU851') DTSCS85 +01163 COMMAREA (L851-COMM-AREA) DTSCS85 +01164 END-EXEC. DTSCS85 +01165 S851-EXIT. DTSCS85 +01166 EXIT. DTSCS85 +01167 SKIP3 DTSCS85 +01168 S899-ABEND. DTSCS85 +01169 EXEC CICS ABEND DTSCS85 +01170 ABCODE(WRK-ABEND-CD) DTSCS85 +01171 END-EXEC. DTSCS85 +01172 *S899-EXIT. DTSCS85 +01173 * EXIT. DTSCS85 +01174 /*****************************************************************DTSCS85 +01175 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS85 +01176 ******************************************************************DTSCS85 +01177 SKIP1 DTSCS85 +01178 S1001-SCREEN-KEY-EDITS. DTSCS85 +01179 SKIP1 DTSCS85 +01180 PERFORM S1100-TERRITORY THRU S1100-EXIT. DTSCS85 01181 SKIP1 DTSCS85 -01182 PERFORM S1210-REP-1 THRU S1210-EXIT. DTSCS85 -01183 PERFORM S1220-REP-2 THRU S1220-EXIT. DTSCS85 -01184 PERFORM S1230-REP-REST THRU S1230-EXIT DTSCS85 -01185 VARYING MAP-IDX FROM 3 BY 1 DTSCS85 -01186 UNTIL MAP-IDX GREATER THAN 10. DTSCS85 -01187 SKIP1 DTSCS85 -01188 S1002-EXIT. DTSCS85 -01189 EXIT. DTSCS85 -01190 EJECT DTSCS85 -01191 S1100-TERRITORY. DTSCS85 -01192 INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE. DTSCS85 -01193 IF MAP-TERRITORY = SPACE DTSCS85 -01194 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS85 -01195 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 -01196 ELSE DTSCS85 -01197 IF MAP-TERRITORY NUMERIC DTSCS85 -01198 NEXT SENTENCE DTSCS85 -01199 ELSE DTSCS85 -01200 MOVE MAP-TERRITORY TO C072-ST DTSCS85 -01201 IF C072-US-88 OR C072-CANADA-88 DTSCS85 -01202 NEXT SENTENCE DTSCS85 -01203 ELSE DTSCS85 -01204 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 -01205 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS85 -01206 S1100-EXIT. DTSCS85 -01207 EXIT. DTSCS85 -01208 SKIP3 DTSCS85 -01209 S1101-ERROR. DTSCS85 -01210 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TERRITORY-A. DTSCS85 -01211 IF LCCM-NO-MSG DTSCS85 -01212 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS85 -01213 MOVE CATB-CURSOR TO MAP-TERRITORY-L DTSCS85 -01214 SET CURSOR-SET-YES TO TRUE. DTSCS85 -01215 S1101-EXIT. DTSCS85 -01216 EXIT. DTSCS85 -01217 EJECT DTSCS85 -01218 S1210-REP-1. DTSCS85 -01219 SET MAP-IDX TO +1. DTSCS85 -01220 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 -01221 S1210-EXIT. DTSCS85 -01222 EXIT. DTSCS85 -01223 SKIP3 DTSCS85 -01224 S1211-VERIFY. DTSCS85 -01225 MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID. DTSCS85 -01226 PERFORM S062-READ-REP THRU S062-EXIT. DTSCS85 -01227 IF L062-NOT-VALID DTSCS85 -01228 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 -01229 PERFORM S1291-ERROR THRU S1291-EXIT DTSCS85 -01230 GO TO S1211-EXIT. DTSCS85 -01231 IF L062-FIELD-DESK-88 OR L062-DEFAULT-FLD-REP-88 DTSCS85 -01232 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 -01233 PERFORM S1291-ERROR THRU S1291-EXIT. DTSCS85 -01234 S1211-EXIT. DTSCS85 -01235 EXIT. DTSCS85 -01236 SKIP3 DTSCS85 -01237 S1220-REP-2. DTSCS85 -01238 INSPECT MAP-REP-ID (2) CONVERTING SPACE TO LOW-VALUE. DTSCS85 -01239 IF MAP-REP-ID (2) NOT = LOW-VALUE DTSCS85 -01240 SET MAP-IDX TO +2 DTSCS85 -01241 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 -01242 S1220-EXIT. DTSCS85 -01243 EXIT. DTSCS85 -01244 SKIP3 DTSCS85 -01245 S1230-REP-REST. DTSCS85 -01246 INSPECT MAP-REP-ID (MAP-IDX) CONVERTING SPACE TO LOW-VALUE. DTSCS85 -01247 IF MAP-REP-ID (MAP-IDX) NOT = MAP-REP-ID (2) DTSCS85 -01248 IF MAP-REP-ID (MAP-IDX) = LOW-VALUE DTSCS85 -01249 OR MAP-REP-ID (2) = LOW-VALUE DTSCS85 -01250 MOVE MSG-E851-AREA TO WRK-MSG-AREA DTSCS85 -01251 PERFORM S1291-ERROR THRU S1291-EXIT DTSCS85 -01252 ELSE DTSCS85 -01253 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 -01254 S1230-EXIT. DTSCS85 -01255 EXIT. DTSCS85 -01256 SKIP3 DTSCS85 -01257 S1291-ERROR. DTSCS85 -01258 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-ID-A (MAP-IDX). DTSCS85 -01259 IF LCCM-NO-MSG DTSCS85 -01260 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS85 -01261 MOVE CATB-CURSOR TO MAP-REP-ID-L (MAP-IDX) DTSCS85 -01262 SET CURSOR-SET-YES TO TRUE. DTSCS85 -01263 S1291-EXIT. DTSCS85 -01264 EXIT. DTSCS85 -01265 EJECT DTSCS85 -01266 /*****************************************************************DTSCS85 -01267 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS85 -01268 ******************************************************************DTSCS85 -01269 S5100-SET-LOCK-ATTRB. DTSCS85 -01270 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS85 -01271 SCR-ATB-NUM. DTSCS85 -01272 SKIP1 DTSCS85 -01273 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 -01274 SKIP1 DTSCS85 -01275 MOVE CATB-ASKIP-BRT-MDTON TO MAP-TERRITORY-A DTSCS85 -01276 MAP-GOTO-A. DTSCS85 -01277 S5100-EXIT. DTSCS85 -01278 EXIT. DTSCS85 -01279 SKIP3 DTSCS85 -01280 ******************************************************************DTSCS85 -01281 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS85 -01282 ******************************************************************DTSCS85 -01283 S5200-SET-UPDATE-ATTRB. DTSCS85 -01284 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS85 -01285 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS85 -01286 SKIP1 DTSCS85 -01287 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 -01288 S5200-EXIT. DTSCS85 -01289 EXIT. DTSCS85 -01290 SKIP3 DTSCS85 -01291 ******************************************************************DTSCS85 -01292 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS85 -01293 ******************************************************************DTSCS85 -01294 S5300-SET-INQ-ATTRB. DTSCS85 -01295 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS85 -01296 SCR-ATB-NUM. DTSCS85 -01297 SKIP1 DTSCS85 -01298 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 -01299 S5300-EXIT. DTSCS85 -01300 EXIT. DTSCS85 -01301 SKIP3 DTSCS85 -01302 ******************************************************************DTSCS85 -01303 * DO IT *DTSCS85 -01304 ******************************************************************DTSCS85 -01305 S5900-SET-ATTRB. DTSCS85 -01306 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-TERRITORY-A. DTSCS85 -01307 SKIP1 DTSCS85 -01308 MOVE CATB-ASKIP-NORM-MDTON TO MAP-TERRITORY-DESC-A. DTSCS85 -01309 SKIP1 DTSCS85 -01310 MOVE SCR-ATB-AN TO MAP-REP-ID-A (1) DTSCS85 -01311 MAP-REP-ID-A (2) DTSCS85 -01312 MAP-REP-ID-A (3) DTSCS85 -01313 MAP-REP-ID-A (4) DTSCS85 -01314 MAP-REP-ID-A (5) DTSCS85 -01315 MAP-REP-ID-A (6) DTSCS85 -01316 MAP-REP-ID-A (7) DTSCS85 -01317 MAP-REP-ID-A (8) DTSCS85 -01318 MAP-REP-ID-A (9) DTSCS85 -01319 MAP-REP-ID-A (10). DTSCS85 -01320 SKIP1 DTSCS85 -01321 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS85 -01322 MAP-CHNG-DATE-A. DTSCS85 -01323 SKIP1 DTSCS85 -01324 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS85 -01325 S5900-EXIT. DTSCS85 -01326 EXIT. DTSCS85 -01327 /*****************************************************************DTSCS85 -01328 * READ PREPARATION ROUTINES *DTSCS85 -01329 ******************************************************************DTSCS85 -01330 S8010-READ-FFAZ. DTSCS85 -01331 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS85 -01332 SET FFAZ-FAZ-88 TO TRUE. DTSCS85 -01333 MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY. DTSCS85 -01334 PERFORM S831-READ THRU S831-EXIT. DTSCS85 -01335 S8010-EXIT. DTSCS85 -01336 EXIT. DTSCS85 -01337 /*****************************************************************DTSCS85 -01338 * MAP ROUTINES *DTSCS85 -01339 ******************************************************************DTSCS85 -01340 S9100-RECEIVE. DTSCS85 -01341 SET L851-RECEIVE-88 TO TRUE. DTSCS85 -01342 SKIP1 DTSCS85 -01343 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS85 -01344 SKIP1 DTSCS85 -01345 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 -01346 SKIP1 DTSCS85 -01347 MOVE L851-AID TO LCCM-AID. DTSCS85 -01348 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS85 -01349 S9100-EXIT. DTSCS85 -01350 EXIT. DTSCS85 -01351 SKIP3 DTSCS85 -01352 S9200-SEND-DATAONLY. DTSCS85 -01353 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 -01354 SKIP1 DTSCS85 -01355 IF LCCM-NO-MSG DTSCS85 -01356 NEXT SENTENCE DTSCS85 -01357 ELSE DTSCS85 -01358 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS85 +01182 S1001-EXIT. DTSCS85 +01183 EXIT. DTSCS85 +01184 SKIP3 DTSCS85 +01185 S1002-SCREEN-DATA-EDITS. DTSCS85 +01186 SKIP1 DTSCS85 +01187 PERFORM S1210-REP-1 THRU S1210-EXIT. DTSCS85 +01188 PERFORM S1220-REP-2 THRU S1220-EXIT. DTSCS85 +01189 PERFORM S1230-REP-REST THRU S1230-EXIT DTSCS85 +01190 VARYING MAP-IDX FROM 3 BY 1 DTSCS85 +01191 UNTIL MAP-IDX GREATER THAN 10. DTSCS85 +01192 SKIP1 DTSCS85 +01193 S1002-EXIT. DTSCS85 +01194 EXIT. DTSCS85 +01195 EJECT DTSCS85 +01196 S1100-TERRITORY. DTSCS85 +01197 INSPECT MAP-TERRITORY CONVERTING LOW-VALUE TO SPACE. DTSCS85 +01198 IF MAP-TERRITORY = SPACE DTSCS85 +01199 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS85 +01200 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS85 +01201 ELSE DTSCS85 +01202 IF MAP-TERRITORY NUMERIC DTSCS85 +01203 NEXT SENTENCE DTSCS85 +01204 ELSE DTSCS85 +01205 MOVE MAP-TERRITORY TO C072-ST DTSCS85 +01206 IF C072-US-88 OR C072-CANADA-88 DTSCS85 +01207 NEXT SENTENCE DTSCS85 +01208 ELSE DTSCS85 +01209 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 +01210 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS85 +01211 S1100-EXIT. DTSCS85 +01212 EXIT. DTSCS85 +01213 SKIP3 DTSCS85 +01214 S1101-ERROR. DTSCS85 +01215 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TERRITORY-A. DTSCS85 +01216 IF LCCM-NO-MSG DTSCS85 +01217 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS85 +01218 MOVE CATB-CURSOR TO MAP-TERRITORY-L DTSCS85 +01219 SET CURSOR-SET-YES TO TRUE. DTSCS85 +01220 S1101-EXIT. DTSCS85 +01221 EXIT. DTSCS85 +01222 EJECT DTSCS85 +01223 S1210-REP-1. DTSCS85 +01224 SET MAP-IDX TO +1. DTSCS85 +01225 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 +01226 S1210-EXIT. DTSCS85 +01227 EXIT. DTSCS85 +01228 SKIP3 DTSCS85 +01229 S1211-VERIFY. DTSCS85 +01230 MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID. DTSCS85 +01231 PERFORM S062-READ-REP THRU S062-EXIT. DTSCS85 +01232 IF L062-NOT-VALID DTSCS85 +01233 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 +01234 PERFORM S1291-ERROR THRU S1291-EXIT DTSCS85 +01235 GO TO S1211-EXIT. DTSCS85 +01236 IF L062-FIELD-DESK-88 OR L062-DEFAULT-FLD-REP-88 DTSCS85 +01237 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS85 +01238 PERFORM S1291-ERROR THRU S1291-EXIT. DTSCS85 +01239 S1211-EXIT. DTSCS85 +01240 EXIT. DTSCS85 +01241 SKIP3 DTSCS85 +01242 S1220-REP-2. DTSCS85 +01243 INSPECT MAP-REP-ID (2) CONVERTING SPACE TO LOW-VALUE. DTSCS85 +01244 IF MAP-REP-ID (2) NOT = LOW-VALUE DTSCS85 +01245 SET MAP-IDX TO +2 DTSCS85 +01246 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 +01247 S1220-EXIT. DTSCS85 +01248 EXIT. DTSCS85 +01249 SKIP3 DTSCS85 +01250 S1230-REP-REST. DTSCS85 +01251 INSPECT MAP-REP-ID (MAP-IDX) CONVERTING SPACE TO LOW-VALUE. DTSCS85 +01252 IF MAP-REP-ID (MAP-IDX) NOT = MAP-REP-ID (2) DTSCS85 +01253 IF MAP-REP-ID (MAP-IDX) = LOW-VALUE DTSCS85 +01254 OR MAP-REP-ID (2) = LOW-VALUE DTSCS85 +01255 MOVE MSG-E851-AREA TO WRK-MSG-AREA DTSCS85 +01256 PERFORM S1291-ERROR THRU S1291-EXIT DTSCS85 +01257 ELSE DTSCS85 +01258 PERFORM S1211-VERIFY THRU S1211-EXIT. DTSCS85 +01259 S1230-EXIT. DTSCS85 +01260 EXIT. DTSCS85 +01261 SKIP3 DTSCS85 +01262 S1291-ERROR. DTSCS85 +01263 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-ID-A (MAP-IDX). DTSCS85 +01264 IF LCCM-NO-MSG DTSCS85 +01265 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS85 +01266 MOVE CATB-CURSOR TO MAP-REP-ID-L (MAP-IDX) DTSCS85 +01267 SET CURSOR-SET-YES TO TRUE. DTSCS85 +01268 S1291-EXIT. DTSCS85 +01269 EXIT. DTSCS85 +01270 EJECT DTSCS85 +01271 /*****************************************************************DTSCS85 +01272 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS85 +01273 ******************************************************************DTSCS85 +01274 S5100-SET-LOCK-ATTRB. DTSCS85 +01275 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS85 +01276 SCR-ATB-NUM. DTSCS85 +01277 SKIP1 DTSCS85 +01278 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 +01279 SKIP1 DTSCS85 +01280 MOVE CATB-ASKIP-BRT-MDTON TO MAP-TERRITORY-A DTSCS85 +01281 MAP-GOTO-A. DTSCS85 +01282 S5100-EXIT. DTSCS85 +01283 EXIT. DTSCS85 +01284 SKIP3 DTSCS85 +01285 ******************************************************************DTSCS85 +01286 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS85 +01287 ******************************************************************DTSCS85 +01288 S5200-SET-UPDATE-ATTRB. DTSCS85 +01289 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS85 +01290 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS85 +01291 SKIP1 DTSCS85 +01292 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 +01293 S5200-EXIT. DTSCS85 +01294 EXIT. DTSCS85 +01295 SKIP3 DTSCS85 +01296 ******************************************************************DTSCS85 +01297 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS85 +01298 ******************************************************************DTSCS85 +01299 S5300-SET-INQ-ATTRB. DTSCS85 +01300 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS85 +01301 SCR-ATB-NUM. DTSCS85 +01302 SKIP1 DTSCS85 +01303 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS85 +01304 S5300-EXIT. DTSCS85 +01305 EXIT. DTSCS85 +01306 SKIP3 DTSCS85 +01307 ******************************************************************DTSCS85 +01308 * DO IT *DTSCS85 +01309 ******************************************************************DTSCS85 +01310 S5900-SET-ATTRB. DTSCS85 +01311 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-TERRITORY-A. DTSCS85 +01312 SKIP1 DTSCS85 +01313 MOVE CATB-ASKIP-NORM-MDTON TO MAP-TERRITORY-DESC-A. DTSCS85 +01314 SKIP1 DTSCS85 +01315 MOVE SCR-ATB-AN TO MAP-REP-ID-A (1) DTSCS85 +01316 MAP-REP-ID-A (2) DTSCS85 +01317 MAP-REP-ID-A (3) DTSCS85 +01318 MAP-REP-ID-A (4) DTSCS85 +01319 MAP-REP-ID-A (5) DTSCS85 +01320 MAP-REP-ID-A (6) DTSCS85 +01321 MAP-REP-ID-A (7) DTSCS85 +01322 MAP-REP-ID-A (8) DTSCS85 +01323 MAP-REP-ID-A (9) DTSCS85 +01324 MAP-REP-ID-A (10). DTSCS85 +01325 SKIP1 DTSCS85 +01326 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS85 +01327 MAP-CHNG-DATE-A. DTSCS85 +01328 SKIP1 DTSCS85 +01329 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS85 +01330 S5900-EXIT. DTSCS85 +01331 EXIT. DTSCS85 +01332 /*****************************************************************DTSCS85 +01333 * READ PREPARATION ROUTINES *DTSCS85 +01334 ******************************************************************DTSCS85 +01335 S8010-READ-FFAZ. DTSCS85 +01336 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS85 +01337 SET FFAZ-FAZ-88 TO TRUE. DTSCS85 +01338 MOVE MAP-TERRITORY TO FFAZ-FLD-TERRITORY. DTSCS85 +01339 PERFORM S831-READ THRU S831-EXIT. DTSCS85 +01340 S8010-EXIT. DTSCS85 +01341 EXIT. DTSCS85 +01342 /*****************************************************************DTSCS85 +01343 * MAP ROUTINES *DTSCS85 +01344 ******************************************************************DTSCS85 +01345 S9100-RECEIVE. DTSCS85 +01346 SET L851-RECEIVE-88 TO TRUE. DTSCS85 +01347 SKIP1 DTSCS85 +01348 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS85 +01349 SKIP1 DTSCS85 +01350 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 +01351 SKIP1 DTSCS85 +01352 MOVE L851-AID TO LCCM-AID. DTSCS85 +01353 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS85 +01354 S9100-EXIT. DTSCS85 +01355 EXIT. DTSCS85 +01356 SKIP3 DTSCS85 +01357 S9200-SEND-DATAONLY. DTSCS85 +01358 MOVE LOW-VALUES TO MAP-AREA. DTSCS85 01359 SKIP1 DTSCS85 -01360 IF CURSOR-SET-GOTO DTSCS85 -01361 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS85 +01360 IF LCCM-NO-MSG DTSCS85 +01361 NEXT SENTENCE DTSCS85 01362 ELSE DTSCS85 -01363 MOVE CATB-CURSOR TO MAP-TERRITORY-L. DTSCS85 +01363 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS85 01364 SKIP1 DTSCS85 -01365 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS85 -01366 SKIP1 DTSCS85 -01367 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS85 -01368 SKIP1 DTSCS85 -01369 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 -01370 S9200-EXIT. DTSCS85 -01371 EXIT. DTSCS85 -01372 SKIP3 DTSCS85 -01373 S9300-SEND-MAP. DTSCS85 -01374 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS85 -01375 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS85 -01376 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS85 -01377 SKIP1 DTSCS85 -01378 IF SCR-ACCESS-UPDATE DTSCS85 -01379 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS85 -01380 ELSE DTSCS85 -01381 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS85 +01365 IF CURSOR-SET-GOTO DTSCS85 +01366 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS85 +01367 ELSE DTSCS85 +01368 MOVE CATB-CURSOR TO MAP-TERRITORY-L. DTSCS85 +01369 SKIP1 DTSCS85 +01370 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS85 +01371 SKIP1 DTSCS85 +01372 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS85 +01373 SKIP1 DTSCS85 +01374 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 +01375 S9200-EXIT. DTSCS85 +01376 EXIT. DTSCS85 +01377 SKIP3 DTSCS85 +01378 S9300-SEND-MAP. DTSCS85 +01379 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS85 +01380 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS85 +01381 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS85 01382 SKIP1 DTSCS85 -01383 PERFORM S9331-DSCR-TERRITORY THRU S9331-EXIT. DTSCS85 -01384 SKIP1 DTSCS85 -01385 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS85 -01386 SKIP1 DTSCS85 -01387 IF CURSOR-SET-NO DTSCS85 -01388 MOVE CATB-CURSOR TO MAP-TERRITORY-L. DTSCS85 +01383 IF SCR-ACCESS-UPDATE DTSCS85 +01384 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS85 +01385 ELSE DTSCS85 +01386 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS85 +01387 SKIP1 DTSCS85 +01388 PERFORM S9331-DSCR-TERRITORY THRU S9331-EXIT. CL**3 01389 SKIP1 DTSCS85 -01390 SET L851-SEND-88 TO TRUE. DTSCS85 +01390 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS85 01391 SKIP1 DTSCS85 -01392 PERFORM S9800-NAME-FILL THRU S9800-EXIT DTSCS85 -01393 VARYING MAP-IDX FROM 1 BY 1 DTSCS85 -01394 UNTIL MAP-IDX GREATER THAN 10. DTSCS85 -01395 SKIP1 DTSCS85 -01396 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS85 -01397 SKIP1 DTSCS85 -01398 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 -01399 S9300-EXIT. DTSCS85 -01400 EXIT. DTSCS85 -01401 SKIP3 DTSCS85 -01402 S9310-UPDATE-FKEYS. DTSCS85 -01403 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS85 -01404 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS85 -01405 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS85 -01406 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS85 -01407 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS85 -01408 SKIP1 DTSCS85 -01409 IF LCCM-SCR-CLEAR DTSCS85 -01410 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS85 -01411 MAP-KEY-DEL DTSCS85 -01412 ELSE DTSCS85 -01413 IF LCCM-SCR-UPDATE-LOCKED DTSCS85 -01414 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS85 -01415 MAP-KEY-FWRD DTSCS85 -01416 MAP-KEY-ADD DTSCS85 -01417 MAP-KEY-MOD DTSCS85 -01418 MAP-KEY-DEL DTSCS85 -01419 ELSE DTSCS85 -01420 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS85 -01421 S9310-EXIT. DTSCS85 -01422 EXIT. DTSCS85 -01423 SKIP3 DTSCS85 -01424 S9320-INQUIRY-FKEYS. DTSCS85 -01425 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS85 -01426 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS85 -01427 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS85 -01428 MAP-KEY-MOD DTSCS85 -01429 MAP-KEY-DEL. DTSCS85 -01430 S9320-EXIT. DTSCS85 -01431 EXIT. DTSCS85 -01432 EJECT DTSCS85 -01433 S9331-DSCR-TERRITORY. DTSCS85 -01434 * IF MAP-TERRITORY = SPACE OR LOW-VALUE DTSCS85 -01435 IF MAP-TERRITORY NOT NUMERIC DTSCS85 -01436 MOVE SPACE TO MAP-TERRITORY-DESC DTSCS85 -01437 GO TO S9331-EXIT. DTSCS85 -01438 DTSCS85 -01439 CALL 'LPAMC' USING DTSCS85 -01440 DFHEIBLK DTSCS85 -01441 LPAM-DUMMY-COMMAREA DTSCS85 -01442 LPAM-OPEN-FUNCTION DTSCS85 -01443 LPAM-ANCHOR-AREA DTSCS85 -01444 LPAM-RETURN-CODE DTSCS85 -01445 LPAM-ERROR-AREA DTSCS85 -01446 LPAM-STREET-FILE-RCB DTSCS85 -01447 LPAM-PRODUCT-NAME DTSCS85 -01448 LPAM-STREET-FILE-NAME. DTSCS85 -01449 DTSCS85 -01450 IF LPAM-RETURN-CODE NOT = '00' DTSCS85 -01451 * MOVE '=NOT AVAILABLE=' TO MAP-CITY DTSCS85 -01452 MOVE '=NOT AVAILABLE=' TO MAP-TERRITORY-DESC DTSCS85 -01453 GO TO S9331-EXIT. DTSCS85 -01454 DTSCS85 -01455 MOVE LOW-VALUES TO LPAM-GETZIP-INPUT. DTSCS85 -01456 MOVE MAP-TERRITORY TO LPAM-GETZIP-TARGET-ZIP. DTSCS85 -01457 MOVE 'FIRST' TO LPAM-GETZIP-TARGET-IND. DTSCS85 -01458 MOVE 1 TO LPAM-GETZIP-REPLICATION. DTSCS85 -01459 DTSCS85 -01460 CALL 'LPAMC' USING DTSCS85 -01461 DFHEIBLK DTSCS85 -01462 LPAM-DUMMY-COMMAREA DTSCS85 -01463 LPAM-GETZIP-FUNCTION DTSCS85 -01464 LPAM-ANCHOR-AREA DTSCS85 -01465 LPAM-RETURN-CODE DTSCS85 -01466 LPAM-ERROR-AREA DTSCS85 -01467 LPAM-STREET-FILE-RCB DTSCS85 -01468 LPAM-GETZIP-INPUT DTSCS85 -01469 LPAM-GETZIP-OUTPUT. DTSCS85 -01470 DTSCS85 -01471 IF LPAM-RETURN-CODE = '00' DTSCS85 -01472 MOVE LPAM-GETZIP-RCITY TO MAP-TERRITORY-DESC DTSCS85 -01473 *********MOVE LPAM-GETZIP-RSTATE TO MAP-ST DTSCS85 -01474 ELSE DTSCS85 -01475 MOVE ALL '?' TO MAP-TERRITORY-DESC. DTSCS85 -01476 DTSCS85 -01477 CALL 'LPAMC' USING DTSCS85 -01478 DFHEIBLK DTSCS85 -01479 LPAM-DUMMY-COMMAREA DTSCS85 -01480 LPAM-CLOSE-FUNCTION DTSCS85 -01481 LPAM-ANCHOR-AREA DTSCS85 -01482 LPAM-RETURN-CODE DTSCS85 -01483 LPAM-ERROR-AREA DTSCS85 -01484 LPAM-STREET-FILE-RCB. DTSCS85 -01485 S9331-EXIT. DTSCS85 -01486 EXIT. DTSCS85 -01487 EJECT DTSCS85 -01488 S9800-NAME-FILL. DTSCS85 -01489 IF MAP-REP-ID (MAP-IDX) = LOW-VALUE DTSCS85 -01490 MOVE LOW-VALUE TO MAP-REP-NAME (MAP-IDX) DTSCS85 -01491 ELSE DTSCS85 -01492 MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID DTSCS85 -01493 PERFORM S062-READ-REP THRU S062-EXIT DTSCS85 -01494 MOVE L062-NAME TO MAP-REP-NAME (MAP-IDX). DTSCS85 -01495 S9800-EXIT. DTSCS85 -01496 EXIT. DTSCS85 -01497 SKIP3 DTSCS85 -01498 S9900-PREPARE-SEND. DTSCS85 -01499 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS85 -01500 LCCM-SCR-ID. DTSCS85 -01501 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS85 -01502 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS85 -01503 S9900-EXIT. DTSCS85 -01504 EXIT. DTSCS85 +01392 IF CURSOR-SET-NO DTSCS85 +01393 MOVE CATB-CURSOR TO MAP-TERRITORY-L. DTSCS85 +01394 SKIP1 DTSCS85 +01395 SET L851-SEND-88 TO TRUE. DTSCS85 +01396 SKIP1 DTSCS85 +01397 PERFORM S9800-NAME-FILL THRU S9800-EXIT DTSCS85 +01398 VARYING MAP-IDX FROM 1 BY 1 DTSCS85 +01399 UNTIL MAP-IDX GREATER THAN 10. DTSCS85 +01400 SKIP1 DTSCS85 +01401 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS85 +01402 SKIP1 DTSCS85 +01403 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS85 +01404 S9300-EXIT. DTSCS85 +01405 EXIT. DTSCS85 +01406 SKIP3 DTSCS85 +01407 S9310-UPDATE-FKEYS. DTSCS85 +01408 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS85 +01409 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS85 +01410 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS85 +01411 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS85 +01412 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS85 +01413 SKIP1 DTSCS85 +01414 IF LCCM-SCR-CLEAR DTSCS85 +01415 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS85 +01416 MAP-KEY-DEL DTSCS85 +01417 ELSE DTSCS85 +01418 IF LCCM-SCR-UPDATE-LOCKED DTSCS85 +01419 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS85 +01420 MAP-KEY-FWRD DTSCS85 +01421 MAP-KEY-ADD DTSCS85 +01422 MAP-KEY-MOD DTSCS85 +01423 MAP-KEY-DEL DTSCS85 +01424 ELSE DTSCS85 +01425 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS85 +01426 S9310-EXIT. DTSCS85 +01427 EXIT. DTSCS85 +01428 SKIP3 DTSCS85 +01429 S9320-INQUIRY-FKEYS. DTSCS85 +01430 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS85 +01431 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS85 +01432 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS85 +01433 MAP-KEY-MOD DTSCS85 +01434 MAP-KEY-DEL. DTSCS85 +01435 S9320-EXIT. DTSCS85 +01436 EXIT. DTSCS85 +01437 EJECT DTSCS85 +01438 S9331-DSCR-TERRITORY. DTSCS85 +01439 * IF MAP-TERRITORY = SPACE OR LOW-VALUE DTSCS85 +01440 IF MAP-TERRITORY NOT NUMERIC DTSCS85 +01441 MOVE SPACE TO MAP-TERRITORY-DESC DTSCS85 +01442 GO TO S9331-EXIT. DTSCS85 +01443 DTSCS85 +01444 DTSCS85 +01445 * MOVE ALL '?' TO MAP-TERRITORY-DESC. CL**3 +01446 DTSCS85 +01447 S9331-EXIT. CL**3 +01448 EXIT. CL**3 +01449 S9800-NAME-FILL. DTSCS85 +01450 IF MAP-REP-ID (MAP-IDX) = LOW-VALUE DTSCS85 +01451 MOVE LOW-VALUE TO MAP-REP-NAME (MAP-IDX) DTSCS85 +01452 ELSE DTSCS85 +01453 MOVE MAP-REP-ID (MAP-IDX) TO L062-FLD-REP-ID DTSCS85 +01454 PERFORM S062-READ-REP THRU S062-EXIT DTSCS85 +01455 MOVE L062-NAME TO MAP-REP-NAME (MAP-IDX). DTSCS85 +01456 S9800-EXIT. DTSCS85 +01457 EXIT. DTSCS85 +01458 SKIP3 DTSCS85 +01459 S9900-PREPARE-SEND. DTSCS85 +01460 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS85 +01461 LCCM-SCR-ID. DTSCS85 +01462 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS85 +01463 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS85 +01464 S9900-EXIT. DTSCS85 +01465 EXIT. DTSCS85 diff --git a/CICSFiles.txt b/CICSFiles.txt index 8904e93..505d2ab 100644 --- a/CICSFiles.txt +++ b/CICSFiles.txt @@ -1,4 +1,4 @@ -E:\Faizan_Folder\DUTAS_DEV_UPDATE\DUTAS\CICS\DTSCU851.cob +E:\Faizan_Folder\DUTAS_DEV_UPDATE\DUTAS\CICS\DTSCS81.cob diff --git a/CompileOptions.txt b/CompileOptions.txt index 6fa84fd..add71cd 100644 --- a/CompileOptions.txt +++ b/CompileOptions.txt @@ -1,5 +1,5 @@ -IgnoreParseError=TRUE --OutputDir=E:\Faizan_Folder\DUTAS_DEV_UPDATE\bin\CICS +-OutputDir=E:\Faizan_Folder\DUTAS_DEV_UPDATE\bin\CICS\dll -RemoveFileVerifyFailed=FALSE -MaxMem=1000 -IncludeSearchPath=E:\Faizan_Folder\DUTAS_DEV_UPDATE/DUTAS/Copybook